X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplMonad.lhs;h=afe7289001aced292a521066225d7adf0be89146;hb=8655d6ca41df4aa77a559d4067ad3815797b9803;hp=f538bf9b755895a3f5831439c3f07180c265d84c;hpb=b085ee40c7f265a5977ea6ec1c415e573be5ff8c;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
index f538bf9..afe7289 100644
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ b/ghc/compiler/simplCore/SimplMonad.lhs
@@ -77,15 +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(..) )
@@ -93,6 +93,8 @@ import PrelArr  ( Array(..) )
 import GHC.Arr  ( Array(..) )
 #endif
 
+import Array		( array, (//) )
+
 infixr 0  `thenSmpl`, `thenSmpl_`
 \end{code}
 
@@ -680,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
 
@@ -691,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.
@@ -889,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.
@@ -925,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}	
 
@@ -986,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)