Merge branch 'master' of http://darcs.haskell.org//ghc

44 files changed, 1167 insertions, 862 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/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 4a5143bcb9..447ed153cb 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -190,6 +190,12 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
        ; checkL (not (isStrictId binder)
             || (isNonRec rec_flag && not (isTopLevel top_lvl_flag)))
            (mkStrictMsg binder)
+        -- Check that if the binder is local, it is not marked as exported
+       ; checkL (not (isExportedId binder) || isTopLevel top_lvl_flag)
+           (mkNonTopExportedMsg binder)
+        -- Check that if the binder is local, it does not have an external name
+       ; checkL (not (isExternalName (Var.varName binder)) || isTopLevel top_lvl_flag)
+           (mkNonTopExternalNameMsg binder)
         -- Check whether binder's specialisations contain any out-of-scope variables
        ; mapM_ (checkBndrIdInScope binder) bndr_vars 
 
@@ -1020,7 +1026,7 @@ lookupIdInScope id
 		Nothing -> do { addErrL out_of_scope
 			      ; return id } }
   where
-    out_of_scope = ppr id <+> ptext (sLit "is out of scope")
+    out_of_scope = pprBndr LetBind id <+> ptext (sLit "is out of scope")
 
 
 oneTupleDataConId :: Id	-- Should not happen
@@ -1040,7 +1046,7 @@ checkInScope :: SDoc -> Var -> LintM ()
 checkInScope loc_msg var =
  do { subst <- getTvSubst
     ; checkL (not (mustHaveLocalBinding var) || (var `isInScope` subst))
-             (hsep [ppr var, loc_msg]) }
+             (hsep [pprBndr LetBind var, loc_msg]) }
 
 checkTys :: OutType -> OutType -> MsgDoc -> LintM ()
 -- check ty2 is subtype of ty1 (ie, has same structure but usage
@@ -1220,6 +1226,13 @@ mkStrictMsg binder
 	      hsep [ptext (sLit "Binder's demand info:"), ppr (idDemandInfo binder)]
 	     ]
 
+mkNonTopExportedMsg :: Id -> MsgDoc
+mkNonTopExportedMsg binder
+  = hsep [ptext (sLit "Non-top-level binder is marked as exported:"), ppr binder]
+
+mkNonTopExternalNameMsg :: Id -> MsgDoc
+mkNonTopExternalNameMsg binder
+  = hsep [ptext (sLit "Non-top-level binder has an external name:"), ppr binder]
 
 mkKindErrMsg :: TyVar -> Type -> MsgDoc
 mkKindErrMsg tyvar arg_ty
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index d7296e3e25..4faad7fc25 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -917,10 +917,10 @@ instance Outputable AltCon where
 instance Show AltCon where
   showsPrec p con = showsPrecSDoc p (ppr con)
 
-cmpAlt :: Alt b -> Alt b -> Ordering
+cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
 
-ltAlt :: Alt b -> Alt b -> Bool
+ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool
 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
 
 cmpAltCon :: AltCon -> AltCon -> Ordering
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 198ac7e610..44aebb8169 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -15,7 +15,8 @@ module CoreUtils (
         mkAltExpr,
 
         -- * Taking expressions apart
-        findDefault, findAlt, isDefaultAlt, mergeAlts, trimConArgs,
+        findDefault, findAlt, isDefaultAlt,
+        mergeAlts, trimConArgs, filterAlts,
 
         -- * Properties of expressions
         exprType, coreAltType, coreAltsType,
@@ -69,7 +70,7 @@ import Util
 import Pair
 import Data.Word
 import Data.Bits
-import Data.List ( mapAccumL )
+import Data.List
 \end{code}
 
 
@@ -342,18 +343,18 @@ This makes it easy to find, though it makes matching marginally harder.
 
 \begin{code}
 -- | Extract the default case alternative
-findDefault :: [CoreAlt] -> ([CoreAlt], Maybe CoreExpr)
+findDefault :: [(AltCon, [a], b)] -> ([(AltCon, [a], b)], Maybe b)
 findDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null args ) (alts, Just rhs)
 findDefault alts                        =                     (alts, Nothing)
 
-isDefaultAlt :: CoreAlt -> Bool
+isDefaultAlt :: (AltCon, a, b) -> Bool
 isDefaultAlt (DEFAULT, _, _) = True
 isDefaultAlt _               = False
 
 
 -- | Find the case alternative corresponding to a particular
 -- constructor: panics if no such constructor exists
-findAlt :: AltCon -> [CoreAlt] -> Maybe CoreAlt
+findAlt :: AltCon -> [(AltCon, a, b)] -> Maybe (AltCon, a, b)
     -- A "Nothing" result *is* legitmiate
     -- See Note [Unreachable code]
 findAlt con alts
@@ -369,7 +370,7 @@ findAlt con alts
           GT -> ASSERT( not (con1 == DEFAULT) ) go alts deflt
 
 ---------------------------------
-mergeAlts :: [CoreAlt] -> [CoreAlt] -> [CoreAlt]
+mergeAlts :: [(AltCon, a, b)] -> [(AltCon, a, b)] -> [(AltCon, a, b)]
 -- ^ Merge alternatives preserving order; alternatives in
 -- the first argument shadow ones in the second
 mergeAlts [] as2 = as2
@@ -396,6 +397,83 @@ trimConArgs (LitAlt _)   args = ASSERT( null args ) []
 trimConArgs (DataAlt dc) args = dropList (dataConUnivTyVars dc) args
 \end{code}
 
+\begin{code}
+filterAlts :: [Unique]             -- ^ Supply of uniques used in case we have to manufacture a new AltCon
+           -> Type                 -- ^ Type of scrutinee (used to prune possibilities)
+           -> [AltCon]             -- ^ Constructors known to be impossible due to the form of the scrutinee
+           -> [(AltCon, [Var], a)] -- ^ Alternatives
+           -> ([AltCon], Bool, [(AltCon, [Var], a)])
+             -- Returns:
+             --  1. Constructors that will never be encountered by the *default* case (if any)
+             --  2. Whether we managed to refine the default alternative into a specific constructor (for statistcs only)
+             --  3. The new alternatives
+             --
+             -- NB: the final list of alternatives may be empty:
+             -- This is a tricky corner case.  If the data type has no constructors,
+             -- which GHC allows, then the case expression will have at most a default
+             -- alternative.
+             --
+             -- If callers need to preserve the invariant that there is always at least one branch
+             -- in a "case" statement then they will need to manually add a dummy case branch that just
+             -- calls "error" or similar.
+filterAlts us ty imposs_cons alts = (imposs_deflt_cons, refined_deflt, merged_alts)
+  where
+    (alts_wo_default, maybe_deflt) = findDefault alts
+    alt_cons = [con | (con,_,_) <- alts_wo_default]
+    imposs_deflt_cons = nub (imposs_cons ++ alt_cons)
+      -- "imposs_deflt_cons" are handled 
+      --   EITHER by the context, 
+      --   OR by a non-DEFAULT branch in this case expression.
+
+    trimmed_alts = filterOut impossible_alt alts_wo_default
+    merged_alts  = mergeAlts trimmed_alts (maybeToList maybe_deflt')
+      -- We need the mergeAlts in case the new default_alt 
+      -- has turned into a constructor alternative.
+      -- The merge keeps the inner DEFAULT at the front, if there is one
+      -- and interleaves the alternatives in the right order
+
+    (refined_deflt, maybe_deflt') = case maybe_deflt of
+      Just deflt_rhs -> case mb_tc_app of
+        Just (tycon, inst_tys)
+          |     -- This branch handles the case where we are 
+                -- scrutinisng an algebraic data type
+            isAlgTyCon tycon            -- It's a data type, tuple, or unboxed tuples.  
+          , not (isNewTyCon tycon)      -- We can have a newtype, if we are just doing an eval:
+                                        --      case x of { DEFAULT -> e }
+                                        -- and we don't want to fill in a default for them!
+          , Just all_cons <- tyConDataCons_maybe tycon
+          , let imposs_data_cons = [con | DataAlt con <- imposs_deflt_cons]   -- We now know it's a data type 
+                impossible con   = con `elem` imposs_data_cons || dataConCannotMatch inst_tys con
+          -> case filterOut impossible all_cons of
+               -- Eliminate the default alternative
+               -- altogether if it can't match:
+               []    -> (False, Nothing)
+               -- It matches exactly one constructor, so fill it in:
+               [con] -> (True, Just (DataAlt con, ex_tvs ++ arg_ids, deflt_rhs))
+                 where (ex_tvs, arg_ids) = dataConRepInstPat us con inst_tys
+               _     -> (False, Just (DEFAULT, [], deflt_rhs))
+
+          | debugIsOn, isAlgTyCon tycon
+          , null (tyConDataCons tycon)
+          , not (isFamilyTyCon tycon || isAbstractTyCon tycon)
+                -- Check for no data constructors
+                -- This can legitimately happen for abstract types and type families,
+                -- so don't report that
+          -> pprTrace "prepareDefault" (ppr tycon)
+             (False, Just (DEFAULT, [], deflt_rhs))
+
+        _ -> (False, Just (DEFAULT, [], deflt_rhs))
+      Nothing -> (False, Nothing)
+  
+    mb_tc_app = splitTyConApp_maybe ty
+    Just (_, inst_tys) = mb_tc_app
+
+    impossible_alt :: (AltCon, a, b) -> Bool
+    impossible_alt (con, _, _) | con `elem` imposs_cons = True
+    impossible_alt (DataAlt con, _, _) = dataConCannotMatch inst_tys con
+    impossible_alt _                   = False
+\end{code}
+
 Note [Unreachable code]
 ~~~~~~~~~~~~~~~~~~~~~~~
 It is possible (although unusual) for GHC to find a case expression
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 2b72a923dd..a6d878a703 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -65,7 +65,7 @@ import Bag
 import FastString
 import ForeignCall
 import MonadUtils
-import Util( equalLength )
+import Util( equalLength, filterOut )
 
 import Data.Maybe
 import Control.Monad
@@ -170,17 +170,36 @@ in repTyClD and repC.
 
 -}
 
+-- represent associated family instances
+--
+repTyClDs :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
+repTyClDs ds = liftM de_loc (mapMaybeM repTyClD ds)
+
+
 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 
-repTyClD tydecl@(L _ (TyFamily {}))
-  = repTyFamily tydecl addTyVarBinds
+repTyClD (L loc (TyFamily { tcdFlavour = flavour,
+		            tcdLName   = tc, tcdTyVars = tvs, 
+		            tcdKindSig = opt_kind }))
+  = do { tc1 <- lookupLOcc tc 		-- See note [Binders and occurrences] 
+       ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
+           do { flav   <- repFamilyFlavour flavour
+	      ; bndrs1 <- coreList tyVarBndrTyConName bndrs
+              ; case opt_kind of 
+                  Nothing -> repFamilyNoKind flav tc1 bndrs1
+                  Just (HsBSig ki _) 
+                    -> do { ki1 <- repKind ki 
+                          ; repFamilyKind flav tc1 bndrs1 ki1 }
+              }
+       ; return $ Just (loc, dec)
+       }
 
 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] 
        ; tc_tvs <- mk_extra_tvs tvs mb_kind
