[project @ 2000-12-12 14:35:08 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / DriverState.hs
index 37e19e2..5723788 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.16 2000/11/21 14:35:05 simonmar Exp $
+-- $Id: DriverState.hs,v 1.20 2000/12/12 14:35:08 simonmar Exp $
 --
 -- Settings for the driver
 --
@@ -22,9 +22,8 @@ import IOExts
 import TmpFiles        ( newTempName )
 import Directory ( removeFile )
 #endif
+import Panic
 
-import System
-import IO
 import List
 import Char  
 import Monad
@@ -287,7 +286,7 @@ buildCoreToDo = do
        ])
       ]
 
-    else {- level >= 1 -} return [ 
+    else {- opt_level >= 1 -} return [ 
 
        -- initial simplify: mk specialiser happy: minimum effort please
        CoreDoSimplify (isAmongSimpl [
@@ -359,6 +358,7 @@ buildCoreToDo = do
                -- catch it.  For the record, the redex is 
                --        f_el22 (f_el21 r_midblock)
 
+
 -- Leave out lambda lifting for now
 --       "-fsimplify", -- Tidy up results of full laziness
 --         "[", 
@@ -368,12 +368,8 @@ buildCoreToDo = do
 
        -- We want CSE to follow the final full-laziness pass, because it may
        -- succeed in commoning up things floated out by full laziness.
-       --
-       -- CSE must immediately follow a simplification pass, because it relies
-       -- on the no-shadowing invariant.  See comments at the top of CSE.lhs
-       -- So it must NOT follow float-inwards, which can give rise to shadowing,
-       -- even if its input doesn't have shadows.  Hence putting it between
-       -- the two passes.
+       -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
+
        if cse then CoreCSE else CoreDoNothing,
 
        CoreDoFloatInwards,
@@ -381,11 +377,10 @@ buildCoreToDo = do
 -- Case-liberation for -O2.  This should be after
 -- strictness analysis and the simplification which follows it.
 
---       ( ($OptLevel != 2)
---       ? ""
---       : "-fliberate-case -fsimplify [ $Oopt_FB_Support -ffloat-lets-exposing-whnf -ffloat-primops-ok -fcase-of-case -fdo-case-elim -fcase-merge -fdo-lambda-eta-expansion -freuse-con -flet-to-case $Oopt_PedanticBottoms $Oopt_MaxSimplifierIterations $Oopt_ShowSimplifierProgress ]" ),
---
---       "-fliberate-case",
+       if opt_level >= 2 then
+          CoreLiberateCase
+       else
+          CoreDoNothing,
 
        -- Final clean-up simplification:
        CoreDoSimplify (isAmongSimpl [
@@ -527,7 +522,6 @@ GLOBAL_VAR(v_Build_tag, "", String)
 data WayName
   = WayProf
   | WayUnreg
-  | WayDll
   | WayTicky
   | WayPar
   | WayGran
@@ -554,12 +548,10 @@ data WayName
 
 GLOBAL_VAR(v_Ways, [] ,[WayName])
 
--- ToDo: allow WayDll with any other allowed combination
-
-allowed_combinations = 
-   [  [WayProf,WayUnreg],
-      [WayProf,WaySMP]    -- works???
-   ]
+allowed_combination way = way `elem` combs
+  where  -- the sub-lists must be ordered according to WayName, 
+         -- because findBuildTag sorts them
+    combs                = [ [WayProf,WayUnreg], [WayProf,WaySMP] ]
 
 findBuildTag :: IO [String]  -- new options
 findBuildTag = do
@@ -572,7 +564,7 @@ findBuildTag = do
               writeIORef v_Build_tag (wayTag details)
               return (wayOpts details)
 
-     ws  -> if  ws `notElem` allowed_combinations
+     ws  -> if not (allowed_combination ws)
                then throwDyn (OtherError $
                                "combination not supported: "  ++
                                foldr1 (\a b -> a ++ '/':b) 
@@ -616,9 +608,6 @@ way_details =
        , "-funregisterised"
        , "-fvia-C" ]),
 
-    (WayDll, Way  "dll" "DLLized"
-        [ ]),
-
     (WayPar, Way  "mp" "Parallel" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
@@ -714,7 +703,8 @@ machdepCCOpts
       --   the fp (%ebp) for our register maps.
        = do n_regs <- readState stolen_x86_regs
             sta    <- readIORef v_Static
-            return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" ],
+            return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
+                        if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
                      [ "-fno-defer-pop", "-fomit-frame-pointer",
                        "-DSTOLEN_X86_REGS="++show n_regs ]
                    )