optimization flags and improver eng

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 = []
+shareOpt = []
-fullOpt = [2]
+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, CncCat ty t m) = (c, CncCat ty (shareOptim opt t) m)
-shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOpt 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
+shareOptim :: OptSpec -> Term -> Term
-shareOpt opt 
+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

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 
+    case optim of
-    then shareModule fullOpt minfo0   -- parametrization and sharing
+      "parametrize" -> shareModule paramOpt minfo0  -- parametrization and sharing
-    else if values                    
+      "values"      -> shareModule valOpt minfo0    -- tables as courses-of-values
-    then shareModule valOpt minfo0     -- tables as courses-of-values
+      "share"       -> shareModule shareOpt minfo0  -- sharing of branches
-    else shareModule basicOpt minfo0  -- sharing only
+      "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
 

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

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]
 

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"

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"
+  CImport _ -> both "old v s src retain nocf nocheckcirc cflexer noemit o"
-                    "abs cnc res path"
+                    "abs cnc res path optimize"
   CRemoveLanguage _ -> none
   CEmptyState -> none
   CStripState -> none

src/HelpFile

@@ -25,7 +25,6 @@ i,  import: i File
       -old          old: parse in GF<2.0 format (not necessary)
       -v            verbose: give lots of messages 
       -s            silent: don't give error messages
-      -opt          perform branch-sharing optimization
       -src          source: ignore precompiled gfc and gfr files
       -retain       retain operations: read resource modules (needed in comm cc) 
       -nocf         don't build context-free grammar (thus no parser)
@@ -38,6 +37,7 @@ i,  import: i File
       -cnc          set the name used for concrete syntax (with -old option)
       -res          set the name used for resource (with -old option)
       -path         use the (colon-separated) search path to find modules
+      -optimize     select an optimization to override file-defined flags
   examples:
       i English.gf                      -- ordinary import of Concrete
       i -retain german/ParadigmsGer.gf  -- import of Resource to test
@@ -427,6 +427,15 @@ q, quit: q
 -number, the maximum number of generated items in a list. 
        The default is unlimited.
 
+-optimize, optimization on generated code.
+       The default is share.
+    -optimize=share        share common branches in tables
+    -optimize=parametrize  first try parametrize then do share with the rest
+    -optimize=values       represent tables as courses-of-values
+    -optimize=all          first try parametrize then do values with the rest
+    -optimize=none         no optimization
+
+
 -parser, Context-free    parsing algorithm. The default is chart.
     -parser=earley       Earley algorithm
     -parser=chart        bottom-up chart parser

src/HelpFile.hs

@@ -1,17 +1,18 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : HelpFile
--- Maintainer  : (Maintainer)
+-- Maintainer  : Aarne Ranta
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date $ 
+-- > CVS $Date $
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Help on shell commands. Generated from HelpFile by 'make help'.
 -----------------------------------------------------------------------------
 
+
 module HelpFile where
 
 import Operations
@@ -52,7 +53,6 @@ txtHelpFile =
   "\n      -old          old: parse in GF<2.0 format (not necessary)" ++
   "\n      -v            verbose: give lots of messages " ++
   "\n      -s            silent: don't give error messages" ++
-  "\n      -opt          perform branch-sharing optimization" ++
   "\n      -src          source: ignore precompiled gfc and gfr files" ++
   "\n      -retain       retain operations: read resource modules (needed in comm cc) " ++
   "\n      -nocf         don't build context-free grammar (thus no parser)" ++
@@ -65,6 +65,7 @@ txtHelpFile =
   "\n      -cnc          set the name used for concrete syntax (with -old option)" ++
   "\n      -res          set the name used for resource (with -old option)" ++
   "\n      -path         use the (colon-separated) search path to find modules" ++
+  "\n      -optimize     select an optimization to override file-defined flags" ++
   "\n  examples:" ++
   "\n      i English.gf                      -- ordinary import of Concrete" ++
   "\n      i -retain german/ParadigmsGer.gf  -- import of Resource to test" ++
@@ -454,6 +455,15 @@ txtHelpFile =
   "\n-number, the maximum number of generated items in a list. " ++
   "\n       The default is unlimited." ++
   "\n" ++
+  "\n-optimize, optimization on generated code." ++
+  "\n       The default is share." ++
+  "\n    -optimize=share        share common branches in tables" ++
+  "\n    -optimize=parametrize  first try parametrize then do share with the rest" ++
+  "\n    -optimize=values       represent tables as courses-of-values" ++
+  "\n    -optimize=all          first try parametrize then do values with the rest" ++
+  "\n    -optimize=none         no optimization" ++
+  "\n" ++
+  "\n" ++
   "\n-parser, Context-free    parsing algorithm. The default is chart." ++
   "\n    -parser=earley       Earley algorithm" ++
   "\n    -parser=chart        bottom-up chart parser" ++

src/tools/MkHelpFile.hs

@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Compile HelpFile.hs from HelpFile.
 -----------------------------------------------------------------------------
 
 module Main where
@@ -20,6 +20,7 @@ main = do
   writeFile "HelpFile.hs" s'
 
 mkHsFile ss =
+  helpHeader ++
   "module HelpFile where\n\n" ++
   "import Operations\n\n" ++
   "txtHelpFileSummary =\n" ++
@@ -39,3 +40,21 @@ mkOne s = "  \"" ++ pref s ++ (escs s) ++ "\" ++"
    escs [] = []
    escs (c:cs) | elem c "\"\\" = '\\':c:escs cs
    escs (c:cs) = c:escs cs
+
+helpHeader = unlines [
+  "----------------------------------------------------------------------",
+  "-- |",
+  "-- Module      : HelpFile",
+  "-- Maintainer  : Aarne Ranta",
+  "-- Stability   : (stable)",
+  "-- Portability : (portable)",
+  "--",
+  "-- > CVS $Date $", 
+  "-- > CVS $Author $",
+  "-- > CVS $Revision $",
+  "--",
+  "-- Help on shell commands. Generated from HelpFile by 'make help'.",
+  "-----------------------------------------------------------------------------",
+  "",
+  ""
+  ]