module for analysing source grammars

src/compiler/GF/Grammar/Analyse.hs

@@ -0,0 +1,29 @@
+module GF.Grammar.Analyse (
+        stripSourceGrammar
+        ) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Option ---
+import GF.Infra.Modules
+
+import GF.Data.Operations
+
+import qualified Data.Map as Map
+
+
+stripSourceGrammar :: SourceGrammar -> SourceGrammar
+stripSourceGrammar sgr = mGrammar [(i, m{jments = Map.map stripInfo (jments m)}) | (i,m) <- modules sgr]
+
+stripInfo :: Info -> Info
+stripInfo i = case i of
+  AbsCat _ -> i
+  AbsFun mt mi me mb -> AbsFun mt mi Nothing mb
+  ResParam mp mt -> ResParam mp Nothing
+  ResValue lt -> i ----
+  ResOper mt md -> ResOper mt Nothing
+  ResOverload is fs -> ResOverload is [(lty, L loc (EInt 0)) | (lty,L loc _) <- fs]
+  CncCat mty mte mtf -> CncCat mty Nothing Nothing
+  CncFun mict mte mtf -> CncFun mict Nothing Nothing
+  AnyInd b f -> i
+

src/compiler/GF/Grammar/Grammar.hs

@@ -16,7 +16,6 @@
 
 module GF.Grammar.Grammar (SourceGrammar,
         emptySourceGrammar,mGrammar,
-        stripSourceGrammar,
         SourceModInfo,
         SourceModule,
         mapSourceModule,
@@ -241,19 +240,3 @@ label2ident :: Label -> Ident
 label2ident (LIdent s) = identC s
 label2ident (LVar i)   = identC (BS.pack ('$':show i))
 
-
-stripSourceGrammar :: SourceGrammar -> SourceGrammar
-stripSourceGrammar sgr = sgr --mGrammar [(i, m{jments = Map.map }) | (i,m) <- modules sgr]
-
-stripInfo :: Info -> Info
-stripInfo i = case i of
-  AbsCat _ -> i
-  AbsFun mt mi me mb -> AbsFun mt mi Nothing mb
-  ResParam mp mt -> ResParam mp Nothing
-  ResValue lt -> i ----
-  ResOper mt md -> ResOper mt Nothing
-  ResOverload is fs -> ResOverload is [(lty, L loc (EInt 0)) | (lty,L loc _) <- fs]
-  CncCat mty mte mtf -> CncCat mty Nothing Nothing
-  CncFun mict mte mtf -> CncFun mict Nothing Nothing
-  AnyInd b f -> i
-

src/compiler/GF/Grammar/Printer.hs

@@ -107,7 +107,7 @@ ppJudgement q (id, ResOper  ptype pexp) =
 ppJudgement q (id, ResOverload ids defs) =
   text "oper" <+> ppIdent id <+> equals <+> 
   (text "overload" <+> lbrace $$
-   nest 2 (vcat [ppIdent id <+> (colon <+> ppTerm q 0 ty $$ equals <+> ppTerm q 0 e) | (L _ ty,L _ e) <- defs]) $$
+   nest 2 (vcat [ppIdent id <+> (colon <+> ppTerm q 0 ty $$ equals <+> ppTerm q 0 e <+> semi) | (L _ ty,L _ e) <- defs]) $$
    rbrace) <+> semi
 ppJudgement q (id, CncCat  ptype pexp pprn) =
   (case ptype of
@@ -127,7 +127,7 @@ ppJudgement q (id, CncFun  ptype pdef pprn) =
   (case pprn of
      Just (L _ prn) -> text "printname" <+> text "fun" <+> ppIdent id <+> equals <+> ppTerm q 0 prn <+> semi
      Nothing        -> empty)
-ppJudgement q (id, AnyInd cann mid) = text "ind" <+> ppIdent id <+> equals <+> (if cann then text "canonical" else empty) <+> ppIdent mid <+> semi
+ppJudgement q (id, AnyInd cann mid) = text "-- ind" <+> ppIdent id <+> equals <+> (if cann then text "canonical" else empty) <+> ppIdent mid <+> semi
 
 ppTerm q d (Abs b v e)   = let (xs,e') = getAbs (Abs b v e)
                            in prec d 0 (char '\\' <> commaPunct ppBind xs <+> text "->" <+> ppTerm q 0 e')