summaryrefslogtreecommitdiff
path: root/src/compiler/GF
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF')
-rw-r--r--src/compiler/GF/Grammar/Grammar.hs18
-rw-r--r--src/compiler/GF/Grammar/Printer.hs4
2 files changed, 22 insertions, 0 deletions
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index 0234bdcb8..2c84351af 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -16,6 +16,7 @@
module GF.Grammar.Grammar (SourceGrammar,
emptySourceGrammar,mGrammar,
+ stripSourceGrammar,
SourceModInfo,
SourceModule,
mapSourceModule,
@@ -239,3 +240,20 @@ ident2label c = LIdent (ident2bs c)
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 3319f86e8..fc9d31802 100644
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -10,6 +10,7 @@
module GF.Grammar.Printer
( TermPrintQual(..)
, ppLabel
+ , ppGrammar
, ppModule
, ppJudgement
, ppTerm
@@ -33,6 +34,9 @@ import qualified Data.Map as Map
data TermPrintQual = Qualified | Unqualified
+ppGrammar :: SourceGrammar -> Doc
+ppGrammar sgr = vcat $ map (ppModule Qualified) $ modules sgr
+
ppModule :: TermPrintQual -> SourceModule -> Doc
ppModule q (mn, ModInfo mtype mstat opts exts with opens _ jments) =
hdr $$ nest 2 (ppOptions opts $$ vcat (map (ppJudgement q) defs)) $$ ftr