Merge in changes from HEAD

18 files changed, 157 insertions, 105 deletions

diff --git a/.gitignore b/.gitignore
index bbcff222d2..32d243bca6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,6 +7,7 @@
 *.BAK
 *.orig
 *.prof
+*.rej
 
 *.hi
 *.hi-boot
@@ -30,6 +31,12 @@ config.status
 configure
 
 # -----------------------------------------------------------------------------
+# Ignore any overlapped darcs repos and back up files
+
+*-darcs-backup*
+_darcs/
+
+# -----------------------------------------------------------------------------
 # sub-repositories
 
 /ghc-tarballs/
@@ -79,9 +86,7 @@ configure
 /bindist-list
 /bindistprep/
 /bindisttest/HelloWorld
-/bindisttest/a/
-/bindisttest/install\ dir/
-/bindisttest/output
+/bindisttest/
 /ch01.html
 /ch02.html
 /compiler/cmm/CmmLex.hs
@@ -119,8 +124,12 @@ configure
 /docs/users_guide/users_guide.xml
 /docs/users_guide/users_guide/
 /docs/users_guide/what_glasgow_exts_does.gen.xml
+/driver/ghc/dist/
+/driver/haddock/dist/
 /driver/ghci/ghc-pkg-inplace
 /driver/ghci/ghci-inplace
+/driver/ghci/dist/
+/driver/ghci/ghci.res
 /driver/mangler/dist/ghc-asm
 /driver/mangler/dist/ghc-asm.prl
 /driver/package.conf
@@ -150,6 +159,8 @@ configure
 /libffi/package.conf.inplace
 /libffi/package.conf.inplace.raw
 /libffi/stamp*
+/libffi/package.conf.install
+/libffi/package.conf.install.raw
 /libraries/bin-package-db/GNUmakefile
 /libraries/bin-package-db/ghc.mk
 /libraries/bootstrapping.conf
@@ -185,6 +196,8 @@ configure
 /rts/package.conf.inplace.raw
 /rts/sm/Evac_thr.c
 /rts/sm/Scav_thr.c
+/rts/package.conf.install
+/rts/package.conf.install.raw
 /stage3.package.conf
 /testsuite_summary.txt
 /testlog
@@ -218,3 +231,4 @@ configure
 /utils/runghc/runhaskell
 /utils/runstdtest/runstdtest
 /utils/unlit/unlit
