[project @ 2001-07-31 10:06:25 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / DriverState.hs
index 48e683a..719ca5d 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.46 2001/06/27 16:38:17 simonmar Exp $
+-- $Id: DriverState.hs,v 1.51 2001/07/31 10:06:25 sewardj Exp $
 --
 -- Settings for the driver
 --
@@ -25,6 +25,7 @@ import Panic
 import List
 import Char  
 import Monad
+import Directory ( doesDirectoryExist )
 
 -----------------------------------------------------------------------------
 -- non-configured things
@@ -142,7 +143,7 @@ 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_Strictness,               False {-True-},  Bool)
 GLOBAL_VAR(v_CPR,                      True,  Bool)
 GLOBAL_VAR(v_CSE,                      True,  Bool)
 
@@ -242,13 +243,21 @@ buildCoreToDo = do
        ]),
 
        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,
 
@@ -326,8 +335,66 @@ GLOBAL_VAR(v_Cmdline_libraries,   [], [String])
 
 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)
 
@@ -376,8 +443,29 @@ 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