X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSubst.lhs;h=b02bc805784b21986e809d433c288cb757556f79;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hp=3224cc2763cd8ff322bd990d7296c07c94273d4a;hpb=d10fa3041959b3e05a4718ff9d1ab8201d1d591e;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index 3224cc2..b02bc80 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -13,7 +13,7 @@ module CoreSubst (
         -- ** Substituting into expressions and related types
 	deShadowBinds, substSpec, substRulesForImportedIds,
 	substTy, substExpr, substBind, substUnfolding,
-	substInlineRuleGuidance, lookupIdSubst, lookupTvSubst, substIdOcc,
+	substInlineRuleInfo, lookupIdSubst, lookupTvSubst, substIdOcc,
 
         -- ** Operations on substitutions
 	emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst, 
@@ -510,27 +510,25 @@ substUnfolding subst (DFunUnfolding con args)
 substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_guidance = guide@(InlineRule {}) })
 	-- Retain an InlineRule!
   = seqExpr new_tmpl `seq` 
-    new_mb_wkr `seq`
-    unf { uf_tmpl = new_tmpl, uf_guidance = guide { ug_ir_info = new_mb_wkr } }
+    new_info `seq`
+    unf { uf_tmpl = new_tmpl, uf_guidance = guide { ir_info = new_info } }
   where
-    new_tmpl   = substExpr subst tmpl
-    new_mb_wkr = substInlineRuleGuidance subst (ug_ir_info guide)
+    new_tmpl = substExpr subst tmpl
+    new_info = substInlineRuleInfo subst (ir_info guide)
 
 substUnfolding _ (CoreUnfolding {}) = NoUnfolding	-- Discard
 	-- Always zap a CoreUnfolding, to save substitution work
 
-substUnfolding _ unf = unf	-- Otherwise no substitution to do
+substUnfolding _ unf = unf	-- NoUnfolding, OtherCon
 
 -------------------
-substInlineRuleGuidance :: Subst -> InlineRuleInfo -> InlineRuleInfo
-substInlineRuleGuidance subst (InlWrapper wkr)
-  = case lookupIdSubst subst wkr of
-      Var w1 -> InlWrapper w1
-      other  -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr wkr )
-      	        InlUnSat   -- Worker has got substituted away altogether
-			   -- (This can happen if it's trivial, via
-			   --  postInlineUnconditionally, hence only warning)
-substInlineRuleGuidance _ info = info
+substInlineRuleInfo :: Subst -> InlineRuleInfo -> InlineRuleInfo
+substInlineRuleInfo (Subst in_scope ids _) (InlWrapper wkr)
+  | Just (Var w1) <- lookupVarEnv  ids      wkr = InlWrapper w1
+  | Just w1       <- lookupInScope in_scope wkr = InlWrapper w1
+  | otherwise = WARN( True, text "Interesting! CoreSubst.substWorker:" <+> ppr wkr )
+      	        InlVanilla -- Note [Worker inlining]
+substInlineRuleInfo _ info = info
 
 ------------------
 substIdOcc :: Subst -> Id -> Id
@@ -584,6 +582,18 @@ substVarSet subst fvs
 	| otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
 \end{code}
 
+Note [Worker inlining]
+~~~~~~~~~~~~~~~~~~~~~~
+A worker can get sustituted away entirely.
+	- it might be trivial
+	- it might simply be very small
+We do not treat an InlWrapper as an 'occurrence' in the occurence 
+analyser, so it's possible that the worker is not even in scope any more.
+
+In all all these cases we simply drop the special case, returning to
+InlVanilla.  The WARN is just so I can see if it happens a lot.
+
+
 %************************************************************************
 %*									*
 	The Very Simple Optimiser