diff --git a/examples/bronzeage/Makefile b/examples/bronzeage/Makefile index 5d4fd7acc..b0efea29f 100644 --- a/examples/bronzeage/Makefile +++ b/examples/bronzeage/Makefile @@ -5,10 +5,10 @@ all: magnet magnet: # gfc --make -src --parser=off --name=fre BronzeageFre.gf +RTS -K100M # gfc --make -src --erasing=on --name=bul BronzeageBul.gf - gfc --make -src --parser=off --name=fin BronzeageFin.gf +RTS -K100M + gfc --make -src --erasing=on --name=fin BronzeageFin.gf +RTS -K100M gfc --make -src --erasing=on --name=eng BronzeageEng.gf gfc --make -src --erasing=on --name=ger BronzeageGer.gf gfc --make -src --erasing=on --name=scand BronzeageNor.gf BronzeageSwe.gf - gfc --make -src --name=rom BronzeageIta.gf BronzeageSpa.gf - gfc --make --name=bronze eng.pgf fin.pgf ger.pgf rom.pgf scand.pgf + gfc --make -src --name=rom BronzeageIta.gf BronzeageSpa.gf BronzeageFre.gf + gfc --make --name=bronze eng.pgf fin.pgf ger.pgf rom.pgf scand.pgf diff --git a/src/GF/Compile/Compute.hs b/src/GF/Compile/Compute.hs index f35e7c6a9..3c7c061fc 100644 --- a/src/GF/Compile/Compute.hs +++ b/src/GF/Compile/Compute.hs @@ -33,6 +33,8 @@ import GF.Grammar.AppPredefined import Data.List (nub,intersperse) import Control.Monad (liftM2, liftM) +----import Debug.Trace ---- + -- | computation of concrete syntax terms into normal form -- used mainly for partial evaluation computeConcrete :: SourceGrammar -> Term -> Err Term @@ -309,7 +311,7 @@ computeTermOpt rec gr = comput True where -- course-of-values table: look up by index, no pattern matching needed V ptyp ts -> do vs <- allParamValues gr ptyp - case lookup v' (zip vs [0 .. length vs - 1]) of + case lookupR v' (zip vs [0 .. length vs - 1]) of Just i -> comp g $ ts !! i _ -> return $ S t' v' -- if v' is not canonical T _ cc -> case matchPattern cc v' of @@ -321,6 +323,13 @@ computeTermOpt rec gr = comput True where S (V i cs) e -> prawitzV g i (flip S v') cs e _ -> returnC $ S t' v' + --- needed to match records with and without type information + ---- todo: eliminate linear search in a list of records! + lookupR v vs = case v of + R rs -> lookup ([(x,y) | (x,(_,y)) <- rs]) + [([(x,y) | (x,(_,y)) <- rs],v) | (R rs,v) <- vs] + _ -> lookup v vs + -- case-expand tables -- if already expanded, don't expand again compTable g t = case t of 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