module UHC.Light.Compiler.Opts
( module UHC.Light.Compiler.Opts.Base
, optOptsIsYes, showStr2stMp
, defaultEHCOpts
, ehcCmdLineOpts
, 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.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.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
import UHC.Light.Compiler.Base.Debug
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
mkStringPath :: String -> [String]
mkStringPath = wordsBy (`elem` ";,")
mkFileLocPath :: String -> FileLocPath
mkFileLocPath = map mkDirFileLoc . mkStringPath
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
instance Show CoreOpt where
show CoreOpt_Dump = "dump"
show CoreOpt_DumpBinary = "dump-binary"
show CoreOpt_DumpAlsoNonParseable = "whendump-alsononparseable"
show CoreOpt_Run = "run"
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]
instance Show PgmExec where
show PgmExec_CPP = "P"
show PgmExec_C = "c"
show PgmExec_Linker = "l"
pgmExecMp :: Map.Map String PgmExec
pgmExecMp = str2stMp
ehcOptWholeProgOptimizationScope :: EHCOpts -> Bool
ehcOptWholeProgOptimizationScope opts
= ehcOptOptimizationScope opts > OptimizationScope_PerModule
ehcOptEarlyModMerge :: EHCOpts -> Bool
ehcOptEarlyModMerge opts
= ehcOptOptimizationScope opts >= OptimizationScope_WholeCore
ehcOptWholeProgHPTAnalysis :: EHCOpts -> Bool
ehcOptWholeProgHPTAnalysis opts
= False
ehcOptOptimizes :: Optimize -> EHCOpts -> Bool
ehcOptOptimizes o opts = o `Set.member` ehcOptOptimizations opts
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"])
]
}
ehcCmdLineOpts :: GetOptCmdLineOpts
ehcCmdLineOpts = 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 "O" ["optimise"] (OptArg oOptimization ("0|1|2|3|<opt>[=" ++ boolArgStr ++ "]"))
("optimise with level or specific <opt> 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 <pkg>/<variant>/<target>/<flavor>"
, 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)"
, Option "" ["coreopt"] (ReqArg oOptCore "opt[,...]") ("opts (specific) for core: " ++ showStr2stMp coreOptMp)
]
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
}
oOptCore s o = o { ehcOptCoreOpts = optOpts coreOptMp s ++ ehcOptCoreOpts o}
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
Just "core" -> o { ehcOptMbTarget = JustOk Target_None_Core_AsIs
}
Just "tycore"-> o { ehcOptMbTarget = JustOk Target_None_TyCore_None
}
_ -> 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)
=
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 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]
}
oHidePackage s o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ pkgSearchFilter parsePkgKey PackageSearchFilter_HidePkg [s]
}
oHideAllPackages o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ [PackageSearchFilter_HideAll]
}
oOutputDir s o = o { ehcOptOutputDir = Just s
}
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 =
nub $ ehcOptCmdLineOpts o ++ fst (parseCmdLineOpts cmd s) }
oPgmExec cmd s o = o { ehcOptPgmExecMp = Map.insert cmd s $ ehcOptPgmExecMp o }
ehcrunCmdLineOpts :: GetOptCmdLineOpts
ehcrunCmdLineOpts
= 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])
type GetOptCmdLineOpts = [OptDescr (EHCOpts -> EHCOpts)]
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: use alternate compiler driver (under development)"
, Option "v" ["verbose"] (OptArg oVerbose "0|1|2|3|4") ( "be verbose, 0=quiet, 4=debug, "
++ "default=1"
)
]
oHelp o = o { ehcOptImmQuit = Just ImmediateQuitOption_Help }
oVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_Version }
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
oNumVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionDotted }
oVersionAsNumber o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionAsNumber }
oAltDriver o = o { ehcOptAltDriver = True }
intArg tr = ReqArg (optInt tr) "<nr>"
optInt :: (EHCOpts -> Int -> EHCOpts) -> String -> EHCOpts -> EHCOpts
optInt tr s o
= tr o $ read s
data OptArgAllow
= OptArgAllow_Bool
| OptArgAllow_Int
deriving (Eq,Enum,Bounded)
optArgAllAllow :: [OptArgAllow]
optArgAllAllow = [minBound .. maxBound]
data OptArg
= OptArg_Bool Bool
| OptArg_Int Int
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
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
oPriv o b = o { ehcOptPriv = b }
optDumpCoreStages o b = o { ehcOptDumpCoreStages = b }
oSetGenTrampoline o b = o { ehcOptGenTrampoline_ = b }
oStopAtCoreError o b = o { ehcDebugStopAtCoreError = b }
oStopAtHIError o b = o { ehcDebugStopAtHIError = b }
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
ehcCmdLineOptsApply :: [EHCOpts -> EHCOpts] -> [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String])
ehcCmdLineOptsApply = cmdlineOptsApply ehcCmdLineOpts
ehcrunCmdLineOptsApply :: [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String])
ehcrunCmdLineOptsApply = cmdlineOptsApply ehcrunCmdLineOpts []
optsDiscrRecompileRepr :: EHCOpts -> String
optsDiscrRecompileRepr opts
= concat
$ intersperse " "
$ [ show (ehcOptAspects opts)
, o "clsrec" (ehcCfgClassViaRec opts)
, show (ehcOptTarget opts)
, show (ehcOptOptimizationLevel opts)
]
where o m v = if v then m else ""
data FIOBind
= FIOBindYes | FIOBindNoBut TyVarIdS
deriving (Show)
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
, fioPredAsTy :: !Bool , fioAllowRPredElim :: !Bool
, fioBindLVars :: !FIOBind , fioBindRVars :: !FIOBind
, fiMbMkErrClash :: Maybe (Ty -> Ty -> Err)
}
fioBindNoSet :: FIOBind -> TyVarIdS
fioBindNoSet (FIOBindNoBut s) = s
fioBindNoSet _ = Set.empty
fioBindIsYes :: FIOBind -> Bool
fioBindIsYes FIOBindYes = True
fioBindIsYes _ = False
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
}
instance Show FIOpts where
show o = "FIOpts"
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)
>#< "}"
instLFIOpts :: FIOpts
instLFIOpts = strongFIOpts {fioBindRFirst = False}
instLRFIOpts :: FIOpts
instLRFIOpts = strongFIOpts {fioBindRFirst = False, fioBindLFirst = False}
unifyFIOpts :: FIOpts
unifyFIOpts = strongFIOpts {fioMode = FitUnify}
instFIOpts :: FIOpts
instFIOpts = instLFIOpts {fioLeaveRInst = True, fioBindLFirst = False}
weakFIOpts :: FIOpts
weakFIOpts = fioMkWeak strongFIOpts
predFIOpts :: FIOpts
predFIOpts = strongFIOpts {fioPredAsTy = True, fioLeaveRInst = True}
implFIOpts :: FIOpts
implFIOpts = strongFIOpts {fioAllowRPredElim = False}
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)}
fioMkStrong :: FIOpts -> FIOpts
fioMkStrong fi = fi {fioLeaveRInst = False, fioBindRFirst = True, fioBindLFirst = True}
fioMkWeak :: FIOpts -> FIOpts
fioMkWeak fi = fi {fioLeaveRInst = True, fioBindRFirst = False}
fioMkFinal :: FIOpts -> FIOpts
fioMkFinal fi = fi {fioBindLFirst = False, fioBindRFirst = False, fioExpandEqTyVar = True}
fioMkUnify :: FIOpts -> FIOpts
fioMkUnify fi = fi {fioMode = FitUnify}
fioIsSubsume :: FIOpts -> Bool
fioIsSubsume fio = case fioMode fio of {FitSubLR -> True ; _ -> False}