From: simonmar Date: Tue, 24 Oct 2000 15:58:02 +0000 (+0000) Subject: [project @ 2000-10-24 15:58:02 by simonmar] X-Git-Tag: Approximately_9120_patches~3517 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=f98aaf1088d0b654ebf6c887c7dbebe5bb6f5f5f;p=ghc-hetmet.git [project @ 2000-10-24 15:58:02 by simonmar] Compiles up to DriverFlags --- diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 2509004..348831a 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -12,7 +12,7 @@ module CmdLineOpts ( SwitchResult(..), HscLang(..), DynFlag(..), -- needed non-abstractly by DriverFlags - DynFlags, -- abstract + DynFlags(..), intSwitchSet, switchIsOn, diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index cd6a60c..fb34b4c 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 = "" diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 270e009..7842780 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index 8566b7e..6a331f7 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# 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 ]