From 849642e9dd638082bb7b1d7b704200e01429233d Mon Sep 17 00:00:00 2001 From: bjorn Date: Wed, 15 Oct 2008 11:55:18 +0000 Subject: Merge ModuleOptions and Options. --- src/GF/Compile/Optimize.hs | 2 +- src/GF/Compile/ReadFiles.hs | 2 +- src/GF/Infra/Modules.hs | 8 +- src/GF/Infra/Option.hs | 342 +++++++++++++++------------------------ src/GF/Source/GrammarToSource.hs | 2 +- src/GF/Source/SourceToGrammar.hs | 8 +- 6 files changed, 145 insertions(+), 219 deletions(-) (limited to 'src') diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs index ca3e6ec3e..05a3826bf 100644 --- a/src/GF/Compile/Optimize.hs +++ b/src/GF/Compile/Optimize.hs @@ -58,7 +58,7 @@ optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of return (mo2,eenv) _ -> evalModule oopts mse mo where - oopts = opts `addOptions` toOptions (flagsModule mo) + oopts = opts `addOptions` flagsModule mo optim = flag optOptimizations oopts evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs index 67535227b..19bcc013b 100644 --- a/src/GF/Compile/ReadFiles.hs +++ b/src/GF/Compile/ReadFiles.hs @@ -210,4 +210,4 @@ getOptionsFromFile file = do s <- ioeIO $ readFileIfStrict file let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls - ioeErr $ liftM toOptions $ parseModuleOptions fs + ioeErr $ parseModuleOptions fs diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs index 6c40944da..9d8438f0f 100644 --- a/src/GF/Infra/Modules.hs +++ b/src/GF/Infra/Modules.hs @@ -66,7 +66,7 @@ data ModInfo i a = data Module i a = Module { mtype :: ModuleType i , mstatus :: ModuleStatus , - flags :: ModuleOptions, + flags :: Options, extend :: [(i,MInclude i)], opens :: [OpenSpec i] , jments :: BinTree i a , @@ -128,15 +128,15 @@ addOpenQualif :: i -> i -> Module i t -> Module i t addOpenQualif i j (Module mt ms fs me ops js ps) = Module mt ms fs me (oQualif i j : ops) js ps -addFlag :: ModuleOptions -> Module i t -> Module i t +addFlag :: Options -> Module i t -> Module i t addFlag f mo = mo {flags = flags mo `addOptions` f} -flagsModule :: (i,ModInfo i a) -> ModuleOptions +flagsModule :: (i,ModInfo i a) -> Options flagsModule (_,mi) = case mi of ModMod m -> flags m _ -> noOptions -allFlags :: MGrammar i a -> ModuleOptions +allFlags :: MGrammar i a -> Options allFlags gr = concatOptions $ map flags $ [m | (_, ModMod m) <- modules gr] mapModules :: (Module i a -> Module i a) diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index 7b8a50db1..58e8d4409 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -1,8 +1,8 @@ module GF.Infra.Option ( -- * Option types - Options, ModuleOptions, - Flags(..), ModuleFlags(..), + Options, + Flags(..), Mode(..), Phase(..), Verbosity(..), Encoding(..), OutputFormat(..), SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..), Dump(..), Printer(..), Recomp(..), @@ -11,9 +11,8 @@ module GF.Infra.Option -- * Option pretty-printing moduleOptionsGFO, -- * Option manipulation - OPTIONS(..), addOptions, concatOptions, noOptions, - modifyFlags, modifyModuleFlags, + modifyFlags, helpMessage, -- * Checking specific options flag, cfgTransform, haskellOption, @@ -137,27 +136,6 @@ data Printer = PrinterStrip -- ^ Remove name qualifiers. data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp deriving (Show,Eq,Ord) -data ModuleFlags = ModuleFlags { - optName :: Maybe String, - optAbsName :: Maybe String, - optCncName :: Maybe String, - optResName :: Maybe String, - optPreprocessors :: [String], - optEncoding :: Encoding, - optOptimizations :: Set Optimization, - optCFGTransforms :: Set CFGTransform, - optLibraryPath :: [FilePath], - optStartCat :: Maybe String, - optSpeechLanguage :: Maybe String, - optLexer :: Maybe String, - optUnlexer :: Maybe String, - optErasing :: Bool, - optBuildParser :: Bool, - optWarnings :: [Warning], - optDump :: [Dump] - } - deriving (Show) - data Flags = Flags { optMode :: Mode, optStopAfterPhase :: Phase, @@ -175,7 +153,23 @@ data Flags = Flags { optPrinter :: [Printer], optProb :: Bool, optRetainResource :: Bool, - optModuleFlags :: ModuleFlags + optName :: Maybe String, + optAbsName :: Maybe String, + optCncName :: Maybe String, + optResName :: Maybe String, + optPreprocessors :: [String], + optEncoding :: Encoding, + optOptimizations :: Set Optimization, + optCFGTransforms :: Set CFGTransform, + optLibraryPath :: [FilePath], + optStartCat :: Maybe String, + optSpeechLanguage :: Maybe String, + optLexer :: Maybe String, + optUnlexer :: Maybe String, + optErasing :: Bool, + optBuildParser :: Bool, + optWarnings :: [Warning], + optDump :: [Dump] } deriving (Show) @@ -184,8 +178,6 @@ newtype Options = Options (Flags -> Flags) instance Show Options where show (Options o) = show (o defaultFlags) -newtype ModuleOptions = ModuleOptions (ModuleFlags -> ModuleFlags) - -- Option parsing parseOptions :: [String] -> Err (Options, [FilePath]) @@ -195,119 +187,41 @@ parseOptions args return (opts, files) where (optss, files, errs) = getOpt RequireOrder optDescr args -parseModuleOptions :: [String] -> Err ModuleOptions -parseModuleOptions args - | not (null errs) = errors errs - | not (null files) = errors $ map ("Non-option among module options: " ++) files - | otherwise = liftM concatOptions $ sequence flags - where (flags, files, errs) = getOpt RequireOrder moduleOptDescr args +parseModuleOptions :: [String] -> Err Options +parseModuleOptions args = do (opts,nonopts) <- parseOptions args + if null nonopts + then return opts + else errors $ map ("Non-option among module options: " ++) nonopts -- Showing options -- | Pretty-print the module options that are preserved in .gfo files. -moduleOptionsGFO :: ModuleOptions -> [(String,String)] -moduleOptionsGFO (ModuleOptions o) = - maybe [] (\x -> [("language",x)]) (optSpeechLanguage mfs) - ++ maybe [] (\x -> [("startcat",x)]) (optStartCat mfs) - ++ [("coding", show (optEncoding mfs))] - ++ (if optErasing mfs then [("erasing","on")] else []) - where - mfs = o defaultModuleFlags +moduleOptionsGFO :: Options -> [(String,String)] +moduleOptionsGFO opts = + maybe [] (\x -> [("language",x)]) (flag optSpeechLanguage opts) + ++ maybe [] (\x -> [("startcat",x)]) (flag optStartCat opts) + ++ [("coding", show (flag optEncoding opts))] + ++ (if flag optErasing opts then [("erasing","on")] else []) -- Option manipulation -class OPTIONS a where - toOptions :: a -> Options - fromOptions :: Options -> a +flag :: (Flags -> a) -> Options -> a +flag f (Options o) = f (o defaultFlags) -instance OPTIONS Options where - toOptions = id - fromOptions = id +addOptions :: Options -> Options -> Options +addOptions (Options o1) (Options o2) = Options (o2 . o1) -instance OPTIONS ModuleOptions where - toOptions (ModuleOptions f) = Options (\fs -> fs { optModuleFlags = f (optModuleFlags fs) }) - fromOptions (Options f) = ModuleOptions (\fs -> optModuleFlags (f (defaultFlags { optModuleFlags = fs}))) +noOptions :: Options +noOptions = Options id -instance OPTIONS Flags where - toOptions fs = Options (\_ -> fs) - fromOptions (Options f) = f defaultFlags - -instance OPTIONS ModuleFlags where - toOptions mfs = Options (\fs -> fs { optModuleFlags = mfs }) - fromOptions (Options f) = optModuleFlags (f defaultFlags) - -flag :: (OPTIONS a, OPTIONS b) => (a -> c) -> b -> c -flag f o = f (fromOptions (toOptions o)) - -addOptions :: OPTIONS a => a -> a -> a -addOptions x y = let Options o1 = toOptions x - Options o2 = toOptions y - in fromOptions (Options (o2 . o1)) - -noOptions :: OPTIONS a => a -noOptions = fromOptions (Options id) - -concatOptions :: OPTIONS a => [a] -> a +concatOptions :: [Options] -> Options concatOptions = foldr addOptions noOptions modifyFlags :: (Flags -> Flags) -> Options modifyFlags = Options -modifyModuleFlags :: (ModuleFlags -> ModuleFlags) -> Options -modifyModuleFlags = toOptions . ModuleOptions - - -{- - -parseModuleFlags :: Options -> [(String,Maybe String)] -> Err ModuleOptions -parseModuleFlags opts flags = - mapM (uncurry (findFlag moduleOptDescr)) flags >>= foldM (flip ($)) (optModuleOptions opts) - -findFlag :: Monad m => [OptDescr a] -> String -> Maybe String -> m a -findFlag opts n mv = - case filter (`flagMatches` n) opts of - [] -> fail $ "Unknown option: " ++ n - [opt] -> flagValue opt n mv - _ -> fail $ n ++ " matches multiple options." - -flagMatches :: OptDescr a -> String -> Bool -flagMatches (Option cs ss _ _) n = n `elem` (map (:[]) cs ++ ss) - -flagValue :: Monad m => OptDescr a -> String -> Maybe String -> m a -flagValue (Option _ _ arg _) n mv = - case (arg, mv) of - (NoArg x, Nothing) -> return x - (NoArg _, Just _ ) -> fail $ "Option " ++ n ++ " does not take a value." - (ReqArg _ _, Nothing) -> fail $ "Option " ++ n ++ " requires a value." - (ReqArg f _, Just x ) -> return (f x) - (OptArg f _, mx ) -> return (f mx) - --} - -- Default options -defaultModuleFlags :: ModuleFlags -defaultModuleFlags = ModuleFlags { - optName = Nothing, - optAbsName = Nothing, - optCncName = Nothing, - optResName = Nothing, - optPreprocessors = [], - optEncoding = ISO_8859_1, - optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues], - optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter, - CFGTopDownFilter, CFGMergeIdentical], - optLibraryPath = [], - optStartCat = Nothing, - optSpeechLanguage = Nothing, - optLexer = Nothing, - optUnlexer = Nothing, - optErasing = False, - optBuildParser = True, - optWarnings = [], - optDump = [] - } - defaultFlags :: Flags defaultFlags = Flags { optMode = ModeInteractive, @@ -326,14 +240,75 @@ defaultFlags = Flags { optPrinter = [], optProb = False, optRetainResource = False, - optModuleFlags = defaultModuleFlags + + optName = Nothing, + optAbsName = Nothing, + optCncName = Nothing, + optResName = Nothing, + optPreprocessors = [], + optEncoding = ISO_8859_1, + optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues], + optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter, + CFGTopDownFilter, CFGMergeIdentical], + optLibraryPath = [], + optStartCat = Nothing, + optSpeechLanguage = Nothing, + optLexer = Nothing, + optUnlexer = Nothing, + optErasing = False, + optBuildParser = True, + optWarnings = [], + optDump = [] } -- Option descriptions -moduleOptDescr :: [OptDescr (Err ModuleOptions)] -moduleOptDescr = +optDescr :: [OptDescr (Err Options)] +optDescr = [ + Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.", + Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.", + Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 2.", + Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.", + Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.", + Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).", + Option [] ["run"] (NoArg (mode ModeRun)) "Run in interactive mode, showing output only (no other messages).", + Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).", + Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.", + Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .", + Option [] ["make"] (NoArg (phase Link)) "Build .pgf file and other output files.", + Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.", + Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).", + Option [] ["emit-gfo"] (NoArg (emitGFO True)) "Create .gfo files (default).", + Option [] ["no-emit-gfo"] (NoArg (emitGFO False)) "Do not create .gfo files.", + Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').", + Option ['f'] ["output-format"] (ReqArg outFmt "FMT") + (unlines ["Output format. FMT can be one of:", + "Multiple concrete: pgf (default), gar, js, prolog, ...", + "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...", + "Abstract only: haskell, prolog_abs, ..."]), + Option [] ["sisr"] (ReqArg sisrFmt "FMT") + (unlines ["Include SISR tags in generated speech recognition grammars.", + "FMT can be one of: old, 1.0"]), + Option [] ["haskell"] (ReqArg hsOption "OPTION") + ("Turn on an optional feature when generating Haskell data types. OPTION = " + ++ concat (intersperse " | " (map fst haskellOptionNames))), + Option [] ["lexical"] (ReqArg lexicalCat "CAT[,CAT[...]]") + "Treat CAT as a lexical category.", + Option ['o'] ["output-file"] (ReqArg outFile "FILE") + "Save output in FILE (default is out.X, where X depends on output format.", + Option ['D'] ["output-dir"] (ReqArg outDir "DIR") + "Save output files (other than .gfc files) in DIR.", + Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp)) + "Always recompile from source.", + Option [] ["gfo","recomp-if-newer"] (NoArg (recomp RecompIfNewer)) + "(default) Recompile from source if the source is newer than the .gfo file.", + Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp)) + "Never recompile from source, if there is already .gfo file.", + Option [] ["strip"] (NoArg (printer PrinterStrip)) + "Remove name qualifiers when pretty-printing.", + Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.", + Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas.", Option ['n'] ["name"] (ReqArg name "NAME") (unlines ["Use NAME as the name of the output. This is used in the output file names, ", "with suffixes depending on the formats, and, when relevant, ", @@ -373,8 +348,35 @@ moduleOptDescr = dumpOption "refresh" DumpRefresh, dumpOption "opt" DumpOptimize, dumpOption "canon" DumpCanon + ] - where + where phase x = set $ \o -> o { optStopAfterPhase = x } + mode x = set $ \o -> o { optMode = x } + verbosity mv = case mv of + Nothing -> set $ \o -> o { optVerbosity = Verbose } + Just v -> case readMaybe v >>= toEnumBounded of + Just i -> set $ \o -> o { optVerbosity = i } + Nothing -> fail $ "Bad verbosity: " ++ show v + cpu x = set $ \o -> o { optShowCPUTime = x } + emitGFO x = set $ \o -> o { optEmitGFO = x } + gfoDir x = set $ \o -> o { optGFODir = x } + outFmt x = readOutputFormat x >>= \f -> + set $ \o -> o { optOutputFormats = optOutputFormats o ++ [f] } + sisrFmt x = case x of + "old" -> set $ \o -> o { optSISR = Just SISR_WD20030401 } + "1.0" -> set $ \o -> o { optSISR = Just SISR_1_0 } + _ -> fail $ "Unknown SISR format: " ++ show x + hsOption x = case lookup x haskellOptionNames of + Just p -> set $ \o -> o { optHaskellOptions = Set.insert p (optHaskellOptions o) } + Nothing -> fail $ "Unknown Haskell option: " ++ x + ++ " Known: " ++ show (map fst haskellOptionNames) + lexicalCat x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) } + outFile x = set $ \o -> o { optOutputFile = Just x } + outDir x = set $ \o -> o { optOutputDir = Just x } + recomp x = set $ \o -> o { optRecomp = x } + printer x = set $ \o -> o { optPrinter = x : optPrinter o } + prob x = set $ \o -> o { optProb = x } + name x = set $ \o -> o { optName = Just x } absName x = set $ \o -> o { optAbsName = Just x } cncName x = set $ \o -> o { optCncName = Just x } @@ -408,82 +410,6 @@ moduleOptDescr = dumpOption s d = Option [] ["dump-"++s] (NoArg (set $ \o -> o { optDump = d:optDump o})) ("Dump output of the " ++ s ++ " phase.") - set = return . ModuleOptions - -optDescr :: [OptDescr (Err Options)] -optDescr = - [ - Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.", - Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.", - Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 2.", - Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.", - Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.", - Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).", - Option [] ["run"] (NoArg (mode ModeRun)) "Run in interactive mode, showing output only (no other messages).", - Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).", - Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.", - Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .", - Option [] ["make"] (NoArg (phase Link)) "Build .pgf file and other output files.", - Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.", - Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).", - Option [] ["emit-gfo"] (NoArg (emitGFO True)) "Create .gfo files (default).", - Option [] ["no-emit-gfo"] (NoArg (emitGFO False)) "Do not create .gfo files.", - Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').", - Option ['f'] ["output-format"] (ReqArg outFmt "FMT") - (unlines ["Output format. FMT can be one of:", - "Multiple concrete: pgf (default), gar, js, prolog, ...", - "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...", - "Abstract only: haskell, prolog_abs, ..."]), - Option [] ["sisr"] (ReqArg sisrFmt "FMT") - (unlines ["Include SISR tags in generated speech recognition grammars.", - "FMT can be one of: old, 1.0"]), - Option [] ["haskell"] (ReqArg hsOption "OPTION") - ("Turn on an optional feature when generating Haskell data types. OPTION = " - ++ concat (intersperse " | " (map fst haskellOptionNames))), - Option [] ["lexical"] (ReqArg lexicalCat "CAT[,CAT[...]]") - "Treat CAT as a lexical category.", - Option ['o'] ["output-file"] (ReqArg outFile "FILE") - "Save output in FILE (default is out.X, where X depends on output format.", - Option ['D'] ["output-dir"] (ReqArg outDir "DIR") - "Save output files (other than .gfc files) in DIR.", - Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp)) - "Always recompile from source.", - Option [] ["gfo","recomp-if-newer"] (NoArg (recomp RecompIfNewer)) - "(default) Recompile from source if the source is newer than the .gfo file.", - Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp)) - "Never recompile from source, if there is already .gfo file.", - Option [] ["strip"] (NoArg (printer PrinterStrip)) - "Remove name qualifiers when pretty-printing.", - Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.", - Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas." - ] ++ map (fmap (liftM toOptions)) moduleOptDescr - where phase x = set $ \o -> o { optStopAfterPhase = x } - mode x = set $ \o -> o { optMode = x } - verbosity mv = case mv of - Nothing -> set $ \o -> o { optVerbosity = Verbose } - Just v -> case readMaybe v >>= toEnumBounded of - Just i -> set $ \o -> o { optVerbosity = i } - Nothing -> fail $ "Bad verbosity: " ++ show v - cpu x = set $ \o -> o { optShowCPUTime = x } - emitGFO x = set $ \o -> o { optEmitGFO = x } - gfoDir x = set $ \o -> o { optGFODir = x } - outFmt x = readOutputFormat x >>= \f -> - set $ \o -> o { optOutputFormats = optOutputFormats o ++ [f] } - sisrFmt x = case x of - "old" -> set $ \o -> o { optSISR = Just SISR_WD20030401 } - "1.0" -> set $ \o -> o { optSISR = Just SISR_1_0 } - _ -> fail $ "Unknown SISR format: " ++ show x - hsOption x = case lookup x haskellOptionNames of - Just p -> set $ \o -> o { optHaskellOptions = Set.insert p (optHaskellOptions o) } - Nothing -> fail $ "Unknown Haskell option: " ++ x - ++ " Known: " ++ show (map fst haskellOptionNames) - lexicalCat x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) } - outFile x = set $ \o -> o { optOutputFile = Just x } - outDir x = set $ \o -> o { optOutputDir = Just x } - recomp x = set $ \o -> o { optRecomp = x } - printer x = set $ \o -> o { optPrinter = x : optPrinter o } - prob x = set $ \o -> o { optProb = x } - set = return . Options outputFormats :: [(String,OutputFormat)] @@ -601,15 +527,15 @@ isLexicalCat opts c = Set.member c (flag optLexicalCats opts) -- setOptimization :: Optimization -> Bool -> Options -setOptimization o b = modifyModuleFlags (setOptimization' o b) +setOptimization o b = modifyFlags (setOptimization' o b) -setOptimization' :: Optimization -> Bool -> ModuleFlags -> ModuleFlags +setOptimization' :: Optimization -> Bool -> Flags -> Flags setOptimization' o b f = f { optOptimizations = toggle o b (optOptimizations f)} setCFGTransform :: CFGTransform -> Bool -> Options -setCFGTransform t b = modifyModuleFlags (setCFGTransform' t b) +setCFGTransform t b = modifyFlags (setCFGTransform' t b) -setCFGTransform' :: CFGTransform -> Bool -> ModuleFlags -> ModuleFlags +setCFGTransform' :: CFGTransform -> Bool -> Flags -> Flags setCFGTransform' t b f = f { optCFGTransforms = toggle t b (optCFGTransforms f) } toggle :: Ord a => a -> Bool -> Set a -> Set a diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs index f76fe6cee..bf3b92222 100644 --- a/src/GF/Source/GrammarToSource.hs +++ b/src/GF/Source/GrammarToSource.hs @@ -132,7 +132,7 @@ trPerh p = case p of May b -> P.EIndir $ tri b _ -> P.EMeta --- -trFlags :: ModuleOptions -> [P.TopDef] +trFlags :: Options -> [P.TopDef] trFlags = map trFlag . moduleOptionsGFO trFlag :: (String,String) -> P.TopDef diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs index 2bf7ae9ef..da5ab180d 100644 --- a/src/GF/Source/SourceToGrammar.hs +++ b/src/GF/Source/SourceToGrammar.hs @@ -239,7 +239,7 @@ buildPosTree m = buildTree . mkPoss . filter ((>0) . snd) where _ -> [] name = prIdent m ++ ".gf" ---- -transAbsDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.ModuleOptions) +transAbsDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.Options) transAbsDef x = case x of DefCat catdefs -> liftM (Left . concat) $ mapM transCatDef catdefs DefFun fundefs -> do @@ -277,7 +277,7 @@ transAbsDef x = case x of returnl :: a -> Err (Either a b) returnl = return . Left -transFlagDef :: FlagDef -> Err GO.ModuleOptions +transFlagDef :: FlagDef -> Err GO.Options transFlagDef x = case x of FlagDef f x -> parseModuleOptions ["--" ++ prPIdent f ++ "=" ++ prPIdent x] where @@ -330,7 +330,7 @@ transDataDef x = case x of DataId id -> liftM G.Cn $ transIdent id DataQId id0 id -> liftM2 G.QC (transIdent id0) (transIdent id) -transResDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.ModuleOptions) +transResDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.Options) transResDef x = case x of DefPar pardefs -> do pardefs' <- mapM transParDef pardefs @@ -380,7 +380,7 @@ transParDef x = case x of ParDefAbs id -> liftM2 (,) (transIdent id) (return []) _ -> Bad $ "illegal definition in resource:" ++++ printTree x -transCncDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.ModuleOptions) +transCncDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.Options) transCncDef x = case x of DefLincat defs -> do defs' <- liftM concat $ mapM transPrintDef defs -- cgit v1.2.3