-- {-# LANGUAGE TemplateHaskell #-} module UHC.Light.Compiler.Opts.Base ( ImmediateQuitOption (..) , EhOpt (..) , EHCOpts (..) , emptyEHCOpts , ehcOptEhAstPP, ehcOptEhAstPPExtensive , ehcOptFromJust , ehcOptIsUnderDev , InOrOutputFor (..) , CoreOpt (..) , CoreRunOpt (..) , 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.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 {-# LINE 75 "src/ehc/Opts/Base.chs" #-} data ImmediateQuitOption = ImmediateQuitOption_Help -- print help | ImmediateQuitOption_Version -- print version info | ImmediateQuitOption_Meta_Variant -- print variant number | ImmediateQuitOption_Meta_Targets -- print all codegeneration targets (empty if no codegen) | ImmediateQuitOption_Meta_TargetDefault -- print the default codegeneration target (dummy if no codegen) | ImmediateQuitOption_Meta_Optimizations -- print all optimizations | ImmediateQuitOption_Meta_Pkgdir_System -- print system package dir | ImmediateQuitOption_Meta_Pkgdir_User -- print user package dir | ImmediateQuitOption_VersionDotted -- print version in dotted style, for external version comparison | ImmediateQuitOption_VersionAsNumber -- print version as number, for external version comparison -- -| ImmediateQuitOption_Meta_ExportEnv (Maybe String) -- export (write) environmental info of installation -- -| ImmediateQuitOption_Meta_DirEnv -- print dir of environmental info of installation {-# LINE 99 "src/ehc/Opts/Base.chs" #-} data InOrOutputFor = OutputFor_Module | OutputFor_Pkg | InputFrom_Loc FileLoc {-# LINE 112 "src/ehc/Opts/Base.chs" #-} -- | Build pkg options, all (except obligatory name) wrapped in Maybe/[] because of possible absence. -- 20140829 AD: will be used to construct config file data PkgOption = PkgOption { pkgoptName :: PkgName -- ^ build a package with name , pkgoptExposedModules :: [String] -- ^ 20140829 AD not yet used: exposed modules , pkgoptBuildDepends :: [PkgName] -- ^ 20140829 AD not yet used: depends on pkgs } emptyPkgOption :: PkgOption emptyPkgOption = PkgOption emptyPkgName [] [] {-# LINE 130 "src/ehc/Opts/Base.chs" #-} -- | EH specific options data EhOpt = EhOpt_NONE -- no-op option | EhOpt_Dump -- dump textual EH output | EhOpt_DumpAST -- dump textual EH output, as annotated AST deriving (Eq, Ord, Enum, Bounded) {-# LINE 139 "src/ehc/Opts/Base.chs" #-} -- | Core specific options data CoreOpt = CoreOpt_NONE -- no-op option -- | CoreOpt_PPParseable -- pretty print parseable, negation means just make it readable | CoreOpt_Readable -- when there is a choice, make it more readable | CoreOpt_Dump | CoreOpt_DumpAST | CoreOpt_DumpBinary | CoreOpt_DumpAlsoNonParseable-- dump also the parts which are not parseable | CoreOpt_Run -- run after compilation | CoreOpt_LoadOnly -- only load what is available, to be used only (for now) by alternate compiler driver | CoreOpt_RunDump -- dump CoreRun | CoreOpt_RunDumpVerbose -- dump CoreRun, more verbose | CoreOpt_RunTrace -- trace during running CoreRun | CoreOpt_RunTraceExtensive -- trace during running CoreRun, with extensive info, implies CoreOpt_RunTrace | CoreOpt_RunPPNames -- when dump/run CoreRun print names instead of | CoreOpt_RunPPVerbose -- when dump CoreRun print more verbose info in comment deriving (Eq,Enum,Bounded) {-# LINE 170 "src/ehc/Opts/Base.chs" #-} -- | Core specific options data CoreRunOpt = CoreRunOpt_PrintResult -- Print run result deriving (Eq,Ord,Enum,Bounded,Generic) instance DataAndConName CoreRunOpt {-# LINE 203 "src/ehc/Opts/Base.chs" #-} -- | Pgm (internal program used) options, in particular alternate internal shell commands data PgmExec = PgmExec_CPP -- alternate CPP | PgmExec_C -- alternate C compiler | PgmExec_Linker -- alternate linker deriving (Eq,Ord,Enum,Bounded) {-# LINE 212 "src/ehc/Opts/Base.chs" #-} -- | Wrapper around options, adding semantics for adapting cmd specific behavior data ExecOpt = ExecOpt_Plain String -- ^ plain option | ExecOpt_Output (String -> String) -- ^ output file execOptsPlain :: [ExecOpt] -> [String] execOptsPlain o = [ s | ExecOpt_Plain s <- o ] {-# LINE 228 "src/ehc/Opts/Base.chs" #-} -- | The options to use. data EHCOpts = EHCOpts { ehcOptTrace :: forall a . String -> a -> a -- tracing , ehcOptAspects :: String -- which aspects are included in this compiler , ehcOptShowHS :: Bool -- show HS pretty print on stdout , ehcOptShowEH :: Bool -- show EH pretty print on stdout , ehcOptEhOpts :: [EhOpt] -- EH options , ehcOptUnderDev :: Set.Set UnderDev -- turning on something under development (available options change according to whim and weather) , ehcOptPriv :: Bool -- privately used (in general during switch between 2 impls of 1 feature) , ehcOptHsChecksInEH :: Bool -- do checks in EH which already have been done in HS (usually related to name absence/duplication). This is used for EH compilation only. , ehcOptShowTopTyPP :: Bool -- show EH type of expression , ehcOptImmQuit :: Maybe ImmediateQuitOption , ehcOptDebug :: Bool -- debug info , ehcStopAtPoint :: CompilePoint -- stop at (after) compile phase , ehcOptPolyKinds :: Bool -- allow kind polymorphism , ehcOptExtensibleRecords :: Bool , ehcOptMbTarget :: MaybeOk Target -- code generation target , ehcOptMbTargetFlavor :: MaybeOk TargetFlavor -- code generation target flavor , ehcOptBangPatterns :: Bool -- allow bang patterns , ehcOptOptimizationLevel :: OptimizationLevel -- optimisation level , ehcOptOptimizationScope :: OptimizationScope -- optimisation scope , ehcOptOptimizations :: OptimizeS -- individual optimizations to be done, derived from level + scope , ehcOptOptimizeOptionMp :: OptimizeOptionMp -- optimization specific configuration , ehcOptDumpCoreStages :: Bool -- dump intermediate Core transformation stages , ehcOptCoreOpts :: [CoreOpt] -- Core options , ehcOptCoreRunOpts :: !(Set.Set CoreRunOpt) -- CoreRun options , ehcOptGenTrampoline_ :: Bool -- gen trampoline with (tail) calls , ehcOptGenTrace :: Bool , ehcOptEmitHS :: Bool , ehcOptEmitEH :: Bool , ehcOptImportFileLocPath :: FileLocPath , ehcOptVerbosity :: Verbosity -- verbosity level , ehcOptTraceOn :: !(Set.Set TraceOn) -- on what to trace , ehcOptBuiltinNames :: EHBuiltinNames , ehcOptEnvironment :: EHCEnvironment -- runtime environment , ehcCfgInstFldHaveSelf:: Bool -- functions/fields of instance get as arg the dictionary as well , ehcOptPrfCutOffAt :: Int -- cut off limit for context reduction , ehcCfgClassViaRec :: Bool -- instance representation via record instead of data -- , ehcCfgCHRScoped :: CHRScoped -- how to gen scoped CHR's (option is used only for paper writing + experimenting) , ehcOptTyBetaRedCutOffAt -- cut off for type lambda expansion :: Int , ehcDebugStopAtCoreError :: Bool -- stop when Core parse error occurs (otherwise errors are ignored, repaired .core is used) , ehcOptCheckRecompile :: Bool , ehcDebugStopAtHIError:: Bool -- stop when HI parse error occurs (otherwise it is ignored, .hi thrown away) -- , ehcOptDoExecLinking :: Bool -- do link, if False compile only , ehcOptLinkingStyle :: LinkingStyle -- how to link, possibly no linking (e.g. when compile only) , ehcOptGenGenerics :: Bool -- generate for use of generics , ehcOptFusion :: Bool -- allow fusion syntax, the optimization itself is triggered by optimize flags , ehcOptAltDriver :: Bool -- alternate (build function based) compiler driver , ehcOptHiValidityCheck:: Bool -- when .hi and compiler are out of sync w.r.t. timestamp and checksum, recompile , ehcOptLibFileLocPath :: FileLocPath , ehcOptPkgdirLocPath :: StringPath , ehcOptPkgDb :: PackageDatabase -- package database to be used for searching packages , ehcProgName :: FPath -- name of this program , ehcCurDir :: String -- current dir (not an option, but set initially) , ehcOptUserDir :: String -- user dir for storing user specific stuff , ehcOptMbOutputFile :: Maybe FPath -- in which file to put generated output/executable , ehcOptCPP :: Bool -- do preprocess with C preprecessor CPP , ehcOptUseAssumePrelude -- use & assume presence of prelude :: Bool , ehcOptPackageSearchFilter :: [PackageSearchFilter] -- description of what to expose from package database , ehcOptOutputDir :: Maybe String -- where to put output, instead of same dir as input file , ehcOptKeepIntermediateFiles :: Bool -- keep intermediate files , ehcOptPkgOpt :: Maybe PkgOption -- package building (etc) option , ehcOptCfgInstallRoot :: Maybe String -- the directory where the installation resides; overrides ehcenvInstallRoot , ehcOptCfgInstallVariant :: Maybe String -- the installation variant; overrides ehcenvVariant , ehcOptCmdLineOpts :: CmdLineOpts -- options from the commandline and pragma for such options , ehcOptCmdLineOptsDoneViaPragma :: Bool -- options via OPTIONS_UHC pragma have been set , ehcOptOverloadedStrings :: Bool -- allow overloaded strings , ehcOptPgmExecMp :: Map.Map PgmExec FilePath -- alternate executables for program , ehcOptExecOptsMp :: Map.Map FilePath [ExecOpt] -- default options for commands } deriving Typeable {-# LINE 401 "src/ehc/Opts/Base.chs" #-} 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 -- 20150924 , UnderDev_NamedInst -- 20150925 ] , ehcOptHsChecksInEH = False , ehcOptShowEH = False , ehcOptShowTopTyPP = False , ehcOptImmQuit = Nothing , ehcOptDebug = False , ehcStopAtPoint = CompilePoint_All , ehcOptPolyKinds = False , ehcOptExtensibleRecords= False , ehcOptBangPatterns = False , ehcOptMbTarget = JustOk defaultTarget , ehcOptMbTargetFlavor = JustOk defaultTargetFlavor , ehcOptOptimizationLevel= OptimizationLevel_Normal , ehcOptOptimizationScope= OptimizationScope_PerModule , ehcOptDumpCoreStages = False , ehcOptOptimizations = optimizeRequiresClosure $ Map.findWithDefault Set.empty OptimizationLevel_Normal optimizationLevelMp , ehcOptOptimizeOptionMp = Map.empty , ehcOptCoreOpts = [] , ehcOptCoreRunOpts = Set.empty , ehcOptGenTrampoline_ = False , ehcOptGenTrace = False , ehcOptVerbosity = VerboseMinimal , ehcOptTraceOn = Set.empty , ehcOptEmitHS = False , ehcOptEmitEH = False , ehcOptImportFileLocPath= [] , ehcOptBuiltinNames = mkEHBuiltinNames (const id) , ehcOptEnvironment = undefined -- filled in at toplevel , ehcCfgInstFldHaveSelf = False , ehcOptPrfCutOffAt = 20 , ehcCfgClassViaRec = False -- True -- , ehcCfgCHRScoped = CHRScopedAll , ehcOptTyBetaRedCutOffAt = 10 , ehcDebugStopAtCoreError= False , ehcOptCheckRecompile = True , ehcDebugStopAtHIError = False -- , ehcOptDoExecLinking = True , ehcOptLinkingStyle = LinkingStyle_Exec -- how to link, possibly no linking (e.g. when compile only) , ehcOptGenGenerics = True , ehcOptFusion = False , ehcOptAltDriver = False , ehcOptHiValidityCheck = True , ehcOptLibFileLocPath = [] , ehcOptPkgdirLocPath = [] , ehcOptPkgDb = emptyPackageDatabase , ehcProgName = emptyFPath , ehcCurDir = "" , ehcOptUserDir = "" , ehcOptMbOutputFile = Nothing , ehcOptCPP = False , ehcOptUseAssumePrelude = True , ehcOptPackageSearchFilter = [] -- pkgSearchFilter parsePkgKey PackageSearchFilter_ExposePkg Cfg.ehcAssumedPackages , ehcOptOutputDir = Nothing , ehcOptKeepIntermediateFiles = False , ehcOptPkgOpt = Nothing , ehcOptCfgInstallRoot = Nothing , ehcOptCfgInstallVariant= Nothing , ehcOptCmdLineOpts = [] , ehcOptCmdLineOptsDoneViaPragma = False , ehcOptOverloadedStrings= False , ehcOptPgmExecMp = Map.empty , ehcOptExecOptsMp = Map.empty } {-# LINE 583 "src/ehc/Opts/Base.chs" #-} -- | PP EH AST, with annotations ehcOptEhAstPP :: EHCOpts -> Bool ehcOptEhAstPP opts = EhOpt_DumpAST `elem` ehcOptEhOpts opts -- | PP EH AST, with annotations ehcOptEhAstPPExtensive :: EHCOpts -> Bool ehcOptEhAstPPExtensive opts = (ehcOptEhAstPP opts && ehcOptDebug opts) || EhOpt_DumpAST `elem` ehcOptEhOpts opts {-# LINE 598 "src/ehc/Opts/Base.chs" #-} -- | Do some plain PP on EH ehcOptEhPP :: EHCOpts -> Bool ehcOptEhPP opts = ehcOptShowEH opts || ehcOptEmitEH opts || EhOpt_Dump `elem` ehcOptEhOpts opts {-# LINE 604 "src/ehc/Opts/Base.chs" #-} ehcOptTarget :: EHCOpts -> Target ehcOptTarget = maybeOk (\s -> panic ("ehcOptTarget: " ++ s)) id . ehcOptMbTarget ehcOptTargetFlavor :: EHCOpts -> TargetFlavor ehcOptTargetFlavor = maybeOk (\s -> panic ("ehcOptTargetFlavor: " ++ s)) id . ehcOptMbTargetFlavor {-# LINE 612 "src/ehc/Opts/Base.chs" #-} -- | Generate system F (20120421 AD: very much under construction) ehcOptCoreSysF :: EHCOpts -> Bool ehcOptCoreSysF _ = False -- | Typecheck system F (20120421 AD: very much under construction) ehcOptCoreSysFCheck :: EHCOpts -> Bool ehcOptCoreSysFCheck _ = False -- | Typecheck system F (20120421 AD: very much under construction) ehcOptCoreSysFGen :: EHCOpts -> Bool ehcOptCoreSysFGen opts = ehcOptCoreSysF opts -- | Typecheck system F (20120421 AD: very much under construction) ehcOptCoreSysFCheckOnlyVal :: EHCOpts -> Bool ehcOptCoreSysFCheckOnlyVal opts = ehcOptCoreSysFCheck opts {-# LINE 646 "src/ehc/Opts/Base.chs" #-} -- generate bytecode ehcOptEmitExecBytecode :: EHCOpts -> Bool ehcOptEmitExecBytecode _ = False ehcOptEmitBytecode :: EHCOpts -> Bool ehcOptEmitBytecode _ = False {-# LINE 703 "src/ehc/Opts/Base.chs" #-} -- | Check Cmm ehcOptCmmCheck :: EHCOpts -> Bool ehcOptCmmCheck _ = False {-# LINE 713 "src/ehc/Opts/Base.chs" #-} -- | Via Core -> Grin -> CMM -> JS ? ehcOptIsViaGrinCmmJavaScript :: EHCOpts -> Bool ehcOptIsViaGrinCmmJavaScript opts = False -- | Via Core -> JS ? ehcOptIsViaCoreJavaScript :: EHCOpts -> Bool ehcOptIsViaCoreJavaScript opts = targetIsViaCoreJavaScript t where t = ehcOptTarget opts {-# LINE 734 "src/ehc/Opts/Base.chs" #-} ehcOptIsViaCmm :: EHCOpts -> Bool ehcOptIsViaCmm opts = ehcOptIsViaGrinCmmJavaScript opts {-# INLINE ehcOptIsViaCmm #-} {-# LINE 740 "src/ehc/Opts/Base.chs" #-} ehcOptIsViaGrin :: EHCOpts -> Bool ehcOptIsViaGrin opts = ehcOptIsViaGrinCmmJavaScript opts || targetIsGrinBytecode t || targetDoesHPTAnalysis t where t = ehcOptTarget opts {-# LINE 750 "src/ehc/Opts/Base.chs" #-} 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 {-# LINE 762 "src/ehc/Opts/Base.chs" #-} -- | Either fromJust with a possible panic, or with a default value (when debugging) ehcOptFromJust :: EHCOpts -> String -> a -> Maybe a -> a ehcOptFromJust opts panicMsg n m | ehcOptDebug opts = maybe n id m | otherwise = panicJust panicMsg m {-# LINE 774 "src/ehc/Opts/Base.chs" #-} -- | Do linking into executable? ehcOptDoExecLinking :: EHCOpts -> Bool ehcOptDoExecLinking opts = ehcOptLinkingStyle opts == LinkingStyle_Exec {-# LINE 784 "src/ehc/Opts/Base.chs" #-} -- | Is something under development turned on? ehcOptIsUnderDev :: UnderDev -> EHCOpts -> Bool ehcOptIsUnderDev ud opts = ud `Set.member` ehcOptUnderDev opts