diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 31ca5b67e2f8af9e9fbaf1b0da2b3e8d5393df69..85c5640a0e9e3adf33490a0a485e48ed95e9bab1 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -45,7 +45,7 @@ module IdInfo (
 
 
 import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding )
-import {-# SOURCE #-} CoreSyn	 ( SimplifiableCoreExpr )
+import {-# SOURCE #-} CoreSyn	 ( CoreExpr )
 
 -- for mkdependHS, CoreSyn.hi-boot refers to it:
 import BinderInfo ( BinderInfo )
@@ -198,7 +198,7 @@ ppDemandInfo (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""),
 A @IdSpecEnv@ holds details of an @Id@'s specialisations. 
 
 \begin{code}
-type IdSpecEnv = SpecEnv SimplifiableCoreExpr
+type IdSpecEnv = SpecEnv CoreExpr
 \end{code}
 
 For example, if \tr{f}'s @SpecEnv@ contains the mapping:
diff --git a/ghc/compiler/coreSyn/CoreSyn.hi-boot b/ghc/compiler/coreSyn/CoreSyn.hi-boot
index 7d543d8a8cc58a11f3ac5347cc020625ad8bd628..c49a4c424bf38833f24ee34a091fee6bcbf7fe32 100644
--- a/ghc/compiler/coreSyn/CoreSyn.hi-boot
+++ b/ghc/compiler/coreSyn/CoreSyn.hi-boot
@@ -1,9 +1,9 @@
 _interface_ CoreSyn 1
 _exports_
-CoreSyn SimplifiableCoreExpr ;
+CoreSyn CoreExpr ;
 _declarations_
 
 -- Needed by IdInfo
-1 type SimplifiableCoreExpr = GenCoreExpr (Id!Id, BinderInfo.BinderInfo) Id!Id BasicTypes.Unused ;
+1 type CoreExpr = GenCoreExpr Id!Id Id!Id BasicTypes.Unused ;
 1 data GenCoreExpr a b c ;
 
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index eea46d10dc3a468a36f995e2bffcf683ea0a604f..8a1cb925083e19ba318276092f33365b69b4622d 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -313,11 +313,15 @@ sizeExpr (I# bOMB_OUT_SIZE) args expr
       = nukeScrutDiscount (size_up rhs)
 		`addSize`
 	size_up body
+		`addSizeN`
+	1	-- For the allocation
 
     size_up (Let (Rec pairs) body)
       = nukeScrutDiscount (foldr addSize sizeZero [size_up rhs | (_,rhs) <- pairs])
 		`addSize`
 	size_up body
+		`addSizeN`
+	length pairs	-- For the allocation
 
     size_up (Case scrut alts)
       = nukeScrutDiscount (size_up scrut)
@@ -451,19 +455,21 @@ is more accurate (see @sizeExpr@ above for how this discount size
 is computed).
 
 \begin{code}
-smallEnoughToInline :: [Bool]			-- Evaluated-ness of value arguments
+smallEnoughToInline :: Id			-- The function (for trace msg only)
+		    -> [Bool]			-- Evaluated-ness of value arguments
 		    -> Bool			-- Result is scrutinised
 		    -> UnfoldingGuidance
 		    -> Bool			-- True => unfold it
 
-smallEnoughToInline _ _ UnfoldAlways = True
-smallEnoughToInline _ _ UnfoldNever  = False
-smallEnoughToInline arg_is_evald_s result_is_scruted
+smallEnoughToInline _ _ _ UnfoldAlways = True
+smallEnoughToInline _ _ _ UnfoldNever  = False
+smallEnoughToInline id arg_is_evald_s result_is_scruted
 	      (UnfoldIfGoodArgs m_tys_wanted n_vals_wanted discount_vec size scrut_discount)
   = if enough_args n_vals_wanted arg_is_evald_s &&
        size - discount <= opt_UnfoldingUseThreshold
     then
-       pprTrace "small enough" (int size <+> int discount) True
+       -- pprTrace "small enough" (ppr id <+> int size <+> int discount) 
+       True
     else
        False
   where
@@ -486,8 +492,8 @@ smallEnoughToInline arg_is_evald_s result_is_scruted
 		    | otherwise		= 0
 
     arg_discount no_of_constrs is_evald
-      | is_evald  = 1 + no_of_constrs * opt_UnfoldingConDiscount
-      | otherwise = 1
+      | is_evald  = no_of_constrs * opt_UnfoldingConDiscount
+      | otherwise = 0
 \end{code}
 
 We use this one to avoid exporting inlinings that we ``couldn't possibly
@@ -495,12 +501,11 @@ use'' on the other side.  Can be overridden w/ flaggery.
 Just the same as smallEnoughToInline, except that it has no actual arguments.
 
 \begin{code}
---UNUSED?
-couldBeSmallEnoughToInline :: UnfoldingGuidance -> Bool
-couldBeSmallEnoughToInline guidance = smallEnoughToInline (repeat True) True guidance
+couldBeSmallEnoughToInline :: Id -> UnfoldingGuidance -> Bool
+couldBeSmallEnoughToInline id guidance = smallEnoughToInline id (repeat True) True guidance
 
-certainlySmallEnoughToInline :: UnfoldingGuidance -> Bool
-certainlySmallEnoughToInline guidance = smallEnoughToInline (repeat False) False guidance
+certainlySmallEnoughToInline :: Id -> UnfoldingGuidance -> Bool
+certainlySmallEnoughToInline id guidance = smallEnoughToInline id (repeat False) False guidance
 \end{code}
 
 Predicates
diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 9eeadaf96a37e40dae36ea4d8f2010ba926757c2..ca2f4e602f98932789aa1b9b2deb4c3ea99196a8 100644
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -10,7 +10,8 @@
 \begin{code}
 module PprCore (
 	pprCoreExpr, pprIfaceUnfolding, 
-	pprCoreBinding, pprCoreBindings
+	pprCoreBinding, pprCoreBindings,
+	pprGenericBindings
     ) where
 
 #include "HsVersions.h"
@@ -50,14 +51,70 @@ print something.
 
 @pprParendCoreExpr@ puts parens around non-atomic Core expressions.
 
+Un-annotated core dumps
+~~~~~~~~~~~~~~~~~~~~~~~
 \begin{code}
-pprCoreBinding  :: CoreBinding   -> SDoc
 pprCoreBindings :: [CoreBinding] -> SDoc
+pprCoreBinding  :: CoreBinding   -> SDoc
+pprCoreExpr     :: CoreExpr	 -> SDoc
+
+pprCoreBindings = pprTopBinds pprCoreEnv
+pprCoreBinding  = pprTopBind pprCoreEnv
+pprCoreExpr     = ppr_expr pprCoreEnv
+
+pprCoreEnv = init_ppr_env ppr pprCoreBinder ppr
+\end{code}
+
+Printer for unfoldings in interfaces
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+\begin{code}
+pprIfaceUnfolding :: CoreExpr -> SDoc
+pprIfaceUnfolding = ppr_expr pprIfaceEnv
+
+pprIfaceEnv = init_ppr_env pprTyVarBndr pprIfaceBinder  ppr
+\end{code}
+
+Generic Core (possibly annotated binders etc)
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+\begin{code}
+pprGenericBindings :: (Outputable bndr, Outputable occ) => [GenCoreBinding bndr occ flexi] -> SDoc
+pprGenericBindings = pprTopBinds pprGenericEnv
+
+pprGenericEnv :: (Outputable bndr, Outputable occ) => PprEnv flexi bndr occ
+pprGenericEnv = init_ppr_env ppr (\_ -> ppr) ppr
+
+pprGenericArgEnv :: (Outputable occ) => PprEnv flexi bndr occ
+pprGenericArgEnv = init_ppr_env ppr (error "ppr_bndr") ppr
+
+instance (Outputable bndr, Outputable occ) => Outputable (GenCoreBinding bndr occ flexi) where
+    ppr bind = ppr_bind pprGenericEnv bind
+
+instance (Outputable bndr, Outputable occ) => Outputable (GenCoreExpr bndr occ flexi) where
+    ppr expr = ppr_expr pprGenericEnv expr
+
+instance (Outputable occ) => Outputable (GenCoreArg occ flexi) where
+    ppr arg = ppr_arg pprGenericArgEnv arg
+
+instance (Outputable bndr, Outputable occ) => Outputable (GenCoreCaseAlts bndr occ flexi) where
+    ppr alts = ppr_alts pprGenericEnv alts
+
+instance (Outputable bndr, Outputable occ) => Outputable (GenCoreCaseDefault bndr occ flexi) where
+    ppr deflt  = ppr_default pprGenericEnv deflt
+\end{code}
 
+
+%************************************************************************
+%*									*
+\subsection{Instance declarations for Core printing}
+%*									*
+%************************************************************************
+
+
+\begin{code}
 init_ppr_env tvbndr pbdr pocc
   = initPprEnv
 	(Just ppr) -- literals
-	(Just ppr_con)		-- data cons
+	(Just ppr)		-- data cons
 	(Just ppr_prim)		-- primops
 	(Just (\ cc -> text (showCostCentre True cc)))
 
@@ -68,20 +125,6 @@ init_ppr_env tvbndr pbdr pocc
 	(Just pbdr) (Just pocc) -- value vars
   where
 
-    ppr_con con = ppr con
-
-{-	[We now use Con {a,b,c} for Con expressions. SLPJ March 97.]
-	[We can't treat them as ordinary applications because the Con doesn't have
-	 dictionaries in it, whereas the constructor Id does.]
-
-	OLD VERSION: 
-	-- ppr_con is used when printing Con expressions; we add a "!" 
-	-- to distinguish them from ordinary applications.  But not when
-	-- printing for interfaces, where they are treated as ordinary applications
-    ppr_con con | ifaceStyle sty = ppr sty con
-	        | otherwise	 = ppr sty con <> char '!'
--}
-
 	-- We add a "!" to distinguish Primitive applications from ordinary applications.  
 	-- But not when printing for interfaces, where they are treated 
 	-- as ordinary applications
@@ -90,74 +133,27 @@ init_ppr_env tvbndr pbdr pocc
 					 else
 					    ppr prim <> char '!')
 
---------------
-pprCoreBindings binds = vcat (map pprCoreBinding binds)
-
-pprCoreBinding (NonRec binder expr) = ppr_binding (binder, expr)
-
-pprCoreBinding (Rec binds)
-  = vcat [ptext SLIT("Rec {"),
-	  vcat (map ppr_binding binds),
-	  ptext SLIT("end Rec }")]
-
-ppr_binding (binder, expr)
- = sep [pprCoreBinder LetBind binder, 
-        nest 2 (equals <+> pprCoreExpr expr)]
-\end{code}
-
-General expression printer
-
-\begin{code}
-pprCoreExpr :: CoreExpr	-> SDoc
-pprCoreExpr = ppr_expr pprCoreEnv
-
-pprCoreEnv = init_ppr_env ppr pprCoreBinder ppr
-\end{code}
-
-Printer for unfoldings in interfaces
-
-\begin{code}
-pprIfaceUnfolding :: CoreExpr -> SDoc
-pprIfaceUnfolding = ppr_expr pprIfaceEnv
-
-pprIfaceEnv = init_ppr_env pprTyVarBndr pprIfaceBinder  ppr
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection{Instance declarations for Core printing}
+\subsection{The guts}
 %*									*
 %************************************************************************
 
 \begin{code}
-pprGenEnv :: (Outputable bndr, Outputable occ) => PprEnv flexi bndr occ
-pprGenEnv = init_ppr_env ppr (\_ -> ppr) ppr
-
-pprGenArgEnv :: (Outputable occ) => PprEnv flexi bndr occ
-pprGenArgEnv = init_ppr_env ppr (error "ppr_bndr") ppr
+pprTopBinds pe binds = vcat (map (pprTopBind pe) binds)
 
-instance (Outputable bndr, Outputable occ) => Outputable (GenCoreBinding bndr occ flexi) where
-    ppr bind = ppr_bind pprGenEnv bind
-
-instance (Outputable bndr, Outputable occ) => Outputable (GenCoreExpr bndr occ flexi) where
-    ppr expr = ppr_expr pprGenEnv expr
-
-instance (Outputable occ) => Outputable (GenCoreArg occ flexi) where
-    ppr arg = ppr_arg pprGenArgEnv arg
+pprTopBind pe (NonRec binder expr)
+ = sep [ppr_binding_pe pe (binder,expr)] $$ text ""
 
-instance (Outputable bndr, Outputable occ) => Outputable (GenCoreCaseAlts bndr occ flexi) where
-    ppr alts = ppr_alts pprGenEnv alts
-
-instance (Outputable bndr, Outputable occ) => Outputable (GenCoreCaseDefault bndr occ flexi) where
-    ppr deflt  = ppr_default pprGenEnv deflt
+pprTopBind pe (Rec binds)
+  = vcat [ptext SLIT("Rec {"),
+	  vcat (map (ppr_binding_pe pe) binds),
+	  ptext SLIT("end Rec }"),
+	  text ""]
 \end{code}
 
-%************************************************************************
-%*									*
-\subsection{Workhorse routines (...????...)}
-%*									*
-%************************************************************************
-
 \begin{code}
 ppr_bind pe (NonRec val_bdr expr) = ppr_binding_pe pe (val_bdr, expr)
 ppr_bind pe (Rec binds)  	  = vcat (map pp binds)
diff --git a/ghc/compiler/simplCore/BinderInfo.lhs b/ghc/compiler/simplCore/BinderInfo.lhs
index 6737103e7a984a788ecff3351f26bfef9065ea9b..8a4b92224460d1a1102caaa775703408d5e57ce9 100644
--- a/ghc/compiler/simplCore/BinderInfo.lhs
+++ b/ghc/compiler/simplCore/BinderInfo.lhs
@@ -145,7 +145,7 @@ okToInline False small_enough (OneOcc _ NoDupDanger _ n_alts _)
 -- If the thing isn't a redex, there's no danger of duplicating work, 
 -- so we can inline if it occurs once, or is small
 okToInline True small_enough occ_info 
- = small_enough || one_occ
+ = one_occ || small_enough
  where
    one_occ = case occ_info of
 		OneOcc _ _ _ n_alts _ -> n_alts <= 1
diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index f5e22068e2aea7595a8c38b3cfe5511394a16783..2d37a9de35a6016a8ac3e3d8269ce1d4ce58717d 100644
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -22,13 +22,15 @@ import CmdLineOpts	( opt_D_dump_occur_anal, SimplifierSwitch(..) )
 import CoreSyn
 import Digraph		( stronglyConnCompR, SCC(..) )
 import Id		( idWantsToBeINLINEd, addNoInlinePragma, nukeNoInlinePragma,
+			  omitIfaceSigForId,
 			  idType, idUnique, Id,
 			  emptyIdSet, unionIdSets, mkIdSet,
 			  elementOfIdSet,
 			  addOneToIdSet, IdSet,
-			  nullIdEnv, unitIdEnv, combineIdEnvs,
+
+			  IdEnv, nullIdEnv, unitIdEnv, combineIdEnvs,
 			  delOneFromIdEnv, delManyFromIdEnv, isNullIdEnv, 
-			  mapIdEnv, lookupIdEnv, IdEnv 
+			  mapIdEnv, lookupIdEnv, elemIdEnv, addOneToIdEnv
 			)
 import Specialise       ( idSpecVars )
 import Name		( isExported, isLocallyDefined )
@@ -42,116 +44,6 @@ import Outputable
 \end{code}
 
 
-%************************************************************************
-%*									*
-\subsection[OccurAnal-types]{Data types}
-%*									*
-%************************************************************************
-
-\begin{code}
-data OccEnv =
-  OccEnv
-    Bool	-- IgnoreINLINEPragma flag
-		-- False <=> OK to use INLINEPragma information
-		-- True  <=> ignore INLINEPragma information
-
-    (Id -> IdSet -> Bool)	-- Tells whether an Id occurrence is interesting,
-				-- given the set of in-scope variables
-
-    IdSet	-- In-scope Ids
-
-
-addNewCands :: OccEnv -> [Id] -> OccEnv
-addNewCands (OccEnv ip ifun cands) ids
-  = OccEnv ip ifun (cands `unionIdSets` mkIdSet ids)
-
-addNewCand :: OccEnv -> Id -> OccEnv
-addNewCand (OccEnv ip ifun cands) id
-  = OccEnv ip ifun (addOneToIdSet cands id)
-
-isCandidate :: OccEnv -> Id -> Bool
-isCandidate (OccEnv _ ifun cands) id = ifun id cands
-
-inlineMe :: OccEnv -> Id -> Bool
-inlineMe env id
-  = {-	See comments with simplIdWantsToBeINLINEd in SimplUtils.lhs 
-	not ignore_inline_prag && 
-    -}
-    idWantsToBeINLINEd id
-
-
-type UsageDetails = IdEnv BinderInfo	-- A finite map from ids to their usage
-
-combineUsageDetails, combineAltsUsageDetails
-	:: UsageDetails -> UsageDetails -> UsageDetails
-
-combineUsageDetails usage1 usage2
-  = combineIdEnvs addBinderInfo usage1 usage2
-
-combineAltsUsageDetails usage1 usage2
-  = combineIdEnvs orBinderInfo usage1 usage2
-
-addOneOcc :: UsageDetails -> Id -> BinderInfo -> UsageDetails
-addOneOcc usage id info
-  = combineIdEnvs addBinderInfo usage (unitIdEnv id info)
-	-- ToDo: make this more efficient
-
-emptyDetails = (nullIdEnv :: UsageDetails)
-
-unitDetails id info = (unitIdEnv id info :: UsageDetails)
-
-tagBinders :: UsageDetails	    -- Of scope
-	   -> [Id]		    -- Binders
-	   -> (UsageDetails, 	    -- Details with binders removed
-	      [(Id,BinderInfo)])    -- Tagged binders
-
-tagBinders usage binders =
- let
-  usage' = usage `delManyFromIdEnv` binders
-  uss    = [ (binder, usage_of usage binder) | binder <- binders ]
- in
- if isNullIdEnv usage' then
-    (usage', uss)
- else
-    (usage', uss)
-{-
-  = (usage `delManyFromIdEnv` binders,
-     [ (binder, usage_of usage binder) | binder <- binders ]
-    )
--}
-tagBinder :: UsageDetails	    -- Of scope
-	  -> Id			    -- Binders
-	  -> (UsageDetails, 	    -- Details with binders removed
-	      (Id,BinderInfo))	    -- Tagged binders
-
-tagBinder usage binder =
- let
-   usage'  = usage `delOneFromIdEnv` binder
-   us      = usage_of usage binder 
-   cont =
-    if isNullIdEnv usage' then  -- Bogus test to force evaluation.
-       (usage', (binder, us))
-    else
-       (usage', (binder, us))
- in
- if isDeadOcc us then		-- Ditto 
-	cont
- else 
-	cont
-
-
-usage_of usage binder
-  | isExported binder
-  = noBinderInfo	-- Visible-elsewhere things count as many
-  | otherwise
-  = case (lookupIdEnv usage binder) of
-      Nothing   -> deadOccurrence
-      Just info -> info
-
-isNeeded env usage binder = not (isDeadOcc (usage_of usage binder))
-\end{code}
-
-
 %************************************************************************
 %*									*
 \subsection[OccurAnal-main]{Counting occurrences: main function}
@@ -168,38 +60,18 @@ occurAnalyseBinds
 
 occurAnalyseBinds binds simplifier_sw_chkr
   | opt_D_dump_occur_anal = pprTrace "OccurAnal:"
-				     (vcat (map ppr_bind binds'))
+				     (pprGenericBindings binds')
 				     binds'
   | otherwise		  = binds'
   where
-    (_, binds') = doo initial_env binds
+    (_, _, binds') = occAnalTop initial_env binds
 
     initial_env = OccEnv (simplifier_sw_chkr IgnoreINLINEPragma)
 			 (\id in_scope -> isLocallyDefined id)	-- Anything local is interesting
 			 emptyIdSet				-- Not actually used
-
-    doo env [] = (emptyDetails, [])
-    doo env (bind:binds)
-      = (final_usage, new_binds ++ the_rest)
-      where
-	new_env			 = env `addNewCands` (bindersOf bind)
-	(binds_usage, the_rest)  = doo new_env binds
-	(final_usage, new_binds) = occAnalBind env bind binds_usage
-
-	-- This really ought to be done properly by PprCore, but
-	-- it isn't.  pprCoreBinding only works on Id binders, and
-	-- the general case is complicated by the fact that it has to work
-	-- for interface files too.  Sigh
-
-ppr_bind bind@(NonRec binder expr)
-  = ppr bind
-
-ppr_bind bind@(Rec binds)
-  = vcat [ptext SLIT("Rec {"),
-	      nest 2 (ppr bind),
-	      ptext SLIT("end Rec }")]
 \end{code}
 
+
 \begin{code}
 occurAnalyseExpr :: (Id -> Bool)	-- Tells if a variable is interesting
 		 -> CoreExpr
@@ -220,6 +92,134 @@ occurAnalyseGlobalExpr expr
     snd (occurAnalyseExpr (\_ -> False) expr)
 \end{code}
 
+
+%************************************************************************
+%*									*
+\subsection{Top level stuff}
+%*									*
+%************************************************************************
+
+In @occAnalTop@ we do indirection-shorting.  That is, if we have this:
+
+	loc = <expression>
+	...
+	exp = loc
+
+where exp is exported, and loc is not, then we replace it with this:
+
+	loc = exp
+	exp = <expression>
+	...
+
+Without this we never get rid of the exp = loc thing.
+This save a gratuitous jump
+(from \tr{x_exported} to \tr{x_local}), and makes strictness
+information propagate better.
+This used to happen in the final phase, but its tidier to do it here.
+
+
+If more than one exported thing is equal to a local thing (i.e., the
+local thing really is shared), then we do one only:
+\begin{verbatim}
+	x_local = ....
+	x_exported1 = x_local
+	x_exported2 = x_local
+==>
+	x_exported1 = ....
+
+	x_exported2 = x_exported1
+\end{verbatim}
+
+We rely on prior eta reduction to simplify things like
+\begin{verbatim}
+	x_exported = /\ tyvars -> x_local tyvars
+==>
+	x_exported = x_local
+\end{verbatim}
+Hence,there's a possibility of leaving unchanged something like this:
+\begin{verbatim}
+	x_local = ....
+	x_exported1 = x_local Int
+\end{verbatim}
+By the time we've thrown away the types in STG land this 
+could be eliminated.  But I don't think it's very common
+and it's dangerous to do this fiddling in STG land 
+because we might elminate a binding that's mentioned in the
+unfolding for something.
+
+
+\begin{code}
+occAnalTop :: OccEnv 			-- What's in scope
+	   -> [CoreBinding]
+	   -> (IdEnv BinderInfo, 	-- Occurrence info
+	       IdEnv Id,		-- Indirection elimination info
+	       [SimplifiableCoreBinding]
+	      )
+
+occAnalTop env [] = (emptyDetails, nullIdEnv, [])
+
+-- Special case for eliminating indirections
+occAnalTop env (NonRec exported_id (Var local_id) : binds)
+  | isExported exported_id &&		-- Only if this is exported
+
+    isLocallyDefined local_id &&	-- Only if this one is defined in this
+					-- 	module, so that we *can* change its
+				  	-- 	binding to be the exported thing!
+
+    not (isExported local_id) &&	-- Only if this one is not itself exported,
+					--	since the transformation will nuke it
+
+    not (omitIfaceSigForId local_id) &&	-- Don't do the transformation if rhs_id is
+					-- 	something like a constructor, whose 
+					--	definition is implicitly exported and 
+					-- 	which must not vanish.
+		-- To illustrate the preceding check consider
+		--	data T = MkT Int
+		--	mkT = MkT
+		--	f x = MkT (x+1)
+		-- Here, we'll make a local, non-exported, defn for MkT, and without the
+		-- above condition we'll transform it to:
+		--	mkT = \x. MkT [x]
+		--	f = \y. mkT (y+1)
+		-- This is bad because mkT will get the IdDetails of MkT, and won't
+		-- be exported.  Also the code generator won't make a definition for
+		-- the MkT constructor.
+		-- Slightly gruesome, this.
+
+
+    not (maybeToBool (lookupIdEnv ind_env local_id))
+					-- Only if not already substituted for
+    
+  = 	-- Aha!  An indirection; let's eliminate it!
+    (scope_usage, ind_env', binds')
+  where
+    (scope_usage, ind_env, binds') = occAnalTop env binds
+    ind_env' = addOneToIdEnv ind_env local_id exported_id
+
+-- The normal case
+occAnalTop env (bind : binds)
+  = (final_usage, ind_env, new_binds ++ binds')
+  where
+    new_env			   = env `addNewCands` (bindersOf bind)
+    (scope_usage, ind_env, binds') = occAnalTop new_env binds
+    (final_usage, new_binds)       = occAnalBind env (zap_bind bind) scope_usage
+
+	-- Deal with any indirections
+    zap_bind (NonRec bndr rhs) 
+	| bndr `elemIdEnv` ind_env 			= Rec (zap (bndr,rhs))
+		-- The Rec isn't strictly necessary, but it's convenient
+    zap_bind (Rec pairs)
+	| or [id `elemIdEnv` ind_env | (id,_) <- pairs] = Rec (concat (map zap pairs))
+
+    zap_bind bind = bind
+
+    zap pair@(bndr,rhs) = case lookupIdEnv ind_env bndr of
+			    Nothing          -> [pair]
+			    Just exported_id -> [(bndr, Var exported_id),
+					         (exported_id, rhs)]
+\end{code}
+
+
 %************************************************************************
 %*									*
 \subsection[OccurAnal-main]{Counting occurrences: main function}
@@ -514,7 +514,9 @@ occAnalRhs env id rhs
   where
     (rhs_usage, rhs') = occAnal env rhs
     total_usage = foldr add rhs_usage (idSpecVars id)
-    add v u     = addOneOcc u v (argOccurrence 0)
+    add v u     = addOneOcc u v noBinderInfo	-- Give a non-committal binder info
+						-- (i.e manyOcc) because many copies
+						-- of the specialised thing can appear
 \end{code}
 
 Expressions
@@ -686,3 +688,115 @@ occAnalArg env (VarArg v)
   | otherwise         = emptyDetails
 occAnalArg _   _      = emptyDetails
 \end{code}
+
+
+%************************************************************************
+%*									*
+\subsection[OccurAnal-types]{Data types}
+%*									*
+%************************************************************************
+
+\begin{code}
+data OccEnv =
+  OccEnv
+    Bool	-- IgnoreINLINEPragma flag
+		-- False <=> OK to use INLINEPragma information
+		-- True  <=> ignore INLINEPragma information
+
+    (Id -> IdSet -> Bool)	-- Tells whether an Id occurrence is interesting,
+				-- given the set of in-scope variables
+
+    IdSet	-- In-scope Ids
+
+
+addNewCands :: OccEnv -> [Id] -> OccEnv
+addNewCands (OccEnv ip ifun cands) ids
+  = OccEnv ip ifun (cands `unionIdSets` mkIdSet ids)
+
+addNewCand :: OccEnv -> Id -> OccEnv
+addNewCand (OccEnv ip ifun cands) id
+  = OccEnv ip ifun (addOneToIdSet cands id)
+
+isCandidate :: OccEnv -> Id -> Bool
+isCandidate (OccEnv _ ifun cands) id = ifun id cands
+
+inlineMe :: OccEnv -> Id -> Bool
+inlineMe env id
+  = {-	See comments with simplIdWantsToBeINLINEd in SimplUtils.lhs 
+	not ignore_inline_prag && 
+    -}
+    idWantsToBeINLINEd id
+
+
+type UsageDetails = IdEnv BinderInfo	-- A finite map from ids to their usage
+
+combineUsageDetails, combineAltsUsageDetails
+	:: UsageDetails -> UsageDetails -> UsageDetails
+
+combineUsageDetails usage1 usage2
+  = combineIdEnvs addBinderInfo usage1 usage2
+
+combineAltsUsageDetails usage1 usage2
+  = combineIdEnvs orBinderInfo usage1 usage2
+
+addOneOcc :: UsageDetails -> Id -> BinderInfo -> UsageDetails
+addOneOcc usage id info
+  = combineIdEnvs addBinderInfo usage (unitIdEnv id info)
+	-- ToDo: make this more efficient
+
+emptyDetails = (nullIdEnv :: UsageDetails)
+
+unitDetails id info = (unitIdEnv id info :: UsageDetails)
+
+tagBinders :: UsageDetails	    -- Of scope
+	   -> [Id]		    -- Binders
+	   -> (UsageDetails, 	    -- Details with binders removed
+	      [(Id,BinderInfo)])    -- Tagged binders
+
+tagBinders usage binders =
+ let
+  usage' = usage `delManyFromIdEnv` binders
+  uss    = [ (binder, usage_of usage binder) | binder <- binders ]
+ in
+ if isNullIdEnv usage' then
+    (usage', uss)
+ else
+    (usage', uss)
+{-
+  = (usage `delManyFromIdEnv` binders,
+     [ (binder, usage_of usage binder) | binder <- binders ]
+    )
+-}
+tagBinder :: UsageDetails	    -- Of scope
+	  -> Id			    -- Binders
+	  -> (UsageDetails, 	    -- Details with binders removed
+	      (Id,BinderInfo))	    -- Tagged binders
+
+tagBinder usage binder =
+ let
+   usage'  = usage `delOneFromIdEnv` binder
+   us      = usage_of usage binder 
+   cont =
+    if isNullIdEnv usage' then  -- Bogus test to force evaluation.
+       (usage', (binder, us))
+    else
+       (usage', (binder, us))
+ in
+ if isDeadOcc us then		-- Ditto 
+	cont
+ else 
+	cont
+
+
+usage_of usage binder
+  | isExported binder
+  = noBinderInfo	-- Visible-elsewhere things count as many
+  | otherwise
+  = case (lookupIdEnv usage binder) of
+      Nothing   -> deadOccurrence
+      Just info -> info
+
+isNeeded env usage binder = not (isDeadOcc (usage_of usage binder))
+\end{code}
+
+
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 42a240563b4034b6f53a3fbfeecc46a8027ab28c..e21e0f0ae666ffea9d13f65c1fb2152cb4949499 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -37,7 +37,7 @@ import Id		( mkSysLocal, mkUserId, setIdVisibility, replaceIdInfo,
                           replacePragmaInfo, getIdDemandInfo, idType,
 			  getIdInfo, getPragmaInfo, mkIdWithNewUniq,
 			  nullIdEnv, addOneToIdEnv, delOneFromIdEnv,
- 			  lookupIdEnv, IdEnv, omitIfaceSigForId,
+ 			  lookupIdEnv, IdEnv, 
 			  Id
 			)
 import IdInfo		( willBeDemanded, DemandInfo )
@@ -236,11 +236,13 @@ foldl_mn f z (x:xs) = f z x	>>= \ zz ->
 
 Several tasks are done by @tidyCorePgm@
 
-1.  Eliminate indirections.  The point here is to transform
-	x_local = E
-	x_exported = x_local
-    ==>
-	x_exported = E
+----------------
+	[March 98] Indirections are now elimianted by the occurrence analyser
+	-- 1.  Eliminate indirections.  The point here is to transform
+	--	x_local = E
+	--	x_exported = x_local
+	--    ==>
+	--	x_exported = E
 
 2.  Make certain top-level bindings into Globals. The point is that 
     Global things get externally-visible labels at code generation
@@ -287,110 +289,15 @@ Several tasks are done by @tidyCorePgm@
 	generator makes global labels from the uniques for local thunks etc.]
 
 
-Eliminate indirections
-~~~~~~~~~~~~~~~~~~~~~~
-In @elimIndirections@, we look for things at the top-level of the form...
-\begin{verbatim}
-	x_local = ....
-	x_exported = x_local
-\end{verbatim}
-In cases we find like this, we go {\em backwards} and replace
-\tr{x_local} with \tr{x_exported}.  This save a gratuitous jump
-(from \tr{x_exported} to \tr{x_local}), and makes strictness
-information propagate better.
-
-We rely on prior eta reduction to simplify things like
-\begin{verbatim}
-	x_exported = /\ tyvars -> x_local tyvars
-==>
-	x_exported = x_local
-\end{verbatim}
-
-If more than one exported thing is equal to a local thing (i.e., the
-local thing really is shared), then we do one only:
-\begin{verbatim}
-	x_local = ....
-	x_exported1 = x_local
-	x_exported2 = x_local
-==>
-	x_exported1 = ....
-
-	x_exported2 = x_exported1
-\end{verbatim}
-
-There's a possibility of leaving unchanged something like this:
-\begin{verbatim}
-	x_local = ....
-	x_exported1 = x_local Int
-\end{verbatim}
-By the time we've thrown away the types in STG land this 
-could be eliminated.  But I don't think it's very common
-and it's dangerous to do this fiddling in STG land 
-because we might elminate a binding that's mentioned in the
-unfolding for something.
-
-General Strategy: first collect the info; then make a \tr{Id -> Id} mapping.
-Then blast the whole program (LHSs as well as RHSs) with it.
-
 
 
 \begin{code}
 tidyCorePgm :: Module -> [CoreBinding] -> [CoreBinding]
 
 tidyCorePgm mod binds_in
-  = initTM mod indirection_env $
-    tidyTopBindings (catMaybes reduced_binds)	`thenTM` \ binds ->
+  = initTM mod nullIdEnv $
+    tidyTopBindings binds_in	`thenTM` \ binds ->
     returnTM (bagToList binds)
-  where
-    (indirection_env, reduced_binds) = mapAccumL try_bind nullIdEnv binds_in
-
-    try_bind :: IdEnv CoreBinder -> CoreBinding -> (IdEnv CoreBinder, Maybe CoreBinding)
-    try_bind env_so_far (NonRec exported_binder rhs)
-	| isExported exported_binder &&		-- Only if this is exported
-	  maybeToBool maybe_rhs_id &&		-- 	and the RHS is a simple Id
-
-	  isLocallyDefined rhs_id &&		-- Only if this one is defined in this
-	  					-- 	module, so that we *can* change its
-					  	-- 	binding to be the exported thing!
-
-	  not (isExported rhs_id) &&		-- Only if this one is not itself exported,
-						--	since the transformation will nuke it
-
-	  not (omitIfaceSigForId rhs_id) &&	-- Don't do the transformation if rhs_id is
-						-- 	something like a constructor, whose 
-						--	definition is implicitly exported and 
-						-- 	which must not vanish.
-		-- To illustrate the preceding check consider
-		--	data T = MkT Int
-		--	mkT = MkT
-		--	f x = MkT (x+1)
-		-- Here, we'll make a local, non-exported, defn for MkT, and without the
-		-- above condition we'll transform it to:
-		--	mkT = \x. MkT [x]
-		--	f = \y. mkT (y+1)
-		-- This is bad because mkT will get the IdDetails of MkT, and won't
-		-- be exported.  Also the code generator won't make a definition for
-		-- the MkT constructor.
-		-- Slightly gruesome, this.
-
-	  not (maybeToBool (lookupIdEnv env_so_far rhs_id))
-						-- Only if not already substituted for
-
-	= (addOneToIdEnv env_so_far rhs_id (ValBinder new_rhs_id), Nothing)
-	where
-	   maybe_rhs_id = case etaCoreExpr rhs of
-				Var rhs_id -> Just rhs_id
-				other	   -> Nothing
-	   Just rhs_id  = maybe_rhs_id
-	   new_rhs_id   = exported_binder `replaceIdInfo`     getIdInfo rhs_id
-					  `replacePragmaInfo` getPragmaInfo rhs_id
-				-- NB: we keep the Pragmas and IdInfo for the old rhs_id!
-				-- This is important; it might be marked "no-inline" by
-				-- the occurrence analyser (because it's recursive), and
-				-- we must not lose that information.
-
-    try_bind env_so_far bind
-	= (env_so_far, Just bind)
 \end{code}
 
 Top level bindings
diff --git a/ghc/compiler/simplCore/SimplEnv.lhs b/ghc/compiler/simplCore/SimplEnv.lhs
index 5e86269ed4d68276302d02af1198271c77874677..9e59327f5ece294a1698c2b15d51015868ddbc61 100644
--- a/ghc/compiler/simplCore/SimplEnv.lhs
+++ b/ghc/compiler/simplCore/SimplEnv.lhs
@@ -472,7 +472,8 @@ extendConApps con_apps id other_rhs = con_apps
 \end{code}
 
 \begin{code}
-lookForConstructor (SimplEnv _ _ _ _ _ con_apps) con args
+lookForConstructor env@(SimplEnv _ _ _ _ _ con_apps) (Con con args)
+  | switchIsSet env SimplReuseCon
   = case lookupFM con_apps (UCA con val_args) of
 	Nothing     -> Nothing
 
@@ -485,6 +486,7 @@ lookForConstructor (SimplEnv _ _ _ _ _ con_apps) con args
     val_args = filter isValArg args		-- Literals and Ids
     ty_args  = [ty | TyArg ty <- args]		-- Just types
 
+lookForConstructor env other = Nothing
 \end{code}
 
 NB: In @lookForConstructor@ we used (before Apr 94) to have a special case
@@ -590,7 +592,7 @@ extendEnvGivenBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con
   = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env new_con_apps 
   where
     new_out_id_env | okToInline (whnfOrBottom form) 
-				(couldBeSmallEnoughToInline guidance) 
+				(couldBeSmallEnoughToInline out_id guidance) 
 				occ_info 
 		   = out_id_env_with_unfolding
 		   | otherwise
diff --git a/ghc/compiler/simplCore/SimplVar.lhs b/ghc/compiler/simplCore/SimplVar.lhs
index 3799d5e63c2982e85e5c786b18c6562ee9ac8014..c3db663eeb99f49fb3bfc4696d1d909a3ecc5dab 100644
--- a/ghc/compiler/simplCore/SimplVar.lhs
+++ b/ghc/compiler/simplCore/SimplVar.lhs
@@ -30,6 +30,7 @@ import Id		( idType, getIdInfo, getIdUnfolding,
 			  elemIdEnv, isNullIdEnv, addOneToIdEnv
 			)
 import SpecEnv		( lookupSpecEnv, substSpecEnv, isEmptySpecEnv )
+import OccurAnal	( occurAnalyseGlobalExpr )
 import Literal		( isNoRepLit )
 import MagicUFs		( applyMagicUnfoldingFun, MagicUnfoldingFun )
 import SimplEnv
@@ -64,7 +65,7 @@ completeVar env var args result_ty
   | maybeToBool maybe_specialisation
   = tick SpecialisationDone	`thenSmpl_`
     simplExpr (bindTyVars env spec_bindings) 
-	      spec_template
+	      (occurAnalyseGlobalExpr spec_template)
 	      remaining_args
 	      result_ty
 
@@ -87,7 +88,7 @@ completeVar env var args result_ty
     && ok_to_inline
     && costCentreOk (getEnclosingCC env) (getEnclosingCC unf_env)
     )
-  = pprTrace "Unfolding" (ppr var) $
+  = -- pprTrace "Unfolding" (ppr var) $
     unfold var unf_env unf_template args result_ty
 
 
@@ -135,7 +136,7 @@ completeVar env var args result_ty
     essential_unfoldings_only = switchIsOn sw_chkr EssentialUnfoldingsOnly
     is_case_scrutinee	      = switchIsOn sw_chkr SimplCaseScrutinee
     ok_to_inline	      = okToInline (whnfOrBottom form) small_enough occ_info 
-    small_enough	      = smallEnoughToInline arg_evals is_case_scrutinee guidance
+    small_enough	      = smallEnoughToInline var arg_evals is_case_scrutinee guidance
     arg_evals		      = [is_evald arg | arg <- args, isValArg arg]
 
     is_evald (VarArg v) = isEvaluated (lookupRhsInfo env v)
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 522a96c9a2ea06f794f8815c6e9d7c844c507411..2e7b0837af40a2256b677c81126e684982aa97c5 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -24,7 +24,7 @@ import Id		( idType, idMustBeINLINEd, idWantsToBeINLINEd, idMustNotBeINLINEd,
 			  addIdArity, getIdArity,
 			  getIdDemandInfo, addIdDemandInfo
 			)
-import Name		( isExported )
+import Name		( isExported, isLocallyDefined )
 import IdInfo		( willBeDemanded, noDemandInfo, DemandInfo, ArityInfo(..),
 			  atLeastArity, unknownArity )
 import Literal		( isNoRepLit )
@@ -1021,47 +1021,53 @@ Because then we can't remove the x=y binding, in which case we
 have just made things worse, perhaps a lot worse.
 
 \begin{code}
-	-- Right hand sides that are constructors
-	--	let v = C args
-	--	in
-	--- ...(let w = C same-args in ...)...
-	-- Then use v instead of w.	 This may save
-	-- re-constructing an existing constructor.
 completeNonRec env binder new_id new_rhs
-  |  not (isExported new_id)		-- Don't bother for exported things
-					-- because we won't be able to drop
-					-- its binding.
-  && maybeToBool maybe_atomic_rhs
-  = tick tick_type	`thenSmpl_`
+  = returnSmpl (env', [NonRec b r | (b,r) <- binds])
+  where
+    (env', binds) = completeBind env binder new_id new_rhs
+
+
+completeBind :: SimplEnv 
+	     -> InBinder -> OutId -> OutExpr		-- Id and RHS
+	     -> (SimplEnv, [(OutId, OutExpr)])		-- Final envt and binding(s)
+
+completeBind env binder@(_,occ_info) new_id new_rhs
+  | idMustNotBeINLINEd new_id		-- Occurrence analyser says "don't inline"
+  = (env, new_binds)
+
+  |  atomic_rhs			-- If rhs (after eta reduction) is atomic
+  && not (isExported new_id)	-- and binder isn't exported
+  = 	-- Drop the binding completely
     let
-	env1 = notInScope env new_id
-	env2 = bindIdToAtom env1 binder rhs_arg
+        env1 = notInScope env new_id
+	env2 = bindIdToAtom env1 binder the_arg
     in
-    returnSmpl (env2, [])
-  where
-    Just (rhs_arg, tick_type) = maybe_atomic_rhs
-    maybe_atomic_rhs 
-      = 		-- Try first for an existing constructor application
-	case maybe_con new_rhs of {
-	Just con -> Just (VarArg con, ConReused);
-
- 	Nothing  ->	-- No good; try eta-reduction
-	case etaCoreExpr new_rhs of {
-	Var v -> Just (VarArg v, AtomicRhs);
-	Lit l -> Just (LitArg l, AtomicRhs);
-
-	other -> Nothing -- Neither worked, so return Nothing
-	}}
-	
+    (env2, [])
 
-    maybe_con (Con con con_args) | switchIsSet env SimplReuseCon
-				 = lookForConstructor env con con_args 
-    maybe_con other_rhs		 = Nothing
+  |  atomic_rhs 		-- Rhs is atomic, and new_id is exported
+  && case eta'd_rhs of { Var v -> isLocallyDefined v && not (isExported v); other -> False }
+  =	-- The local variable v will be eliminated next time round
+	-- in favour of new_id, so it's a waste to replace all new_id's with v's
+	-- this time round.
+	-- This case is an optional improvement; saves a simplifier iteration
+    (env, [(new_id, eta'd_rhs)])
 
-completeNonRec env binder@(id,occ_info) new_id new_rhs
-  = returnSmpl (new_env , [NonRec new_id new_rhs])
+  | otherwise				-- Non-atomic
+  = let
+	env1 = extendEnvGivenBinding env occ_info new_id new_rhs
+    in 
+    (env1, new_binds)
+	     
   where
-    new_env = extendEnvGivenBinding env occ_info new_id new_rhs
+    new_binds  = [(new_id, new_rhs)]
+    atomic_rhs = is_atomic eta'd_rhs
+    eta'd_rhs  = case lookForConstructor env new_rhs of 
+		   Just v -> Var v
+		   other  -> etaCoreExpr new_rhs
+
+    the_arg    = case eta'd_rhs of
+			  Var v -> VarArg v
+			  Lit l -> LitArg l
 \end{code}
 
 ----------------------------------------------------------------------------
@@ -1203,31 +1209,11 @@ simplRecursiveGroup env (new_id : new_ids) ((binder@(id, occ_info), rhs) : pairs
   | otherwise
   = simplRhsExpr env binder rhs new_id		`thenSmpl` \ (new_rhs, arity) ->
     let
-	new_id' = new_id `withArity` arity
-    
-	-- ToDo: this next bit could usefully share code with completeNonRec
-
-        new_env 
-	  | idMustNotBeINLINEd new_id		-- Occurrence analyser says "don't inline"
-	  = env
-
-	  | is_atomic eta'd_rhs 		-- If rhs (after eta reduction) is atomic
-	  = let
-	       env1 = notInScope env new_id
-	    in
-    	    bindIdToAtom env1 binder the_arg
-
-	  | otherwise				-- Non-atomic
-	  = extendEnvGivenBinding env occ_info new_id new_rhs
-						-- Don't eta if it doesn't eliminate the binding
-
-        eta'd_rhs = etaCoreExpr new_rhs
-        the_arg   = case eta'd_rhs of
-			  Var v -> VarArg v
-			  Lit l -> LitArg l
+	new_id'   = new_id `withArity` arity
+        (new_env, new_binds') = completeBind env binder new_id' new_rhs
     in
     simplRecursiveGroup new_env new_ids pairs	`thenSmpl` \ (new_pairs, final_env) ->
-    returnSmpl ((new_id', new_rhs) : new_pairs, final_env)   
+    returnSmpl (new_binds' ++ new_pairs, final_env)   
   where
     ok_to_dup = switchIsSet env SimplOkToDupCode
 \end{code}
diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index aade3c4997894b9a694a9ba28c1229a7b728eb89..cb5638c739ee96209f6da07939018f7bde6ce2d3 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -32,7 +32,7 @@ import TyVar		( TyVar,
 			  TyVarEnv, mkTyVarEnv, delFromTyVarEnv
 			)
 import CoreSyn
-import OccurAnal	( occurAnalyseGlobalExpr )
+import PprCore		()	-- Instances 
 import Name		( NamedThing(..), getSrcLoc )
 import SpecEnv		( addToSpecEnv, lookupSpecEnv, specEnvValues )
 
@@ -1191,7 +1191,7 @@ addIdSpecialisations id spec_stuff
     (new_spec_env, errs) = foldr add (getIdSpecialisation id, []) spec_stuff
 
     add (tyvars, tys, template) (spec_env, errs)
-	= case addToSpecEnv True spec_env tyvars tys (occurAnalyseGlobalExpr template) of
+	= case addToSpecEnv True spec_env tyvars tys template of
 		Succeeded spec_env' -> (spec_env', errs)
 		Failed err 	    -> (spec_env, err:errs)
 
@@ -1234,7 +1234,7 @@ substSpecEnvRhs te ve rhs
 				        where
 					  te' = delFromTyVarEnv te tyvar
 
-    go te ve (Lam b@(ValBinder (v,_)) e) = Lam b (go te ve' e)
+    go te ve (Lam b@(ValBinder v) e) = Lam b (go te ve' e)
 				     where
 				       ve' = delOneFromIdEnv ve v
 
diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs
index fbac09bc6c81b55d945074a068233ce5895970a4..ebea69bc956e5d99eb65fdaa6339a338a8edc9bf 100644
--- a/ghc/compiler/stranal/WorkWrap.lhs
+++ b/ghc/compiler/stranal/WorkWrap.lhs
@@ -184,7 +184,7 @@ tryWW	:: Id				-- The fn binder
 					-- if two, then a worker and a
 					-- wrapper.
 tryWW fn_id rhs
-  | (certainlySmallEnoughToInline $
+  | (certainlySmallEnoughToInline fn_id $
      calcUnfoldingGuidance (getInlinePragma fn_id) 
 			  opt_UnfoldingCreationThreshold
 			  rhs
diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index cecc64a7b6b8e285a2402c1b4890348c4114672a..1218e41350bc7f5da38e05cb70a693922fcf5593 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -67,8 +67,9 @@ tcInterfaceSigs unf_env (SigD (IfaceSig name ty id_infos src_loc) : rest)
 	    sig_id | any inline_please id_infos = addInlinePragma imp_id
 	           | otherwise	 	        = imp_id
 
-	    inline_please (HsUnfold inline _) = inline
-	    inline_please other		  = False
+	    inline_please (HsUnfold inline _)			       = inline
+	    inline_please (HsStrictness (HsStrictnessInfo _ (Just _))) = True	-- Inline wrappers
+	    inline_please other				 	       = False
 	in
 	returnTc sig_id
     ))						`thenTc` \ sig_id ->