-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.29 2001/01/18 16:30:00 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.30 2001/01/19 15:26:37 simonmar Exp $
--
-- GHC Interactive User Interface
--
mapM setOpt plus_opts
-- now, the GHC flags
- io (do leftovers <- processArgs static_flags minus_opts []
+ io (do -- first, static flags
+ leftovers <- processArgs static_flags minus_opts []
+
+ -- then, dynamic flags
dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags dyn_flags
leftovers <- processArgs dynamic_flags leftovers []
dyn_flags <- readIORef v_DynFlags
writeIORef v_InitDynFlags dyn_flags
+
if (not (null leftovers))
then throwDyn (OtherError ("unrecognised flags: " ++
unwords leftovers))
deriving (Eq)
data DynFlags = DynFlags {
- coreToDo :: [CoreToDo],
- stgToDo :: [StgToDo],
- hscLang :: HscLang,
- hscOutName :: String, -- name of the file in which to place output
- verbosity :: Int, -- verbosity level
- flags :: [DynFlag]
+ coreToDo :: [CoreToDo],
+ stgToDo :: [StgToDo],
+ hscLang :: HscLang,
+ hscOutName :: String, -- name of the output file
+ verbosity :: Int, -- verbosity level
+ cppFlag :: Bool, -- preprocess with cpp?
+ stolen_x86_regs :: Int,
+ cmdlineHcIncludes :: [String], -- -#includes
+
+ -- options for particular phases
+ opt_L :: [String],
+ opt_P :: [String],
+ opt_c :: [String],
+ opt_a :: [String],
+ opt_m :: [String],
+
+ -- hsc dynamic flags
+ flags :: [DynFlag]
}
defaultDynFlags = DynFlags {
coreToDo = [], stgToDo = [],
- hscLang = HscC, hscOutName = "",
- verbosity = 0, flags = []
+ hscLang = HscC,
+ hscOutName = "",
+ verbosity = 0,
+ cppFlag = False,
+ stolen_x86_regs = 4,
+ cmdlineHcIncludes = [],
+ opt_L = [],
+ opt_P = [],
+ opt_c = [],
+ opt_a = [],
+ opt_m = [],
+ flags = []
}
{-
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.39 2001/01/12 11:04:45 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.40 2001/01/19 15:26:37 simonmar Exp $
--
-- Driver flags
--
-- v_InitDynFlags
-- is the "baseline" dynamic flags, initialised from
--- the defaults and command line options.
+-- the defaults and command line options, and updated by the
+-- ':s' command in GHCi.
--
-- v_DynFlags
-- is the dynamic flags for the current compilation. It is reset
setDynFlag f = updDynFlags (\dfs -> dfs{ flags = f : flags dfs })
unSetDynFlag f = updDynFlags (\dfs -> dfs{ flags = filter (/= f) (flags dfs) })
+addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
+addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
+addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
+addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
+addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
+
+addCmdlineHCInclude a =
+ updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
+
+ -- we add to the options from the front, so we need to reverse the list
+getOpts :: (DynFlags -> [a]) -> IO [a]
+getOpts opts = dynFlag opts >>= return . reverse
+
-- we can only change HscC to HscAsm and vice-versa with dynamic flags
-- (-fvia-C and -fasm).
setLang l = do
dynamic_flags = [
- ( "cpp", NoArg (updateState (\s -> s{ cpp_flag = True })) )
+ ( "cpp", NoArg (updDynFlags (\s -> s{ cppFlag = True })) )
, ( "#include", HasArg (addCmdlineHCInclude) )
, ( "v", OptPrefix (setVerbosity) )
------ Machine dependant (-m<blah>) stuff ---------------------------
- , ( "monly-2-regs", NoArg (updateState (\s -> s{stolen_x86_regs = 2}) ))
- , ( "monly-3-regs", NoArg (updateState (\s -> s{stolen_x86_regs = 3}) ))
- , ( "monly-4-regs", NoArg (updateState (\s -> s{stolen_x86_regs = 4}) ))
+ , ( "monly-2-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
+ , ( "monly-3-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
+ , ( "monly-4-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
------ Compiler flags -----------------------------------------------
then throwDyn (PhaseFailed phase_name exit_code)
else do when (verb >= 3) (hPutStr stderr "\n")
return ()
+
+-----------------------------------------------------------------------------
+-- Via-C compilation stuff
+
+-- flags returned are: ( all C compilations
+-- , registerised HC compilations
+-- )
+
+machdepCCOpts
+ | prefixMatch "alpha" cTARGETPLATFORM
+ = return ( ["-static"], [] )
+
+ | prefixMatch "hppa" cTARGETPLATFORM
+ -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
+ -- (very nice, but too bad the HP /usr/include files don't agree.)
+ = return ( ["-static", "-D_HPUX_SOURCE"], [] )
+
+ | prefixMatch "m68k" cTARGETPLATFORM
+ -- -fno-defer-pop : for the .hc files, we want all the pushing/
+ -- popping of args to routines to be explicit; if we let things
+ -- be deferred 'til after an STGJUMP, imminent death is certain!
+ --
+ -- -fomit-frame-pointer : *don't*
+ -- It's better to have a6 completely tied up being a frame pointer
+ -- rather than let GCC pick random things to do with it.
+ -- (If we want to steal a6, then we would try to do things
+ -- as on iX86, where we *do* steal the frame pointer [%ebp].)
+ = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
+
+ | prefixMatch "i386" cTARGETPLATFORM
+ -- -fno-defer-pop : basically the same game as for m68k
+ --
+ -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
+ -- the fp (%ebp) for our register maps.
+ = do n_regs <- dynFlag stolen_x86_regs
+ sta <- readIORef v_Static
+ return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
+ if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
+ [ "-fno-defer-pop", "-fomit-frame-pointer",
+ "-DSTOLEN_X86_REGS="++show n_regs ]
+ )
+
+ | prefixMatch "mips" cTARGETPLATFORM
+ = return ( ["static"], [] )
+
+ | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
+ = return ( ["static"], ["-finhibit-size-directive"] )
+
+ | otherwise
+ = return ( [], [] )
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.48 2001/01/16 21:05:51 qrczak Exp $
+-- $Id: DriverPipeline.hs,v 1.49 2001/01/19 15:26:37 simonmar Exp $
--
-- GHC Driver
--
++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t"
++ unwords unhandled_flags)) (ExitFailure 1))
- do_cpp <- readState cpp_flag
+ do_cpp <- dynFlag cppFlag
if do_cpp
then do
cpp <- readIORef v_Pgm_P
++ pkg_include_dirs)
c_includes <- getPackageCIncludes
- cmdline_includes <- readState cmdline_hc_includes -- -#include options
+ cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
let cc_injects | hcc = unlines (map mk_include
(c_includes ++ reverse cmdline_includes))
mangler_opts <- getOpts opt_m
machdep_opts <-
if (prefixMatch "i386" cTARGETPLATFORM)
- then do n_regs <- readState stolen_x86_regs
+ then do n_regs <- dynFlag stolen_x86_regs
return [ show n_regs ]
else return []
runSomething "Assembly Mangler"
preprocess :: FilePath -> IO FilePath
preprocess filename =
ASSERT(haskellish_file filename)
- do init_driver_state <- readIORef v_InitDriverState
- writeIORef v_Driver_state init_driver_state
-
+ do init_dyn_flags <- readIORef v_InitDynFlags
+ writeIORef v_DynFlags init_dyn_flags
pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
defaultHscLang filename
runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
-
-----------------------------------------------------------------------------
-- Compile a single module, under the control of the compilation manager.
--
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
showPass init_dyn_flags
(showSDoc (text "Compiling" <+> ppr (name_of_summary summary)))
-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.24 2001/01/16 12:41:03 simonmar Exp $
+-- $Id: DriverState.hs,v 1.25 2001/01/19 15:26:37 simonmar Exp $
--
-- Settings for the driver
--
import Monad
-----------------------------------------------------------------------------
--- Driver state
-
--- certain flags can be specified on a per-file basis, in an OPTIONS
--- pragma at the beginning of the source file. This means that when
--- compiling mulitple files, we have to restore the global option
--- settings before compiling a new file.
---
--- The DriverState record contains the per-file-mutable state.
-
-data DriverState = DriverState {
-
- -- are we runing cpp on this file?
- cpp_flag :: Bool,
-
- -- misc
- stolen_x86_regs :: Int,
- cmdline_hc_includes :: [String],
-
- -- options for a particular phase
- opt_L :: [String],
- opt_P :: [String],
- opt_c :: [String],
- opt_a :: [String],
- opt_m :: [String]
- }
-
-initDriverState = DriverState {
- cpp_flag = False,
- stolen_x86_regs = 4,
- cmdline_hc_includes = [],
- opt_L = [],
- opt_P = [],
- opt_c = [],
- opt_a = [],
- opt_m = [],
- }
-
--- 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
-
-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})
-
-addCmdlineHCInclude a =
- updateState (\s -> s{cmdline_hc_includes = a : cmdline_hc_includes s})
-
- -- we add to the options from the front, so we need to reverse the list
-getOpts :: (DriverState -> [a]) -> IO [a]
-getOpts opts = readState opts >>= return . reverse
-
------------------------------------------------------------------------------
-- non-configured things
cHaskell1Version = "5" -- i.e., Haskell 98
getStaticOpts :: IORef [String] -> IO [String]
getStaticOpts ref = readIORef ref >>= return . reverse
-
------------------------------------------------------------------------------
--- Via-C compilation stuff
-
--- flags returned are: ( all C compilations
--- , registerised HC compilations
--- )
-
-machdepCCOpts
- | prefixMatch "alpha" cTARGETPLATFORM
- = return ( ["-static"], [] )
-
- | prefixMatch "hppa" cTARGETPLATFORM
- -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
- -- (very nice, but too bad the HP /usr/include files don't agree.)
- = return ( ["-static", "-D_HPUX_SOURCE"], [] )
-
- | prefixMatch "m68k" cTARGETPLATFORM
- -- -fno-defer-pop : for the .hc files, we want all the pushing/
- -- popping of args to routines to be explicit; if we let things
- -- be deferred 'til after an STGJUMP, imminent death is certain!
- --
- -- -fomit-frame-pointer : *don't*
- -- It's better to have a6 completely tied up being a frame pointer
- -- rather than let GCC pick random things to do with it.
- -- (If we want to steal a6, then we would try to do things
- -- as on iX86, where we *do* steal the frame pointer [%ebp].)
- = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
-
- | prefixMatch "i386" cTARGETPLATFORM
- -- -fno-defer-pop : basically the same game as for m68k
- --
- -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
- -- the fp (%ebp) for our register maps.
- = do n_regs <- readState stolen_x86_regs
- sta <- readIORef v_Static
- return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
- if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
- [ "-fno-defer-pop", "-fomit-frame-pointer",
- "-DSTOLEN_X86_REGS="++show n_regs ]
- )
-
- | prefixMatch "mips" cTARGETPLATFORM
- = return ( ["static"], [] )
-
- | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
- = return ( ["static"], ["-finhibit-size-directive"] )
-
- | otherwise
- = return ( [], [] )
-------------------------- Code output -------------------------------
(maybe_stub_h_name, maybe_stub_c_name)
- <- _scc_ "CodeOutput"
- codeOutput dflags this_mod local_tycons
+ <- codeOutput dflags this_mod local_tycons
tidy_binds stg_binds
c_code h_code abstractC
{-# OPTIONS -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.47 2001/01/16 12:41:03 simonmar Exp $
+-- $Id: Main.hs,v 1.48 2001/01/19 15:26:37 simonmar Exp $
--
-- GHC Driver program
--
#ifdef GHCI
-import Interpreter
import InteractiveUI
#endif
import DriverUtil
import Panic
import DriverPhases ( Phase(..), haskellish_file )
-import CmdLineOpts ( HscLang(..), DynFlags(..), v_Static_hsc_opts )
+import CmdLineOpts
import TmpFiles
import Finder ( initFinder )
import CmStaticInfo
import Util
-
import Concurrent
import Directory
import IOExts
| otherwise -> defaultHscLang
writeIORef v_DynFlags
- DynFlags{ coreToDo = core_todo,
- stgToDo = stg_todo,
- hscLang = lang,
- -- leave out hscOutName for now
- hscOutName = panic "Main.main:hscOutName not set",
-
- verbosity = case mode of
- DoInteractive -> 1
- DoMake -> 1
- _other -> 0,
-
- flags = [] }
+ defaultDynFlags{ coreToDo = core_todo,
+ stgToDo = stg_todo,
+ hscLang = lang,
+ -- leave out hscOutName for now
+ hscOutName = panic "Main.main:hscOutName not set",
+
+ verbosity = case mode of
+ DoInteractive -> 1
+ DoMake -> 1
+ _other -> 0,
+ }
-- the rest of the arguments are "dynamic"
srcs <- processArgs dynamic_flags (way_non_static ++
-- complain about any unknown flags
mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
- -- save the flag state, because this could be modified by OPTIONS
- -- 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
-
verb <- dynFlag verbosity
when (verb >= 2)
if null srcs then throwDyn (UsageError "no input files") else do
let compileFile src = do
- writeIORef v_Driver_state saved_driver_state
writeIORef v_DynFlags init_dyn_flags
-- We compile in two stages, because the file may have an
projects / ghc-hetmet.git / commitdiff