git @ Cat's Eye Technologies Fountain / 672d7cc
Introduce term values and refactor grammar. Chris Pressey 1 year, 5 months ago
3 changed file(s) with 44 addition(s) and 34 deletion(s). Raw diff Collapse all Expand all
1919 be rewritten for clarity at some point.
2020
2121 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 ")"
2727 | "<." Constraint ".>"
2828 | Terminal
2929 | NonTerminal [Actuals].
30 NonTerminal ::= <<upper>><<alphanumeric>>*.
31 Terminal ::= <<">> <<any except ">>+ <<">> | <<#>>IntLit.
3032 Formals ::= "<" Variable {"," Variable} ">".
3133 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.
4239 IntLit ::= [<<->>] <<digit>>+.
40 TermLit ::= Atom ["(" Literal {"," Literal} ")"].
41 Placeholder ::= "$" Variable.
4342
4443 Tests follow.
4544
00 {-# LANGUAGE FlexibleContexts #-}
11 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 --
27
38 import Data.Char (chr)
49 import Text.ParserCombinators.Parsec
2126 p <- option [] formals
2227 bt <- option False (do { keyword "(*)"; return True })
2328 keyword "::="
24 e <- expr0 bt
29 e <- prodExpr0 bt
2530 keyword ";"
2631 return Production{ ntname=nt, params=p, backtrackable=bt, constituents=e }
2732
3136 keyword ">"
3237 return v
3338
34 expr0 bt = do
35 es <- sepBy (expr1 bt) (keyword "|")
39 prodExpr0 bt = do
40 es <- sepBy (prodExpr1 bt) (keyword "|")
3641 return $ Alt bt es
3742
38 expr1 bt = do
43 prodExpr1 bt = do
3944 es <- many1 $ term bt
4045 return $ Seq $ flattenseq es where
4146 flattenseq [] = []
4853
4954 parenExpr bt = do
5055 keyword "("
51 e <- expr0 bt
56 e <- prodExpr0 bt
5257 keyword ")"
5358 return e
5459
5560 loopExpr bt = do
5661 keyword "{"
57 e <- expr0 bt
62 e <- prodExpr0 bt
5863 keyword "}"
5964 return $ Loop e []
6065
99104 inc = do
100105 v <- variable
101106 keyword "+="
102 e <- cexpr
107 e <- conExpr
103108 return $ Inc v e
104109
105110 dec = do
106111 v <- variable
107112 keyword "-="
108 e <- cexpr
113 e <- conExpr
109114 return $ Dec v e
110115
111116 gte = do
112117 v <- variable
113118 keyword ">="
114 e <- cexpr
119 e <- conExpr
115120 return $ GreaterThanOrEqual v e
116121
117122 gt = do
118123 v <- variable
119124 keyword ">"
120 e <- cexpr
125 e <- conExpr
121126 return $ GreaterThan v e
122127
123128 lte = do
124129 v <- variable
125130 keyword "<="
126 e <- cexpr
131 e <- conExpr
127132 return $ LessThanOrEqual v e
128133
129134 lt = do
130135 v <- variable
131136 keyword "<"
132 e <- cexpr
137 e <- conExpr
133138 return $ LessThan v e
134139
135140 both = do
144149 s <- lowWord
145150 return $ Var s
146151
147 cexpr = (try cIntExpr) <|> cVarExpr
148
149 cIntExpr = do
152 conExpr = (try intExpr) <|> varExpr
153
154 intExpr = do
150155 i <- intlit
151156 return $ CVal (IntVal i)
152157
153 cVarExpr = do
158 varExpr = do
154159 v <- variable
155160 return $ CVar v
156161
33
44
55 data Value = IntVal Integer
6 | StrVal String
6 | Placeholder String
7 | Constructor String [Value]
78 deriving (Ord, Eq)
89
910 instance Show Value where
1011 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)
1218
13 -- TODO: this is some kind of Functor thing actually
19 -- TODO: this is actually some kind of Functor-ish, "AdditiveGroupMaybe" thing
1420 instance Deltaable Value where
1521 incrBy (IntVal y) (IntVal x) = Just $ IntVal (x + y)
1622 incrBy _ _ = Nothing