real: enable linear
[nofib.git] / real / rx / src / Command.hs
1 -- for parsing formatting commands
2
3 -- changes:
4
5 -- 25. 4. 97: make '$' refer to value of some binding
6
7 module Command
8
9 ( Cmd(..)
10 , pcmd
11 )
12
13 where
14
15 import Data.Char
16
17 import Options
18
19 import Lex
20 import Parse
21
22
23 -- a command starts with a dot (which is eaten before the parser
24 -- down below is called) and only extends for one line
25
26 data Cmd = Begin Opts
27 | End
28 | Set Opts
29 | Import Opts String
30
31 | Unknown String
32
33 --------------------------------------------------------
34
35 -- parsing commands
36
37 paName = litp "Name" (\ cs ->
38 isAlpha (head cs) || isDigit (head cs))
39
40
41 paStrng = litp "String" (\ cs -> head cs == '"') -- rely on the lexer
42 `act` \ cs -> drop 1 (take (length cs - 1) cs)
43
44 paNameStrng = paName ||! paStrng
45
46 paBind opts =
47 (paNameStrng +.. lit "=")
48 +.+ ( paNameStrng -- take it literally
49 ||! (lit "$" ..+ paNameStrng) `act` (getopt opts)
50 )
51
52
53 paGroup opts = lit "(" ..+ paBind opts `sepBy` lit "," +.. lit ")"
54 `act` listToOpts
55
56 paOptGroup opts = paGroup opts ||! succeed emptyOpts
57
58 paCommand opts =
59 ( lit "begin" ..+ paOptGroup opts
60 `act` \ g -> Begin g
61 ) ||! ( lit "end"
62 `act` \ _ -> End
63 ) ||! ( lit "set" ..+ paGroup opts
64 `act` \ g -> Set g
65 ) ||! ( lit "import" ..+ paOptGroup opts +.+ paNameStrng
66 `act` \ (g, n) -> Import g n
67
68 ) ||! ( many (litp "unknown" (const True))
69 `act` \ ws -> Unknown (unwords ws)
70 )
71
72 pcmd opts inp = simpleParse (paCommand opts) (myLex (uncomment inp))