GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-30 23:02:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

new-comp: delay eta expansion until just before partial evaluation

Browse Source 
This seems to work for the most part, but a problem showed up in WordsCat.gf in
the phrasebook.
This commit is contained in:
hallgren
2013-05-30 16:01:12 +00:00
parent 1846e6bf65
commit 72fd7e821f
2 changed files with 25 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -73,8 +73,7 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont
pargs = [protoFCat gr (snd $ catSkeleton ty) lincat | ((_,_,ty),(_,_,lincat)) <- zip ctxt cont]
pmcfgEnv0 = emptyPMCFGEnv
b <- convert opts gr cenv (floc opath loc id) term val pargs
b <- convert opts gr cenv (floc opath loc id) term (cont,val) pargs
let (seqs1,b1) = addSequencesB seqs b
pmcfgEnv1 = foldBM addRule
pmcfgEnv0
@@ -106,8 +105,8 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ linc
parg = protoFCat gr (identW,cVar) typeStr
pmcfgEnv0 = emptyPMCFGEnv
b <- convert opts gr cenv (floc opath loc id) term lincat [parg]
lincont = [(Explicit, varStr, typeStr)]
b <- convert opts gr cenv (floc opath loc id) term (lincont,lincat) [parg]
let (seqs1,b1) = addSequencesB seqs b
pmcfgEnv1 = foldBM addRule
pmcfgEnv0
@@ -126,7 +125,7 @@ addPMCFG opts gr cenv opath am cm seqs id info = return (seqs, info)
floc opath loc id = maybe (L loc id) (\path->L (External path loc) id) opath
convert opts gr cenv loc term val pargs =
convert opts gr cenv loc term ty@(_,val) pargs =
case term' of
Error s -> fail $ render $ ppL loc (text $ "Predef.error: "++s)
_ -> return $ runCnvMonad gr (conv term') (pargs,[])
@@ -134,9 +133,16 @@ convert opts gr cenv loc term val pargs =
conv t = convertTerm opts CNil val =<< unfactor t
term' = if flag optNewComp opts
then normalForm cenv loc (recordExpand val term) -- new evaluator
then normalForm cenv loc (expand ty term) -- new evaluator
else term -- old evaluator is invoked from GF.Compile.Optimize
expand ty@(context,val) = recordExpand val . etaExpand ty
etaExpand (context,val) = mkAbs pars . flip mkApp args
where pars = [(Explicit,v) | v <- vars]
args = map Vr vars
vars = map (\(bt,x,t) -> x) context
recordExpand :: Type -> Term -> Term
recordExpand typ trm =
case typ of