-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.41 2001/05/31 11:32:25 simonmar Exp $
+-- $Id: DriverState.hs,v 1.57 2001/09/14 15:51:42 simonpj Exp $
--
-- Settings for the driver
--
#include "../includes/config.h"
#include "HsVersions.h"
-import CmStaticInfo
+import SysTools ( getTopDir )
+import ParsePkgConf ( loadPackageConfig )
+import Packages ( PackageConfig(..), mungePackagePaths )
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
+
+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)
--- location of compiler-related files
-GLOBAL_VAR(v_TopDir, error "no TOPDIR", String)
+-----------------------------------------------------------------------------
+-- 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)
GLOBAL_VAR(v_Collect_ghc_timing, False, Bool)
GLOBAL_VAR(v_Do_asm_mangling, True, Bool)
GLOBAL_VAR(v_Excess_precision, False, Bool)
+GLOBAL_VAR(v_Read_DotGHCi, 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_Strictness, True, Bool)
GLOBAL_VAR(v_CPR, True, Bool)
GLOBAL_VAR(v_CSE, True, Bool)
+GLOBAL_VAR(v_RuleCheck, Nothing, Maybe String)
-- these are the static flags you get without -O.
hsc_minusNoO_flags =
strictness <- readIORef v_Strictness
cpr <- readIORef v_CPR
cse <- readIORef v_CSE
+ rule_check <- readIORef v_RuleCheck
if opt_level == 0 then return
[
]),
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,
CoreDoSimplify (isAmongSimpl [
MaxSimplifierIterations max_iter
-- No -finline-phase: allow all Ids to be inlined now
- ])
+ ]),
+
+ case rule_check of { Just pat -> CoreDoRuleCheck pat; Nothing -> CoreDoNothing }
]
buildStgToDo :: IO [ StgToDo ]
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])
+readPackageConf :: String -> IO ()
+readPackageConf conf_file = do
+ proto_pkg_details <- loadPackageConfig conf_file
+ top_dir <- getTopDir
+ let pkg_details = mungePackagePaths top_dir proto_pkg_details
+ old_pkg_details <- readIORef v_Package_details
+ let intersection = filter (`elem` map name old_pkg_details)
+ (map name pkg_details)
+ if (not (null intersection))
+ then throwDyn (InstallationError ("package `" ++ head intersection ++ "' is already defined"))
+ else do
+ writeIORef v_Package_details (pkg_details ++ old_pkg_details)
+
addPackage :: String -> IO ()
addPackage package
= do pkg_details <- readIORef v_Package_details
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 ...)
+ -- JRS 04 Sept 01: Same appalling hack for HSwin32[1,2]
+ hACK libs
+# ifndef mingw32_TARGET_OS
+ = libs
+# else
+ = if "HSstd1" `elem` libs && "HSstd2" `elem` libs
+ then "HSstd" : filter ((/= "HSstd").(take 5)) libs
+ else
+ if "HSwin321" `elem` libs && "HSwin322" `elem` libs
+ then "HSwin32" : filter ((/= "HSwin32").(take 7)) libs
+ else
+ libs
+# endif
getPackageExtraGhcOpts :: IO [String]
getPackageExtraGhcOpts = 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"), [PackageConfig])
+GLOBAL_VAR(v_Package_details, [], [PackageConfig])
lookupPkg :: String -> [PackageConfig] -> Maybe PackageConfig
lookupPkg nm ps
= case [p | p <- ps, name p == nm] of
[] -> Nothing
(p:_) -> Just p
+
-----------------------------------------------------------------------------
-- Ways
, "-fvia-C" ]
-----------------------------------------------------------------------------
--- 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
+-- Options for particular phases
GLOBAL_VAR(v_Opt_dep, [], [String])
GLOBAL_VAR(v_Anti_opt_C, [], [String])
projects / ghc-hetmet.git / blobdiff