Merge remote-tracking branch 'origin/master' into type-nats

48 files changed, 398 insertions, 258 deletions

diff --git a/aclocal.m4 b/aclocal.m4
index 6d80ad3759..5652185b5e 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -363,12 +363,18 @@ AC_DEFUN([FP_SETTINGS],
 [
     if test "$windows" = YES
     then
-        SettingsCCompilerCommand='$topdir/../mingw/bin/gcc.exe'
+        if test "$HostArch" = "x86_64"
+        then
+            mingw_bin_prefix=x86_64-w64-mingw32-
+        else
+            mingw_bin_prefix=
+        fi
+        SettingsCCompilerCommand="\$topdir/../mingw/bin/${mingw_bin_prefix}gcc.exe"
         SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2 $CONF_GCC_LINKER_OPTS_STAGE2"
-        SettingsArCommand='$topdir/../mingw/bin/ar.exe'
+        SettingsArCommand="\$topdir/../mingw/bin/${mingw_bin_prefix}ar.exe"
         SettingsPerlCommand='$topdir/../perl/perl.exe'
-        SettingsDllWrapCommand='$topdir/../mingw/bin/dllwrap.exe'
-        SettingsWindresCommand='$topdir/../mingw/bin/windres.exe'
+        SettingsDllWrapCommand="\$topdir/../mingw/bin/${mingw_bin_prefix}dllwrap.exe"
+        SettingsWindresCommand="\$topdir/../mingw/bin/${mingw_bin_prefix}windres.exe"
         SettingsTouchCommand='$topdir/touchy.exe'
     else
         SettingsCCompilerCommand="$WhatGccIsCalled"
@@ -686,7 +692,8 @@ case $HostPlatform in
   esac ;;
 alpha-dec-osf*) fptools_cv_leading_underscore=no;;
 *cygwin32) fptools_cv_leading_underscore=yes;;
-*mingw32) fptools_cv_leading_underscore=yes;;
+i386-unknown-mingw32) fptools_cv_leading_underscore=yes;;
+x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;;
 
     # HACK: Apple doesn't seem to provide nlist in the 64-bit-libraries
 x86_64-apple-darwin*) fptools_cv_leading_underscore=yes;;
