Commit 1074ffb3f86def70c8f35dfae61ed2d5a0d8cf8c - Fountain

+2

-0

src/Language/Fountain/Constraint.hs less more

17	17	\| LessThan Variable CExpr
18	18	\| LessThanOrEqual Variable CExpr
19	19	\| Both Constraint Constraint
	20	\| Lookahead String
20	21	deriving (Show, Ord, Eq)
21	22
22	23	depictVar (Var s) = s

33	34	depictConstraint (LessThan v e) = (depictVar v) ++ " < " ++ (depictCExpr e)
34	35	depictConstraint (LessThanOrEqual v e) = (depictVar v) ++ " <= " ++ (depictCExpr e)
35	36	depictConstraint (Both c1 c2) = "&& " ++ (depictConstraint c1) ++ ", " ++ (depictConstraint c2)
	37	depictConstraint (Lookahead s) = "token is " ++ (show s)

+9

-6

src/Language/Fountain/Generator.hs less more

34	34	gen g state@(Generating _str store) (Alt False choices) =
35	35	case missingPreConditions choices of
36	36	missing@(_:_) ->
37		error ("No pre-condition present on these Alt choices: " ++ (show missing))
	37	error ("No pre-condition present on these Alt choices: " ++ (depictExprs missing))
38	38	[] ->
39	39	let
40	40	preConditionedChoices = map (\x -> (getPreCondition x, x)) choices

48	48	-- we ignore the constraint here because it will be found and applied when we descend into e
49	49	genAlt st [(_, e)] = gen g st e
50	50	genAlt _st other =
51		error ("Multiple pre-conditions are satisfied in Alt: " ++ (show other))
	51	error ("Multiple pre-conditions are satisfied in Alt: " ++ (depictExprs (map (snd) other)))
52	52
53	53	gen _g _state (Alt True _choices) = error "Backtracking alternations during generation not yet implemented"
54	54

123	123	Just $ update (\i -> Just (i - delta)) v st
124	124	Nothing ->
125	125	Nothing
126		applyConstraint (GreaterThan v e) st = applyRelConstraint (>) v e st
127		applyConstraint (GreaterThanOrEqual v e) st = applyRelConstraint (>=) v e st
128		applyConstraint (LessThan v e) st = applyRelConstraint (<) v e st
129		applyConstraint (LessThanOrEqual v e) st = applyRelConstraint (<=) v e st
130	126	applyConstraint (Both c1 c2) st =
131	127	case applyConstraint c1 st of
132	128	Just st' ->
133	129	applyConstraint c2 st'
134	130	Nothing ->
135	131	Nothing
	132	applyConstraint (Lookahead _) _st =
	133	-- This only applies in parsing; during generation, there is nothing to look ahead TO!
	134	Nothing
	135	applyConstraint (GreaterThan v e) st = applyRelConstraint (>) v e st
	136	applyConstraint (GreaterThanOrEqual v e) st = applyRelConstraint (>=) v e st
	137	applyConstraint (LessThan v e) st = applyRelConstraint (<) v e st
	138	applyConstraint (LessThanOrEqual v e) st = applyRelConstraint (<=) v e st
136	139
137	140	applyRelConstraint op v e st =
138	141	case (fetch v st, ceval e st) of

+3

-1

src/Language/Fountain/Grammar.hs less more

2	2	Expr(Seq, Alt, Loop, Terminal, NonTerminal, Constraint),
3	3	Production(Production, ntname, params, backtrackable, constituents),
4	4	Grammar(Grammar),
5		depictExpr, depictProduction, depictGrammar, depictVars,
	5	depictExpr, depictExprs, depictProduction, depictGrammar, depictVars,
6	6	startSymbol, production, getFormals,
7	7	getPreCondition, missingPreConditions
8	8	) where

51	51	depictExpr (NonTerminal name vars) = name ++ depictVars vars
52	52	depictExpr (Constraint c) = "<. " ++ (depictConstraint c) ++ " .>"
53	53
	54	depictExprs exprs = (intercalate ", " (map (depictExpr) exprs))
	55
54	56	depictVars [] = ""
55	57	depictVars vars = "<" ++ (intercalate ", " (map (depictVar) vars)) ++ ">"
56	58

+12

-7

src/Language/Fountain/Parser.hs less more

40	40	st' -> st'
41	41
42	42	-- Hello, Mrs Non-Backtracking Alternation!
43		parse g state@(Parsing _str store) expr@(Alt False choices) =
	43	parse g state@(Parsing _str store) (Alt False choices) =
44	44	case missingPreConditions choices of
45	45	missing@(_:_) ->
46		error ("No pre-condition present on these Alt choices: " ++ (show missing) ++ " of this: " ++ (show expr))
	46	error ("No pre-condition present on these Alt choices: " ++ (depictExprs missing))
47	47	[] ->
48	48	let
49	49	preConditionedChoices = map (\x -> (getPreCondition x, x)) choices

57	57	-- we ignore the constraint here because it will be found and applied when we descend into e
58	58	parseAlt st [(_, e)] = parse g st e
59	59	parseAlt _st other =
60		error ("Multiple pre-conditions are satisfied in Alt: " ++ (show other))
	60	error ("Multiple pre-conditions are satisfied in Alt: " ++ (depictExprs (map (snd) other)))
61	61
62	62	parse g state (Loop l _) = parseLoop state l where
63	63	parseLoop st e =

120	120	Just $ update (\i -> Just (i - delta)) v st
121	121	Nothing ->
122	122	Nothing
123		applyConstraint (GreaterThan v e) st = applyRelConstraint (>) v e st
124		applyConstraint (GreaterThanOrEqual v e) st = applyRelConstraint (>=) v e st
125		applyConstraint (LessThan v e) st = applyRelConstraint (<) v e st
126		applyConstraint (LessThanOrEqual v e) st = applyRelConstraint (<=) v e st
127	123	applyConstraint (Both c1 c2) st =
128	124	case applyConstraint c1 st of
129	125	Just st' ->
130	126	applyConstraint c2 st'
131	127	Nothing ->
132	128	Nothing
	129	applyConstraint (Lookahead _s) _st =
	130	-- FIXME we need access to state, not just store!
	131	-- state@(Parsing (c:cs) _store)
	132	-- if s == [c] then Just state else Nothing
	133	Nothing
	134	applyConstraint (GreaterThan v e) st = applyRelConstraint (>) v e st
	135	applyConstraint (GreaterThanOrEqual v e) st = applyRelConstraint (>=) v e st
	136	applyConstraint (LessThan v e) st = applyRelConstraint (<) v e st
	137	applyConstraint (LessThanOrEqual v e) st = applyRelConstraint (<=) v e st
133	138
134	139	applyRelConstraint op v e st =
135	140	case (fetch v st, ceval e st) of