diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 5b5c2139e467a007a60cc3f780f6fdd59d12a698..cc8dc37425d6ea09f08159bc340651b1d9c8c9af 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -41,6 +41,7 @@ import IdInfo		( IdInfo, StrictnessInfo, ArityInfo,
 			  arityInfo, ppArityInfo, strictnessInfo, ppStrictnessInfo, 
 			  bottomIsGuaranteed, workerExists, 
 			)
+import PragmaInfo	( PragmaInfo(..) )
 import CoreSyn		( CoreExpr, CoreBinding, GenCoreExpr, GenCoreBinding(..) )
 import CoreUnfold	( calcUnfoldingGuidance, UnfoldingGuidance(..), Unfolding )
 import FreeVars		( addExprFVs )
@@ -287,9 +288,14 @@ ifaceId get_idinfo needed_ids is_rec id rhs
     con_list 		   = idSetToList wrapper_cons
 
     ------------  Unfolding  --------------
-    unfold_pretty | show_unfold = hsep [ptext SLIT("_U_"), pprIfaceUnfolding rhs]
+    unfold_pretty | show_unfold = hsep [ptext unfold_herald, pprIfaceUnfolding rhs]
 		  | otherwise   = empty
 
+    unfold_herald = case inline_pragma of
+			IMustBeINLINEd   -> SLIT("_U_")
+			IWantToBeINLINEd -> SLIT("_U_")
+			other		 -> SLIT("_u_")
+
     show_unfold = not implicit_unfolding && 		-- Not unnecessary
 		  not dodgy_unfolding			-- Not dangerous
 
diff --git a/ghc/compiler/reader/Lex.lhs b/ghc/compiler/reader/Lex.lhs
index ca67c8c8977d1c2dbcb67976010868c28eb4a3b5..181a93f0a3ec34749f8eca6745e887416c467a2c 100644
--- a/ghc/compiler/reader/Lex.lhs
+++ b/ghc/compiler/reader/Lex.lhs
@@ -753,8 +753,8 @@ ifaceKeywordsFM = listToUFM $
        ,("declarations_",	ITdeclarations)
        ,("pragmas_",		ITpragmas)
        ,("forall_",		ITforall)
-       ,("U_",			ITunfold False)
-       ,("U!_",			ITunfold True)
+       ,("u_",			ITunfold False)
+       ,("U_",			ITunfold True)
        ,("A_",			ITarity)
        ,("coerce_in_",		ITcoerce_in)
        ,("coerce_out_",		ITcoerce_out)
diff --git a/ghc/compiler/simplCore/SimplCase.lhs b/ghc/compiler/simplCore/SimplCase.lhs
index bbbd9d5b4f7f9eb102db7014d8cd364575acf79c..c7d3313126d05eb69bea3b428266afaaad5bebe2 100644
--- a/ghc/compiler/simplCore/SimplCase.lhs
+++ b/ghc/compiler/simplCore/SimplCase.lhs
@@ -43,8 +43,8 @@ Float let out of case.
 
 \begin{code}
 simplCase :: SimplEnv
-	  -> InExpr	-- Scrutinee
-	  -> InAlts	-- Alternatives
+	  -> InExpr					-- Scrutinee
+	  -> (SubstEnvs, InAlts)			-- Alternatives, and their static environment
 	  -> (SimplEnv -> InExpr -> SmplM OutExpr)	-- Rhs handler
 	  -> OutType					-- Type of result expression
 	  -> SmplM OutExpr
@@ -99,27 +99,30 @@ All of this works equally well if the outer case has multiple rhss.
 
 
 \begin{code}
-simplCase env (Case inner_scrut inner_alts) outer_alts rhs_c result_ty
+simplCase env (Case inner_scrut inner_alts) (subst_envs, outer_alts) rhs_c result_ty
   | switchIsSet env SimplCaseOfCase
   = 	-- Ha!  Do case-of-case
     tick CaseOfCase	`thenSmpl_`
 
     if no_need_to_bind_large_alts
     then
-	simplCase env inner_scrut inner_alts
-		  (\env rhs -> simplCase env rhs outer_alts rhs_c result_ty) result_ty
+	simplCase env inner_scrut (getSubstEnvs env, inner_alts)
+		  (\env' rhs -> simplCase env' rhs (subst_envs, outer_alts) rhs_c result_ty)
+		  result_ty
     else
