From d7e3c869c2ae56141260d4576b439097e8271383 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Fri, 14 Dec 2012 14:00:21 +0000
Subject: 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.
---
 src/compiler/GF/Compile/GeneratePMCFG.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

(limited to 'src/compiler/GF/Compile/GeneratePMCFG.hs')

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
-- 
cgit v1.2.3