X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FTidyPgm.lhs;fp=compiler%2Fmain%2FTidyPgm.lhs;h=0245978491c1c1f58e4b35ef8886ff9846fef35f;hp=98ab1d9314937aeef42eedc54f8a8f92e495fe15;hb=bc115352a6211fa8814eb1b584fe5284bf57ca00;hpb=241b0013560b3ee5a54f35672417dac330b938e0

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 98ab1d9..0245978 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -709,10 +709,17 @@ addExternal expose_all id = (new_needed_ids, show_unfold)
     mb_unfold_ids :: Maybe (IdSet, [Id])	-- Nothing => don't unfold
     mb_unfold_ids = case unfoldingInfo idinfo of
 		      CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_guidance = guide } 
-			| show_unfolding src guide
-			-> Just (exprFvsInOrder unf_rhs)
+					  | show_unfolding src guide
+					  -> Just (unf_ext_ids src unf_rhs)
 		      DFunUnfolding _ ops -> Just (exprsFvsInOrder ops)
 		      _                   -> Nothing
+                  where
+                    unf_ext_ids (InlineWrapper v) _ = (unitVarSet v, [v])
+                    unf_ext_ids _           unf_rhs = exprFvsInOrder unf_rhs
+		    -- For a wrapper, externalise the wrapper id rather than the
+		    -- fvs of the rhs.  The two usually come down to the same thing
+		    -- but I've seen cases where we had a wrapper id $w but a
+		    -- rhs where $w had been inlined; see Trac #3922
 
     show_unfolding unf_source unf_guidance
        =  expose_all 	     -- 'expose_all' says to expose all