diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs index d4b3a9df3..e7e16013c 100644 --- a/src/GF/Compile.hs +++ b/src/GF/Compile.hs @@ -76,7 +76,10 @@ optimize opts = cse . suf buildParser :: Options -> PGF -> PGF buildParser opts = - if flag optBuildParser opts then addParsers opts else id + case flag optBuildParser opts of + BuildParser -> addParsers opts + DontBuildParser -> id + BuildParserOnDemand -> mapConcretes (\cnc -> cnc { cflags = Map.insert (mkCId "parser") "ondemand" (cflags cnc) }) batchCompile :: Options -> [FilePath] -> IOE SourceGrammar batchCompile opts files = do diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs index 3b71bf28a..63491f94e 100644 --- a/src/GF/Compile/GrammarToGFCC.hs +++ b/src/GF/Compile/GrammarToGFCC.hs @@ -73,7 +73,7 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = cns = map (i2i . fst) cms abs = D.Abstr aflags funs cats catfuns gflags = Map.empty - aflags = Map.fromList [(mkCId f,x) | (f,x) <- moduleOptionsGFO (M.flags abm)] + aflags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF (M.flags abm)] mkDef pty = case pty of Yes t -> mkExp t _ -> CM.primNotion @@ -93,7 +93,7 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg) where js = tree2list (M.jments mo) - flags = Map.fromList [(mkCId f,x) | (f,x) <- moduleOptionsGFO (M.flags mo)] + flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF (M.flags mo)] opers = Map.fromAscList [] -- opers will be created as optimization utf = id -- trace (show lang0 +++ show flags) $ -- if moduleFlag optEncoding (moduleOptions (M.flags mo)) == UTF_8 diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index 58e8d4409..25ccb09a2 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -5,11 +5,12 @@ module GF.Infra.Option Flags(..), Mode(..), Phase(..), Verbosity(..), Encoding(..), OutputFormat(..), SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..), - Dump(..), Printer(..), Recomp(..), + Dump(..), Printer(..), Recomp(..), BuildParser(..), -- * Option parsing parseOptions, parseModuleOptions, -- * Option pretty-printing - moduleOptionsGFO, + optionsGFO, + optionsPGF, -- * Option manipulation addOptions, concatOptions, noOptions, modifyFlags, @@ -136,6 +137,9 @@ data Printer = PrinterStrip -- ^ Remove name qualifiers. data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp deriving (Show,Eq,Ord) +data BuildParser = BuildParser | DontBuildParser | BuildParserOnDemand + deriving (Show,Eq,Ord) + data Flags = Flags { optMode :: Mode, optStopAfterPhase :: Phase, @@ -167,7 +171,7 @@ data Flags = Flags { optLexer :: Maybe String, optUnlexer :: Maybe String, optErasing :: Bool, - optBuildParser :: Bool, + optBuildParser :: BuildParser, optWarnings :: [Warning], optDump :: [Dump] } @@ -195,13 +199,18 @@ parseModuleOptions args = do (opts,nonopts) <- parseOptions args -- Showing options --- | Pretty-print the module options that are preserved in .gfo files. -moduleOptionsGFO :: Options -> [(String,String)] -moduleOptionsGFO opts = +-- | Pretty-print the options that are preserved in .gfo files. +optionsGFO :: Options -> [(String,String)] +optionsGFO opts = optionsPGF opts + ++ [("coding", show (flag optEncoding opts))] + +-- | Pretty-print the options that are preserved in .pgf files. +optionsPGF :: Options -> [(String,String)] +optionsPGF 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 []) + ++ (if flag optBuildParser opts == BuildParserOnDemand then [("parser","ondemand")] else []) -- Option manipulation @@ -256,7 +265,7 @@ defaultFlags = Flags { optLexer = Nothing, optUnlexer = Nothing, optErasing = False, - optBuildParser = True, + optBuildParser = BuildParser, optWarnings = [], optDump = [] } @@ -331,7 +340,7 @@ optDescr = ("Character encoding of the source grammar, ENCODING = " ++ concat (intersperse " | " (map fst encodings)) ++ "."), Option [] ["erasing"] (onOff erasing False) "Generate erasing grammar (default off).", - Option [] ["parser"] (onOff parser True) "Build parser (default on).", + Option [] ["parser"] (ReqArg buildParser "VALUE") "Build parser (default on). VALUE = on | off | ondemand", Option [] ["startcat"] (ReqArg startcat "CAT") "Grammar start category.", Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar.", Option [] ["lexer"] (ReqArg lexer "LEXER") "Use lexer LEXER.", @@ -388,7 +397,11 @@ optDescr = Just c -> set $ \o -> o { optEncoding = c } Nothing -> fail $ "Unknown character encoding: " ++ x erasing x = set $ \o -> o { optErasing = x } - parser x = set $ \o -> o { optBuildParser = x } + buildParser x = do v <- case x of + "on" -> return BuildParser + "off" -> return DontBuildParser + "ondemand" -> return BuildParserOnDemand + set $ \o -> o { optBuildParser = v } startcat x = set $ \o -> o { optStartCat = Just x } language x = set $ \o -> o { optSpeechLanguage = Just x } lexer x = set $ \o -> o { optLexer = Just x } diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs index bf3b92222..fa879cf23 100644 --- a/src/GF/Source/GrammarToSource.hs +++ b/src/GF/Source/GrammarToSource.hs @@ -133,7 +133,7 @@ trPerh p = case p of _ -> P.EMeta --- trFlags :: Options -> [P.TopDef] -trFlags = map trFlag . moduleOptionsGFO +trFlags = map trFlag . optionsGFO trFlag :: (String,String) -> P.TopDef trFlag (f,x) = P.DefFlag [P.FlagDef (tri $ identC (BS.pack f)) (tri $ identC (BS.pack x))] diff --git a/src/PGF.hs b/src/PGF.hs index 17f1d8af8..754bcf34f 100644 --- a/src/PGF.hs +++ b/src/PGF.hs @@ -214,12 +214,12 @@ readPGF f = do g <- parseGrammar s return $! addParsers $ toPGF g --- Adds parsers for all concretes that don't have a parser. +-- Adds parsers for all concretes that don't have a parser and that have parser=ondemand. addParsers :: PGF -> PGF -addParsers pgf = pgf { concretes = Map.map conv (concretes pgf) } - where - conv cnc | isJust (parser cnc) = cnc - | otherwise = cnc { parser = Just (PMCFG.convertConcrete (abstract pgf) cnc) } +addParsers pgf = mapConcretes (\cnc -> if wantsParser cnc then addParser cnc else cnc) pgf + where + wantsParser cnc = isNothing (parser cnc) && Map.lookup (mkCId "parser") (cflags cnc) == Just "ondemand" + addParser cnc = cnc { parser = Just (PMCFG.convertConcrete (abstract pgf) cnc) } linearize pgf lang = concat . take 1 . PGF.Linearize.linearizes pgf lang