Commit e6ef290e authored by simonmar's avatar simonmar
Browse files

[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.
parent 0fff912c
......@@ -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",
......
-----------------------------------------------------------------------------
-- $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 )
-----------------------------------------------------------------------------
-- $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"
......
-----------------------------------------------------------------------------
-- $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
......
-----------------------------------------------------------------------------
-- $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 []
......
{-# 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
......
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