+
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index c151a26391..901b13b342 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -101,7 +101,7 @@ module CLabel (
         hasCAF,
 	infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
 	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
-        isMathFun,
+        isMathFun, isCas,
  	isCFunctionLabel, isGcPtrLabel, labelDynamic,
 
 	pprCLabel
@@ -590,9 +590,17 @@ maybeAsmTemp (AsmTempLabel uq) 		= Just uq
 maybeAsmTemp _ 	    	       		= Nothing
 
 
+-- | Check whether a label corresponds to our cas function.
+--      We #include the prototype for this, so we need to avoid
+--      generating out own C prototypes.
+isCas :: CLabel -> Bool
+isCas (CmmLabel pkgId fn _) = pkgId == rtsPackageId && fn == fsLit "cas"
+isCas _                     = False
+
+
 -- | Check whether a label corresponds to a C function that has 
 --      a prototype in a system header somehere, or is built-in
---      to the C compiler. For these labels we abovoid generating our
+--      to the C compiler. For these labels we avoid generating our
 --      own C prototypes.
 isMathFun :: CLabel -> Bool
 isMathFun (ForeignLabel fs _ _ _) 	= fs `elementOfUniqSet` math_funs
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 10f4e8bacf..d363cef50b 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -248,7 +248,7 @@ pprStmt stmt = case stmt of
                 | CmmNeverReturns <- ret ->
                     let myCall = pprCall (pprCLabel lbl) cconv results args safety
                     in (real_fun_proto lbl, myCall)
-                | not (isMathFun lbl) ->
+                | not (isMathFun lbl || isCas lbl) ->
                     let myCall = braces (
                                      pprCFunType (char '*' <> text "ghcFunPtr") cconv results args <> semi
                                   $$ text "ghcFunPtr" <+> equals <+> cast_fn <> semi
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index b28f3eba3f..0daa6befc4 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -365,6 +365,20 @@ addTickHsExpr (HsWrap w e) =
 		(return w)
 		(addTickHsExpr e)	-- explicitly no tick on inside
 
+addTickHsExpr (HsArrApp	 e1 e2 ty1 arr_ty lr) = 
+        liftM5 HsArrApp
+	       (addTickLHsExpr e1)
+	       (addTickLHsExpr e2)
+	       (return ty1)
+	       (return arr_ty)
+	       (return lr)
+
+addTickHsExpr (HsArrForm e fix cmdtop) = 
+        liftM3 HsArrForm
+	       (addTickLHsExpr e)
+	       (return fix)
+	       (mapM (liftL (addTickHsCmdTop)) cmdtop)
+
 addTickHsExpr e@(HsType _) = return e
 
 -- Others dhould never happen in expression content.
@@ -558,7 +572,7 @@ addTickHsCmd (HsLet binds c) =
 addTickHsCmd (HsDo cxt stmts last_exp srcloc) = do
         (stmts', last_exp') <- addTickLCmdStmts' stmts (addTickLHsCmd last_exp)
 	return (HsDo cxt stmts' last_exp' srcloc)
-  where
+
 addTickHsCmd (HsArrApp	 e1 e2 ty1 arr_ty lr) = 
         liftM5 HsArrApp
 	       (addTickLHsExpr e1)
diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index 11d1dcb080..1a1e935c48 100644
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -679,16 +679,12 @@ okInstDclSig (TypeSig _ _)   = False
 okInstDclSig (FixSig _)      = False
 okInstDclSig _ 	             = True
 
-sigForThisGroup :: NameSet -> LSig Name -> Bool
-sigForThisGroup ns sig
-  = case sigName sig of
-	Nothing -> False
-	Just n  -> n `elemNameSet` ns
-
 sigName :: LSig name -> Maybe name
+-- Used only in Haddock
 sigName (L _ sig) = sigNameNoLoc sig
 
 sigNameNoLoc :: Sig name -> Maybe name    
+-- Used only in Haddock
 sigNameNoLoc (TypeSig   n _)          = Just (unLoc n)
 sigNameNoLoc (SpecSig   n _ _)        = Just (unLoc n)
 sigNameNoLoc (InlineSig n _)          = Just (unLoc n)
diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs
index 661dc9afe4..b0c63a4c34 100644
--- a/compiler/llvmGen/LlvmCodeGen/Regs.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs
@@ -38,6 +38,8 @@ lmGlobalReg suf reg
         VanillaReg 4 _ -> wordGlobal $ "R4" ++ suf
         VanillaReg 5 _ -> wordGlobal $ "R5" ++ suf
         VanillaReg 6 _ -> wordGlobal $ "R6" ++ suf
+        VanillaReg 7 _ -> wordGlobal $ "R7" ++ suf
+        VanillaReg 8 _ -> wordGlobal $ "R8" ++ suf
         SpLim          -> wordGlobal $ "SpLim" ++ suf
         FloatReg 1     -> floatGlobal $"F1" ++ suf
         FloatReg 2     -> floatGlobal $"F2" ++ suf
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 54f0a92115..5767a52552 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -210,7 +210,6 @@ unregFlags :: [Located String]
 unregFlags = map (mkGeneralLocated "in unregFlags")
    [ "-optc-DNO_REGS"
    , "-optc-DUSE_MINIINTERPRETER"
-   , "-fno-asm-mangling"
    , "-funregisterised" ]
 
 -----------------------------------------------------------------------------
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 503953d4a0..4d8cf422ae 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -699,7 +699,7 @@ renameSig _ (SpecInstSig ty)
 -- {-# SPECIALISE #-} pragmas can refer to imported Ids
 -- so, in the top-level case (when mb_names is Nothing)
 -- we use lookupOccRn.  If there's both an imported and a local 'f'
--- then the SPECIALISE pragma is ambiguous, unlike alll other signatures
+-- then the SPECIALISE pragma is ambiguous, unlike all other signatures
 renameSig mb_names sig@(SpecSig v ty inl)
   = do	{ new_v <- case mb_names of
                      Just {} -> lookupSigOccRn mb_names sig v
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 97f4ab3938..c4ad95a333 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -12,7 +12,7 @@ module RnEnv (
 	lookupLocalDataTcNames, lookupSigOccRn,
 	lookupFixityRn, lookupTyFixityRn, 
 	lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
-	lookupSyntaxName, lookupSyntaxTable, 
+	lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
 	lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
 	getLookupOccRn, addUsedRdrNames,
 
@@ -754,6 +754,17 @@ We treat the orignal (standard) names as free-vars too, because the type checker
 checks the type of the user thing against the type of the standard thing.
 
 \begin{code}
+lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars)
+-- Different to lookupSyntaxName because in the non-rebindable
+-- case we desugar directly rather than calling an existing function
+-- Hence the (Maybe (SyntaxExpr Name)) return type
+lookupIfThenElse 
+  = do { rebind <- xoptM Opt_RebindableSyntax
+       ; if not rebind 
+         then return (Nothing, emptyFVs)
+         else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))
+                 ; return (Just (HsVar ite), unitFV ite) } }
+
 lookupSyntaxName :: Name 				-- The standard name
 	         -> RnM (SyntaxExpr Name, FreeVars)	-- Possibly a non-standard name
 lookupSyntaxName std_name
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 9bb955131d..d11249aea9 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -268,13 +268,10 @@ rnExpr (ExprWithTySig expr pty)
 
 rnExpr (HsIf _ p b1 b2)
   = do { (p', fvP) <- rnLExpr p
-    ; (b1', fvB1) <- rnLExpr b1
-    ; (b2', fvB2) <- rnLExpr b2
-    ; rebind <- xoptM Opt_RebindableSyntax
-    ; if not rebind
-       then return (HsIf Nothing p' b1' b2', plusFVs [fvP, fvB1, fvB2])
-       else do { c <- liftM HsVar (lookupOccRn (mkVarUnqual (fsLit "ifThenElse")))
-               ; return (HsIf (Just c) p' b1' b2', plusFVs [fvP, fvB1, fvB2]) }}
+       ; (b1', fvB1) <- rnLExpr b1
+       ; (b2', fvB2) <- rnLExpr b2
+       ; (mb_ite, fvITE) <- lookupIfThenElse
+       ; return (HsIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
 
 rnExpr (HsType a)
   = rnHsTypeFVs doc a	`thenM` \ (t, fvT) -> 
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 3a30f9b5a1..8462403813 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -25,7 +25,6 @@ import TcHsType
 import TcPat
 import TcMType
 import TcType
-import RnBinds( misplacedSigErr )
 import Coercion
 import TysPrim
 import Id
@@ -44,7 +43,6 @@ import BasicTypes
 import Outputable
 import FastString
 
-import Data.List( partition )
 import Control.Monad
 
 #include "HsVersions.h"
@@ -559,24 +557,16 @@ tcSpec _ prag = pprPanic "tcSpec" (ppr prag)
 tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag]
 tcImpPrags prags
   = do { this_mod <- getModule
-       ; let is_imp prag 
-               = case sigName prag of
-                   Nothing   -> False
-                   Just name -> not (nameIsLocalOrFrom this_mod name)
-             (spec_prags, others) = partition isSpecLSig $
-	     		  	    filter is_imp prags
-       ; mapM_ misplacedSigErr others 
-       -- Messy that this misplaced-sig error comes here
-       -- but the others come from the renamer
-       ; mapAndRecoverM (wrapLocM tcImpSpec) spec_prags }
-
-tcImpSpec :: Sig Name -> TcM TcSpecPrag
-tcImpSpec prag@(SpecSig (L _ name) _ _)
+       ; mapAndRecoverM (wrapLocM tcImpSpec) 
+         [L loc (name,prag) | (L loc prag@(SpecSig (L _ name) _ _)) <- prags
+                            , not (nameIsLocalOrFrom this_mod name) ] }
+
+tcImpSpec :: (Name, Sig Name) -> TcM TcSpecPrag
+tcImpSpec (name, prag)
  = do { id <- tcLookupId name
       ; checkTc (isAnyInlinePragma (idInlinePragma id))
                 (impSpecErr name)
       ; tcSpec id prag }
-tcImpSpec p = pprPanic "tcImpSpec" (ppr p)
 
 impSpecErr :: Name -> SDoc
 impSpecErr name
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 195eb994b6..72b99c5f70 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1282,7 +1282,7 @@ inferInstanceContexts oflag infer_specs
     gen_soln (DS { ds_loc = loc, ds_orig = orig, ds_tvs = tyvars 
 		 , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs })
       = setSrcSpan loc	$
-	addErrCtxt (derivInstCtxt clas inst_tys) $ 
+	addErrCtxt (derivInstCtxt the_pred) $ 
 	do {      -- Check for a bizarre corner case, when the derived instance decl should
 		  -- have form 	instance C a b => D (T a) where ...
 		  -- Note that 'b' isn't a parameter of T.  This gives rise to all sorts
@@ -1297,7 +1297,7 @@ inferInstanceContexts oflag infer_specs
                                      , not (tyVarsOfPred pred `subVarSet` tv_set)]
 	   ; mapM_ (addErrTc . badDerivedPred) weird_preds	
 
-           ; theta <- simplifyDeriv orig tyvars deriv_rhs
+           ; theta <- simplifyDeriv orig the_pred tyvars deriv_rhs
 	   	-- checkValidInstance tyvars theta clas inst_tys
 		-- Not necessary; see Note [Exotic derived instance contexts]
 		-- 		  in TcSimplify
@@ -1307,6 +1307,8 @@ inferInstanceContexts oflag infer_specs
 		-- Hence no need to call:
 		--   checkValidInstance tyvars theta clas inst_tys
 	   ; return (sortLe (<=) theta) }	-- Canonicalise before returning the solution
+      where
+        the_pred = mkClassPred clas inst_tys
 
 ------------------------------------------------------------------
 mkInstance :: OverlapFlag -> ThetaType -> DerivSpec -> Instance
@@ -1509,9 +1511,9 @@ standaloneCtxt :: LHsType Name -> SDoc
 standaloneCtxt ty = hang (ptext (sLit "In the stand-alone deriving instance for")) 
 		       2 (quotes (ppr ty))
 
-derivInstCtxt :: Class -> [Type] -> Message
-derivInstCtxt clas inst_tys
-  = ptext (sLit "When deriving the instance for") <+> parens (pprClassPred clas inst_tys)
+derivInstCtxt :: PredType -> Message
+derivInstCtxt pred
+  = ptext (sLit "When deriving the instance for") <+> parens (ppr pred)
 
 badDerivedPred :: PredType -> Message
 badDerivedPred pred
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 272199999b..b76b75cb7f 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -892,15 +892,15 @@ gen_Read_binds get_fixity loc tycon
     read_nullary_cons 
       = case nullary_cons of
     	    []    -> []
-    	    [con] -> [nlHsDo DoExpr [bindLex (match_con con)] (result_expr con [])]
+    	    [con] -> [nlHsDo DoExpr (match_con con) (result_expr con [])]
             _     -> [nlHsApp (nlHsVar choose_RDR) 
     		   	      (nlList (map mk_pair nullary_cons))]
         -- NB For operators the parens around (:=:) are matched by the
 	-- enclosing "parens" call, so here we must match the naked
 	-- data_con_str con
 
-    match_con con | isSym con_str = symbol_pat con_str
-                  | otherwise     = ident_pat  con_str
+    match_con con | isSym con_str = [symbol_pat con_str]
+                  | otherwise     = ident_h_pat  con_str
                   where
                     con_str = data_con_str con
 	-- For nullary constructors we must match Ident s for normal constrs
@@ -924,12 +924,12 @@ gen_Read_binds get_fixity loc tycon
 	prefix_parser = mk_parser prefix_prec prefix_stmts body
 
 	read_prefix_con
-	    | isSym con_str = [read_punc "(", bindLex (symbol_pat con_str), read_punc ")"]
-	    | otherwise     = [bindLex (ident_pat con_str)]
+	    | isSym con_str = [read_punc "(", symbol_pat con_str, read_punc ")"]
+	    | otherwise     = ident_h_pat con_str
      	 
 	read_infix_con
-	    | isSym con_str = [bindLex (symbol_pat con_str)]
-	    | otherwise     = [read_punc "`", bindLex (ident_pat con_str), read_punc "`"]
+	    | isSym con_str = [symbol_pat con_str]
+	    | otherwise     = [read_punc "`"] ++ ident_h_pat con_str ++ [read_punc "`"]
 
        	prefix_stmts		-- T a b c
        	  = read_prefix_con ++ read_args
@@ -971,8 +971,15 @@ gen_Read_binds get_fixity loc tycon
     result_expr con as = nlHsApp (nlHsVar returnM_RDR) (con_app con as)		-- return (con as)
     
     punc_pat s   = nlConPat punc_RDR   [nlLitPat (mkHsString s)]  -- Punc 'c'
-    ident_pat s  = nlConPat ident_RDR  [nlLitPat (mkHsString s)]  -- Ident "foo"
-    symbol_pat s = nlConPat symbol_RDR [nlLitPat (mkHsString s)]  -- Symbol ">>"
+
+    -- For constructors and field labels ending in '#', we hackily
+    -- let the lexer generate two tokens, and look for both in sequence
+    -- Thus [Ident "I"; Symbol "#"].  See Trac #5041
+    ident_h_pat s | Just (ss, '#') <- snocView s = [ ident_pat ss, symbol_pat "#" ]
+                  | otherwise                    = [ ident_pat s ]
+      		      		   
+    ident_pat  s = bindLex $ nlConPat ident_RDR  [nlLitPat (mkHsString s)]  -- Ident "foo" <- lexP
+    symbol_pat s = bindLex $ nlConPat symbol_RDR [nlLitPat (mkHsString s)]  -- Symbol ">>" <- lexP
     
     data_con_str con = occNameString (getOccName con)
     
@@ -990,11 +997,9 @@ gen_Read_binds get_fixity loc tycon
 	-- or	(#) = 4
 	-- Note the parens!
     read_lbl lbl | isSym lbl_str 
-		 = [read_punc "(", 
-		    bindLex (symbol_pat lbl_str),
-		    read_punc ")"]
+		 = [read_punc "(", symbol_pat lbl_str, read_punc ")"]
 		 | otherwise
-		 = [bindLex (ident_pat lbl_str)]
+		 = ident_h_pat lbl_str
 		 where	
 		   lbl_str = occNameString (getOccName lbl) 
 \end{code}
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 13c7377e00..b8919a77c5 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -105,7 +105,9 @@ import HsBinds               -- for TcEvBinds stuff
 import Id 
 
 import TcRnTypes
-
+#ifdef DEBUG
+import Control.Monad( when )
+#endif
 import Data.IORef
 \end{code}
 
@@ -423,17 +425,16 @@ type TcsUntouchables = (Untouchables,TcTyVarSet)
 
 \begin{code}
 data SimplContext
-  = SimplInfer		-- Inferring type of a let-bound thing
-  | SimplRuleLhs	-- Inferring type of a RULE lhs
-  | SimplInteractive	-- Inferring type at GHCi prompt
-  | SimplCheck		-- Checking a type signature or RULE rhs
-  deriving Eq
+  = SimplInfer SDoc	   -- Inferring type of a let-bound thing
+  | SimplRuleLhs RuleName  -- Inferring type of a RULE lhs
+  | SimplInteractive	   -- Inferring type at GHCi prompt
+  | SimplCheck SDoc	   -- Checking a type signature or RULE rhs
 
 instance Outputable SimplContext where
-  ppr SimplInfer       = ptext (sLit "SimplInfer")
-  ppr SimplRuleLhs     = ptext (sLit "SimplRuleLhs")
+  ppr (SimplInfer d)   = ptext (sLit "SimplInfer") <+> d
+  ppr (SimplCheck d)   = ptext (sLit "SimplCheck") <+> d
+  ppr (SimplRuleLhs n) = ptext (sLit "SimplRuleLhs") <+> doubleQuotes (ftext n)
   ppr SimplInteractive = ptext (sLit "SimplInteractive")
-  ppr SimplCheck       = ptext (sLit "SimplCheck")
 
 isInteractive :: SimplContext -> Bool
 isInteractive SimplInteractive = True
@@ -443,14 +444,14 @@ simplEqsOnly :: SimplContext -> Bool
 -- Simplify equalities only, not dictionaries
 -- This is used for the LHS of rules; ee
 -- Note [Simplifying RULE lhs constraints] in TcSimplify
-simplEqsOnly SimplRuleLhs = True
-simplEqsOnly _            = False
+simplEqsOnly (SimplRuleLhs {}) = True
+simplEqsOnly _                 = False
 
 performDefaulting :: SimplContext -> Bool
-performDefaulting SimplInfer   	   = False
-performDefaulting SimplRuleLhs 	   = False
-performDefaulting SimplInteractive = True
-performDefaulting SimplCheck       = True
+performDefaulting (SimplInfer {})   = False
+performDefaulting (SimplRuleLhs {}) = False
+performDefaulting SimplInteractive  = True
+performDefaulting (SimplCheck {})   = True
 
 ---------------
 newtype TcS a = TcS { unTcS :: TcSEnv -> TcM a } 
@@ -527,8 +528,9 @@ runTcS context untouch tcs
        ; mapM_ do_unification (varEnvElts ty_binds)
 
 #ifdef DEBUG
---       ; count <- TcM.readTcRef step_count
---       ; TcM.dumpTcRn (ptext (sLit "Constraint solver steps =") <+> int count)
+       ; count <- TcM.readTcRef step_count
+       ; when (count > 0) $
+         TcM.dumpTcRn (ptext (sLit "Constraint solver steps =") <+> int count <+> ppr context)
 #endif
              -- And return
        ; ev_binds      <- TcM.readTcRef evb_ref
@@ -565,8 +567,9 @@ recoverTcS (TcS recovery_code) (TcS thing_inside)
 
 ctxtUnderImplic :: SimplContext -> SimplContext
 -- See Note [Simplifying RULE lhs constraints] in TcSimplify
-ctxtUnderImplic SimplRuleLhs = SimplCheck
-ctxtUnderImplic ctxt         = ctxt
+ctxtUnderImplic (SimplRuleLhs n) = SimplCheck (ptext (sLit "lhs of rule") 
+                                               <+> doubleQuotes (ftext n))
+ctxtUnderImplic ctxt              = ctxt
 
 tryTcS :: TcS a -> TcS a
 -- Like runTcS, but from within the TcS monad 
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 0012b1ea5b..57ff63649a 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -51,7 +51,7 @@ simplifyTop :: WantedConstraints -> TcM (Bag EvBind)
 -- but when there is nothing to quantify we don't wrap
 -- in a degenerate implication, so we do that here instead
 simplifyTop wanteds 
-  = simplifyCheck SimplCheck wanteds
+  = simplifyCheck (SimplCheck (ptext (sLit "top level"))) wanteds
 
 ------------------
 simplifyInteractive :: WantedConstraints -> TcM (Bag EvBind)
@@ -63,7 +63,8 @@ simplifyDefault :: ThetaType	-- Wanted; has no type variables in it
                 -> TcM ()	-- Succeeds iff the constraint is soluble
 simplifyDefault theta
   = do { wanted <- newFlatWanteds DefaultOrigin theta
-       ; _ignored_ev_binds <- simplifyCheck SimplCheck (mkFlatWC wanted)
+       ; _ignored_ev_binds <- simplifyCheck (SimplCheck (ptext (sLit "defaults"))) 
+                                            (mkFlatWC wanted)
        ; return () }
 \end{code}
 
@@ -77,13 +78,14 @@ simplifyDefault theta
 
 \begin{code}
 simplifyDeriv :: CtOrigin
-		-> [TyVar]	
-		-> ThetaType		-- Wanted
-	        -> TcM ThetaType	-- Needed
+              -> PredType
+	      -> [TyVar]	
+	      -> ThetaType		-- Wanted
+	      -> TcM ThetaType	-- Needed
 -- Given  instance (wanted) => C inst_ty 
 -- Simplify 'wanted' as much as possibles
 -- Fail if not possible
-simplifyDeriv orig tvs theta 
+simplifyDeriv orig pred tvs theta 
   = do { tvs_skols <- tcInstSkolTyVars tvs -- Skolemize
       	 	-- The constraint solving machinery 
 		-- expects *TcTyVars* not TyVars.  
@@ -92,12 +94,13 @@ simplifyDeriv orig tvs theta
 
        ; let skol_subst = zipTopTvSubst tvs $ map mkTyVarTy tvs_skols
              subst_skol = zipTopTvSubst tvs_skols $ map mkTyVarTy tvs
+	     doc = parens $ ptext (sLit "deriving") <+> parens (ppr pred)
 
        ; wanted <- newFlatWanteds orig (substTheta skol_subst theta)
 
        ; traceTc "simplifyDeriv" (ppr tvs $$ ppr theta $$ ppr wanted)
        ; (residual_wanted, _binds)
-             <- runTcS SimplInfer NoUntouchables $
+             <- runTcS (SimplInfer doc) NoUntouchables $
                 solveWanteds emptyInert (mkFlatWC wanted)
 
        ; let (good, bad) = partitionBagWith get_good (wc_flat residual_wanted)
@@ -249,7 +252,7 @@ simplifyInfer top_lvl apply_mr name_taus wanteds
             -- Step 2 
        	    -- Now simplify the possibly-bound constraints
        ; (simpl_results, tc_binds0)
-           <- runTcS SimplInfer NoUntouchables $
+           <- runTcS (SimplInfer (ppr (map fst name_taus))) NoUntouchables $
               simplifyWithApprox (zonked_wanteds { wc_flat = perhaps_bound })
 
        ; when (insolubleWC simpl_results)  -- Fail fast if there is an insoluble constraint
@@ -549,7 +552,7 @@ simplifyRule name tv_bndrs lhs_wanted rhs_wanted
 		 -- variables; hence *no untouchables*
 
        ; (lhs_results, lhs_binds)
-              <- runTcS SimplRuleLhs untch $
+              <- runTcS (SimplRuleLhs name) untch $
                  solveWanteds emptyInert zonked_lhs
 
        ; traceTc "simplifyRule" $
@@ -591,7 +594,8 @@ simplifyRule name tv_bndrs lhs_wanted rhs_wanted
 
 	     -- Hence the rather painful ad-hoc treatement here
        ; rhs_binds_var@(EvBindsVar evb_ref _)  <- newTcEvBinds
-       ; rhs_binds1 <- simplifyCheck SimplCheck $
+       ; let doc = ptext (sLit "rhs of rule") <+> doubleQuotes (ftext name)
+       ; rhs_binds1 <- simplifyCheck (SimplCheck doc) $
             WC { wc_flat = emptyBag
                , wc_insol = emptyBag
                , wc_impl = unitBag $
diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs
index c95571245b..559ea659e1 100644
--- a/compiler/types/OptCoercion.lhs
+++ b/compiler/types/OptCoercion.lhs
@@ -100,10 +100,13 @@ opt_co env sym co
 

 opt_co' env _   (Refl ty)           = Refl (substTy env ty)

 opt_co' env sym (SymCo co)          = opt_co env (not sym) co

-opt_co' env sym (TyConAppCo tc cos) = TyConAppCo tc (map (opt_co env sym) cos)

+

+opt_co' env sym (TyConAppCo tc cos) = mkTyConAppCo tc (map (opt_co env sym) cos)

 opt_co' env sym (AppCo co1 co2)     = mkAppCo (opt_co env sym co1) (opt_co env sym co2)

 opt_co' env sym (ForAllCo tv co)    = case substTyVarBndr env tv of

-                                         (env', tv') -> ForAllCo tv' (opt_co env' sym co)

+                                         (env', tv') -> mkForAllCo tv' (opt_co env' sym co)

+     -- Use the "mk" functions to check for nested Refls

+

 opt_co' env sym (CoVarCo cv)

   | Just co <- lookupCoVar env cv

   = opt_co (zapCvSubstEnv env) sym co

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index c12f9c89db..71d1f8d506 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -556,9 +556,7 @@ instance Outputable name => OutputableBndr (IPName name) where
 	-- OK, here's the main printer
 
 ppr_type :: Prec -> Type -> SDoc
-ppr_type _ (TyVarTy tv)         -- Note [Infix type variables]
-  | isSymOcc (getOccName tv)  = parens (ppr tv)
-  | otherwise		      = ppr tv
+ppr_type _ (TyVarTy tv)	      = ppr_tvar tv
 ppr_type p (PredTy pred)      = maybeParen p TyConPrec $
                                 ifPprDebug (ptext (sLit "<pred>")) <> (pprPredTy pred)
 ppr_type p (TyConApp tc tys)  = pprTcApp p ppr_type tc tys
@@ -594,15 +592,19 @@ ppr_forall_type p ty
     split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty
     split2 ps ty		    = (reverse ps, ty)
 
--------------------
+ppr_tvar :: TyVar -> SDoc
+ppr_tvar tv  -- Note [Infix type variables]
+  | isSymOcc (getOccName tv)  = parens (ppr tv)
+  | otherwise		      = ppr tv
+
 pprForAll :: [TyVar] -> SDoc
 pprForAll []  = empty
 pprForAll tvs = ptext (sLit "forall") <+> sep (map pprTvBndr tvs) <> dot
 
 pprTvBndr :: TyVar -> SDoc
 pprTvBndr tv
-  | isLiftedTypeKind kind = ppr tv
-  | otherwise             = parens (ppr tv <+> dcolon <+> pprKind kind)
+  | isLiftedTypeKind kind = ppr_tvar tv
+  | otherwise             = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
   where
     kind = tyVarKind tv
 \end{code}
diff --git a/ghc/ghc.mk b/ghc/ghc.mk
index 8776566106..93199d9e68 100644
--- a/ghc/ghc.mk
+++ b/ghc/ghc.mk
@@ -111,21 +111,23 @@ all_ghc_stage3 : $(GHC_STAGE3)
 $(INPLACE_LIB)/extra-gcc-opts : extra-gcc-opts
 	"$(CP)" $< $@
 
-# The GHC programs need to depend on all the helper programs they might call
+# The GHC programs need to depend on all the helper programs they might call,
+# and the settings files they use
+
+$(GHC_STAGE1) : | $(UNLIT) $(INPLACE_LIB)/extra-gcc-opts
+$(GHC_STAGE2) : | $(UNLIT) $(INPLACE_LIB)/extra-gcc-opts
+$(GHC_STAGE3) : | $(UNLIT) $(INPLACE_LIB)/extra-gcc-opts
+
 ifeq "$(GhcUnregisterised)" "NO"
-$(GHC_STAGE1) : $(SPLIT)
-$(GHC_STAGE2) : $(SPLIT)
-$(GHC_STAGE3) : $(SPLIT)
+$(GHC_STAGE1) : | $(SPLIT)
+$(GHC_STAGE2) : | $(SPLIT)
+$(GHC_STAGE3) : | $(SPLIT)
 endif
 
-$(GHC_STAGE1) : $(INPLACE_LIB)/extra-gcc-opts
-$(GHC_STAGE2) : $(INPLACE_LIB)/extra-gcc-opts
-$(GHC_STAGE3) : $(INPLACE_LIB)/extra-gcc-opts
-
 ifeq "$(Windows)" "YES"
-$(GHC_STAGE1) : $(TOUCHY)
-$(GHC_STAGE2) : $(TOUCHY)
-$(GHC_STAGE3) : $(TOUCHY)
+$(GHC_STAGE1) : | $(TOUCHY)
+$(GHC_STAGE2) : | $(TOUCHY)
+$(GHC_STAGE3) : | $(TOUCHY)
 endif
 
 ifeq "$(BootingFromHc)" "YES"