diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Canon/Share.hs | 19 | ||||
| -rw-r--r-- | src/GF/Compile/Compile.hs | 18 | ||||
| -rw-r--r-- | src/GF/Grammar/Lookup.hs | 2 | ||||
| -rw-r--r-- | src/GF/Infra/Modules.hs | 7 | ||||
| -rw-r--r-- | src/GF/Infra/Option.hs | 3 | ||||
| -rw-r--r-- | src/GF/Shell/ShellCommands.hs | 7 | ||||
| -rw-r--r-- | src/HelpFile | 11 | ||||
| -rw-r--r-- | src/HelpFile.hs | 20 | ||||
| -rw-r--r-- | src/tools/MkHelpFile.hs | 21 |
9 files changed, 79 insertions, 29 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 diff --git a/src/HelpFile b/src/HelpFile index af09b5e01..5581039f2 100644 --- a/src/HelpFile +++ b/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 diff --git a/src/HelpFile.hs b/src/HelpFile.hs index 9409dd4cc..0b78947bb 100644 --- a/src/HelpFile.hs +++ b/src/HelpFile.hs @@ -1,17 +1,18 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) +-- Module : HelpFile +-- 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" ++ diff --git a/src/tools/MkHelpFile.hs b/src/tools/MkHelpFile.hs index bd3c10792..6f7fe0184 100644 --- a/src/tools/MkHelpFile.hs +++ b/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'.", + "-----------------------------------------------------------------------------", + "", + "" + ]
\ No newline at end of file |