module UHC.Light.Compiler.Opts ( module UHC.Light.Compiler.Opts.Base , optOptsIsYes, showStr2stMp , defaultEHCOpts , ehcCmdLineOpts , sortOptions , ehcrunCmdLineOpts , GetOptCmdLineOpts , ehcCmdLineOptsApply, ehcrunCmdLineOptsApply , FIOpts (..) , strongFIOpts , instLFIOpts , instLRFIOpts , unifyFIOpts, instFIOpts , fioSwapPolarity, fioSwapOpts , fioMkStrong , fioMkWeak , fioMkUnify , fioIsSubsume , weakFIOpts , Optimize (..), OptimizationLevel (..) , module UHC.Light.Compiler.Base.FileSearchLocation , ehcOptWholeProgHPTAnalysis , ehcOptOptimizes , fioMkFinal , FIOBind (..) , fioBindIsYes, fioBindNoSet , predFIOpts, implFIOpts , ehcOptWholeProgOptimizationScope , ehcOptEarlyModMerge , optsDiscrRecompileRepr , ehcOptUpdateWithPragmas ) where import System.Console.GetOpt import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.Opts.Base import UHC.Util.Utils import Data.Maybe import qualified Data.Map as Map import Data.Char import UHC.Light.Compiler.Base.UnderDev import UHC.Util.Pretty import UHC.Light.Compiler.Ty import qualified Data.Set as Set import Data.List import UHC.Light.Compiler.Base.HsName.Builtin import UHC.Util.FPath import UHC.Light.Compiler.EHC.Environment import UHC.Light.Compiler.Base.Target import UHC.Light.Compiler.Base.Trace import UHC.Light.Compiler.Base.Optimize import UHC.Light.Compiler.Base.FileSearchLocation import UHC.Light.Compiler.Error import qualified UHC.Light.Compiler.Config as Cfg import UHC.Light.Compiler.Base.Pragma import UHC.Light.Compiler.Opts.CommandLine import UHC.Light.Compiler.Base.Parser import UHC.Light.Compiler.Base.Parser2 {-# LINE 76 "src/ehc/Opts.chs" #-} -- | possibly adapt with pragmas ehcOptUpdateWithPragmas :: Set.Set Pragma -> EHCOpts -> (EHCOpts,Bool) ehcOptUpdateWithPragmas pragmas opts = foldr (\p om@(o,modf) -> maybe om (\o -> (o,True)) $ upd p o) (opts,False) (Set.toList pragmas) where upd pragma opts = case pragma of Pragma_NoGenericDeriving -> Just $ opts { ehcOptGenGenerics = False } Pragma_GenericDeriving -> Just $ opts { ehcOptGenGenerics = True } Pragma_NoBangPatterns -> Just $ opts { ehcOptBangPatterns = False } Pragma_BangPatterns -> Just $ opts { ehcOptBangPatterns = True } Pragma_NoOverloadedStrings -> Just $ opts { ehcOptOverloadedStrings = False } Pragma_OverloadedStrings -> Just $ opts { ehcOptOverloadedStrings = True } Pragma_NoPolyKinds -> Just $ opts { ehcOptPolyKinds = False } Pragma_PolyKinds -> Just $ opts { ehcOptPolyKinds = True } Pragma_ExtensibleRecords -> Just $ opts { ehcOptExtensibleRecords = True } Pragma_Fusion -> Just $ opts { ehcOptFusion = True } Pragma_OptionsUHC o -> fmap (\o -> o {ehcOptCmdLineOptsDoneViaPragma = True}) mo where (mo,_,_) = ehcCmdLineOptsApply [] (words o) opts _ -> Nothing {-# LINE 102 "src/ehc/Opts.chs" #-} mkStringPath :: String -> [String] mkStringPath = wordsBy (`elem` ";,") mkFileLocPath :: String -> FileLocPath mkFileLocPath = map mkDirFileLoc . mkStringPath {-# LINE 114 "src/ehc/Opts.chs" #-} optOpts :: Map.Map String opt -> String -> [opt] optOpts m s = catMaybes $ map (\os -> Map.lookup os m) $ wordsBy (==',') s optOptsIsYes :: Eq opt => Maybe [opt] -> opt -> Bool optOptsIsYes mos o = maybe False (o `elem`) mos {-# LINE 123 "src/ehc/Opts.chs" #-} instance Show EhOpt where show EhOpt_Dump = "dump" show EhOpt_DumpAST = "dump-ast" show _ = "-" ehOptMp :: Map.Map String EhOpt ehOptMp = str2stMpWithOmit [EhOpt_NONE] {-# LINE 133 "src/ehc/Opts.chs" #-} instance Show CoreOpt where -- show CoreOpt_PPParseable = "pp-parseable" show CoreOpt_Dump = "dump" show CoreOpt_DumpBinary = "dump-binary" show CoreOpt_DumpAlsoNonParseable = "whendump-alsononparseable" show CoreOpt_DumpAST = "dump-ast" show CoreOpt_Run = "run" show CoreOpt_LoadOnly = "loadonly" show CoreOpt_RunDump = "dump-run" show CoreOpt_RunTrace = "run-trace" show CoreOpt_RunTraceExtensive = "run-trace-extensive" show CoreOpt_RunPPNames = "run-ppnames" show CoreOpt_RunPPVerbose = "run-ppverbose" show _ = "-" coreOptMp :: Map.Map String CoreOpt coreOptMp = str2stMpWithOmit [CoreOpt_NONE] {-# LINE 165 "src/ehc/Opts.chs" #-} instance Show CoreRunOpt where show = strToLower . showUnprefixed 1 coreRunOptMp :: Map.Map String CoreRunOpt coreRunOptMp = str2stMp {-# LINE 189 "src/ehc/Opts.chs" #-} instance Show PgmExec where show PgmExec_CPP = "P" show PgmExec_C = "c" show PgmExec_Linker = "l" pgmExecMp :: Map.Map String PgmExec pgmExecMp = str2stMp {-# LINE 205 "src/ehc/Opts.chs" #-} -- do something with whole program ehcOptWholeProgOptimizationScope :: EHCOpts -> Bool ehcOptWholeProgOptimizationScope opts = ehcOptOptimizationScope opts > OptimizationScope_PerModule {-# LINE 212 "src/ehc/Opts.chs" #-} -- compatibility option ehcOptEarlyModMerge :: EHCOpts -> Bool ehcOptEarlyModMerge opts = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore {-# LINE 219 "src/ehc/Opts.chs" #-} -- do whole program analysis, with HPT ehcOptWholeProgHPTAnalysis :: EHCOpts -> Bool ehcOptWholeProgHPTAnalysis opts = False {-# LINE 274 "src/ehc/Opts.chs" #-} -- | optimizes a particular option ehcOptOptimizes :: Optimize -> EHCOpts -> Bool ehcOptOptimizes o opts = o `Set.member` ehcOptOptimizations opts {-# LINE 284 "src/ehc/Opts.chs" #-} -- | The default EHC options. defaultEHCOpts = emptyEHCOpts { ehcOptExecOptsMp = ehcOptExecOptsMp emptyEHCOpts `Map.union` Map.fromList [ (Cfg.shellCmdCpp, [ExecOpt_Plain "traditional-cpp", ExecOpt_Plain "std=gnu99", ExecOpt_Plain "fno-show-column", ExecOpt_Plain "P"]) ] } {-# LINE 300 "src/ehc/Opts.chs" #-} -- | Commandline opts for ehc/uhc (EHC) ehcCmdLineOpts :: GetOptCmdLineOpts ehcCmdLineOpts = sortOptions $ sharedCmdLineOpts ++ [ Option "t" ["target"] (ReqArg oTarget (showSupportedTargets' "|")) ("generate code for target, default=" ++ show defaultTarget) , Option "" ["target-flavor"] (ReqArg oTargetFlavor (showAllTargetFlavors' "|")) ("generate code for target flavor, default=" ++ show defaultTargetFlavor) , Option "p" ["pretty"] (OptArg oPretty "hs|eh|ast|-") "show pretty printed source or EH abstract syntax tree, default=eh, -=off, (downstream only)" , Option "d" ["debug"] (NoArg oDebug) "show debug information" , Option "" ["priv"] (boolArg oPriv) "private flag, used during development of 2 impls of 1 feature" , Option "" ["underdev"] (ReqArg oUnderDev "opt[,...]") ("opts (specific) for flipping (on/off) under development features: " ++ showStr2stMp allUnderDevMp ++ ", on: " ++ (concat $ intersperse " " $ map show $ Set.toList $ ehcOptUnderDev emptyEHCOpts)) , Option "O" ["optimise"] (OptArg oOptimization ("0|1|2|3|[=" ++ boolArgStr ++ "]")) ("optimise with level or specific by optim name: " ++ showStr2stMp allOptimizeMp ++ ", or by scope name: " ++ showStr2stMp allOptimScopeMp ++ ", default=1") , Option "" ["gen-trampoline"] (boolArg oSetGenTrampoline) "codegen: use trampoline mechanism (development/internal use only)" , Option "" ["no-recomp"] (NoArg oNoRecomp) "turn off recompilation check (force recompile)" , Option "" ["no-prelude"] (NoArg oNoPrelude) "do not assume presence of Prelude" , Option "" ["no-hi-check"] (NoArg oNoHiCheck) "no check on .hi files not matching the compiler version" , Option "c" ["compile-only"] (NoArg oCompileOnly) "compile only, do not link" , Option "i" ["import-path"] (ReqArg oUsrFileLocPath "path") "search path for user files, separators=';', appended to previous" , Option "L" ["lib-search-path"] (ReqArg oLibFileLocPath "path") "search path for library files, see also --import-path" , Option "" ["cpp"] (NoArg oCPP) "preprocess source with CPP" , Option "" ["limit-tysyn-expand"] (intArg oLimitTyBetaRed) "type synonym expansion limit" , Option "" ["odir"] (ReqArg oOutputDir "dir") "base directory for generated files" , Option "o" ["output"] (ReqArg oOutputFile "file") "file to generate executable to (implies --compile-only off)" , Option "" ["keep-intermediate-files"] (NoArg oKeepIntermediateFiles) "keep intermediate files (default=off)" , Option "" ["meta-variant"] (NoArg oVariant) "meta: print variant (then stop)" , Option "" ["meta-target-default"] (NoArg oTargetDflt) "meta: print the default codegeneration target (then stop)" , Option "" ["meta-targets"] (NoArg oTargets) "meta: print supported codegeneration targets (then stop)" , Option "" ["meta-optimizations"] (NoArg oOptimizations) "meta: print optimization names (then stop)" , Option "" ["meta-pkgdir-system"] (NoArg oMetaPkgdirSys) "meta: print system package dir (then stop)" , Option "" ["meta-pkgdir-user"] (NoArg oMetaPkgdirUser) "meta: print user package dir (then stop)" , Option "" ["package"] (ReqArg oExposePackage "package") "see --pkg-expose" , Option "" ["hide-all-packages"] (NoArg oHideAllPackages) "see --pkg-hide-all" , Option "" ["pkg-expose"] (ReqArg oExposePackage "package") "pkg: expose/use package" , Option "" ["pkg-hide"] (ReqArg oHidePackage "package") "pkg: hide package" , Option "" ["pkg-hide-all"] (NoArg oHideAllPackages) "pkg: hide all (implicitly) assumed/used packages" , Option "" ["pkg-searchpath"] (ReqArg oPkgdirLocPath "path") "pkg: package search directories, each dir has ///" , Option "" ["pkg-build"] (ReqArg oPkgBuild "package") "pkg build: build package from files. Implies --compile-only" , Option "" ["pkg-build-exposed"] (ReqArg oPkgBuildExposedModules "modules") "pkg build: for package building, exposed modules (blank separated)" , Option "" ["pkg-build-depends"] (ReqArg oPkgBuildBuildDepends "packages") "pkg build: for package building, depended on packages (blank separated)" , Option "" ["cfg-install-root"] (ReqArg oCfgInstallRoot "dir") "cfg: installation root (to be used only by wrapper script)" , Option "" ["cfg-install-variant"] (ReqArg oCfgInstallVariant "variant") "cfg: installation variant (to be used only by wrapper script)" , Option "" ["optP"] (ReqArg (oCmdLineOpts Cmd_CPP_Preprocessing) "opt for cmd") "opt: option for cmd used by compiler, currently only P (preprocessing)" , Option "" ["pgmP"] (ReqArg (oPgmExec PgmExec_CPP) "alternate program for cmd") "pgm: alternate executable used by compiler, currently only P (preprocessing)" ] {-# LINE 450 "src/ehc/Opts.chs" #-} where oPretty ms o = case ms of Just "-" -> o { ehcOptShowEH = False } Just "no" -> o { ehcOptShowEH = False } Just "off" -> o { ehcOptShowEH = False } Just "hs" -> o { ehcOptShowHS = True } Just "eh" -> o { ehcOptShowEH = True } Just "pp" -> o { ehcOptShowEH = True } _ -> o oShowTopTy ms o = case ms of Just "yes" -> o { ehcOptShowTopTyPP = True } _ -> o oVariant o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Variant } oDebug o = o { ehcOptDebug = True } oStopAt s o = o { ehcStopAtPoint = case s of "0" -> CompilePoint_Imports "1" -> CompilePoint_Parse "2" -> CompilePoint_AnalHS "3" -> CompilePoint_AnalEH "4" -> CompilePoint_Core _ -> CompilePoint_All } oTarget s o = o { ehcOptMbTarget = mbtarget , ehcOptOptimizationScope = if isJustOk mbtarget && targetDoesHPTAnalysis (fromJustOk mbtarget) then max oscope (maxBound :: OptimizationScope) else oscope } where mbtarget = maybe (NotOk s) JustOk $ Map.lookup s supportedTargetMp oscope = ehcOptOptimizationScope o oTargetFlavor s o = o { ehcOptMbTargetFlavor = maybe (NotOk s) JustOk $ Map.lookup s allTargetFlavorMp } oOptimizations o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Optimizations } oTargets o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Targets } oTargetDflt o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_TargetDefault } oCode ms o = case ms of Just "hs" -> o { ehcOptEmitHS = True } Just "eh" -> o { ehcOptEmitEH = True } Just "-" -> o -- { ehcOptEmitCore = False } Just "core" -> o { ehcOptMbTarget = JustOk Target_None_Core_AsIs } _ -> o oOptimization ms o = o' {ehcOptOptimizations = optimizeRequiresClosure os} where (o',doSetOpts) = case ms of Just (clevel:',':cscope:_) | isJust mbO -> (fromJust mbO o, True) where mbO = mbLevelScope (Just clevel) (Just cscope) Just (',':cscope:_) | isJust mbO -> (fromJust mbO o, True) where mbO = mbLevelScope Nothing (Just cscope) Just olevel@(clevel:_) | isDigit clevel && l >= 0 && l < (maxscp * maxlev) -> ( o { ehcOptOptimizationLevel = toEnum lev, ehcOptOptimizationScope = toEnum sc } , True ) where l = read olevel :: Int (sc,lev) = quotRem l maxlev Just scpname@(_:_) | isJust mbScp -> ( o { ehcOptOptimizationScope = sc } , True ) where mbScp@(~(Just sc)) = Map.lookup scpname allOptimScopeMp Just optname@(_:_) -> case break (== '=') optname of (nm, yesno) -> ( o { ehcOptOptimizations = os , ehcOptOptimizeOptionMp = osmp `Map.union` ehcOptOptimizeOptionMp o } , False ) where set True opt = Set.insert opt $ ehcOptOptimizations o set False opt = Set.delete opt $ ehcOptOptimizations o (os,osmp) = -- lookup name, and attempt to extract boolean of assumedly '=' prefixed string, or if not a boolean try to extract specific config whilst also assuming True for the boolean case (Map.lookup nm allOptimizeMp, optArgTake optArgAllAllow $ drop 1 yesno) of (Just opt, Just (OptArg_Bool b,_ )) -> (set b opt , Map.empty) (Just opt, Just (OptArg_Int i,_ )) -> (set True opt , optimizeOptionMpSingleton opt optopt v) where (optopt,optdflt) = allOptimizeOptionMpAnyOption opt v = maybe optdflt (\(_,(lo,_)) -> toEnum $ fromEnum lo + i) $ mapLookup2 opt optopt allOptimizeOptionMp (Just opt, _ ) -> (set True opt , Map.empty) _ -> (ehcOptOptimizations o , Map.empty) Nothing -> (o { ehcOptOptimizationLevel = OptimizationLevel_Much }, True) _ -> (o, False) os | doSetOpts = Map.findWithDefault Set.empty (ehcOptOptimizationLevel o') optimizationLevelMp | otherwise = ehcOptOptimizations o' maxlev = fromEnum (maxBound :: OptimizationLevel) + 1 maxscp = fromEnum (maxBound :: OptimizationScope) + 1 mbLevelScope ml ms | isJust l && isJust s = Just (\o -> o { ehcOptOptimizationLevel = toEnum (fromJust l), ehcOptOptimizationScope = toEnum (fromJust s) }) | otherwise = Nothing where l = r ehcOptOptimizationLevel maxlev ml s = r ehcOptOptimizationScope maxscp ms r :: Enum x => (EHCOpts -> x) -> Int -> Maybe Char -> Maybe Int r dflt mx m | x >= 0 && x < mx = Just x | otherwise = Nothing where x = (maybe (fromEnum $ dflt o) (\c -> read [c]) m) :: Int oNoRecomp o = o { ehcOptCheckRecompile = False } oCompileOnly o = o { ehcOptLinkingStyle = LinkingStyle_None } oNoHiCheck o = o { ehcOptHiValidityCheck = False } oUsrFileLocPath s o = o { ehcOptImportFileLocPath = ehcOptImportFileLocPath o ++ mkFileLocPath s } oLibFileLocPath s o = o { ehcOptLibFileLocPath = ehcOptLibFileLocPath o ++ mkFileLocPath s } oPkgdirLocPath s o = o { ehcOptPkgdirLocPath = ehcOptPkgdirLocPath o ++ mkStringPath s } oNoPrelude o = o { ehcOptUseAssumePrelude = False } oCPP o = o { ehcOptCPP = True } oLimitTyBetaRed o l = o { ehcOptTyBetaRedCutOffAt = l } oLimitCtxtRed o l = o { ehcOptPrfCutOffAt = l } oMetaPkgdirSys o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Pkgdir_System } oMetaPkgdirUser o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Pkgdir_User } oExposePackage s o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ pkgSearchFilter parsePkgKey PackageSearchFilter_ExposePkg [s] -- , ehcOptLibPackages = ehcOptLibPackages o ++ [s] } oHidePackage s o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ pkgSearchFilter parsePkgKey PackageSearchFilter_HidePkg [s] } oHideAllPackages o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ [PackageSearchFilter_HideAll] -- , ehcOptHideAllPackages = True } oOutputDir s o = o { ehcOptOutputDir = Just s -- no linking when no output file is generated. This is not failsafe, requires better solution as now no executable is generated when no --output is specified. Should depend on existence of main. -- , ehcOptDoExecLinking = isJust (ehcOptMbOutputFile o) } oOutputFile s o = o { ehcOptMbOutputFile = Just (mkFPath s) , ehcOptLinkingStyle = LinkingStyle_Exec } oKeepIntermediateFiles o = o { ehcOptKeepIntermediateFiles = True } oPkgBuild s o = o { ehcOptPkgOpt = Just ((maybe emptyPkgOption id $ ehcOptPkgOpt o) {pkgoptName=s}) , ehcOptLinkingStyle = LinkingStyle_Pkg } oPkgBuildExposedModules s o = o { ehcOptPkgOpt = Just ((maybe emptyPkgOption id $ ehcOptPkgOpt o) {pkgoptExposedModules = words s}) } oPkgBuildBuildDepends s o = o { ehcOptPkgOpt = Just ((maybe emptyPkgOption id $ ehcOptPkgOpt o) {pkgoptBuildDepends = words s}) } oCfgInstallRoot s o = o { ehcOptCfgInstallRoot = Just s } oCfgInstallVariant s o = o { ehcOptCfgInstallVariant = Just s } oCmdLineOpts cmd s o = o { ehcOptCmdLineOpts = -- (\v -> tr "XX" (pp s >#< show v) v) $ nub $ ehcOptCmdLineOpts o ++ fst (parseCmdLineOpts cmd s) } oPgmExec cmd s o = o { ehcOptPgmExecMp = Map.insert cmd s $ ehcOptPgmExecMp o } {-# LINE 722 "src/ehc/Opts.chs" #-} -- | Sort options according to long descr field sortOptions :: GetOptCmdLineOpts -> GetOptCmdLineOpts sortOptions = sortOn (\(Option _ d _ _) -> d) {-# LINE 732 "src/ehc/Opts.chs" #-} -- | Commandline opts for ehcr/uhcr (EHCRun) ehcrunCmdLineOpts :: GetOptCmdLineOpts ehcrunCmdLineOpts = sortOptions $ sharedCmdLineOpts ++ [ Option "" ["trace"] (boolArg optTrace) "corerun: trace execution" ] where optTrace o b = o { ehcOptCoreOpts = upd $ ehcOptCoreOpts o } where upd | b = (CoreOpt_RunTrace :) | otherwise = (\\ [CoreOpt_RunTrace]) {-# LINE 753 "src/ehc/Opts.chs" #-} -- | The description for GetOpt type GetOptCmdLineOpts = [OptDescr (EHCOpts -> EHCOpts)] -- | Commandline opts shared between main invocations sharedCmdLineOpts :: GetOptCmdLineOpts sharedCmdLineOpts = [ Option "h" ["help"] (NoArg oHelp) "print this help (then stop)" , Option "" ["version"] (NoArg oVersion) "print version info (then stop)" , Option "" ["version-dotted"] (NoArg oNumVersion) ("print version in \"x.y.z\" style (then stop)") , Option "" ["version-asnumber"] (NoArg oVersionAsNumber) ("print version in \"xyz\" style (then stop)") , Option "" ["numeric-version"] (NoArg oNumVersion) "see --version-dotted (to become obsolete)" , Option "" ["driver-alt"] (NoArg oAltDriver) "driver: toggle alternate compiler driver (under development, default off, for uhcr default on)" , Option "" ["debug-traceon"] (ReqArg oTraceOn "aspects") ("debug: trace on specific aspects: " ++ showStr2stMp allTraceOnMp) , Option "v" ["verbose"] (OptArg oVerbose "0|1|2|3|4") ( "be verbose, 0=quiet, 4=debug, " ++ "default=1" ) , Option "" ["ehopt"] (ReqArg oOptEh "opt[,...]") ("opts (specific) for EH: " ++ showStr2stMp ehOptMp) , Option "" ["coreopt"] (ReqArg oOptCore "opt[,...]") ("opts (specific) for Core: " ++ showStr2stMp coreOptMp) , Option "" ["corerunopt"] (ReqArg oOptCoreRun "opt[,...]") ("opts (specific) for CoreRun: " ++ showStr2stMp coreRunOptMp) ] {-# LINE 795 "src/ehc/Opts.chs" #-} -- | Help oHelp o = o { ehcOptImmQuit = Just ImmediateQuitOption_Help } -- | Version oVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_Version } -- | Verbosity oVerbose ms o = case ms of Just "0" -> o { ehcOptVerbosity = VerboseQuiet } Just "1" -> o { ehcOptVerbosity = VerboseMinimal } Just "2" -> o { ehcOptVerbosity = VerboseNormal } Just "3" -> o { ehcOptVerbosity = VerboseALot } Just "4" -> o { ehcOptVerbosity = VerboseDebug } Nothing -> o { ehcOptVerbosity = succ (ehcOptVerbosity o)} _ -> o {-# LINE 813 "src/ehc/Opts.chs" #-} oOptEh s o = o { ehcOptEhOpts = optOpts ehOptMp s ++ ehcOptEhOpts o} {-# LINE 817 "src/ehc/Opts.chs" #-} oOptCore s o = o { ehcOptCoreOpts = optOpts coreOptMp s ++ ehcOptCoreOpts o} {-# LINE 821 "src/ehc/Opts.chs" #-} oOptCoreRun s o = o { ehcOptCoreRunOpts = Set.fromList (optOpts coreRunOptMp s) `Set.union` ehcOptCoreRunOpts o} {-# LINE 825 "src/ehc/Opts.chs" #-} oNumVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionDotted } oVersionAsNumber o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionAsNumber } {-# LINE 830 "src/ehc/Opts.chs" #-} oAltDriver o = o { ehcOptAltDriver = not $ ehcOptAltDriver o } oTraceOn s o = o { ehcOptTraceOn = Set.fromList (optOpts allTraceOnMp s) `Set.union` ehcOptTraceOn o } {-# LINE 839 "src/ehc/Opts.chs" #-} -- | Int option intArg tr = ReqArg (optInt tr) "" -- | EHCOpts updater for Int option optInt :: (EHCOpts -> Int -> EHCOpts) -> String -> EHCOpts -> EHCOpts optInt tr s o = tr o $ read s {-# LINE 849 "src/ehc/Opts.chs" #-} -- | What kind of optional args are allowed data OptArgAllow = OptArgAllow_Bool | OptArgAllow_Int deriving (Eq,Enum,Bounded) optArgAllAllow :: [OptArgAllow] optArgAllAllow = [minBound .. maxBound] {-# LINE 860 "src/ehc/Opts.chs" #-} -- | An optional arg, universal type for all occurring variants data OptArg = OptArg_Bool Bool | OptArg_Int Int {-# LINE 867 "src/ehc/Opts.chs" #-} optArgTake :: [OptArgAllow] -> String -> Maybe (OptArg,String) optArgTake allow s = case s of ('-':r) -> Just (OptArg_Bool False,r) ('n':'o':r) -> Just (OptArg_Bool False,r) ('n':r) -> Just (OptArg_Bool False,r) ('o':'f':'f':r) -> Just (OptArg_Bool False,r) ('0':r) | noInt -> Just (OptArg_Bool False,r) ('+':r) -> Just (OptArg_Bool True ,r) ('y':'e':'s':r) -> Just (OptArg_Bool True ,r) ('y':r) -> Just (OptArg_Bool True ,r) ('o':'n':r) -> Just (OptArg_Bool True ,r) ('1':r) | noInt -> Just (OptArg_Bool True ,r) ( c :_) | yesInt && isDigit c -> Just (OptArg_Int (read d) ,r) where (d,r) = span isDigit s _ -> Nothing where yesInt = OptArgAllow_Int `elem` allow noInt = not yesInt {-# LINE 889 "src/ehc/Opts.chs" #-} optBooleanTake :: String -> Maybe (Bool,String) optBooleanTake s = case optArgTake [OptArgAllow_Bool] s of Just (OptArg_Bool b, r) -> Just (b,r) _ -> Nothing optBoolean :: (EHCOpts -> Bool -> EHCOpts) -> Maybe String -> EHCOpts -> EHCOpts optBoolean tr ms o = case ms of Just s -> maybe o (tr o . fst) (optBooleanTake s) _ -> o boolArgStr = "Bool" boolArg tr = OptArg (optBoolean tr) boolArgStr {-# LINE 910 "src/ehc/Opts.chs" #-} oPriv o b = o { ehcOptPriv = b } {-# LINE 914 "src/ehc/Opts.chs" #-} oUnderDev s o = o { ehcOptUnderDev = {- Set.fromList (optOpts allUnderDevMp s) `Set.union` ehcOptUnderDev o -- -} foldr (\ud o -> if Set.member ud o then Set.delete ud o else Set.insert ud o) (ehcOptUnderDev o) (optOpts allUnderDevMp s) } {-# LINE 920 "src/ehc/Opts.chs" #-} optDumpCoreStages o b = o { ehcOptDumpCoreStages = b } {-# LINE 928 "src/ehc/Opts.chs" #-} oSetGenTrampoline o b = o { ehcOptGenTrampoline_ = b } {-# LINE 948 "src/ehc/Opts.chs" #-} oStopAtCoreError o b = o { ehcDebugStopAtCoreError = b } {-# LINE 952 "src/ehc/Opts.chs" #-} oStopAtHIError o b = o { ehcDebugStopAtHIError = b } {-# LINE 960 "src/ehc/Opts.chs" #-} -- | Apply the cmdline opts description to a EHCOpts, returning Nothing when there were no options cmdlineOptsApply :: [OptDescr (EHCOpts -> EHCOpts)] -> [EHCOpts -> EHCOpts] -> [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) cmdlineOptsApply cmdlopts postopts args opts = (if null o' then Nothing else Just (foldl (flip ($)) opts o'),n,errs) where oo@(o,n,errs) = getOpt Permute cmdlopts args o' = o ++ postopts -- | Apply the cmdline opts description for 'EHC' to a EHCOpts, returning Nothing when there were no options ehcCmdLineOptsApply :: [EHCOpts -> EHCOpts] -> [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) ehcCmdLineOptsApply = cmdlineOptsApply ehcCmdLineOpts -- | Apply the cmdline opts description for 'EHCRun' to a EHCOpts, returning Nothing when there were no options ehcrunCmdLineOptsApply :: [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) ehcrunCmdLineOptsApply = cmdlineOptsApply ehcrunCmdLineOpts [] {-# LINE 981 "src/ehc/Opts.chs" #-} optsDiscrRecompileRepr :: EHCOpts -> String optsDiscrRecompileRepr opts = concat $ intersperse " " $ [ show (ehcOptAspects opts) , o "clsrec" (ehcCfgClassViaRec opts) -- , o "exec" (ehcOptEmitExecC opts) -- , o "bexec" (ehcOptEmitExecBytecode opts) , show (ehcOptTarget opts) , show (ehcOptOptimizationLevel opts) ] where o m v = if v then m else "" {-# LINE 1002 "src/ehc/Opts.chs" #-} data FIOBind = FIOBindYes | FIOBindNoBut TyVarIdS deriving (Show) {-# LINE 1008 "src/ehc/Opts.chs" #-} data FIOpts = FIOpts { fioLeaveRInst :: !Bool , fioBindRFirst :: !Bool , fioBindLFirst :: !Bool , fioBindLBeforeR :: !Bool , fioMode :: !FIMode , fioUniq :: !UID , fioBindCategs :: ![TyVarCateg] , fioNoRLabElimFor :: ![HsName] , fioNoLLabElimFor :: ![HsName] , fioDontBind :: !TyVarIdS , fioExpandEqTyVar :: !Bool -- expand tyvars also when equal. Required for Sys F translation. , fioPredAsTy :: !Bool , fioAllowRPredElim :: !Bool , fioBindLVars :: !FIOBind , fioBindRVars :: !FIOBind , fiMbMkErrClash :: Maybe (Ty -> Ty -> Err) -- alternate error construction for type clash } {-# LINE 1042 "src/ehc/Opts.chs" #-} fioBindNoSet :: FIOBind -> TyVarIdS fioBindNoSet (FIOBindNoBut s) = s fioBindNoSet _ = Set.empty fioBindIsYes :: FIOBind -> Bool fioBindIsYes FIOBindYes = True fioBindIsYes _ = False {-# LINE 1052 "src/ehc/Opts.chs" #-} strongFIOpts :: FIOpts strongFIOpts = FIOpts { fioLeaveRInst = False , fioBindRFirst = True , fioBindLFirst = True , fioBindLBeforeR = True , fioMode = FitSubLR , fioUniq = uidStart , fioBindCategs = [TyVarCateg_Plain] , fioNoRLabElimFor = [] , fioNoLLabElimFor = [] , fioDontBind = Set.empty , fioExpandEqTyVar = False , fioPredAsTy = False , fioAllowRPredElim = True , fioBindLVars = FIOBindYes , fioBindRVars = FIOBindYes , fiMbMkErrClash = Nothing } {-# LINE 1082 "src/ehc/Opts.chs" #-} instance Show FIOpts where show o = "FIOpts" {-# LINE 1087 "src/ehc/Opts.chs" #-} instance PP FIOpts where pp o = "FIOpts{" >#< "leaveRInst=" >|< pp (fioLeaveRInst o) >#< "bindLFirst=" >|< pp (fioBindLFirst o) >#< "bindRFirst=" >|< pp (fioBindRFirst o) >#< "fioNoLLabElimFor=" >|< pp (show $ fioNoLLabElimFor o) >#< "fioNoRLabElimFor=" >|< pp (show $ fioNoRLabElimFor o) >#< "allowRPredElim=" >|< pp (fioAllowRPredElim o) >#< "}" {-# LINE 1103 "src/ehc/Opts.chs" #-} instLFIOpts :: FIOpts instLFIOpts = strongFIOpts {fioBindRFirst = False} {-# LINE 1108 "src/ehc/Opts.chs" #-} instLRFIOpts :: FIOpts instLRFIOpts = strongFIOpts {fioBindRFirst = False, fioBindLFirst = False} {-# LINE 1113 "src/ehc/Opts.chs" #-} unifyFIOpts :: FIOpts unifyFIOpts = strongFIOpts {fioMode = FitUnify} instFIOpts :: FIOpts instFIOpts = instLFIOpts {fioLeaveRInst = True, fioBindLFirst = False} {-# LINE 1121 "src/ehc/Opts.chs" #-} weakFIOpts :: FIOpts weakFIOpts = fioMkWeak strongFIOpts {-# LINE 1126 "src/ehc/Opts.chs" #-} predFIOpts :: FIOpts predFIOpts = strongFIOpts {fioPredAsTy = True, fioLeaveRInst = True} implFIOpts :: FIOpts implFIOpts = strongFIOpts {fioAllowRPredElim = False} {-# LINE 1134 "src/ehc/Opts.chs" #-} fioSwapOpts :: FIOpts -> FIOpts fioSwapOpts fio = fio { fioBindRFirst = fioBindLFirst fio , fioBindLFirst = fioBindRFirst fio , fioBindLBeforeR = not (fioBindLBeforeR fio) , fioBindLVars = fioBindRVars fio , fioBindRVars = fioBindLVars fio } fioSwapPolarity :: Polarity -> FIOpts -> FIOpts fioSwapPolarity pol fio = fio {fioMode = fimSwapPol pol (fioMode fio)} {-# LINE 1151 "src/ehc/Opts.chs" #-} fioMkStrong :: FIOpts -> FIOpts fioMkStrong fi = fi {fioLeaveRInst = False, fioBindRFirst = True, fioBindLFirst = True} {-# LINE 1156 "src/ehc/Opts.chs" #-} fioMkWeak :: FIOpts -> FIOpts fioMkWeak fi = fi {fioLeaveRInst = True, fioBindRFirst = False} {-# LINE 1161 "src/ehc/Opts.chs" #-} -- | Adapt options for extracting final ty fioMkFinal :: FIOpts -> FIOpts fioMkFinal fi = fi {fioBindLFirst = False, fioBindRFirst = False, fioExpandEqTyVar = True} {-# LINE 1167 "src/ehc/Opts.chs" #-} fioMkUnify :: FIOpts -> FIOpts fioMkUnify fi = fi {fioMode = FitUnify} {-# LINE 1176 "src/ehc/Opts.chs" #-} fioIsSubsume :: FIOpts -> Bool fioIsSubsume fio = case fioMode fio of {FitSubLR -> True ; _ -> False}