forked from GitHub/gf-core
optimization flags and improver eng
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-- Lookup in source (concrete and resource) when compiling.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Lookup where
|
||||
|
||||
@@ -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]
|
||||
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
11
src/HelpFile
11
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
|
||||
|
||||
@@ -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" ++
|
||||
|
||||
@@ -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'.",
|
||||
"-----------------------------------------------------------------------------",
|
||||
"",
|
||||
""
|
||||
]
|
||||
Reference in New Issue
Block a user