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.

1 files changed, 19 insertions, 23 deletions

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
-