CSEE now works fine

doc/gf-history.html

@@ -12,6 +12,32 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2
 
 </center>
 
+20/9 (AR) Added optimization by <b>common subexpression elimination</b>.
+It works on GFC modules and creates $oper$ definitions for
+subterms that occur more than once in $lin$ definitions. These
+$oper$ definitions are automatically reinlined in functionalities
+that don't support $oper$s in GFC. This conversion is done by
+module and the $oper$s are not inherited. Moreover, the subterms
+can contain free variables which means that the $oper$s are not
+always well typed. However, since all variables in GFC are type-specific
+(and local variables are $lin$-specific), this does not destroy
+subject reduction or cause illegal captures. 
+<br>
+The optimization is triggered by the flag <tt>optimize=OPT_subs</tt>,
+where <tt>OPT</tt> is any of the other optimizations (see <tt>h -optimize</tt>).
+The most aggressive value of the flag is <tt>all_subs</tt>. In experiments,
+the size of a GFC module can shrink by 80% compared to plain <tt>all</tt>.
+
+<p>
+
+15/9 (AR) Fixed some bugs in dependent-type type checking of abstract
+modules at compile time. The type checker is more severe now, which means
+that some old grammars may fail to compile - but this is usually the
+right result. However, the type checker of <tt>def</tt> judgements still
+needs work.
+
+<p>
+
 14/9 (AR) Added printing of grammars to a format without parameters, in
 the spirit of Peanos "Latino sine flexione". The command <tt>pg -unpar</tt>
 does the trick, and the result can be saved in a <tt>gfcm</tt> file. The generated

src/GF/Canon/Look.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/19 16:11:06 $ 
+-- > CVS $Date: 2005/09/20 09:32:56 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.16 $
+-- > CVS $Revision: 1.17 $
 --
 -- lookup in GFC. AR 2003
 -----------------------------------------------------------------------------
@@ -187,7 +187,7 @@ ccompute cnc = comp []
     _        -> return t  
    where
      compt = comp g xs
-     look c = lookupGlobal cnc c
+     look c = lookupGlobal cnc c >>= compt
 
      lookVar c co = case lookup c co of
        Just t -> return t

src/GF/Canon/Subexpressions.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/19 13:01:18 $ 
+-- > CVS $Date: 2005/09/20 09:32:56 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
 -- Common subexpression elimination.
 -- all tables. AR 18\/9\/2005.
@@ -80,11 +80,14 @@ unSubelimCanon gr@(M.MGrammar modules) =
  
 unSubelimModule :: CanonModule -> CanonModule
 unSubelimModule mo@(i,m) = case m of
-    M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) ->
+    M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) | hasSub ljs ->
       (i, M.ModMod (M.Module mt st fs me ops 
-                     (rebuild (map unparInfo (tree2list js)))))
+                     (rebuild (map unparInfo ljs)))) 
+                        where ljs = tree2list js
     _ -> (i,m)
   where
+    -- perform this iff the module has opers
+    hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
     unparInfo (c,info) = case info of
       CncFun k xs t m -> [(c, CncFun k xs (unparTerm t) m)]
       ResOper _ _ -> []

src/GF/Compile/Compile.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/19 13:01:18 $
+-- > CVS $Date: 2005/09/20 09:32:56 $
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.43 $
+-- > CVS $Revision: 1.44 $
 --
 -- The top-level compilation chain from source file to gfc\/gfr.
 -----------------------------------------------------------------------------
@@ -282,8 +282,10 @@ 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
+  let oopts  = addOptions opts (iOpts (flagsModule minfo))
+      optims = maybe "share" id $ getOptVal oopts useOptimizer
+      optim  = takeWhile (/='_') optims
+      subs   = drop 1 (dropWhile (/='_') optims) == "subs"
   minfo1     <- return $ 
     case optim of
       "parametrize" -> shareModule paramOpt minfo0  -- parametrization and sharing
@@ -295,7 +297,7 @@ generateModuleCode opts path minfo@(name,info) = do
 
   -- do common subexpression elimination if required by flag "subs"
   minfo' <- 
-    if oElem elimSubs opts
+    if subs
       then ioeErr $ elimSubtermsMod minfo1
       else return minfo1
 

