From: simonmar Date: Sun, 19 Nov 2000 19:40:08 +0000 (+0000) Subject: [project @ 2000-11-19 19:40:07 by simonmar] X-Git-Tag: Approximately_9120_patches~3314 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e6ef290e6a8beb8cb7d5d5d0d2dc99090096315a;p=ghc-hetmet.git [project @ 2000-11-19 19:40:07 by simonmar] Cleanup sweep. Includes code to get -H working again, #ifdefed out for the time being since it needs support in the RTS. --- diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 1466775..cca0830 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -91,8 +91,7 @@ module CmdLineOpts ( opt_NoPruneTyDecls, opt_NoPruneDecls, opt_Static, - opt_Unregisterised, - opt_Verbose + opt_Unregisterised ) where #include "HsVersions.h" @@ -103,6 +102,7 @@ import IOExts ( IORef, readIORef ) import Constants -- Default values for some flags import Util import FastTypes +import Config import Maybes ( firstJust ) import Panic ( panic ) @@ -416,7 +416,7 @@ opt_InPackage = case lookup_str "-inpackage=" of opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls") opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names") opt_GranMacros = lookUp SLIT("-fgransim") -opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling. +opt_HiVersion = read cProjectVersionInt :: Int opt_HistorySize = lookup_def_int "-fhistory-size" 20 opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts") opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas") @@ -450,7 +450,6 @@ opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls") opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls") opt_Static = lookUp SLIT("-static") opt_Unregisterised = lookUp SLIT("-funregisterised") -opt_Verbose = lookUp SLIT("-v") \end{code} %************************************************************************ @@ -501,12 +500,11 @@ isStaticHscFlag f = "fno-prune-decls", "fno-prune-tydecls", "static", - "funregisterised", - "v" ] + "funregisterised" + ] || any (flip prefixMatch f) [ "fcontext-stack", "fliberate-case-threshold", - "fhi-version=", "fhistory-size", "funfolding-interface-threshold", "funfolding-creation-threshold", diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 5b2dc2d..6c86b7a 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.19 2000/11/14 16:28:38 simonmar Exp $ +-- $Id: DriverFlags.hs,v 1.20 2000/11/19 19:40:08 simonmar Exp $ -- -- Driver flags -- @@ -162,7 +162,6 @@ static_flags = ------- ways -------------------------------------------------------- , ( "prof" , NoArg (addNoDups v_Ways WayProf) ) , ( "unreg" , NoArg (addNoDups v_Ways WayUnreg) ) - , ( "dll" , NoArg (addNoDups v_Ways WayDll) ) , ( "ticky" , NoArg (addNoDups v_Ways WayTicky) ) , ( "parallel" , NoArg (addNoDups v_Ways WayPar) ) , ( "gransim" , NoArg (addNoDups v_Ways WayGran) ) @@ -218,7 +217,7 @@ static_flags = "warning: don't know how to split \ \object files on this architecture" ) ) - + ------- Include/Import Paths ---------------------------------------- , ( "i" , OptPrefix (addToDirList v_Import_paths) ) , ( "I" , Prefix (addToDirList v_Include_paths) ) @@ -259,6 +258,11 @@ static_flags = ----- Linker -------------------------------------------------------- , ( "static" , NoArg (writeIORef v_Static True) ) + ----- RTS opts ------------------------------------------------------ +#ifdef not_yet + , ( "H" , HasArg (setHeapSize . fromIntegral . decodeSize) ) +#endif + ------ Compiler flags ----------------------------------------------- , ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) ) , ( "O" , OptPrefix (setOptLevel) ) @@ -431,13 +435,17 @@ floatOpt :: IORef Double -> String -> IO () floatOpt ref str = writeIORef ref (read str :: Double) +#ifdef not_yet +foreign import "setHeapSize" unsafe setHeapSize :: Int -> IO () +#endif + ----------------------------------------------------------------------------- -- Build the Hsc static command line opts buildStaticHscOpts :: IO [String] buildStaticHscOpts = do - opt_C_ <- getStaticOpts v_Opt_C -- misc hsc opts + opt_C_ <- getStaticOpts v_Opt_C -- misc hsc opts from the command line -- optimisation minus_o <- readIORef v_OptLevel @@ -458,10 +466,7 @@ buildStaticHscOpts = do let basic_opts = opt_C_ ++ optimisation_opts ++ stg_opts filtered_opts = filter (`notElem` anti_flags) basic_opts - verb <- is_verbose - let hi_vers = "-fhi-version="++cProjectVersionInt - static <- (do s <- readIORef v_Static; if s then return "-static" else return "") - return ( filtered_opts ++ [ hi_vers, static, verb ] ) + return ( static : filtered_opts ) diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 398d3b6..de77887 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.29 2000/11/17 13:33:17 sewardj Exp $ +-- $Id: DriverPipeline.hs,v 1.30 2000/11/19 19:40:08 simonmar Exp $ -- -- GHC Driver -- @@ -723,7 +723,10 @@ doLink o_files = do preprocess :: FilePath -> IO FilePath preprocess filename = ASSERT(haskellish_file filename) - do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False + do init_driver_state <- readIORef v_InitDriverState + writeIORef v_Driver_state init_driver_state + + pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False defaultHscLang filename runPipeline pipeline filename False{-no linking-} False{-no -o flag-} @@ -771,6 +774,8 @@ compile ghci_mode summary source_unchanged old_iface hst hit pcs = do init_dyn_flags <- readIORef v_InitDynFlags writeIORef v_DynFlags init_dyn_flags + init_driver_state <- readIORef v_InitDriverState + writeIORef v_Driver_state init_driver_state let location = ms_location summary let input_fn = unJust (ml_hs_file location) "compile:hs" diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 4b94d28..b61562b 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverState.hs,v 1.14 2000/11/16 11:39:37 simonmar Exp $ +-- $Id: DriverState.hs,v 1.15 2000/11/19 19:40:08 simonmar Exp $ -- -- Settings for the driver -- @@ -67,7 +67,15 @@ initDriverState = DriverState { opt_m = [], } -GLOBAL_VAR(v_Driver_state, initDriverState, DriverState) +-- The driver state is first initialized from the command line options, +-- and then reset to this initial state before each compilation. +-- v_InitDriverState contains the saved initial state, and v_DriverState +-- contains the current state (modified by any OPTIONS pragmas, for example). +-- +-- v_InitDriverState may also be modified from the GHCi prompt, using :set. +-- +GLOBAL_VAR(v_InitDriverState, initDriverState, DriverState) +GLOBAL_VAR(v_Driver_state, initDriverState, DriverState) readState :: (DriverState -> a) -> IO a readState f = readIORef v_Driver_state >>= return . f @@ -75,11 +83,11 @@ readState f = readIORef v_Driver_state >>= return . f updateState :: (DriverState -> DriverState) -> IO () updateState f = readIORef v_Driver_state >>= writeIORef v_Driver_state . f -addOpt_L a = updateState (\s -> s{opt_L = a : opt_L s}) -addOpt_P a = updateState (\s -> s{opt_P = a : opt_P s}) -addOpt_c a = updateState (\s -> s{opt_c = a : opt_c s}) -addOpt_a a = updateState (\s -> s{opt_a = a : opt_a s}) -addOpt_m a = updateState (\s -> s{opt_m = a : opt_m s}) +addOpt_L a = updateState (\s -> s{opt_L = a : opt_L s}) +addOpt_P a = updateState (\s -> s{opt_P = a : opt_P s}) +addOpt_c a = updateState (\s -> s{opt_c = a : opt_c s}) +addOpt_a a = updateState (\s -> s{opt_a = a : opt_a s}) +addOpt_m a = updateState (\s -> s{opt_m = a : opt_m s}) addCmdlineHCInclude a = updateState (\s -> s{cmdline_hc_includes = a : cmdline_hc_includes s}) @@ -98,7 +106,6 @@ cHaskell1Version = "5" -- i.e., Haskell 98 -- location of compiler-related files GLOBAL_VAR(v_TopDir, clibdir, String) -GLOBAL_VAR(v_Inplace, False, Bool) -- Cpp-related flags v_Hs_source_cpp_opts = global @@ -142,14 +149,14 @@ GLOBAL_VAR(v_Split_prefix, "", String) GLOBAL_VAR(v_N_split_files, 0, Int) can_split :: Bool -can_split = prefixMatch "i386" cTARGETPLATFORM - || prefixMatch "alpha" cTARGETPLATFORM - || prefixMatch "hppa" cTARGETPLATFORM - || prefixMatch "m68k" cTARGETPLATFORM - || prefixMatch "mips" cTARGETPLATFORM +can_split = prefixMatch "i386" cTARGETPLATFORM + || prefixMatch "alpha" cTARGETPLATFORM + || prefixMatch "hppa" cTARGETPLATFORM + || prefixMatch "m68k" cTARGETPLATFORM + || prefixMatch "mips" cTARGETPLATFORM || prefixMatch "powerpc" cTARGETPLATFORM - || prefixMatch "rs6000" cTARGETPLATFORM - || prefixMatch "sparc" cTARGETPLATFORM + || prefixMatch "rs6000" cTARGETPLATFORM + || prefixMatch "sparc" cTARGETPLATFORM ----------------------------------------------------------------------------- -- Compiler output options @@ -264,6 +271,10 @@ hsc_minusO_flags = "-flet-to-case" ] +getStaticOptimisationFlags 0 = hsc_minusNoO_flags +getStaticOptimisationFlags 1 = hsc_minusO_flags +getStaticOptimisationFlags n = hsc_minusO2_flags + buildCoreToDo :: IO [CoreToDo] buildCoreToDo = do opt_level <- readIORef v_OptLevel diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs index a8dd667..08d02c6 100644 --- a/ghc/compiler/main/DriverUtil.hs +++ b/ghc/compiler/main/DriverUtil.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverUtil.hs,v 1.8 2000/11/17 13:33:17 sewardj Exp $ +-- $Id: DriverUtil.hs,v 1.9 2000/11/19 19:40:08 simonmar Exp $ -- -- Utils for the driver -- @@ -39,7 +39,7 @@ long_usage = do exitWith ExitSuccess where dump "" = return () - dump ('$':'$':s) = hPutStr stderr get_prog_name >> dump s + dump ('$':'$':s) = hPutStr stderr prog_name >> dump s dump (c:s) = hPutChar stderr c >> dump s data BarfKind @@ -49,22 +49,25 @@ data BarfKind | OtherError String -- just prints the error message deriving Eq -GLOBAL_VAR(v_Prog_name, "ghc", String) - -get_prog_name = unsafePerformIO (readIORef v_Prog_name) -- urk! +prog_name = unsafePerformIO (getProgName) +{-# NOINLINE prog_name #-} instance Show BarfKind where - showsPrec _ e = showString get_prog_name . showString ": " . showBarf e + showsPrec _ e = showString prog_name . showString ": " . showBarf e -showBarf (UsageError str) = showString str . showChar '\n' . showString short_usage -showBarf (OtherError str) = showString str -showBarf (PhaseFailed phase code) = - showString phase . showString " failed, code = " . shows code -showBarf (Interrupted) = showString "interrupted" +showBarf (UsageError str) + = showString str . showChar '\n' . showString short_usage +showBarf (OtherError str) + = showString str +showBarf (PhaseFailed phase code) + = showString phase . showString " failed, code = " . shows code +showBarf (Interrupted) + = showString "interrupted" unknownFlagErr f = throwDyn (UsageError ("unrecognised flag: " ++ f)) barfKindTc = mkTyCon "BarfKind" +{-# NOINLINE barfKindTc #-} instance Typeable BarfKind where typeOf _ = mkAppTy barfKindTc [] diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index e9c22d9..81c5459 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.25 2000/11/17 16:53:27 simonmar Exp $ +-- $Id: Main.hs,v 1.26 2000/11/19 19:40:08 simonmar Exp $ -- -- GHC Driver program -- @@ -114,9 +114,6 @@ main = installHandler sigINT sig_handler Nothing #endif - pgm <- getProgName - writeIORef v_Prog_name pgm - argv <- getArgs -- grab any -B options from the command line first @@ -254,6 +251,7 @@ main = -- pragmas during the compilation, and we'll need to restore it -- before starting the next compilation. saved_driver_state <- readIORef v_Driver_state + writeIORef v_InitDriverState saved_driver_state let compileFile (src, phases) = do writeIORef v_Driver_state saved_driver_state