diff options
| author | hallgren <hallgren@chalmers.se> | 2012-12-14 14:00:21 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2012-12-14 14:00:21 +0000 |
| commit | d7e3c869c2ae56141260d4576b439097e8271383 (patch) | |
| tree | 0cb042a0289cb3eac2fa6e5cf87b06894d4f628b /src/compiler/GF/Compile/GeneratePMCFG.hs | |
| parent | f7a5eb0df10f3cfef6e3d4c70c4714008c50bbe8 (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.hs | 18 |
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 |
