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

1 files changed, 18 insertions, 16 deletions

diff --git a/src/GF/CFGM/PrintCFG.hs b/src/GF/CFGM/PrintCFG.hs
index db3ae74a4..7310da562 100644
--- a/src/GF/CFGM/PrintCFG.hs
+++ b/src/GF/CFGM/PrintCFG.hs
@@ -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])