-       ; dec <- addTyVarBinds tc_tvs $ \bndrs -> 
+       ; dec <- addTyClTyVarBinds tc_tvs $ \bndrs -> 
            do { cxt1     <- repLContext cxt
               ; opt_tys1 <- maybeMapM repLTys opt_tys   -- only for family insts
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
@@ -198,7 +217,7 @@ repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt, tcdKindSig = mb_kind,
 		          tcdCons = [con], tcdDerivs = mb_derivs }))
   = do { tc1 <- lookupLOcc tc 		-- See note [Binders and occurrences] 
        ; tc_tvs <- mk_extra_tvs tvs mb_kind
-       ; dec <- addTyVarBinds tc_tvs $ \bndrs -> 
+       ; dec <- addTyClTyVarBinds tc_tvs $ \bndrs -> 
            do { cxt1     <- repLContext cxt
               ; opt_tys1 <- maybeMapM repLTys opt_tys   -- only for family insts
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
@@ -213,7 +232,7 @@ repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt, tcdKindSig = mb_kind,
 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
                              tcdSynRhs = ty }))
   = do { tc1 <- lookupLOcc tc 		-- See note [Binders and occurrences] 
-       ; dec <- addTyVarBinds tvs $ \bndrs -> 
+       ; dec <- addTyClTyVarBinds tvs $ \bndrs -> 
            do { opt_tys1 <- maybeMapM repLTys opt_tys   -- only for family insts
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
 	      ; ty1      <- repLTy ty
@@ -233,7 +252,7 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
  	      ; sigs1  <- rep_sigs sigs
  	      ; binds1 <- rep_binds meth_binds
 	      ; fds1   <- repLFunDeps fds
-              ; ats1   <- repLAssocFamilys ats
+              ; ats1   <- repTyClDs ats
  	      ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
 	      ; bndrs1 <- coreList tyVarBndrTyConName bndrs
  	      ; repClass cxt1 cls1 bndrs1 fds1 decls1 
@@ -275,31 +294,6 @@ mk_extra_tvs tvs (Just (HsBSig 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.
---
-repTyFamily :: LTyClDecl Name 
-            -> ProcessTyVarBinds TH.Dec
-            -> DsM (Maybe (SrcSpan, Core TH.DecQ))
-repTyFamily (L loc (TyFamily { tcdFlavour = flavour,
-		               tcdLName   = tc, tcdTyVars = tvs, 
-		               tcdKindSig = opt_kind }))
-            tyVarBinds
-  = do { tc1 <- lookupLOcc tc 		-- See note [Binders and occurrences] 
-       ; dec <- tyVarBinds tvs $ \bndrs ->
-           do { flav   <- repFamilyFlavour flavour
-	      ; bndrs1 <- coreList tyVarBndrTyConName bndrs
-              ; case opt_kind of 
-                  Nothing -> repFamilyNoKind flav tc1 bndrs1
-                  Just (HsBSig ki _) 
-                    -> do { ki1 <- repKind ki 
-                          ; repFamilyKind flav tc1 bndrs1 ki1 }
-              }
-       ; return $ Just (loc, dec)
-       }
-repTyFamily _ _ = panic "DsMeta.repTyFamily: internal error"
-
 -- represent fundeps
 --
 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
@@ -320,24 +314,6 @@ repFamilyFlavour :: FamilyFlavour -> DsM (Core TH.FamFlavour)
 repFamilyFlavour TypeFamily = rep2 typeFamName []
 repFamilyFlavour DataFamily = rep2 dataFamName []
 
--- represent associated family declarations
---
-repLAssocFamilys :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
-repLAssocFamilys = mapM repLAssocFamily
-  where
-    repLAssocFamily tydecl@(L _ (TyFamily {})) 
-      = liftM (snd . fromJust) $ repTyFamily tydecl lookupTyVarBinds
-    repLAssocFamily tydecl
-      = failWithDs msg
-      where
-        msg = ptext (sLit "Illegal associated declaration in class:") <+> 
-              ppr tydecl
-
--- represent associated family instances
---
-repLAssocFamInst :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
-repLAssocFamInst = liftM de_loc . mapMaybeM repTyClD
-
 -- represent instance declarations
 --
 repInstD :: LInstDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
@@ -362,7 +338,7 @@ repInstD (L loc (ClsInstDecl ty binds prags ats))
                ; inst_ty1 <- repTapps cls_tcon cls_tys
                ; binds1 <- rep_binds binds
                ; prags1 <- rep_sigs prags
-               ; ats1 <- repLAssocFamInst ats
+               ; ats1 <- repTyClDs ats
                ; decls <- coreList decQTyConName (ats1 ++ binds1 ++ prags1)
                ; repInst cxt1 inst_ty1 decls }
        ; return (Just (loc, dec)) }
@@ -632,17 +608,27 @@ addTyVarBinds tvs m
   where
     mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)
 
--- Look up a list of type variables; the computations passed as the second 
--- argument gets the *new* names on Core-level as an argument
---
-lookupTyVarBinds :: ProcessTyVarBinds a
-lookupTyVarBinds tvs m =
-  do
-    let names       = hsLTyVarNames tvs
-        mkWithKinds = map repTyVarBndrWithKind tvs
-    bndrs       <- mapM lookupBinder names 
-    kindedBndrs <- zipWithM ($) mkWithKinds bndrs
-    m kindedBndrs
+
+addTyClTyVarBinds :: ProcessTyVarBinds a
+-- Used for data/newtype declarations, and family instances,
+-- so that the nested type variables work right
+--    instance C (T a) where
+--      type W (T a) = blah
+-- The 'a' in the type instance is the one bound by the instance decl
+addTyClTyVarBinds tvs m
+  = do { let tv_names = hsLTyVarNames tvs
+       ; env <- dsGetMetaEnv
+       ; freshNames <- mkGenSyms (filterOut (`elemNameEnv` env) tv_names)
+       	    -- Make fresh names for the ones that are not already in scope
+            -- This makes things work for family declarations
+
+       ; term <- addBinds freshNames $ 
+	    	 do { kindedBndrs <- mapM mk_tv_bndr tvs
+	    	    ; m kindedBndrs }
+
+       ; wrapGenSyms freshNames term }
+  where
+    mk_tv_bndr tv = do { v <- lookupOcc (hsLTyVarName tv); repTyVarBndrWithKind tv v }
 
 -- Produce kinded binder constructors from the Haskell tyvar binders
 --
diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index e68e6db7c2..25141362f8 100644
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -27,7 +27,7 @@ module DsMonad (
         dsLookupDPHRdrEnv, dsLookupDPHRdrEnv_maybe,
         dsInitPArrBuiltin,
 
-        DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
+        DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv,
 
         -- Warnings
         DsWarning, warnDs, failWithDs,
@@ -480,6 +480,9 @@ dsInitPArrBuiltin thing_inside
 \end{code}
 
 \begin{code}
+dsGetMetaEnv :: DsM (NameEnv DsMetaVal)
+dsGetMetaEnv = do { env <- getLclEnv; return (ds_meta env) }
+
 dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
 dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (ds_meta env) name) }
 
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/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index f4ad61757f..f91ee14de7 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -8,25 +8,18 @@
 -- calling the object-code linker and the byte-code linker where
 -- necessary.
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 {-# OPTIONS -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
 module Linker ( HValue, getHValue, showLinkerState,
-		linkExpr, linkDecls, unload, withExtendedLinkEnv,
+                linkExpr, linkDecls, unload, withExtendedLinkEnv,
                 extendLinkEnv, deleteFromLinkEnv,
-                extendLoadedPkgs, 
-		linkPackages,initDynLinker,linkModule,
+                extendLoadedPkgs,
+                linkPackages,initDynLinker,linkModule,
 
-		-- Saving/restoring globals
-		PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals
-	) where
+                -- Saving/restoring globals
+                PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals
+        ) where
 
 #include "HsVersions.h"
 
@@ -80,12 +73,12 @@ import Exception
 
 
 %************************************************************************
-%*									*
-			The Linker's state
-%*									*
+%*                                                                      *
+                        The Linker's state
+%*                                                                      *
 %************************************************************************
 
-The persistent linker state *must* match the actual state of the 
+The persistent linker state *must* match the actual state of the
 C dynamic linker at all times, so we keep it in a private global variable.
 
 The global IORef used for PersistentLinkerState actually contains another MVar.
@@ -97,7 +90,7 @@ interpreted code only), for use during linking.
 
 \begin{code}
 GLOBAL_VAR_M(v_PersistentLinkerState, newMVar (panic "Dynamic linker not initialised"), MVar PersistentLinkerState)
-GLOBAL_VAR(v_InitLinkerDone, False, Bool)	-- Set True when dynamic linker is initialised
+GLOBAL_VAR(v_InitLinkerDone, False, Bool) -- Set True when dynamic linker is initialised
 
 modifyPLS_ :: (PersistentLinkerState -> IO PersistentLinkerState) -> IO ()
 modifyPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f
@@ -108,37 +101,37 @@ modifyPLS f = readIORef v_PersistentLinkerState >>= flip modifyMVar f
 data PersistentLinkerState
    = PersistentLinkerState {
 
-	-- Current global mapping from Names to their true values
+        -- Current global mapping from Names to their true values
         closure_env :: ClosureEnv,
 
-	-- The current global mapping from RdrNames of DataCons to
-	-- info table addresses.
-	-- When a new Unlinked is linked into the running image, or an existing
-	-- module in the image is replaced, the itbl_env must be updated
-	-- appropriately.
+        -- The current global mapping from RdrNames of DataCons to
+        -- info table addresses.
+        -- When a new Unlinked is linked into the running image, or an existing
+        -- module in the image is replaced, the itbl_env must be updated
+        -- appropriately.
         itbl_env    :: !ItblEnv,
 
-	-- The currently loaded interpreted modules (home package)
-	bcos_loaded :: ![Linkable],
+        -- The currently loaded interpreted modules (home package)
+        bcos_loaded :: ![Linkable],
 
-	-- And the currently-loaded compiled modules (home package)
-	objs_loaded :: ![Linkable],
+        -- And the currently-loaded compiled modules (home package)
+        objs_loaded :: ![Linkable],
 
-	-- The currently-loaded packages; always object code
-	-- Held, as usual, in dependency order; though I am not sure if
-	-- that is really important
-	pkgs_loaded :: ![PackageId]
+        -- The currently-loaded packages; always object code
+        -- Held, as usual, in dependency order; though I am not sure if
+        -- that is really important
+        pkgs_loaded :: ![PackageId]
      }
 
 emptyPLS :: DynFlags -> PersistentLinkerState
-emptyPLS _ = PersistentLinkerState { 
-			closure_env = emptyNameEnv,
-			itbl_env    = emptyNameEnv,
-			pkgs_loaded = init_pkgs,
-			bcos_loaded = [],
-			objs_loaded = [] }
-                    
-  -- Packages that don't need loading, because the compiler 
+emptyPLS _ = PersistentLinkerState {
+                        closure_env = emptyNameEnv,
+                        itbl_env    = emptyNameEnv,
+                        pkgs_loaded = init_pkgs,
+                        bcos_loaded = [],
+                        objs_loaded = [] }
+
+  -- Packages that don't need loading, because the compiler
   -- shares them with the interpreted program.
   --
   -- The linker's symbol table is populated with RTS symbols using an
@@ -180,7 +173,7 @@ getHValue hsc_env name = do
             else
              return (pls, pls)
   lookupName (closure_env pls) name
-        
+
 linkDependencies :: HscEnv -> PersistentLinkerState
                  -> SrcSpan -> [Module]
                  -> IO (PersistentLinkerState, SuccessFlag)
@@ -188,17 +181,17 @@ linkDependencies hsc_env pls span needed_mods = do
 --   initDynLinker (hsc_dflags hsc_env)
    let hpt = hsc_HPT hsc_env
        dflags = hsc_dflags hsc_env
-	-- The interpreter and dynamic linker can only handle object code built
-	-- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
-	-- So here we check the build tag: if we're building a non-standard way
-	-- then we need to find & link object files built the "normal" way.
+   -- The interpreter and dynamic linker can only handle object code built
+   -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
+   -- So here we check the build tag: if we're building a non-standard way
+   -- then we need to find & link object files built the "normal" way.
    maybe_normal_osuf <- checkNonStdWay dflags span
 
-	-- Find what packages and linkables are required
+   -- Find what packages and linkables are required
    (lnks, pkgs) <- getLinkDeps hsc_env hpt pls
-				maybe_normal_osuf span needed_mods
+                               maybe_normal_osuf span needed_mods
 
-	-- Link the packages and modules required
+   -- Link the packages and modules required
    pls1 <- linkPackages' dflags pkgs pls
    linkModules dflags pls1 lnks
 
@@ -223,35 +216,35 @@ withExtendedLinkEnv new_env action
                     new = delListFromNameEnv cur (map fst new_env)
                 in return pls{ closure_env = new }
 
--- filterNameMap removes from the environment all entries except 
--- 	those for a given set of modules;
--- Note that this removes all *local* (i.e. non-isExternal) names too 
---	(these are the temporary bindings from the command line).
+-- filterNameMap removes from the environment all entries except
+-- those for a given set of modules;
+-- Note that this removes all *local* (i.e. non-isExternal) names too
+-- (these are the temporary bindings from the command line).
 -- Used to filter both the ClosureEnv and ItblEnv
 
 filterNameMap :: [Module] -> NameEnv (Name, a) -> NameEnv (Name, a)
-filterNameMap mods env 
+filterNameMap mods env
    = filterNameEnv keep_elt env
    where
-     keep_elt (n,_) = isExternalName n 
-		      && (nameModule n `elem` mods)
+     keep_elt (n,_) = isExternalName n
+                      && (nameModule n `elem` mods)
 
 
 -- | Display the persistent linker state.
 showLinkerState :: IO ()
 showLinkerState
-  = do pls <- readIORef v_PersistentLinkerState >>= readMVar 
+  = do pls <- readIORef v_PersistentLinkerState >>= readMVar
        printDump (vcat [text "----- Linker state -----",
-			text "Pkgs:" <+> ppr (pkgs_loaded pls),
-			text "Objs:" <+> ppr (objs_loaded pls),
-			text "BCOs:" <+> ppr (bcos_loaded pls)])
+                        text "Pkgs:" <+> ppr (pkgs_loaded pls),
+                        text "Objs:" <+> ppr (objs_loaded pls),
+                        text "BCOs:" <+> ppr (bcos_loaded pls)])
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Initialisation}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -284,56 +277,56 @@ initDynLinker dflags =
 reallyInitDynLinker :: DynFlags -> IO PersistentLinkerState
 reallyInitDynLinker dflags =
     do  {  -- Initialise the linker state
-	  let pls0 = emptyPLS dflags
+          let pls0 = emptyPLS dflags
 
-	 	-- (a) initialise the C dynamic linker
-	; initObjLinker 
+          -- (a) initialise the C dynamic linker
+        ; initObjLinker
 
-		-- (b) Load packages from the command-line
-	; pls <- linkPackages' dflags (preloadPackages (pkgState dflags)) pls0
+          -- (b) Load packages from the command-line
+        ; pls <- linkPackages' dflags (preloadPackages (pkgState dflags)) pls0
 
-	   	-- (c) Link libraries from the command-line
-	; let optl = getOpts dflags opt_l
-	; let minus_ls = [ lib | '-':'l':lib <- optl ]
+          -- (c) Link libraries from the command-line
+        ; let optl = getOpts dflags opt_l
+        ; let minus_ls = [ lib | '-':'l':lib <- optl ]
         ; let lib_paths = libraryPaths dflags
         ; libspecs <- mapM (locateLib dflags False lib_paths) minus_ls
 
-	   	-- (d) Link .o files from the command-line
+          -- (d) Link .o files from the command-line
         ; cmdline_ld_inputs <- readIORef v_Ld_inputs
 
-	; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
+        ; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
 
-                -- (e) Link any MacOS frameworks
-	; let framework_paths
+          -- (e) Link any MacOS frameworks
+        ; let framework_paths
                | isDarwinTarget = frameworkPaths dflags
                | otherwise      = []
-	; let frameworks
+        ; let frameworks
                | isDarwinTarget = cmdlineFrameworks dflags
                | otherwise      = []
-		-- Finally do (c),(d),(e)	
+          -- Finally do (c),(d),(e)
         ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
                                ++ libspecs
-			       ++ map Framework frameworks
-	; if null cmdline_lib_specs then return pls
-				    else do
+                               ++ map Framework frameworks
+        ; if null cmdline_lib_specs then return pls
+                                    else do
 
- 	{ mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
-	; maybePutStr dflags "final link ... "
-	; ok <- resolveObjs
+        { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
+        ; maybePutStr dflags "final link ... "
+        ; ok <- resolveObjs
 
-	; if succeeded ok then maybePutStrLn dflags "done"
-	  else ghcError (ProgramError "linking extra libraries/objects failed")
+        ; if succeeded ok then maybePutStrLn dflags "done"
+          else ghcError (ProgramError "linking extra libraries/objects failed")
 
         ; return pls
-	}}
+        }}
 
 classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
 classifyLdInput f
   | isObjectFilename f = return (Just (Object f))
   | isDynLibFilename f = return (Just (DLLPath f))