src/GF/Compile/ShellState.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/18 22:55:46 $ 
+-- > CVS $Date: 2005/09/20 09:32:56 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.47 $
+-- > CVS $Revision: 1.48 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -186,8 +186,10 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
   let concrs = maybe [] (M.allConcretes cgr) abstr0
       concr0 = ifNull Nothing (return . head) concrs
       notInrts f = notElem f $ map fst rts
-      sub = if oElem elimSubs opts then unSubelimCanon else id
-  cfs <- mapM (canon2cf opts (sub cgr)) concrs --- why need to update all...
+      subcgr = unSubelimCanon cgr
+  cfs <- mapM (canon2cf opts subcgr) concrs --- why need to update all...
+
+  let morphos = map (mkMorpho subcgr) concrs
 
   let pinfosOld = map (CnvOld.pInfo opts cgr) concrs  -- peb 18/6 (OBSOLETE)
 
@@ -216,7 +218,7 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
     mcfgs      = zip concrs mcfgs,
     cfgs       = zip concrs cfgs,
     pInfos     = zip concrs pInfos,
-    morphos    = zip concrs (map (mkMorpho cgr) concrs),
+    morphos    = zip concrs morphos,
     gloptions  = gloptions sh, --- opts, -- this would be command-line options
     readFiles  = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
     absCats    = csi,

src/GF/Conversion/GFCtoSimple.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/08/08 08:09:49 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.13 $
+-- > CVS $Date: 2005/09/20 09:32:56 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.14 $
 --
 -- Converting GFC to SimpleGFC
 --
@@ -30,6 +30,7 @@ import GF.Conversion.Types
 import GF.UseGrammar.Linear (expandLinTables)
 import GF.Canon.GFC (CanonGrammar)
 import GF.Canon.MkGFC (grammar2canon)
+import GF.Canon.Subexpressions (unSubelimCanon)
 import qualified GF.Canon.Look as Look (lookupLin, allParamValues, lookupLincat)
 import qualified GF.Canon.CMacros as CMacros (defLinType)
 import GF.Data.Operations (err, errVal)
@@ -43,12 +44,13 @@ import GF.Infra.Print
 type Env = (CanonGrammar, I.Ident)
 
 convertGrammar :: Env -> SGrammar
-convertGrammar gram = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) $
-		      tracePrt "GFCtoSimple - simpleGFC rules" (prt . length) $
-		      [ convertAbsFun gram fun typing |
-			A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
-			A.AbsDFun fun typing _ <- defs ]
+convertGrammar (g,i) = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) $
+		        tracePrt "GFCtoSimple - simpleGFC rules" (prt . length) $
+		         [ convertAbsFun gram fun typing |
+			  A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
+			  A.AbsDFun fun typing _ <- defs ]
     where A.Gr modules = grammar2canon (fst gram)
+          gram = (unSubelimCanon g,i)
 
 convertAbsFun :: Env -> I.Ident -> A.Exp -> SRule
 convertAbsFun gram fun typing = Rule abs cnc

src/GF/Shell/HelpFile.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/14 16:26:22 $
+-- > CVS $Date: 2005/09/20 09:32:56 $
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.12 $
+-- > CVS $Revision: 1.13 $
 --
 -- Help on shell commands. Generated from HelpFile by 'make help'.
 -- PLEASE DON'T EDIT THIS FILE.
@@ -495,6 +495,10 @@ txtHelpFile =
   "\n" ++
   "\n-optimize, optimization on generated code." ++
   "\n       The default is share for concrete, none for resource modules." ++
+  "\n       Each of the flags can have the suffix _subs, which performs" ++
+  "\n       common subexpression elimination after the main optimization." ++
+  "\n       Thus, -optimize=all_subs is the most aggressive one." ++
+  "\n" ++
   "\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" ++

src/HelpFile

@@ -466,6 +466,10 @@ q, quit: q
 
 -optimize, optimization on generated code.
        The default is share for concrete, none for resource modules.
+       Each of the flags can have the suffix _subs, which performs
+       common subexpression elimination after the main optimization.
+       Thus, -optimize=all_subs is the most aggressive one.
+
     -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