-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.47 2001/06/28 10:19:48 sewardj 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 Packages ( PackageConfig(..) )
+import SysTools ( getTopDir )
+import ParsePkgConf ( loadPackageConfig )
+import Packages ( PackageConfig(..), mungePackagePaths )
import CmdLineOpts
import DriverPhases
import DriverUtil
import List
import Char
import Monad
+import Directory ( doesDirectoryExist )
-----------------------------------------------------------------------------
-- non-configured things
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_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)
-- 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
-- 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 libs
+ else
+ if "HSwin321" `elem` libs && "HSwin322" `elem` libs
+ then "HSwin32" : filter ((/= "HSwin32").(take 7)) libs
+ else
+ libs
# endif
getPackageExtraGhcOpts :: IO [String]
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
, "-fvia-C" ]
-----------------------------------------------------------------------------
--- Programs for particular phases
+-- Options for particular phases
GLOBAL_VAR(v_Opt_dep, [], [String])
GLOBAL_VAR(v_Anti_opt_C, [], [String])