optimization flags and improver eng

6 files changed, 34 insertions, 22 deletions

diff --git a/src/GF/Canon/Share.hs b/src/GF/Canon/Share.hs
index 4e3c485a7..ff9be59b2 100644
--- a/src/GF/Canon/Share.hs
+++ b/src/GF/Canon/Share.hs
@@ -9,10 +9,10 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Optimizations on GFC code: sharing, parametrization, value sets.
 -----------------------------------------------------------------------------
 
-module Share (shareModule, OptSpec, basicOpt, fullOpt, valOpt) where
+module Share (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
 
 import AbsGFC
 import Ident
@@ -28,9 +28,10 @@ import qualified Modules as M
 type OptSpec = [Integer] ---
 doOptFactor opt = elem 2 opt
 doOptValues opt = elem 3 opt
-basicOpt = []
-fullOpt = [2]
+shareOpt = []
+paramOpt = [2]
 valOpt = [3]
+allOpt = [2,3]
 
 shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo)
 shareModule opt (i,m) = case m of
@@ -38,13 +39,14 @@ shareModule opt (i,m) = case m of
     (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
   _ -> (i,m)
 
-shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOpt opt t) m)
-shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOpt opt t) m)
+shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt t) m)
+shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt t) m)
 shareInfo _ i = i
 
 -- the function putting together optimizations
-shareOpt :: OptSpec -> Term -> Term
-shareOpt opt 
+shareOptim :: OptSpec -> Term -> Term
+shareOptim opt 
+  | doOptFactor opt && doOptValues opt = values . factor 0
   | doOptFactor opt = share . factor 0
   | doOptValues opt = values    
   | otherwise = share
@@ -133,5 +135,6 @@ replace old new trm = case trm of
 
 values :: Term -> Term
 values t = case t of
+  T ty [c] -> T ty [Cas p (values t) | Cas p t <- [c]] -- preserve parametrization
   T ty cs  -> V ty [values t | Cas _ t <- cs] -- assumes proper order
   _ -> C.composSafeOp values t
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index 2c8016a61..bfd8f64f2 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- The top-level compilation chain from source file to gfc/gfr.
 -----------------------------------------------------------------------------
 
 module Compile where
@@ -276,12 +276,16 @@ generateModuleCode :: Options -> InitPath -> SourceModule -> IOE GFC.CanonModule
 generateModuleCode opts path minfo@(name,info) = do
   let pname = prefixPathName path (prt name)
   minfo0     <- ioeErr $ redModInfo minfo
+  let oopts = addOptions opts (iOpts (flagsModule minfo))
+      optim = maybe "share" id $ getOptVal oopts useOptimizer
   minfo'     <- return $ 
-    if optim 
-    then shareModule fullOpt minfo0   -- parametrization and sharing
-    else if values                    
-    then shareModule valOpt minfo0     -- tables as courses-of-values
-    else shareModule basicOpt minfo0  -- sharing only
+    case optim of
+      "parametrize" -> shareModule paramOpt minfo0  -- parametrization and sharing
+      "values"      -> shareModule valOpt minfo0    -- tables as courses-of-values
+      "share"       -> shareModule shareOpt minfo0  -- sharing of branches
+      "all"         -> shareModule allOpt minfo0    -- first parametrize then values
+      "none"        -> minfo0                       -- no optimization
+      _             -> shareModule shareOpt minfo0  -- sharing; default
 
   -- for resource, also emit gfr
   case info of
@@ -305,8 +309,6 @@ generateModuleCode opts path minfo@(name,info) = do
      _ -> True
    nomulti = not $ oElem makeMulti opts
    emit  = oElem emitCode opts && not (oElem notEmitCode opts)
-   optim = oElem optimizeCanon opts
-   values = oElem optimizeValues opts
 
 -- for old GF: sort into modules, write files, compile as usual
 
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index 9d5b5114b..1cfb63be6 100644
--- a/src/GF/Grammar/Lookup.hs
+++ b/src/GF/Grammar/Lookup.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Lookup in source (concrete and resource) when compiling.
 -----------------------------------------------------------------------------
 
 module Lookup where
diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs
index 3da4bca9f..2f14095a9 100644
--- a/src/GF/Infra/Modules.hs
+++ b/src/GF/Infra/Modules.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Datastructures and functions for modules, common to GF and GFC.
 -----------------------------------------------------------------------------
 
 module Modules where
@@ -91,6 +91,11 @@ addOpenQualif :: i -> i -> Module i f t -> Module i f t
 addOpenQualif i j (Module mt ms fs me ops js) = 
   Module mt ms fs me (oQualif i j : ops) js
 
+flagsModule :: (i,ModInfo i f a) -> [f]
+flagsModule (_,mi) = case mi of
+  ModMod m -> flags m
+  _ -> []
+
 allFlags :: MGrammar i f a -> [f]
 allFlags gr = concat $ map flags $ reverse [m | (_, ModMod m) <- modules gr]
 
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index 4aab45d4d..4d3cf5393 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Options and flags used in GF shell commands and files.
 -----------------------------------------------------------------------------
 
 module Option where
@@ -224,6 +224,7 @@ useAbsName     = aOpt "abs"
 useCncName     = aOpt "cnc"
 useResName     = aOpt "res"
 useFile        = aOpt "file"
+useOptimizer   = aOpt "optimize"
 
 markLin        = aOpt "mark"
 markOptXML     = oArg "xml"
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index 58fc527bf..be1137440 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- The datatype of shell commands and the list of their options.
 -----------------------------------------------------------------------------
 
 module ShellCommands where
@@ -130,6 +130,7 @@ testValidFlag st co f x = case f of
   "transform" -> testInc customTermCommand
   "filter"  -> testInc customStringCommand
   "length"  -> testN
+  "optimize"-> testIn $ words "parametrize values all share none"
   _ -> return ()
  where
    testInc ci = 
@@ -148,8 +149,8 @@ testValidFlag st co f x = case f of
 
 optionsOfCommand :: Command -> ([String],[String])
 optionsOfCommand co = case co of
-  CImport _ -> both "old v s opt val src retain nocf nocheckcirc cflexer noemit o"
-                    "abs cnc res path"
+  CImport _ -> both "old v s src retain nocf nocheckcirc cflexer noemit o"
+                    "abs cnc res path optimize"
   CRemoveLanguage _ -> none
   CEmptyState -> none
   CStripState -> none