@@ -776,9 +783,9 @@ dnl
 AC_DEFUN([FPTOOLS_HAPPY],
 [AC_PATH_PROG(HappyCmd,happy,)
 # Happy is passed to Cabal, so we need a native path
-if test "x$HostPlatform"  = "xi386-unknown-mingw32" && \
-   test "${OSTYPE}"      != "msys"                  && \
-   test "${HappyCmd}"    != ""
+if test "$HostOS"      = "mingw32" && \
+   test "${OSTYPE}"   != "msys"    && \
+   test "${HappyCmd}" != ""
 then
     # Canonicalise to <drive>:/path/to/gcc
     HappyCmd=`cygpath -m "${HappyCmd}"`
@@ -812,9 +819,9 @@ AC_DEFUN([FPTOOLS_ALEX],
 [
 AC_PATH_PROG(AlexCmd,alex,)
 # Alex is passed to Cabal, so we need a native path
-if test "x$HostPlatform"  = "xi386-unknown-mingw32" && \
-   test "${OSTYPE}"      != "msys"                  && \
-   test "${AlexCmd}"     != ""
+if test "$HostOS"     = "mingw32" && \
+   test "${OSTYPE}"  != "msys"    && \
+   test "${AlexCmd}" != ""
 then
     # Canonicalise to <drive>:/path/to/gcc
     AlexCmd=`cygpath -m "${AlexCmd}"`
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 9da00590c2..346b108fa4 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -1107,10 +1107,11 @@ pprHexVal w rep
         -- times values are unsigned.  This also helps eliminate occasional
         -- warnings about integer overflow from gcc.
 
-        -- on 32-bit platforms, add "ULL" to 64-bit literals
-      repsuffix W64 | wORD_SIZE == 4 = ptext (sLit "ULL")
-        -- on 64-bit platforms with 32-bit int, add "L" to 64-bit literals
-      repsuffix W64 | cINT_SIZE == 4 = ptext (sLit "UL")
+      repsuffix W64
+       | cINT_SIZE       == 8 = char 'U'
+       | cLONG_SIZE      == 8 = ptext (sLit "UL")
+       | cLONG_LONG_SIZE == 8 = ptext (sLit "ULL")
+       | otherwise            = panic "pprHexVal: Can't find a 64-bit type"
       repsuffix _ = char 'U'
 
       go 0 = empty
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index ed288096f7..7f107137b6 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -870,10 +870,12 @@ get to a partial application:
 \begin{code}
 tryEtaReducePrep :: [CoreBndr] -> CoreExpr -> Maybe CoreExpr
 tryEtaReducePrep bndrs expr@(App _ _)
-  | ok_to_eta_reduce f &&
-    n_remaining >= 0 &&
-    and (zipWith ok bndrs last_args) &&
-    not (any (`elemVarSet` fvs_remaining) bndrs)
+  | ok_to_eta_reduce f
+  , n_remaining >= 0
+  , and (zipWith ok bndrs last_args)
+  , not (any (`elemVarSet` fvs_remaining) bndrs)
+  , exprIsHNF remaining_expr   -- Don't turn value into a non-value
+                               -- else the behaviour with 'seq' changes
   = Just remaining_expr
   where
     (f, args) = collectArgs expr
@@ -885,9 +887,9 @@ tryEtaReducePrep bndrs expr@(App _ _)
     ok bndr (Var arg) = bndr == arg
     ok _    _         = False
 
-	  -- we can't eta reduce something which must be saturated.
+	  -- We can't eta reduce something which must be saturated.
     ok_to_eta_reduce (Var f) = not (hasNoBinding f)
-    ok_to_eta_reduce _       = False --safe. ToDo: generalise
+    ok_to_eta_reduce _       = False -- Safe. ToDo: generalise
 
 tryEtaReducePrep bndrs (Let bind@(NonRec _ r) body)
   | not (any (`elemVarSet` fvs) bndrs)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index bef7b5da8d..2b72a923dd 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -124,16 +124,16 @@ repTopDs group
 	--	     return (Data t [] ...more t's... }
 	-- The other important reason is that the output must mention
 	-- only "T", not "Foo:T" where Foo is the current module
-
 	
 	decls <- addBinds ss (do {
+                        fix_ds  <- mapM repFixD (hs_fixds group) ;
 			val_ds  <- rep_val_binds (hs_valds group) ;
 			tycl_ds <- mapM repTyClD (concat (hs_tyclds group)) ;
 			inst_ds <- mapM repInstD (hs_instds group) ;
 			for_ds <- mapM repForD (hs_fords group) ;
 			-- more needed
 			return (de_loc $ sort_by_loc $ 
-                                val_ds ++ catMaybes tycl_ds
+                                val_ds ++ catMaybes tycl_ds ++ fix_ds
                                        ++ catMaybes inst_ds ++ for_ds) }) ;
 
 	decl_ty <- lookupType decQTyConName ;
@@ -175,15 +175,16 @@ repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 repTyClD tydecl@(L _ (TyFamily {}))
   = repTyFamily tydecl addTyVarBinds
 
-repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt, 
+repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt, tcdKindSig = mb_kind,
 		          tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
 		          tcdCons = cons, tcdDerivs = mb_derivs }))
   = do { tc1 <- lookupLOcc tc 		-- See note [Binders and occurrences] 
-       ; dec <- addTyVarBinds tvs $ \bndrs -> 
+       ; tc_tvs <- mk_extra_tvs tvs mb_kind
+       ; dec <- addTyVarBinds tc_tvs $ \bndrs -> 
            do { cxt1     <- repLContext cxt
               ; opt_tys1 <- maybeMapM repLTys opt_tys   -- only for family insts
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
-              ; cons1    <- mapM (repC (hsLTyVarNames tvs)) cons
+              ; cons1    <- mapM (repC (hsLTyVarNames tc_tvs)) cons
       	      ; cons2    <- coreList conQTyConName cons1
       	      ; derivs1  <- repDerivs mb_derivs
 	      ; bndrs1   <- coreList tyVarBndrTyConName bndrs
@@ -192,15 +193,16 @@ repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
        ; return $ Just (loc, dec) 
        }
 
-repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt, 
+repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt, tcdKindSig = mb_kind,
 		          tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
 		          tcdCons = [con], tcdDerivs = mb_derivs }))
   = do { tc1 <- lookupLOcc tc 		-- See note [Binders and occurrences] 
-       ; dec <- addTyVarBinds tvs $ \bndrs -> 
+       ; tc_tvs <- mk_extra_tvs tvs mb_kind
+       ; dec <- addTyVarBinds tc_tvs $ \bndrs -> 
            do { cxt1     <- repLContext cxt
               ; opt_tys1 <- maybeMapM repLTys opt_tys   -- only for family insts
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
-              ; con1     <- repC (hsLTyVarNames tvs) con
+              ; con1     <- repC (hsLTyVarNames tc_tvs) con
       	      ; derivs1  <- repDerivs mb_derivs
 	      ; bndrs1   <- coreList tyVarBndrTyConName bndrs
       	      ; repNewtype cxt1 tc1 bndrs1 opt_tys2 con1 derivs1
@@ -244,6 +246,35 @@ repTyClD (L loc d) = putSrcSpanDs loc $
 		     do { warnDs (hang ds_msg 4 (ppr d))
 			; return Nothing }
 
+-------------------------
+mk_extra_tvs :: [LHsTyVarBndr Name] -> Maybe (HsBndrSig (LHsKind Name)) -> DsM [LHsTyVarBndr Name]
+-- If there is a kind signature it must be of form
+--    k1 -> .. -> kn -> *
+-- Return type variables [tv1:k1, tv2:k2, .., tvn:kn]
+mk_extra_tvs tvs Nothing 
+  = return tvs
+mk_extra_tvs tvs (Just (HsBSig hs_kind _))
+  = do { extra_tvs <- go hs_kind
+       ; return (tvs ++ extra_tvs) }
+  where
+    go :: LHsKind Name -> DsM [LHsTyVarBndr Name]
+    go (L loc (HsFunTy kind rest))
+      = do { uniq <- newUnique
+           ; let { occ = mkTyVarOccFS (fsLit "t")
+                 ; nm = mkInternalName uniq occ loc
+                 ; hs_tv = L loc (KindedTyVar nm (HsBSig kind placeHolderBndrs)) }
+           ; hs_tvs <- go rest
+           ; return (hs_tv : hs_tvs) }
+
+    go (L _ (HsTyVar n))
+      | n == liftedTypeKindTyConName
+      = return []
+   
+    go _ = failWithDs (hang (ptext (sLit "Malformed kind signature"))
+                          2 (ppr hs_kind))
+
+
+-------------------------
 -- The type variables in the head of families are treated differently when the
 -- family declaration is associated.  In that case, they are usage, not binding
 -- occurences.
@@ -261,9 +292,9 @@ repTyFamily (L loc (TyFamily { tcdFlavour = flavour,
 	      ; bndrs1 <- coreList tyVarBndrTyConName bndrs
               ; case opt_kind of 
                   Nothing -> repFamilyNoKind flav tc1 bndrs1
-                  Just ki -> do { ki1 <- repKind ki 
-                                ; repFamilyKind flav tc1 bndrs1 ki1
-                                }
+                  Just (HsBSig ki _) 
+                    -> do { ki1 <- repKind ki 
+                          ; repFamilyKind flav tc1 bndrs1 ki1 }
               }
        ; return $ Just (loc, dec)
        }
@@ -314,7 +345,7 @@ repInstD (L loc (FamInstDecl fi_decl))
   = repTyClD (L loc fi_decl)
 
 
-repInstD (L loc (ClsInstDecl ty binds _ ats))	-- Ignore user pragmas for now
+repInstD (L loc (ClsInstDecl ty binds prags ats))
   = do { dec <- addTyVarBinds tvs $ \_ ->
 	    -- We must bring the type variables into scope, so their
 	    -- occurrences don't fail, even though the binders don't 
@@ -330,8 +361,9 @@ repInstD (L loc (ClsInstDecl ty binds _ ats))	-- Ignore user pragmas for now
                ; cls_tys <- repLTys tys
                ; inst_ty1 <- repTapps cls_tcon cls_tys
                ; binds1 <- rep_binds binds
+               ; prags1 <- rep_sigs prags
                ; ats1 <- repLAssocFamInst ats
-               ; decls <- coreList decQTyConName (ats1 ++ binds1)
+               ; decls <- coreList decQTyConName (ats1 ++ binds1 ++ prags1)
                ; repInst cxt1 inst_ty1 decls }
        ; return (Just (loc, dec)) }
  where
@@ -371,6 +403,17 @@ repSafety PlayRisky = rep2 unsafeName []
 repSafety PlayInterruptible = rep2 interruptibleName []
 repSafety PlaySafe = rep2 safeName []
 
+repFixD :: LFixitySig Name -> DsM (SrcSpan, Core TH.DecQ)
+repFixD (L loc (FixitySig name (Fixity prec dir)))
+  = do { MkC name' <- lookupLOcc name
+       ; MkC prec' <- coreIntLit prec
+       ; let rep_fn = case dir of 
+                        InfixL -> infixLDName
+                        InfixR -> infixRDName
+                        InfixN -> infixNDName
+       ; dec <- rep2 rep_fn [prec', name']
+       ; return (loc, dec) }
+
 ds_msg :: SDoc
 ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
 
@@ -426,7 +469,7 @@ mkGadtCtxt data_tvs (ResTyGADT res_ty)
   = return (go [] [] (data_tvs `zip` tys))
 
   | otherwise 
-  = failWithDs (ptext (sLit "Malformed constructor result type") <+> ppr res_ty)
+  = failWithDs (ptext (sLit "Malformed constructor result type:") <+> ppr res_ty)
   where
     go cxt subst [] = (cxt, subst)
     go cxt subst ((data_tv, ty) : rest)
@@ -607,7 +650,7 @@ repTyVarBndrWithKind :: LHsTyVarBndr Name
                      -> Core TH.Name -> DsM (Core TH.TyVarBndr)
 repTyVarBndrWithKind (L _ (UserTyVar {})) nm
   = repPlainTV nm
-repTyVarBndrWithKind (L _ (KindedTyVar _ (HsBSig ki _) _)) nm
+repTyVarBndrWithKind (L _ (KindedTyVar _ (HsBSig ki _))) nm
   = repKind ki >>= repKindedTV nm
 
 -- represent a type context
@@ -1767,7 +1810,7 @@ templateHaskellNames = [
     classDName, instanceDName, sigDName, forImpDName, 
     pragInlDName, pragSpecDName, pragSpecInlDName,
     familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
-    tySynInstDName, 
+    tySynInstDName, infixLDName, infixRDName, infixNDName,
     -- Cxt
     cxtName,
     -- Pred
@@ -1963,7 +2006,8 @@ parSName    = libFun (fsLit "parS")    parSIdKey
 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
     instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
     pragSpecInlDName, familyNoKindDName, familyKindDName, dataInstDName,
-    newtypeInstDName, tySynInstDName :: Name
+    newtypeInstDName, tySynInstDName, 
+    infixLDName, infixRDName, infixNDName :: Name
 funDName         = libFun (fsLit "funD")         funDIdKey
 valDName         = libFun (fsLit "valD")         valDIdKey
 dataDName        = libFun (fsLit "dataD")        dataDIdKey
@@ -1981,6 +2025,9 @@ familyKindDName  = libFun (fsLit "familyKindD")  familyKindDIdKey
 dataInstDName    = libFun (fsLit "dataInstD")    dataInstDIdKey
 newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
 tySynInstDName   = libFun (fsLit "tySynInstD")   tySynInstDIdKey
+infixLDName      = libFun (fsLit "infixLD")      infixLDIdKey
+infixRDName      = libFun (fsLit "infixRD")      infixRDIdKey
+infixNDName      = libFun (fsLit "infixND")      infixNDIdKey
 
 -- type Ctxt = ...
 cxtName :: Name
@@ -2245,7 +2292,8 @@ parSIdKey        = mkPreludeMiscIdUnique 323
 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
     classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
     pragSpecDIdKey, pragSpecInlDIdKey, familyNoKindDIdKey, familyKindDIdKey,
-    dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey :: Unique 
+    dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey, 
+    infixLDIdKey, infixRDIdKey, infixNDIdKey :: Unique 
 funDIdKey          = mkPreludeMiscIdUnique 330
 valDIdKey          = mkPreludeMiscIdUnique 331
 dataDIdKey         = mkPreludeMiscIdUnique 332
@@ -2263,6 +2311,9 @@ familyKindDIdKey   = mkPreludeMiscIdUnique 343
 dataInstDIdKey     = mkPreludeMiscIdUnique 344
 newtypeInstDIdKey  = mkPreludeMiscIdUnique 345
 tySynInstDIdKey    = mkPreludeMiscIdUnique 346
+infixLDIdKey       = mkPreludeMiscIdUnique 347
+infixRDIdKey       = mkPreludeMiscIdUnique 348
+infixNDIdKey       = mkPreludeMiscIdUnique 349
 
 -- type Cxt = ...
 cxtIdKey :: Unique
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 014094c1d5..b4b3c0e924 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -405,8 +405,9 @@ endif
 endif
 
 ifeq "$(compiler_stage1_VERSION_MUNGED)" "YES"
+compiler_stage1_MUNGED_VERSION = $(subst .$(ProjectPatchLevel),,$(ProjectVersion))
 define compiler_PACKAGE_MAGIC
-compiler_stage1_VERSION = $(subst .$(ProjectPatchLevel),,$(ProjectVersion))
+compiler_stage1_VERSION = $(compiler_stage1_MUNGED_VERSION)
 endef
 
 # Don't register the non-munged package
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 0072abc13e..b0cd2f4340 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -154,6 +154,10 @@ cvtDec (TH.SigD nm typ)
 	; ty' <- cvtType typ
 	; returnL $ Hs.SigD (TypeSig [nm'] ty') }
 
+cvtDec (TH.InfixD fx nm)
+  = do { nm' <- vNameL nm
+       ; returnL (Hs.SigD (FixSig (FixitySig nm' (cvtFixity fx)))) } 
+
 cvtDec (PragmaD prag)
   = do { prag' <- cvtPragmaD prag
        ; returnL $ Hs.SigD prag' }
@@ -250,7 +254,7 @@ cvt_ci_decs :: MsgDoc -> [TH.Dec]
 -- ie signatures, bindings, and associated types
 cvt_ci_decs doc decs
   = do  { decs' <- mapM cvtDec decs
-        ; let (ats', bind_sig_decs') = partitionWith is_tycl decs'
+        ; let (ats', bind_sig_decs') = partitionWith is_fam_inst decs'
 	; let (sigs', prob_binds') = partitionWith is_sig bind_sig_decs'
 	; let (binds', bads) = partitionWith is_bind prob_binds'
 	; unless (null bads) (failWith (mkBadDecMsg doc bads))
@@ -303,9 +307,9 @@ cvt_tyinst_hdr cxt tc tys
 --		Partitioning declarations
 -------------------------------------------------------------------
 
-is_tycl :: LHsDecl RdrName -> Either (LTyClDecl RdrName) (LHsDecl RdrName)
-is_tycl (L loc (Hs.TyClD tcd)) = Left (L loc tcd)
-is_tycl decl                   = Right decl
+is_fam_inst :: LHsDecl RdrName -> Either (LTyClDecl RdrName) (LHsDecl RdrName)
+is_fam_inst (L loc (Hs.InstD (FamInstDecl d))) = Left (L loc d)
+is_fam_inst decl                               = Right decl
 
 is_sig :: LHsDecl RdrName -> Either (LSig RdrName) (LHsDecl RdrName)
 is_sig (L loc (Hs.SigD sig)) = Left (L loc sig)
@@ -792,12 +796,11 @@ cvtTvs tvs = mapM cvt_tv tvs
 cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr RdrName)
 cvt_tv (TH.PlainTV nm) 
   = do { nm' <- tName nm
-       ; returnL $ UserTyVar nm' placeHolderKind
-       }
+       ; returnL $ UserTyVar nm' }
 cvt_tv (TH.KindedTV nm ki) 
   = do { nm' <- tName nm
        ; ki' <- cvtKind ki
-       ; returnL $ KindedTyVar nm' (HsBSig ki' placeHolderBndrs) placeHolderKind }
+       ; returnL $ KindedTyVar nm' (HsBSig ki' placeHolderBndrs) }
 
 cvtContext :: TH.Cxt -> CvtM (LHsContext RdrName)
 cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }
@@ -878,9 +881,18 @@ cvtKind (ArrowK k1 k2) = do
   k2' <- cvtKind k2
   returnL (HsFunTy k1' k2')
 
-cvtMaybeKind :: Maybe TH.Kind -> CvtM (Maybe (LHsKind RdrName))
+cvtMaybeKind :: Maybe TH.Kind -> CvtM (Maybe (HsBndrSig (LHsKind RdrName)))
 cvtMaybeKind Nothing = return Nothing
-cvtMaybeKind (Just ki) = cvtKind ki >>= return . Just
+cvtMaybeKind (Just ki) = do { ki' <- cvtKind ki
+                            ; return (Just (HsBSig ki' placeHolderBndrs)) }
+
+-----------------------------------------------------------
+cvtFixity :: TH.Fixity -> Hs.Fixity
+cvtFixity (TH.Fixity prec dir) = Hs.Fixity prec (cvt_dir dir)
+   where
+     cvt_dir TH.InfixL = Hs.InfixL
+     cvt_dir TH.InfixR = Hs.InfixR
+     cvt_dir TH.InfixN = Hs.InfixN
 
 -----------------------------------------------------------
 
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 26d49f726c..d3231696fa 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -452,7 +452,7 @@ data TyClDecl name
     TyFamily {  tcdFlavour :: FamilyFlavour,             -- type or data
                 tcdLName   :: Located name,              -- type constructor
                 tcdTyVars  :: [LHsTyVarBndr name],       -- type variables
-                tcdKindSig :: Maybe (LHsKind name)       -- result kind
+                tcdKindSig :: Maybe (HsBndrSig (LHsKind name))  -- result kind
     }
 
 
@@ -470,7 +470,7 @@ data TyClDecl name
                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns.
                   -- See Note [tcdTyVars and tcdTyPats] 
 
-                tcdKindSig:: Maybe (LHsKind name),
+                tcdKindSig:: Maybe (HsBndrSig (LHsKind name)),
                         -- ^ Optional kind signature.
                         --
                         -- @(Just k)@ for a GADT-style @data@, or @data
@@ -667,7 +667,7 @@ instance OutputableBndr name
                   derivings
       where
         ppr_sigx Nothing     = empty
-        ppr_sigx (Just kind) = dcolon <+> ppr kind
+        ppr_sigx (Just (HsBSig kind _)) = dcolon <+> ppr kind
 
     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
                     tcdFDs  = fds,
diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index 39181f7eb1..9e8d27bde0 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -31,7 +31,6 @@ module HsTypes (
 	
 	mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
 	hsTyVarName, hsTyVarNames, 
-	hsTyVarKind, hsLTyVarKind, hsTyVarNameKind,
 	hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
 	splitHsInstDeclTy_maybe, splitLHsInstDeclTy_maybe,
         splitHsForAllTy, splitLHsForAllTy,
@@ -144,12 +143,10 @@ placeHolderBndrs = panic "placeHolderBndrs"
 data HsTyVarBndr name
   = UserTyVar		-- No explicit kinding
          name 		-- See Note [Printing KindedTyVars]
-         PostTcKind
 
   | KindedTyVar
          name
          (HsBndrSig (LHsKind name))   -- The user-supplied kind signature
-         PostTcKind
       --  *** NOTA BENE *** A "monotype" in a pragma can have
       -- for-alls in it, (mostly to do with dictionaries).  These
       -- must be explicitly Kinded.
@@ -383,19 +380,8 @@ hsExplicitTvs _                                   = []
 
 ---------------------
 hsTyVarName :: HsTyVarBndr name -> name
-hsTyVarName (UserTyVar n _)   = n
-hsTyVarName (KindedTyVar n _ _) = n
-
-hsTyVarKind :: HsTyVarBndr name -> Kind
-hsTyVarKind (UserTyVar _ k)   = k
-hsTyVarKind (KindedTyVar _ _ k) = k
-
-hsLTyVarKind :: LHsTyVarBndr name -> Kind
-hsLTyVarKind  = hsTyVarKind . unLoc
-
-hsTyVarNameKind :: HsTyVarBndr name -> (name, Kind)
-hsTyVarNameKind (UserTyVar n k)   = (n,k)
-hsTyVarNameKind (KindedTyVar n _ k) = (n,k)
+hsTyVarName (UserTyVar n)     = n
+hsTyVarName (KindedTyVar n _) = n
 
 hsLTyVarName :: LHsTyVarBndr name -> name
 hsLTyVarName = hsTyVarName . unLoc
@@ -505,8 +491,8 @@ instance (Outputable sig) => Outputable (HsBndrSig sig) where
     ppr (HsBSig ty _) = ppr ty
 
 instance (OutputableBndr name) => Outputable (HsTyVarBndr name) where
-    ppr (UserTyVar name _)      = ppr name
-    ppr (KindedTyVar name kind _) = parens $ hsep [ppr name, dcolon, ppr kind]
+    ppr (UserTyVar name)        = ppr name
+    ppr (KindedTyVar name kind) = parens $ hsep [ppr name, dcolon, ppr kind]
 
 pprHsForAll :: OutputableBndr name => HsExplicitFlag -> [LHsTyVarBndr name] ->  LHsContext name -> SDoc
 pprHsForAll exp tvs cxt 
diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index f7a1a10a5b..729532da2a 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -268,7 +268,7 @@ mkHsString s = HsString (mkFastString s)
 
 -------------
 userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)]
-userHsTyVarBndrs bndrs = [ L loc (UserTyVar v placeHolderKind) | L loc v <- bndrs ]
+userHsTyVarBndrs bndrs = [ L loc (UserTyVar v) | L loc v <- bndrs ]
 \end{code}
 
 
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 0dd90f5337..38cada8185 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -726,9 +726,9 @@ data_or_newtype :: { Located NewOrData }
         : 'data'        { L1 DataType }
         | 'newtype'     { L1 NewType }
 
-opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
+opt_kind_sig :: { Located (Maybe (HsBndrSig (LHsKind RdrName))) }
         :                               { noLoc Nothing }
-        | '::' kind                     { LL (Just $2) }
+        | '::' kind                     { LL (Just (HsBSig $2 placeHolderBndrs)) }
 
 -- tycl_hdr parses the header of a class or data type decl,
 -- which takes the form
@@ -1107,8 +1107,8 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] }
          | {- empty -}                  { [] }
 
 tv_bndr :: { LHsTyVarBndr RdrName }
-        : tyvar                         { L1 (UserTyVar (unLoc $1) placeHolderKind) }
-        | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) (HsBSig $4 placeHolderBndrs) placeHolderKind) }
+        : tyvar                         { L1 (UserTyVar (unLoc $1)) }
+        | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) (HsBSig $4 placeHolderBndrs)) }
 
 fds :: { Located [Located (FunDep RdrName)] }
         : {- empty -}                   { noLoc [] }
diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index 872bcdefc0..4311c2522d 100644
--- a/compiler/parser/ParserCore.y
+++ b/compiler/parser/ParserCore.y
@@ -375,7 +375,7 @@ ifaceUnliftedTypeKind = ifaceTcType (IfaceTc unliftedTypeKindTyConName)
 ifaceArrow ifT1 ifT2 = IfaceFunTy ifT1 ifT2
 
 toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName
-toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOccFS tv)) bsig placeHolderKind
+toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOccFS tv)) bsig
                   where
                     bsig = HsBSig (toHsKind k) placeHolderBndrs
 
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 1bb7695b7d..a847f55d19 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -203,7 +203,7 @@ mkTyData :: SrcSpan
          -> Bool                -- True <=> data family instance
          -> Maybe CType
          -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
-         -> Maybe (LHsKind RdrName)
+         -> Maybe (HsBndrSig (LHsKind RdrName))
          -> [LConDecl RdrName]
          -> Maybe [LHsType RdrName]
          -> P (LTyClDecl RdrName)
@@ -217,7 +217,8 @@ mkTyData loc new_or_data is_family cType (L _ (mcxt, tycl_hdr)) ksig data_cons m
                                  tcdCtxt = cxt, tcdLName = tc,
                                  tcdTyVars = tyvars, tcdTyPats = typats,
                                  tcdCons = data_cons,
-                                 tcdKindSig = ksig, tcdDerivs = maybe_deriv })) }
+                                 tcdKindSig = ksig,
+                                 tcdDerivs = maybe_deriv })) }
 
 mkTySynonym :: SrcSpan
             -> Bool             -- True <=> type family instances
@@ -234,7 +235,7 @@ mkTySynonym loc is_family lhs rhs
 mkTyFamily :: SrcSpan
            -> FamilyFlavour
            -> LHsType RdrName   -- LHS
