summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/Compute/AppPredefined.hs7
-rw-r--r--src/compiler/GF/Compile/Compute/Concrete.hs4
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteLazy.hs7
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs6
-rw-r--r--src/compiler/GF/Compile/Optimize.hs42
5 files changed, 32 insertions, 34 deletions
diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs
index 6b125e001..2a1998283 100644
--- a/src/compiler/GF/Compile/Compute/AppPredefined.hs
+++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs
@@ -12,10 +12,10 @@
-- Predefined function type signatures and definitions.
-----------------------------------------------------------------------------
-module GF.Compile.Compute.AppPredefined (
- isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined
+module GF.Compile.Compute.AppPredefined ({-
+ isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined-}
) where
-
+{-
import GF.Compile.TypeCheck.Primitives
import GF.Infra.Option
import GF.Data.Operations
@@ -140,3 +140,4 @@ mapStr ty f t = case (ty,t) of
mapField (mty,te) = case mty of
Just ty -> (mty,mapStr ty f te)
_ -> (mty,te)
+-} \ No newline at end of file
diff --git a/src/compiler/GF/Compile/Compute/Concrete.hs b/src/compiler/GF/Compile/Compute/Concrete.hs
index f5a940022..f411f2ca0 100644
--- a/src/compiler/GF/Compile/Compute/Concrete.hs
+++ b/src/compiler/GF/Compile/Compute/Concrete.hs
@@ -1,3 +1,3 @@
-module GF.Compile.Compute.Concrete(module M) where
-import GF.Compile.Compute.ConcreteLazy as M -- New
+module GF.Compile.Compute.Concrete{-(module M)-} where
+--import GF.Compile.Compute.ConcreteLazy as M -- New
--import GF.Compile.Compute.ConcreteStrict as M -- Old, inefficient
diff --git a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
index 67d21768b..abfa93578 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
@@ -12,10 +12,10 @@
-- Computation of source terms. Used in compilation and in @cc@ command.
-----------------------------------------------------------------------------
-module GF.Compile.Compute.ConcreteLazy (computeConcrete, computeTerm,checkPredefError) where
-
-import GF.Data.Operations
+module GF.Compile.Compute.ConcreteLazy ({-computeConcrete, computeTerm,checkPredefError-}) where
+{-
import GF.Grammar.Grammar
+import GF.Data.Operations
import GF.Infra.Ident
--import GF.Infra.Option
import GF.Data.Str
@@ -528,3 +528,4 @@ checkPredefError sgr t = case t of
predef_error s = App (Q (cPredef,cError)) (K s)
-}
+-}
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 059038b6c..72e280b07 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -150,9 +150,9 @@ convert opts gr cenv loc term ty@(_,val) pargs =
where
conv t = convertTerm opts CNil val =<< unfactor t
- term' = if flag optNewComp opts
- then normalForm cenv loc (expand ty term) -- new evaluator
- else term -- old evaluator is invoked from GF.Compile.Optimize
+ term' = {-if flag optNewComp opts
+ 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
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index bd75cbc2c..9d15a9970 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -22,7 +22,8 @@ import GF.Grammar.Macros
import GF.Grammar.Lookup
import GF.Grammar.Predef
--import GF.Compile.Refresh
-import GF.Compile.Compute.Concrete
+--import GF.Compile.Compute.Concrete
+import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues)
--import GF.Compile.CheckGrammar
--import GF.Compile.Update
@@ -49,12 +50,14 @@ optimizeModule opts sgr m@(name,mi)
where
oopts = opts `addOptions` mflags mi
+ resenv = resourceValues sgr
+
updateEvalInfo mi (i,info) = do
- info <- evalInfo oopts sgr (name,mi) i info
+ info <- evalInfo oopts resenv sgr (name,mi) i info
return (mi{jments=updateTree (i,info) (jments mi)})
-evalInfo :: Options -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
-evalInfo opts sgr m c info = do
+evalInfo :: Options -> GlobalEnv -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
+evalInfo opts resenv sgr m c info = do
(if verbAtLeast opts Verbose then trace (" " ++ showIdent c) else id) return ()
@@ -81,7 +84,7 @@ evalInfo opts sgr m c info = do
return (Just (L loc (factor param c 0 re)))
_ -> return pre -- indirection
- ppr' <- evalPrintname gr ppr
+ let ppr' = fmap (evalPrintname resenv c) ppr
return (CncCat ptyp pde' pre' ppr' mpmcfg)
@@ -91,9 +94,9 @@ evalInfo opts sgr m c info = do
Just (L loc de) -> do de <- partEval opts gr (cont,val) de
return (Just (L loc (factor param c 0 de)))
Nothing -> return pde
- ppr' <- evalPrintname gr ppr
+ let ppr' = fmap (evalPrintname resenv c) ppr
return $ CncFun mt pde' ppr' mpmcfg -- only cat in type actually needed
-
+{-
ResOper pty pde
| not new && OptExpand `Set.member` optim -> do
pde' <- case pde of
@@ -101,10 +104,10 @@ evalInfo opts sgr m c info = do
return (Just (L loc (factor param c 0 de)))
Nothing -> return Nothing
return $ ResOper pty pde'
-
+-}
_ -> return info
where
- new = flag optNewComp opts -- computations moved to GF.Compile.GeneratePMCFG
+-- new = flag optNewComp opts -- computations moved to GF.Compile.GeneratePMCFG
gr = prependModule sgr m
optim = flag optOptimizations opts
@@ -113,14 +116,14 @@ evalInfo opts sgr m c info = do
-- | the main function for compiling linearizations
partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term
-partEval opts = if flag optNewComp opts
- then partEvalNew opts
- else partEvalOld opts
+partEval opts = {-if flag optNewComp opts
+ then-} partEvalNew opts
+ {-else partEvalOld opts-}
partEvalNew opts gr (context, val) trm =
errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $
checkPredefError trm
-
+{-
partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $ do
let vars = map (\(bt,x,t) -> x) context
args = map Vr vars
@@ -140,8 +143,6 @@ partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation
rightType _ = False
-
-
-- here we must be careful not to reduce
-- variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}}
-- {s = variants {"Auto" ; "Wagen"} ; g = variants {N ; M}} ;
@@ -153,7 +154,7 @@ recordExpand typ trm = case typ of
_ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys]
_ -> return trm
-
+-}
-- | auxiliaries for compiling the resource
mkLinDefault :: SourceGrammar -> Type -> Err Term
@@ -196,12 +197,8 @@ mkLinReference gr typ =
_ | Just _ <- isTypeInts typ -> Bad "no string"
_ -> Bad (render (text "linearization type field cannot be" <+> ppTerm Unqualified 0 typ))
-evalPrintname :: SourceGrammar -> Maybe (L Term) -> Err (Maybe (L Term))
-evalPrintname gr mpr =
- case mpr of
- Just (L loc pr) -> do pr <- computeConcrete gr pr
- return (Just (L loc pr))
- Nothing -> return Nothing
+evalPrintname :: GlobalEnv -> Ident -> L Term -> L Term
+evalPrintname resenv c (L loc pr) = L loc (normalForm resenv (L loc c) pr)
-- do even more: factor parametric branches
@@ -238,4 +235,3 @@ replace old new trm =
R _ | trm == old -> new
App x y -> App (replace old new x) (replace old new y)
_ -> composSafeOp (replace old new) trm
-
generated by cgit v1.2.3 (git 2.39.1) at 2026-06-06 23:52:18 +0000