git @ Cat's Eye Technologies Fountain / 9fa16a4
Checkpoint having Alt actually have a backtracking-or-not option. Chris Pressey 1 year, 5 months ago
3 changed file(s) with 42 addition(s) and 34 deletion(s). Raw diff Collapse all Expand all
+1
-1
src/Language/Fountain/Generator.hs less more
4747
4848 -- We look at all the choices; each should start with a pre-condition
4949 -- determining whether we can select it; and we should narrow down our
50 -- choices based on that. (Then pick randomly? Or insist deterministic?)
50 -- choices based on that.
5151 gen g state@(Generating _str store) (Alt False choices) =
5252 case missingPreConditions choices of
5353 missing@(_:_) ->
+33
-32
src/Language/Fountain/Loader.hs less more
1919 p <- option [] formals
2020 bt <- option False (do { keyword "(*)"; return True })
2121 keyword "::="
22 e <- expr0
22 e <- expr0 bt
2323 keyword ";"
2424 return Production{ ntname=nt, params=p, backtrackable=bt, constituents=e }
2525
2929 keyword ">"
3030 return v
3131
32 expr0 = do
33 es <- sepBy (expr1) (keyword "|")
34 return $ Alt False es
35
36 expr1 = do
37 es <- many1 term
32 expr0 bt = do
33 es <- sepBy (expr1 bt) (keyword "|")
34 return $ Alt bt es
35
36 expr1 bt = do
37 es <- many1 $ term bt
3838 return $ Seq $ flattenseq es where
3939 flattenseq [] = []
4040 flattenseq (s:ss) = case s of
4242 Seq xs -> xs ++ (flattenseq ss)
4343 _ -> (s:flattenseq ss)
4444
45 term = (try parenExpr) <|> (try loopExpr) <|> (try constraintExpr) <|> (try terminal) <|> nonterminal
46
47 parenExpr = do
45 term bt = (try $ parenExpr bt) <|> (try $ loopExpr bt) <|> (try $ constraintExpr bt) <|> (try $ terminal bt) <|> nonterminal bt
46
47 parenExpr bt = do
4848 keyword "("
49 e <- expr0
49 e <- expr0 bt
5050 keyword ")"
5151 return e
5252
53 loopExpr = do
53 loopExpr bt = do
5454 keyword "{"
55 e <- expr0
55 e <- expr0 bt
5656 keyword "}"
5757 return $ Loop e []
5858
59 constraintExpr = do
59 constraintExpr _bt = do
6060 keyword "<."
6161 c <- constrainer
6262 keyword ".>"
6363 return $ Constraint $ c
6464
65 constrainer = (try unifyConst) <|> (try unifyVar) <|> (try inc) <|> (try dec) <|> (try gte) <|> (try gt) <|> (try lte) <|> (try lt) <|> (try both)
65 terminal _bt = do
66 s <- quotedString <|> charlit
67 case s of
68 [c] -> return $ Terminal $ c
69 _ -> return $ Seq $ map (\c -> Terminal c) s
70
71 nonterminal _bt = do
72 s <- capWord
73 a <- option [] actuals
74 return $ NonTerminal s a
75 where
76 actuals = do
77 keyword "<"
78 v <- sepBy (variable) (keyword ",")
79 keyword ">"
80 return v
81
82 constrainer = (try unifyConst) <|> (try unifyVar) <|> (try inc) <|> (try dec) <|>
83 (try gte) <|> (try gt) <|> (try lte) <|> (try lt) <|> (try both)
6684
6785 unifyConst = do
6886 v <- variable
134152 v <- variable
135153 return $ CVar v
136154
137 terminal = do
138 s <- quotedString <|> charlit
139 case s of
140 [c] -> return $ Terminal $ c
141 _ -> return $ Seq $ map (\c -> Terminal c) s
142
143 nonterminal = do
144 s <- capWord
145 a <- option [] actuals
146 return $ NonTerminal s a
147
148 actuals = do
149 keyword "<"
150 v <- sepBy (variable) (keyword ",")
151 keyword ">"
152 return v
153
154155 --
155156 -- Low level: Concrete things
156157 --
+8
-1
src/Language/Fountain/Parser.hs less more
3030 Failure -> Failure
3131 st' -> parseSeq st' rest
3232
33 parse g state (Alt _bt s) = parseAlt state s where
33 -- Hello, Mrs Backtracking Alternation!
34 parse g state (Alt True s) = parseAlt state s where
3435 parseAlt _st [] = Failure
3536 parseAlt st (e : rest) =
3637 case parse g st e of
3738 Failure -> parseAlt st rest
3839 st' -> st'
40
41 -- Hello, Mrs Non-Backtracking Alternation!
42 parse g state (Alt False s) = parseAlt state s where
43 parseAlt _st [] = Failure
44 -- FIXME: this should do "pick an applicable one"
45 parseAlt st (e : _) = parse g st e
3946
4047 parse g state (Loop l _) = parseLoop state l where
4148 parseLoop st e =