%
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-98
%
\section[CmdLineOpts]{Things to do with command-line options}
opt_D_dump_deriv,
opt_D_dump_ds,
opt_D_dump_flatC,
+ opt_D_dump_foreign,
opt_D_dump_occur_anal,
opt_D_dump_rdr,
opt_D_dump_realC,
opt_DoSemiTagging,
opt_DoEtaReduction,
opt_DoTickyProfiling,
+ opt_EmitCExternDecls,
opt_EnsureSplittableC,
opt_FoldrBuildOn,
opt_ForConcurrent,
opt_GlasgowExts,
opt_GranMacros,
opt_HiMap,
+ opt_HiVersion,
opt_IgnoreIfacePragmas,
opt_IrrefutableTuples,
opt_LiberateCaseThreshold,
opt_MultiParamClasses,
+ opt_NoHiCheck,
opt_NoImplicitPrelude,
opt_NumbersStrict,
opt_OmitBlackHoling,
opt_ProduceC,
opt_ProduceHi,
opt_ProduceS,
+ opt_ProduceExportCStubs,
+ opt_ProduceExportHStubs,
opt_ReportWhyUnfoldingsDisallowed,
opt_ReturnInRegsThreshold,
+ opt_ReportCompile,
opt_SccGroup,
opt_SccProfilingOn,
opt_ShowImportSpecs,
opt_StgDoLetNoEscapes,
opt_InterfaceUnfoldThreshold,
+ opt_UnfoldCasms,
opt_UnfoldingCreationThreshold,
opt_UnfoldingConDiscount,
opt_UnfoldingUseThreshold,
assoc_opts = assocMaybe [ (a, True) | a <- argv ]
unpacked_opts = map _UNPK_ argv
+
+{-
+ 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.
+
+assoc_opts = assocMaybe [ (_PK_ a, True) | a <- unpacked_opts ]
+
+unpacked_opts :: [String]
+unpacked_opts =
+ concat $
+ map (expandAts) $
+ map _UNPK_ argv
+ where
+ expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
+ expandAts l = [l]
+-}
\end{code}
\begin{code}
opt_D_dump_deriv = lookUp SLIT("-ddump-deriv")
opt_D_dump_ds = lookUp SLIT("-ddump-ds")
opt_D_dump_flatC = lookUp SLIT("-ddump-flatC")
+opt_D_dump_foreign = lookUp SLIT("-ddump-foreign-stubs")
opt_D_dump_occur_anal = lookUp SLIT("-ddump-occur-anal")
opt_D_dump_rdr = lookUp SLIT("-ddump-rdr")
opt_D_dump_realC = lookUp SLIT("-ddump-realC")
opt_D_verbose_stg2stg = lookUp SLIT("-dverbose-stg")
opt_DoCoreLinting = lookUp SLIT("-dcore-lint")
opt_DoStgLinting = lookUp SLIT("-dstg-lint")
+opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction")
opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging")
opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky")
-opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction")
+opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls")
opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names")
opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on")
opt_ForConcurrent = lookUp SLIT("-fconcurrent")
opt_GranMacros = lookUp SLIT("-fgransim")
opt_GlasgowExts = lookUp SLIT("-fglasgow-exts")
-opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files
+opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files
+opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas")
opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
opt_MultiParamClasses = opt_GlasgowExts
opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
opt_ProduceC = lookup_str "-C="
opt_ProduceS = lookup_str "-S="
+opt_ProduceExportCStubs = lookup_str "-F="
+opt_ProduceExportHStubs = lookup_str "-FH="
opt_ProduceHi = lookup_str "-hifile=" -- the one to produce this time
opt_ReportWhyUnfoldingsDisallowed= lookUp SLIT("-freport-disallowed-unfoldings")
+opt_ReportCompile = lookUp SLIT("-freport-compile")
+opt_ReturnInRegsThreshold = lookup_int "-freturn-in-regs-threshold"
opt_SccProfilingOn = lookUp SLIT("-fscc-profiling")
opt_ShowImportSpecs = lookUp SLIT("-fshow-import-specs")
opt_SigsRequired = lookUp SLIT("-fsignatures-required")
opt_SpecialiseTrace = lookUp SLIT("-ftrace-specialisation")
opt_SpecialiseUnboxed = lookUp SLIT("-fspecialise-unboxed")
opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape")
-opt_ReturnInRegsThreshold = lookup_int "-freturn-in-regs-threshold"
opt_SccGroup = lookup_str "-G="
opt_Verbose = lookUp SLIT("-v")
+opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file")
opt_InterfaceUnfoldThreshold = lookup_def_int "-funfolding-interface-threshold" iNTERFACE_UNFOLD_THRESHOLD
opt_UnfoldingCreationThreshold = lookup_def_int "-funfolding-creation-threshold" uNFOLDING_CREATION_THRESHOLD
opt_UnfoldingUseThreshold = lookup_def_int "-funfolding-use-threshold" uNFOLDING_USE_THRESHOLD
classifyOpts = sep argv [] [] -- accumulators...
where
- sep :: [FAST_STRING] -- cmd-line opts (input)
+ sep :: [FAST_STRING] -- cmd-line opts (input)
-> [CoreToDo] -> [StgToDo] -- to_do accumulators
-> ([CoreToDo], [StgToDo]) -- result
# define CORE_TD(to_do) sep opts (to_do:core_td) stg_td
# define STG_TD(to_do) sep opts core_td (to_do:stg_td)
-# define IGNORE_ARG() sep opts core_td stg_td
sep (opt1:opts) core_td stg_td
- =
- case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end...
-
- ',' : _ -> IGNORE_ARG() -- it is for the parser
+ = case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end...
+ ',' : _ -> sep opts core_td stg_td -- it is for the parser
"-fsimplify" -> -- gather up SimplifierSwitches specially...
simpl_sep opts defaultSimplSwitches core_td stg_td
"-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling)
_ -> -- NB: the driver is really supposed to handle bad options
- IGNORE_ARG()
+ sep opts core_td stg_td
----------------
- simpl_sep :: [FAST_STRING] -- cmd-line opts (input)
- -> [SimplifierSwitch] -- simplifier-switch accumulator
- -> [CoreToDo] -> [StgToDo] -- to_do accumulators
- -> ([CoreToDo], [StgToDo]) -- result
+ simpl_sep :: [FAST_STRING] -- cmd-line opts (input)
+ -> [SimplifierSwitch] -- simplifier-switch accumulator
+ -> [CoreToDo] -> [StgToDo] -- to_do accumulators
+ -> ([CoreToDo], [StgToDo]) -- result
-- "simpl_sep" tailcalls "sep" once it's seen one set
-- of SimplifierSwitches for a CoreDoSimplify.
%************************************************************************
\begin{code}
-# define ARRAY Array
-# define LIFT Lift
-# define SET_TO =:
-(=:) a b = (a,b)
-
isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
all_undefined)
// defined_elems
- all_undefined = [ i SET_TO SwBool False | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
+ all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
defined_elems = map mk_assoc_elem tidied_on_switches
in
-- (avoid some unboxing, bounds checking, and other horrible things:)
- case sw_tbl of { ARRAY bounds_who_needs_'em stuff ->
+ case sw_tbl of { Array bounds_who_needs_'em stuff ->
\ switch ->
case (indexArray# stuff (tagOf_SimplSwitch switch)) of
- LIFT v -> v
+ Lift v -> v
}
where
- mk_assoc_elem k@(MaxSimplifierIterations lvl) = IBOX(tagOf_SimplSwitch k) SET_TO SwInt lvl
+ mk_assoc_elem k@(MaxSimplifierIterations lvl) = (IBOX(tagOf_SimplSwitch k), SwInt lvl)
- mk_assoc_elem k = IBOX(tagOf_SimplSwitch k) SET_TO SwBool True -- I'm here, Mom!
+ mk_assoc_elem k = (IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
-- cannot have duplicates if we are going to use the array thing
rm_dups switches_so_far switch
projects / ghc-hetmet.git / blobdiff