More work on the canonica_gf export

+ Abstract syntax now is converted directly from the Grammar and not via PGF,
  so you can use `gf -batch -no-pmcfg -f canonical_gf ...`, to export to
  canonical_gf while skipping PMCFG and PGF file generation completely.
+ Flags that are normally copied to PGF files are now included in the
  caninical_gf output as well (in particular the startcat flag).

1 files changed, 28 insertions, 9 deletions

diff --git a/src/compiler/GF/Grammar/Canonical.hs b/src/compiler/GF/Grammar/Canonical.hs
index 8d61a8a53..6d08b815f 100644
--- a/src/compiler/GF/Grammar/Canonical.hs
+++ b/src/compiler/GF/Grammar/Canonical.hs
@@ -1,6 +1,7 @@
 -- | Abstract syntax for canonical GF grammars, i.e. what's left after
 -- high-level constructions such as functors and opers have been eliminated
--- by partial evaluation.
+-- by partial evaluation. This is intended as a common intermediate
+-- representation to simplify export to other formats.
 module GF.Grammar.Canonical where
 import Prelude hiding ((<>))
 import GF.Text.Pretty
@@ -12,7 +13,7 @@ data Grammar = Grammar Abstract [Concrete] deriving Show
 -- ** Abstract Syntax
 
 -- | Abstract Syntax
-data Abstract = Abstract ModId [CatDef] [FunDef] deriving Show
+data Abstract = Abstract ModId Flags [CatDef] [FunDef] deriving Show
 
 data CatDef   = CatDef CatId [CatId]        deriving Show
 data FunDef   = FunDef FunId Type           deriving Show
@@ -25,8 +26,9 @@ data TypeBinding = TypeBinding VarId Type   deriving Show
 -- ** Concreate syntax
 
 -- | Concrete Syntax
-data Concrete  = Concrete ModId ModId [ParamDef] [LincatDef] [LinDef]
+data Concrete  = Concrete ModId ModId Flags [ParamDef] [LincatDef] [LinDef]
                  deriving Show
+concName (Concrete cnc _ _ _ _ _) = cnc
 
 data ParamDef  = ParamDef ParamId [ParamValueDef]
                | ParamAliasDef ParamId LinType
@@ -99,6 +101,10 @@ newtype FunId = FunId String  deriving (Eq,Show)
 
 data VarId = Anonymous | VarId String  deriving Show
 
+newtype Flags = Flags [(FlagName,FlagValue)] deriving Show
+type FlagName = String
+data FlagValue = Str String | Int Int | Flt Double deriving Show
+
 --------------------------------------------------------------------------------
 -- ** Pretty printing
 
@@ -106,10 +112,12 @@ instance Pretty Grammar where
   pp (Grammar abs cncs) = abs $+$ vcat cncs
 
 instance Pretty Abstract where
-  pp (Abstract m cats funs) = "abstract" <+> m <+> "=" <+> "{" $$
-                              "cat" <+> fsep cats $$
-                              "fun" <+> vcat funs $$
-                              "}"
+  pp (Abstract m flags cats funs) =
+    "abstract" <+> m <+> "=" <+> "{" $$
+       flags $$
+       "cat" <+> fsep cats $$
+       "fun" <+> vcat funs $$
+       "}"
 
 instance Pretty CatDef where
   pp (CatDef c cs) = hsep (c:cs)<>";"
@@ -139,7 +147,7 @@ instance Pretty VarId where
 --------------------------------------------------------------------------------
 
 instance Pretty Concrete where
-  pp (Concrete cncid absid params lincats lins) =
+  pp (Concrete cncid absid flags params lincats lins) =
       "concrete" <+> cncid <+> "of" <+> absid <+> "=" <+> "{" $$
       vcat params $$
       section "lincat" lincats $$
@@ -241,6 +249,17 @@ instance Pretty ParamId where pp = ppA
 instance PPA    ParamId where ppA (ParamId s) = pp s
 instance Pretty VarValueId where pp (VarValueId s) = pp s
 
+instance Pretty Flags where
+  pp (Flags []) = empty
+  pp (Flags flags) = "flags" <+> vcat (map ppFlag flags)
+    where
+      ppFlag (name,value) = name <+> "=" <+> value <>";"
+
+instance Pretty FlagValue where
+  pp (Str s) = pp s
+  pp (Int i) = pp i
+  pp (Flt d) = pp d
+
 --------------------------------------------------------------------------------
 -- | Pretty print atomically (i.e. wrap it in parentheses if necessary)
 class Pretty a => PPA a where ppA :: a -> Doc
@@ -248,4 +267,4 @@ class Pretty a => PPA a where ppA :: a -> Doc
 class Pretty rhs => RhsSeparator rhs where rhsSep :: rhs -> Doc
 
 semiSep xs = punctuate ";" xs
-block xs = braces (semiSep xs)
\ No newline at end of file
+block xs = braces (semiSep xs)