[project @ 2002-10-25 09:40:47 by simonmar]

[ghc-hetmet.git] / ghc / compiler / simplCore / SimplMonad.lhs

diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
index 800334c..fe43c6d 100644 (file)
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ b/ghc/compiler/simplCore/SimplMonad.lhs
@@ -71,7 +71,7 @@ import UniqSupply     ( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
                          UniqSupply
                        )
 import FiniteMap
-import BasicTypes      ( TopLevelFlag, isTopLevel, 
+import BasicTypes      ( TopLevelFlag, isTopLevel, isLoopBreaker,
                          Activation, isActive, isAlwaysActive,
                          OccInfo(..), isOneOcc
                        )
@@ -80,18 +80,21 @@ import CmdLineOpts  ( SimplifierSwitch(..), SimplifierMode(..),
                          opt_PprStyle_Debug, opt_HistorySize, opt_SimplNoPreInlining,
                        )
 import Unique          ( Unique )
-import Maybes          ( expectJust )
 import Outputable
-import Array           ( array, (//) )
 import FastTypes
-import GlaExts         ( indexArray# )
+import FastString
+import Maybes          ( expectJust )
 
-#if __GLASGOW_HASKELL__ < 301
-import ArrBase ( Array(..) )
-#else
+import GLAEXTS         ( indexArray# )
+
+#if __GLASGOW_HASKELL__ < 503
 import PrelArr  ( Array(..) )
+#else
+import GHC.Arr  ( Array(..) )
 #endif
 
+import Array           ( array, (//) )
+
 infixr 0  `thenSmpl`, `thenSmpl_`
 \end{code}
 
@@ -446,7 +449,7 @@ data Tick
   | PostInlineUnconditionally  Id
 
   | UnfoldingDone              Id
-  | RuleFired                  FAST_STRING     -- Rule name
+  | RuleFired                  FastString      -- Rule name
 
   | LetFloatFromLet
   | EtaExpansion               Id      -- LHS binder
@@ -862,16 +865,27 @@ story for now.
 \begin{code}
 postInlineUnconditionally :: SimplEnv -> OutId -> OccInfo -> OutExpr -> Bool
 postInlineUnconditionally env bndr occ_info rhs 
-  =  exprIsTrivial rhs && active && isOneOcc occ_info
-       -- We used to have (not loop_breaker && not (isExportedId bndr))
-       -- instead of (isOneOcc occ_info).  Indeed, you might suppose that
+  =  exprIsTrivial rhs
+  && active
+  && not (isLoopBreaker occ_info)
+  && not (isExportedId bndr)
+       -- We used to have (isOneOcc occ_info) instead of
+       -- not (isLoopBreaker occ_info) && not (isExportedId bndr)
+       -- That was because a rather fragile use of rules got confused
+       -- if you inlined even a binding f=g  e.g. We used to have
+       --      map = mapList
+       -- But now a more precise use of phases has eliminated this problem,
+       -- so the is_active test will do the job.  I think.
+       --
+       -- OLD COMMENT: (delete soon)
+       -- Indeed, you might suppose that
        -- there is nothing wrong with substituting for a trivial RHS, even
        -- if it occurs many times.  But consider
        --      x = y
        --      h = _inline_me_ (...x...)
        -- Here we do *not* want to have x inlined, even though the RHS is
        -- trivial, becuase the contract for an INLINE pragma is "no inlining".
-       -- This is important in the rules for the Prelude (e.g. PrelEnum.eftInt).
+       -- This is important in the rules for the Prelude 
   where
     active = case getMode env of
                   SimplGently  -> isAlwaysActive prag
@@ -953,7 +967,7 @@ type SwitchChecker = SimplifierSwitch -> SwitchResult
 
 data SwitchResult
   = SwBool     Bool            -- on/off
-  | SwString   FAST_STRING     -- nothing or a String
+  | SwString   FastString      -- nothing or a String
   | SwInt      Int             -- nothing or an Int
 
 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
@@ -974,20 +988,10 @@ isAmongSimpl on_switches          -- Switches mentioned later occur *earlier*
        defined_elems = map mk_assoc_elem tidied_on_switches
     in
     -- (avoid some unboxing, bounds checking, and other horrible things:)
-#if __GLASGOW_HASKELL__ < 405
-    case sw_tbl of { Array bounds_who_needs_'em stuff ->
-#else
     case sw_tbl of { Array _ _ stuff ->
-#endif
     \ switch ->
        case (indexArray# stuff (tagOf_SimplSwitch switch)) of
-#if __GLASGOW_HASKELL__ < 400
-         Lift v -> v
-#elif __GLASGOW_HASKELL__ < 403
-         (# _, v #) -> v
-#else
          (# v #) -> v
-#endif
     }
   where
     mk_assoc_elem k@(MaxSimplifierIterations lvl)