Commit f98aaf10 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-24 15:58:02 by simonmar]

Compiles up to DriverFlags
parent 33d4a6bd
......@@ -12,7 +12,7 @@ module CmdLineOpts (
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
--
......@@ -261,7 +261,7 @@ static_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) )
......@@ -272,9 +272,9 @@ static_flags =
, ( "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
......@@ -324,7 +324,7 @@ dynamic_flags = [
, ( "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) )
......@@ -373,8 +373,8 @@ dynamic_flags = [
, ( "-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) )
......@@ -437,8 +437,8 @@ build_hsc_opts = do
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
......@@ -451,7 +451,7 @@ build_hsc_opts = do
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
--
......@@ -16,7 +16,6 @@ import CmdLineOpts
import DriverUtil
import Util
import Config
import Array
import Exception
import IOExts
......@@ -228,14 +227,14 @@ GLOBAL_VAR(warning_opt, W_default, WarningState)
-----------------------------------------------------------------------------
-- 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)
......@@ -244,27 +243,25 @@ go_via_C = do
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",
......@@ -273,23 +270,23 @@ hsc_minusO_flags = do
"-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 [
......@@ -394,7 +391,7 @@ build_CoreToDo level max_iter usageSP strictness cpr cse
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
--
......@@ -159,11 +159,24 @@ main =
-- 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 ]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment