Commment code and options relating to the old partial evaluator

This means that the -old-comp and -new-comp flags are not recognized anymore.

The only functional difference is that printnames were still normalized with
the old partial evaluator. Now that is done with the new partial evaluator.

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
-