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.

gf.cabal

@@ -49,9 +49,9 @@ flag server
   Description: Include --server mode
   Default:     True
 
-flag new-comp
+--flag new-comp
-  Description: Make -new-comp the default
+--  Description: Make -new-comp the default
-  Default:     True
+--  Default:     True
 
 flag custom-binary
   Description: Use a customised version of the binary package
@@ -137,8 +137,8 @@ Executable gf
     other-modules: GFServer
     hs-source-dirs: src/server src/server/transfer src/example-based
 
-  if flag(new-comp)
+--if flag(new-comp)
-    cpp-options: -DNEW_COMP
+--  cpp-options: -DNEW_COMP
 
   build-tools: happy, alex>=3
 
@@ -206,7 +206,7 @@ Executable gf
     GF.Compile.TypeCheck.ConcreteNew
     GF.Compile.TypeCheck.TC
     GF.Compile.Compute.Abstract
-    GF.Compile.Compute.Concrete
+--  GF.Compile.Compute.Concrete
     GF.Compile.Compute.ConcreteNew1
     GF.Compile.Compute.ConcreteNew
     GF.Compile.Compute.AppPredefined

src/compiler/GF/Compile/Compute/AppPredefined.hs

@@ -12,10 +12,10 @@
 -- Predefined function type signatures and definitions.
 -----------------------------------------------------------------------------
 
-module GF.Compile.Compute.AppPredefined (
+module GF.Compile.Compute.AppPredefined ({-
-          isInPredefined, typPredefined, arrityPredefined, predefModInfo, 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)
+-}

src/compiler/GF/Compile/Compute/Concrete.hs

@@ -1,3 +1,3 @@
-module GF.Compile.Compute.Concrete(module M) where
+module GF.Compile.Compute.Concrete{-(module M)-} where
-import GF.Compile.Compute.ConcreteLazy as M -- New
+--import GF.Compile.Compute.ConcreteLazy as M -- New
 --import GF.Compile.Compute.ConcreteStrict as M -- Old, inefficient

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
+module GF.Compile.Compute.ConcreteLazy ({-computeConcrete, computeTerm,checkPredefError-}) where
-
+{-
-import GF.Data.Operations
 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)
 -}
+-}

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
+    term' = {-if flag optNewComp opts
-            then normalForm cenv loc (expand ty term) -- new evaluator
+            then-} normalForm cenv loc (expand ty term) -- new evaluator
-            else term -- old evaluator is invoked from GF.Compile.Optimize
+            --else term -- old evaluator is invoked from GF.Compile.Optimize
 
 expand ty@(context,val) = recordExpand val . etaExpand ty
 

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 :: Options -> GlobalEnv -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
-evalInfo opts sgr m c info = do
+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
+partEval opts = {-if flag optNewComp opts
-                then partEvalNew opts
+                then-} partEvalNew opts
-                else partEvalOld 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 :: GlobalEnv -> Ident -> L Term -> L Term
-evalPrintname gr mpr =
+evalPrintname resenv c (L loc pr) = L loc (normalForm resenv (L loc c) pr)
-  case mpr of
-    Just (L loc pr) -> do pr <- computeConcrete gr pr
-                          return (Just (L loc pr))
-    Nothing         -> return Nothing
 
 -- 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
-

src/compiler/GF/Infra/Option.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+-- LANGUAGE CPP
 module GF.Infra.Option
     (
      -- * Option types
@@ -173,8 +173,8 @@ data Flags = Flags {
       optTagsOnly        :: Bool,
       optHeuristicFactor :: Maybe Double,
       optMetaProb        :: Maybe Double,
-      optMetaToknProb    :: Maybe Double,
+      optMetaToknProb    :: Maybe Double{-,
-      optNewComp         :: Bool
+      optNewComp         :: Bool-}
     }
   deriving (Show)
 
@@ -285,13 +285,14 @@ defaultFlags = Flags {
       optTagsOnly        = False,
       optHeuristicFactor = Nothing,
       optMetaProb        = Nothing,
-      optMetaToknProb    = Nothing,
+      optMetaToknProb    = Nothing{-,
       optNewComp         =
 #ifdef NEW_COMP
                            True
 #else
                            False
 #endif
+-}
     }
 
 -- | Option descriptions
@@ -374,8 +375,8 @@ optDescr =
      Option [] ["heuristic_search_factor"] (ReqArg (readDouble (\d o -> o { optHeuristicFactor = Just d })) "FACTOR") "Set the heuristic search factor for statistical parsing",
      Option [] ["meta_prob"] (ReqArg (readDouble (\d o -> o { optMetaProb = Just d })) "PROB") "Set the probability of introducting a meta variable in the parser",
      Option [] ["meta_token_prob"] (ReqArg (readDouble (\d o -> o { optMetaToknProb = Just d })) "PROB") "Set the probability for skipping a token in the parser",
-     Option [] ["new-comp"] (NoArg (set $ \o -> o{optNewComp = True})) "Use the new experimental compiler.",
+--     Option [] ["new-comp"] (NoArg (set $ \o -> o{optNewComp = True})) "Use the new experimental compiler.",
-     Option [] ["old-comp"] (NoArg (set $ \o -> o{optNewComp = False})) "Use old trusty compiler.",
+--     Option [] ["old-comp"] (NoArg (set $ \o -> o{optNewComp = False})) "Use old trusty compiler.",
      dumpOption "source" Source,
      dumpOption "rebuild" Rebuild,
      dumpOption "extend" Extend,

src/compiler/GFI.hs

@@ -15,7 +15,7 @@ import GF.Grammar.Parser (runP, pExp)
 import GF.Grammar.ShowTerm
 import GF.Grammar.Lookup (allOpers,allOpersTo)
 import GF.Compile.Rename(renameSourceTerm)
-import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError)
+--import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError)
 import qualified GF.Compile.Compute.ConcreteNew as CN(normalForm,resourceValues)
 import GF.Compile.TypeCheck.Concrete (inferLType,ppType)
 import GF.Infra.Dependencies(depGraph)
@@ -178,16 +178,17 @@ execute1 opts gfenv0 s0 =
         pOpts style q ("-qual"   :ws) = pOpts style            Qualified   ws
         pOpts style q             ws  = (style,q,unwords ws)
 
-        (style,q,s) = pOpts TermPrintDefault Qualified ws'
+        (style,q,s) = pOpts TermPrintDefault Qualified ws
+        {-
         (new,ws') = case ws of
                       "-new":ws' -> (True,ws')
                       "-old":ws' -> (False,ws')
                       _ -> (flag optNewComp opts,ws)
-
+        -}
       case runP pExp (UTF8.fromString s) of
         Left (_,msg) -> putStrLn msg
         Right t      -> putStrLn . err id (showTerm sgr style q)
-                                 . checkComputeTerm' new sgr
+                                 . checkComputeTerm sgr
                                  $ {-codeTerm (decodeUnicode utf8 . BS.pack)-} t
       continue gfenv
 
@@ -324,14 +325,13 @@ execute1 opts gfenv0 s0 =
 
 printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)
 
-checkComputeTerm = checkComputeTerm' False
+checkComputeTerm sgr t = do
-checkComputeTerm' new sgr t = do
                  mo <- maybe (raise "no source grammar in scope") return $ greatestResource sgr
                  ((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t
                                             inferLType sgr [] t
-                 t1 <- if new
+                 t1 <- {-if new
-                       then return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
+                       then-} return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
-                       else computeConcrete sgr t
+                       {-else computeConcrete sgr t-}
                  checkPredefError t1
 
 fetchCommand :: GFEnv -> IO String