-           -> Maybe (LHsKind RdrName) -- Optional kind signature
+           -> Maybe (HsBndrSig (LHsKind RdrName)) -- Optional kind signature
            -> P (LTyClDecl RdrName)
 mkTyFamily loc flavour lhs ksig
   = do { (tc, tparams) <- checkTyClHdr lhs
@@ -523,9 +524,9 @@ checkTyVars tycl_hdr tparms = mapM chk tparms
   where
         -- Check that the name space is correct!
     chk (L l (HsKindSig (L _ (HsTyVar tv)) k))
-        | isRdrTyVar tv    = return (L l (KindedTyVar tv (HsBSig k placeHolderBndrs) placeHolderKind))
+        | isRdrTyVar tv    = return (L l (KindedTyVar tv (HsBSig k placeHolderBndrs)))
     chk (L l (HsTyVar tv))
-        | isRdrTyVar tv    = return (L l (UserTyVar tv placeHolderKind))
+        | isRdrTyVar tv    = return (L l (UserTyVar tv))
     chk t@(L l _)
         = parseErrorSDoc l $
           vcat [ sep [ ptext (sLit "Unexpected type") <+> quotes (ppr t)
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 734eee3dad..cff6e322f6 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -106,12 +106,13 @@ rnLHsType = rnLHsTyKi True
 rnLHsKind  :: HsDocContext -> LHsKind RdrName -> RnM (LHsKind Name, FreeVars)
 rnLHsKind = rnLHsTyKi False
 
-rnLHsMaybeKind  :: HsDocContext -> Maybe (LHsKind RdrName) 
-                -> RnM (Maybe (LHsKind Name), FreeVars)
-rnLHsMaybeKind _ Nothing = return (Nothing, emptyFVs)
-rnLHsMaybeKind doc (Just k) 
-  = do { (k', fvs) <- rnLHsKind doc k
-       ; return (Just k', fvs) }
+rnLHsMaybeKind  :: HsDocContext -> Maybe (HsBndrSig (LHsKind RdrName))
+                -> RnM (Maybe (HsBndrSig (LHsKind Name)), FreeVars)
+rnLHsMaybeKind _ Nothing 
+  = return (Nothing, emptyFVs)
+rnLHsMaybeKind doc (Just bsig) 
+  = rnHsBndrSig False doc bsig $ \ bsig' -> 
+    return (Just bsig', emptyFVs)
 
 rnHsType  :: HsDocContext -> HsType RdrName -> RnM (HsType Name, FreeVars)
 rnHsType = rnHsTyKi True
@@ -412,14 +413,14 @@ bindTyVarsRn doc tv_bndrs names thing_inside
   where
     go [] [] thing_inside = thing_inside []
 
-    go (L loc (UserTyVar _ tck) : tvs) (n : ns) thing_inside
+    go (L loc (UserTyVar _) : tvs) (n : ns) thing_inside
       = go tvs ns $ \ tvs' ->
-        thing_inside (L loc (UserTyVar n tck) : tvs')
+        thing_inside (L loc (UserTyVar n) : tvs')
 
-    go (L loc (KindedTyVar _ bsig tck) : tvs) (n : ns) thing_inside
+    go (L loc (KindedTyVar _ bsig) : tvs) (n : ns) thing_inside
       = rnHsBndrSig False doc bsig $ \ bsig' ->
         go tvs ns $ \ tvs' ->
-        thing_inside (L loc (KindedTyVar n bsig' tck) : tvs')
+        thing_inside (L loc (KindedTyVar n bsig') : tvs')
 
     -- Lists of unequal length
     go tvs names _ = pprPanic "bindTyVarsRn" (ppr tvs $$ ppr names)
@@ -896,7 +897,8 @@ checkTH _ _ = return ()	-- OK
 #else
 checkTH e what 	-- Raise an error in a stage-1 compiler
   = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>  
-	          ptext (sLit "illegal in a stage-1 compiler"),
+	          ptext (sLit "requires GHC with interpreter support"),
+                  ptext (sLit "Perhaps you are using a stage-1 compiler?"),
 	          nest 2 (ppr e)])
 #endif   
 \end{code}
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index d97a0884f9..604db4de47 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -20,7 +20,7 @@ module TcEnv(
         tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom,
         
         -- Local environment
-        tcExtendKindEnv, tcExtendKindEnvTvs, tcExtendTcTyThingEnv,
+        tcExtendKindEnv, tcExtendTcTyThingEnv,
         tcExtendTyVarEnv, tcExtendTyVarEnv2, 
         tcExtendGhciEnv, tcExtendLetEnv,
         tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, 
@@ -340,11 +340,6 @@ tcExtendKindEnv things thing_inside
     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
 
-tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> ([LHsTyVarBndr Name] -> TcM r) -> TcM r
-tcExtendKindEnvTvs bndrs thing_inside
-  = tcExtendKindEnv (map (hsTyVarNameKind . unLoc) bndrs)
-                    (thing_inside bndrs)
-
 -----------------------
 -- Scoped type and kind variables
 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 7379ca2ae9..7bda323f5b 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -48,8 +48,6 @@ import Platform
 import SrcLoc
 import Bag
 import FastString
-
-import Control.Monad
 \end{code}
 
 \begin{code}
@@ -210,14 +208,14 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ (CLabel _))
        ; return idecl }      -- NB check res_ty not sig_ty!
                              --    In case sig_ty is (forall a. ForeignPtr a)
 
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ CWrapper) = do
+tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh CWrapper) = do
         -- Foreign wrapper (former f.e.d.)
         -- The type must be of the form ft -> IO (FunPtr ft), where ft is a
         -- valid foreign type.  For legacy reasons ft -> IO (Ptr ft) as well
         -- as ft -> IO Addr is accepted, too.  The use of the latter two forms
         -- is DEPRECATED, though.
     checkCg checkCOrAsmOrLlvmOrInterp
-    checkCConv cconv
+    cconv' <- checkCConv cconv
     case arg_tys of
         [arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
                         checkForeignRes nonIOok  checkSafe isFFIExportResultTy res1_ty
@@ -226,23 +224,22 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ CWrapper) = do
                   where
                      (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
         _ -> addErrTc (illegalForeignTyErr empty sig_ty)
-    return idecl
+    return (CImport cconv' safety mh CWrapper)
 
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction target))
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction target))
   | isDynamicTarget target = do -- Foreign import dynamic
       checkCg checkCOrAsmOrLlvmOrInterp
-      checkCConv cconv
+      cconv' <- checkCConv cconv
       case arg_tys of           -- The first arg must be Ptr, FunPtr, or Addr
         []                -> do
           check False (illegalForeignTyErr empty sig_ty)
-          return idecl
         (arg1_ty:arg_tys) -> do
           dflags <- getDynFlags
           check (isFFIDynArgumentTy arg1_ty)
                 (illegalForeignTyErr argument arg1_ty)
           checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
           checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
-          return idecl
+      return $ CImport cconv' safety mh (CFunction target)
   | cconv == PrimCallConv = do
       dflags <- getDynFlags
       check (xopt Opt_GHCForeignImportPrim dflags)
@@ -257,7 +254,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar
       return idecl
   | otherwise = do              -- Normal foreign import
       checkCg checkCOrAsmOrLlvmOrDotNetOrInterp
-      checkCConv cconv
+      cconv' <- checkCConv cconv
       checkCTarget target
       dflags <- getDynFlags
       checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
@@ -268,7 +265,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar
            | not (null arg_tys) ->
               addErrTc (text "`value' imports cannot have function types")
           _ -> return ()
-      return idecl
+      return $ CImport cconv' safety mh (CFunction target)
 
 
 -- This makes a convenient place to check
@@ -315,7 +312,7 @@ tcFExport fo@(ForeignExport (L loc nm) hs_ty _ spec)
 
     (norm_co, norm_sig_ty) <- normaliseFfiType sig_ty
 
-    tcCheckFEType norm_sig_ty spec
+    spec' <- tcCheckFEType norm_sig_ty spec
 
            -- we're exporting a function, but at a type possibly more
            -- constrained than its declared/inferred type. Hence the need
@@ -327,20 +324,21 @@ tcFExport fo@(ForeignExport (L loc nm) hs_ty _ spec)
     -- is *stable* (i.e. the compiler won't change it later),
     -- because this name will be referred to by the C code stub.
     id  <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc
-    return (mkVarBind id rhs, ForeignExport (L loc id) undefined norm_co spec)
+    return (mkVarBind id rhs, ForeignExport (L loc id) undefined norm_co spec')
 tcFExport d = pprPanic "tcFExport" (ppr d)
 \end{code}
 
 ------------ Checking argument types for foreign export ----------------------
 
 \begin{code}
-tcCheckFEType :: Type -> ForeignExport -> TcM ()
+tcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport
 tcCheckFEType sig_ty (CExport (CExportStatic str cconv)) = do
     checkCg checkCOrAsmOrLlvm
     check (isCLabelString str) (badCName str)
-    checkCConv cconv
+    cconv' <- checkCConv cconv
     checkForeignArgs isFFIExternalTy arg_tys
     checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty
+    return (CExport (CExportStatic str cconv'))
   where
       -- Drop the foralls before inspecting n
       -- the structure of the foreign type.
@@ -449,15 +447,18 @@ checkCg check = do
 Calling conventions
 
 \begin{code}
-checkCConv :: CCallConv -> TcM ()
-checkCConv CCallConv    = return ()
-checkCConv CApiConv     = return ()
+checkCConv :: CCallConv -> TcM CCallConv
+checkCConv CCallConv    = return CCallConv
+checkCConv CApiConv     = return CApiConv
 checkCConv StdCallConv  = do dflags <- getDynFlags
                              let platform = targetPlatform dflags
-                             unless (platformArch platform == ArchX86) $
-                                 -- This is a warning, not an error. see #3336
-                                 addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall")
-checkCConv PrimCallConv = addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
+                             if platformArch platform == ArchX86
+                                 then return StdCallConv
+                                 else do -- This is a warning, not an error. see #3336
+                                         addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall")
+                                         return CCallConv
+checkCConv PrimCallConv = do addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
+                             return PrimCallConv
 checkCConv CmmCallConv  = panic "checkCConv CmmCallConv"
 \end{code}
 
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 1f776cebbd..c29f1a4bc3 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -792,7 +792,7 @@ bindScopedKindVars hs_tvs thing_inside
   where
     kvs :: [KindVar]   -- All skolems
     kvs = [ mkKindSigVar kv 
-          | L _ (KindedTyVar _ (HsBSig _ kvs) _) <- hs_tvs
+          | L _ (KindedTyVar _ (HsBSig _ kvs)) <- hs_tvs
           , kv <- kvs ]
 
 tcHsTyVarBndrs :: [LHsTyVarBndr Name] 
@@ -825,7 +825,7 @@ tcHsTyVarBndr (L _ hs_tv)
            _ -> do
        { kind <- case hs_tv of
                    UserTyVar {} -> newMetaKindVar
-                   KindedTyVar _ (HsBSig kind _) _ -> tcLHsKind kind
+                   KindedTyVar _ (HsBSig kind _) -> tcLHsKind kind
        ; return (mkTyVar name kind) } } }
 
 ------------------
@@ -915,7 +915,7 @@ kcLookupKind nm
            _                   -> pprPanic "kcLookupKind" (ppr tc_ty_thing) }
 
 kcTyClTyVars :: Name -> [LHsTyVarBndr Name] -> (TcKind -> TcM a) -> TcM a
--- Used for the type varaibles of a type or class decl,
+-- Used for the type variables of a type or class decl,
 -- when doing the initial kind-check.  
 kcTyClTyVars name hs_tvs thing_inside
   = bindScopedKindVars hs_tvs $
@@ -927,10 +927,10 @@ kcTyClTyVars name hs_tvs thing_inside
         ; tcExtendKindEnv name_ks (thing_inside res_k) }
   where
     kc_tv :: LHsTyVarBndr Name -> Kind -> TcM (Name, Kind)
-    kc_tv (L _ (UserTyVar n _)) exp_k 
+    kc_tv (L _ (UserTyVar n)) exp_k 
       = do { check_in_scope n exp_k
            ; return (n, exp_k) }
-    kc_tv (L _ (KindedTyVar n (HsBSig hs_k _) _)) exp_k
+    kc_tv (L _ (KindedTyVar n (HsBSig hs_k _))) exp_k
       = do { k <- tcLHsKind hs_k
            ; _ <- unifyKind k exp_k
            ; check_in_scope n exp_k
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index c166e6210e..b2b4089f54 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -431,13 +431,14 @@ kcFamilyDecl (TySynonym {}) = return ()
 kcFamilyDecl d = pprPanic "kcFamilyDecl" (ppr d)
 
 ------------------
-kcResultKind :: Maybe (LHsKind Name) -> Kind -> TcM ()
+kcResultKind :: Maybe (HsBndrSig (LHsKind Name)) -> Kind -> TcM ()
 kcResultKind Nothing res_k
   = discardResult (unifyKind res_k liftedTypeKind)
       --             type family F a 
       -- defaults to type family F a :: *
-kcResultKind (Just k) res_k
-  = do { k' <- tcLHsKind k
+kcResultKind (Just (HsBSig k ns)) res_k
+  = do { let kvs = map mkKindSigVar ns 
+       ; k' <- tcExtendTyVarEnv kvs (tcLHsKind k)
        ; discardResult (unifyKind k' res_k) }
 \end{code}
 
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 6b99a1f53b..e9af2015ba 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -1176,7 +1176,7 @@ isOverloadedTy _               = False
 
 \begin{code}
 isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,
-    isUnitTy, isCharTy :: Type -> Bool
+    isUnitTy, isCharTy, isAnyTy :: Type -> Bool
 isFloatTy      = is_tc floatTyConKey
 isDoubleTy     = is_tc doubleTyConKey
 isIntegerTy    = is_tc integerTyConKey
@@ -1185,6 +1185,7 @@ isWordTy       = is_tc wordTyConKey
 isBoolTy       = is_tc boolTyConKey
 isUnitTy       = is_tc unitTyConKey
 isCharTy       = is_tc charTyConKey
+isAnyTy        = is_tc anyTyConKey
 
 isStringTy :: Type -> Bool
 isStringTy ty
@@ -1354,9 +1355,11 @@ isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
 
 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
 -- Checks for valid argument type for a 'foreign import prim'
--- Currently they must all be simple unlifted types.
+-- Currently they must all be simple unlifted types, or the well-known type
+-- Any, which can be used to pass the address to a Haskell object on the heap to
+-- the foreign function.
 isFFIPrimArgumentTy dflags ty
-   = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
+   = isAnyTy ty || checkRepTyCon (legalFIPrimArgTyCon dflags) ty
 
 isFFIPrimResultTy :: DynFlags -> Type -> Bool
 -- Checks for valid result type for a 'foreign import prim'
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index 931bdf78ad..c7b9dedd37 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -414,7 +414,6 @@ lookupFamInstEnvConflicts envs fam_inst skol_tvs
 		  (ppr tpl_tvs <+> ppr tpl_tys) )
 		-- Unification will break badly if the variables overlap
 		-- They shouldn't because we allocate separate uniques for them
-         pprTrace "tcUnifyTys" (ppr tpl_tys $$ ppr match_tys $$ ppr fam_inst) $
          case tcUnifyTys instanceBindFun tpl_tys match_tys of
 	      Just subst | conflicting old_fam_inst subst -> Just subst
 	      _other	   	              	          -> Nothing
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index b96ae5e063..b58fcd4817 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -958,10 +958,9 @@ warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
 warnPprTrace _     _file _line _msg x | opt_NoDebugOutput = x
 warnPprTrace False _file _line _msg x = x
 warnPprTrace True   file  line  msg x
-  = pprDebugAndThen trace "WARNING:" doc x
+  = pprDebugAndThen trace str msg x
   where
-    doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
-               msg]
+    str = showSDoc (hsep [text "WARNING: file", text file <> comma, text "line", int line])
 
 assertPprPanic :: String -> Int -> SDoc -> a
 -- ^ Panic with an assertation failure, recording the given file and line number.
diff --git a/configure.ac b/configure.ac
index 4951467b4d..b796f6d441 100644
--- a/configure.ac
+++ b/configure.ac
@@ -159,9 +159,9 @@ fi;
 # GHC is passed to Cabal, so we need a native path
 if test "${WithGhc}" != ""
 then
-    ghc_host=`"${WithGhc}" +RTS --info | grep 'Host platform' | sed -e 's/.*, "//' -e 's/")//'`
+    ghc_host_os=`"${WithGhc}" +RTS --info | grep 'Host OS' | sed -e 's/.*, "//' -e 's/")//'`
 
-    if test "$ghc_host" = "i386-unknown-mingw32"
+    if test "$ghc_host_os" = "mingw32"
     then
         if test "${OSTYPE}" = "msys"
         then
@@ -252,57 +252,73 @@ if test "$HostOS" = "mingw32"
 then
     test -d inplace || mkdir inplace
 
-    CC="$hardtop/inplace/mingw/bin/gcc.exe"
-    LD="$hardtop/inplace/mingw/bin/ld.exe"
-    NM="$hardtop/inplace/mingw/bin/nm.exe"
-    fp_prog_ar_raw="$hardtop/inplace/mingw/bin/ar.exe"
-
-    # NB. If you update the tarballs to a new version of gcc, don't
-    # forget to tweak the paths in driver/gcc/gcc.c.
-    if ! test -d inplace/mingw ||
-         test inplace/mingw -ot ghc-tarballs/mingw/binutils*.tar.lzma  ||
-         test inplace/mingw -ot ghc-tarballs/mingw/gcc-core*.tar.lzma  ||
-         test inplace/mingw -ot ghc-tarballs/mingw/gcc-c++*.tar.lzma   ||
-         test inplace/mingw -ot ghc-tarballs/mingw/libgcc*.tar.gz      ||
-         test inplace/mingw -ot ghc-tarballs/mingw/libgmp*.tar.gz      ||
-         test inplace/mingw -ot ghc-tarballs/mingw/libmpc*.tar.gz      ||
-         test inplace/mingw -ot ghc-tarballs/mingw/libmpfr*.tar.gz     ||
-         test inplace/mingw -ot ghc-tarballs/mingw/libstdc*.tar.lzma   ||
-         test inplace/mingw -ot ghc-tarballs/mingw/mingwrt*-dev.tar.gz ||
-         test inplace/mingw -ot ghc-tarballs/mingw/mingwrt*-dll.tar.gz ||
-         test inplace/mingw -ot ghc-tarballs/mingw/w32api*.tar.lzma
+    if test "$HostArch" = "i386"
     then
-        AC_MSG_NOTICE([Making in-tree mingw tree])
-        rm -rf inplace/mingw
-        mkdir inplace/mingw
-        (
-            cd inplace/mingw &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/binutils*.tar.lzma  &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/gcc-core*.tar.lzma  &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/gcc-c++*.tar.lzma   &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/libgcc*.tar.lzma    &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/libgmp*.tar.lzma    &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/libmpc*.tar.lzma    &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/libmpfr*.tar.lzma   &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/libstdc*.tar.lzma   &&
-            tar -z     -xf ../../ghc-tarballs/mingw/mingwrt*-dev.tar.gz &&
-            tar -z     -xf ../../ghc-tarballs/mingw/mingwrt*-dll.tar.gz &&
-            tar --lzma -xf ../../ghc-tarballs/mingw/w32api*.tar.lzma    &&
-            mv bin/gcc.exe bin/realgcc.exe
-        )
-        PATH=`pwd`/inplace/mingw/bin:$PATH inplace/mingw/bin/realgcc.exe driver/gcc/gcc.c driver/utils/cwrapper.c driver/utils/getLocation.c -Idriver/utils -o inplace/mingw/bin/gcc.exe
-        if ! test -e inplace/mingw/bin/gcc.exe
+        # NB. If you update the tarballs to a new version of gcc, don't
+        # forget to tweak the paths in driver/gcc/gcc.c.
+        if ! test -d inplace/mingw ||
+             test inplace/mingw -ot ghc-tarballs/mingw/binutils*.tar.lzma  ||
+             test inplace/mingw -ot ghc-tarballs/mingw/gcc-core*.tar.lzma  ||
+             test inplace/mingw -ot ghc-tarballs/mingw/gcc-c++*.tar.lzma   ||
+             test inplace/mingw -ot ghc-tarballs/mingw/libgcc*.tar.gz      ||
+             test inplace/mingw -ot ghc-tarballs/mingw/libgmp*.tar.gz      ||
+             test inplace/mingw -ot ghc-tarballs/mingw/libmpc*.tar.gz      ||
+             test inplace/mingw -ot ghc-tarballs/mingw/libmpfr*.tar.gz     ||
+             test inplace/mingw -ot ghc-tarballs/mingw/libstdc*.tar.lzma   ||
+             test inplace/mingw -ot ghc-tarballs/mingw/mingwrt*-dev.tar.gz ||
+             test inplace/mingw -ot ghc-tarballs/mingw/mingwrt*-dll.tar.gz ||
+             test inplace/mingw -ot ghc-tarballs/mingw/w32api*.tar.lzma
+        then
+            AC_MSG_NOTICE([Making in-tree mingw tree])
+            rm -rf inplace/mingw
+            mkdir inplace/mingw
+            (
+                cd inplace/mingw &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/binutils*.tar.lzma  &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/gcc-core*.tar.lzma  &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/gcc-c++*.tar.lzma   &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/libgcc*.tar.lzma    &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/libgmp*.tar.lzma    &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/libmpc*.tar.lzma    &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/libmpfr*.tar.lzma   &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/libstdc*.tar.lzma   &&
+                tar -z     -xf ../../ghc-tarballs/mingw/mingwrt*-dev.tar.gz &&
+                tar -z     -xf ../../ghc-tarballs/mingw/mingwrt*-dll.tar.gz &&
+                tar --lzma -xf ../../ghc-tarballs/mingw/w32api*.tar.lzma    &&
+                mv bin/gcc.exe bin/realgcc.exe
+            )
+            PATH=`pwd`/inplace/mingw/bin:$PATH inplace/mingw/bin/realgcc.exe driver/gcc/gcc.c driver/utils/cwrapper.c driver/utils/getLocation.c -Idriver/utils -o inplace/mingw/bin/gcc.exe
+            AC_MSG_NOTICE([In-tree mingw tree created])
+        fi
+        mingwbin="$hardtop/inplace/mingw/bin/"
+    else
+        # NB. If you update the tarballs to a new version of gcc, don't
+        # forget to tweak the paths in driver/gcc/gcc.c.
+        if ! test -d inplace/mingw ||
+             test inplace/mingw -ot ghc-tarballs/mingw64/mingw-w64-bin_*.zip
         then
-            AC_MSG_ERROR([GHC is required unless bootstrapping from .hc files.])
+            AC_MSG_NOTICE([Making in-tree mingw tree])
+            rm -rf inplace/mingw
+            mkdir inplace/mingw
+            (
+                cd inplace/mingw &&
+                unzip ../../ghc-tarballs/mingw64/mingw-w64-bin_*.zip
+            )
+            AC_MSG_NOTICE([In-tree mingw tree created])
         fi
-        AC_MSG_NOTICE([In-tree mingw tree created])
+        mingwbin="$hardtop/inplace/mingw/bin/x86_64-w64-mingw32-"
     fi
+
+    CC="${mingwbin}gcc.exe"
+    LD="${mingwbin}ld.exe"
+    NM="${mingwbin}nm.exe"
+    fp_prog_ar_raw="${mingwbin}ar.exe"
+
     if ! test -d inplace/perl ||
          test inplace/perl -ot ghc-tarballs/perl/ghc-perl*.tar.gz
     then
         AC_MSG_NOTICE([Making in-tree perl tree])
         rm -rf inplace/perl
-        mkdir inplace
         mkdir inplace/perl
         (
             cd inplace/perl &&
@@ -447,10 +463,11 @@ dnl --------------------------------------------------------------
 dnl ** Can the unix package be built?
 dnl --------------------------------------------------------------
 
-if test x"$TargetPlatform" = x"i386-unknown-mingw32"; then
-   GhcLibsWithUnix=NO
+if test "$TargetOS" = "mingw32"
+then
+    GhcLibsWithUnix=NO
 else
-   GhcLibsWithUnix=YES
+    GhcLibsWithUnix=YES
 fi
 AC_SUBST([GhcLibsWithUnix])
 
@@ -571,9 +588,9 @@ AC_SUBST(HaveDtrace)
 
 AC_PATH_PROG(HSCOLOUR,HsColour)
 # HsColour is passed to Cabal, so we need a native path
-if test "x$HostPlatform"  = "xi386-unknown-mingw32" && \
-   test "${OSTYPE}"      != "msys"                  && \
-   test "${HSCOLOUR}"    != ""
+if test "$HostOS"      = "mingw32" && \
+   test "${OSTYPE}"   != "msys"    && \
+   test "${HSCOLOUR}" != ""
 then
     # Canonicalise to <drive>:/path/to/gcc
     HSCOLOUR=`cygpath -m ${HSCOLOUR}`
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index bcf84b4246..d7e200458d 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -2025,16 +2025,6 @@ The following syntax is stolen:
 
       <varlistentry>
 	<term>
-	  <literal>'<replaceable>varid</replaceable></literal>
-	</term>
-	<listitem><para>
-	Stolen by: <option>-XTemplateHaskell</option>and 
-                   <option>-XPolyKinds</option>
-	  </para></listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
 	  <literal>[:<replaceable>varid</replaceable>|</literal>
           <indexterm><primary>quasi-quotation</primary></indexterm>
 	</term>
@@ -5356,8 +5346,11 @@ type T1 = P     -- 1
 type T2 = 'P    -- promoted 2
 </programlisting>
 Note that promoted datatypes give rise to named kinds. Since these can never be
-ambiguous, we do not allow quotes in kind names.
+ambiguous, we do not allow quotes in kind names. 
 </para>
+<para>Just as in the case of Template Haskell (<xref linkend="th-syntax"/>), there is
+no way to quote a data constructor or type constructor whose second character
+is a single quote.</para>
 </sect3>
 
 <sect3 id="promoted-lists-and-tuples">
@@ -6871,7 +6864,7 @@ understand Template Haskell; see the <ulink url="http://haskell.org/haskellwiki/
 Wiki page</ulink>.
 </para>
 
-    <sect2>
+    <sect2 id="th-syntax">
       <title>Syntax</title>
 
       <para> Template Haskell has the following new syntactic
@@ -6931,7 +6924,19 @@ Wiki page</ulink>.
 		  <itemizedlist>
 		    <listitem><para> <literal>'f</literal> has type <literal>Name</literal>, and names the function <literal>f</literal>.
 		  Similarly <literal>'C</literal> has type <literal>Name</literal> and names the data constructor <literal>C</literal>.
-		  In general <literal>'</literal><replaceable>thing</replaceable> interprets <replaceable>thing</replaceable> in an expression context.
+		  In general <literal>'</literal><replaceable>thing</replaceable> 
+                  interprets <replaceable>thing</replaceable> in an expression context.</para>
+                    <para>A name whose second character is a single
+                    quote (sadly) cannot be quoted in this way,
+                    because it will be parsed instead as a quoted
+                    character.  For example, if the function is called
+                    <literal>f'7</literal> (which is a legal Haskell
+                    identifier), an attempt to quote it as
+                    <literal>'f'7</literal> would be parsed as the
+                    character literal <literal>'f'</literal> followed
+                    by the numeric literal <literal>7</literal>. There
+                    is no current escape mechanism in this (unusual)
+                    situation.
 		     </para></listitem>
 		    <listitem><para> <literal>''T</literal> has type <literal>Name</literal>, and names the type constructor  <literal>T</literal>.
 		  That is, <literal>''</literal><replaceable>thing</replaceable> interprets <replaceable>thing</replaceable> in a type context.
diff --git a/driver/ghci/ghc.mk b/driver/ghci/ghc.mk
index 51203ab4d5..88c6aafeca 100644
--- a/driver/ghci/ghc.mk
+++ b/driver/ghci/ghc.mk
@@ -34,14 +34,14 @@ driver/ghci_dist_PROG    = ghci$(exeext)
 driver/ghci_dist_INSTALL = YES
 driver/ghci_dist_OTHER_OBJS = driver/ghci/ghci.res
 
-$(eval $(call build-prog,driver/ghci,dist,0))
+$(eval $(call build-prog,driver/ghci,dist,1))
 
 driver/ghci_dist_PROG_VER = ghci-$(ProjectVersion)$(exeext)
 
 INSTALL_BINS += driver/ghci/dist/build/tmp/$(driver/ghci_dist_PROG_VER)
 
 driver/ghci/ghci.res : driver/ghci/ghci.rc driver/ghci/ghci.ico
-	$(INPLACE_MINGW)/bin/windres --preprocessor="$(CPP) -xc -DRC_INVOKED" -o driver/ghci/ghci.res -i driver/ghci/ghci.rc -O coff
+	"$(WINDRES)" --preprocessor="$(CPP) -xc -DRC_INVOKED" -o driver/ghci/ghci.res -i driver/ghci/ghci.rc -O coff
 
 driver/ghci/dist/build/tmp/$(driver/ghci_dist_PROG_VER) : driver/ghci/dist/build/tmp/$(driver/ghci_dist_PROG)
 	"$(CP)" $< $@
diff --git a/driver/utils/cwrapper.c b/driver/utils/cwrapper.c
index 911290224c..5105924b74 100644
--- a/driver/utils/cwrapper.c
+++ b/driver/utils/cwrapper.c
@@ -31,7 +31,7 @@ char *mkString(const char *fmt, ...) {
     va_end(argp);
 
     if (i < 0) {
-        die("snprintf 0 failed: errno %d: %s\n", errno, strerror(errno));
+        die("vsnprintf 0 failed: errno %d: %s\n", errno, strerror(errno));
     }
 
     p = malloc(i + 1);
@@ -42,8 +42,8 @@ char *mkString(const char *fmt, ...) {
     va_start(argp, fmt);
     j = vsnprintf(p, i + 1, fmt, argp);
     va_end(argp);
-    if (i < 0) {
-        die("snprintf with %d failed: errno %d: %s\n",
+    if (j < 0) {
+        die("vsnprintf with %d failed: errno %d: %s\n",
             i + 1, errno, strerror(errno));
     }
 
diff --git a/ghc/ghc.mk b/ghc/ghc.mk
index ede5687dc6..a13f03b875 100644
--- a/ghc/ghc.mk
+++ b/ghc/ghc.mk
@@ -22,6 +22,15 @@ ghc_stage2_CONFIGURE_OPTS += --flags=ghci
 ghc_stage3_CONFIGURE_OPTS += --flags=ghci
 endif
 
+ifeq "$(compiler_stage1_VERSION_MUNGED)" "YES"
+# If we munge the stage1 version, and we're using a devel snapshot for
+# stage0, then stage1 may actually have an earlier version than stage0
+# (e.g. boot with ghc-7.5.20120316, building ghc-7.5). We therefore
+# need to tell Cabal to use version 7.5 of the ghc package when building
+# in ghc/stage1
+ghc_stage1_CONFIGURE_OPTS += --constraint "ghc == $(compiler_stage1_MUNGED_VERSION)"
+endif
+
 ghc_stage1_MORE_HC_OPTS = $(GhcStage1HcOpts)
 ghc_stage2_MORE_HC_OPTS = $(GhcStage2HcOpts)
 ghc_stage3_MORE_HC_OPTS = $(GhcStage3HcOpts)
diff --git a/includes/Cmm.h b/includes/Cmm.h
index 11c02b4e3e..f582ca9771 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -383,7 +383,7 @@
 // allocate() - this includes many of the primops.
 #define MAYBE_GC(liveness,reentry)			\
     if (bdescr_link(CurrentNursery) == NULL || \
-        generation_n_new_large_words(W_[g0]) >= CLong[large_alloc_lim]) {   \
+        generation_n_new_large_words(W_[g0]) >= TO_W_(CLong[large_alloc_lim])) {   \
 	R9  = liveness;					\
         R10 = reentry;					\
         HpAlloc = 0;					\
diff --git a/includes/HaskellConstants.hs b/includes/HaskellConstants.hs
index e38e896ba0..ef38cb5788 100644
--- a/includes/HaskellConstants.hs
+++ b/includes/HaskellConstants.hs
@@ -176,6 +176,12 @@ mAX_PTR_TAG = tAG_MASK
 cINT_SIZE :: Int
 cINT_SIZE = SIZEOF_INT
 
+cLONG_SIZE :: Int
+cLONG_SIZE = SIZEOF_LONG
+
+cLONG_LONG_SIZE :: Int
+cLONG_LONG_SIZE = SIZEOF_LONG_LONG
+
 -- Size of a storage manager block (in bytes).
 
 bLOCK_SIZE :: Int
diff --git a/includes/MachDeps.h b/includes/MachDeps.h
index f97d3e87d4..81e223dfb5 100644
--- a/includes/MachDeps.h
+++ b/includes/MachDeps.h
@@ -83,19 +83,18 @@
 #define SIZEOF_WORD32           SIZEOF_UNSIGNED_INT
 #define ALIGNMENT_WORD32        ALIGNMENT_UNSIGNED_INT
 
-#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8
-/* assume long long is 64 bits */
-#define SIZEOF_INT64            SIZEOF_LONG_LONG
-#define ALIGNMENT_INT64         ALIGNMENT_LONG_LONG
-#define SIZEOF_WORD64           SIZEOF_UNSIGNED_LONG_LONG
-#define ALIGNMENT_WORD64        ALIGNMENT_UNSIGNED_LONG_LONG
-#elif SIZEOF_LONG == 8
+#if SIZEOF_LONG == 8
 #define SIZEOF_INT64            SIZEOF_LONG
 #define ALIGNMENT_INT64         ALIGNMENT_LONG
 #define SIZEOF_WORD64           SIZEOF_UNSIGNED_LONG
 #define ALIGNMENT_WORD64        ALIGNMENT_UNSIGNED_LONG
+#elif HAVE_LONG_LONG && SIZEOF_LONG_LONG == 8
+#define SIZEOF_INT64            SIZEOF_LONG_LONG
+#define ALIGNMENT_INT64         ALIGNMENT_LONG_LONG
+#define SIZEOF_WORD64           SIZEOF_UNSIGNED_LONG_LONG
+#define ALIGNMENT_WORD64        ALIGNMENT_UNSIGNED_LONG_LONG
 #else
-#error GHC untested on this architecture: sizeof(void *) < 8 and no long longs.
+#error Cannot find a 64bit type.
 #endif
 
 #ifndef WORD_SIZE_IN_BITS
diff --git a/includes/Rts.h b/includes/Rts.h
index 3360eda323..cb23fd1083 100644
--- a/includes/Rts.h
+++ b/includes/Rts.h
@@ -17,6 +17,13 @@
 extern "C" {
 #endif
 
+/* We include windows.h very early, as on Win64 the CONTEXT type has
+   fields "R8", "R9" and "R10", which goes bad if we've already
+   #define'd those names for our own purposes (in stg/Regs.h) */
+#if defined(HAVE_WINDOWS_H)
+#include <windows.h>
+#endif
+
 #ifndef IN_STG_CODE
 #define IN_STG_CODE 0
 #endif
diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index e3b3f7d5f5..7f41ebc421 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -232,7 +232,7 @@ SchedulerStatus rts_getSchedStatus (Capability *cap);
 //	Note that RtsAPI.h is also included by foreign export stubs in
 //	the base package itself.
 //
-#if defined(mingw32_HOST_OS) && defined(__PIC__) && !defined(COMPILING_BASE_PACKAGE)
+#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH) && defined(__PIC__) && !defined(COMPILING_BASE_PACKAGE)
 __declspec(dllimport) extern StgWord base_GHCziTopHandler_runIO_closure[];
 __declspec(dllimport) extern StgWord base_GHCziTopHandler_runNonIO_closure[];
 #else
diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h
index e4397f2ee3..3fbeed2450 100644
--- a/includes/rts/storage/InfoTables.h
+++ b/includes/rts/storage/InfoTables.h
@@ -77,7 +77,7 @@ typedef struct {
 /* The type flags provide quick access to certain properties of a closure. */
 
 #define _HNF (1<<0)  /* head normal form?    */
-#define _BTM (1<<1)  /* bitmap-style layout? */
+#define _BTM (1<<1)  /* uses info->layout.bitmap */
 #define _NS  (1<<2)  /* non-sparkable        */
 #define _STA (1<<3)  /* static?              */
 #define _THU (1<<4)  /* thunk?               */
diff --git a/includes/stg/DLL.h b/includes/stg/DLL.h
index 7d4096025d..b7030b0e88 100644
--- a/includes/stg/DLL.h
+++ b/includes/stg/DLL.h
@@ -14,7 +14,7 @@
 #ifndef __STGDLL_H__
 #define __STGDLL_H__ 1
 
-#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
 #  define DLL_IMPORT_DATA_REF(x) (_imp__##x)
 #  define DLL_IMPORT_DATA_VARNAME(x) *_imp__##x
 #  if __GNUC__ && !defined(__declspec)
@@ -45,7 +45,7 @@
 #else
 #define DLL_IMPORT
 #define DLL_IMPORT_RTS DLLIMPORT
-# if defined(__PIC__) && defined(mingw32_HOST_OS)
+# if defined(__PIC__) && defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
 #  define DLL_IMPORT_DATA_VAR(x) _imp__##x
 # else
 #  define DLL_IMPORT_DATA_VAR(x) x
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 2b5bd46aba..2482da869d 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -622,6 +622,12 @@ ifeq "$(CrossCompiling)" "YES"
 SRC_HSC2HS_OPTS += --cross-compile
 endif
 
+ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
+WINDRES = $(INPLACE_MINGW)/bin/windres
+else ifeq "$(TARGETPLATFORM)" "x86_64-unknown-mingw32"
+WINDRES = $(INPLACE_MINGW)/bin/x86_64-w64-mingw32-windres
+endif
+
 #-----------------------------------------------------------------------------
 # Mingwex Library
 #
diff --git a/rts/ClosureFlags.c b/rts/ClosureFlags.c
index 41810f4025..0ab8b45669 100644
--- a/rts/ClosureFlags.c
+++ b/rts/ClosureFlags.c
@@ -37,14 +37,14 @@ StgWord16 closure_flags[] = {
  [FUN_1_1]		=  (_HNF|     _NS|		    _SRT         ),
  [FUN_0_2]		=  (_HNF|     _NS|		    _SRT         ),
  [FUN_STATIC]	   	=  (_HNF|     _NS|_STA|             _SRT    	 ),
- [THUNK]		=  (     _BTM|         _THU|        _SRT    	 ),
- [THUNK_1_0]		=  (     _BTM|         _THU|        _SRT    	 ),
- [THUNK_0_1]		=  (     _BTM|         _THU|        _SRT    	 ),
- [THUNK_2_0]		=  (     _BTM|         _THU|        _SRT    	 ),
- [THUNK_1_1]		=  (     _BTM|         _THU|        _SRT    	 ),
- [THUNK_0_2]		=  (     _BTM|         _THU|        _SRT    	 ),
- [THUNK_STATIC]	   	=  (     _BTM|    _STA|_THU|        _SRT    	 ),
- [THUNK_SELECTOR]	=  (     _BTM|         _THU|        _SRT    	 ),
+ [THUNK]                =  (                   _THU|        _SRT         ),
+ [THUNK_1_0]            =  (                   _THU|        _SRT         ),
+ [THUNK_0_1]            =  (                   _THU|        _SRT         ),
+ [THUNK_2_0]            =  (                   _THU|        _SRT         ),
+ [THUNK_1_1]            =  (                   _THU|        _SRT         ),
+ [THUNK_0_2]            =  (                   _THU|        _SRT         ),
+ [THUNK_STATIC]         =  (              _STA|_THU|        _SRT         ),
+ [THUNK_SELECTOR]       =  (                   _THU|        _SRT         ),
  [BCO]		   	=  (_HNF|     _NS                           	 ),
  [AP]			=  (                   _THU                 	 ),
  [PAP]		   	=  (_HNF|     _NS				 ),
@@ -52,7 +52,7 @@ StgWord16 closure_flags[] = {
  [IND]		   	=  (          _NS|			  _IND ),
  [IND_PERM]		=  (          _NS|			  _IND ),
  [IND_STATIC]	   	=  (          _NS|_STA|                   _IND ),
- [RET_BCO]		=  (     _BTM                                  ),
+ [RET_BCO]              =  ( 0                                         ),
  [RET_SMALL]		=  (     _BTM|                       _SRT      ),
  [RET_BIG]		=  (                                 _SRT      ),
  [RET_DYN]		=  (                                 _SRT      ),
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index 74545af149..199f0cd378 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -676,13 +676,19 @@ INFO_TABLE_RET( stg_block_async, RET_SMALL, W_ unused )
     W_ len, errC;
 
     ares = Sp(1);
-    len = StgAsyncIOResult_len(ares);
-    errC = StgAsyncIOResult_errCode(ares);
+    len = TO_W_(StgAsyncIOResult_len(ares));
+    errC = TO_W_(StgAsyncIOResult_errCode(ares));
     foreign "C" free(ares "ptr");
+#ifdef GhcUnregisterised
+    Sp(1) = errC;
+    Sp(0) = len;
+    jump %ENTRY_CODE(Sp(2));
+#else
     R1 = len;
     Sp_adj(1);
     Sp(0) = errC;
     jump %ENTRY_CODE(Sp(1));
+#endif
 }
 
 stg_block_async
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 2eac1cd834..a18e7caa8d 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -31,9 +31,11 @@
 // When building the RTS in the non-dyn way on Windows, we don't
 //	want declspec(__dllimport__) on the front of function prototypes
 //	from libffi.
-#if defined(mingw32_HOST_OS) && !defined(__PIC__)
+#if defined(mingw32_HOST_OS)
+#if (defined(i386_HOST_ARCH) && !defined(__PIC__)) || defined(x86_64_HOST_ARCH)
 # define LIBFFI_NOT_DLL
 #endif
+#endif
 
 #include "ffi.h"
 
diff --git a/rts/Linker.c b/rts/Linker.c
index 9fb3f68fb9..6fd36d8bd8 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -396,10 +396,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(utime)                               \
       SymI_HasProto(waitpid)
 
-#elif !defined(mingw32_HOST_OS)
-#define RTS_MINGW_ONLY_SYMBOLS /**/
-#define RTS_CYGWIN_ONLY_SYMBOLS /**/
-#else /* defined(mingw32_HOST_OS) */
+#elif defined(mingw32_HOST_OS)
 #define RTS_POSIX_ONLY_SYMBOLS  /**/
 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 
@@ -415,6 +412,12 @@ typedef struct _RtsSymbolVal {
 #define RTS___MINGW_VFPRINTF_SYM /**/
 #endif
 
+#if defined(i386_HOST_ARCH)
+#define RTS_MINGW32_ONLY(X) X
+#else
+#define RTS_MINGW32_ONLY(X) /**/
+#endif
+
 /* These are statically linked from the mingw libraries into the ghc
    executable, so we have to employ this hack. */
 #define RTS_MINGW_ONLY_SYMBOLS                           \
@@ -444,7 +447,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(strcpy)                              \
       SymI_HasProto(strncpy)                             \
       SymI_HasProto(abort)                               \
-      SymI_NeedsProto(_alloca)                           \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_alloca))         \
       SymI_HasProto(isxdigit)                            \
       SymI_HasProto(isupper)                             \
       SymI_HasProto(ispunct)                             \
@@ -495,21 +498,25 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(rts_InstallConsoleEvent)             \
       SymI_HasProto(rts_ConsoleHandlerDone)              \
       SymI_NeedsProto(mktime)                            \
-      SymI_NeedsProto(_imp___timezone)                   \
-      SymI_NeedsProto(_imp___tzname)                     \
-      SymI_NeedsProto(_imp__tzname)                      \
-      SymI_NeedsProto(_imp___iob)                        \
-      SymI_NeedsProto(_imp___osver)                      \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_imp___timezone)) \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_imp___tzname))   \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_imp__tzname))    \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_imp___iob))      \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_imp___osver))    \
       SymI_NeedsProto(localtime)                         \
       SymI_NeedsProto(gmtime)                            \
       SymI_NeedsProto(opendir)                           \
       SymI_NeedsProto(readdir)                           \
       SymI_NeedsProto(rewinddir)                         \
-      SymI_NeedsProto(_imp____mb_cur_max)                \
-      SymI_NeedsProto(_imp___pctype)                     \
-      SymI_NeedsProto(__chkstk)                          \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_imp____mb_cur_max)) \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(_imp___pctype))   \
+      RTS_MINGW32_ONLY(SymI_NeedsProto(__chkstk))        \
       RTS_MINGW_GETTIMEOFDAY_SYM                         \
       SymI_NeedsProto(closedir)
+
+#else
+#define RTS_MINGW_ONLY_SYMBOLS /**/
+#define RTS_CYGWIN_ONLY_SYMBOLS /**/
 #endif
 
 
@@ -742,7 +749,7 @@ typedef struct _RtsSymbolVal {
 // We don't do this when compiling to Windows DLLs at the moment because
 //      it doesn't support cross package data references well.
 //
-#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
 #define RTS_INTCHAR_SYMBOLS
 #else
 #define RTS_INTCHAR_SYMBOLS                             \
@@ -1069,7 +1076,7 @@ typedef struct _RtsSymbolVal {
 
 /* entirely bogus claims about types of these symbols */
 #define SymI_NeedsProto(vvv)  extern void vvv(void);
-#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
 #define SymE_HasProto(vvv)    SymE_HasProto(vvv);
 #define SymE_NeedsProto(vvv)    extern void _imp__ ## vvv (void);
 #else
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 4cb3b8d85c..e368ed195b 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -35,7 +35,7 @@ import base_ControlziExceptionziBase_nestedAtomically_closure;
 import EnterCriticalSection;
 import LeaveCriticalSection;
 import ghczmprim_GHCziTypes_False_closure;
-#if !defined(mingw32_HOST_OS)
+#if defined(GhcUnregisterised) || !defined(mingw32_HOST_OS)
 import sm_mutex;
 #endif
 
diff --git a/rts/Printer.c b/rts/Printer.c
index 008427113a..688ed7b664 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -1107,8 +1107,8 @@ char *closure_type_names[] = {
  [CATCH_FRAME]           = "CATCH_FRAME",
  [UNDERFLOW_FRAME]       = "UNDERFLOW_FRAME",
  [STOP_FRAME]            = "STOP_FRAME",
- [BLACKHOLE]             = "BLACKHOLE",
  [BLOCKING_QUEUE]        = "BLOCKING_QUEUE",
+ [BLACKHOLE]             = "BLACKHOLE",
  [MVAR_CLEAN]            = "MVAR_CLEAN",
  [MVAR_DIRTY]            = "MVAR_DIRTY",
  [ARR_WORDS]             = "ARR_WORDS",
diff --git a/rts/RtsMain.c b/rts/RtsMain.c
index e89445db25..435df420c5 100644
--- a/rts/RtsMain.c
+++ b/rts/RtsMain.c
@@ -108,11 +108,11 @@ int hs_main (int argc, char *argv[],     // program args
     progmain_closure = main_closure;
     rtsconfig = rts_config;
 
-#if defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
     BEGIN_CATCH
 #endif
     real_main();
-#if defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
     END_CATCH
 #endif
 }
diff --git a/rts/Schedule.c b/rts/Schedule.c
index e17116bc07..aa22e06bd9 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -611,7 +611,7 @@ schedulePreLoop(void)
 {
   // initialisation for scheduler - what cannot go into initScheduler()  
 
-#if defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH) && !defined(GhcUnregisterised)
     win32AllocStack();
 #endif
 }
diff --git a/rts/StgCRun.c b/rts/StgCRun.c
index 3654b3336a..f08e35dd11 100644
--- a/rts/StgCRun.c
+++ b/rts/StgCRun.c
@@ -33,6 +33,14 @@
 /* include Stg.h first because we want real machine regs in here: we
  * have to get the value of R1 back from Stg land to C land intact.
  */
+
+/* We include windows.h very early, as on Win64 the CONTEXT type has
+   fields "R8", "R9" and "R10", which goes bad if we've already
+   #define'd those names for our own purposes (in stg/Regs.h) */
+#if defined(HAVE_WINDOWS_H)
+#include <windows.h>
+#endif
+
 #define IN_STGCRUN 1
 #include "Stg.h"
 #include "Rts.h"
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index e4b128f96e..763c85b3b6 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -576,7 +576,7 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE
    replace them with references to the static objects.
    ------------------------------------------------------------------------- */
 
-#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
 /*
  * When sticking the RTS in a Windows DLL, we delay populating the
  * Charlike and Intlike tables until load-time, which is only
@@ -601,7 +601,7 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE
  * on the fact that static closures live in the data section.
  */
 
-#if !(defined(__PIC__) && defined(mingw32_HOST_OS))
+#if !(defined(__PIC__) && defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH))
 section "data" {
  stg_CHARLIKE_closure:
     CHARLIKE_HDR(0)
@@ -899,4 +899,4 @@ section "data" {
     INTLIKE_HDR(16)  /* MAX_INTLIKE == 16 */
 }
 
-#endif // !(defined(__PIC__) && defined(mingw32_HOST_OS))
+#endif // !(defined(__PIC__) && defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH))
diff --git a/rts/ghc.mk b/rts/ghc.mk
index fc634c7ff2..e5fff56008 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -28,7 +28,7 @@ all_rts : $(ALL_RTS_LIBS)
 
 ALL_DIRS = hooks parallel sm eventlog
 
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
+ifeq "$(HostOS_CPP)" "mingw32"
 ALL_DIRS += win32
 else
 ALL_DIRS += posix
@@ -311,6 +311,12 @@ rts/RtsUtils_CC_OPTS += -DTargetVendor=\"$(TargetVendor_CPP)\"
 rts/RtsUtils_CC_OPTS += -DGhcUnregisterised=\"$(GhcUnregisterised)\"
 rts/RtsUtils_CC_OPTS += -DGhcEnableTablesNextToCode=\"$(GhcEnableTablesNextToCode)\"
 
+ifeq "$(GhcUnregisterised)" "YES"
+rts/HeapStackCheck_HC_OPTS += -DGhcUnregisterised=1
+rts/PrimOps_HC_OPTS += -DGhcUnregisterised=1
+rts/Schedule_CC_OPTS += -DGhcUnregisterised=1
+endif
+
 # Compile various performance-critical pieces *without* -fPIC -dynamic
 # even when building a shared library.  If we don't do this, then the
 # GC runs about 50% slower on x86 due to the overheads of PIC.  The
diff --git a/rts/win32/AwaitEvent.c b/rts/win32/AwaitEvent.c
index 1b92c4386f..af9c658e02 100644
--- a/rts/win32/AwaitEvent.c
+++ b/rts/win32/AwaitEvent.c
@@ -27,13 +27,11 @@ static nat workerWaitingForRequests = 0;
 void
 awaitEvent(rtsBool wait)
 {
-  int ret;
-
   do {
     /* Try to de-queue completed IO requests
      */
     workerWaitingForRequests = 1;
-    ret = awaitRequests(wait);
+    awaitRequests(wait);
     workerWaitingForRequests = 0;
 
     // If a signal was raised, we need to service it
diff --git a/rts/win32/ThrIOManager.c b/rts/win32/ThrIOManager.c
index bad621ced6..afcdc19d27 100644
--- a/rts/win32/ThrIOManager.c
+++ b/rts/win32/ThrIOManager.c
@@ -152,7 +152,7 @@ ioManagerStart (void)
     Capability *cap;

     if (io_manager_event == INVALID_HANDLE_VALUE) {

 	cap = rts_lock();

-#if defined(mingw32_HOST_OS) && defined(__PIC__)

+#if defined(mingw32_HOST_OS) && defined(i386_HOST_Arch) && defined(__PIC__)

         rts_evalIO(&cap,_imp__base_GHCziConcziIO_ensureIOManagerIsRunning_closure,NULL);

 #else

         rts_evalIO(&cap,&base_GHCziConcziIO_ensureIOManagerIsRunning_closure,NULL);

diff --git a/rts/win32/seh_excn.c b/rts/win32/seh_excn.c
index 5da7579b10..da5f64d812 100644
--- a/rts/win32/seh_excn.c
+++ b/rts/win32/seh_excn.c
@@ -1,9 +1,11 @@
+#include "ghcconfig.h"
 #include "seh_excn.h"
 
 /*
  * Exception / signal handlers.
  */
-#if defined(__MINGW32__)
+#if defined(mingw32_HOST_OS)
+#if defined(i386_HOST_ARCH)
 jmp_buf seh_unwind_to;
 unsigned long seh_excn_code; /* variable used to communicate what kind of exception we've caught;nice. */
 
@@ -39,4 +41,5 @@ catchDivZero(struct _EXCEPTION_RECORD* rec,
      return ExceptionContinueSearch;
 }
 #endif
+#endif
 
diff --git a/utils/fingerprint/fingerprint.py b/utils/fingerprint/fingerprint.py
index 5a753279e6..b0e599d03b 100755
--- a/utils/fingerprint/fingerprint.py
+++ b/utils/fingerprint/fingerprint.py
@@ -55,7 +55,7 @@ def fingerprint(source=None):
   `sync-all` command will be run to get the current fingerprint.
   """
   if source is None:
-    sync_all = ["./sync-all", "log", "HEAD^..", "--pretty=oneline"]
+    sync_all = ["./sync-all", "log", "-1", "--pretty=oneline"]
     source  = Popen(sync_all, stdout=PIPE).stdout
 
   lib = ""