diff options
Diffstat (limited to 'src/compiler/GF/Grammar')
| -rw-r--r-- | src/compiler/GF/Grammar/Canonical.hs | 37 |
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) |