PMCFG pretty printer

src/GF/Command/Commands.hs

@@ -17,7 +17,7 @@ import PGF.Data ----
 import PGF.Morphology
 import PGF.VisualizeTree
 import GF.Compile.Export
-import GF.Infra.Option (noOptions)
+import GF.Infra.Option (noOptions, readOutputFormat)
 import GF.Infra.UseIO
 import GF.Data.ErrM ----
 import PGF.Expr (readTree)
@@ -376,7 +376,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        "N.B.2 This command is slightly obsolete: to produce different formats",
        "the batch compiler gfc is recommended, and has many more options."
        ],
-     exec  = \opts _ -> return $ fromString $ prGrammar opts,
+     exec  = \opts _ -> prGrammar opts,
      flags = [
        --"cat",
        ("lang",   "select languages for the some options (default all languages)"),
@@ -651,15 +651,13 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      [] -> (ts, "no trees found")
      _ -> fromTrees ts
 
-   prGrammar opts = case opts of
-     _ | isOpt "cats" opts -> unwords $ map showType $ categories pgf
-     _ | isOpt "fullform" opts -> concatMap 
-          (prFullFormLexicon . morpho) $ optLangs opts
-     _ | isOpt "missing" opts -> 
-           unlines $ [unwords (prCId la:":": map prCId cs) | 
-                       la <- optLangs opts, let cs = missingLins pgf la]
-     _ -> case valStrOpts "printer" "pgf" opts of
-       v -> concatMap snd $ exportPGF noOptions (read v) pgf
+   prGrammar opts
+     | isOpt "cats"     opts = return $ fromString $ unwords $ map showType $ categories pgf
+     | isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . morpho) $ optLangs opts
+     | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (prCId la:":": map prCId cs) | 
+                                                                  la <- optLangs opts, let cs = missingLins pgf la]
+     | otherwise             = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
+                                  return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf
 
    morphos opts s = 
      [lookupMorpho (morpho la) s | la <- optLangs opts]

src/GF/Compile/Export.hs

@@ -30,6 +30,7 @@ exportPGF :: Options
 exportPGF opts fmt pgf = 
     case fmt of
       FmtPGFPretty    -> multi "txt" prPGFPretty
+      FmtPMCFGPretty  -> single "pmcfg" prPMCFGPretty
       FmtJavaScript   -> multi "js"  pgf2js
       FmtHaskell      -> multi "hs"  (grammar2haskell opts name)
       FmtProlog       -> multi "pl"  grammar2prolog 

src/GF/Compile/PGFPretty.hs

@@ -1,10 +1,11 @@
 -- | Print a part of a PGF grammar on the human-readable format used in 
 -- the paper "PGF: A Portable Run-Time Format for Type-Theoretical Grammars".
-module GF.Compile.PGFPretty (prPGFPretty) where
+module GF.Compile.PGFPretty (prPGFPretty, prPMCFGPretty) where
 
 import PGF.CId
 import PGF.Data
 import PGF.Macros
+import PGF.PMCFG
 
 import GF.Data.Operations
 
@@ -16,6 +17,13 @@ import Text.PrettyPrint.HughesPJ
 prPGFPretty :: PGF -> String
 prPGFPretty pgf = render $ prAbs (abstract pgf) $$ prAll (prCnc (abstract pgf)) (concretes pgf)
 
+prPMCFGPretty :: PGF -> CId -> String
+prPMCFGPretty pgf lang = render $
+  case lookParser pgf lang of
+    Nothing    -> empty
+    Just pinfo -> text "language" <+> text (prCId lang) $$ ppPMCFG pinfo
+                                                   
+
 prAbs :: Abstr -> Doc
 prAbs a = prAll prCat (cats a) $$ prAll prFun (funs a)
 

src/GF/Infra/Option.hs

@@ -16,7 +16,7 @@ module GF.Infra.Option
      modifyFlags,
      helpMessage,
      -- * Checking specific options
-     flag, cfgTransform, haskellOption,
+     flag, cfgTransform, haskellOption, readOutputFormat,
      isLexicalCat,
      -- * Setting specific options
      setOptimization, setCFGTransform,
@@ -81,6 +81,7 @@ data Encoding = UTF_8 | ISO_8859_1 | CP_1251
   deriving (Eq,Ord)
 
 data OutputFormat = FmtPGFPretty
+                  | FmtPMCFGPretty
                   | FmtJavaScript 
                   | FmtHaskell 
                   | FmtProlog
@@ -427,7 +428,8 @@ optDescr =
 
 outputFormats :: [(String,OutputFormat)]
 outputFormats = 
-    [("pgf-pretty",   FmtPGFPretty),
+    [("pgf_pretty",   FmtPGFPretty),
+     ("pmcfg_pretty", FmtPMCFGPretty),
      ("js",           FmtJavaScript),
      ("haskell",      FmtHaskell),
      ("prolog",       FmtProlog),