1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
module PShell where
import Operations
import UseIO
import ShellState
import ShellCommands
import Shell
import Option
import PGrammar (pzIdent, pTrm) --- (string2formsAndTerm)
import API
import Arch(fetchCommand)
import Char (isDigit)
import IO
-- parsing GF shell commands. AR 11/11/2001
-- getting a sequence of command lines as input
getCommandLines :: IO (String,[CommandLine])
getCommandLines = do
s <- fetchCommand "> "
return (s,pCommandLines s)
getCommandLinesBatch :: IO (String,[CommandLine])
getCommandLinesBatch = do
s <- catch getLine (\e -> if IO.isEOFError e then return "q" else ioError e)
return $ (s,pCommandLines s)
pCommandLines :: String -> [CommandLine]
pCommandLines = map pCommandLine . concatMap (chunks ";;" . words) . lines
pCommandLine :: [String] -> CommandLine
pCommandLine s = pFirst (chks s) where
pFirst cos = case cos of
(c,os,[a]) : cs -> ((c,os), a, pCont cs)
_ -> ((CVoid,noOptions), AError "no parse", [])
pCont cos = case cos of
(c,os,_) : cs -> (c,os) : pCont cs
_ -> []
chks = map pCommandOpt . chunks "|"
pCommandOpt :: [String] -> (Command, Options, [CommandArg])
pCommandOpt (w:ws) = let
(os, co) = getOptions "-" ws
(comm, args) = pCommand (abbrevCommand w:co)
in
(comm, os, args)
pCommandOpt s = (CVoid, noOptions, [AError "no parse"])
pInputString :: String -> [CommandArg]
pInputString s = case s of
('"':_:_) -> [AString (init (tail s))]
_ -> [AError "illegal string"]
-- command rl can be written remove_language etc.
abbrevCommand :: String -> String
abbrevCommand = hds . words . map u2sp where
u2sp c = if c=='_' then ' ' else c
hds s = case s of
[w@[_,_]] -> w
_ -> map head s
pCommand :: [String] -> (Command, [CommandArg])
pCommand ws = case ws of
"i" : f : [] -> aUnit (CImport f)
"rl" : l : [] -> aUnit (CRemoveLanguage (language l))
"e" : [] -> aUnit CEmptyState
"s" : [] -> aUnit CStripState
"tg" : f : [] -> aUnit (CTransformGrammar f)
"cl" : f : [] -> aUnit (CConvertLatex f)
"ph" : [] -> aUnit CPrintHistory
"l" : s -> aTermLi CLinearize s
"p" : s -> aString CParse s
"t" : i:o: s -> aString (CTranslate (language i) (language o)) s
"gr" : [] -> aUnit CGenerateRandom
"gr" : t -> aTerm CGenerateRandom t
"gt" : [] -> aUnit CGenerateTrees
"gt" : t -> aTerm CGenerateTrees t
"pt" : s -> aTerm CPutTerm s
----- "wt" : f : s -> aTerm (CWrapTerm (string2id f)) s
"ma" : s -> aString CMorphoAnalyse s
"tt" : s -> aString CTestTokenizer s
"cc" : s -> aUnit $ CComputeConcrete $ unwords s
"so" : s -> aUnit $ CShowOpers $ unwords s
"tq" : i:o:[] -> aUnit (CTranslationQuiz (language i) (language o))
"tl":i:o:n:[] -> aUnit (CTranslationList (language i) (language o) (readIntArg n))
"mq" : [] -> aUnit CMorphoQuiz
"ml" : n : [] -> aUnit (CMorphoList (readIntArg n))
"wf" : f : s -> aString (CWriteFile f) s
"af" : f : s -> aString (CAppendFile f) s
"rf" : f : [] -> aUnit (CReadFile f)
"sa" : s -> aString CSpeakAloud s
"ps" : s -> aString CPutString s
"st" : s -> aTerm CShowTerm s
"!" : s -> aUnit (CSystemCommand (unwords s))
"sc" : s -> aUnit (CSystemCommand (unwords s))
"sf" : l : [] -> aUnit (CSetLocalFlag (language l))
"sf" : [] -> aUnit CSetFlag
"pg" : [] -> aUnit CPrintGrammar
"pi" : c : [] -> aUnit $ CPrintInformation (pzIdent c)
"pj" : [] -> aUnit CPrintGramlet
"pxs" : [] -> aUnit CPrintCanonXMLStruct
"px" : [] -> aUnit CPrintCanonXML
"pm" : [] -> aUnit CPrintMultiGrammar
"po" : [] -> aUnit CPrintGlobalOptions
"pl" : [] -> aUnit CPrintLanguages
"h" : c : [] -> aUnit $ CHelp (Just (abbrevCommand c))
"h" : [] -> aUnit $ CHelp Nothing
"q" : [] -> aImpure ICQuit
"eh" : f : [] -> aImpure (ICExecuteHistory f)
n : [] | all isDigit n -> aImpure (ICEarlierCommand (readIntArg n))
"es" : [] -> aImpure ICEditSession
"ts" : [] -> aImpure ICTranslateSession
_ -> (CVoid, [])
where
aString c ss = (c, pInputString (unwords ss))
aTerm c ss = (c, [ASTrm $ unwords ss]) ---- [ASTrms [s2t (unwords ss)]])
aUnit c = (c, [AUnit])
aImpure = aUnit . CImpure
aTermLi c ss = (c [], [ASTrm $ unwords ss])
---- (c forms, [ASTrms [term]]) where
---- (forms,term) = ([], s2t (unwords ss)) ---- string2formsAndTerm (unwords ss)
|
