From 7f90087ab9c77ac2e2a57d53b8a985feb45d43f2 Mon Sep 17 00:00:00 2001 From: bjorn Date: Fri, 30 May 2008 13:56:50 +0000 Subject: [PATCH] Added setOptimization function to GF.Infra.Options. I will need to do similar things for other options. --- src-3.0/GF/Compile.hs | 5 ++-- src-3.0/GF/Compile/BackOpt.hs | 9 ++++--- src-3.0/GF/Compile/Optimize.hs | 3 ++- src-3.0/GF/Infra/Option.hs | 43 +++++++++++++++++++++++++--------- 4 files changed, 43 insertions(+), 17 deletions(-) diff --git a/src-3.0/GF/Compile.hs b/src-3.0/GF/Compile.hs index 677aa4104..0119b2107 100644 --- a/src-3.0/GF/Compile.hs +++ b/src-3.0/GF/Compile.hs @@ -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 = diff --git a/src-3.0/GF/Compile/BackOpt.hs b/src-3.0/GF/Compile/BackOpt.hs index 0043d02d8..2814448b4 100644 --- a/src-3.0/GF/Compile/BackOpt.hs +++ b/src-3.0/GF/Compile/BackOpt.hs @@ -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 diff --git a/src-3.0/GF/Compile/Optimize.hs b/src-3.0/GF/Compile/Optimize.hs index 9263dcdd9..80ceed16d 100644 --- a/src-3.0/GF/Compile/Optimize.hs +++ b/src-3.0/GF/Compile/Optimize.hs @@ -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 :: diff --git a/src-3.0/GF/Infra/Option.hs b/src-3.0/GF/Infra/Option.hs index c950be587..b9fb7370f 100644 --- a/src-3.0/GF/Infra/Option.hs +++ b/src-3.0/GF/Infra/Option.hs @@ -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