-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.24 2001/01/16 12:41:03 simonmar Exp $
+-- $Id: DriverState.hs,v 1.35 2001/03/23 16:36:20 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
-----------------------------------------------------------------------------
-- Hi Files
-GLOBAL_VAR(v_ProduceHi, True, Bool)
GLOBAL_VAR(v_Hi_on_stdout, False, Bool)
GLOBAL_VAR(v_Hi_suf, "hi", String)
-----------------------------------------------------------------------------
--- Warnings & sanity checking
-
--- Warning packages that are controlled by -W and -Wall. The 'standard'
--- warnings that you get all the time are
---
--- -fwarn-overlapping-patterns
--- -fwarn-missing-methods
--- -fwarn-missing-fields
--- -fwarn-deprecations
--- -fwarn-duplicate-exports
---
--- these are turned off by -Wnot.
-
-
-standardWarnings = [ "-fwarn-overlapping-patterns"
- , "-fwarn-missing-methods"
- , "-fwarn-missing-fields"
- , "-fwarn-deprecations"
- , "-fwarn-duplicate-exports"
- ]
-minusWOpts = standardWarnings ++
- [ "-fwarn-unused-binds"
- , "-fwarn-unused-matches"
- , "-fwarn-incomplete-patterns"
- , "-fwarn-unused-imports"
- ]
-minusWallOpts = minusWOpts ++
- [ "-fwarn-type-defaults"
- , "-fwarn-name-shadowing"
- , "-fwarn-missing-signatures"
- , "-fwarn-hi-shadowing"
- ]
-
-data WarningState = W_default | W_ | W_all | W_not
-GLOBAL_VAR(v_Warning_opt, W_default, WarningState)
-
------------------------------------------------------------------------------
-- Compiler optimisation options
GLOBAL_VAR(v_OptLevel, 0, Int)
[
"-fignore-interface-pragmas",
"-fomit-interface-pragmas",
+ "-fdo-lambda-eta-expansion", -- This one is important for a tiresome reason:
+ -- we want to make sure that the bindings for data
+ -- constructors are eta-expanded. This is probably
+ -- a good thing anyway, but it seems fragile.
"-flet-no-escape"
]
-- these are the static flags you get when -O is on.
hsc_minusO_flags =
[
+ "-fignore-asserts",
"-ffoldr-build-on",
"-fdo-eta-reduction",
"-fdo-lambda-eta-expansion",
- "-fcase-of-case",
"-fcase-merge",
"-flet-to-case",
"-flet-no-escape"
CoreLiberateCase
else
CoreDoNothing,
+ if opt_level >= 2 then
+ CoreDoSpecConstr
+ else
+ CoreDoNothing,
-- Final clean-up simplification:
CoreDoSimplify (isAmongSimpl [
= do paths <- readIORef ref
writeIORef ref (paths ++ split split_marker path)
+GLOBAL_VAR(v_HCHeader, "", String)
+
-----------------------------------------------------------------------------
-- Packages
ps <- getPackageInfo
return (concatMap extra_ld_opts ps)
-getPackageInfo :: IO [Package]
+getPackageInfo :: IO [PackageConfig]
getPackageInfo = do
ps <- readIORef v_Packages
getPackageDetails ps
-getPackageDetails :: [String] -> IO [Package]
+getPackageDetails :: [String] -> IO [PackageConfig]
getPackageDetails ps = do
pkg_details <- readIORef v_Package_details
return [ pkg | p <- ps, Just pkg <- [ lookupPkg p pkg_details ] ]
-GLOBAL_VAR(v_Package_details, (error "package_details"), [Package])
+GLOBAL_VAR(v_Package_details, (error "package_details"), [PackageConfig])
-lookupPkg :: String -> [Package] -> Maybe Package
+lookupPkg :: String -> [PackageConfig] -> Maybe PackageConfig
lookupPkg nm ps
= case [p | p <- ps, name p == nm] of
[] -> Nothing
(WayUnreg, Way "u" "Unregisterised"
unregFlags ),
+ -- optl's below to tell linker where to find the PVM library -- HWL
(WayPar, Way "mp" "Parallel"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
, "-package concurrent"
+ , "-optc-w"
+ , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
+ , "-optl-lpvm3"
+ , "-optl-lgpvm3"
+ , "-fvia-C" ]),
+
+ -- at the moment we only change the RTS and could share compiler and libs!
+ (WayPar, Way "mt" "Parallel ticky profiling"
+ [ "-fparallel"
+ , "-D__PARALLEL_HASKELL__"
+ , "-optc-DPAR"
+ , "-optc-DPAR_TICKY"
+ , "-package concurrent"
+ , "-optc-w"
+ , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
+ , "-optl-lpvm3"
+ , "-optl-lgpvm3"
, "-fvia-C" ]),
- (WayGran, Way "mg" "Gransim"
+ (WayPar, Way "md" "Distributed"
+ [ "-fparallel"
+ , "-D__PARALLEL_HASKELL__"
+ , "-D__DISTRIBUTED_HASKELL__"
+ , "-optc-DPAR"
+ , "-optc-DDIST"
+ , "-package concurrent"
+ , "-optc-w"
+ , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
+ , "-optl-lpvm3"
+ , "-optl-lgpvm3"
+ , "-fvia-C" ]),
+
+ (WayGran, Way "mg" "GranSim"
[ "-fgransim"
, "-D__GRANSIM__"
, "-optc-DGRAN"
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 ( [], [] )
projects / ghc-hetmet.git / blobdiff