diff --git a/src/compiler/GF/Grammar/Analyse.hs b/src/compiler/GF/Grammar/Analyse.hs new file mode 100644 index 000000000..ad538de87 --- /dev/null +++ b/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 + diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs index 2c84351af..686164539 100644 --- a/src/compiler/GF/Grammar/Grammar.hs +++ b/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 - diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs index fc9d31802..c4a449cd7 100644 --- a/src/compiler/GF/Grammar/Printer.hs +++ b/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')