dead code elimination for PGF. Note: the produced grammars will not work well with metavariables and high-order abstract syntax

4 files changed, 12 insertions, 3 deletions

diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index 1aebeaf31..bf872c138 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -41,6 +41,7 @@ import PGF.Check
 import PGF.CId
 import PGF.Data
 import PGF.Macros
+import PGF.Optimize
 
 
 -- | Compiles a number of source files and builds a 'PGF' structure for them.
@@ -60,7 +61,7 @@ link opts cnc gr = do
                         (True, True) -> ioeIO $ putStrLn "OK" 
                         (False,True) -> return ()
                         _            -> ioeIO $ putStrLn $ "Corrupted PGF"
-                      return gc
+                      return $ if flag optOptimizePGF opts then optimizePGF gc else gc
       Bad s     -> fail s
 
 batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 995219efd..d1121e827 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -5,7 +5,7 @@ import GF.Compile.Export
 import GF.Compile.GeneratePMCFG
 
 import PGF.CId
-import PGF.Macros(updateProductionIndices)
+import PGF.Optimize(updateProductionIndices)
 import PGF.Check(checkLin)
 import qualified PGF.Macros as CM
 import qualified PGF.Data as C
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index ee8d76b45..6c00336de 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -161,6 +161,7 @@ data Flags = Flags {
       optPreprocessors   :: [String],
       optEncoding        :: String,
       optOptimizations   :: Set Optimization,
+      optOptimizePGF     :: Bool,
       optCFGTransforms   :: Set CFGTransform,
       optLibraryPath     :: [FilePath],
       optStartCat        :: Maybe String,
@@ -260,6 +261,7 @@ defaultFlags = Flags {
       optPreprocessors   = [],
       optEncoding        = "latin1",
       optOptimizations   = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize],
+      optOptimizePGF     = False,
       optCFGTransforms   = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter, 
                                          CFGTopDownFilter, CFGMergeIdentical],
       optLibraryPath     = [],
@@ -348,6 +350,8 @@ optDescr =
      Option [] ["unlexer"] (ReqArg unlexer "UNLEXER") "Use unlexer UNLEXER.",
      Option [] ["optimize"] (ReqArg optimize "OPT") 
                 "Select an optimization package. OPT = all | values | parametrize | none",
+     Option [] ["optimize-pgf"] (NoArg (optimize_pgf True))
+                "Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file",
      Option [] ["stem"] (onOff (toggleOptimize OptStem) True) "Perform stem-suffix analysis (default on).",
      Option [] ["cse"] (onOff (toggleOptimize OptCSE) True) "Perform common sub-expression elimination (default on).",
      Option [] ["cfg"] (ReqArg cfgTransform "TRANS") "Enable or disable specific CFG transformations. TRANS = merge, no-merge, bottomup, no-bottomup, ...",
@@ -406,6 +410,8 @@ optDescr =
        optimize    x = case lookup x optimizationPackages of
                          Just p  -> set $ \o -> o { optOptimizations = p }
                          Nothing -> fail $ "Unknown optimization package: " ++ x
+                         
+       optimize_pgf x = set $ \o -> o { optOptimizePGF = x }
 
        toggleOptimize x b = set $ setOptimization' x b
 
diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs
index 1f0ac870b..352827f6d 100644
--- a/src/compiler/GFC.hs
+++ b/src/compiler/GFC.hs
@@ -4,6 +4,7 @@ module GFC (mainGFC) where
 import PGF
 import PGF.CId
 import PGF.Data
+import PGF.Optimize
 import GF.Compile
 import GF.Compile.Export
 
@@ -55,7 +56,8 @@ compileCFFiles opts fs =
 unionPGFFiles :: Options -> [FilePath] -> IOE ()
 unionPGFFiles opts fs = 
     do pgfs <- mapM readPGFVerbose fs
-       let pgf = foldl1 unionPGF pgfs
+       let pgf0 = foldl1 unionPGF pgfs
+           pgf = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
            pgfFile = grammarName opts pgf <.> "pgf"
        if pgfFile `elem` fs 
          then putStrLnE $ "Refusing to overwrite " ++ pgfFile