[project @ 2001-12-10 14:08:14 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / DriverState.hs
index e45dcd0..7676434 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.54 2001/08/14 13:40:08 sewardj Exp $
+-- $Id: DriverState.hs,v 1.63 2001/12/10 14:08:14 simonmar Exp $
 --
 -- Settings for the driver
 --
@@ -48,6 +48,10 @@ data GhcMode
 
 GLOBAL_VAR(v_GhcMode, error "mode not set", GhcMode)
 
+isCompManagerMode DoMake        = True
+isCompManagerMode DoInteractive = True
+isCompManagerMode _             = False
+
 -----------------------------------------------------------------------------
 -- Global compilation flags
 
@@ -60,12 +64,17 @@ v_Hs_source_cpp_opts = global
        ]
 {-# NOINLINE v_Hs_source_cpp_opts #-}
 
+
 -- Keep output from intermediate phases
 GLOBAL_VAR(v_Keep_hi_diffs,            False,          Bool)
 GLOBAL_VAR(v_Keep_hc_files,            False,          Bool)
 GLOBAL_VAR(v_Keep_s_files,             False,          Bool)
 GLOBAL_VAR(v_Keep_raw_s_files,         False,          Bool)
 GLOBAL_VAR(v_Keep_tmp_files,           False,          Bool)
+#ifdef ILX
+GLOBAL_VAR(v_Keep_il_files,            False,          Bool)
+GLOBAL_VAR(v_Keep_ilx_files,           False,          Bool)
+#endif
 
 -- Misc
 GLOBAL_VAR(v_Scale_sizes_by,           1.0,            Double)
@@ -77,6 +86,9 @@ GLOBAL_VAR(v_Do_asm_mangling,         True,           Bool)
 GLOBAL_VAR(v_Excess_precision,         False,          Bool)
 GLOBAL_VAR(v_Read_DotGHCi,             True,           Bool)
 
+-- Preprocessor flags
+GLOBAL_VAR(v_Hs_source_pp_opts, [], [String])
+
 -----------------------------------------------------------------------------
 -- Splitting object files (for libraries)
 
@@ -146,9 +158,12 @@ 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,               False{-True-},  Bool)
+GLOBAL_VAR(v_Strictness,               True,  Bool)
+#ifdef DEBUG
 GLOBAL_VAR(v_CPR,                      True,  Bool)
+#endif
 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 =
@@ -186,35 +201,38 @@ buildCoreToDo = do
    max_iter   <- readIORef v_MaxSimplifierIterations
    usageSP    <- readIORef v_UsageSPInf
    strictness <- readIORef v_Strictness
+#ifdef DEBUG
    cpr        <- readIORef v_CPR
+#endif
    cse        <- readIORef v_CSE
