{-# OPTIONS -fno-cse #-}-- -fno-cse is needed for GLOBAL_VAR's to behave properly--------------------------------------------------------------------------------- Static flags---- Static flags can only be set once, on the command-line. Inside GHC,-- each static flag corresponds to a top-level value, usually of type Bool.---- (c) The University of Glasgow 2005-------------------------------------------------------------------------------moduleStaticFlags(staticFlags,initStaticOpts,-- WaysWayName(..),Way(..),v_Ways,isRTSWay,mkBuildTag,-- Output style optionsopt_PprUserLength,opt_SuppressUniques,opt_PprStyle_Debug,opt_NoDebugOutput,-- profiling optsopt_SccProfilingOn,-- Hpc optsopt_Hpc,-- language optsopt_DictsStrict,opt_IrrefutableTuples,opt_Parallel,-- optimisation optsopt_DsMultiTyVar,opt_NoStateHack,opt_SimpleListLiterals,opt_SpecInlineJoinPoints,opt_CprOff,opt_SimplNoPreInlining,opt_SimplExcessPrecision,opt_MaxWorkerArgs,-- Unfolding controlopt_UF_CreationThreshold,opt_UF_UseThreshold,opt_UF_FunAppDiscount,opt_UF_KeenessFactor,opt_UF_DearOp,-- Optimization fuel controlsopt_Fuel,-- Related to linkingopt_PIC,opt_Static,-- misc optsopt_IgnoreDotGhci,opt_ErrorSpans,opt_GranMacros,opt_HiVersion,opt_HistorySize,opt_OmitBlackHoling,opt_Unregisterised,v_Ld_inputs,tablesNextToCode,opt_StubDeadValues,opt_Ticky,-- For the parseraddOpt,removeOpt,addWay,getWayFlags,v_opt_C_ready)where#include "HsVersions.h"importConfigimportFastStringimportUtilimportMaybes(firstJust)importPanicimportData.Maybe(listToMaybe)importData.IORefimportSystem.IO.Unsafe(unsafePerformIO)importData.List------------------------------------------------------------------------------- Static flagsinitStaticOpts::IO()initStaticOpts=writeIORefv_opt_C_readyTrueaddOpt::String->IO()addOpt=consIORefv_opt_CaddWay::WayName->IO()addWay=consIORefv_Ways.lkupWayremoveOpt::String->IO()removeOptf=dofs<-readIORefv_opt_CwriteIORefv_opt_C$!filter(/=f)fslookUp::FastString->Boollookup_def_int::String->Int->Intlookup_def_float::String->Float->Floatlookup_str::String->MaybeString-- holds the static opts while they're being collected, before-- being unsafely read by unpacked_static_opts below.GLOBAL_VAR(v_opt_C,defaultStaticOpts,[String])GLOBAL_VAR(v_opt_C_ready,False,Bool)staticFlags::[String]staticFlags=unsafePerformIO$doready<-readIORefv_opt_C_readyif(notready)thenpanic"Static flags have not been initialised!\n Please call GHC.newSession or GHC.parseStaticFlags early enough."elsereadIORefv_opt_C-- -static is the defaultdefaultStaticOpts::[String]defaultStaticOpts=["-static"]packed_static_opts::[FastString]packed_static_opts=mapmkFastStringstaticFlagslookUpsw=sw`elem`packed_static_opts-- (lookup_str "foo") looks for the flag -foo=X or -fooX, -- and returns the string Xlookup_strsw=casefirstJust(map(stripPrefixsw)staticFlags)ofJust('=':str)->JuststrJuststr->JuststrNothing->Nothinglookup_def_intswdef=case(lookup_strsw)ofNothing->def-- Use defaultJustxx->try_readswxxlookup_def_floatswdef=case(lookup_strsw)ofNothing->def-- Use defaultJustxx->try_readswxxtry_read::Reada=>String->String->a-- (try_read sw str) tries to read s; if it fails, it-- bleats about flag swtry_readswstr=casereadsstrof((x,_):_)->x-- Be forgiving: ignore trailing goop, and alternative parses[]->ghcError(UsageError("Malformed argument "++str++" for flag "++sw))-- ToDo: hack alert. We should really parse the arugments-- and announce errors in a more civilised way.{-
Putting the compiler options into temporary at-files
may turn out to be necessary later on if we turn hsc into
a pure Win32 application where I think there's a command-line
length limit of 255. unpacked_opts understands the @ option.
unpacked_opts :: [String]
unpacked_opts =
concat $
map (expandAts) $
map unpackFS argv -- NOT ARGV any more: v_Static_hsc_opts
where
expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
expandAts l = [l]
-}opt_IgnoreDotGhci::Boolopt_IgnoreDotGhci=lookUp(fsLit"-ignore-dot-ghci")-- debugging optsopt_SuppressUniques::Boolopt_SuppressUniques=lookUp(fsLit"-dsuppress-uniques")opt_PprStyle_Debug::Boolopt_PprStyle_Debug=lookUp(fsLit"-dppr-debug")opt_PprUserLength::Intopt_PprUserLength=lookup_def_int"-dppr-user-length"5--ToDo: give this a nameopt_Fuel::Intopt_Fuel=lookup_def_int"-dopt-fuel"maxBoundopt_NoDebugOutput::Boolopt_NoDebugOutput=lookUp(fsLit"-dno-debug-output")-- profiling optsopt_SccProfilingOn::Boolopt_SccProfilingOn=lookUp(fsLit"-fscc-profiling")-- Hpc optsopt_Hpc::Boolopt_Hpc=lookUp(fsLit"-fhpc")-- language optsopt_DictsStrict::Boolopt_DictsStrict=lookUp(fsLit"-fdicts-strict")opt_IrrefutableTuples::Boolopt_IrrefutableTuples=lookUp(fsLit"-firrefutable-tuples")opt_Parallel::Boolopt_Parallel=lookUp(fsLit"-fparallel")-- optimisation optsopt_DsMultiTyVar::Boolopt_DsMultiTyVar=not(lookUp(fsLit"-fno-ds-multi-tyvar"))-- On by defaultopt_SpecInlineJoinPoints::Boolopt_SpecInlineJoinPoints=lookUp(fsLit"-fspec-inline-join-points")opt_SimpleListLiterals::Boolopt_SimpleListLiterals=lookUp(fsLit"-fsimple-list-literals")opt_NoStateHack::Boolopt_NoStateHack=lookUp(fsLit"-fno-state-hack")opt_CprOff::Boolopt_CprOff=lookUp(fsLit"-fcpr-off")-- Switch off CPR analysis in the new demand analyseropt_MaxWorkerArgs::Intopt_MaxWorkerArgs=lookup_def_int"-fmax-worker-args"(10::Int)opt_GranMacros::Boolopt_GranMacros=lookUp(fsLit"-fgransim")opt_HiVersion::Integeropt_HiVersion=read(cProjectVersionInt++cProjectPatchLevel)::Integeropt_HistorySize::Intopt_HistorySize=lookup_def_int"-fhistory-size"20opt_OmitBlackHoling::Boolopt_OmitBlackHoling=lookUp(fsLit"-dno-black-holing")opt_StubDeadValues::Boolopt_StubDeadValues=lookUp(fsLit"-dstub-dead-values")-- Simplifier switchesopt_SimplNoPreInlining::Boolopt_SimplNoPreInlining=lookUp(fsLit"-fno-pre-inlining")-- NoPreInlining is there just to see how bad things-- get if you don't do it!opt_SimplExcessPrecision::Boolopt_SimplExcessPrecision=lookUp(fsLit"-fexcess-precision")-- Unfolding controlopt_UF_CreationThreshold::Intopt_UF_CreationThreshold=lookup_def_int"-funfolding-creation-threshold"(45::Int)opt_UF_UseThreshold::Intopt_UF_UseThreshold=lookup_def_int"-funfolding-use-threshold"(6::Int)-- Discounts can be bigopt_UF_FunAppDiscount::Intopt_UF_FunAppDiscount=lookup_def_int"-funfolding-fun-discount"(6::Int)-- It's great to inline a fnopt_UF_KeenessFactor::Floatopt_UF_KeenessFactor=lookup_def_float"-funfolding-keeness-factor"(1.5::Float)opt_UF_DearOp::Intopt_UF_DearOp=(4::Int)-- Related to linkingopt_PIC::Bool#if darwin_TARGET_OS && x86_64_TARGET_ARCHopt_PIC=True#elseopt_PIC=lookUp(fsLit"-fPIC")#endifopt_Static::Boolopt_Static=lookUp(fsLit"-static")opt_Unregisterised::Boolopt_Unregisterised=lookUp(fsLit"-funregisterised")-- Derived, not a real option. Determines whether we will be compiling-- info tables that reside just before the entry code, or with an-- indirection to the entry code. See TABLES_NEXT_TO_CODE in -- includes/rts/storage/InfoTables.h.tablesNextToCode::BooltablesNextToCode=notopt_Unregisterised&&cGhcEnableTablesNextToCode=="YES"-- Include full span info in error messages, instead of just the start position.opt_ErrorSpans::Boolopt_ErrorSpans=lookUp(fsLit"-ferror-spans")opt_Ticky::Boolopt_Ticky=lookUp(fsLit"-ticky")-- object files and libraries to be linked in are collected here.-- ToDo: perhaps this could be done without a global, it wasn't obvious-- how to do it though --SDM.GLOBAL_VAR(v_Ld_inputs,[],[String])------------------------------------------------------------------------------- Ways-- The central concept of a "way" is that all objects in a given-- program must be compiled in the same "way". Certain options change-- parameters of the virtual machine, eg. profiling adds an extra word-- to the object header, so profiling objects cannot be linked with-- non-profiling objects.-- After parsing the command-line options, we determine which "way" we-- are building - this might be a combination way, eg. profiling+threaded.-- We then find the "build-tag" associated with this way, and this-- becomes the suffix used to find .hi files and libraries used in-- this compilation.dataWayName=WayThreaded|WayDebug|WayProf|WayEventLog|WayPar|WayGran|WayNDP|WayDynderiving(Eq,Ord)GLOBAL_VAR(v_Ways,[],[Way])allowed_combination::[WayName]->Boolallowed_combinationway=and[x`allowedWith`y|x<-way,y<-way,x<y]where-- Note ordering in these tests: the left argument is-- <= the right argument, according to the Ord instance-- on Way above.-- dyn is allowed with everything_`allowedWith`WayDyn=TrueWayDyn`allowedWith`_=True-- debug is allowed with everything_`allowedWith`WayDebug=TrueWayDebug`allowedWith`_=TrueWayProf`allowedWith`WayNDP=TrueWayThreaded`allowedWith`WayProf=TrueWayThreaded`allowedWith`WayEventLog=True_`allowedWith`_=FalsegetWayFlags::IO[String]-- new optionsgetWayFlags=dounsorted<-readIORefv_Waysletways=sortBy(compare`on`wayName)$nubBy((==)`on`wayName)$unsortedwriteIORefv_Wayswaysifnot(allowed_combination(mapwayNameways))thenghcError(CmdLineError$"combination not supported: "++foldr1(\ab->a++'/':b)(mapwayDescways))elsereturn(concatMapwayOptsways)mkBuildTag::[Way]->StringmkBuildTagways=concat(intersperse"_"(mapwayTagways))lkupWay::WayName->WaylkupWayw=caselistToMaybe(filter((==)w.wayName)way_details)ofNothing->error"findBuildTag"Justdetails->detailsisRTSWay::WayName->BoolisRTSWay=wayRTSOnly.lkupWaydataWay=Way{wayName::WayName,wayTag::String,wayRTSOnly::Bool,wayDesc::String,wayOpts::[String]}way_details::[Way]way_details=[WayWayThreaded"thr"True"Threaded"[#if defined(freebsd_TARGET_OS)-- "-optc-pthread"-- , "-optl-pthread"-- FreeBSD's default threading library is the KSE-based M:N libpthread,-- which GHC has some problems with. It's currently not clear whether-- the problems are our fault or theirs, but it seems that using the-- alternative 1:1 threading library libthr works around it:"-optl-lthr"#elif defined(solaris2_TARGET_OS)"-optl-lrt"#endif],WayWayDebug"debug"True"Debug"[],WayWayDyn"dyn"False"Dynamic"["-DDYNAMIC","-optc-DDYNAMIC"],WayWayProf"p"False"Profiling"["-fscc-profiling","-DPROFILING","-optc-DPROFILING"],WayWayEventLog"l"True"RTS Event Logging"["-DTRACING","-optc-DTRACING"],WayWayPar"mp"False"Parallel"["-fparallel","-D__PARALLEL_HASKELL__","-optc-DPAR","-package concurrent","-optc-w","-optl-L${PVM_ROOT}/lib/${PVM_ARCH}","-optl-lpvm3","-optl-lgpvm3"],-- at the moment we only change the RTS and could share compiler and libs!WayWayPar"mt"False"Parallel ticky profiling"["-fparallel","-D__PARALLEL_HASKELL__","-optc-DPAR","-optc-DPAR_TICKY","-package concurrent","-optc-w","-optl-L${PVM_ROOT}/lib/${PVM_ARCH}","-optl-lpvm3","-optl-lgpvm3"],WayWayPar"md"False"Distributed"["-fparallel","-D__PARALLEL_HASKELL__","-D__DISTRIBUTED_HASKELL__","-optc-DPAR","-optc-DDIST","-package concurrent","-optc-w","-optl-L${PVM_ROOT}/lib/${PVM_ARCH}","-optl-lpvm3","-optl-lgpvm3"],WayWayGran"mg"False"GranSim"["-fgransim","-D__GRANSIM__","-optc-DGRAN","-package concurrent"],WayWayNDP"ndp"False"Nested data parallelism"["-XParr","-fvectorise"]]