Commit 3966761c074e9d2be216576b01624496b91ac712 - Fountain

Make preprocessing more purpose-sensitive. All tests pass now! Chris Pressey 6 months ago

2 changed file(s) with 28 addition(s) and 20 deletion(s). Raw diff Collapse all Expand all

+27

-19

src/Language/Fountain/Preprocessor.hs less more

13	13	import Language.Fountain.Value
14	14	import Language.Fountain.Constraint
15	15
	16	data Purpose = ForParsing \| ForGeneration
	17	deriving (Show, Ord, Eq)
16	18
17	19	preprocessGrammarForGeneration :: Grammar -> Bool -> Grammar
18		preprocessGrammarForGeneration g True = preprocessGrammarForGeneration (extractLoops g) False
19		preprocessGrammarForGeneration (Grammar productions) False =
	20	preprocessGrammarForGeneration = preprocessGrammar ForGeneration
	21
	22	preprocessGrammarForParsing :: Grammar -> Bool -> Grammar
	23	preprocessGrammarForParsing = preprocessGrammar ForParsing
	24
	25	preprocessGrammar :: Purpose -> Grammar -> Bool -> Grammar
	26
	27	preprocessGrammar purpose g True = preprocessGrammar purpose (extractLoops purpose g) False
	28	preprocessGrammar purpose (Grammar productions) False =
20	29	Grammar $ map (preprocessProduction) productions where
21	30	preprocessProduction p@Production{ constituents=c } = p { constituents=preprocessExpr c }
22		preprocessExpr = eliminateSingleAlts . coalesceConstraints . decorateLoops
23
24
25		preprocessGrammarForParsing :: Grammar -> Bool -> Grammar
26		preprocessGrammarForParsing g True = preprocessGrammarForParsing (extractLoops g) False
27		preprocessGrammarForParsing (Grammar productions) False =
28		Grammar $ map (preprocessProduction) productions where
29		preprocessProduction p@Production{ constituents=c } = p { constituents=preprocessExpr c }
30		preprocessExpr = eliminateSingleAlts . coalesceConstraints
31
	31	preprocessExpr = case purpose of
	32	ForGeneration -> eliminateSingleAlts . coalesceConstraints . decorateLoops
	33	ForParsing -> eliminateSingleAlts . coalesceConstraints
32	34
33	35	--
34	36	-- Coalesce constraints

60	62	-- the loop, we throw away that result so that we do not
61	63	-- apply them twice.
62	64	in
63		(Loop expr' constraints):(decorateSeq rest)
	65	case constraints of
	66	[] ->
	67	error "No postconditions defined for this Loop"
	68	_ ->
	69	(Loop expr' constraints):(decorateSeq rest)
64	70	decorateSeq (expr:rest) =
65	71	(decorateLoops expr):(decorateSeq rest)
66	72	absorbConstraints :: [Expr] -> ([Constraint Value Expr], [Expr])

146	152	ps' <- collectLoopsProductions ps
147	153	return $ Grammar ps'
148	154
149		extractLoops :: Grammar -> Grammar
150		extractLoops g = extractLoops' $ preprocessGrammarForLoopExtraction g
151
152		preprocessGrammarForLoopExtraction :: Grammar -> Grammar
153		preprocessGrammarForLoopExtraction (Grammar productions) = Grammar $ map (preprocessProduction) productions where
	155	extractLoops :: Purpose -> Grammar -> Grammar
	156	extractLoops purpose g = extractLoops' $ preprocessGrammarForLoopExtraction purpose g
	157
	158	preprocessGrammarForLoopExtraction :: Purpose -> Grammar -> Grammar
	159	preprocessGrammarForLoopExtraction purpose (Grammar productions) = Grammar $ map (preprocessProduction) productions where
154	160	preprocessProduction p@Production{ constituents=c } = p { constituents=preprocessExpr c }
155		preprocessExpr = eliminateSingleAlts . decorateLoops
	161	preprocessExpr = case purpose of
	162	ForParsing -> eliminateSingleAlts
	163	ForGeneration -> eliminateSingleAlts . decorateLoops
156	164
157	165	extractLoops' g =
158	166	let

-1

src/Main.hs less more

60	60	output $ Grammar.depictGrammar grammar
61	61	["preprocess", grammarFileName] -> do
62	62	grammar <- loadSource grammarFileName
63		let grammar' = Preprocessor.preprocessGrammarForGeneration grammar (convertLoops flags)
	63	let grammar' = Preprocessor.preprocessGrammarForParsing grammar (convertLoops flags)
64	64	-- TODO: add flag to show internal format
65	65	output $ Grammar.depictGrammar grammar'
66	66	("parse":grammarFileName:textFileName:initialParams) -> do