-  | otherwise 	       = do
-	hPutStrLn stderr ("Warning: ignoring unrecognised input `" ++ f ++ "'")
-	return Nothing
+  | otherwise          = do
+        hPutStrLn stderr ("Warning: ignoring unrecognised input `" ++ f ++ "'")
+        return Nothing
 
 preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
 preloadLib dflags lib_paths framework_paths lib_spec
@@ -355,13 +348,13 @@ preloadLib dflags lib_paths framework_paths lib_spec
                       Nothing -> maybePutStrLn dflags "done"
                       Just mm -> preloadFailed mm lib_paths lib_spec
 
-	  DLLPath dll_path
-	     -> do maybe_errstr <- loadDLL dll_path
+          DLLPath dll_path
+             -> do maybe_errstr <- loadDLL dll_path
                    case maybe_errstr of
                       Nothing -> maybePutStrLn dflags "done"
                       Just mm -> preloadFailed mm lib_paths lib_spec
 
-	  Framework framework
+          Framework framework
            | isDarwinTarget
              -> do maybe_errstr <- loadFramework framework_paths framework
                    case maybe_errstr of
@@ -374,13 +367,13 @@ preloadLib dflags lib_paths framework_paths lib_spec
     preloadFailed sys_errmsg paths spec
        = do maybePutStr dflags "failed.\n"
             ghcError $
