module UHC.Light.Compiler.Opts.Base
( ImmediateQuitOption (..)
, EhOpt (..)
, EHCOpts (..)
, emptyEHCOpts
, ehcOptEhAstPP, ehcOptEhAstPPExtensive
, ehcOptFromJust
, ehcOptIsUnderDev
, InOrOutputFor (..)
, CoreOpt (..)
, ehcOptEhPP
, ehcOptTarget, ehcOptTargetFlavor
, ehcOptCoreSysF, ehcOptCoreSysFCheck, ehcOptCoreSysFGen, ehcOptCoreSysFCheckOnlyVal
, ehcOptEmitExecBytecode, ehcOptEmitBytecode
, ehcOptCmmCheck
, ehcOptIsViaGrinCmmJavaScript, ehcOptIsViaCoreJavaScript
, ehcOptIsViaCmm
, ehcOptIsViaGrin
, ehcOptBuiltin, ehcOptBuiltin2
, ehcOptDoExecLinking
, PkgOption (..), emptyPkgOption
, PgmExec (..)
, ExecOpt (..), execOptsPlain )
where
import UHC.Light.Compiler.Base.Common
import UHC.Util.Utils
import Data.Typeable
import Data.Maybe
import qualified Data.Map as Map
import UHC.Light.Compiler.Base.UnderDev
import UHC.Util.Pretty
import qualified Data.Set as Set
import Data.List
import Data.Char
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 qualified UHC.Light.Compiler.ConfigInstall as Cfg
import UHC.Light.Compiler.Base.Pragma
import UHC.Light.Compiler.Opts.CommandLine
data ImmediateQuitOption
= ImmediateQuitOption_Help
| ImmediateQuitOption_Version
| ImmediateQuitOption_Meta_Variant
| ImmediateQuitOption_Meta_Targets
| ImmediateQuitOption_Meta_TargetDefault
| ImmediateQuitOption_Meta_Optimizations
| ImmediateQuitOption_Meta_Pkgdir_System
| ImmediateQuitOption_Meta_Pkgdir_User
| ImmediateQuitOption_VersionDotted
| ImmediateQuitOption_VersionAsNumber
data InOrOutputFor
= OutputFor_Module
| OutputFor_Pkg
| InputFrom_Loc FileLoc
data PkgOption
= PkgOption
{ pkgoptName :: PkgName
, pkgoptExposedModules :: [String]
, pkgoptBuildDepends :: [PkgName]
}
emptyPkgOption :: PkgOption
emptyPkgOption = PkgOption emptyPkgName [] []
data EhOpt
= EhOpt_NONE
| EhOpt_Dump
| EhOpt_DumpAST
deriving (Eq, Ord, Enum, Bounded)
data CoreOpt
= CoreOpt_NONE
| CoreOpt_Readable
| CoreOpt_Dump
| CoreOpt_DumpBinary
| CoreOpt_DumpAlsoNonParseable
| CoreOpt_Run
| CoreOpt_LoadOnly
| CoreOpt_RunDump
| CoreOpt_RunDumpVerbose
| CoreOpt_RunTrace
| CoreOpt_RunTraceExtensive
| CoreOpt_RunPPNames
| CoreOpt_RunPPVerbose
deriving (Eq,Enum,Bounded)
data PgmExec
= PgmExec_CPP
| PgmExec_C
| PgmExec_Linker
deriving (Eq,Ord,Enum,Bounded)
data ExecOpt
= ExecOpt_Plain String
| ExecOpt_Output (String -> String)
execOptsPlain :: [ExecOpt] -> [String]
execOptsPlain o = [ s | ExecOpt_Plain s <- o ]
data EHCOpts
= EHCOpts
{ ehcOptTrace :: forall a . String -> a -> a
, ehcOptAspects :: String
, ehcOptShowHS :: Bool
, ehcOptShowEH :: Bool
, ehcOptEhOpts :: [EhOpt]
, ehcOptUnderDev :: Set.Set UnderDev
, ehcOptPriv :: Bool
, ehcOptHsChecksInEH :: Bool
, ehcOptShowTopTyPP :: Bool
, ehcOptImmQuit :: Maybe ImmediateQuitOption
, ehcOptDebug :: Bool
, ehcStopAtPoint :: CompilePoint
, ehcOptPolyKinds :: Bool
, ehcOptExtensibleRecords
:: Bool
, ehcOptMbTarget :: MaybeOk Target
, ehcOptMbTargetFlavor :: MaybeOk TargetFlavor
, ehcOptBangPatterns :: Bool
, ehcOptOptimizationLevel
:: OptimizationLevel
, ehcOptOptimizationScope
:: OptimizationScope
, ehcOptOptimizations :: OptimizeS
, ehcOptOptimizeOptionMp
:: OptimizeOptionMp
, ehcOptDumpCoreStages :: Bool
, ehcOptCoreOpts :: [CoreOpt]
, ehcOptGenTrampoline_ :: Bool
, ehcOptGenTrace :: Bool
, ehcOptEmitHS :: Bool
, ehcOptEmitEH :: Bool
, ehcOptImportFileLocPath
:: FileLocPath
, ehcOptVerbosity :: Verbosity
, ehcOptTraceOn :: !(Set.Set TraceOn)
, ehcOptBuiltinNames :: EHBuiltinNames
, ehcOptEnvironment :: EHCEnvironment
, ehcCfgInstFldHaveSelf:: Bool
, ehcOptPrfCutOffAt :: Int
, ehcCfgClassViaRec :: Bool
, ehcOptTyBetaRedCutOffAt
:: Int
, ehcDebugStopAtCoreError
:: Bool
, ehcOptCheckRecompile :: Bool
, ehcDebugStopAtHIError:: Bool
, ehcOptLinkingStyle :: LinkingStyle
, ehcOptGenGenerics :: Bool
, ehcOptFusion :: Bool
, ehcOptAltDriver :: Bool
, ehcOptHiValidityCheck:: Bool
, ehcOptLibFileLocPath :: FileLocPath
, ehcOptPkgdirLocPath :: StringPath
, ehcOptPkgDb :: PackageDatabase
, ehcProgName :: FPath
, ehcCurDir :: String
, ehcOptUserDir :: String
, ehcOptMbOutputFile :: Maybe FPath
, ehcOptCPP :: Bool
, ehcOptUseAssumePrelude
:: Bool
, ehcOptPackageSearchFilter
:: [PackageSearchFilter]
, ehcOptOutputDir :: Maybe String
, ehcOptKeepIntermediateFiles
:: Bool
, ehcOptPkgOpt :: Maybe PkgOption
, ehcOptCfgInstallRoot :: Maybe String
, ehcOptCfgInstallVariant :: Maybe String
, ehcOptCmdLineOpts :: CmdLineOpts
, ehcOptCmdLineOptsDoneViaPragma
:: Bool
, ehcOptOverloadedStrings
:: Bool
, ehcOptPgmExecMp :: Map.Map PgmExec FilePath
, ehcOptExecOptsMp :: Map.Map FilePath [ExecOpt]
}
deriving Typeable
emptyEHCOpts
= EHCOpts
{ ehcOptTrace = \_ x -> x
, ehcOptAspects = "base codegen core corebackend corein coreout corerun corerunin hmtyinfer noHmTyRuler"
, ehcOptShowHS = False
, ehcOptEhOpts = []
, ehcOptPriv = False
, ehcOptUnderDev = Set.fromList
[ UnderDev_NameAnalysis
, UnderDev_NamedInst
]
, ehcOptHsChecksInEH = False
, ehcOptShowEH = False
, ehcOptShowTopTyPP = False
, ehcOptImmQuit = Nothing
, ehcOptDebug = False
, ehcStopAtPoint = CompilePoint_All
, ehcOptPolyKinds = False
, ehcOptExtensibleRecords= False
, ehcOptMbTarget = JustOk defaultTarget
, ehcOptMbTargetFlavor = JustOk defaultTargetFlavor
, ehcOptBangPatterns = True
, ehcOptOptimizationLevel= OptimizationLevel_Normal
, ehcOptOptimizationScope= OptimizationScope_PerModule
, ehcOptDumpCoreStages = False
, ehcOptOptimizations = optimizeRequiresClosure $ Map.findWithDefault Set.empty OptimizationLevel_Normal optimizationLevelMp
, ehcOptOptimizeOptionMp = Map.empty
, ehcOptCoreOpts = []
, ehcOptGenTrampoline_ = False
, ehcOptGenTrace = False
, ehcOptVerbosity = VerboseMinimal
, ehcOptTraceOn = Set.empty
, ehcOptEmitHS = False
, ehcOptEmitEH = False
, ehcOptImportFileLocPath= []
, ehcOptBuiltinNames = mkEHBuiltinNames (const id)
, ehcOptEnvironment = undefined
, ehcCfgInstFldHaveSelf = False
, ehcOptPrfCutOffAt = 20
, ehcCfgClassViaRec = False
, ehcOptTyBetaRedCutOffAt
= 10
, ehcDebugStopAtCoreError= False
, ehcOptCheckRecompile = True
, ehcDebugStopAtHIError = False
, ehcOptLinkingStyle = LinkingStyle_Exec
, ehcOptGenGenerics = True
, ehcOptFusion = False
, ehcOptAltDriver = False
, ehcOptHiValidityCheck = True
, ehcOptLibFileLocPath = []
, ehcOptPkgdirLocPath = []
, ehcOptPkgDb = emptyPackageDatabase
, ehcProgName = emptyFPath
, ehcCurDir = ""
, ehcOptUserDir = ""
, ehcOptMbOutputFile = Nothing
, ehcOptCPP = False
, ehcOptUseAssumePrelude = True
, ehcOptPackageSearchFilter
= []
, ehcOptOutputDir = Nothing
, ehcOptKeepIntermediateFiles
= False
, ehcOptPkgOpt = Nothing
, ehcOptCfgInstallRoot = Nothing
, ehcOptCfgInstallVariant= Nothing
, ehcOptCmdLineOpts = []
, ehcOptCmdLineOptsDoneViaPragma
= False
, ehcOptOverloadedStrings= False
, ehcOptPgmExecMp = Map.empty
, ehcOptExecOptsMp = Map.empty
}
ehcOptEhAstPP :: EHCOpts -> Bool
ehcOptEhAstPP opts =
EhOpt_DumpAST `elem` ehcOptEhOpts opts
ehcOptEhAstPPExtensive :: EHCOpts -> Bool
ehcOptEhAstPPExtensive opts = (ehcOptEhAstPP opts && ehcOptDebug opts) || EhOpt_DumpAST `elem` ehcOptEhOpts opts
ehcOptEhPP :: EHCOpts -> Bool
ehcOptEhPP opts = ehcOptShowEH opts || ehcOptEmitEH opts || EhOpt_Dump `elem` ehcOptEhOpts opts
ehcOptTarget :: EHCOpts -> Target
ehcOptTarget = maybeOk (\s -> panic ("ehcOptTarget: " ++ s)) id . ehcOptMbTarget
ehcOptTargetFlavor :: EHCOpts -> TargetFlavor
ehcOptTargetFlavor = maybeOk (\s -> panic ("ehcOptTargetFlavor: " ++ s)) id . ehcOptMbTargetFlavor
ehcOptCoreSysF :: EHCOpts -> Bool
ehcOptCoreSysF _ = False
ehcOptCoreSysFCheck :: EHCOpts -> Bool
ehcOptCoreSysFCheck _ = False
ehcOptCoreSysFGen :: EHCOpts -> Bool
ehcOptCoreSysFGen opts = ehcOptCoreSysF opts
ehcOptCoreSysFCheckOnlyVal :: EHCOpts -> Bool
ehcOptCoreSysFCheckOnlyVal opts = ehcOptCoreSysFCheck opts
ehcOptEmitExecBytecode :: EHCOpts -> Bool
ehcOptEmitExecBytecode _ = False
ehcOptEmitBytecode :: EHCOpts -> Bool
ehcOptEmitBytecode _ = False
ehcOptCmmCheck :: EHCOpts -> Bool
ehcOptCmmCheck _ = False
ehcOptIsViaGrinCmmJavaScript :: EHCOpts -> Bool
ehcOptIsViaGrinCmmJavaScript opts
= False
ehcOptIsViaCoreJavaScript :: EHCOpts -> Bool
ehcOptIsViaCoreJavaScript opts
= targetIsViaCoreJavaScript t
where t = ehcOptTarget opts
ehcOptIsViaCmm :: EHCOpts -> Bool
ehcOptIsViaCmm opts = ehcOptIsViaGrinCmmJavaScript opts
ehcOptIsViaGrin :: EHCOpts -> Bool
ehcOptIsViaGrin opts = ehcOptIsViaGrinCmmJavaScript opts || targetIsGrinBytecode t || targetDoesHPTAnalysis t
where t = ehcOptTarget opts
ehcOptBuiltin :: EHCOpts -> (EHBuiltinNames -> x) -> x
ehcOptBuiltin o f = f $ ehcOptBuiltinNames o
ehcOptBuiltin2 :: EHCOpts -> (EHBuiltinNames -> Int -> HsName) -> Int -> HsName
ehcOptBuiltin2 o f i = f (ehcOptBuiltinNames o) i
ehcOptFromJust :: EHCOpts -> String -> a -> Maybe a -> a
ehcOptFromJust opts panicMsg n m
| ehcOptDebug opts = maybe n id m
| otherwise = panicJust panicMsg m
ehcOptDoExecLinking :: EHCOpts -> Bool
ehcOptDoExecLinking opts = ehcOptLinkingStyle opts == LinkingStyle_Exec
ehcOptIsUnderDev :: UnderDev -> EHCOpts -> Bool
ehcOptIsUnderDev ud opts = ud `Set.member` ehcOptUnderDev opts