[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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