summaryrefslogtreecommitdiff
path: root/src/GF/Compile/GrammarToGFCC.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-12-04 17:02:24 +0000
committeraarne <aarne@cs.chalmers.se>2008-12-04 17:02:24 +0000
commitd38f56b02557cdd26cd8a82f1f1d1dae61f47667 (patch)
tree5d2dc5cb661646b8f94e11b459d3aca9eb0d25a3 /src/GF/Compile/GrammarToGFCC.hs
parent896791e78cca4a21a5837ff2c971aaf0f84324b1 (diff)
fixed a Compute bug due to failure to match typed record values with untyped record patterns
Diffstat (limited to 'src/GF/Compile/GrammarToGFCC.hs')
-rw-r--r--src/GF/Compile/GrammarToGFCC.hs8
1 files changed, 4 insertions, 4 deletions
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs
index bb99d9d6c..539e5834c 100644
--- a/src/GF/Compile/GrammarToGFCC.hs
+++ b/src/GF/Compile/GrammarToGFCC.hs
@@ -38,7 +38,7 @@ traceD s t = t
-- the main function: generate PGF from GF.
mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.PGF)
mkCanon2gfcc opts cnc gr =
- (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr)
+ (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon opts abs) gr)
where
abs = err (const c) id $ M.abstractOfConcrete gr c where c = identC (BS.pack cnc)
pars = mkParamLincat gr
@@ -267,8 +267,8 @@ repartition abs cg =
-- translate tables and records to arrays, parameters and labels to indices
-canon2canon :: Ident -> SourceGrammar -> SourceGrammar
-canon2canon abs cg0 =
+canon2canon :: Options -> Ident -> SourceGrammar -> SourceGrammar
+canon2canon opts abs cg0 =
(recollect . map cl2cl . repartition abs . purgeGrammar abs) cg0
where
recollect = M.MGrammar . nubBy (\ (i,_) (j,_) -> i==j) . concatMap M.modules
@@ -281,7 +281,7 @@ canon2canon abs cg0 =
(c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 (M.jments mo))
_ -> (c,m)
j2j cg (f,j) =
- let debug = traceD ("+ " ++ prt f) in
+ let debug = if verbAtLeast opts Verbose then trace ("+ " ++ prt f) else id in
case j of
CncFun x (Yes tr) z -> CncFun x (Yes (debug (t2t tr))) z
CncCat (Yes ty) (Yes x) y -> CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y