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

More work on the new partial evaluator

Browse Source 
The work done by the partial evaluator is now divied in two stages:
 - A static "term traversal" stage that happens only once per term and uses
   only statically known information. In particular, the values of lambda bound
   variables are unknown during this stage. Some tables are transformed to
   reduce the cost of pattern matching.
 - A dynamic "function application" stage, where function bodies can be
   evaluated repeatedly with different arguments, without the term traversal
   overhead and without recomputing statically known information.

Also the treatment of predefined functions has been reworked to take advantage
of the staging and better handle partial applications.
This commit is contained in:
hallgren
2012-12-14 14:00:21 +00:00
parent f7a5eb0df1
commit d7e3c869c2
6 changed files with 320 additions and 175 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -66,13 +66,13 @@ mapAccumWithKeyM f a m = do let xs = Map.toAscList m
addPMCFG :: Options -> SourceGrammar -> GlobalEnv -> Ident -> Ident -> SeqSet -> Ident -> Info -> IO (SeqSet, Info)
addPMCFG opts gr cenv am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin@(Just (L _ term)) mprn Nothing) = do
addPMCFG opts gr cenv am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin@(Just (L loc term)) mprn Nothing) = do
let pres = protoFCat gr res val
pargs = [protoFCat gr (snd $ catSkeleton ty) lincat | ((_,_,ty),(_,_,lincat)) <- zip ctxt cont]
pmcfgEnv0 = emptyPMCFGEnv
b = convert opts gr cenv term val pargs
b = convert opts gr cenv (L loc id) term val pargs
(seqs1,b1) = addSequencesB seqs b
pmcfgEnv1 = foldBM addRule
pmcfgEnv0
@@ -99,13 +99,13 @@ addPMCFG opts gr cenv am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val))
newArgs = map getFIds newArgs'
in addFunction env0 newCat fun newArgs
addPMCFG opts gr cenv am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat)) mdef@(Just (L _ term)) mprn Nothing) = do
addPMCFG opts gr cenv am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat)) mdef@(Just (L loc term)) mprn Nothing) = do
let pres = protoFCat gr (am,id) lincat
parg = protoFCat gr (identW,cVar) typeStr
pmcfgEnv0 = emptyPMCFGEnv
b = convert opts gr cenv term lincat [parg]
b = convert opts gr cenv (L loc id) term lincat [parg]
(seqs1,b1) = addSequencesB seqs b
pmcfgEnv1 = foldBM addRule
pmcfgEnv0
@@ -122,12 +122,12 @@ addPMCFG opts gr cenv am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat)) m
addPMCFG opts gr cenv am cm seqs id info = return (seqs, info)
convert opts gr cenv term val pargs =
convert opts gr cenv loc term val pargs =
runCnvMonad gr conv (pargs,[])
where
conv = convertTerm opts CNil val =<< unfactor cenv term'
conv = convertTerm opts CNil val =<< unfactor term'
term' = if flag optNewComp opts
then normalForm cenv (recordExpand val term) -- new evaluator
then normalForm cenv loc (recordExpand val term) -- new evaluator
else term -- old evaluator is invoked from GF.Compile.Optimize
recordExpand :: Type -> Term -> Term
@@ -143,8 +143,8 @@ recordExpand typ trm =
_ -> R [assign lab (P trm lab) | (lab,_) <- tys]
_ -> trm
unfactor :: GlobalEnv -> Term -> CnvMonad Term
unfactor cenv t = CM (\gr c -> c (unfac gr t))
unfactor :: Term -> CnvMonad Term
unfactor t = CM (\gr c -> c (unfac gr t))
where
unfac gr t =
case t of