+   rule_check <- readIORef v_RuleCheck
 
    if opt_level == 0 then return
       [
-       CoreDoSimplify (isAmongSimpl [
+       CoreDoSimplify (SimplPhase 0) [
            MaxSimplifierIterations max_iter
-       ])
+       ]
       ]
 
     else {- opt_level >= 1 -} return [ 
 
        -- initial simplify: mk specialiser happy: minimum effort please
-       CoreDoSimplify (isAmongSimpl [
-           SimplInlinePhase 0,
+       CoreDoSimplify SimplGently [
+                       --      Simplify "gently"
                        -- Don't inline anything till full laziness has bitten
                        -- In particular, inlining wrappers inhibits floating
                        -- e.g. ...(case f x of ...)...
                        --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
                        --  ==> ...(case x of I# x# -> case fw x# of ...)...
                        -- and now the redex (f x) isn't floatable any more
-           DontApplyRules,
                        -- Similarly, don't apply any rules until after full 
                        -- laziness.  Notably, list fusion can prevent floating.
+
             NoCaseOfCase,
                        -- Don't do case-of-case transformations.
                        -- This makes full laziness work better
            MaxSimplifierIterations max_iter
-       ]),
+       ],
 
        -- Specialisation is best done before full laziness
        -- so that overloaded functions have all their dictionary lambdas manifest
@@ -223,33 +241,33 @@ buildCoreToDo = do
        CoreDoFloatOutwards False{-not full-},
        CoreDoFloatInwards,
 
-       CoreDoSimplify (isAmongSimpl [
-          SimplInlinePhase 1,
-               -- Want to run with inline phase 1 after the specialiser to give
+       CoreDoSimplify (SimplPhase 2) [
+               -- Want to run with inline phase 2 after the specialiser to give
                -- maximum chance for fusion to work before we inline build/augment
-               -- in phase 2.  This made a difference in 'ansi' where an 
+               -- in phase 1.  This made a difference in 'ansi' where an 
                -- overloaded function wasn't inlined till too late.
           MaxSimplifierIterations max_iter
-       ]),
+       ],
+       case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
 
        -- infer usage information here in case we need it later.
         -- (add more of these where you need them --KSW 1999-04)
         if usageSP then CoreDoUSPInf else CoreDoNothing,
 
-       CoreDoSimplify (isAmongSimpl [
+       CoreDoSimplify (SimplPhase 1) [
                -- Need inline-phase2 here so that build/augment get 
                -- inlined.  I found that spectral/hartel/genfft lost some useful
                -- strictness in the function sumcode' if augment is not inlined
                -- before strictness analysis runs
-          SimplInlinePhase 2,
           MaxSimplifierIterations max_iter
-       ]),
+       ],
+       case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
 
-       CoreDoSimplify (isAmongSimpl [
-          MaxSimplifierIterations 3
-               -- No -finline-phase: allow all Ids to be inlined now
+       CoreDoSimplify (SimplPhase 0) [
+               -- Phase 0: allow all Ids to be inlined now
                -- This gets foldr inlined before strictness analysis
-               --
+
+          MaxSimplifierIterations 3
                -- At least 3 iterations because otherwise we land up with
                -- huge dead expressions because of an infelicity in the 
                -- simpifier.   
@@ -257,17 +275,20 @@ buildCoreToDo = do
                -- ==>  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!
-       ]),
 
+       ],
+       case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
+
+#ifdef DEBUG
        if cpr        then CoreDoCPResult   else CoreDoNothing,
+#endif
        if strictness then CoreDoStrictness else CoreDoNothing,
        CoreDoWorkerWrapper,
        CoreDoGlomBinds,
 
-       CoreDoSimplify (isAmongSimpl [
+       CoreDoSimplify (SimplPhase 0) [
           MaxSimplifierIterations max_iter
-               -- No -finline-phase: allow all Ids to be inlined now
-       ]),
+       ],
 
        CoreDoFloatOutwards False{-not full-},
                -- nofib/spectral/hartel/wang doubles in speed if you
@@ -295,6 +316,8 @@ buildCoreToDo = do
 -- Case-liberation for -O2.  This should be after
 -- strictness analysis and the simplification which follows it.
 
+       case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
+
        if opt_level >= 2 then
           CoreLiberateCase
        else
@@ -305,10 +328,9 @@ buildCoreToDo = do
           CoreDoNothing,
 
        -- Final clean-up simplification:
-       CoreDoSimplify (isAmongSimpl [
+       CoreDoSimplify (SimplPhase 0) [
          MaxSimplifierIterations max_iter
-               -- No -finline-phase: allow all Ids to be inlined now
-       ])
+       ]
      ]
 
 buildStgToDo :: IO [ StgToDo ]
@@ -340,8 +362,11 @@ addToDirList :: IORef [String] -> String -> IO ()
 addToDirList ref path
   = do paths           <- readIORef ref
        shiny_new_ones  <- splitUp path
-       writeIORef ref (paths ++ shiny_new_ones)
-
+       writeIORef ref (paths ++ filter (not.null) shiny_new_ones)
+               -- empty paths are ignored: there might be a trailing
+               -- ':' in the initial list, for example.  Empty paths can
+               -- cause confusion when they are translated into -I options
+               -- for passing to gcc.
   where
     splitUp ::String -> IO [String]
 #ifdef mingw32_TARGET_OS
@@ -474,13 +499,18 @@ getPackageLibraries = do
      -- 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]