-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.40 2001/05/28 03:31:19 sof Exp $
+-- $Id: DriverState.hs,v 1.51 2001/07/31 10:06:25 sewardj Exp $
--
-- Settings for the driver
--
#include "../includes/config.h"
#include "HsVersions.h"
-import CmStaticInfo
+import Packages ( PackageConfig(..) )
import CmdLineOpts
+import DriverPhases
import DriverUtil
import Util
import Config
import Exception
import IOExts
-#ifdef mingw32_TARGET_OS
-import TmpFiles ( newTempName )
-import Directory ( removeFile )
-#endif
import Panic
import List
import Char
import Monad
+import Directory ( doesDirectoryExist )
-----------------------------------------------------------------------------
-- non-configured things
cHaskell1Version = "5" -- i.e., Haskell 98
-----------------------------------------------------------------------------
--- Global compilation flags
+-- GHC modes of operation
--- location of compiler-related files
-GLOBAL_VAR(v_TopDir, error "no TOPDIR", String)
+data GhcMode
+ = DoMkDependHS -- ghc -M
+ | DoMkDLL -- ghc --mk-dll
+ | StopBefore Phase -- ghc -E | -C | -S | -c
+ | DoMake -- ghc --make
+ | DoInteractive -- ghc --interactive
+ | DoLink -- [ the default ]
+ deriving (Eq)
+
+GLOBAL_VAR(v_GhcMode, error "mode not set", GhcMode)
+
+-----------------------------------------------------------------------------
+-- Global compilation flags
-- Cpp-related flags
v_Hs_source_cpp_opts = global
-- Misc
GLOBAL_VAR(v_Scale_sizes_by, 1.0, Double)
-GLOBAL_VAR(v_Dry_run, False, Bool)
GLOBAL_VAR(v_Static, True, Bool)
GLOBAL_VAR(v_NoHsMain, False, Bool)
GLOBAL_VAR(v_Recomp, True, Bool)
-- Splitting object files (for libraries)
GLOBAL_VAR(v_Split_object_files, False, Bool)
-GLOBAL_VAR(v_Split_prefix, "", String)
-GLOBAL_VAR(v_N_split_files, 0, Int)
+GLOBAL_VAR(v_Split_info, ("",0), (String,Int))
+ -- The split prefix and number of files
+
can_split :: Bool
can_split = prefixMatch "i386" cTARGETPLATFORM
GLOBAL_VAR(v_Object_suf, Nothing, Maybe String)
GLOBAL_VAR(v_HC_suf, Nothing, Maybe String)
+GLOBAL_VAR(v_Hi_dir, Nothing, Maybe String)
GLOBAL_VAR(v_Hi_suf, "hi", String)
GLOBAL_VAR(v_Ld_inputs, [], [String])
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_Strictness, False {-True-}, Bool)
GLOBAL_VAR(v_CPR, True, Bool)
GLOBAL_VAR(v_CSE, True, Bool)
]),
CoreDoSimplify (isAmongSimpl [
- MaxSimplifierIterations 2
+ MaxSimplifierIterations 3
-- No -finline-phase: allow all Ids to be inlined now
-- This gets foldr inlined before strictness analysis
+ --
+ -- At least 3 iterations because otherwise we land up with
+ -- huge dead expressions because of an infelicity in the
+ -- simpifier.
+ -- let k = BIG in foldr k z xs
+ -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs
+ -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
+ -- Don't stop now!
]),
- if strictness then CoreDoStrictness else CoreDoNothing,
if cpr then CoreDoCPResult else CoreDoNothing,
+ if strictness then CoreDoStrictness else CoreDoNothing,
CoreDoWorkerWrapper,
CoreDoGlomBinds,
addToDirList :: IORef [String] -> String -> IO ()
addToDirList ref path
- = do paths <- readIORef ref
- writeIORef ref (paths ++ split split_marker path)
+ = do paths <- readIORef ref
+ shiny_new_ones <- splitUp path
+ writeIORef ref (paths ++ shiny_new_ones)
+
+ where
+ splitUp ::String -> IO [String]
+#ifdef mingw32_TARGET_OS
+ -- 'hybrid' support for DOS-style paths in directory lists.
+ --
+ -- That is, if "foo:bar:baz" is used, this interpreted as
+ -- consisting of three entries, 'foo', 'bar', 'baz'.
+ -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
+ -- as four elts, "c:/foo", "c:\\foo", "x", and "/bar" --
+ -- *provided* c:/foo exists and x:/bar doesn't.
+ --
+ -- Notice that no attempt is made to fully replace the 'standard'
+ -- split marker ':' with the Windows / DOS one, ';'. The reason being
+ -- that this will cause too much breakage for users & ':' will
+ -- work fine even with DOS paths, if you're not insisting on being silly.
+ -- So, use either.
+ splitUp [] = return []
+ splitUp (x:':':div:xs)
+ | div `elem` dir_markers = do
+ let (p,rs) = findNextPath xs
+ ps <- splitUp rs
+ {-
+ Consult the file system to check the interpretation
+ of (x:':':div:p) -- this is arguably excessive, we
+ could skip this test & just say that it is a valid
+ dir path.
+ -}
+ flg <- doesDirectoryExist (x:':':div:p)
+ if flg then
+ return ((x:':':div:p):ps)
+ else
+ return ([x]:(div:p):ps)
+ splitUp xs = do
+ let (p,rs) = findNextPath xs
+ ps <- splitUp rs
+ return (cons p ps)
+
+ cons "" xs = xs
+ cons x xs = x:xs
+
+ -- will be called either when we've consumed nought or the "<Drive>:/" part of
+ -- a DOS path, so splitting is just a Q of finding the next split marker.
+ findNextPath xs =
+ case break (`elem` split_markers) xs of
+ (p, d:ds) -> (p, ds)
+ (p, xs) -> (p, xs)
+
+ split_markers :: [Char]
+ split_markers = [':', ';']
+
+ dir_markers :: [Char]
+ dir_markers = ['/', '\\']
+
+#else
+ splitUp xs = return (split split_marker xs)
+#endif
GLOBAL_VAR(v_HCHeader, "", String)
-----------------------------------------------------------------------------
-- Packages
-GLOBAL_VAR(v_Path_package_config, error "path_package_config", String)
-
-- package list is maintained in dependency order
GLOBAL_VAR(v_Packages, ("std":"rts":"gmp":[]), [String])
getPackageImportPath :: IO [String]
getPackageImportPath = do
ps <- getPackageInfo
- return (nub (concat (map import_dirs ps)))
+ return (nub (filter (not.null) (concatMap import_dirs ps)))
getPackageIncludePath :: IO [String]
getPackageIncludePath = do
getPackageLibraryPath :: IO [String]
getPackageLibraryPath = do
ps <- getPackageInfo
- return (nub (concat (map library_dirs ps)))
+ return (nub (filter (not.null) (concatMap library_dirs ps)))
getPackageLibraries :: IO [String]
getPackageLibraries = do
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) (hACK (hs_libraries p)) ++ extra_libraries p) ps
))
+ where
+ -- This is a totally horrible (temporary) hack, for Win32. Problem is
+ -- that package.conf for Win32 says that the main prelude lib is
+ -- split into HSstd1 and HSstd2, which is needed due to limitations in
+ -- the PEi386 file format, to make GHCi work. However, we still only
+ -- have HSstd.a for static linking, not HSstd1.a and HSstd2.a.
+ -- getPackageLibraries is called to find the .a's to add to the static
+ -- link line. On Win32, this hACK detects HSstd1 and HSstd2 and
+ -- replaces them with HSstd, so static linking still works.
+ -- Libraries needed for dynamic (GHCi) linking are discovered via
+ -- different route (in InteractiveUI.linkPackage).
+ -- See driver/PackageSrc.hs for the HSstd1/HSstd2 split definition.
+ -- THIS IS A STRICTLY TEMPORARY HACK (famous last words ...)
+ hACK libs
+# ifndef mingw32_TARGET_OS
+ = libs
+# else
+ = if "HSstd1" `elem` libs && "HSstd2" `elem` libs
+ then "HSstd" : filter ((/= "HSstd").(take 5)) libs
+ else libs
+# endif
getPackageExtraGhcOpts :: IO [String]
getPackageExtraGhcOpts = do
= case [p | p <- ps, name p == nm] of
[] -> Nothing
(p:_) -> Just p
+
-----------------------------------------------------------------------------
-- Ways
-----------------------------------------------------------------------------
-- Programs for particular phases
-GLOBAL_VAR(v_Pgm_L, error "pgm_L", String)
-GLOBAL_VAR(v_Pgm_P, cRAWCPP, String)
-GLOBAL_VAR(v_Pgm_c, cGCC, String)
-GLOBAL_VAR(v_Pgm_m, error "pgm_m", String)
-GLOBAL_VAR(v_Pgm_s, error "pgm_s", String)
-GLOBAL_VAR(v_Pgm_a, cGCC, String)
-GLOBAL_VAR(v_Pgm_l, cGCC, String)
-GLOBAL_VAR(v_Pgm_dll, cMkDLL, String)
-
-#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
-GLOBAL_VAR(v_Pgm_T, cTOUCH, String)
-#endif
-
GLOBAL_VAR(v_Opt_dep, [], [String])
GLOBAL_VAR(v_Anti_opt_C, [], [String])
GLOBAL_VAR(v_Opt_C, [], [String])
projects / ghc-hetmet.git / blobdiff