SwitchResult(..),
HscLang(..),
DynFlag(..), -- needed non-abstractly by DriverFlags
- DynFlags, -- abstract
+ DynFlags(..),
intSwitchSet,
switchIsOn,
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.6 2000/10/18 09:40:18 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.7 2000/10/24 15:58:02 simonmar Exp $
--
-- Driver flags
--
, ( "static" , NoArg (writeIORef static True) )
------ Compiler flags -----------------------------------------------
- , ( "O2-for-C" , NoArg (writeIORef opt_minus_o2_for_C True) )
+ , ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) )
, ( "O" , OptPrefix (setOptLevel) )
, ( "fasm" , OptPrefix (\_ -> writeIORef hsc_lang HscAsm) )
, ( "fno-asm-mangling" , NoArg (writeIORef do_asm_mangling False) )
, ( "fmax-simplifier-iterations",
- Prefix (writeIORef opt_MaxSimplifierIterations . read) )
+ Prefix (writeIORef v_MaxSimplifierIterations . read) )
- , ( "fusagesp" , NoArg (do writeIORef opt_UsageSPInf True
+ , ( "fusagesp" , NoArg (do writeIORef v_UsageSPInf True
add opt_C "-fusagesp-on") )
, ( "fexcess-precision" , NoArg (do writeIORef excess_precision True
, ( "U", Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
------ Debugging ----------------------------------------------------
- , ( "dstg-stats", NoArg (writeIORef opt_StgStats True) )
+ , ( "dstg-stats", NoArg (writeIORef v_StgStats True) )
, ( "ddump_all", NoArg (setDynFlag Opt_D_dump_all) )
, ( "ddump_most", NoArg (setDynFlag Opt_D_dump_most) )
, ( "-fwarn-missing-fields", NoArg (setDynFlag Opt_WarnMissingFields) )
, ( "-fwarn-missing-methods", NoArg (setDynFlag Opt_WarnMissingMethods))
, ( "-fwarn-missing-signatures", NoArg (setDynFlag Opt_WarnMissingSigs) )
- , ( "-fwarn-name-shadowing", NoArg (setDynFlag Opt_WarnNameShadowin) )
- , ( "-fwarn-overlapping-patterns", NoArg (setDynFlag Opt_WarnOverlappingPatterns )) )
+ , ( "-fwarn-name-shadowing", NoArg (setDynFlag Opt_WarnNameShadowing) )
+ , ( "-fwarn-overlapping-patterns", NoArg (setDynFlag Opt_WarnOverlappingPatterns ) )
, ( "-fwarn-simple-patterns", NoArg (setDynFlag Opt_WarnSimplePatterns))
, ( "-fwarn-type-defaults", NoArg (setDynFlag Opt_WarnTypeDefaults) )
, ( "-fwarn-unused-binds", NoArg (setDynFlag Opt_WarnUnusedBinds) )
W_not -> []
-- optimisation
- minus_o <- readIORef opt_level
- optimisation_opts <-
+ minus_o <- readIORef v_OptLevel
+ let optimisation_opts =
case minus_o of
0 -> hsc_minusNoO_flags
1 -> hsc_minusO_flags
let stg_massage | WayProf `elem` ways_ = "-fmassage-stg-for-profiling"
| otherwise = ""
- stg_stats <- readIORef opt_StgStats
+ stg_stats <- readIORef v_StgStats
let stg_stats_flag | stg_stats = "-dstg-stats"
| otherwise = ""
-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.4 2000/10/11 16:26:04 simonmar Exp $
+-- $Id: DriverState.hs,v 1.5 2000/10/24 15:58:02 simonmar Exp $
--
-- Settings for the driver
--
import DriverUtil
import Util
import Config
-import Array
import Exception
import IOExts
-----------------------------------------------------------------------------
-- Compiler optimisation options
-GLOBAL_VAR(opt_level, 0, Int)
+GLOBAL_VAR(v_OptLevel, 0, Int)
setOptLevel :: String -> IO ()
-setOptLevel "" = do { writeIORef opt_level 1; go_via_C }
-setOptLevel "not" = writeIORef opt_level 0
+setOptLevel "" = do { writeIORef v_OptLevel 1; go_via_C }
+setOptLevel "not" = writeIORef v_OptLevel 0
setOptLevel [c] | isDigit c = do
let level = ord c - ord '0'
- writeIORef opt_level level
+ writeIORef v_OptLevel level
when (level >= 1) go_via_C
setOptLevel s = unknownFlagErr ("-O"++s)
case l of { HscAsm -> writeIORef hsc_lang HscC;
_other -> return () }
-GLOBAL_VAR(opt_minus_o2_for_C, False, Bool)
+GLOBAL_VAR(v_minus_o2_for_C, False, Bool)
-GLOBAL_VAR(opt_MaxSimplifierIterations, 4, Int)
-GLOBAL_VAR(opt_StgStats, False, Bool)
-GLOBAL_VAR(opt_UsageSPInf, False, Bool) -- Off by default
-GLOBAL_VAR(opt_Strictness, True, Bool)
-GLOBAL_VAR(opt_CPR, True, Bool)
+GLOBAL_VAR(v_MaxSimplifierIterations, 4, Int)
+GLOBAL_VAR(v_StgStats, False, Bool)
+GLOBAL_VAR(v_UsageSPInf, False, Bool) -- Off by default
+GLOBAL_VAR(v_Strictness, True, Bool)
+GLOBAL_VAR(v_CPR, True, Bool)
+GLOBAL_VAR(v_CSE, True, Bool)
hsc_minusO2_flags = hsc_minusO_flags -- for now
-hsc_minusNoO_flags = do
- iter <- readIORef opt_MaxSimplifierIterations
- return [
+hsc_minusNoO_flags =
+ [
"-fignore-interface-pragmas",
"-fomit-interface-pragmas"
]
-hsc_minusO_flags = do
- stgstats <- readIORef opt_StgStats
-
- return [
+hsc_minusO_flags =
+ [
"-ffoldr-build-on",
"-fdo-eta-reduction",
"-fdo-lambda-eta-expansion",
"-flet-to-case"
]
-build_CoreToDo
- :: Int -- opt level
- -> Int -- max iterations
- -> Bool -- do usageSP
- -> Bool -- do strictness
- -> Bool -- do CPR
- -> Bool -- do CSE
- -> [CoreToDo]
-
-build_CoreToDo level max_iter usageSP strictness cpr cse
- | level == 0 = [
+buildCoreToDo :: IO [CoreToDo]
+buildCoreToDo = do
+ opt_level <- readIORef v_OptLevel
+ max_iter <- readIORef v_MaxSimplifierIterations
+ usageSP <- readIORef v_UsageSPInf
+ strictness <- readIORef v_Strictness
+ cpr <- readIORef v_CPR
+ cse <- readIORef v_CSE
+
+ if opt_level == 0 then return
+ [
CoreDoSimplify (isAmongSimpl [
MaxSimplifierIterations max_iter
])
]
- | level >= 1 = [
+ else {- level >= 1 -} return [
-- initial simplify: mk specialiser happy: minimum effort please
CoreDoSimplify (isAmongSimpl [
MaxSimplifierIterations max_iter
-- No -finline-phase: allow all Ids to be inlined now
])
- ]
+ ]
-----------------------------------------------------------------------------
-- Paths & Libraries
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.6 2000/10/17 13:22:11 simonmar Exp $
+-- $Id: Main.hs,v 1.7 2000/10/24 15:58:02 simonmar Exp $
--
-- GHC Driver program
--
-- give the static flags to hsc
build_hsc_opts
+ -- build the default DynFlags (these may be adjusted on a per
+ -- module basis by OPTIONS pragmas and settings in the interpreter).
+
+ core_todo <- buildCoreToDo
+
+ lang <- readIORef hsc_lang
+ writeIORef v_DynFlags
+ DynFlags{ coreToDo = core_todo,
+ stgToDo = error "ToDo: stgToDo"
+ hscLang = lang,
+ -- leave out hscOutName for now
+ flags = [] }
+
-- the rest of the arguments are "dynamic"
srcs <- processArgs dynamic_flags non_static []
-- save the "initial DynFlags" away
dyn_flags <- readIORef v_DynFlags
- writeIORef v_InitDynFlags dyn_flags
+ writeIORef v_InitDynFlags
-- complain about any unknown flags
let unknown_flags = [ f | ('-':f) <- srcs ]
projects / ghc-hetmet.git / commitdiff