Construct a grammar and return it
Chris Pressey
1 year, 1 month ago
| 8 | 8 |
Production(Production, ntname, params, backtrackMode, constituents),
|
| 9 | 9 |
Grammar(Grammar),
|
| 10 | 10 |
depictExpr, depictExprs, depictProduction, depictGrammar, depictVars,
|
| 11 | |
startSymbol, productionExpr, productionParams, getFormals,
|
|
11 |
startSymbol, productionExpr, productionParams, getFormals, mergeGrammars
|
| 12 | 12 |
) where
|
| 13 | 13 |
|
| 14 | 14 |
import Data.List (intercalate)
|
|
| 92 | 92 |
if nt == (ntname prod) then params prod else getFormals nt (Grammar rest)
|
| 93 | 93 |
getFormals nt (Grammar []) = error ("Production '" ++ nt ++ "' not found")
|
| 94 | 94 |
|
|
95 |
mergeGrammars :: Grammar -> Grammar -> Grammar
|
|
96 |
mergeGrammars (Grammar ps1) (Grammar ps2) = Grammar $ ps1 ++ ps2
|
| 140 | 140 |
ps' <- collectLoopsProductions ps
|
| 141 | 141 |
return $ Grammar ps'
|
| 142 | 142 |
|
| 143 | |
extractLoops :: Grammar -> (Grammar, (Integer, CollectedLoops))
|
| 144 | |
extractLoops g = runState (collectLoopsGrammar g) (0, [])
|
|
143 |
extractLoops :: Grammar -> Grammar
|
|
144 |
extractLoops g =
|
|
145 |
let
|
|
146 |
(g', (_count, loops)) = runState (collectLoopsGrammar g) (0, [])
|
|
147 |
loopsG = loops2grammar loops
|
|
148 |
g'' = mergeGrammars g' loopsG
|
|
149 |
in
|
|
150 |
g''
|
|
151 |
where
|
|
152 |
loops2grammar loops = Grammar $ map (loop2production) loops
|
|
153 |
loop2production (name, expr) =
|
|
154 |
Production{
|
|
155 |
ntname=name,
|
|
156 |
params=[], -- FIXME collect and retain them
|
|
157 |
backtrackMode=Nothing,
|
|
158 |
constituents=expr -- FIXME transform it
|
|
159 |
}
|
| 2 | 2 |
-- SPDX-License-Identifier: LicenseRef-BSD-2-Clause-X-Fountain
|
| 3 | 3 |
|
| 4 | 4 |
module Main (main) where
|
| 5 | |
|
| 6 | |
import Data.List (intercalate)
|
| 7 | 5 |
|
| 8 | 6 |
import System.Environment
|
| 9 | 7 |
import System.Exit
|
|
| 61 | 59 |
output $ Grammar.depictGrammar grammar'
|
| 62 | 60 |
["extractloops", grammarFileName] -> do
|
| 63 | 61 |
grammar <- loadSource grammarFileName
|
| 64 | |
let (grammar', (_count, loops)) = Preprocessor.extractLoops grammar
|
|
62 |
let grammar' = Preprocessor.extractLoops grammar
|
| 65 | 63 |
putStrLn $ Grammar.depictGrammar grammar'
|
| 66 | |
let depictPair = \(name, expr) -> name ++ ":" ++ Grammar.depictExpr expr
|
| 67 | |
let depictPairs = \pairs -> (intercalate ", " (map (depictPair) pairs))
|
| 68 | |
putStrLn $ depictPairs loops
|
| 69 | 64 |
("parse":grammarFileName:textFileName:initialParams) -> do
|
| 70 | 65 |
grammar <- loadSource grammarFileName
|
| 71 | 66 |
let grammar' = Preprocessor.preprocessGrammarForParsing grammar
|