msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Build cfgm files using the nondeterministic conversion. Allow coercions in cfgm rule functions and remove the name.

Browse Source
This commit is contained in:
bringert
2005-03-21 13:27:04 +00:00
parent 96a08c9df4
commit 75d228629a
9 changed files with 312 additions and 254 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
src/GF/CFGM/PrintCFG.hs
View File

@@ -1,4 +1,3 @@
module PrintCFG where
-- pretty-printer generated by the BNF converter
@@ -15,20 +14,22 @@ type Doc = [ShowS] -> [ShowS]
doc :: ShowS -> Doc
doc = (:)
-- seriously hacked spacing
render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of
";" :ts -> showString ";" . new i . rend i ts
-- H removed a bunch of cases here
"]":".":ts -> showString "]" . space "." . rend i ts -- H
t:t' :ts | noSpace t' -> showString t . showString t' . rend i ts -- H
t :ts | noSpace t -> showString t . rend i ts -- H
t :ts -> space t . rend i ts
_ -> id
"[" :ts -> showChar '[' . rend i ts
"(" :ts -> showChar '(' . rend i ts
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
"}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
"}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
";" :ts -> showChar ';' . new i . rend i ts
t : "," :ts -> showString t . space "," . rend i ts
t : ")" :ts -> showString t . showChar ')' . rend i ts
t : "]" :ts -> showString t . showChar ']' . rend i ts
t :ts -> space t . rend i ts
_ -> id
new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
space t = showString t . (\s -> if null s then "" else (' ':s))
noSpace t = t `elem` ["[","]","{","}",",","/",":",".","!"] -- H
parenth :: Doc -> Doc
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
@@ -111,12 +112,18 @@ instance Print Flag where
instance Print Rule where
prt i e = case e of
Rule id name profile category symbols -> prPrec i 0 (concatD [prt 0 id , doc (showString ":") , prt 0 name , prt 0 profile , doc (showString ".") , prt 0 category , doc (showString "->") , prt 0 symbols])
Rule fun profile category symbols -> prPrec i 0 (concatD [prt 0 fun , doc (showString ":") , prt 0 profile , doc (showString ".") , prt 0 category , doc (showString "->") , prt 0 symbols])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Fun where
prt i e = case e of
Cons id -> prPrec i 0 (concatD [prt 0 id])
Coerce -> prPrec i 0 (concatD [doc (showString "_")])
instance Print Profile where
prt i e = case e of
Profile intss -> prPrec i 0 (concatD [doc (showString "[") , prt 0 intss , doc (showString "]")])
@@ -141,11 +148,6 @@ instance Print Symbol where
[x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print Name where
prt i e = case e of
Name singlequotestring -> prPrec i 0 (concatD [prt 0 singlequotestring])
instance Print Category where
prt i e = case e of
Category singlequotestring -> prPrec i 0 (concatD [prt 0 singlequotestring])