Introduce term values and refactor grammar.
Chris Pressey
1 year, 5 months ago
19 | 19 | be rewritten for clarity at some point. |
20 | 20 | |
21 | 21 | Grammar ::= {Production}. |
22 | Production ::= NonTerminal [Formals] ["(*)"] "::=" {Expr0}. | |
23 | Expr0 ::= Expr1 {"|" Expr1}. | |
24 | Expr1 ::= Term {Term}. | |
25 | Term ::= "{" Expr0 "}" | |
26 | | "(" Expr0 ")" | |
22 | Production ::= NonTerminal [Formals] ["(*)"] "::=" {ProdExpr0}. | |
23 | ProdExpr0 ::= ProdExpr1 {"|" ProdExpr1}. | |
24 | ProdExpr1 ::= Term {Term}. | |
25 | Term ::= "{" ProdExpr0 "}" | |
26 | | "(" ProdExpr0 ")" | |
27 | 27 | | "<." Constraint ".>" |
28 | 28 | | Terminal |
29 | 29 | | NonTerminal [Actuals]. |
30 | NonTerminal ::= <<upper>><<alphanumeric>>*. | |
31 | Terminal ::= <<">> <<any except ">>+ <<">> | <<#>>IntLit. | |
30 | 32 | Formals ::= "<" Variable {"," Variable} ">". |
31 | 33 | Actuals ::= "<" VarExpr {"," VarExpr} ">". |
32 | VarExpr ::= Variable. -- TODO: In future this might be richer. | |
33 | Constraint ::= Variable Constrainer. | |
34 | Constrainer ::= "=" (Variable | IntLit) | |
35 | | "+=" CExpr | |
36 | | "-=" CExpr | |
37 | | ">" CExpr | |
38 | | "<" CExpr. | |
39 | CExpr ::= Variable | IntLit. | |
40 | NonTerminal ::= <<upper>><<alphanumeric>>*. | |
41 | Terminal ::= <<">> <<any except ">>+ <<">> | <<#>>IntLit. | |
34 | Constraint ::= Variable Op ConExpr. | |
35 | Op := "=" | "+=" | "-=" | ">" | "<". | |
36 | ConExpr ::= VarExpr | Literal. | |
37 | VarExpr ::= Variable. | |
38 | Literal ::= IntLit | TermLit | Placeholder. | |
42 | 39 | IntLit ::= [<<->>] <<digit>>+. |
40 | TermLit ::= Atom ["(" Literal {"," Literal} ")"]. | |
41 | Placeholder ::= "$" Variable. | |
43 | 42 | |
44 | 43 | Tests follow. |
45 | 44 |
0 | 0 | {-# LANGUAGE FlexibleContexts #-} |
1 | 1 | module Language.Fountain.Loader where |
2 | ||
3 | -- | |
4 | -- In a more conventional project, this module would be called "Parser", | |
5 | -- but that would be somewhat too confusing here. | |
6 | -- | |
2 | 7 | |
3 | 8 | import Data.Char (chr) |
4 | 9 | import Text.ParserCombinators.Parsec |
21 | 26 | p <- option [] formals |
22 | 27 | bt <- option False (do { keyword "(*)"; return True }) |
23 | 28 | keyword "::=" |
24 | e <- expr0 bt | |
29 | e <- prodExpr0 bt | |
25 | 30 | keyword ";" |
26 | 31 | return Production{ ntname=nt, params=p, backtrackable=bt, constituents=e } |
27 | 32 | |
31 | 36 | keyword ">" |
32 | 37 | return v |
33 | 38 | |
34 | expr0 bt = do | |
35 | es <- sepBy (expr1 bt) (keyword "|") | |
39 | prodExpr0 bt = do | |
40 | es <- sepBy (prodExpr1 bt) (keyword "|") | |
36 | 41 | return $ Alt bt es |
37 | 42 | |
38 | expr1 bt = do | |
43 | prodExpr1 bt = do | |
39 | 44 | es <- many1 $ term bt |
40 | 45 | return $ Seq $ flattenseq es where |
41 | 46 | flattenseq [] = [] |
48 | 53 | |
49 | 54 | parenExpr bt = do |
50 | 55 | keyword "(" |
51 | e <- expr0 bt | |
56 | e <- prodExpr0 bt | |
52 | 57 | keyword ")" |
53 | 58 | return e |
54 | 59 | |
55 | 60 | loopExpr bt = do |
56 | 61 | keyword "{" |
57 | e <- expr0 bt | |
62 | e <- prodExpr0 bt | |
58 | 63 | keyword "}" |
59 | 64 | return $ Loop e [] |
60 | 65 | |
99 | 104 | inc = do |
100 | 105 | v <- variable |
101 | 106 | keyword "+=" |
102 | e <- cexpr | |
107 | e <- conExpr | |
103 | 108 | return $ Inc v e |
104 | 109 | |
105 | 110 | dec = do |
106 | 111 | v <- variable |
107 | 112 | keyword "-=" |
108 | e <- cexpr | |
113 | e <- conExpr | |
109 | 114 | return $ Dec v e |
110 | 115 | |
111 | 116 | gte = do |
112 | 117 | v <- variable |
113 | 118 | keyword ">=" |
114 | e <- cexpr | |
119 | e <- conExpr | |
115 | 120 | return $ GreaterThanOrEqual v e |
116 | 121 | |
117 | 122 | gt = do |
118 | 123 | v <- variable |
119 | 124 | keyword ">" |
120 | e <- cexpr | |
125 | e <- conExpr | |
121 | 126 | return $ GreaterThan v e |
122 | 127 | |
123 | 128 | lte = do |
124 | 129 | v <- variable |
125 | 130 | keyword "<=" |
126 | e <- cexpr | |
131 | e <- conExpr | |
127 | 132 | return $ LessThanOrEqual v e |
128 | 133 | |
129 | 134 | lt = do |
130 | 135 | v <- variable |
131 | 136 | keyword "<" |
132 | e <- cexpr | |
137 | e <- conExpr | |
133 | 138 | return $ LessThan v e |
134 | 139 | |
135 | 140 | both = do |
144 | 149 | s <- lowWord |
145 | 150 | return $ Var s |
146 | 151 | |
147 | cexpr = (try cIntExpr) <|> cVarExpr | |
148 | ||
149 | cIntExpr = do | |
152 | conExpr = (try intExpr) <|> varExpr | |
153 | ||
154 | intExpr = do | |
150 | 155 | i <- intlit |
151 | 156 | return $ CVal (IntVal i) |
152 | 157 | |
153 | cVarExpr = do | |
158 | varExpr = do | |
154 | 159 | v <- variable |
155 | 160 | return $ CVar v |
156 | 161 |
3 | 3 | |
4 | 4 | |
5 | 5 | data Value = IntVal Integer |
6 | | StrVal String | |
6 | | Placeholder String | |
7 | | Constructor String [Value] | |
7 | 8 | deriving (Ord, Eq) |
8 | 9 | |
9 | 10 | instance Show Value where |
10 | 11 | show (IntVal n) = show n |
11 | show (StrVal s) = show s | |
12 | show (Placeholder ph) = ph -- we assume first letter is caps | |
13 | show (Constructor s vals) = s ++ (if vals == [] then "" else "(" ++ (showMany vals) ++ ")") | |
14 | where | |
15 | showMany [] = "" | |
16 | showMany [v] = show v | |
17 | showMany (v:vs) = (show v) ++ ", " ++ (showMany vs) | |
12 | 18 | |
13 | -- TODO: this is some kind of Functor thing actually | |
19 | -- TODO: this is actually some kind of Functor-ish, "AdditiveGroupMaybe" thing | |
14 | 20 | instance Deltaable Value where |
15 | 21 | incrBy (IntVal y) (IntVal x) = Just $ IntVal (x + y) |
16 | 22 | incrBy _ _ = Nothing |