blob: f27eddb1ab1a58a8b6f4fbe90b2d1582189e81b9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
-- Handles printing a CFGrammar in CFGM format.
module PrintCFGrammar (prCanonAsCFGM) where
import AbsGFC
import Ident
import GFC
import Modules
import qualified ConvertGrammar as Cnv
import qualified PrintParser as Prt
import ErrM
import List (intersperse)
import Maybe (listToMaybe, maybe)
-- FIXME: fix warning about bad -printer= value
prCanonAsCFGM :: CanonGrammar -> String
prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
where
cncs = maybe [] (allConcretes gr) (greatestAbstract gr)
cncms = map (\i -> (i,fromOk (lookupModule gr i))) cncs
fromOk (Ok x) = x
fromOk (Bad y) = error y
xs = [(i,getFlag fs "startcat") | (i,ModMod (Module{flags=fs})) <- cncms]
-- FIXME: need to look in abstract module too
getFlag :: [Flag] -> String -> Maybe String
getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
prLangAsCFGM gr i@(IC lang) start = (header . startcat . rules . footer) ""
where
header = showString "grammar " . showString lang . showString "\n"
startcat = maybe id (\s -> showString "startcat " . showString (s++"{}.s") . showString ";\n") start
rules0 = map Prt.prt $ Cnv.cfg $ Cnv.pInfo gr i
rules = showString $ concat $ map (\l -> init l++";\n") rules0
footer = showString "end grammar\n"
|
