grammar printing options in gf3 and gfc

src/GF/Canon/CanonToGFCC.hs

@@ -70,7 +70,7 @@ normalize = share . unoptimizeCanon . Sub.unSubelimCanon where
 
 canon2gfcc :: CanonGrammar -> D.GFCC
 canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = 
-     D.GFCC an cns abs cncs 
+     D.GFCC an cns Map.empty abs cncs 
  where
   an  = (i2i a)
   cns = map (i2i . fst) cms
@@ -86,7 +86,7 @@ canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
     [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
 
   cncs  = Map.fromList [mkConcr (i2i lang) mo | (lang,M.ModMod mo) <- cms]
-  mkConcr lang mo = (lang,D.Concr flags lins opers lincats lindefs printnames)
+  mkConcr lang mo = (lang,D.Concr flags lins opers lincats lindefs printnames params)
     where
       flags   = Map.fromAscList [] ---- flags
       opers   = Map.fromAscList [] -- opers will be created as optimization
@@ -97,6 +97,7 @@ canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
       lindefs = Map.fromAscList 
         [(i2i c, mkTerm tr) | (c,GFC.CncCat _ tr _) <- tree2list (M.jments mo)]
       printnames = Map.fromAscList [] ---- printnames
+      params = Map.fromAscList [] ---- params
 
 i2i :: Ident -> C.CId
 i2i (IC c) = C.CId c

src/GF/Command/Commands.hs

@@ -15,6 +15,7 @@ import GF.Command.ParGFShell
 import GF.GFCC.ShowLinearize
 import GF.GFCC.API
 import GF.GFCC.Macros
+import GF.Devel.PrintGFCC
 import GF.GFCC.AbsGFCC ----
 
 import GF.Command.ErrM ----
@@ -79,7 +80,7 @@ valOpts flag def opts = case lookup flag flags of
 isOpt :: String -> [Option] -> Bool
 isOpt o opts = elem o [x | OOpt (Ident x) <- opts]
 
-
+-- this list must be kept sorted by the command name!
 allCommands :: MultiGrammar -> Map.Map String CommandInfo
 allCommands mgr = Map.fromAscList [
   ("gr", emptyCommandInfo {
@@ -109,6 +110,10 @@ allCommands mgr = Map.fromAscList [
   ("p", emptyCommandInfo {
      exec = \opts -> return . fromTrees . concatMap (par opts). toStrings,
      flags = ["cat","lang"]
+     }),
+  ("pg", emptyCommandInfo {
+     exec  = \opts _ -> return $ fromString $ prGrammar opts,
+     flags = ["cat","lang","printer"]
      })
   ]
  where
@@ -134,6 +139,11 @@ allCommands mgr = Map.fromAscList [
 
    fromTrees ts = (ts,unlines (map showTree ts))
    fromStrings ss = (map tStr ss, unlines ss)
+   fromString  s  = ([tStr s], s)
    toStrings ts = [s | DTr [] (AS s) [] <- ts] 
    tStr s = DTr [] (AS s) []
 
+   prGrammar opts = case valIdOpts "printer" "" opts of
+     "cats" -> unwords $ categories mgr
+     v -> prGFCC v gr 
+

src/GF/Devel/GFC.hs

@@ -1,8 +1,8 @@
 module Main where
 
 import GF.Devel.Compile
+import GF.Devel.PrintGFCC
 import GF.Devel.GrammarToGFCC
-import GF.Devel.GFCCtoJS
 import GF.GFCC.OptimizeGFCC
 import GF.GFCC.CheckGFCC
 import GF.GFCC.DataGFCC
@@ -26,12 +26,7 @@ main = do
       let target = abs ++ ".gfcc"
       writeFile target (printGFCC gc)
       putStrLn $ "wrote file " ++ target
-      if oElem (iOpt "js") opts 
+      mapM_ (alsoPrint opts abs gc) printOptions
-        then do
-          let js = abs ++ ".js"
-          writeFile js (gfcc2js gc)
-          putStrLn $ "wrote file " ++ js
-        else return ()
 
     -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
     _ | all ((=="gfcc") . fileSuffix) fs && oElem (iOpt "o") opts -> do
@@ -51,3 +46,18 @@ check gfcc = do
 
 file2gfcc f =
   readFileIf f >>= err (error) (return . mkGFCC) . pGrammar . myLexer
+
+
+---- TODO: nicer and richer print options
+
+alsoPrint opts abs gr (opt,suff) =
+      if oElem (iOpt opt) opts 
+        then do
+          let outfile = abs ++ "." ++ suff
+          let output = prGFCC opt gr
+          writeFile outfile output
+          putStrLn $ "wrote file " ++ outfile
+        else return ()
+
+printOptions = [("haskell","hs"),("haskell_gadt","hs"),("js","js")]
+

src/GF/Devel/PrintGFCC.hs

@@ -0,0 +1,14 @@
+module GF.Devel.PrintGFCC where
+
+import GF.GFCC.DataGFCC (GFCC,printGFCC)
+import GF.Devel.GFCCtoHaskell
+import GF.Devel.GFCCtoJS
+
+-- top-level access to code generation
+
+prGFCC :: String -> GFCC -> String
+prGFCC printer gr = case printer of
+  "haskell" -> grammar2haskell gr
+  "haskell_gadt" -> grammar2haskellGADT gr
+  "js" -> gfcc2js gr
+  _ -> printGFCC gr