Commit c1d8d0d9f1c72e38394fddd62462bf51bec4ae3b - Fountain

Add --convert-loops flag to trigger the pre-processing of loops. Chris Pressey 8 months ago

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

+12

-8

src/Language/Fountain/Preprocessor.hs less more

13	13	import Language.Fountain.Constraint
14	14
15	15
16		preprocessGrammarForGeneration :: Grammar -> Grammar
17		preprocessGrammarForGeneration (Grammar productions) = Grammar $ map (preprocessProduction) productions where
18		preprocessProduction p@Production{ constituents=c } = p { constituents=preprocessExpr c }
19		preprocessExpr = eliminateSingleAlts . coalesceConstraints . decorateLoops
	16	preprocessGrammarForGeneration :: Grammar -> Bool -> Grammar
	17	preprocessGrammarForGeneration g True = preprocessGrammarForGeneration (extractLoops g) False
	18	preprocessGrammarForGeneration (Grammar productions) False =
	19	Grammar $ map (preprocessProduction) productions where
	20	preprocessProduction p@Production{ constituents=c } = p { constituents=preprocessExpr c }
	21	preprocessExpr = eliminateSingleAlts . coalesceConstraints . decorateLoops
20	22
21	23
22		preprocessGrammarForParsing :: Grammar -> Grammar
23		preprocessGrammarForParsing (Grammar productions) = Grammar $ map (preprocessProduction) productions where
24		preprocessProduction p@Production{ constituents=c } = p { constituents=preprocessExpr c }
25		preprocessExpr = eliminateSingleAlts . coalesceConstraints
	24	preprocessGrammarForParsing :: Grammar -> Bool -> Grammar
	25	preprocessGrammarForParsing g True = preprocessGrammarForParsing (extractLoops g) False
	26	preprocessGrammarForParsing (Grammar productions) False =
	27	Grammar $ map (preprocessProduction) productions where
	28	preprocessProduction p@Production{ constituents=c } = p { constituents=preprocessExpr c }
	29	preprocessExpr = eliminateSingleAlts . coalesceConstraints
26	30
27	31
28	32	--

-7

src/Main.hs less more

18	18	dumpState :: Bool,
19	19	startSymbol :: Maybe String,
20	20	suppressNewline :: Bool,
	21	convertLoops :: Bool,
21	22	seed :: Int
22	23	} deriving (Show, Ord, Eq)
23	24

25	26	dumpState = False,
26	27	startSymbol = Nothing,
27	28	suppressNewline = False,
	29	convertLoops = False,
28	30	seed = 0
29	31	}
30	32

34	36	parseFlags flags{ startSymbol = Just s } rest
35	37	parseFlags flags ("--suppress-newline":rest) =
36	38	parseFlags flags{ suppressNewline = True } rest
	39	parseFlags flags ("--convert-loops":rest) =
	40	parseFlags flags{ convertLoops = True } rest
37	41	parseFlags flags ("--seed":seedStr:rest) =
38	42	parseFlags flags{ seed = (read seedStr) :: Int } rest
39	43	parseFlags flags other = (flags, other)

56	60	output $ Grammar.depictGrammar grammar
57	61	["preprocess", grammarFileName] -> do
58	62	grammar <- loadSource grammarFileName
59		let grammar' = Preprocessor.preprocessGrammarForGeneration grammar
	63	let grammar' = Preprocessor.preprocessGrammarForGeneration grammar (convertLoops flags)
60	64	-- TODO: add flag to show internal format
61	65	output $ Grammar.depictGrammar grammar'
62		["extractloops", grammarFileName] -> do
63		grammar <- loadSource grammarFileName
64		let grammar' = Preprocessor.extractLoops grammar
65		putStrLn $ Grammar.depictGrammar grammar'
66	66	("parse":grammarFileName:textFileName:initialParams) -> do
67	67	grammar <- loadSource grammarFileName
68		let grammar' = Preprocessor.preprocessGrammarForParsing grammar
	68	let grammar' = Preprocessor.preprocessGrammarForParsing grammar (convertLoops flags)
69	69	text <- loadText textFileName
70	70	let start = getStartSymbol grammar' flags
71	71	let initialState = Parser.constructState grammar' start text initialParams

74	74	exitWith $ either (\_msg -> ExitFailure 1) (\_remaining -> ExitSuccess) $ Parser.obtainResult finalState
75	75	("generate":grammarFileName:initialParams) -> do
76	76	grammar <- loadSource grammarFileName
77		let grammar' = Preprocessor.preprocessGrammarForGeneration grammar
	77	let grammar' = Preprocessor.preprocessGrammarForGeneration grammar (convertLoops flags)
78	78	let start = getStartSymbol grammar' flags
79	79	let initialState = Generator.constructState grammar' start (seed flags) initialParams
80	80	let finalState = Generator.generateFrom grammar' start initialState