-	      CmdLineError (
+              CmdLineError (
                     "user specified .o/.so/.DLL could not be loaded ("
                     ++ sys_errmsg ++ ")\nWhilst trying to load:  "
                     ++ showLS spec ++ "\nAdditional directories searched:"
                     ++ (if null paths then " (none)" else
                         (concat (intersperse "\n" (map ("   "++) paths)))))
-    
+
     -- Not interested in the paths in the static case.
     preload_static _paths name
        = do b <- doesFileExist name
@@ -394,9 +387,9 @@ preloadLib dflags lib_paths framework_paths lib_spec
 
 
 %************************************************************************
-%*									*
-		Link a byte-code expression
-%*									*
+%*                                                                      *
+                Link a byte-code expression
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -408,25 +401,25 @@ preloadLib dflags lib_paths framework_paths lib_spec
 --
 linkExpr :: HscEnv -> SrcSpan -> UnlinkedBCO -> IO HValue
 linkExpr hsc_env span root_ul_bco
-  = do {  
-	-- Initialise the linker (if it's not been done already)
+  = do {
+     -- Initialise the linker (if it's not been done already)
      let dflags = hsc_dflags hsc_env
    ; initDynLinker dflags
 
-        -- Take lock for the actual work.
+     -- Take lock for the actual work.
    ; modifyPLS $ \pls0 -> do {
 
-	-- Link the packages and modules required
+     -- Link the packages and modules required
    ; (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
    ; if failed ok then
-	ghcError (ProgramError "")
+        ghcError (ProgramError "")
      else do {
 
-	-- Link the expression itself
+     -- Link the expression itself
      let ie = itbl_env pls
-	 ce = closure_env pls
+         ce = closure_env pls
 
-	-- Link the necessary packages and linkables
+     -- Link the necessary packages and linkables
    ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
    ; return (pls, root_hval)
    }}}
@@ -434,15 +427,15 @@ linkExpr hsc_env span root_ul_bco
      free_names = nameSetToList (bcoFreeNames root_ul_bco)
 
      needed_mods :: [Module]
-     needed_mods = [ nameModule n | n <- free_names, 
+     needed_mods = [ nameModule n | n <- free_names,
                      isExternalName n,      -- Names from other modules
                      not (isWiredInName n)  -- Exclude wired-in names
                    ]                        -- (see note below)
-	-- Exclude wired-in names because we may not have read
-	-- their interface files, so getLinkDeps will fail
-	-- All wired-in names are in the base package, which we link
-	-- by default, so we can safely ignore them here.
- 
+        -- Exclude wired-in names because we may not have read
+        -- their interface files, so getLinkDeps will fail
+        -- All wired-in names are in the base package, which we link
+        -- by default, so we can safely ignore them here.
+
 dieWith :: SrcSpan -> MsgDoc -> IO a
 dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage SevFatal span msg)))
 
@@ -472,41 +465,41 @@ failNonStd srcspan = dieWith srcspan $
   ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$
   ptext (sLit "You need to build the program twice: once the normal way, and then") $$
   ptext (sLit "in the desired way using -osuf to set the object file suffix.")
-  
+
 
 getLinkDeps :: HscEnv -> HomePackageTable
             -> PersistentLinkerState
             -> Bool                             -- replace object suffices?
-	    -> SrcSpan				-- for error messages
-	    -> [Module]				-- If you need these
-	    -> IO ([Linkable], [PackageId])	-- ... then link these first
+            -> SrcSpan                          -- for error messages
+            -> [Module]                         -- If you need these
+            -> IO ([Linkable], [PackageId])     -- ... then link these first
 -- Fails with an IO exception if it can't find enough files
 
 getLinkDeps hsc_env hpt pls replace_osuf span mods
 -- Find all the packages and linkables that a set of modules depends on
  = do {
-	-- 1.  Find the dependent home-pkg-modules/packages from each iface
+        -- 1.  Find the dependent home-pkg-modules/packages from each iface
         -- (omitting iINTERACTIVE, which is already linked)
         (mods_s, pkgs_s) <- follow_deps (filter ((/=) iNTERACTIVE) mods)
                                         emptyUniqSet emptyUniqSet;
 
-	let {
-	-- 2.  Exclude ones already linked
-	--	Main reason: avoid findModule calls in get_linkable
-	    mods_needed = mods_s `minusList` linked_mods     ;
-	    pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
+        let {
+        -- 2.  Exclude ones already linked
+        --      Main reason: avoid findModule calls in get_linkable
+            mods_needed = mods_s `minusList` linked_mods     ;
+            pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
 
-	    linked_mods = map (moduleName.linkableModule) 
+            linked_mods = map (moduleName.linkableModule)
                                 (objs_loaded pls ++ bcos_loaded pls)
-	} ;
-	
-	-- 3.  For each dependent module, find its linkable
-	--     This will either be in the HPT or (in the case of one-shot
-	--     compilation) we may need to use maybe_getFileLinkable
+        } ;
+
+        -- 3.  For each dependent module, find its linkable
+        --     This will either be in the HPT or (in the case of one-shot
+        --     compilation) we may need to use maybe_getFileLinkable
         let { osuf = objectSuf dflags } ;
         lnks_needed <- mapM (get_linkable osuf replace_osuf) mods_needed ;
 
-	return (lnks_needed, pkgs_needed) }
+        return (lnks_needed, pkgs_needed) }
   where
     dflags = hsc_dflags hsc_env
     this_pkg = thisPackage dflags
@@ -527,8 +520,8 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
           mb_iface <- initIfaceCheck hsc_env $
                         loadInterface msg mod (ImportByUser False)
           iface <- case mb_iface of
-        	    Maybes.Failed err      -> ghcError (ProgramError (showSDoc err))
-	            Maybes.Succeeded iface -> return iface
+                    Maybes.Failed err      -> ghcError (ProgramError (showSDoc err))
+                    Maybes.Succeeded iface -> return iface
 
           when (mi_boot iface) $ link_boot_mod_error mod
 
@@ -554,44 +547,44 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
                   text "due to use of Template Haskell"
 
 
-    link_boot_mod_error mod = 
+    link_boot_mod_error mod =
         ghcError (ProgramError (showSDoc (
-            text "module" <+> ppr mod <+> 
+            text "module" <+> ppr mod <+>
             text "cannot be linked; it is only available as a boot module")))
 
     no_obj :: Outputable a => a -> IO b
     no_obj mod = dieWith span $
-		     ptext (sLit "cannot find object file for module ") <> 
-			quotes (ppr mod) $$
-		     while_linking_expr
-		
+                     ptext (sLit "cannot find object file for module ") <>
+                        quotes (ppr mod) $$
+                     while_linking_expr
+
     while_linking_expr = ptext (sLit "while linking an interpreted expression")
 
-	-- This one is a build-system bug
+        -- This one is a build-system bug
 
     get_linkable osuf replace_osuf mod_name      -- A home-package module
-	| Just mod_info <- lookupUFM hpt mod_name 
-	= adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
-	| otherwise	
-	= do	-- It's not in the HPT because we are in one shot mode, 
-		-- so use the Finder to get a ModLocation...
-	     mb_stuff <- findHomeModule hsc_env mod_name
-	     case mb_stuff of
-		  Found loc mod -> found loc mod
-		  _ -> no_obj mod_name
+        | Just mod_info <- lookupUFM hpt mod_name
+        = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
+        | otherwise
+        = do    -- It's not in the HPT because we are in one shot mode,
+                -- so use the Finder to get a ModLocation...
+             mb_stuff <- findHomeModule hsc_env mod_name
+             case mb_stuff of
+                  Found loc mod -> found loc mod
+                  _ -> no_obj mod_name
         where
             found loc mod = do {
-		-- ...and then find the linkable for it
-	       mb_lnk <- findObjectLinkableMaybe mod loc ;
-	       case mb_lnk of {
-		  Nothing  -> no_obj mod ;
-		  Just lnk -> adjust_linkable lnk
-	      }}
+                -- ...and then find the linkable for it
+               mb_lnk <- findObjectLinkableMaybe mod loc ;
+               case mb_lnk of {
+                  Nothing  -> no_obj mod ;
+                  Just lnk -> adjust_linkable lnk
+              }}
 
             adjust_linkable lnk
                 | replace_osuf = do
                         new_uls <- mapM adjust_ul (linkableUnlinked lnk)
-         		return lnk{ linkableUnlinked=new_uls }
+                        return lnk{ linkableUnlinked=new_uls }
                 | otherwise =
                         return lnk
 
@@ -600,19 +593,19 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
                 let new_file = reverse (drop (length osuf + 1) (reverse file))
                                  <.> normalObjectSuffix
                 ok <- doesFileExist new_file
-		if (not ok)
-		   then dieWith span $
-			  ptext (sLit "cannot find normal object file ")
-				<> quotes (text new_file) $$ while_linking_expr
-		   else return (DotO new_file)
+                if (not ok)
+                   then dieWith span $
+                          ptext (sLit "cannot find normal object file ")
+                                <> quotes (text new_file) $$ while_linking_expr
+                   else return (DotO new_file)
             adjust_ul _ = panic "adjust_ul"
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
               Loading a Decls statement
-%*									*
+%*                                                                      *
 %************************************************************************
 \begin{code}
 linkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO () --[HValue]
@@ -643,7 +636,7 @@ linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
     free_names =  concatMap (nameSetToList . bcoFreeNames) unlinkedBCOs
 
     needed_mods :: [Module]
-    needed_mods = [ nameModule n | n <- free_names, 
+    needed_mods = [ nameModule n | n <- free_names,
                     isExternalName n,       -- Names from other modules
                     not (isWiredInName n)   -- Exclude wired-in names
                   ]                         -- (see note below)
@@ -656,9 +649,9 @@ linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
               Loading a single module
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -672,11 +665,11 @@ linkModule hsc_env mod = do
 \end{code}
 
 %************************************************************************
-%*									*
-		Link some linkables
-	The linkables may consist of a mixture of 
-	byte-code modules and object modules
-%*									*
+%*                                                                      *
+                Link some linkables
+        The linkables may consist of a mixture of
+        byte-code modules and object modules
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -684,19 +677,19 @@ linkModules :: DynFlags -> PersistentLinkerState -> [Linkable]
             -> IO (PersistentLinkerState, SuccessFlag)
 linkModules dflags pls linkables
   = mask_ $ do  -- don't want to be interrupted by ^C in here
-	
-	let (objs, bcos) = partition isObjectLinkable 
+
+        let (objs, bcos) = partition isObjectLinkable
                               (concatMap partitionLinkable linkables)
 
-		-- Load objects first; they can't depend on BCOs
-	(pls1, ok_flag) <- dynLinkObjs dflags pls objs
+                -- Load objects first; they can't depend on BCOs
+        (pls1, ok_flag) <- dynLinkObjs dflags pls objs
+
+        if failed ok_flag then
+                return (pls1, Failed)
+          else do
+                pls2 <- dynLinkBCOs pls1 bcos
+                return (pls2, Succeeded)
 
-	if failed ok_flag then 
-		return (pls1, Failed)
-	  else do
-		pls2 <- dynLinkBCOs pls1 bcos
-		return (pls2, Succeeded)
-		
 
 -- HACK to support f-x-dynamic in the interpreter; no other purpose
 partitionLinkable :: Linkable -> [Linkable]
@@ -704,7 +697,7 @@ partitionLinkable li
    = let li_uls = linkableUnlinked li
          li_uls_obj = filter isObject li_uls
          li_uls_bco = filter isInterpretable li_uls
-     in 
+     in
          case (li_uls_obj, li_uls_bco) of
             (_:_, _:_) -> [li {linkableUnlinked=li_uls_obj},
                            li {linkableUnlinked=li_uls_bco}]
@@ -720,118 +713,118 @@ findModuleLinkable_maybe lis mod
 linkableInSet :: Linkable -> [Linkable] -> Bool
 linkableInSet l objs_loaded =
   case findModuleLinkable_maybe objs_loaded (linkableModule l) of
-	Nothing -> False
-	Just m  -> linkableTime l == linkableTime m
+        Nothing -> False
+        Just m  -> linkableTime l == linkableTime m
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{The object-code linker}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 dynLinkObjs :: DynFlags -> PersistentLinkerState -> [Linkable]
             -> IO (PersistentLinkerState, SuccessFlag)
 dynLinkObjs dflags pls objs = do
-	-- Load the object files and link them
-	let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
-	    pls1 		     = pls { objs_loaded = objs_loaded' }
-	    unlinkeds 		     = concatMap linkableUnlinked new_objs
-
-	mapM_ loadObj (map nameOfObject unlinkeds)
-
-	-- Link the all together
-	ok <- resolveObjs
-
-	-- If resolving failed, unload all our 
-	-- object modules and carry on
-	if succeeded ok then do
-		return (pls1, Succeeded)
-	  else do
-		pls2 <- unload_wkr dflags [] pls1
+        -- Load the object files and link them
+        let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
+            pls1                     = pls { objs_loaded = objs_loaded' }
+            unlinkeds                = concatMap linkableUnlinked new_objs
+
+        mapM_ loadObj (map nameOfObject unlinkeds)
+
+        -- Link the all together
+        ok <- resolveObjs
+
+        -- If resolving failed, unload all our
+        -- object modules and carry on
+        if succeeded ok then do
+                return (pls1, Succeeded)
+          else do
+                pls2 <- unload_wkr dflags [] pls1
                 return (pls2, Failed)
 
 
-rmDupLinkables :: [Linkable] 	-- Already loaded
-	       -> [Linkable]	-- New linkables
-	       -> ([Linkable],	-- New loaded set (including new ones)
-		   [Linkable])	-- New linkables (excluding dups)
+rmDupLinkables :: [Linkable]    -- Already loaded
+               -> [Linkable]    -- New linkables
+               -> ([Linkable],  -- New loaded set (including new ones)
+                   [Linkable])  -- New linkables (excluding dups)
 rmDupLinkables already ls
   = go already [] ls
   where
     go already extras [] = (already, extras)
     go already extras (l:ls)
-	| linkableInSet l already = go already     extras     ls
-	| otherwise		  = go (l:already) (l:extras) ls
+        | linkableInSet l already = go already     extras     ls
+        | otherwise               = go (l:already) (l:extras) ls
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{The byte-code linker}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 dynLinkBCOs :: PersistentLinkerState -> [Linkable] -> IO PersistentLinkerState
 dynLinkBCOs pls bcos = do
 
-	let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
-	    pls1 		     = pls { bcos_loaded = bcos_loaded' }
-	    unlinkeds :: [Unlinked]
-	    unlinkeds 		     = concatMap linkableUnlinked new_bcos
-
-	    cbcs :: [CompiledByteCode]
-	    cbcs      = map byteCodeOfObject unlinkeds
-		      
-	    	      
-	    ul_bcos    = [b | ByteCode bs _  <- cbcs, b <- bs]
-	    ies	       = [ie | ByteCode _ ie <- cbcs]
-	    gce	      = closure_env pls
+        let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
+            pls1                     = pls { bcos_loaded = bcos_loaded' }
+            unlinkeds :: [Unlinked]
+            unlinkeds                = concatMap linkableUnlinked new_bcos
+
+            cbcs :: [CompiledByteCode]
+            cbcs      = map byteCodeOfObject unlinkeds
+
+
+            ul_bcos    = [b | ByteCode bs _  <- cbcs, b <- bs]
+            ies        = [ie | ByteCode _ ie <- cbcs]
+            gce       = closure_env pls
             final_ie  = foldr plusNameEnv (itbl_env pls) ies
 
         (final_gce, _linked_bcos) <- linkSomeBCOs True final_ie gce ul_bcos
-		-- XXX What happens to these linked_bcos?
+                -- XXX What happens to these linked_bcos?
 
-	let pls2 = pls1 { closure_env = final_gce,
-			  itbl_env    = final_ie }
+        let pls2 = pls1 { closure_env = final_gce,
+                          itbl_env    = final_ie }
 
-	return pls2
+        return pls2
 
 -- Link a bunch of BCOs and return them + updated closure env.
-linkSomeBCOs :: Bool 	-- False <=> add _all_ BCOs to returned closure env
+linkSomeBCOs :: Bool    -- False <=> add _all_ BCOs to returned closure env
                         -- True  <=> add only toplevel BCOs to closure env
-             -> ItblEnv 
-             -> ClosureEnv 
+             -> ItblEnv
+             -> ClosureEnv
              -> [UnlinkedBCO]
              -> IO (ClosureEnv, [HValue])
-			-- The returned HValues are associated 1-1 with
-			-- the incoming unlinked BCOs.  Each gives the
-			-- value of the corresponding unlinked BCO
-					
+                        -- The returned HValues are associated 1-1 with
+                        -- the incoming unlinked BCOs.  Each gives the
+                        -- value of the corresponding unlinked BCO
+
 linkSomeBCOs toplevs_only ie ce_in ul_bcos
    = do let nms = map unlinkedBCOName ul_bcos
-        hvals <- fixIO 
+        hvals <- fixIO
                     ( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
                                in  mapM (linkBCO ie ce_out) ul_bcos )
         let ce_all_additions = zip nms hvals
             ce_top_additions = filter (isExternalName.fst) ce_all_additions
-            ce_additions     = if toplevs_only then ce_top_additions 
+            ce_additions     = if toplevs_only then ce_top_additions
                                                else ce_all_additions
-            ce_out = -- make sure we're not inserting duplicate names into the 
-		     -- closure environment, which leads to trouble.
-		     ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
-		     extendClosureEnv ce_in ce_additions
+            ce_out = -- make sure we're not inserting duplicate names into the
+                     -- closure environment, which leads to trouble.
+                     ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
+                     extendClosureEnv ce_in ce_additions
         return (ce_out, hvals)
 
 \end{code}
 
 
 %************************************************************************
-%*									*
-		Unload some object modules
-%*									*
+%*                                                                      *
+                Unload some object modules
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -854,92 +847,92 @@ unload :: DynFlags
        -> IO ()
 unload dflags linkables
   = mask_ $ do -- mask, so we're safe from Ctrl-C in here
-  
-	-- Initialise the linker (if it's not been done already)
-	initDynLinker dflags
 
-	new_pls
+        -- Initialise the linker (if it's not been done already)
+        initDynLinker dflags
+
+        new_pls
             <- modifyPLS $ \pls -> do
-	         pls1 <- unload_wkr dflags linkables pls
+                 pls1 <- unload_wkr dflags linkables pls
                  return (pls1, pls1)
 
-	debugTraceMsg dflags 3 (text "unload: retaining objs" <+> ppr (objs_loaded new_pls))
-	debugTraceMsg dflags 3 (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls))
-	return ()
+        debugTraceMsg dflags 3 (text "unload: retaining objs" <+> ppr (objs_loaded new_pls))
+        debugTraceMsg dflags 3 (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls))
+        return ()
 
 unload_wkr :: DynFlags
-           -> [Linkable]		-- stable linkables
-	   -> PersistentLinkerState
+           -> [Linkable]                -- stable linkables
+           -> PersistentLinkerState
            -> IO PersistentLinkerState
 -- Does the core unload business
 -- (the wrapper blocks exceptions and deals with the PLS get and put)
 
 unload_wkr _ linkables pls
-  = do	let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable linkables
+  = do  let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable linkables
 
-	objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
+        objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
         bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
 
-       	let bcos_retained = map linkableModule bcos_loaded'
-	    itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
+        let bcos_retained = map linkableModule bcos_loaded'
+            itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
             closure_env'  = filterNameMap bcos_retained (closure_env pls)
-  	    new_pls = pls { itbl_env = itbl_env',
-			    closure_env = closure_env',
-			    bcos_loaded = bcos_loaded',
-			    objs_loaded = objs_loaded' }
+            new_pls = pls { itbl_env = itbl_env',
+                            closure_env = closure_env',
+                            bcos_loaded = bcos_loaded',
+                            objs_loaded = objs_loaded' }
 
-	return new_pls
+        return new_pls
   where
     maybeUnload :: [Linkable] -> Linkable -> IO Bool
     maybeUnload keep_linkables lnk
       | linkableInSet lnk keep_linkables = return True
-      | otherwise		    
+      | otherwise
       = do mapM_ unloadObj [f | DotO f <- linkableUnlinked lnk]
-		-- The components of a BCO linkable may contain
-		-- dot-o files.  Which is very confusing.
-		--
-		-- But the BCO parts can be unlinked just by 
-		-- letting go of them (plus of course depopulating
-		-- the symbol table which is done in the main body)
-	   return False
+                -- The components of a BCO linkable may contain
+                -- dot-o files.  Which is very confusing.
+                --
+                -- But the BCO parts can be unlinked just by
+                -- letting go of them (plus of course depopulating
+                -- the symbol table which is done in the main body)
+           return False
 \end{code}
 
 
 %************************************************************************
-%*									*
-		Loading packages
-%*									*
+%*                                                                      *
+                Loading packages
+%*                                                                      *
 %************************************************************************
 
 
 \begin{code}
-data LibrarySpec 
-   = Object FilePath 	-- Full path name of a .o file, including trailing .o
-			-- For dynamic objects only, try to find the object 
-			-- file in all the directories specified in 
-			-- v_Library_paths before giving up.
+data LibrarySpec
+   = Object FilePath    -- Full path name of a .o file, including trailing .o
+                        -- For dynamic objects only, try to find the object
+                        -- file in all the directories specified in
+                        -- v_Library_paths before giving up.
 
-   | Archive FilePath 	-- Full path name of a .a file, including trailing .a
+   | Archive FilePath   -- Full path name of a .a file, including trailing .a
 
-   | DLL String		-- "Unadorned" name of a .DLL/.so
-			--  e.g.    On unix     "qt"  denotes "libqt.so"
-			--          On WinDoze  "burble"  denotes "burble.DLL"
-			--  loadDLL is platform-specific and adds the lib/.so/.DLL
-			--  suffixes platform-dependently
+   | DLL String         -- "Unadorned" name of a .DLL/.so
+                        --  e.g.    On unix     "qt"  denotes "libqt.so"
+                        --          On WinDoze  "burble"  denotes "burble.DLL"
+                        --  loadDLL is platform-specific and adds the lib/.so/.DLL
+                        --  suffixes platform-dependently
 
    | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library
-			-- (ends with .dll or .so).
+                        -- (ends with .dll or .so).
 
-   | Framework String	-- Only used for darwin, but does no harm
+   | Framework String   -- Only used for darwin, but does no harm
 
 -- If this package is already part of the GHCi binary, we'll already
 -- have the right DLLs for this package loaded, so don't try to
 -- load them again.
--- 
+--
 -- But on Win32 we must load them 'again'; doing so is a harmless no-op
 -- as far as the loader is concerned, but it does initialise the list
--- of DLL handles that rts/Linker.c maintains, and that in turn is 
--- used by lookupSymbol.  So we must call addDLL for each library 
+-- of DLL handles that rts/Linker.c maintains, and that in turn is
+-- used by lookupSymbol.  So we must call addDLL for each library
 -- just to get the DLL handle into the list.
 partOfGHCi :: [PackageName]
 partOfGHCi
@@ -964,7 +957,7 @@ linkPackages :: DynFlags -> [PackageId] -> IO ()
 --       we don't really need to use the package-config dependencies.
 --
 -- However we do need the package-config stuff (to find aux libs etc),
--- and following them lets us load libraries in the right order, which 
+-- and following them lets us load libraries in the right order, which
 -- perhaps makes the error message a bit more localised if we get a link
 -- failure.  So the dependency walking code is still here.
 
@@ -989,25 +982,25 @@ linkPackages' dflags new_pks pls = do
          foldM link_one pkgs new_pkgs
 
      link_one pkgs new_pkg
-	| new_pkg `elem` pkgs	-- Already linked
-	= return pkgs
+        | new_pkg `elem` pkgs   -- Already linked
+        = return pkgs
 
-	| Just pkg_cfg <- lookupPackage pkg_map new_pkg
-	= do { 	-- Link dependents first
+        | Just pkg_cfg <- lookupPackage pkg_map new_pkg
+        = do {  -- Link dependents first
                pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
                                     Map.lookup ipid ipid_map
                                   | ipid <- depends pkg_cfg ]
-		-- Now link the package itself
-	     ; linkPackage dflags pkg_cfg
-	     ; return (new_pkg : pkgs') }
+                -- Now link the package itself
+             ; linkPackage dflags pkg_cfg
+             ; return (new_pkg : pkgs') }
 
-	| otherwise
-	= ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
+        | otherwise
+        = ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
 
 
 linkPackage :: DynFlags -> PackageConfig -> IO ()
 linkPackage dflags pkg
-   = do 
+   = do
         let dirs      =  Packages.libraryDirs pkg
 
         let hs_libs   =  Packages.hsLibraries pkg
@@ -1035,29 +1028,29 @@ linkPackage dflags pkg
         extra_classifieds <- mapM (locateLib dflags False dirs) extra_libs
         let classifieds = hs_classifieds ++ extra_classifieds
 
-        -- Complication: all the .so's must be loaded before any of the .o's.  
+        -- Complication: all the .so's must be loaded before any of the .o's.
         let known_dlls = [ dll  | DLLPath dll    <- classifieds ]
             dlls       = [ dll  | DLL dll        <- classifieds ]
             objs       = [ obj  | Object obj     <- classifieds ]
             archs      = [ arch | Archive arch   <- classifieds ]
 
-	maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
+        maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
 
-	-- See comments with partOfGHCi
-	when (packageName pkg `notElem` partOfGHCi) $ do
-	    loadFrameworks pkg
+        -- See comments with partOfGHCi
+        when (packageName pkg `notElem` partOfGHCi) $ do
+            loadFrameworks pkg
             mapM_ load_dyn (known_dlls ++ map mkSOName dlls)
 
-	-- After loading all the DLLs, we can load the static objects.
-	-- Ordering isn't important here, because we do one final link
-	-- step to resolve everything.
-	mapM_ loadObj objs
-	mapM_ loadArchive archs
+        -- After loading all the DLLs, we can load the static objects.
+        -- Ordering isn't important here, because we do one final link
+        -- step to resolve everything.
+        mapM_ loadObj objs
+        mapM_ loadArchive archs
 
         maybePutStr dflags "linking ... "
         ok <- resolveObjs
-	if succeeded ok then maybePutStrLn dflags "done."
-	      else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
+        if succeeded ok then maybePutStrLn dflags "done."
+              else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
 
 -- we have already searched the filesystem; the strings passed to load_dyn
 -- can be passed directly to loadDLL.  They are either fully-qualified
@@ -1080,10 +1073,10 @@ loadFrameworks pkg
     frameworks = Packages.frameworks pkg
 
     load fw = do  r <- loadFramework fw_dirs fw
-		  case r of
-		    Nothing  -> return ()
-		    Just err -> ghcError (CmdLineError ("can't load framework: " 
-                               			        ++ fw ++ " (" ++ err ++ ")" ))
+                  case r of
+                    Nothing  -> return ()
+                    Just err -> ghcError (CmdLineError ("can't load framework: "
+                                                        ++ fw ++ " (" ++ err ++ ")" ))
 
 -- Try to find an object file for a given library in the given paths.
 -- If it isn't present, we assume that addDLL in the RTS can find it,
@@ -1178,40 +1171,40 @@ loadFramework extraPaths rootname
 \end{code}
 
 %************************************************************************
-%*									*
-		Helper functions
-%*									*
+%*                                                                      *
+                Helper functions
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-findFile :: (FilePath -> FilePath)	-- Maps a directory path to a file path
-	 -> [FilePath]			-- Directories to look in
-	 -> IO (Maybe FilePath)		-- The first file path to match
-findFile _ [] 
+findFile :: (FilePath -> FilePath)      -- Maps a directory path to a file path
+         -> [FilePath]                  -- Directories to look in
+         -> IO (Maybe FilePath)         -- The first file path to match
+findFile _ []
   = return Nothing
 findFile mk_file_path (dir:dirs)
-  = do	{ let file_path = mk_file_path dir
-	; b <- doesFileExist file_path
-	; if b then 
-	     return (Just file_path)
-	  else
-	     findFile mk_file_path dirs }
+  = do  { let file_path = mk_file_path dir
+        ; b <- doesFileExist file_path
+        ; if b then
+             return (Just file_path)
+          else
+             findFile mk_file_path dirs }
 \end{code}
 
 \begin{code}
 maybePutStr :: DynFlags -> String -> IO ()
 maybePutStr dflags s | verbosity dflags > 0 = putStr s
-		     | otherwise	    = return ()
+                     | otherwise            = return ()
 
 maybePutStrLn :: DynFlags -> String -> IO ()
 maybePutStrLn dflags s | verbosity dflags > 0 = putStrLn s
-		       | otherwise	      = return ()
+                       | otherwise            = return ()
 \end{code}
 
 %************************************************************************
-%*									*
-	Tunneling global variables into new instance of GHC library
-%*									*
+%*                                                                      *
+        Tunneling global variables into new instance of GHC library
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs
index dedc9ceb2f..2e3965ab0d 100644
--- a/compiler/ghci/ObjLink.lhs
+++ b/compiler/ghci/ObjLink.lhs
@@ -3,38 +3,31 @@
 %
 
 -- ---------------------------------------------------------------------------
--- 	The dynamic linker for object code (.o .so .dll files)
+--      The dynamic linker for object code (.o .so .dll files)
 -- ---------------------------------------------------------------------------
 
 Primarily, this module consists of an interface to the C-land dynamic linker.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-module ObjLink ( 
-   initObjLinker,	 -- :: IO ()
-   loadDLL,		 -- :: String -> IO (Maybe String)
-   loadArchive,     	 -- :: String -> IO ()
-   loadObj,     	 -- :: String -> IO ()
-   unloadObj,   	 -- :: String -> IO ()
+module ObjLink (
+   initObjLinker,        -- :: IO ()
+   loadDLL,              -- :: String -> IO (Maybe String)
+   loadArchive,          -- :: String -> IO ()
+   loadObj,              -- :: String -> IO ()
+   unloadObj,            -- :: String -> IO ()
    insertSymbol,         -- :: String -> String -> Ptr a -> IO ()
-   lookupSymbol,	 -- :: String -> IO (Maybe (Ptr a))
-   resolveObjs  	 -- :: IO SuccessFlag
+   lookupSymbol,         -- :: String -> IO (Maybe (Ptr a))
+   resolveObjs           -- :: IO SuccessFlag
   )  where
 
 import Panic
-import BasicTypes	( SuccessFlag, successIf )
-import Config		( cLeadingUnderscore )
+import BasicTypes       ( SuccessFlag, successIf )
+import Config           ( cLeadingUnderscore )
 import Util
 
 import Control.Monad    ( when )
 import Foreign.C
-import Foreign		( nullPtr )
+import Foreign          ( nullPtr )
 import GHC.Exts         ( Ptr(..) )
 import System.Posix.Internals ( CFilePath, withFilePath )
 import System.FilePath  ( dropExtension )
@@ -57,8 +50,8 @@ lookupSymbol str_in = do
    withCAString str $ \c_str -> do
      addr <- c_lookupSymbol c_str
      if addr == nullPtr
-	then return Nothing
-	else return (Just addr)
+        then return Nothing
+        else return (Just addr)
 
 prefixUnderscore :: String -> String
 prefixUnderscore
@@ -85,9 +78,9 @@ loadDLL str0 = do
   --
   maybe_errmsg <- withFilePath str $ \dll -> c_addDLL dll
   if maybe_errmsg == nullPtr
-	then return Nothing
-	else do str <- peekCString maybe_errmsg
-		return (Just str)
+        then return Nothing
+        else do str <- peekCString maybe_errmsg
+                return (Just str)
 
 loadArchive :: String -> IO ()
 loadArchive str = do
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index f134255578..be07078c1a 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1930,7 +1930,10 @@ genCCall64 target dest_regs args =
     (CmmPrim _ (Just stmts), _) ->
         stmtsToInstrs stmts
 
-    _ -> genCCall64' target dest_regs args
+    _ ->
+        do dflags <- getDynFlags
+           let platform = targetPlatform dflags
+           genCCall64' platform target dest_regs args
 
   where divOp signed width [CmmHinted res_q _, CmmHinted res_r _]
                            [CmmHinted arg_x _, CmmHinted arg_y _]
@@ -1952,22 +1955,32 @@ genCCall64 target dest_regs args =
         divOp _ _ _ _
             = panic "genCCall64: Wrong number of arguments/results for divOp"
 
-genCCall64' :: CmmCallTarget            -- function to call
+genCCall64' :: Platform
+            -> CmmCallTarget            -- function to call
             -> [HintedCmmFormal]        -- where to put the result
             -> [HintedCmmActual]        -- arguments (of mixed type)
             -> NatM InstrBlock
-genCCall64' target dest_regs args = do
+genCCall64' platform target dest_regs args = do
     -- load up the register arguments
-    (stack_args, aregs, fregs, load_args_code)
-         <- load_args args allArgRegs allFPArgRegs nilOL
+    (stack_args, int_regs_used, fp_regs_used, load_args_code)
+         <-
+        if platformOS platform == OSMinGW32
+        then load_args_win args [] [] allArgRegs nilOL
+        else do (stack_args, aregs, fregs, load_args_code)
+                    <- load_args args allIntArgRegs allFPArgRegs nilOL
+                let fp_regs_used  = reverse (drop (length fregs) (reverse allFPArgRegs))
+                    int_regs_used = reverse (drop (length aregs) (reverse allIntArgRegs))
+                return (stack_args, int_regs_used, fp_regs_used, load_args_code)
 
     let
-        fp_regs_used  = reverse (drop (length fregs) (reverse allFPArgRegs))
-        int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
-        arg_regs = [eax] ++ int_regs_used ++ fp_regs_used
+        arg_regs_used = int_regs_used ++ fp_regs_used
+        arg_regs = [eax] ++ arg_regs_used
                 -- for annotating the call instruction with
         sse_regs = length fp_regs_used
-        tot_arg_size = arg_size * length stack_args
+        arg_stack_slots = if platformOS platform == OSMinGW32
+                          then length stack_args + length allArgRegs
+                          else length stack_args
+        tot_arg_size = arg_size * arg_stack_slots
 
 
     -- Align stack to 16n for calls, assuming a starting stack
@@ -1985,6 +1998,11 @@ genCCall64' target dest_regs args = do
 
     -- push the stack args, right to left
     push_code <- push_args (reverse stack_args) nilOL
+    -- On Win64, we also have to leave stack space for the arguments
+    -- that we are passing in registers
+    lss_code <- if platformOS platform == OSMinGW32
+                then leaveStackSpace (length allArgRegs)
+                else return nilOL
     delta <- getDeltaNat
 
     -- deal with static vs dynamic call targets
@@ -2041,6 +2059,7 @@ genCCall64' target dest_regs args = do
     return (load_args_code      `appOL`
             adjust_rsp          `appOL`
             push_code           `appOL`
+            lss_code            `appOL`
             assign_eax sse_regs `appOL`
             call                `appOL`
             assign_code dest_regs)
@@ -2076,15 +2095,43 @@ genCCall64' target dest_regs args = do
                 (args',ars,frs,code') <- load_args rest aregs fregs code
                 return ((CmmHinted arg hint):args', ars, frs, code')
 
+        load_args_win :: [CmmHinted CmmExpr]
+                      -> [Reg]        -- used int regs
+                      -> [Reg]        -- used FP regs
+                      -> [(Reg, Reg)] -- (int, FP) regs avail for args
+                      -> InstrBlock
+                      -> NatM ([CmmHinted CmmExpr],[Reg],[Reg],InstrBlock)
+        load_args_win args usedInt usedFP [] code
+            = return (args, usedInt, usedFP, code)
+            -- no more regs to use
+        load_args_win [] usedInt usedFP _ code
+            = return ([], usedInt, usedFP, code)
+            -- no more args to push
+        load_args_win ((CmmHinted arg _) : rest) usedInt usedFP
+                      ((ireg, freg) : regs) code
+            | isFloatType arg_rep = do
+                 arg_code <- getAnyReg arg
+                 load_args_win rest (ireg : usedInt) (freg : usedFP) regs
+                               (code `appOL`
+                                arg_code freg `snocOL`
+                                -- If we are calling a varargs function
+                                -- then we need to define ireg as well
+                                -- as freg
+                                MOV II64 (OpReg freg) (OpReg ireg))
+            | otherwise = do
+                 arg_code <- getAnyReg arg
+                 load_args_win rest (ireg : usedInt) usedFP regs
+                               (code `appOL` arg_code ireg)
+            where
+              arg_rep = cmmExprType arg
+
         push_args [] code = return code
         push_args ((CmmHinted arg _):rest) code
            | isFloatType arg_rep = do
              (arg_reg, arg_code) <- getSomeReg arg
              delta <- getDeltaNat
              setDeltaNat (delta-arg_size)
-             dflags <- getDynFlags
-             let platform = targetPlatform dflags
-                 code' = code `appOL` arg_code `appOL` toOL [
+             let code' = code `appOL` arg_code `appOL` toOL [
                             SUB (intSize wordWidth) (OpImm (ImmInt arg_size)) (OpReg rsp) ,
                             DELTA (delta-arg_size),
                             MOV (floatSize width) (OpReg arg_reg) (OpAddr  (spRel platform 0))]
@@ -2106,6 +2153,13 @@ genCCall64' target dest_regs args = do
               arg_rep = cmmExprType arg
               width = typeWidth arg_rep
 
+        leaveStackSpace n = do
+             delta <- getDeltaNat
+             setDeltaNat (delta - n * arg_size)
+             return $ toOL [
+                         SUB II64 (OpImm (ImmInt (n * wORD_SIZE))) (OpReg rsp),
+                         DELTA (delta - n * arg_size)]
+
 -- | We're willing to inline and unroll memcpy/memset calls that touch
 -- at most these many bytes.  This threshold is the same as the one
 -- used by GCC and LLVM.
diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs
index 68ab351e86..997caf5574 100644
--- a/compiler/nativeGen/X86/Regs.hs
+++ b/compiler/nativeGen/X86/Regs.hs
@@ -16,6 +16,7 @@ module X86.Regs (
         spRel,
         argRegs,
         allArgRegs,
+        allIntArgRegs,
         callClobberedRegs,
         allMachRegNos,
         classOfRealReg,
@@ -378,9 +379,6 @@ xmm13 = regSingle 37
 xmm14 = regSingle 38
 xmm15 = regSingle 39
 
-allFPArgRegs :: [Reg]
-allFPArgRegs    = map regSingle [firstxmm .. firstxmm+7]
-
 ripRel :: Displacement -> AddrMode
 ripRel imm      = AddrBaseIndex EABaseRip EAIndexNone imm
 
@@ -406,7 +404,9 @@ xmm n = regSingle (firstxmm+n)
 -- horror show -----------------------------------------------------------------
 freeReg                 :: RegNo -> FastBool
 globalRegMaybe          :: GlobalReg -> Maybe RealReg
-allArgRegs              :: [Reg]
+allArgRegs              :: [(Reg, Reg)]
+allIntArgRegs           :: [Reg]
+allFPArgRegs            :: [Reg]
 callClobberedRegs       :: [Reg]
 
 #if defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH)
@@ -625,16 +625,28 @@ globalRegMaybe _                        = Nothing
 
 --
 
-#if   i386_TARGET_ARCH
-allArgRegs = panic "X86.Regs.allArgRegs: should not be used!"
+#if defined(mingw32_HOST_OS) && x86_64_TARGET_ARCH
 
-#elif x86_64_TARGET_ARCH
-allArgRegs = map regSingle [rdi,rsi,rdx,rcx,r8,r9]
+allArgRegs = zip (map regSingle [rcx,rdx,r8,r9])
+                 (map regSingle [firstxmm ..])
+allIntArgRegs = panic "X86.Regs.allIntArgRegs: not defined for this platform"
+allFPArgRegs = panic "X86.Regs.allFPArgRegs: not defined for this platform"
 
 #else
-allArgRegs  = panic "X86.Regs.allArgRegs: not defined for this architecture"
-#endif
 
+allArgRegs = panic "X86.Regs.allArgRegs: not defined for this arch"
+
+# if   i386_TARGET_ARCH
+allIntArgRegs = panic "X86.Regs.allIntArgRegs: should not be used!"
+# elif x86_64_TARGET_ARCH
+allIntArgRegs = map regSingle [rdi,rsi,rdx,rcx,r8,r9]
+# else
+allIntArgRegs = panic "X86.Regs.allIntArgRegs: not defined for this arch"
+# endif
+
+allFPArgRegs    = map regSingle [firstxmm .. firstxmm+7]
+
+#endif
 
 -- | these are the regs which we cannot assume stay alive over a C call.
 
@@ -661,8 +673,10 @@ callClobberedRegs
 freeReg _               = 0#
 globalRegMaybe _        = panic "X86.Regs.globalRegMaybe: not defined"
 
-allArgRegs              = panic "X86.Regs.globalRegMaybe: not defined"
-callClobberedRegs       = panic "X86.Regs.globalRegMaybe: not defined"
+allArgRegs              = panic "X86.Regs.allArgRegs: not defined"
+allIntArgRegs           = panic "X86.Regs.allIntArgRegs: not defined"
+allFPArgRegs            = panic "X86.Regs.allFPArgRegs: not defined"
+callClobberedRegs       = panic "X86.Regs.callClobberedRegs: not defined"
 
 
 #endif
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 394cd9801e..076df2e67c 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -818,7 +818,7 @@ lvlLamBndrs lvl bndrs
 \end{code}
 
 \begin{code}
-  -- Destintion level is the max Id level of the expression
+  -- Destination level is the max Id level of the expression
   -- (We'll abstract the type variables, if any.)
 destLevel :: LevelEnv -> VarSet -> Bool -> Maybe (Arity, StrictSig) -> Level
 destLevel env fvs is_function mb_bot
@@ -830,6 +830,7 @@ destLevel env fvs is_function mb_bot
   , countFreeIds fvs <= n_args
   = tOP_LEVEL	-- Send functions to top level; see
 		-- the comments with isFunction
+
   | otherwise = maxFvLevel isId env fvs  -- Max over Ids only; the tyvars
     	      		   	    	 -- will be abstracted
 
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 7da185a1ae..59ebeea1bc 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -44,7 +44,6 @@ import StaticFlags
 import CoreSyn
 import qualified CoreSubst
 import PprCore
-import DataCon	( dataConCannotMatch, dataConWorkId )
 import CoreFVs
 import CoreUtils
 import CoreArity
@@ -56,7 +55,7 @@ import Demand
 import SimplMonad
 import Type	hiding( substTy )
 import Coercion hiding( substCo )
-import TyCon
+import DataCon          ( dataConWorkId )
 import VarSet
 import BasicTypes
 import Util
@@ -65,7 +64,7 @@ import Outputable
 import FastString
 import Pair
 
-import Data.List
+import Control.Monad    ( when )
 \end{code}
 
 
@@ -1495,97 +1494,18 @@ of the inner case y, which give us nowhere to go!
 
 \begin{code}
 prepareAlts :: OutExpr -> OutId -> [InAlt] -> SimplM ([AltCon], [InAlt])
-prepareAlts scrut case_bndr' alts
-  = do	{ let (alts_wo_default, maybe_deflt) = findDefault alts
-	      alt_cons = [con | (con,_,_) <- alts_wo_default]
-	      imposs_deflt_cons = nub (imposs_cons ++ alt_cons)
-		-- "imposs_deflt_cons" are handled 
-		--   EITHER by the context, 
-		--   OR by a non-DEFAULT branch in this case expression.
-
-	; default_alts <- prepareDefault case_bndr' mb_tc_app 
-					 imposs_deflt_cons maybe_deflt
-
-	; let trimmed_alts = filterOut impossible_alt alts_wo_default
-	      merged_alts  = mergeAlts trimmed_alts default_alts
-		-- We need the mergeAlts in case the new default_alt 
-		-- has turned into a constructor alternative.
-		-- The merge keeps the inner DEFAULT at the front, if there is one
-		-- and interleaves the alternatives in the right order
-
-	; return (imposs_deflt_cons, merged_alts) }
+prepareAlts scrut case_bndr' alts = do
+    us <- getUniquesM
+    -- Case binder is needed just for its type. Note that as an
+    --   OutId, it has maximum information; this is important.
+    --   Test simpl013 is an example
+    let (imposs_deflt_cons, refined_deflt, alts') = filterAlts us (varType case_bndr') imposs_cons alts
+    when refined_deflt $ tick (FillInCaseDefault case_bndr')
+    return (imposs_deflt_cons, alts')
   where
-    mb_tc_app = splitTyConApp_maybe (idType case_bndr')
-    Just (_, inst_tys) = mb_tc_app 
-
     imposs_cons = case scrut of
 		    Var v -> otherCons (idUnfolding v)
 		    _     -> []
-
-    impossible_alt :: CoreAlt -> Bool
-    impossible_alt (con, _, _) | con `elem` imposs_cons = True
-    impossible_alt (DataAlt con, _, _) = dataConCannotMatch inst_tys con
-    impossible_alt _                   = False
-
-
-prepareDefault :: OutId		-- Case binder; need just for its type. Note that as an
-				--   OutId, it has maximum information; this is important.
-				--   Test simpl013 is an example
-	       -> Maybe (TyCon, [Type])	-- Type of scrutinee, decomposed
-	       -> [AltCon]	-- These cons can't happen when matching the default
-	       -> Maybe InExpr	-- Rhs
-	       -> SimplM [InAlt]	-- Still unsimplified
-					-- We use a list because it's what mergeAlts expects,
-
---------- Fill in known constructor -----------
-prepareDefault case_bndr (Just (tycon, inst_tys)) imposs_cons (Just deflt_rhs)
-  | 	-- This branch handles the case where we are 
-	-- scrutinisng an algebraic data type
-    isAlgTyCon tycon		-- It's a data type, tuple, or unboxed tuples.  
-  , not (isNewTyCon tycon)	-- We can have a newtype, if we are just doing an eval:
-				-- 	case x of { DEFAULT -> e }
-				-- and we don't want to fill in a default for them!
-  , Just all_cons <- tyConDataCons_maybe tycon
-  , not (null all_cons)	
-	-- This is a tricky corner case.  If the data type has no constructors,
-	-- which GHC allows, then the case expression will have at most a default
-	-- alternative.  We don't want to eliminate that alternative, because the
-	-- invariant is that there's always one alternative.  It's more convenient
-	-- to leave	
-	--	case x of { DEFAULT -> e }     
-	-- as it is, rather than transform it to
-	--	error "case cant match"
-	-- which would be quite legitmate.  But it's a really obscure corner, and
-	-- not worth wasting code on.
-  , let imposs_data_cons = [con | DataAlt con <- imposs_cons]	-- We now know it's a data type 
-	impossible con   = con `elem` imposs_data_cons || dataConCannotMatch inst_tys con
-  = case filterOut impossible all_cons of
-	[]    -> return []	-- Eliminate the default alternative
-				-- altogether if it can't match
-
-	[con] -> 	-- It matches exactly one constructor, so fill it in
-		 do { tick (FillInCaseDefault case_bndr)
-                    ; us <- getUniquesM
-                    ; let (ex_tvs, arg_ids) = dataConRepInstPat us con inst_tys
-                    ; return [(DataAlt con, ex_tvs ++ arg_ids, deflt_rhs)] }
-
-	_ -> return [(DEFAULT, [], deflt_rhs)]
-
-  | debugIsOn, isAlgTyCon tycon
-  , null (tyConDataCons tycon)
-  , not (isFamilyTyCon tycon || isAbstractTyCon tycon)
-	-- Check for no data constructors
-        -- This can legitimately happen for abstract types and type families,
-        -- so don't report that
-  = pprTrace "prepareDefault" (ppr case_bndr <+> ppr tycon)
-        $ return [(DEFAULT, [], deflt_rhs)]
-
---------- Catch-all cases -----------
-prepareDefault _case_bndr _bndr_ty _imposs_cons (Just deflt_rhs)
-  = return [(DEFAULT, [], deflt_rhs)]
-
-prepareDefault _case_bndr _bndr_ty _imposs_cons Nothing
-  = return []	-- No default branch
 \end{code}
 
 
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index b8c8160972..ab195e87b1 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -1958,6 +1958,8 @@ simplAlts env scrut case_bndr alts cont'
 						       case_bndr case_bndr1 alts
 
         ; (imposs_deflt_cons, in_alts) <- prepareAlts scrut' case_bndr' alts
+          -- NB: it's possible that the returned in_alts is empty: this is handled
+          -- by the caller (rebuildCase) in the missingAlt function
 
 	; let mb_var_scrut = case scrut' of { Var v -> Just v; _ -> Nothing }
         ; alts' <- mapM (simplAlt alt_env' mb_var_scrut
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index ab850399c8..777c03f21d 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/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/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..c1f4f05bea 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
@@ -136,6 +143,24 @@ void _assertFail(const char *filename, unsigned int linenum)
 #define USED_IF_NOT_THREADS
 #endif
 
+#if SIZEOF_VOID_P == 8
+# if SIZEOF_LONG == 8
+#  define FMT_SizeT "lu"
+# elif SIZEOF_LONG_LONG == 8
+#  define FMT_SizeT "llu"
+# else
+#  error Cannot find format specifier for size_t size type
+# endif
+#elif SIZEOF_VOID_P == 4
+# if SIZEOF_INT == 4
+#  define FMT_SizeT "u"
+# else
+#  error Cannot find format specifier for size_t size type
+# endif
+#else
+# error Cannot handle this word size
+#endif
+
 /*
  * Getting printf formats right for platform-dependent typedefs
  */
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/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index 2e09409654..6f2e6de87e 100644
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -30,7 +30,7 @@
 #define str(a,b) #a "_" #b
 
 #define OFFSET(s_type, field) ((size_t)&(((s_type*)0)->field))
-#define FIELD_SIZE(s_type, field) ((unsigned long)sizeof(((s_type*)0)->field))
+#define FIELD_SIZE(s_type, field) ((size_t)sizeof(((s_type*)0)->field))
 #define TYPE_SIZE(type) (sizeof(type))
 
 #pragma GCC poison sizeof
@@ -38,17 +38,17 @@
 #if defined(GEN_HASKELL)
 #define def_offset(str, offset)                          \
     printf("oFFSET_" str " :: Int\n");                   \
-    printf("oFFSET_" str " = %lu\n", (unsigned long)offset);
+    printf("oFFSET_" str " = %" FMT_SizeT "\n", (size_t)offset);
 #else
 #define def_offset(str, offset) \
-    printf("#define OFFSET_" str " %lu\n", (unsigned long)offset);
+    printf("#define OFFSET_" str " %" FMT_SizeT "\n", (size_t)offset);
 #endif
 
 #if defined(GEN_HASKELL)
 #define ctype(type) /* nothing */
 #else
 #define ctype(type) \
-    printf("#define SIZEOF_" #type " %lu\n", (unsigned long)TYPE_SIZE(type));
+    printf("#define SIZEOF_" #type " %" FMT_SizeT "\n", (size_t)TYPE_SIZE(type));
 #endif
 
 #if defined(GEN_HASKELL)
@@ -63,7 +63,7 @@
 */
 #define field_type_(str, s_type, field) \
     printf("#define REP_" str " b"); \
-    printf("%lu\n", FIELD_SIZE(s_type, field) * 8);
+    printf("%" FMT_SizeT "\n", FIELD_SIZE(s_type, field) * 8);
 #define field_type_gcptr_(str, s_type, field) \
     printf("#define REP_" str " gcptr\n");
 #endif
@@ -95,17 +95,17 @@
 #if defined(GEN_HASKELL)
 #define def_size(str, size)                \
     printf("sIZEOF_" str " :: Int\n");     \
-    printf("sIZEOF_" str " = %lu\n", (unsigned long)size);
+    printf("sIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size);
 #else
 #define def_size(str, size) \
-    printf("#define SIZEOF_" str " %lu\n", (unsigned long)size);
+    printf("#define SIZEOF_" str " %" FMT_SizeT "\n", (size_t)size);
 #endif
 
 #if defined(GEN_HASKELL)
 #define def_closure_size(str, size) /* nothing */
 #else
 #define def_closure_size(str, size) \
-    printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%lu)\n", (unsigned long)size);
+    printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%" FMT_SizeT ")\n", (size_t)size);
 #endif
 
 #define struct_size(s_type) \
@@ -193,9 +193,9 @@ main(int argc, char *argv[])
 #ifndef GEN_HASKELL
     printf("/* This file is created automatically.  Do not edit by hand.*/\n\n");
 
-    printf("#define STD_HDR_SIZE   %lu\n", (unsigned long)sizeofW(StgHeader) - sizeofW(StgProfHeader));
+    printf("#define STD_HDR_SIZE   %" FMT_SizeT "\n", (size_t)sizeofW(StgHeader) - sizeofW(StgProfHeader));
     /* grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) */
-    printf("#define PROF_HDR_SIZE  %lu\n", (unsigned long)sizeofW(StgProfHeader));
+    printf("#define PROF_HDR_SIZE  %" FMT_SizeT "\n", (size_t)sizeofW(StgProfHeader));
 
     printf("#define BLOCK_SIZE   %u\n", BLOCK_SIZE);
     printf("#define MBLOCK_SIZE   %u\n", MBLOCK_SIZE);
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/Adjustor.c b/rts/Adjustor.c
index 0f038c4396..a8bf2a283f 100644
--- a/rts/Adjustor.c
+++ b/rts/Adjustor.c
@@ -111,7 +111,7 @@ createAdjustor (int cconv,
         arg_types[i] = char_to_ffi_type(typeString[i+1]);
     }
     switch (cconv) {
-#ifdef mingw32_HOST_OS
+#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
     case 0: /* stdcall */
         abi = FFI_STDCALL;
         break;
@@ -321,10 +321,10 @@ static int totalArgumentSize(char *typeString)
 
 void*
 createAdjustor(int cconv, StgStablePtr hptr,
-	       StgFunPtr wptr,
-	       char *typeString
+               StgFunPtr wptr,
+               char *typeString
 #if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_HOST_ARCH)
-	          STG_UNUSED
+                  STG_UNUSED
 #endif
               )
 {
@@ -339,29 +339,29 @@ createAdjustor(int cconv, StgStablePtr hptr,
        the following assembly language snippet
        (offset and machine code prefixed):
 
-     <0>:	58	          popl   %eax              # temp. remove ret addr..
-     <1>:	68 fd fc fe fa    pushl  0xfafefcfd  	   # constant is large enough to
-        			   	           	   # hold a StgStablePtr
-     <6>:	50	          pushl  %eax		   # put back ret. addr
-     <7>:	b8 fa ef ff 00	  movl   $0x00ffeffa, %eax # load up wptr
-     <c>: 	ff e0             jmp    %eax        	   # and jump to it.
-		# the callee cleans up the stack
+     <0>:       58                popl   %eax              # temp. remove ret addr..
+     <1>:       68 fd fc fe fa    pushl  0xfafefcfd        # constant is large enough to
+                                                           # hold a StgStablePtr
+     <6>:       50                pushl  %eax              # put back ret. addr
+     <7>:       b8 fa ef ff 00    movl   $0x00ffeffa, %eax # load up wptr
+     <c>:       ff e0             jmp    %eax              # and jump to it.
+                # the callee cleans up the stack
     */
     adjustor = allocateExec(14,&code);
     {
-	unsigned char *const adj_code = (unsigned char *)adjustor;
-	adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
+        unsigned char *const adj_code = (unsigned char *)adjustor;
+        adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
 
-	adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
-	*((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
+        adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
+        *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
 
-	adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
+        adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
 
-	adj_code[0x07] = (unsigned char)0xb8; /* movl  $wptr, %eax */
-	*((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
+        adj_code[0x07] = (unsigned char)0xb8; /* movl  $wptr, %eax */
+        *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
 
-	adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
-	adj_code[0x0d] = (unsigned char)0xe0;
+        adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
+        adj_code[0x0d] = (unsigned char)0xe0;
     }
 #endif
     break;
@@ -405,13 +405,137 @@ createAdjustor(int cconv, StgStablePtr hptr,
     }
     
 #elif defined(x86_64_HOST_ARCH)
+
+# if defined(mingw32_HOST_OS)
     /*
       stack at call:
                argn
-	       ...
-	       arg7
+               ...
+               arg5
                return address
-	       %rdi,%rsi,%rdx,%rcx,%r8,%r9 = arg0..arg6
+               %rcx,%rdx,%r8,%r9 = arg1..arg4
+
+      if there are <4 integer args, then we can just push the
+      StablePtr into %rcx and shuffle the other args up.
+
+      If there are >=4 integer args, then we have to flush one arg
+      to the stack, and arrange to adjust the stack ptr on return.
+      The stack will be rearranged to this:
+
+             argn
+             ...
+             arg5
+             return address  *** <-- dummy arg in stub fn.
+             arg4
+             obscure_ccall_ret_code
+
+      This unfortunately means that the type of the stub function
+      must have a dummy argument for the original return address
+      pointer inserted just after the 4th integer argument.
+
+      Code for the simple case:
+
+   0:   4d 89 c1                mov    %r8,%r9
+   3:   49 89 d0                mov    %rdx,%r8
+   6:   48 89 ca                mov    %rcx,%rdx
+   9:   f2 0f 10 da             movsd  %xmm2,%xmm3
+   d:   f2 0f 10 d1             movsd  %xmm1,%xmm2
+  11:   f2 0f 10 c8             movsd  %xmm0,%xmm1
+  15:   48 8b 0d 0c 00 00 00    mov    0xc(%rip),%rcx    # 28 <.text+0x28>
+  1c:   ff 25 0e 00 00 00       jmpq   *0xe(%rip)        # 30 <.text+0x30>
+  22:   90                      nop
+  [...]
+
+
+  And the version for >=4 integer arguments:
+  (note: replace 2-6 with nops if the 4th argument is not a floating
+  point argument).
+
+   0:   41 51                   push   %r9
+   2:   f2 0f 11 1c 24          movsd  %xmm3,(%rsp)
+   7:   ff 35 23 00 00 00       pushq  0x23(%rip)        # 30 <.text+0x30>
+   d:   4d 89 c1                mov    %r8,%r9
+  10:   49 89 d0                mov    %rdx,%r8
+  13:   48 89 ca                mov    %rcx,%rdx
+  16:   f2 0f 10 da             movsd  %xmm2,%xmm3
+  1a:   f2 0f 10 d1             movsd  %xmm1,%xmm2
+  1e:   f2 0f 10 c8             movsd  %xmm0,%xmm1
+  22:   48 8b 0d 0f 00 00 00    mov    0xf(%rip),%rcx    # 38 <.text+0x38>
+  29:   ff 25 11 00 00 00       jmpq   *0x11(%rip)       # 40 <.text+0x40>
+  2f:   90                      nop
+  [...]
+
+    */
+    {  
+        int i = 0;
+        int fourthFloating;
+        char *c;
+        StgWord8 *adj_code;
+
+        // determine whether we have 4 or more integer arguments,
+        // and therefore need to flush one to the stack.
+        for (c = typeString; *c != '\0'; c++) {
+            i++;
+            if (i == 4) {
+                fourthFloating = (*c == 'f' || *c == 'd');
+                break;
+            }
+        }
+
+        if (i < 4) {
+            adjustor = allocateExec(0x38,&code);
+            adj_code = (StgWord8*)adjustor;
+
+            *(StgInt32 *)adj_code        = 0x49c1894d;
+            *(StgInt32 *)(adj_code+0x4)  = 0x8948d089;
+            *(StgInt32 *)(adj_code+0x8)  = 0x100ff2ca;
+            *(StgInt32 *)(adj_code+0xc)  = 0x100ff2da;
+            *(StgInt32 *)(adj_code+0x10) = 0x100ff2d1;
+            *(StgInt32 *)(adj_code+0x14) = 0x0d8b48c8;
+            *(StgInt32 *)(adj_code+0x18) = 0x0000000c;
+
+            *(StgInt32 *)(adj_code+0x1c) = 0x000e25ff;
+            *(StgInt32 *)(adj_code+0x20) = 0x00000000;
+            *(StgInt64 *)(adj_code+0x28) = (StgInt64)hptr;
+            *(StgInt64 *)(adj_code+0x30) = (StgInt64)wptr;
+        }
+        else
+        {
+            adjustor = allocateExec(0x48,&code);
+            adj_code = (StgWord8*)adjustor;
+
+            if (fourthFloating) {
+                *(StgInt32 *)adj_code        = 0x0ff25141;
+                *(StgInt32 *)(adj_code+0x4)  = 0xff241c11;
+            }
+            else {
+                *(StgInt32 *)adj_code        = 0x90905141;
+                *(StgInt32 *)(adj_code+0x4)  = 0xff909090;
+            }
+            *(StgInt32 *)(adj_code+0x8)  = 0x00002335;
+            *(StgInt32 *)(adj_code+0xc)  = 0xc1894d00;
+            *(StgInt32 *)(adj_code+0x10) = 0x48d08949;
+            *(StgInt32 *)(adj_code+0x14) = 0x0ff2ca89;
+            *(StgInt32 *)(adj_code+0x18) = 0x0ff2da10;
+            *(StgInt32 *)(adj_code+0x1c) = 0x0ff2d110;
+            *(StgInt32 *)(adj_code+0x20) = 0x8b48c810;
+            *(StgInt32 *)(adj_code+0x24) = 0x00000f0d;
+            *(StgInt32 *)(adj_code+0x28) = 0x1125ff00;
+            *(StgInt32 *)(adj_code+0x2c) = 0x00000000;
+            
+            *(StgInt64 *)(adj_code+0x30) = (StgInt64)obscure_ccall_ret_code;
+            *(StgInt64 *)(adj_code+0x38) = (StgInt64)hptr;
+            *(StgInt64 *)(adj_code+0x40) = (StgInt64)wptr;
+        }
+    }
+# else
+    /*
+      stack at call:
+               argn
+               ...
+               arg7
+               return address
+               %rdi,%rsi,%rdx,%rcx,%r8,%r9 = arg1..arg6
 
       if there are <6 integer args, then we can just push the
       StablePtr into %edi and shuffle the other args up.
@@ -421,11 +545,11 @@ createAdjustor(int cconv, StgStablePtr hptr,
       The stack will be rearranged to this:
 
              argn
-	     ...
-	     arg7
-	     return address  *** <-- dummy arg in stub fn.
-	     arg6
-	     obscure_ccall_ret_code
+             ...
+             arg7
+             return address  *** <-- dummy arg in stub fn.
+             arg6
+             obscure_ccall_ret_code
 
       This unfortunately means that the type of the stub function
       must have a dummy argument for the original return address
@@ -463,51 +587,54 @@ createAdjustor(int cconv, StgStablePtr hptr,
     */
 
     {  
-	int i = 0;
-	char *c;
-	StgWord8 *adj_code;
-
-	// determine whether we have 6 or more integer arguments,
-	// and therefore need to flush one to the stack.
-	for (c = typeString; *c != '\0'; c++) {
-	    if (*c != 'f' && *c != 'd') i++;
-	    if (i == 6) break;
-	}
-
-	if (i < 6) {
-	    adjustor = allocateExec(0x30,&code);
+        int i = 0;
+        char *c;
+        StgWord8 *adj_code;
+
+        // determine whether we have 6 or more integer arguments,
+        // and therefore need to flush one to the stack.
+        for (c = typeString; *c != '\0'; c++) {
+            if (*c != 'f' && *c != 'd') i++;
+            if (i == 6) break;
+        }
+
+        if (i < 6) {
+            adjustor = allocateExec(0x30,&code);
             adj_code = (StgWord8*)adjustor;
 
-	    *(StgInt32 *)adj_code        = 0x49c1894d;
-	    *(StgInt32 *)(adj_code+0x4)  = 0x8948c889;
-	    *(StgInt32 *)(adj_code+0x8)  = 0xf28948d1;
-	    *(StgInt32 *)(adj_code+0xc)  = 0x48fe8948;
-	    *(StgInt32 *)(adj_code+0x10) = 0x000a3d8b;
-	    *(StgInt32 *)(adj_code+0x14) = 0x25ff0000;
-	    *(StgInt32 *)(adj_code+0x18) = 0x0000000c;
-	    *(StgInt64 *)(adj_code+0x20) = (StgInt64)hptr;
-	    *(StgInt64 *)(adj_code+0x28) = (StgInt64)wptr;
-	}
-	else
-	{
-	    adjustor = allocateExec(0x40,&code);
+            *(StgInt32 *)adj_code        = 0x49c1894d;
+            *(StgInt32 *)(adj_code+0x4)  = 0x8948c889;
+            *(StgInt32 *)(adj_code+0x8)  = 0xf28948d1;
+            *(StgInt32 *)(adj_code+0xc)  = 0x48fe8948;
+            *(StgInt32 *)(adj_code+0x10) = 0x000a3d8b;
+            *(StgInt32 *)(adj_code+0x14) = 0x25ff0000;
+            *(StgInt32 *)(adj_code+0x18) = 0x0000000c;
+            *(StgInt64 *)(adj_code+0x20) = (StgInt64)hptr;
+            *(StgInt64 *)(adj_code+0x28) = (StgInt64)wptr;
+        }
+        else
+        {
+            adjustor = allocateExec(0x40,&code);
             adj_code = (StgWord8*)adjustor;
 
-	    *(StgInt32 *)adj_code        = 0x35ff5141;
-	    *(StgInt32 *)(adj_code+0x4)  = 0x00000020;
-	    *(StgInt32 *)(adj_code+0x8)  = 0x49c1894d;
-	    *(StgInt32 *)(adj_code+0xc)  = 0x8948c889;
-	    *(StgInt32 *)(adj_code+0x10) = 0xf28948d1;
-	    *(StgInt32 *)(adj_code+0x14) = 0x48fe8948;
-	    *(StgInt32 *)(adj_code+0x18) = 0x00123d8b;
-	    *(StgInt32 *)(adj_code+0x1c) = 0x25ff0000;
-	    *(StgInt32 *)(adj_code+0x20) = 0x00000014;
-	    
-	    *(StgInt64 *)(adj_code+0x28) = (StgInt64)obscure_ccall_ret_code;
-	    *(StgInt64 *)(adj_code+0x30) = (StgInt64)hptr;
-	    *(StgInt64 *)(adj_code+0x38) = (StgInt64)wptr;
-	}
+            *(StgInt32 *)adj_code        = 0x35ff5141;
+            *(StgInt32 *)(adj_code+0x4)  = 0x00000020;
+            *(StgInt32 *)(adj_code+0x8)  = 0x49c1894d;
+            *(StgInt32 *)(adj_code+0xc)  = 0x8948c889;
+            *(StgInt32 *)(adj_code+0x10) = 0xf28948d1;
+            *(StgInt32 *)(adj_code+0x14) = 0x48fe8948;
+            *(StgInt32 *)(adj_code+0x18) = 0x00123d8b;
+            *(StgInt32 *)(adj_code+0x1c) = 0x25ff0000;
+            *(StgInt32 *)(adj_code+0x20) = 0x00000014;
+            
+            *(StgInt64 *)(adj_code+0x28) = (StgInt64)obscure_ccall_ret_code;
+            *(StgInt64 *)(adj_code+0x30) = (StgInt64)hptr;
+            *(StgInt64 *)(adj_code+0x38) = (StgInt64)wptr;
+        }
     }
+# endif
+
+
 #elif defined(sparc_HOST_ARCH)
   /* Magic constant computed by inspecting the code length of the following
      assembly language snippet (offset and machine code prefixed):
@@ -579,14 +706,14 @@ createAdjustor(int cconv, StgStablePtr hptr,
      (offset and machine code prefixed; note that the machine code
      shown is longwords stored in little-endian order):
 
-  <00>: 46520414	mov	a2, a4
-  <04>: 46100412	mov	a0, a2
-  <08>: a61b0020	ldq     a0, 0x20(pv)	# load up hptr
-  <0c>: 46730415	mov	a3, a5
-  <10>: a77b0028	ldq     pv, 0x28(pv)	# load up wptr
-  <14>: 46310413	mov	a1, a3
-  <18>: 6bfb----	jmp     (pv), <hint>	# jump to wptr (with hint)
-  <1c>: 00000000				# padding for alignment
+  <00>: 46520414        mov     a2, a4
+  <04>: 46100412        mov     a0, a2
+  <08>: a61b0020        ldq     a0, 0x20(pv)    # load up hptr
+  <0c>: 46730415        mov     a3, a5
+  <10>: a77b0028        ldq     pv, 0x28(pv)    # load up wptr
+  <14>: 46310413        mov     a1, a3
+  <18>: 6bfb----        jmp     (pv), <hint>    # jump to wptr (with hint)
+  <1c>: 00000000                                # padding for alignment
   <20>: [8 bytes for hptr quadword]
   <28>: [8 bytes for wptr quadword]
 
@@ -617,19 +744,19 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
     ASSERT(((StgWord64)wptr & 3) == 0);
     adjustor = allocateExec(48,&code);
     {
-	StgWord64 *const code = (StgWord64 *)adjustor;
+        StgWord64 *const code = (StgWord64 *)adjustor;
 
-	code[0] = 0x4610041246520414L;
-	code[1] = 0x46730415a61b0020L;
-	code[2] = 0x46310413a77b0028L;
-	code[3] = 0x000000006bfb0000L
-		| (((StgWord32*)(wptr) - (StgWord32*)(code) - 3) & 0x3fff);
+        code[0] = 0x4610041246520414L;
+        code[1] = 0x46730415a61b0020L;
+        code[2] = 0x46310413a77b0028L;
+        code[3] = 0x000000006bfb0000L
+                | (((StgWord32*)(wptr) - (StgWord32*)(code) - 3) & 0x3fff);
 
-	code[4] = (StgWord64)hptr;
-	code[5] = (StgWord64)wptr;
+        code[4] = (StgWord64)hptr;
+        code[5] = (StgWord64)wptr;
 
-	/* Ensure that instruction cache is consistent with our new code */
-	__asm__ volatile("call_pal %0" : : "i" (PAL_imb));
+        /* Ensure that instruction cache is consistent with our new code */
+        __asm__ volatile("call_pal %0" : : "i" (PAL_imb));
     }
 #elif defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
 
@@ -959,82 +1086,82 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
     The function descriptor we create contains the gp of the target function
     so gp is already loaded correctly.
 
-	[MLX]       alloc r16=ar.pfs,10,2,0
-		    movl r17=wptr
-	[MII]       st8.spill [r12]=r38,8		// spill in6 (out4)
-		    mov r41=r37				// out7 = in5 (out3)
-		    mov r40=r36;;			// out6 = in4 (out2)
-	[MII]       st8.spill [r12]=r39			// spill in7 (out5)
-		    mov.sptk b6=r17,50
-		    mov r38=r34;;			// out4 = in2 (out0)
-	[MII]       mov r39=r35				// out5 = in3 (out1)
-		    mov r37=r33				// out3 = in1 (loc1)
-		    mov r36=r32				// out2 = in0 (loc0)
-	[MLX]       adds r12=-24,r12			// update sp
-		    movl r34=hptr;;			// out0 = hptr
-	[MIB]       mov r33=r16				// loc1 = ar.pfs
-		    mov r32=b0				// loc0 = retaddr
-		    br.call.sptk.many b0=b6;;
-
-	[MII]       adds r12=-16,r12
-		    mov b0=r32
-		    mov.i ar.pfs=r33
-	[MFB]       nop.m 0x0
-		    nop.f 0x0
-		    br.ret.sptk.many b0;;
+        [MLX]       alloc r16=ar.pfs,10,2,0
+                    movl r17=wptr
+        [MII]       st8.spill [r12]=r38,8               // spill in6 (out4)
+                    mov r41=r37                         // out7 = in5 (out3)
+                    mov r40=r36;;                       // out6 = in4 (out2)
+        [MII]       st8.spill [r12]=r39                 // spill in7 (out5)
+                    mov.sptk b6=r17,50
+                    mov r38=r34;;                       // out4 = in2 (out0)
+        [MII]       mov r39=r35                         // out5 = in3 (out1)
+                    mov r37=r33                         // out3 = in1 (loc1)
+                    mov r36=r32                         // out2 = in0 (loc0)
+        [MLX]       adds r12=-24,r12                    // update sp
+                    movl r34=hptr;;                     // out0 = hptr
+        [MIB]       mov r33=r16                         // loc1 = ar.pfs
+                    mov r32=b0                          // loc0 = retaddr
+                    br.call.sptk.many b0=b6;;
+
+        [MII]       adds r12=-16,r12
+                    mov b0=r32
+                    mov.i ar.pfs=r33
+        [MFB]       nop.m 0x0
+                    nop.f 0x0
+                    br.ret.sptk.many b0;;
 */
 
 /* These macros distribute a long constant into the two words of an MLX bundle */
-#define BITS(val,start,count)	(((val) >> (start)) & ((1 << (count))-1))
-#define MOVL_LOWORD(val)	(BITS(val,22,18) << 46)
-#define MOVL_HIWORD(val)	( (BITS(val,0,7)    << 36)	\
-				| (BITS(val,7,9)    << 50)	\
-				| (BITS(val,16,5)   << 45)	\
-				| (BITS(val,21,1)   << 44)	\
-				| (BITS(val,40,23))		\
-				| (BITS(val,63,1)    << 59))
+#define BITS(val,start,count)   (((val) >> (start)) & ((1 << (count))-1))
+#define MOVL_LOWORD(val)        (BITS(val,22,18) << 46)
+#define MOVL_HIWORD(val)        ( (BITS(val,0,7)    << 36)      \
+                                | (BITS(val,7,9)    << 50)      \
+                                | (BITS(val,16,5)   << 45)      \
+                                | (BITS(val,21,1)   << 44)      \
+                                | (BITS(val,40,23))             \
+                                | (BITS(val,63,1)    << 59))
 
     {
-	StgStablePtr stable;
-	IA64FunDesc *wdesc = (IA64FunDesc *)wptr;
-	StgWord64 wcode = wdesc->ip;
-	IA64FunDesc *fdesc;
-	StgWord64 *code;
-
-	/* we allocate on the Haskell heap since malloc'd memory isn't
-	 * executable - argh */
-	/* Allocated memory is word-aligned (8 bytes) but functions on ia64
-	 * must be aligned to 16 bytes.  We allocate an extra 8 bytes of
-	 * wiggle room so that we can put the code on a 16 byte boundary. */
-	adjustor = stgAllocStable(sizeof(IA64FunDesc)+18*8+8, &stable);
-
-	fdesc = (IA64FunDesc *)adjustor;
-	code = (StgWord64 *)(fdesc + 1);
-	/* add 8 bytes to code if needed to align to a 16-byte boundary */
-	if ((StgWord64)code & 15) code++;
-	fdesc->ip = (StgWord64)code;
-	fdesc->gp = wdesc->gp;
-
-	code[0]  = 0x0000058004288004 | MOVL_LOWORD(wcode);
-	code[1]  = 0x6000000220000000 | MOVL_HIWORD(wcode);
-	code[2]  = 0x029015d818984001;
-	code[3]  = 0x8401200500420094;
-	code[4]  = 0x886011d8189c0001;
-	code[5]  = 0x84011004c00380c0;
-	code[6]  = 0x0250210046013800;
-	code[7]  = 0x8401000480420084;
-	code[8]  = 0x0000233f19a06005 | MOVL_LOWORD((StgWord64)hptr);
-	code[9]  = 0x6000000440000000 | MOVL_HIWORD((StgWord64)hptr);
-	code[10] = 0x0200210020010811;
-	code[11] = 0x1080006800006200;
-	code[12] = 0x0000210018406000;
-	code[13] = 0x00aa021000038005;
-	code[14] = 0x000000010000001d;
-	code[15] = 0x0084000880000200;
-
-	/* save stable pointers in convenient form */
-	code[16] = (StgWord64)hptr;
-	code[17] = (StgWord64)stable;
+        StgStablePtr stable;
+        IA64FunDesc *wdesc = (IA64FunDesc *)wptr;
+        StgWord64 wcode = wdesc->ip;
+        IA64FunDesc *fdesc;
+        StgWord64 *code;
+
+        /* we allocate on the Haskell heap since malloc'd memory isn't
+         * executable - argh */
+        /* Allocated memory is word-aligned (8 bytes) but functions on ia64
+         * must be aligned to 16 bytes.  We allocate an extra 8 bytes of
+         * wiggle room so that we can put the code on a 16 byte boundary. */
+        adjustor = stgAllocStable(sizeof(IA64FunDesc)+18*8+8, &stable);
+
+        fdesc = (IA64FunDesc *)adjustor;
+        code = (StgWord64 *)(fdesc + 1);
+        /* add 8 bytes to code if needed to align to a 16-byte boundary */
+        if ((StgWord64)code & 15) code++;
+        fdesc->ip = (StgWord64)code;
+        fdesc->gp = wdesc->gp;
+
+        code[0]  = 0x0000058004288004 | MOVL_LOWORD(wcode);
+        code[1]  = 0x6000000220000000 | MOVL_HIWORD(wcode);
+        code[2]  = 0x029015d818984001;
+        code[3]  = 0x8401200500420094;
+        code[4]  = 0x886011d8189c0001;
+        code[5]  = 0x84011004c00380c0;
+        code[6]  = 0x0250210046013800;
+        code[7]  = 0x8401000480420084;
+        code[8]  = 0x0000233f19a06005 | MOVL_LOWORD((StgWord64)hptr);
+        code[9]  = 0x6000000440000000 | MOVL_HIWORD((StgWord64)hptr);
+        code[10] = 0x0200210020010811;
+        code[11] = 0x1080006800006200;
+        code[12] = 0x0000210018406000;
+        code[13] = 0x00aa021000038005;
+        code[14] = 0x000000010000001d;
+        code[15] = 0x0084000880000200;
+
+        /* save stable pointers in convenient form */
+        code[16] = (StgWord64)hptr;
+        code[17] = (StgWord64)stable;
     }
 #else
     barf("adjustor creation not supported on this platform");
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index 74545af149..90691fa091 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -676,13 +676,11 @@ 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");
-    R1 = len;
-    Sp_adj(1);
-    Sp(0) = errC;
-    jump %ENTRY_CODE(Sp(1));
+    Sp_adj(2);
+    RET_NN(len, errC);
 }
 
 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/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..7dca76438b 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(GhcUnregisterised)
     win32AllocStack();
 #endif
 }
diff --git a/rts/StgCRun.c b/rts/StgCRun.c
index 3654b3336a..15f9fd26a8 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"
@@ -90,6 +98,18 @@ StgFunPtr StgReturn(void)
 #define STG_RETURN "StgReturn"
 #endif
 
+#if defined(mingw32_HOST_OS)
+// On windows the stack has to be allocated 4k at a time, otherwise
+// we get a segfault.  The C compiler knows how to do this (it calls
+// _alloca()), so we make sure that we can allocate as much stack as
+// we need:
+StgWord8 *win32AllocStack(void)
+{
+    StgWord8 stack[RESERVED_C_STACK_BYTES + 16 + 12];
+    return stack;
+}
+#endif
+
 /* -----------------------------------------------------------------------------
    x86 architecture
    -------------------------------------------------------------------------- */
@@ -203,18 +223,6 @@ StgRunIsImplementedInAssembler(void)
     );
 }
 
-#if defined(mingw32_HOST_OS)
-// On windows the stack has to be allocated 4k at a time, otherwise
-// we get a segfault.  The C compiler knows how to do this (it calls
-// _alloca()), so we make sure that we can allocate as much stack as
-// we need:
-StgWord8 *win32AllocStack(void)
-{
-    StgWord8 stack[RESERVED_C_STACK_BYTES + 16 + 12];
-    return stack;
-}
-#endif
-
 #endif
 
 /* ----------------------------------------------------------------------------
@@ -251,11 +259,19 @@ StgRunIsImplementedInAssembler(void)
         /*
          * Set BaseReg
          */
+#if defined(mingw32_HOST_OS)
+        "movq %%rdx,%%r13\n\t"
+#else
         "movq %%rsi,%%r13\n\t"
+#endif
         /*
          * grab the function argument from the stack, and jump to it.
          */
+#if defined(mingw32_HOST_OS)
+        "movq %%rcx,%%rax\n\t"
+#else
         "movq %%rdi,%%rax\n\t"
+#endif
         "jmp *%%rax\n\t"
 
         ".globl " STG_RETURN "\n"
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/Trace.c b/rts/Trace.c
index df5147ca05..7f314ba5d6 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -308,6 +308,7 @@ void traceCapsetEvent_ (EventTypeNum tag,
                         CapsetID capset,
                         StgWord info)
 {
+#if 0
 #ifdef DEBUG
     if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
         ACQUIRE_LOCK(&trace_utx);
@@ -332,6 +333,7 @@ void traceCapsetEvent_ (EventTypeNum tag,
         RELEASE_LOCK(&trace_utx);
     } else
 #endif
+#endif
     {
         if (eventlog_enabled) {
             postCapsetEvent(tag, capset, info);
diff --git a/rts/ghc.mk b/rts/ghc.mk
index fc634c7ff2..95faea8f77 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,11 @@ rts/RtsUtils_CC_OPTS += -DTargetVendor=\"$(TargetVendor_CPP)\"
 rts/RtsUtils_CC_OPTS += -DGhcUnregisterised=\"$(GhcUnregisterised)\"
 rts/RtsUtils_CC_OPTS += -DGhcEnableTablesNextToCode=\"$(GhcEnableTablesNextToCode)\"
 
+ifeq "$(GhcUnregisterised)" "YES"
+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..9561ea6aea 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 = ""
diff --git a/utils/hp2ps/Key.c b/utils/hp2ps/Key.c
index 5fa76ab6d7..eda839597a 100644
--- a/utils/hp2ps/Key.c
+++ b/utils/hp2ps/Key.c
@@ -1,11 +1,14 @@
 #include "Main.h"
 #include <stdio.h>
 #include <math.h>
+#include <string.h>
+#include <stdlib.h>
 #include "Defines.h"
 #include "Dimensions.h"
 #include "HpFile.h"
 #include "Shade.h"
 #include "PsFile.h"
+#include "Utilities.h"
 
 /* own stuff */
 #include "Key.h"
@@ -36,7 +39,18 @@ void Key(void)
     }
 }
 
-
+static void
+escape(char *result, const char *name)
+{
+    while (*name != '\0')
+    {
+        if (*name == '\\')
+        {
+            *result++ = '\\';
+        }
+        *result++ = *name++;
+    }
+}
 
 static void
 KeyEntry(floatish centreline, char *name, floatish colour)
@@ -65,5 +79,9 @@ KeyEntry(floatish centreline, char *name, floatish colour)
     fprintf(psfp, "HE%d setfont\n", NORMAL_FONT);
     fprintf(psfp, "%f %f moveto\n", kstart + (floatish) KEY_BOX_WIDTH + 2 * borderspace, namebase);
 
-    fprintf(psfp, "(%s) show\n", name); 
+    // escape backslashes in 'name'
+    char *escaped_name = (char*) xmalloc(strlen(name) * 2 + 1);
+    escape(escaped_name, name);
+    fprintf(psfp, "(%s) show\n", escaped_name);
+    free(escaped_name);
 }