mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Added setOptimization function to GF.Infra.Options. I will need to do similar things for other options.
This commit is contained in:
@@ -34,6 +34,7 @@ import System.Directory
|
||||
import System.FilePath
|
||||
import System.Time
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import PGF.Check
|
||||
import PGF.Data
|
||||
@@ -60,8 +61,8 @@ link opts cnc gr =
|
||||
optimize :: Options -> PGF -> PGF
|
||||
optimize opts = cse . suf
|
||||
where os = moduleFlag optOptimizations opts
|
||||
cse = if OptCSE `elem` os then cseOptimize else id
|
||||
suf = if OptStem `elem` os then suffixOptimize else id
|
||||
cse = if OptCSE `Set.member` os then cseOptimize else id
|
||||
suf = if OptStem `Set.member` os then suffixOptimize else id
|
||||
|
||||
buildParser :: Options -> PGF -> PGF
|
||||
buildParser opts =
|
||||
|
||||
@@ -27,7 +27,10 @@ import Data.List
|
||||
import qualified GF.Infra.Modules as M
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
|
||||
type OptSpec = [Optimization]
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
type OptSpec = Set Optimization
|
||||
|
||||
shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
|
||||
shareModule opt (i,m) = case m of
|
||||
@@ -42,8 +45,8 @@ shareInfo _ i = i
|
||||
|
||||
-- the function putting together optimizations
|
||||
shareOptim :: OptSpec -> Ident -> Term -> Term
|
||||
shareOptim opt c = (if OptValues `elem` opt then values else id)
|
||||
. (if OptParametrize `elem` opt then factor c 0 else id)
|
||||
shareOptim opt c = (if OptValues `Set.member` opt then values else id)
|
||||
. (if OptParametrize `Set.member` opt then factor c 0 else id)
|
||||
|
||||
-- do even more: factor parametric branches
|
||||
|
||||
|
||||
@@ -34,6 +34,7 @@ import GF.Infra.Option
|
||||
|
||||
import Control.Monad
|
||||
import Data.List
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
@@ -103,7 +104,7 @@ evalResInfo oopts gr (c,info) = case info of
|
||||
comp = if optres then computeConcrete gr else computeConcreteRec gr
|
||||
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
|
||||
optim = moduleFlag optOptimizations oopts
|
||||
optres = OptExpand `elem` optim
|
||||
optres = OptExpand `Set.member` optim
|
||||
|
||||
|
||||
evalCncInfo ::
|
||||
|
||||
@@ -14,8 +14,10 @@ module GF.Infra.Option
|
||||
moduleOptions,
|
||||
addModuleOptions, concatModuleOptions, noModuleOptions,
|
||||
helpMessage,
|
||||
-- * Checking options
|
||||
-- * Checking specific options
|
||||
flag, moduleFlag,
|
||||
-- * Setting specific options
|
||||
setOptimization,
|
||||
-- * Convenience methods for checking options
|
||||
verbAtLeast, dump
|
||||
) where
|
||||
@@ -30,6 +32,9 @@ import System.FilePath
|
||||
|
||||
import GF.Data.ErrM
|
||||
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -99,7 +104,7 @@ data ModuleFlags = ModuleFlags {
|
||||
optResName :: Maybe String,
|
||||
optPreprocessors :: [String],
|
||||
optEncoding :: Encoding,
|
||||
optOptimizations :: [Optimization],
|
||||
optOptimizations :: Set Optimization,
|
||||
optLibraryPath :: [FilePath],
|
||||
optStartCat :: Maybe String,
|
||||
optSpeechLanguage :: Maybe String,
|
||||
@@ -195,6 +200,12 @@ flag f (Options o) = f (o defaultFlags)
|
||||
moduleFlag :: (ModuleFlags -> a) -> Options -> a
|
||||
moduleFlag f = flag (f . optModuleFlags)
|
||||
|
||||
onFlags :: (Flags -> Flags) -> Options -> Options
|
||||
onFlags f opts = addOptions opts (Options f)
|
||||
|
||||
onModuleFlags :: (ModuleFlags -> ModuleFlags) -> Options -> Options
|
||||
onModuleFlags f opts = addOptions opts (moduleOptions (ModuleOptions f))
|
||||
|
||||
|
||||
{-
|
||||
|
||||
@@ -233,7 +244,7 @@ defaultModuleFlags = ModuleFlags {
|
||||
optResName = Nothing,
|
||||
optPreprocessors = [],
|
||||
optEncoding = ISO_8859_1,
|
||||
optOptimizations = [OptStem,OptCSE,OptExpand,OptParametrize,OptValues],
|
||||
optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues],
|
||||
optLibraryPath = [],
|
||||
optStartCat = Nothing,
|
||||
optSpeechLanguage = Nothing,
|
||||
@@ -326,7 +337,7 @@ moduleOptDescr =
|
||||
Just p -> set $ \o -> o { optOptimizations = p }
|
||||
Nothing -> fail $ "Unknown optimization package: " ++ x
|
||||
|
||||
toggleOptimize x b = set $ \o -> o { optOptimizations = (if b then (x:) else delete x) (optOptimizations o) }
|
||||
toggleOptimize x b = set $ setOptimization' x b
|
||||
|
||||
dumpOption s d = Option [] ["dump-"++s] (NoArg (set $ \o -> o { optDump = d:optDump o})) ("Dump output of the " ++ s ++ " phase.")
|
||||
|
||||
@@ -403,14 +414,14 @@ instance Show OutputFormat where
|
||||
instance Read OutputFormat where
|
||||
readsPrec = lookupReadsPrec outputFormats
|
||||
|
||||
optimizationPackages :: [(String,[Optimization])]
|
||||
optimizationPackages :: [(String, Set Optimization)]
|
||||
optimizationPackages =
|
||||
[("all_subs", [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]), -- deprecated
|
||||
("all", [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]),
|
||||
("values", [OptStem,OptCSE,OptExpand,OptValues]),
|
||||
("parametrize", [OptStem,OptCSE,OptExpand,OptParametrize]),
|
||||
("none", [OptStem,OptCSE,OptExpand]),
|
||||
("noexpand", [OptStem,OptCSE])]
|
||||
[("all_subs", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]), -- deprecated
|
||||
("all", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]),
|
||||
("values", Set.fromList [OptStem,OptCSE,OptExpand,OptValues]),
|
||||
("parametrize", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),
|
||||
("none", Set.fromList [OptStem,OptCSE,OptExpand]),
|
||||
("noexpand", Set.fromList [OptStem,OptCSE])]
|
||||
|
||||
encodings :: [(String,Encoding)]
|
||||
encodings =
|
||||
@@ -454,6 +465,16 @@ verbAtLeast opts v = flag optVerbosity opts >= v
|
||||
dump :: Options -> Dump -> Bool
|
||||
dump opts d = moduleFlag ((d `elem`) . optDump) opts
|
||||
|
||||
--
|
||||
-- * Convenience functions for setting options
|
||||
--
|
||||
|
||||
setOptimization :: Optimization -> Bool -> Options -> Options
|
||||
setOptimization o b = onModuleFlags (setOptimization' o b)
|
||||
|
||||
setOptimization' :: Optimization -> Bool -> ModuleFlags -> ModuleFlags
|
||||
setOptimization' o b f = f { optOptimizations = g (optOptimizations f)}
|
||||
where g = if b then Set.insert o else Set.delete o
|
||||
|
||||
--
|
||||
-- * General utilities
|
||||
|
||||
Reference in New Issue
Block a user