summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile/GeneratePMCFG.hs
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2012-12-14 14:00:21 +0000
committerhallgren <hallgren@chalmers.se>2012-12-14 14:00:21 +0000
commitd7e3c869c2ae56141260d4576b439097e8271383 (patch)
tree0cb042a0289cb3eac2fa6e5cf87b06894d4f628b /src/compiler/GF/Compile/GeneratePMCFG.hs
parentf7a5eb0df10f3cfef6e3d4c70c4714008c50bbe8 (diff)
More work on the new partial evaluator
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.
Diffstat (limited to 'src/compiler/GF/Compile/GeneratePMCFG.hs')
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs18
1 files changed, 9 insertions, 9 deletions
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index bae883da5..f733f5a0a 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -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