[project @ 2004-08-16 06:44:47 by panne]

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

diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
index 266d9ec..aec3c1b 100644 (file)
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ b/ghc/compiler/simplCore/SimplMonad.lhs
@@ -37,7 +37,7 @@ module SimplMonad (
        -- Environments
        SimplEnv, emptySimplEnv, getSubst, setSubst,
        getSubstEnv, extendSubst, extendSubstList,
-       getInScope, setInScope, modifyInScope, addNewInScopeIds,
+       getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
        setSubstEnv, zapSubstEnv,
 
        -- Floats
@@ -62,7 +62,7 @@ import VarEnv
 import VarSet
 import OrdList
 import qualified Subst
-import Subst           ( Subst, mkSubst, substEnv, 
+import Subst           ( Subst, emptySubst, substEnv, 
                          InScopeSet, mkInScopeSet, substInScope,
                          isInScope 
                        )
@@ -77,14 +77,15 @@ import BasicTypes   ( TopLevelFlag, isTopLevel, isLoopBreaker,
                        )
 import CmdLineOpts     ( SimplifierSwitch(..), SimplifierMode(..),
                          DynFlags, DynFlag(..), dopt, 
-                         opt_PprStyle_Debug, opt_HistorySize, opt_SimplNoPreInlining,
+                         opt_PprStyle_Debug, opt_HistorySize, opt_SimplNoPreInlining, opt_RulesOff
                        )
 import Unique          ( Unique )
-import Maybes          ( expectJust )
 import Outputable
-import Array           ( array, (//) )
 import FastTypes
-import GlaExts         ( indexArray# )
+import FastString
+import Maybes          ( expectJust )
+
+import GLAEXTS         ( indexArray# )
 
 #if __GLASGOW_HASKELL__ < 503
 import PrelArr  ( Array(..) )
@@ -92,6 +93,8 @@ import PrelArr  ( Array(..) )
 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
@@ -594,10 +597,10 @@ data SimplEnv
        -- have a correctly-substituted type.  So we use a lookup in this
        -- set to replace occurrences
 
-emptySimplEnv :: SimplifierMode -> [SimplifierSwitch] -> VarSet -> SimplEnv
-emptySimplEnv mode switches in_scope
-  = SimplEnv { seChkr = isAmongSimpl switches, seCC = subsumedCCS, seMode = mode,
-              seSubst = mkSubst (mkInScopeSet in_scope) emptySubstEnv }
+emptySimplEnv :: SimplifierMode -> [SimplifierSwitch] -> SimplEnv
+emptySimplEnv mode switches
+  = SimplEnv { seChkr = isAmongSimpl switches, seCC = subsumedCCS, 
+              seMode = mode, seSubst = emptySubst }
        -- The top level "enclosing CC" is "SUBSUMED".
 
 ---------------------
@@ -679,6 +682,8 @@ settings:
        SimplGently     (a) Simplifying before specialiser/full laziness
                        (b) Simplifiying inside INLINE pragma
                        (c) Simplifying the LHS of a rule
+                       (d) Simplifying a GHCi expression or Template 
+                               Haskell splice
 
        SimplPhase n    Used at all other times
 
@@ -690,6 +695,12 @@ because doing so inhibits floating
     ==> ...(case x of I# x# -> case fw x# of ...)...
 and now the redex (f x) isn't floatable any more.
 
+The no-inling thing is also important for Template Haskell.  You might be 
+compiling in one-shot mode with -O2; but when TH compiles a splice before
+running it, we don't want to use -O2.  Indeed, we don't want to inline
+anything, because the byte-code interpreter might get confused about 
+unboxed tuples and suchlike.
+
 INLINE pragmas
 ~~~~~~~~~~~~~~
 SimplGently is also used as the mode to simplify inside an InlineMe note.
@@ -888,22 +899,13 @@ postInlineUnconditionally env bndr occ_info rhs
                   SimplGently  -> isAlwaysActive prag
                   SimplPhase n -> isActive n prag
     prag = idInlinePragma bndr
-\end{code}
 
-blackListInline tells if we must not inline at a call site because the
-Id's inline pragma says not to do so.
-
-However, blackListInline is ignored for things with with Compulsory inlinings,
-because they don't have bindings, so we must inline them no matter how
-gentle we are being.
-
-\begin{code}
 activeInline :: SimplEnv -> OutId -> OccInfo -> Bool
 activeInline env id occ
   = case getMode env of
-      SimplGently -> isAlwaysActive prag && isOneOcc occ 
+      SimplGently -> isOneOcc occ && isAlwaysActive prag
        -- No inlining at all when doing gentle stuff,
-       -- except for things that occur once
+       -- except for local things that occur once
        -- The reason is that too little clean-up happens if you 
        -- don't inline use-once things.   Also a bit of inlining is *good* for
        -- full laziness; it can expose constant sub-expressions.
@@ -924,8 +926,15 @@ activeInline env id occ
 activeRule :: SimplEnv -> Maybe (Activation -> Bool)
 -- Nothing => No rules at all
 activeRule env
+  | opt_RulesOff = Nothing
+  | otherwise
   = case getMode env of
-       SimplGently  -> Nothing         -- No rules in gentle mode
+       SimplGently  -> Just isAlwaysActive
+                       -- Used to be Nothing (no rules in gentle mode)
+                       -- Main motivation for changing is that I wanted
+                       --      lift String ===> ...
+                       -- to work in Template Haskell when simplifying
+                       -- splices, so we get simpler code for literal strings
        SimplPhase n -> Just (isActive n)
 \end{code}     
 
@@ -964,7 +973,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
@@ -985,20 +994,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)