-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.12 2000/11/09 12:54:09 simonmar Exp $
+-- $Id: DriverState.hs,v 1.15 2000/11/19 19:40:08 simonmar Exp $
--
-- Settings for the driver
--
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
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})
-- 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
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
-GLOBAL_VAR(v_Hsc_Lang, if cGhcWithNativeCodeGen == "YES" &&
- (prefixMatch "i386" cTARGETPLATFORM ||
- prefixMatch "sparc" cTARGETPLATFORM)
- then HscAsm
- else HscC,
- HscLang)
+defaultHscLang
+ | cGhcWithNativeCodeGen == "YES" &&
+ (prefixMatch "i386" cTARGETPLATFORM ||
+ prefixMatch "sparc" cTARGETPLATFORM) = HscAsm
+ | otherwise = HscC
GLOBAL_VAR(v_Output_dir, Nothing, Maybe String)
GLOBAL_VAR(v_Object_suf, Nothing, Maybe String)
GLOBAL_VAR(v_OptLevel, 0, Int)
setOptLevel :: String -> IO ()
-setOptLevel "" = do { writeIORef v_OptLevel 1; go_via_C }
+setOptLevel "" = do { writeIORef v_OptLevel 1 }
setOptLevel "not" = writeIORef v_OptLevel 0
setOptLevel [c] | isDigit c = do
let level = ord c - ord '0'
writeIORef v_OptLevel level
- when (level >= 1) go_via_C
setOptLevel s = unknownFlagErr ("-O"++s)
-go_via_C = do
- l <- readIORef v_Hsc_Lang
- case l of { HscAsm -> writeIORef v_Hsc_Lang HscC;
- _other -> return () }
-
-GLOBAL_VAR(v_minus_o2_for_C, False, Bool)
-
-GLOBAL_VAR(v_MaxSimplifierIterations, 4, Int)
-GLOBAL_VAR(v_StgStats, False, Bool)
+GLOBAL_VAR(v_minus_o2_for_C, False, Bool)
+GLOBAL_VAR(v_MaxSimplifierIterations, 4, Int)
+GLOBAL_VAR(v_StgStats, False, Bool)
GLOBAL_VAR(v_UsageSPInf, False, Bool) -- Off by default
GLOBAL_VAR(v_Strictness, True, Bool)
GLOBAL_VAR(v_CPR, True, Bool)
"-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
getPackageImportPath :: IO [String]
getPackageImportPath = do
- ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
- return (nub (concat (map import_dirs ps')))
+ ps <- getPackageInfo
+ return (nub (concat (map import_dirs ps)))
getPackageIncludePath :: IO [String]
getPackageIncludePath = do
- ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
- return (nub (filter (not.null) (concatMap include_dirs ps')))
+ ps <- getPackageInfo
+ return (nub (filter (not.null) (concatMap include_dirs ps)))
-- includes are in reverse dependency order (i.e. rts first)
getPackageCIncludes :: IO [String]
getPackageCIncludes = do
- ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
- return (reverse (nub (filter (not.null) (concatMap c_includes ps'))))
+ ps <- getPackageInfo
+ return (reverse (nub (filter (not.null) (concatMap c_includes ps))))
getPackageLibraryPath :: IO [String]
getPackageLibraryPath = do
- ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
- return (nub (concat (map library_dirs ps')))
+ ps <- getPackageInfo
+ return (nub (concat (map library_dirs ps)))
getPackageLibraries :: IO [String]
getPackageLibraries = do
- ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
+ ps <- getPackageInfo
tag <- readIORef v_Build_tag
let suffix = if null tag then "" else '_':tag
return (concat (
- map (\p -> map (++suffix) (hs_libraries p) ++ extra_libraries p) ps'
+ map (\p -> map (++suffix) (hs_libraries p) ++ extra_libraries p) ps
))
getPackageExtraGhcOpts :: IO [String]
getPackageExtraGhcOpts = do
- ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
- return (concatMap extra_ghc_opts ps')
+ ps <- getPackageInfo
+ return (concatMap extra_ghc_opts ps)
getPackageExtraCcOpts :: IO [String]
getPackageExtraCcOpts = do
- ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
- return (concatMap extra_cc_opts ps')
+ ps <- getPackageInfo
+ return (concatMap extra_cc_opts ps)
getPackageExtraLdOpts :: IO [String]
getPackageExtraLdOpts = do
+ ps <- getPackageInfo
+ return (concatMap extra_ld_opts ps)
+
+getPackageInfo :: IO [Package]
+getPackageInfo = do
ps <- readIORef v_Packages
- ps' <- getPackageDetails ps
- return (concatMap extra_ld_opts ps')
+ getPackageDetails ps
getPackageDetails :: [String] -> IO [Package]
getPackageDetails ps = do
projects / ghc-hetmet.git / blobdiff