From ab676aa34302b346cc05181100b46d8490023971 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 23 Aug 2007 15:20:27 +0000
Subject: [PATCH] Improve handling of inline pragmas, esp where type
 applications are involved

See the definition of splitInlineCont for what this is about.
Cures Trac #1627.
Test is simpl017
---
 compiler/simplCore/SimplUtils.lhs |   34 ++++++++++++++++++++++++++++------
 compiler/simplCore/Simplify.lhs   |    6 +++---
 2 files changed, 31 insertions(+), 9 deletions(-)

diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 1399870..a1a7c14 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -15,7 +15,7 @@ module SimplUtils (
 	-- The continuation type
 	SimplCont(..), DupFlag(..), LetRhsFlag(..), 
 	contIsDupable, contResultType, contIsTrivial, contArgs, dropArgs, 
-	countValArgs, countArgs,
+	countValArgs, countArgs, splitInlineCont,
 	mkBoringStop, mkLazyArgStop, mkRhsStop, contIsRhsOrArg,
 	interestingCallContext, interestingArgContext,
 
@@ -42,7 +42,8 @@ import Id
 import Var	( isCoVar )
 import NewDemand
 import SimplMonad
-import Type
+import Type	( Type, funArgTy, mkForAllTys, mkTyVarTys, 
+		  splitTyConApp_maybe, tyConAppArgs )
 import TyCon
 import DataCon
 import Unify	( dataConCannotMatch )
@@ -154,10 +155,11 @@ mkLazyArgStop ty has_rules = Stop ty AnArg (canUpdateInPlace ty || has_rules)
 mkRhsStop :: OutType -> SimplCont
 mkRhsStop ty = Stop ty AnRhs (canUpdateInPlace ty)
 
-contIsRhsOrArg (Stop {})       = True
-contIsRhsOrArg (StrictBind {}) = True
-contIsRhsOrArg (StrictArg {})  = True
-contIsRhsOrArg other	       = False
+-------------------
+contIsRhsOrArg (Stop {})       	 = True
+contIsRhsOrArg (StrictBind {}) 	 = True
+contIsRhsOrArg (StrictArg {})  	 = True
+contIsRhsOrArg other	         = False
 
 -------------------
 contIsDupable :: SimplCont -> Bool
@@ -204,6 +206,26 @@ dropArgs :: Int -> SimplCont -> SimplCont
 dropArgs 0 cont = cont
 dropArgs n (ApplyTo _ _ _ cont) = dropArgs (n-1) cont
 dropArgs n other		= pprPanic "dropArgs" (ppr n <+> ppr other)
+
+--------------------
+splitInlineCont :: SimplCont -> Maybe (SimplCont, SimplCont)
+-- Returns Nothing if the continuation should dissolve an InlineMe Note
+-- Return Just (c1,c2) otherwise, 
+--	where c1 is the continuation to put inside the InlineMe 
+--	and   c2 outside
+
+-- Example: (__inline_me__ (/\a. e)) ty
+--	Here we want to do the beta-redex without dissolving the InlineMe
+-- See test simpl017 (and Trac #1627) for a good example of why this is important
+
+splitInlineCont (ApplyTo dup (Type ty) se c)
+  | Just (c1, c2) <- splitInlineCont c 	        = Just (ApplyTo dup (Type ty) se c1, c2)
+splitInlineCont cont@(Stop ty _ _)       	= Just (mkBoringStop ty, cont)
+splitInlineCont cont@(StrictBind bndr _ _ se _) = Just (mkBoringStop (substTy se (idType bndr)), cont)
+splitInlineCont cont@(StrictArg _ fun_ty _ _)   = Just (mkBoringStop (funArgTy fun_ty), cont)
+splitInlineCont other				= Nothing
+	-- NB: the calculation of the type for mkBoringStop is an annoying
+	--     duplication of the same calucation in mkDupableCont
 \end{code}
 
 
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 5142632..5d40071 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -892,10 +892,10 @@ simplNote env (SCC cc) e cont
 
 -- See notes with SimplMonad.inlineMode
 simplNote env InlineMe e cont
-  | contIsRhsOrArg cont		-- Totally boring continuation; see notes above
+  | Just (inside, outside) <- splitInlineCont cont  -- Boring boring continuation; see notes above
   = do	{ 			-- Don't inline inside an INLINE expression
-	  e' <- simplExpr (setMode inlineMode env) e
-	; rebuild env (mkInlineMe e') cont }
+	  e' <- simplExprC (setMode inlineMode env) e inside
+	; rebuild env (mkInlineMe e') outside }
 
   | otherwise  	-- Dissolve the InlineMe note if there's
 		-- an interesting context of any kind to combine with
-- 
1.7.10.4