-	bindLargeAlts env outer_alts rhs_c result_ty	`thenSmpl` \ (extra_bindings, outer_alts') ->
+	bindLargeAlts env_alts outer_alts rhs_c result_ty	`thenSmpl` \ (extra_bindings, outer_alts') ->
 	let
 	   rhs_c' = \env rhs -> simplExpr env rhs [] result_ty
 	in
-	simplCase env inner_scrut inner_alts
-		  (\env rhs -> simplCase env rhs outer_alts' rhs_c' result_ty)
+	simplCase env inner_scrut (getSubstEnvs env, inner_alts)
+		  (\env rhs -> simplCase env rhs (emptySubstEnvs, outer_alts') rhs_c' result_ty)
 		  result_ty
 						`thenSmpl` \ case_expr ->
 	returnSmpl (mkCoLetsNoUnboxed extra_bindings case_expr)
 
   where
+    env_alts = setSubstEnvs env subst_envs
+
     no_need_to_bind_large_alts = switchIsSet env SimplOkToDupCode ||
    			         isSingleton (nonErrorRHSs inner_alts)
 \end{code}
@@ -143,18 +146,20 @@ simplCase env scrut alts rhs_c result_ty
 Finally the default case
 
 \begin{code}
-simplCase env other_scrut alts rhs_c result_ty
-  = simplTy env scrut_ty			`appEager` \ scrut_ty' ->
-    simplExpr env' other_scrut [] scrut_ty	`thenSmpl` \ scrut' ->
-    completeCase env scrut' alts rhs_c
+simplCase env other_scrut (subst_envs, alts) rhs_c result_ty
+  = simplTy env scrut_ty				`appEager` \ scrut_ty' ->
+    simplExpr env_scrut other_scrut [] scrut_ty'	`thenSmpl` \ scrut' ->
+    completeCase env_alts scrut' alts rhs_c
   where
 	-- When simplifying the scrutinee of a complete case that
 	-- has no default alternative
-    env' = case alts of
+    env_scrut = case alts of
 		AlgAlts _ NoDefault  -> setCaseScrutinee env
 		PrimAlts _ NoDefault -> setCaseScrutinee env
 		other		     -> env
 
+    env_alts = setSubstEnvs env subst_envs
+
     scrut_ty = coreExprType (unTagBinders other_scrut)
 \end{code}
 
diff --git a/ghc/compiler/simplCore/SimplEnv.lhs b/ghc/compiler/simplCore/SimplEnv.lhs
index 587406afad7aa46676a131075a5237b564508aec..86023544552a6882930f9f214f91e083628de04c 100644
--- a/ghc/compiler/simplCore/SimplEnv.lhs
+++ b/ghc/compiler/simplCore/SimplEnv.lhs
@@ -7,6 +7,7 @@
 module SimplEnv (
 	nullSimplEnv, 
 	getEnvs, setTyEnv, setIdEnv, notInScope, setSubstEnvs, zapSubstEnvs,
+	emptySubstEnvs, getSubstEnvs,
 
 	bindTyVar, bindTyVars, simplTy,
 
@@ -28,7 +29,7 @@ module SimplEnv (
 
 	-- Types
 	SwitchChecker,
-	SimplEnv, 
+	SimplEnv, SubstEnvs,
 	UnfoldConApp,
 	SubstInfo(..),
 
@@ -154,6 +155,8 @@ type SimplValEnv = (IdEnv StuffAboutId,	-- Domain includes *all* in-scope
 	-- Ids in the domain of the substitution are *not* in scope;
 	-- they *must* be substituted for the given OutArg
 
+type SubstEnvs = (TyVarEnv Type, IdEnv SubstInfo)
+
 data SubstInfo 
   = SubstVar OutId		-- The Id maps to an already-substituted atom
   | SubstLit Literal		-- ...ditto literal
@@ -204,9 +207,22 @@ setIdEnv :: SimplEnv -> SimplValEnv -> SimplEnv
 setIdEnv (SimplEnv chkr encl_cc ty_env _ con_apps) id_env
   = SimplEnv chkr encl_cc ty_env id_env con_apps
 
-setSubstEnvs :: SimplEnv -> TyVarEnv Type -> IdEnv SubstInfo -> SimplEnv
+getSubstEnvs :: SimplEnv -> SubstEnvs
+getSubstEnvs (SimplEnv _ _ (_, ty_subst) (_, id_subst) _) = (ty_subst, id_subst)
+
+emptySubstEnvs :: SubstEnvs
+emptySubstEnvs = (emptyTyVarEnv, nullIdEnv)
+
+setSubstEnvs :: SimplEnv -> SubstEnvs -> SimplEnv
 setSubstEnvs (SimplEnv chkr encl_cc (in_scope_tyvars, _) (in_scope_ids, _) con_apps)
-	     ty_subst id_subst
+	     (ty_subst, id_subst)
+  = SimplEnv chkr encl_cc (in_scope_tyvars, ty_subst) (in_scope_ids, id_subst) con_apps
+
+combineEnvs :: SimplEnv		-- Get substitution from here
+	    -> SimplEnv		-- Get in-scope info from here
+	    -> SimplEnv
+combineEnvs (SimplEnv _    _       (_, ty_subst)        (_, id_subst)     _)
+	    (SimplEnv chkr encl_cc (in_scope_tyvars, _) (in_scope_ids, _) con_apps)
   = SimplEnv chkr encl_cc (in_scope_tyvars, ty_subst) (in_scope_ids, id_subst) con_apps
 
 zapSubstEnvs :: SimplEnv -> SimplEnv
diff --git a/ghc/compiler/simplCore/SimplVar.lhs b/ghc/compiler/simplCore/SimplVar.lhs
index b1d6664f63c82f9427ab4fa0107787b396a3cee9..7ed82def06ec3bb833faa67e4179d71cab671c03 100644
--- a/ghc/compiler/simplCore/SimplVar.lhs
+++ b/ghc/compiler/simplCore/SimplVar.lhs
@@ -186,7 +186,7 @@ simplBinder env (id, occ_info)
 #if DEBUG
     -- I  reckon the empty-env thing should catch
     -- most no-free-tyvars things, so this test should be redundant
-    (if idHasNoFreeTyVars id then pprTrace "applyEnvsToId" (ppr id) else (\x -> x))
+--    (if idHasNoFreeTyVars id then pprTrace "applyEnvsToId" (ppr id) else (\x -> x))
 #endif
     (let
        -- id1 has its type zapped
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 8bde1385247a7d22a46b85e39b03f2716a82a47c..03c9495dd2236c6362b986236ddc5dc95b65318e 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -250,7 +250,7 @@ simplExpr env (Var var) args result_ty
   = case lookupIdSubst env var of
   
       Just (SubstExpr ty_subst id_subst expr)
-	-> simplExpr (setSubstEnvs env ty_subst id_subst) expr args result_ty
+	-> simplExpr (setSubstEnvs env (ty_subst, id_subst)) expr args result_ty
 
       Just (SubstLit lit)		-- A boring old literal
 	-> ASSERT( null args )
@@ -398,7 +398,10 @@ Case expressions
 
 \begin{code}
 simplExpr env expr@(Case scrut alts) args result_ty
-  = simplCase env scrut alts (\env rhs -> simplExpr env rhs args result_ty) result_ty
+  = simplCase env scrut
+	      (getSubstEnvs env, alts)
+	      (\env rhs -> simplExpr env rhs args result_ty)
+	      result_ty
 \end{code}
 
 
@@ -709,7 +712,9 @@ simplValLam env expr min_no_of_args expr_ty
 \begin{code}
 -- (coerce (case s of p -> r)) args ==> case s of p -> (coerce r) args
 simplCoerce env coercion ty expr@(Case scrut alts) args result_ty
-  = simplCase env scrut alts (\env rhs -> simplCoerce env coercion ty rhs args result_ty) result_ty
+  = simplCase env scrut (getSubstEnvs env, alts)
+	      (\env rhs -> simplCoerce env coercion ty rhs args result_ty)
+	      result_ty
 
 -- (coerce (let defns in b)) args  ==> let defns' in (coerce b) args
 simplCoerce env coercion ty (Let bind body) args result_ty
@@ -904,7 +909,7 @@ simplNonRec env binder@(id,_) rhs body_c body_ty
 	-- we can't trivially do let-to-case (because there may be some unboxed
 	-- things bound in letrecs that aren't really recursive).
   | isUnpointedType rhs_ty && not rhs_is_whnf
-  = simplCase env rhs (PrimAlts [] (BindDefault binder (Var id)))
+  = simplCase env rhs (getSubstEnvs env, PrimAlts [] (BindDefault binder (Var id)))
 		      (\env rhs -> complete_bind env rhs) body_ty
 
 	-- Try let-to-case; see notes below about let-to-case
@@ -918,7 +923,7 @@ simplNonRec env binder@(id,_) rhs body_c body_ty
 		-- the end of simplification.
     )
   = tick Let2Case				`thenSmpl_`
-    simplCase env rhs (AlgAlts [] (BindDefault binder (Var id)))
+    simplCase env rhs (getSubstEnvs env, AlgAlts [] (BindDefault binder (Var id)))
 		      (\env rhs -> complete_bind env rhs) body_ty
 		-- OLD COMMENT:  [now the new RHS is only "x" so there's less worry]
 		-- NB: it's tidier to call complete_bind not simpl_bind, else
@@ -946,14 +951,15 @@ simplNonRec env binder@(id,_) rhs body_c body_ty
 	-- First, bind large let-body if necessary
 	if ok_to_dup || isSingleton (nonErrorRHSs alts)
 	then
-	    simplCase env scrut alts (\env rhs -> simpl_bind env rhs) body_ty
+	    simplCase env scrut (getSubstEnvs env, alts) 
+		      (\env rhs -> simpl_bind env rhs) body_ty
 	else
 	    bindLargeRhs env [binder] body_ty body_c	`thenSmpl` \ (extra_binding, new_body) ->
 	    let
 		body_c' = \env -> simplExpr env new_body [] body_ty
 		case_c  = \env rhs -> simplNonRec env binder rhs body_c' body_ty
 	    in
-	    simplCase env scrut alts case_c body_ty	`thenSmpl` \ case_expr ->
+	    simplCase env scrut (getSubstEnvs env, alts) case_c body_ty	`thenSmpl` \ case_expr ->
 	    returnSmpl (Let extra_binding case_expr)
 
     -- None of the above; simplify rhs and tidy up
diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index ab4edecf4fcdd54682685e2848c12d0afabb896f..6c6f9d24bf33362c7147b093530d339cfdacec50 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -709,8 +709,8 @@ Hence, the invariant is this:
 \begin{code}
 specProgram :: UniqSupply -> [CoreBinding] -> [CoreBinding]
 specProgram us binds
-  = initSM us (go binds 	`thenSM` \ (binds', _) ->
-	       returnSM binds'
+  = initSM us (go binds 	`thenSM` \ (binds', uds') ->
+	       returnSM (dumpAllDictBinds uds' binds')
 	      )
   where
     go []	    = returnSM ([], emptyUDs)
@@ -1064,6 +1064,11 @@ mkDB dict rhs = (dict, rhs, db_ftvs, db_fvs)
 
 addDictBind uds dict rhs = uds { dict_binds = mkDB dict rhs `consBag` dict_binds uds }
 
+dumpAllDictBinds (MkUD {dict_binds = dbs}) binds
+  = foldrBag add binds dbs
+  where
+    add (dict,rhs,_,_) binds = NonRec dict rhs : binds
+
 dumpUDs :: [CoreBinder]
 	-> UsageDetails -> CoreExpr
 	-> (UsageDetails, CoreExpr)
@@ -1174,9 +1179,11 @@ instantiateDictRhs ty_env id_env rhs
     go (Var v)	      = Var (lookupId id_env v)
     go (Lit l)	      = Lit l
     go (Con con args) = Con con (map go_arg args)
+    go (Coerce c t e) = Coerce c (instantiateTy ty_env t) (go e)
     go (Case e alts)  = Case (go e) alts		-- See comment below re alts
     go other	      = pprPanic "instantiateDictRhs" (ppr rhs)
 
+
 dictRhsFVs :: CoreExpr -> IdSet
 	-- Cheapo function for simple RHSs
 dictRhsFVs e
@@ -1187,6 +1194,7 @@ dictRhsFVs e
     go (Var v)	           = unitIdSet v
     go (Lit l)	           = emptyIdSet
     go (Con _ args)        = mkIdSet [id | VarArg id <- args]
+    go (Coerce _ _ e)	   = go e
 
     go (Case e _)	   = go e	-- Claim: no free dictionaries in the alternatives
 					-- These case expressions are of the form
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 36451450c50af24d5e88df533f203603c45472b0..7c6e6e5e9e6a889ce7424d968429fdd216700f6a 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -154,8 +154,9 @@ import Type		( Type, ThetaType, TauType, mkTyVarTy, getTyVar,
 			)
 import PprType		( pprConstraint )
 import TysWiredIn	( unitTy )
-import TyVar		( intersectTyVarSets, unionManyTyVarSets,
-			  isEmptyTyVarSet, zipTyVarEnv, emptyTyVarEnv
+import TyVar		( intersectTyVarSets, unionManyTyVarSets, minusTyVarSet,
+			  isEmptyTyVarSet, tyVarSetToList,
+			  zipTyVarEnv, emptyTyVarEnv
 			)
 import FiniteMap
 import BasicTypes	( TopLevelFlag(..) )
@@ -200,8 +201,23 @@ tcSimplify str top_lvl local_tvs wanted_lie
     checkTc (null cant_generalise)
 	    (genCantGenErr cant_generalise)	`thenTc_`
 
-	 -- Finished
-    returnTc (mkLIE frees, binds, mkLIE irreds)
+	-- Check for ambiguous insts.
+	-- You might think these can't happen (I did) because an ambiguous
+	-- inst like (Eq a) will get tossed out with "frees", and eventually
+	-- dealt with by tcSimplifyTop.
+	-- But we can get stuck with 
+	--	C a b
+	-- where "a" is one of the local_tvs, but "b" is unconstrained.
+	-- Then we must yell about the ambiguous b
+    let
+	(irreds', bad_guys) = partition (isEmptyTyVarSet . ambig_tv_fn) irreds
+	ambig_tv_fn dict    = tyVarsOfInst dict `minusTyVarSet` local_tvs
+    in
+    addAmbigErrs ambig_tv_fn bad_guys	`thenNF_Tc_`
+
+
+	-- Finished
+    returnTc (mkLIE frees, binds, mkLIE irreds')
   where
     wanteds = bagToList wanted_lie
 
@@ -865,7 +881,7 @@ tcSimplifyTop wanted_lie
     d1 `cmp_by_tyvar` d2 = get_tv d1 `compare` get_tv d2
 
     complain d | isEmptyTyVarSet (tyVarsOfInst d) = addTopInstanceErr d
-	       | otherwise			  = addAmbigErr [d]
+	       | otherwise			  = addAmbigErr tyVarsOfInst d
 
 get_tv d   = case getDictClassTys d of
 		   (clas, [ty]) -> getTyVar "tcSimplifyTop" ty
@@ -913,7 +929,7 @@ disambigGroup dicts
     in
 	-- See if any default works, and if so bind the type variable to it
 	-- If not, add an AmbigErr
-    recoverTc (addAmbigErr dicts `thenNF_Tc_` returnTc EmptyMonoBinds)	$
+    recoverTc (complain dicts `thenNF_Tc_` returnTc EmptyMonoBinds)	$
 
     try_default default_tys		 	`thenTc` \ chosen_default_ty ->
 
@@ -932,10 +948,11 @@ disambigGroup dicts
     returnTc EmptyMonoBinds
     
   | otherwise -- No defaults
-  = addAmbigErr dicts	`thenNF_Tc_`
+  = complain dicts	`thenNF_Tc_`
     returnTc EmptyMonoBinds
 
   where
+    complain    = addAmbigErrs tyVarsOfInst
     try_me inst = ReduceMe AddToIrreds		-- This reduce should not fail
     tyvar       = get_tv (head dicts)		-- Should be non-empty
     classes     = map get_clas dicts
@@ -955,10 +972,16 @@ genCantGenErr insts	-- Can't generalise these Insts
 	 nest 4 (pprInstsInFull insts)
 	]
 
-addAmbigErr dicts
-  = tcAddSrcLoc (instLoc (head dicts)) $
-    addErrTc (sep [text "Cannot resolve the ambiguous context" <+> pprInsts dicts,
-	 	   nest 4 (pprInstsInFull dicts)])
+addAmbigErrs ambig_tv_fn dicts = mapNF_Tc (addAmbigErr ambig_tv_fn) dicts
+
+addAmbigErr ambig_tv_fn dict
+  = tcAddSrcLoc (instLoc dict) $
+    addErrTc (sep [text "Ambiguous type variable(s)",
+		   hsep (punctuate comma (map (quotes . ppr) ambig_tvs)),
+		   nest 4 (text "in the constraint" <+> quotes (pprInst dict)),
+	 	   nest 4 (pprOrigin dict)])
+  where
+    ambig_tvs = tyVarSetToList (ambig_tv_fn dict)
 
 -- Used for top-level irreducibles
 addTopInstanceErr dict