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

111 files changed, 1170 insertions, 988 deletions

diff --git a/compiler/HsVersions.h b/compiler/HsVersions.h
index d85234784a..9a83af9768 100644
--- a/compiler/HsVersions.h
+++ b/compiler/HsVersions.h
@@ -46,18 +46,9 @@ name :: IORef (ty);                 \
 name = Util.globalM (value);
 #endif
 
-#ifdef DEBUG
-#define ASSERT(e)      if (not (e)) then (assertPanic __FILE__ __LINE__) else
-#define ASSERT2(e,msg) if (not (e)) then (assertPprPanic __FILE__ __LINE__ (msg)) else
+#define ASSERT(e)      if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
+#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else
 #define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
-#else
--- We have to actually use all the variables we are given or we may get
--- unused variable warnings when DEBUG is off.
-#define ASSERT(e)      if False && (not (e)) then panic "ASSERT" else
-#define ASSERT2(e,msg) if False && (const False (e,msg)) then pprPanic "ASSERT2" (msg) else
-#define WARN(e,msg)    if False && (e) then pprPanic "WARN" (msg) else
--- Here we deliberately don't use when as Control.Monad might not be imported
-#endif
 
 -- Examples:   Assuming   flagSet :: String -> m Bool
 -- 
diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index c6226cac67..98579ac4c3 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -26,7 +26,7 @@ types that
 module BasicTypes(
 	Version, bumpVersion, initialVersion,
 
-	Arity,
+	Arity, RepArity,
 	
 	Alignment,
 
@@ -101,7 +101,18 @@ import Data.Function (on)
 %************************************************************************
 
 \begin{code}
+-- | The number of value arguments that can be applied to a value before it does
+-- "real work". So:
+--  fib 100     has arity 0
+--  \x -> fib x has arity 1
 type Arity = Int
+
+-- | The number of represented arguments that can be applied to a value before it does
+-- "real work". So:
+--  fib 100                    has representation arity 0
+--  \x -> fib x                has representation arity 1
+--  \(# x, y #) -> fib (x + y) has representation arity 2
+type RepArity = Int
 \end{code}
 
 %************************************************************************
diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index aabc5d09c8..dde85a355b 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -31,7 +31,7 @@ module DataCon (
 	dataConInstOrigArgTys, dataConRepArgTys, 
 	dataConFieldLabels, dataConFieldType,
 	dataConStrictMarks, dataConExStricts,
-	dataConSourceArity, dataConRepArity,
+	dataConSourceArity, dataConRepArity, dataConRepRepArity,
 	dataConIsInfix,
 	dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
 	dataConRepStrictness,
@@ -692,9 +692,14 @@ dataConSourceArity dc = length (dcOrigArgTys dc)
 -- | Gives the number of actual fields in the /representation/ of the 
 -- data constructor. This may be more than appear in the source code;
 -- the extra ones are the existentially quantified dictionaries
-dataConRepArity :: DataCon -> Int
+dataConRepArity :: DataCon -> Arity
 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 
+-- | The number of fields in the /representation/ of the constructor
+-- AFTER taking into account the unpacking of any unboxed tuple fields
+dataConRepRepArity :: DataCon -> RepArity
+dataConRepRepArity dc = typeRepArity (dataConRepArity dc) (dataConRepType dc)
+
 -- | Return whether there are any argument types for this 'DataCon's original source type
 isNullarySrcDataCon :: DataCon -> Bool
 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index d1df6cc0ab..e6e221bfce 100644
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -41,8 +41,8 @@ module Id (
 	mkWorkerId, mkWiredInIdName,
 
 	-- ** Taking an Id apart
-	idName, idType, idUnique, idInfo, idDetails,
-	idPrimRep, recordSelectorFieldLabel,
+	idName, idType, idUnique, idInfo, idDetails, idRepArity,
+	recordSelectorFieldLabel,
 
 	-- ** Modifying an Id
 	setIdName, setIdUnique, Id.setIdType, 
@@ -126,7 +126,7 @@ import Outputable
 import Unique
 import UniqSupply
 import FastString
-import Util( count )
+import Util
 import StaticFlags
 
 -- infixl so you can say (id `set` a `set` b)
@@ -158,9 +158,6 @@ idUnique  = Var.varUnique
 idType   :: Id -> Kind
 idType    = Var.varType
 
-idPrimRep :: Id -> PrimRep
-idPrimRep id = typePrimRep (idType id)
-
 setIdName :: Id -> Name -> Id
 setIdName = Var.setVarName
 
@@ -462,6 +459,9 @@ idArity id = arityInfo (idInfo id)
 setIdArity :: Id -> Arity -> Id
 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 
+idRepArity :: Id -> RepArity
+idRepArity x = typeRepArity (idArity x) (idType x)
+
 -- | Returns true if an application to n args would diverge
 isBottomingId :: Id -> Bool
 isBottomingId id = isBottomingSig (idStrictness id)
diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index 966dca1e71..fe36b9d18a 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -52,9 +52,7 @@ module Literal
 import TysPrim
 import PrelNames
 import Type
-import TypeRep
 import TyCon
-import Var
 import Outputable
 import FastTypes
 import FastString
@@ -62,6 +60,8 @@ import BasicTypes
 import Binary
 import Constants
 import UniqFM
+import Util
+
 import Data.Int
 import Data.Ratio
 import Data.Word
@@ -120,32 +120,27 @@ data Literal
                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                 --    be appended to label name when emitting assembly.
 
-  | LitInteger Integer Id	--  ^ Integer literals
-    	       	       		-- See Note [Integer literals]
+  | LitInteger Integer Type --  ^ Integer literals
+                            -- See Note [Integer literals]
   deriving (Data, Typeable)
 \end{code}
 
 Note [Integer literals]
 ~~~~~~~~~~~~~~~~~~~~~~~
 An Integer literal is represented using, well, an Integer, to make it
-easier to write RULEs for them. 
-
- * The Id is for mkInteger, which we use when finally creating the core.
-
- * They only get converted into real Core,
-      mkInteger [c1, c2, .., cn]
-   during the CorePrep phase.
+easier to write RULEs for them. They also contain the Integer type, so
+that e.g. literalType can return the right Type for them.
 
- * When we initally build an Integer literal, notably when
-   deserialising it from an interface file (see the Binary instance
-   below), we don't have convenient access to the mkInteger Id.  So we
-   just use an error thunk, and fill in the real Id when we do tcIfaceLit
-   in TcIface.
+They only get converted into real Core,
+    mkInteger [c1, c2, .., cn]
+during the CorePrep phase, although TidyPgm looks ahead at what the
+core will be, so that it can see whether it involves CAFs.
 
- * When looking for CAF-hood (in TidyPgm), we must take account of the
-   CAF-hood of the mk_integer field in LitInteger; see TidyPgm.cafRefsL.
-   Indeed this is the only reason we put the mk_integer field in the 
-   literal -- otherwise we could just look it up in CorePrep.
+When we initally build an Integer literal, notably when
+deserialising it from an interface file (see the Binary instance
+below), we don't have convenient access to the mkInteger Id.  So we
+just use an error thunk, and fill in the real Id when we do tcIfaceLit
+in TcIface.
 
 
 Binary instance
@@ -203,8 +198,8 @@ instance Binary Literal where
                     return (MachLabel aj mb fod)
               _ -> do
                     i <- get bh
+                    -- See Note [Integer literals]
                     return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
-		    	   -- See Note [Integer literals] in Literal
 \end{code}
 
 \begin{code}
@@ -265,7 +260,7 @@ mkMachChar = MachChar
 mkMachString :: String -> Literal
 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
 
-mkLitInteger :: Integer -> Id -> Literal
+mkLitInteger :: Integer -> Type -> Literal
 mkLitInteger = LitInteger
 
 inIntRange, inWordRange :: Integer -> Bool
@@ -389,12 +384,7 @@ literalType (MachWord64  _) = word64PrimTy
 literalType (MachFloat _)   = floatPrimTy
 literalType (MachDouble _)  = doublePrimTy
 literalType (MachLabel _ _ _) = addrPrimTy
-literalType (LitInteger _ mk_integer_id)
-      -- We really mean idType, rather than varType, but importing Id
-      -- causes a module import loop
-    = case varType mk_integer_id of
-        FunTy _ (FunTy _ integerTy) -> integerTy
-        _ -> panic "literalType: mkIntegerId has the wrong type"
+literalType (LitInteger _ t) = t
 
 absentLiteralOf :: TyCon -> Maybe Literal
 -- Return a literal of the appropriate primtive
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 4671b394cc..a7f4b70d61 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -503,13 +503,13 @@ mkDictSelId no_unf name clas
 				--   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
 
 dictSelRule :: Int -> Arity 
-            -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
+            -> Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
 -- Tries to persuade the argument to look like a constructor
 -- application, using exprIsConApp_maybe, and then selects
 -- from it
 --       sel_i t1..tk (D t1..tk op1 ... opm) = opi
 --
-dictSelRule val_index n_ty_args id_unf args
+dictSelRule val_index n_ty_args _ id_unf args
   | (dict_arg : _) <- drop n_ty_args args
   , Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
   = Just (con_args !! val_index)
@@ -920,12 +920,12 @@ seqId = pcMiscPrelId seqName ty info
                                 , ru_try   = match_seq_of_cast
                                 }
 
-match_seq_of_cast :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
+match_seq_of_cast :: Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
     -- See Note [Built-in RULES for seq]
-match_seq_of_cast _ [Type _, Type res_ty, Cast scrut co, expr]
+match_seq_of_cast _ _ [Type _, Type res_ty, Cast scrut co, expr]
   = Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty,
                               scrut, expr])
-match_seq_of_cast _ _ = Nothing
+match_seq_of_cast _ _ _ = Nothing
 
 ------------------------------------------------
 lazyId :: Id	-- See Note [lazyId magic]
diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs
index f99a50cfeb..7c0f26f4bf 100644
--- a/compiler/basicTypes/Unique.lhs
+++ b/compiler/basicTypes/Unique.lhs
@@ -71,6 +71,7 @@ import FastTypes
 import FastString
 import Outputable
 -- import StaticFlags
+import Util
 
 #if defined(__GLASGOW_HASKELL__)
 --just for implementing a fast [0,61) -> Char function
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 27c9bcb2cf..b39a59134c 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -32,7 +32,7 @@ import Constants
 import Digraph
 import qualified Prelude as P
 import Prelude hiding (succ)
-import Util (sortLe)
+import Util
 
 import BlockId
 import Bitmap
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index a13ae12135..e4370696e1 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -27,6 +27,8 @@ import Platform
 import StaticFlags
 import UniqSupply
 import MonadUtils
+import Util
+
 import Data.Bits
 import Data.Word
 
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 6d02e693fb..0756c87583 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -72,7 +72,7 @@ module CmmUtils(
 #include "HsVersions.h"
 
 import TyCon	( PrimRep(..) )
-import Type	( Type, typePrimRep )
+import Type	( UnaryType, typePrimRep )
 
 import SMRep
 import Cmm
@@ -83,6 +83,7 @@ import OptimizationFuel as F
 import Unique
 import UniqSupply
 import Constants( wORD_SIZE, tAG_MASK )
+import Util
 
 import Data.Word
 import Data.Maybe
@@ -107,7 +108,7 @@ primRepCmmType AddrRep    = bWord
 primRepCmmType FloatRep   = f32
 primRepCmmType DoubleRep  = f64
 
-typeCmmType :: Type -> CmmType
+typeCmmType :: UnaryType -> CmmType
 typeCmmType ty = primRepCmmType (typePrimRep ty)
 
 primRepForeignHint :: PrimRep -> ForeignHint
@@ -121,7 +122,7 @@ primRepForeignHint AddrRep      = AddrHint -- NB! AddrHint, but NonPtrArg
 primRepForeignHint FloatRep	= NoHint
 primRepForeignHint DoubleRep	= NoHint
 
-typeForeignHint :: Type -> ForeignHint
+typeForeignHint :: UnaryType -> ForeignHint
 typeForeignHint = primRepForeignHint . typePrimRep
 
 ---------------------------------------------------
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index debc9e4a35..04586b1029 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -42,6 +42,7 @@ import SMRep (ByteOff)
 import StaticFlags
 import Unique
 import UniqSupply
+import Util
 
 #include "HsVersions.h"
 
diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs
index f624c1c7b6..a85b11bcc6 100644
--- a/compiler/cmm/OptimizationFuel.hs
+++ b/compiler/cmm/OptimizationFuel.hs
@@ -22,6 +22,7 @@ import Control.Monad
 import StaticFlags (opt_Fuel)
 import UniqSupply
 import Panic
+import Util
 
 import Compiler.Hoopl
 import Compiler.Hoopl.GHC (getFuel, setFuel)
diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index 198e192f5c..06442dc004 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -411,15 +411,12 @@ getArgAmode (StgLitArg lit)
   = do  { cmm_lit <- cgLit lit
         ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
 
-getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
-
 getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
 getArgAmodes [] = returnFC []
 getArgAmodes (atom:atoms)
-  | isStgTypeArg atom = getArgAmodes atoms
-  | otherwise         = do { amode  <- getArgAmode  atom 
-                           ; amodes <- getArgAmodes atoms
-                           ; return ( amode : amodes ) }
+  = do { amode  <- getArgAmode  atom 
+       ; amodes <- getArgAmodes atoms
+       ; return ( amode : amodes ) }
 \end{code}
 
 %************************************************************************
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 9049504dca..9ad8d13b5f 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -72,7 +72,7 @@ cgTopRhsCon id con args
         ; when (platformOS (targetPlatform dflags) == OSMinGW32) $
               -- Windows DLLs have a problem with static cross-DLL refs.
               ASSERT( not (isDllConApp dflags con args) ) return ()
-        ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
+        ; ASSERT( args `lengthIs` dataConRepRepArity con ) return ()
 
         -- LAY IT OUT
         ; amodes <- getArgAmodes args
@@ -324,7 +324,7 @@ cgReturnDataCon con amodes
       -- for it to be marked as "used" for LDV profiling.
   | opt_SccProfilingOn    = build_it_then enter_it
   | otherwise
-  = ASSERT( amodes `lengthIs` dataConRepArity con )
+  = ASSERT( amodes `lengthIs` dataConRepRepArity con )
     do  { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
         ; case sequel of
             CaseAlts _ (Just (alts, deflt_lbl)) bndr
@@ -466,8 +466,8 @@ cgDataCon data_con
                                 ; ldvEnter (CmmReg nodeReg)
                                 ; body_code }
 
-            arg_reps :: [(CgRep, Type)]
-            arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
+            arg_reps :: [(CgRep, UnaryType)]
+            arg_reps = [(typeCgRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
 
             body_code = do {
                         -- NB: We don't set CC when entering data (WDP 94/06)
diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index cb3a86ef7f..f935f95726 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -480,7 +480,7 @@ Little helper for primitives that return unboxed tuples.
 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [ForeignHint])
 newUnboxedTupleRegs res_ty =
    let
-	ty_args = tyConAppArgs (repType res_ty)
+	UbxTupleRep ty_args = repType res_ty
 	(reps,hints) = unzip [ (rep, typeForeignHint ty) | ty <- ty_args,
 					   	    let rep = typeCgRep ty,
 					 	    nonVoidArg rep ]
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 16e77eca35..600bbbe0df 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -311,4 +311,5 @@ shimForeignCallArg arg expr
   | otherwise = expr
   where
         -- should be a tycon app, since this is a foreign call
-        tycon = tyConAppTyCon (repType (stgArgType arg))
+        UnaryRep rep_ty = repType (stgArgType arg)
+        tycon           = tyConAppTyCon rep_ty
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index c0e3e3be8b..b96898f591 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -77,6 +77,7 @@ import VarEnv
 import OrdList
 import Unique
 import UniqSupply
+import Util
 import Outputable
 
 import Control.Monad
diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index 499529d841..e933fedb5b 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -43,6 +43,7 @@ import StgSyn
 import PrimOp
 import Outputable
 import StaticFlags
+import Util
 
 import Control.Monad
 import Data.Maybe
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index d8fd07fead..b3a365b201 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -20,6 +20,8 @@ the STG paper.
 -- for details
 
 module ClosureInfo (
+        idRepArity,
+
 	ClosureInfo(..), LambdaFormInfo(..),	-- would be abstract but
 	StandardFormInfo(..),			-- mkCmmInfo looks inside
         SMRep,
@@ -96,6 +98,7 @@ import Outputable
 import FastString
 import Constants
 import DynFlags
+import Util
 \end{code}
 
 
@@ -156,7 +159,7 @@ ClosureInfo contains a LambdaFormInfo.
 data LambdaFormInfo
   = LFReEntrant		-- Reentrant closure (a function)
 	TopLevelFlag	-- True if top level
-	!Int		-- Arity. Invariant: always > 0
+	!RepArity	-- Arity. Invariant: always > 0
 	!Bool		-- True <=> no fvs
 	ArgDescr	-- Argument descriptor (should reall be in ClosureInfo)
 
@@ -180,7 +183,7 @@ data LambdaFormInfo
 
   | LFLetNoEscape	-- See LetNoEscape module for precise description of
 			-- these "lets".
-	!Int		-- arity;
+	!RepArity	-- arity;
 
   | LFBlackHole		-- Used for the closures allocated to hold the result
 			-- of a CAF.  We want the target of the update frame to
@@ -211,7 +214,7 @@ data StandardFormInfo
 	-- The code for the thunk just pushes x2..xn on the stack and enters x1.
 	-- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 	-- in the RTS to save space.
-	Int		-- Arity, n
+	RepArity	-- Arity, n
 \end{code}
 
 
@@ -288,7 +291,7 @@ idCgRep x = typeCgRep . idType $ x
 tyConCgRep :: TyCon -> CgRep
 tyConCgRep = primRepToCgRep . tyConPrimRep
 
-typeCgRep :: Type -> CgRep
+typeCgRep :: UnaryType -> CgRep
 typeCgRep = primRepToCgRep . typePrimRep 
 \end{code}
 
@@ -384,9 +387,12 @@ might_be_a_function :: Type -> Bool
 -- Return False only if we are *sure* it's a data type
 -- Look through newtypes etc as much as poss
 might_be_a_function ty
-  = case tyConAppTyCon_maybe (repType ty) of
-	Just tc -> not (isDataTyCon tc)
-	Nothing -> True
+  | UnaryRep rep <- repType ty
+  , Just tc <- tyConAppTyCon_maybe rep
+  , isDataTyCon tc
+  = False
+  | otherwise
+  = True
 \end{code}
 
 @mkConLFInfo@ is similar, for constructors.
@@ -404,7 +410,7 @@ mkSelectorLFInfo id offset updatable
   = LFThunk NotTopLevel False updatable (SelectorThunk offset) 
 	(might_be_a_function (idType id))
 
-mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo
+mkApLFInfo :: Id -> UpdateFlag -> RepArity -> LambdaFormInfo
 mkApLFInfo id upd_flag arity
   = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
 	(might_be_a_function (idType id))
@@ -416,12 +422,12 @@ Miscellaneous LF-infos.
 mkLFArgument :: Id -> LambdaFormInfo
 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
 
-mkLFLetNoEscape :: Int -> LambdaFormInfo
+mkLFLetNoEscape :: RepArity -> LambdaFormInfo
 mkLFLetNoEscape = LFLetNoEscape
 
 mkLFImported :: Id -> LambdaFormInfo
 mkLFImported id
-  = case idArity id of
+  = case idRepArity id of
       n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr")  -- n > 0
       _ -> mkLFArgument id -- Not sure of exact arity
 \end{code}
@@ -634,13 +640,13 @@ data CallMethod
 
   | DirectEntry 			-- Jump directly, with args in regs
 	CLabel 				--   The code label
-	Int 				--   Its arity
+	RepArity			--   Its arity
 
 getCallMethod :: DynFlags
               -> Name		-- Function being applied
               -> CafInfo        -- Can it refer to CAF's?
 	      -> LambdaFormInfo	-- Its info
-	      -> Int		-- Number of available arguments
+	      -> RepArity	-- Number of available arguments
 	      -> CallMethod
 
 getCallMethod _ _ _ lf_info _
@@ -911,11 +917,11 @@ isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
 isConstrClosure_maybe _ 				  = Nothing
 
-closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
+closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
 closureFunInfo _ = Nothing
 
-lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
+lfFunInfo :: LambdaFormInfo ->  Maybe (RepArity, ArgDescr)
 lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
 lfFunInfo _                                 = Nothing
 
@@ -935,7 +941,7 @@ funTagLFInfo lf
   | otherwise
   = 0
 
-tagForArity :: Int -> Maybe Int
+tagForArity :: RepArity -> Maybe Int
 tagForArity i | i <= mAX_PTR_TAG = Just i
               | otherwise        = Nothing
 
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index aa561c4f40..24ac064256 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -45,6 +45,7 @@ import TyCon
 import Module
 import ErrUtils
 import Panic
+import Util
 
 codeGen :: DynFlags
         -> Module                     -- Module we are compiling
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 7aa159844b..17a7062559 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -46,6 +46,7 @@ import TyCon
 import Module
 import ErrUtils
 import Outputable
+import Util
 
 codeGen :: DynFlags
 	 -> Module
@@ -273,8 +274,8 @@ cgDataCon data_con
 					    (tagForCon data_con)] }
                         -- The case continuation code expects a tagged pointer
 
-	    arg_reps :: [(PrimRep, Type)]
-	    arg_reps = [(typePrimRep ty, ty) | ty <- dataConRepArgTys data_con]
+	    arg_reps :: [(PrimRep, UnaryType)]
+	    arg_reps = [(typePrimRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
 
 	    -- Dynamic closure code for non-nullary constructors only
 	; whenC (not (isNullaryRepDataCon data_con))
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index d4ba62c6ca..9185002354 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -21,8 +21,8 @@ module StgCmmClosure (
         DynTag,  tagForCon, isSmallFamily,
 	ConTagZ, dataConTagZ,
 
-        isVoidRep, isGcPtrRep, addIdReps, addArgReps,
-	argPrimRep, 
+        idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
+	argPrimRep,
 
         -- * LambdaFormInfo
         LambdaFormInfo,         -- Abstract
@@ -90,6 +90,7 @@ import Outputable
 import Platform
 import Constants
 import DynFlags
+import Util
 
 -----------------------------------------------------------------------------
 --		Representations
@@ -97,6 +98,10 @@ import DynFlags
 
 -- Why are these here?
 
+-- NB: this is reliable because by StgCmm no Ids have unboxed tuple type
+idPrimRep :: Id -> PrimRep
+idPrimRep id = typePrimRep (idType id)
+
 addIdReps :: [Id] -> [(PrimRep, Id)]
 addIdReps ids = [(idPrimRep id, id) | id <- ids]
 
@@ -127,7 +132,7 @@ isGcPtrRep _      = False
 data LambdaFormInfo
   = LFReEntrant		-- Reentrant closure (a function)
 	TopLevelFlag	-- True if top level
-	!Int		-- Arity. Invariant: always > 0
+	!RepArity		-- Arity. Invariant: always > 0
 	!Bool		-- True <=> no fvs
 	ArgDescr	-- Argument descriptor (should really be in ClosureInfo)
 
@@ -188,7 +193,7 @@ data StandardFormInfo
 	-- The code for the thunk just pushes x2..xn on the stack and enters x1.
 	-- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 	-- in the RTS to save space.
-	Int		-- Arity, n
+	RepArity		-- Arity, n
 
 
 ------------------------------------------------------
@@ -231,9 +236,12 @@ might_be_a_function :: Type -> Bool
 -- Return False only if we are *sure* it's a data type
 -- Look through newtypes etc as much as poss
 might_be_a_function ty
-  = case tyConAppTyCon_maybe (repType ty) of
-	Just tc -> not (isDataTyCon tc)
-	Nothing -> True
+  | UnaryRep rep <- repType ty
+  , Just tc <- tyConAppTyCon_maybe rep
+  , isDataTyCon tc
+  = False
+  | otherwise
+  = True
 
 -------------
 mkConLFInfo :: DataCon -> LambdaFormInfo
@@ -266,7 +274,7 @@ mkLFImported id
   | otherwise
   = mkLFArgument id -- Not sure of exact arity
   where
-    arity = idArity id
+    arity = idRepArity id
 
 ------------
 mkLFBlackHole :: LambdaFormInfo
@@ -309,7 +317,7 @@ tagForCon con
     con_tag  = dataConTagZ con
     fam_size = tyConFamilySize (dataConTyCon con)
 
-tagForArity :: Int -> DynTag
+tagForArity :: RepArity -> DynTag
 tagForArity arity | isSmallFamily arity = arity
                   | otherwise           = 0
 
@@ -458,13 +466,13 @@ data CallMethod
 
   | DirectEntry 	-- Jump directly, with args in regs
 	CLabel 		--   The code label
-	Int 		--   Its arity
+	RepArity 		--   Its arity
 
 getCallMethod :: DynFlags
               -> Name           -- Function being applied
               -> CafInfo        -- Can it refer to CAF's?
 	      -> LambdaFormInfo	-- Its info
-	      -> Int		-- Number of available arguments
+	      -> RepArity		-- Number of available arguments
 	      -> CallMethod
 
 getCallMethod _ _name _ lf_info _n_args
@@ -744,10 +752,10 @@ closureReEntrant :: ClosureInfo -> Bool
 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
 closureReEntrant _ = False
 
-closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
+closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
 
-lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
+lfFunInfo :: LambdaFormInfo ->  Maybe (RepArity, ArgDescr)
 lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
 lfFunInfo _                                 = Nothing
 
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index e17ac4fd32..a7af5662e9 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -41,7 +41,7 @@ import PrelInfo
 import Outputable
 import Platform
 import StaticFlags
-import Util             ( lengthIs )
+import Util
 
 import Control.Monad
 import Data.Char
@@ -62,7 +62,7 @@ cgTopRhsCon id con args
         ; when (platformOS (targetPlatform dflags) == OSMinGW32) $
               -- Windows DLLs have a problem with static cross-DLL refs.
               ASSERT( not (isDllConApp dflags con args) ) return ()
-        ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
+        ; ASSERT( args `lengthIs` dataConRepRepArity con ) return ()
 
         -- LAY IT OUT
         ; let
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index d8a7061eec..f128e3ad60 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -201,7 +201,6 @@ getArgAmode :: NonVoid StgArg -> FCode CmmExpr
 getArgAmode (NonVoid (StgVarArg var))  =
   do { info  <- getCgIdInfo var; return (idInfoToAmode info) }
 getArgAmode (NonVoid (StgLitArg lit))  = liftM CmmLit $ cgLit lit
-getArgAmode (NonVoid (StgTypeArg _))   = panic "getArgAmode: type arg"
 
 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
 -- NB: Filters out void args, 
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 5ea935984d..9faad02f46 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -497,7 +497,7 @@ cgConApp con stg_args
        ; emitReturn arg_exprs }
 
   | otherwise	--  Boxed constructors; allocate and return
-  = ASSERT( stg_args `lengthIs` dataConRepArity con )
+  = ASSERT( stg_args `lengthIs` dataConRepRepArity con )
     do	{ (idinfo, init) <- buildDynCon (dataConWorkId con) currentCCS con stg_args
 	   	-- The first "con" says that the name bound to this closure is
 		-- is "con", which is a bit of a fudge, but it only affects profiling
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index c41832a0ab..5bc0f7af4e 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -304,5 +304,6 @@ add_shim arg_ty expr
 
   | otherwise = expr
   where
-    tycon = tyConAppTyCon (repType arg_ty)
+    UnaryRep rep_ty = repType arg_ty
+    tycon           = tyConAppTyCon rep_ty
         -- should be a tycon app, since this is a foreign call
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 690b0a9622..7b22c5726a 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -44,6 +44,7 @@ import Module
 import FastString( mkFastString, fsLit )
 import Constants
 import DynFlags
+import Util
 
 -----------------------------------------------------------
 --              Initialise dynamic heap objects
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 9afcd029a4..c33524636b 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -50,7 +50,7 @@ import StgSyn
 import Id
 import Name
 import TyCon		( PrimRep(..) )
-import BasicTypes	( Arity )
+import BasicTypes	( RepArity )
 import DynFlags
 import StaticFlags
 
@@ -128,7 +128,7 @@ adjustHpBackwards
 --	Making calls: directCall and slowCall
 -------------------------------------------------------------------------
 
-directCall :: CLabel -> Arity -> [StgArg] -> FCode ()
+directCall :: CLabel -> RepArity -> [StgArg] -> FCode ()
 -- (directCall f n args)
 -- calls f(arg1, ..., argn), and applies the result to the remaining args
 -- The function f has arity n, and there are guaranteed at least n args
@@ -144,7 +144,7 @@ slowCall fun stg_args
 	; slow_call fun cmm_args (argsReps stg_args) }
 
 --------------
-direct_call :: String -> CLabel -> Arity -> [CmmExpr] -> [ArgRep] -> FCode ()
+direct_call :: String -> CLabel -> RepArity -> [CmmExpr] -> [ArgRep] -> FCode ()
 -- NB1: (length args) may be less than (length reps), because
 --     the args exclude the void ones
 -- NB2: 'arity' refers to the *reps* 
@@ -186,7 +186,7 @@ slow_call fun args reps
     (rts_fun, arity) = slowCallPattern reps
 
 -- These cases were found to cover about 99% of all slow calls:
-slowCallPattern :: [ArgRep] -> (FastString, Arity)
+slowCallPattern :: [ArgRep] -> (FastString, RepArity)
 -- Returns the generic apply function and arity
 slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6)
 slowCallPattern (P: P: P: P: P: _)    = (fsLit "stg_ap_ppppp", 5)
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 331d4f529e..efa234b5a6 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -43,6 +43,7 @@ import Module
 import FastString
 import Outputable
 import StaticFlags
+import Util
 
 ------------------------------------------------------------------------
 --	Primitive operations and foreign calls
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index a6c592cfd8..da69030ddf 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -197,7 +197,7 @@ registerTickyCtr ctr_lbl
 		   (CmmLit (mkIntCLit 1)) ]
     ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
 
-tickyReturnOldCon, tickyReturnNewCon :: Arity -> FCode ()
+tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()
 tickyReturnOldCon arity 
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_OLD_ctr")
 	         ; bumpHistogram    (fsLit "RET_OLD_hst") arity }
@@ -205,7 +205,7 @@ tickyReturnNewCon arity
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_NEW_ctr")
 	         ; bumpHistogram    (fsLit "RET_NEW_hst") arity }
 
-tickyUnboxedTupleReturn :: Int -> FCode ()
+tickyUnboxedTupleReturn :: RepArity -> FCode ()
 tickyUnboxedTupleReturn arity
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_UNBOXED_TUP_ctr")
  	         ; bumpHistogram    (fsLit "RET_UNBOXED_TUP_hst") arity }
@@ -219,7 +219,7 @@ tickyVectoredReturn family_size
 -- Ticky calls
 
 -- Ticks at a *call site*:
-tickyDirectCall :: Arity -> [StgArg] -> FCode ()
+tickyDirectCall :: RepArity -> [StgArg] -> FCode ()
 tickyDirectCall arity args
   | arity == length args = tickyKnownCallExact
   | otherwise = do tickyKnownCallExtraArgs
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index c3327138b3..dda2260a04 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -458,7 +458,7 @@ newUnboxedTupleRegs res_ty
 	; ASSERT( regs `equalLength` reps )
 	  return (regs, map primRepForeignHint reps) }
   where
-    ty_args = tyConAppArgs (repType res_ty)
+    UbxTupleRep ty_args = repType res_ty
     reps = [ rep
 	   | ty <- ty_args
     	   , let rep = typePrimRep ty
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 41b0f3bd2f..ba6a14739a 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -352,17 +352,11 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
      ; subst <- getTvSubst 
      ; checkTys var_ty scrut_ty (mkScrutMsg var var_ty scrut_ty subst)
 
-     -- If the binder is an unboxed tuple type, don't put it in scope
-     ; let scope = if (isUnboxedTupleType (idType var)) then 
-                       pass_var 
-                   else lintAndScopeId var
-     ; scope $ \_ ->
+     ; lintAndScopeId var $ \_ ->
        do { -- Check the alternatives
             mapM_ (lintCoreAlt scrut_ty alt_ty) alts
           ; checkCaseAlts e scrut_ty alts
           ; return alt_ty } }
-  where
-    pass_var f = f var
 
 lintCoreExpr (Type ty)
   = do { ty' <- lintInTy ty
@@ -598,10 +592,7 @@ lintIdBndr :: Id -> (Id -> LintM a) -> LintM a
 -- ToDo: lint its rules
 
 lintIdBndr id linterF 
-  = do 	{ checkL (not (isUnboxedTupleType (idType id))) 
-		 (mkUnboxedTupleMsg id)
-		-- No variable can be bound to an unboxed tuple.
-        ; lintAndScopeId id $ \id' -> linterF id' }
+  = do 	{ lintAndScopeId id $ \id' -> linterF id' }
 
 lintAndScopeIds :: [Var] -> ([Var] -> LintM a) -> LintM a
 lintAndScopeIds ids linterF 
@@ -1257,11 +1248,6 @@ mkArityMsg binder
          ]
            where (StrictSig dmd_ty) = idStrictness binder
 
-mkUnboxedTupleMsg :: Id -> MsgDoc
-mkUnboxedTupleMsg binder
-  = vcat [hsep [ptext (sLit "A variable has unboxed tuple type:"), ppr binder],
-	  hsep [ptext (sLit "Binder's type:"), ppr (idType binder)]]
-
 mkCastErr :: CoreExpr -> Coercion -> Type -> Type -> MsgDoc
 mkCastErr expr co from_ty expr_ty
   = vcat [ptext (sLit "From-type of Cast differs from type of enclosed expression"),
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 55c78b8741..7680bab292 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -8,11 +8,12 @@ Core pass to saturate constructors and PrimOps
 {-# LANGUAGE BangPatterns #-}
 
 module CorePrep (
-      corePrepPgm, corePrepExpr
+      corePrepPgm, corePrepExpr, cvtLitInteger
   ) where
 
 #include "HsVersions.h"
 
+import HscTypes
 import PrelNames
 import CoreUtils
 import CoreArity
@@ -24,6 +25,8 @@ import MkCore hiding( FloatBind(..) )   -- We use our own FloatBind here
 import Type
 import Literal
 import Coercion
+import TcEnv
+import TcRnMonad
 import TyCon
 import Demand
 import Var
@@ -43,7 +46,6 @@ import DynFlags
 import Util
 import Pair
 import Outputable
-import MonadUtils
 import FastString
 import Config
 import Data.Bits
@@ -100,8 +102,8 @@ The goal of this pass is to prepare for code generation.
 
 9.  Replace (lazy e) by e.  See Note [lazyId magic] in MkId.lhs
 
-10. Convert (LitInteger i mkInteger) into the core representation
-    for the Integer i. Normally this uses the mkInteger Id, but if
+10. Convert (LitInteger i t) into the core representation
+    for the Integer i. Normally this uses mkInteger, but if
     we are using the integer-gmp implementation then there is a
     special case where we use the S# constructor for Integers that
     are in the range of Int.
@@ -150,35 +152,37 @@ type CpeRhs  = CoreExpr    -- Non-terminal 'rhs'
 %************************************************************************
 
 \begin{code}
-corePrepPgm :: DynFlags -> CoreProgram -> [TyCon] -> IO CoreProgram
-corePrepPgm dflags binds data_tycons = do
+corePrepPgm :: DynFlags -> HscEnv -> CoreProgram -> [TyCon] -> IO CoreProgram
+corePrepPgm dflags hsc_env binds data_tycons = do
     showPass dflags "CorePrep"
     us <- mkSplitUniqSupply 's'
+    initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
 
     let implicit_binds = mkDataConWorkers data_tycons
             -- NB: we must feed mkImplicitBinds through corePrep too
             -- so that they are suitably cloned and eta-expanded
 
         binds_out = initUs_ us $ do
-                      floats1 <- corePrepTopBinds binds
-                      floats2 <- corePrepTopBinds implicit_binds
+                      floats1 <- corePrepTopBinds initialCorePrepEnv binds
+                      floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds
                       return (deFloatTop (floats1 `appendFloats` floats2))
 
     endPass dflags CorePrep binds_out []
     return binds_out
 
-corePrepExpr :: DynFlags -> CoreExpr -> IO CoreExpr
-corePrepExpr dflags expr = do
+corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
+corePrepExpr dflags hsc_env expr = do
     showPass dflags "CorePrep"
     us <- mkSplitUniqSupply 's'
-    let new_expr = initUs_ us (cpeBodyNF emptyCorePrepEnv expr)
+    initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
+    let new_expr = initUs_ us (cpeBodyNF initialCorePrepEnv expr)
     dumpIfSet_dyn dflags Opt_D_dump_prep "CorePrep" (ppr new_expr)
     return new_expr
 
-corePrepTopBinds :: [CoreBind] -> UniqSM Floats
+corePrepTopBinds :: CorePrepEnv -> [CoreBind] -> UniqSM Floats
 -- Note [Floating out of top level bindings]
-corePrepTopBinds binds
-  = go emptyCorePrepEnv binds
+corePrepTopBinds initialCorePrepEnv binds
+  = go initialCorePrepEnv binds
   where
     go _   []             = return emptyFloats
     go env (bind : binds) = do (env', bind') <- cpeBind TopLevel env bind
@@ -463,8 +467,8 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
 
 cpeRhsE _env expr@(Type {})      = return (emptyFloats, expr)
 cpeRhsE _env expr@(Coercion {})  = return (emptyFloats, expr)
-cpeRhsE env (Lit (LitInteger i mk_integer))
-    = cpeRhsE env (cvtLitInteger i mk_integer)
+cpeRhsE env (Lit (LitInteger i _))
+    = cpeRhsE env (cvtLitInteger (getMkIntegerId env) i)
 cpeRhsE _env expr@(Lit {})       = return (emptyFloats, expr)
 cpeRhsE env expr@(Var {})        = cpeApp env expr
 
@@ -514,13 +518,13 @@ cpeRhsE env (Case scrut bndr ty alts)
             ; rhs' <- cpeBodyNF env2 rhs
             ; return (con, bs', rhs') }
 
-cvtLitInteger :: Integer -> Id -> CoreExpr
+cvtLitInteger :: Id -> Integer -> CoreExpr
 -- Here we convert a literal Integer to the low-level
 -- represenation. Exactly how we do this depends on the
 -- library that implements Integer.  If it's GMP we
 -- use the S# data constructor for small literals.
 -- See Note [Integer literals] in Literal
-cvtLitInteger i mk_integer
+cvtLitInteger mk_integer i
   | cIntegerLibraryType == IntegerGMP
   , inIntRange i       -- Special case for small integers in GMP
     = mkConApp integerGmpSDataCon [Lit (mkMachInt i)]
@@ -1144,23 +1148,32 @@ allLazyNested is_rec (Floats IfUnboxedOk _) = isNonRec is_rec
 --                      The environment
 -- ---------------------------------------------------------------------------
 
-data CorePrepEnv = CPE (IdEnv Id)       -- Clone local Ids
+data CorePrepEnv = CPE (IdEnv Id) -- Clone local Ids
+                       Id         -- mkIntegerId
 
-emptyCorePrepEnv :: CorePrepEnv
-emptyCorePrepEnv = CPE emptyVarEnv
+mkInitialCorePrepEnv :: HscEnv -> IO CorePrepEnv
+mkInitialCorePrepEnv hsc_env
+    = do mkIntegerId <- liftM tyThingId
+                      $ initTcForLookup hsc_env (tcLookupGlobal mkIntegerName)
+         return $ CPE emptyVarEnv mkIntegerId
 
 extendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv
-extendCorePrepEnv (CPE env) id id' = CPE (extendVarEnv env id id')
+extendCorePrepEnv (CPE env mkIntegerId) id id'
+    = CPE (extendVarEnv env id id') mkIntegerId
 
 extendCorePrepEnvList :: CorePrepEnv -> [(Id,Id)] -> CorePrepEnv
-extendCorePrepEnvList (CPE env) prs = CPE (extendVarEnvList env prs)
+extendCorePrepEnvList (CPE env mkIntegerId) prs
+    = CPE (extendVarEnvList env prs) mkIntegerId
 
 lookupCorePrepEnv :: CorePrepEnv -> Id -> Id
-lookupCorePrepEnv (CPE env) id
+lookupCorePrepEnv (CPE env _) id
   = case lookupVarEnv env id of
         Nothing  -> id
         Just id' -> id'
 
+getMkIntegerId :: CorePrepEnv -> Id
+getMkIntegerId (CPE _ mkIntegerId) = mkIntegerId
+
 ------------------------------------------------------------------------------
 -- Cloning binders
 -- ---------------------------------------------------------------------------
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index bfe6dec72e..40243edc0a 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -539,7 +539,7 @@ data CoreRule
 	ru_fn    :: Name,       -- ^ As above
 	ru_nargs :: Int,	-- ^ Number of arguments that 'ru_try' consumes,
 				-- if it fires, including type arguments
-	ru_try  :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
+	ru_try  :: Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
 		-- ^ This function does the rewrite.  It given too many
 		-- arguments, it simply discards them; the returned 'CoreExpr'
 		-- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 53386fec02..25dfaababa 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -85,7 +85,7 @@ import Outputable
 import FastString
 import UniqSupply
 import BasicTypes
-import Util             ( notNull, zipEqual, sortLe )
+import Util
 import Pair
 import Constants
 
@@ -257,8 +257,8 @@ mkWordExprWord w = mkConApp wordDataCon [mkWordLitWord w]
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Integer@
 mkIntegerExpr  :: MonadThings m => Integer -> m CoreExpr  -- Result :: Integer
-mkIntegerExpr i = do mkIntegerId <- lookupId mkIntegerName
-                     return (Lit (mkLitInteger i mkIntegerId))
+mkIntegerExpr i = do t <- lookupTyCon integerTyConName
+                     return (Lit (mkLitInteger i (mkTyConTy t)))
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Float@
 mkFloatExpr :: Float -> CoreExpr
diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs
index 2fff5fdb56..76bdfb930f 100644
--- a/compiler/deSugar/DsCCall.lhs
+++ b/compiler/deSugar/DsCCall.lhs
@@ -49,6 +49,7 @@ import PrelNames
 import VarSet
 import Constants
 import Outputable
+import Util
 \end{code}
 
 Desugaring of @ccall@s consists of adding some state manipulation,
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 04424cde3e..7fa35e30eb 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -155,7 +155,7 @@ dsStrictBind (PatBind {pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty }) body
                              eqn_rhs = cantFailMatchResult body }
        ; var    <- selectMatchVar upat
        ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
-       ; return (scrungleMatch var rhs result) }
+       ; return (bindNonRec var rhs result) }
 
 dsStrictBind bind body = pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
 
@@ -164,38 +164,13 @@ strictMatchOnly :: HsBind Id -> Bool
 strictMatchOnly (AbsBinds { abs_binds = binds })
   = anyBag (strictMatchOnly . unLoc) binds
 strictMatchOnly (PatBind { pat_lhs = lpat, pat_rhs_ty = ty })
-  =  isUnboxedTupleType ty 
+  =  isUnLiftedType ty 
   || isBangLPat lpat   
   || any (isUnLiftedType . idType) (collectPatBinders lpat)
 strictMatchOnly (FunBind { fun_id = L _ id })
   = isUnLiftedType (idType id)
 strictMatchOnly _ = False -- I hope!  Checked immediately by caller in fact
 
-scrungleMatch :: Id -> CoreExpr -> CoreExpr -> CoreExpr
--- Returns something like (let var = scrut in body)
--- but if var is an unboxed-tuple type, it inlines it in a fragile way
--- Special case to handle unboxed tuple patterns; they can't appear nested
--- The idea is that 
---      case e of (# p1, p2 #) -> rhs
--- should desugar to
---      case e of (# x1, x2 #) -> ... match p1, p2 ...
--- NOT
---      let x = e in case x of ....
---
--- But there may be a big 
---      let fail = ... in case e of ...
--- wrapping the whole case, which complicates matters slightly
--- It all seems a bit fragile.  Test is dsrun013.
-
-scrungleMatch var scrut body
-  | isUnboxedTupleType (idType var) = scrungle body
-  | otherwise                       = bindNonRec var scrut body
-  where
-    scrungle (Case (Var x) bndr ty alts)
-                    | x == var = Case scrut bndr ty alts
-    scrungle (Let binds body)  = Let binds (scrungle body)
-    scrungle other = panic ("scrungleMatch: tuple pattern:\n" ++ showSDoc (ppr other))
-
 \end{code}
 
 %************************************************************************
@@ -327,7 +302,7 @@ dsExpr (HsCase discrim matches@(MatchGroup _ rhs_ty))
   | otherwise
   = do { core_discrim <- dsLExpr discrim
        ; ([discrim_var], matching_code) <- matchWrapper CaseAlt matches
-       ; return (scrungleMatch discrim_var core_discrim matching_code) }
+       ; return (bindNonRec discrim_var core_discrim matching_code) }
 
 -- Pepe: The binds are in scope in the body but NOT in the binding group
 --       This is to avoid silliness in breakpoints
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index be66b074f3..93dc627f14 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -47,6 +47,8 @@ import Config
 import Constants
 import OrdList
 import Pair
+import Util
+
 import Data.Maybe
 import Data.List
 \end{code}
@@ -707,9 +709,12 @@ toCType = f False
               = pprPanic "toCType" (ppr t)
 
 typeTyCon :: Type -> TyCon
-typeTyCon ty = case tcSplitTyConApp_maybe (repType ty) of
-                 Just (tc,_) -> tc
-                 Nothing     -> pprPanic "DsForeign.typeTyCon" (ppr ty)
+typeTyCon ty
+  | UnaryRep rep_ty <- repType ty
+  , Just (tc, _) <- tcSplitTyConApp_maybe rep_ty
+  = tc
+  | otherwise
+  = pprPanic "DsForeign.typeTyCon" (ppr ty)
 
 insertRetAddr :: DynFlags -> CCallConv
               -> [(SDoc, SDoc, Type, CmmType)]
@@ -752,7 +757,7 @@ ret_addr_arg = (text "original_return_addr", text "void*", undefined,
 
 -- This function returns the primitive type associated with the boxed
 -- type argument to a foreign export (eg. Int ==> Int#).
-getPrimTyOf :: Type -> Type
+getPrimTyOf :: Type -> UnaryType
 getPrimTyOf ty
   | isBoolTy rep_ty = intPrimTy
   -- Except for Bool, the types we are interested in have a single constructor
@@ -765,7 +770,7 @@ getPrimTyOf ty
         prim_ty
      _other -> pprPanic "DsForeign.getPrimTyOf" (ppr ty)
   where
-        rep_ty = repType ty
+        UnaryRep rep_ty = repType ty
 
 -- represent a primitive type as a Char, for building a string that
 -- described the foreign function type.  The types are size-dependent,
diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs
index c3c52188fe..74fe642f1e 100644
--- a/compiler/deSugar/DsListComp.lhs
+++ b/compiler/deSugar/DsListComp.lhs
@@ -33,6 +33,7 @@ import SrcLoc
 import Outputable
 import FastString
 import TcType
+import Util
 \end{code}
 
 List comprehensions may be desugared in one of two ways: ``ordinary''
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 625c17ab33..9a1d050fb2 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, filterOut )
+import Util
 
 import Data.Maybe
 import Control.Monad
diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs
index 29c10bdb48..e1b2ef83df 100644
--- a/compiler/deSugar/MatchCon.lhs
+++ b/compiler/deSugar/MatchCon.lhs
@@ -26,7 +26,7 @@ import TcType
 import DsMonad
 import DsUtils
 import MkCore   ( mkCoreLets )
-import Util	( all2, takeList, zipEqual )
+import Util
 import ListSetOps ( runs )
 import Id
 import NameEnv
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 090c34ffc0..bfd44384bb 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -360,6 +360,7 @@ Library
         SRT
         SimplStg
         StgStats
+        UnariseStg
         Rules
         SpecConstr
         Specialise
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 93e6a8c188..5e5a5f0c62 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -34,6 +34,7 @@ import ClosureInfo -- CgRep stuff
 import DynFlags
 import Outputable
 import Platform
+import Util
 
 import Control.Monad
 import Control.Monad.ST ( runST )
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index c84d84a78c..851ca389ab 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -271,8 +271,12 @@ collect :: AnnExpr Id VarSet -> ([Var], AnnExpr' Id VarSet)
 collect (_, e) = go [] e
   where
     go xs e | Just e' <- bcView e = go xs e'
-    go xs (AnnLam x (_,e))        = go (x:xs) e
-    go xs not_lambda              = (reverse xs, not_lambda)
+    go xs (AnnLam x (_,e)) 
+      | UbxTupleRep _ <- repType (idType x)
+      = unboxedTupleException
+      | otherwise
+      = go (x:xs) e
+    go xs not_lambda = (reverse xs, not_lambda)
 
 schemeR_wrk :: [Id] -> Id -> AnnExpr Id VarSet -> ([Var], AnnExpr' Var VarSet) -> BcM (ProtoBCO Name)
 schemeR_wrk fvs nm original_body (args, body)
@@ -486,7 +490,7 @@ schemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut
         -- no alts: scrut is guaranteed to diverge
 
 schemeE d s p (AnnCase scrut _ _ [(DataAlt dc, [bind1, bind2], rhs)])
-   | isUnboxedTupleCon dc, VoidArg <- typeCgRep (idType bind1)
+   | isUnboxedTupleCon dc, UnaryRep rep_ty <- repType (idType bind1), VoidRep <- typePrimRep rep_ty
         -- Convert
         --      case .... of x { (# VoidArg'd-thing, a #) -> ... }
         -- to
@@ -499,12 +503,12 @@ schemeE d s p (AnnCase scrut _ _ [(DataAlt dc, [bind1, bind2], rhs)])
    = --trace "automagic mashing of case alts (# VoidArg, a #)" $
      doCase d s p scrut bind2 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
 
-   | isUnboxedTupleCon dc, VoidArg <- typeCgRep (idType bind2)
+   | isUnboxedTupleCon dc, UnaryRep rep_ty <- repType (idType bind2), VoidRep <- typePrimRep rep_ty
    = --trace "automagic mashing of case alts (# a, VoidArg #)" $
      doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
 
 schemeE d s p (AnnCase scrut _ _ [(DataAlt dc, [bind1], rhs)])
-   | isUnboxedTupleCon dc
+   | isUnboxedTupleCon dc, UnaryRep _ <- repType (idType bind1)
         -- Similarly, convert
         --      case .... of x { (# a #) -> ... }
         -- to
@@ -603,7 +607,8 @@ schemeT d s p app
       -- Detect and extract relevant info for the tagToEnum kludge.
       maybe_is_tagToEnum_call
          = let extract_constr_Names ty
-                 | Just tyc <- tyConAppTyCon_maybe (repType ty),
+                 | UnaryRep rep_ty <- repType ty
+                 , Just tyc <- tyConAppTyCon_maybe rep_ty,
                    isDataTyCon tyc
                    = map (getName . dataConWorkId) (tyConDataCons tyc)
                    -- NOTE: use the worker name, not the source name of
@@ -746,6 +751,9 @@ doCase  :: Word -> Sequel -> BCEnv
         -> Bool  -- True <=> is an unboxed tuple case, don't enter the result
         -> BcM BCInstrList
 doCase d s p (_,scrut) bndr alts is_unboxed_tuple
+  | UbxTupleRep _ <- repType (idType bndr)
+  = unboxedTupleException
+  | otherwise
   = let
         -- Top of stack is the return itbl, as usual.
         -- underneath it is the pointer to the alt_code BCO.
@@ -785,6 +793,8 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
            | null real_bndrs = do
                 rhs_code <- schemeE d_alts s p_alts rhs
                 return (my_discr alt, rhs_code)
+           | any (\bndr -> case repType (idType bndr) of UbxTupleRep _ -> True; _ -> False) bndrs
+           = unboxedTupleException
            -- algebraic alt with some binders
            | otherwise =
              let
@@ -903,7 +913,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
 
          pargs _ [] = return []
          pargs d (a:az)
-            = let arg_ty = repType (exprType (deAnnotate' a))
+            = let UnaryRep arg_ty = repType (exprType (deAnnotate' a))
 
               in case tyConAppTyCon_maybe arg_ty of
                     -- Don't push the FO; instead push the Addr# it
@@ -1107,13 +1117,11 @@ maybe_getCCallReturnRep fn_ty
    = let (_a_tys, r_ty) = splitFunTys (dropForAlls fn_ty)
          maybe_r_rep_to_go
             = if isSingleton r_reps then Nothing else Just (r_reps !! 1)
-         (r_tycon, r_reps)
-            = case splitTyConApp_maybe (repType r_ty) of
-                      (Just (tyc, tys)) -> (tyc, map typePrimRep tys)
-                      Nothing -> blargh
+         r_reps = case repType r_ty of
+                      UbxTupleRep reps -> map typePrimRep reps
+                      UnaryRep _       -> blargh
          ok = ( ( r_reps `lengthIs` 2 && VoidRep == head r_reps)
                 || r_reps == [VoidRep] )
-              && isUnboxedTupleTyCon r_tycon
               && case maybe_r_rep_to_go of
                     Nothing    -> True
                     Just r_rep -> r_rep /= PtrRep
diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index e6da6407bb..7378141e3d 100644
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -25,6 +25,7 @@ import NameEnv
 import ClosureInfo
 import DataCon          ( DataCon, dataConRepArgTys, dataConIdentity )
 import TyCon            ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
+import Type             ( flattenRepType, repType )
 import Constants        ( mIN_PAYLOAD_SIZE, wORD_SIZE )
 import CgHeapery        ( mkVirtHeapOffsets )
 import Util
@@ -98,7 +99,7 @@ make_constr_itbls cons
 
         mk_itbl :: DataCon -> Int -> Ptr () -> IO (Name,ItblPtr)
         mk_itbl dcon conNo entry_addr = do
-           let rep_args = [ (typeCgRep arg,arg) | arg <- dataConRepArgTys dcon ]
+           let rep_args = [ (typeCgRep rep_arg,rep_arg) | arg <- dataConRepArgTys dcon, rep_arg <- flattenRepType (repType arg) ]
                (tot_wds, ptr_wds, _) = mkVirtHeapOffsets False{-not a THUNK-} rep_args
 
                ptrs'  = ptr_wds
diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index d8235b6905..0087eb2994 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -27,6 +27,7 @@ import Module
 import FastString
 import Panic
 import Outputable
+import Util
 
 -- Standard libraries
 
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 121b269d64..4be3d87f31 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -54,12 +54,12 @@ import Name
 import VarEnv
 import Util
 import VarSet
+import BasicTypes       ( TupleSort(UnboxedTuple) )
 import TysPrim
 import PrelNames
 import TysWiredIn
 import DynFlags
 import Outputable as Ppr
-import FastString
 import Constants        ( wORD_SIZE )
 import GHC.Arr          ( Array(..) )
 import GHC.Exts
@@ -662,7 +662,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
         return $ fixFunDictionaries $ expandNewtypes term'
       else do
               (old_ty', rev_subst) <- instScheme quant_old_ty
-              my_ty <- newVar argTypeKind
+              my_ty <- newVar openTypeKind
               when (check1 quant_old_ty) (traceTR (text "check1 passed") >>
                                           addConstraint my_ty old_ty')
               term  <- go max_depth my_ty sigma_old_ty hval
@@ -682,7 +682,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
                       zterm' <- mapTermTypeM
                                  (\ty -> case tcSplitTyConApp_maybe ty of
                                            Just (tc, _:_) | tc /= funTyCon
-                                               -> newVar argTypeKind
+                                               -> newVar openTypeKind
                                            _   -> return ty)
                                  term
                       zonkTerm zterm'
@@ -759,32 +759,13 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
           Just dc -> do
             traceTR (text "Just" <+> ppr dc)
             subTtypes <- getDataConArgTys dc my_ty
-            let (subTtypesP, subTtypesNP) = partition isPtrType subTtypes
-            subTermsP <- sequence
-                  [ appArr (go (pred max_depth) ty ty) (ptrs clos) i
-                  | (i,ty) <- zip [0..] subTtypesP]
-            let unboxeds   = extractUnboxed subTtypesNP clos
-                subTermsNP = zipWith Prim subTtypesNP unboxeds
-                subTerms   = reOrderTerms subTermsP subTermsNP subTtypes
+            subTerms <- extractSubTerms (\ty -> go (pred max_depth) ty ty) clos subTtypes
             return (Term my_ty (Right dc) a subTerms)
 
 -- The otherwise case: can be a Thunk,AP,PAP,etc.
       tipe_clos ->
          return (Suspension tipe_clos my_ty a Nothing)
 
-  -- put together pointed and nonpointed subterms in the
-  --  correct order.
-  reOrderTerms _ _ [] = []
-  reOrderTerms pointed unpointed (ty:tys) 
-   | isPtrType ty = ASSERT2(not(null pointed)
-                            , ptext (sLit "reOrderTerms") $$ 
-                                        (ppr pointed $$ ppr unpointed))
-                    let (t:tt) = pointed in t : reOrderTerms tt unpointed tys
-   | otherwise    = ASSERT2(not(null unpointed)
-                           , ptext (sLit "reOrderTerms") $$ 
-                                       (ppr pointed $$ ppr unpointed))
-                    let (t:tt) = unpointed in t : reOrderTerms pointed tt tys
-
   -- insert NewtypeWraps around newtypes
   expandNewtypes = foldTerm idTermFold { fTerm = worker } where
    worker ty dc hval tt
@@ -802,6 +783,46 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
       worker ct ty hval n | isFunTy ty = Suspension ct (dictsView ty) hval n
                           | otherwise  = Suspension ct ty hval n
 
+extractSubTerms :: (Type -> HValue -> TcM Term)
+                -> Closure -> [Type] -> TcM [Term]
+extractSubTerms recurse clos = liftM thirdOf3 . go 0 (nonPtrs clos)
+  where
+    go ptr_i ws [] = return (ptr_i, ws, [])
+    go ptr_i ws (ty:tys)
+      | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty
+      , isUnboxedTupleTyCon tc
+      = do (ptr_i, ws, terms0) <- go ptr_i ws elem_tys
+           (ptr_i, ws, terms1) <- go ptr_i ws tys
+           return (ptr_i, ws, unboxedTupleTerm ty terms0 : terms1)
+      | otherwise
+      = case repType ty of
+          UnaryRep rep_ty -> do
+            (ptr_i, ws, term0)  <- go_rep ptr_i ws ty (typePrimRep rep_ty)
+            (ptr_i, ws, terms1) <- go ptr_i ws tys
+            return (ptr_i, ws, term0 : terms1)
+          UbxTupleRep rep_tys -> do
+            (ptr_i, ws, terms0) <- go_unary_types ptr_i ws rep_tys
+            (ptr_i, ws, terms1) <- go ptr_i ws tys
+            return (ptr_i, ws, unboxedTupleTerm ty terms0 : terms1)
+
+    go_unary_types ptr_i ws [] = return (ptr_i, ws, [])
+    go_unary_types ptr_i ws (rep_ty:rep_tys) = do
+      tv <- newVar liftedTypeKind
+      (ptr_i, ws, term0)  <- go_rep ptr_i ws tv (typePrimRep rep_ty)
+      (ptr_i, ws, terms1) <- go_unary_types ptr_i ws rep_tys
+      return (ptr_i, ws, term0 : terms1)
+
+    go_rep ptr_i ws ty rep = case rep of
+      PtrRep -> do
+        t <- appArr (recurse ty) (ptrs clos) ptr_i
+        return (ptr_i + 1, ws, t)
+      _ -> do
+        let (ws0, ws1) = splitAt (primRepSizeW rep) ws
+        return (ptr_i, ws1, Prim ty ws0)
+
+    unboxedTupleTerm ty terms = Term ty (Right (tupleCon UnboxedTuple (length terms)))
+                                        (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
+
 
 -- Fast, breadth-first Type reconstruction
 ------------------------------------------
@@ -814,7 +835,7 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
         then return old_ty
         else do
           (old_ty', rev_subst) <- instScheme sigma_old_ty
-          my_ty <- newVar argTypeKind
+          my_ty <- newVar openTypeKind
           when (check1 sigma_old_ty) (traceTR (text "check1 passed") >>
                                       addConstraint my_ty old_ty')
           search (isMonomorphic `fmap` zonkTcType my_ty)
@@ -870,11 +891,36 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
 
           Just dc -> do
             arg_tys <- getDataConArgTys dc my_ty
-	    traceTR (text "Constr2" <+> ppr dcname <+> ppr arg_tys)
+            (_, itys) <- findPtrTyss 0 arg_tys
+            traceTR (text "Constr2" <+> ppr dcname <+> ppr arg_tys)
             return $ [ appArr (\e-> (ty,e)) (ptrs clos) i
-                     | (i,ty) <- zip [0..] (filter isPtrType arg_tys)]
+                     | (i,ty) <- itys]
       _ -> return []
 
+findPtrTys :: Int  -- Current pointer index
+           -> Type -- Type
+           -> TR (Int, [(Int, Type)])
+findPtrTys i ty
+  | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty
+  , isUnboxedTupleTyCon tc
+  = findPtrTyss i elem_tys
+  
+  | otherwise
+  = case repType ty of
+      UnaryRep rep_ty | typePrimRep rep_ty == PtrRep -> return (i + 1, [(i, ty)])
+                      | otherwise                    -> return (i,     [])
+      UbxTupleRep rep_tys  -> foldM (\(i, extras) rep_ty -> if typePrimRep rep_ty == PtrRep
+                                                             then newVar liftedTypeKind >>= \tv -> return (i + 1, extras ++ [(i, tv)])
+                                                             else return (i, extras))
+                                    (i, []) rep_tys
+
+findPtrTyss :: Int
+            -> [Type]
+            -> TR (Int, [(Int, Type)])
+findPtrTyss i tys = foldM step (i, []) tys
+  where step (i, discovered) elem_ty = findPtrTys i elem_ty >>= \(i, extras) -> return (i, discovered ++ extras)
+
+
 -- Compute the difference between a base type and the type found by RTTI
 -- improveType <base_type> <rtti_type>
 -- The types can contain skolem type variables, which need to be treated as normal vars.
@@ -890,7 +936,7 @@ getDataConArgTys :: DataCon -> Type -> TR [Type]
 -- if so, make up fresh RTTI type variables for them
 getDataConArgTys dc con_app_ty
   = do { (_, ex_tys, _) <- instTyVars ex_tvs
-       ; let rep_con_app_ty = repType con_app_ty
+       ; let UnaryRep rep_con_app_ty = repType con_app_ty
        ; ty_args <- case tcSplitTyConApp_maybe rep_con_app_ty of
                        Just (tc, ty_args) | dataConTyCon dc == tc
 		       	   -> ASSERT( univ_tvs `equalLength` ty_args) 
@@ -909,11 +955,6 @@ getDataConArgTys dc con_app_ty
     univ_tvs = dataConUnivTyVars dc
     ex_tvs   = dataConExTyVars dc
 
-isPtrType :: Type -> Bool
-isPtrType ty = case typePrimRep ty of
-                 PtrRep -> True
-                 _      -> False
-
 -- Soundness checks
 --------------------
 {-
@@ -1111,7 +1152,8 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs')
                         text " in presence of newtype evidence " <> ppr new_tycon)
                (_, vars, _) <- instTyVars (tyConTyVars new_tycon)
                let ty' = mkTyConApp new_tycon vars
-               _ <- liftTcM (unifyType ty (repType ty'))
+                   UnaryRep rep_ty = repType ty'
+               _ <- liftTcM (unifyType ty rep_ty)
         -- assumes that reptype doesn't ^^^^ touch tyconApp args 
                return ty'
 
@@ -1158,7 +1200,8 @@ isMonomorphic ty = noExistentials && noUniversals
 -- Use only for RTTI types
 isMonomorphicOnNonPhantomArgs :: RttiType -> Bool
 isMonomorphicOnNonPhantomArgs ty
-  | Just (tc, all_args) <- tcSplitTyConApp_maybe (repType ty)
+  | UnaryRep rep_ty <- repType ty
+  , Just (tc, all_args) <- tcSplitTyConApp_maybe rep_ty
   , phantom_vars  <- tyConPhantomTyVars tc
   , concrete_args <- [ arg | (tyv,arg) <- tyConTyVars tc `zip` all_args
                            , tyv `notElem` phantom_vars]
@@ -1196,11 +1239,3 @@ amap' :: (t -> b) -> Array Int t -> [b]
 amap' f (Array i0 i _ arr#) = map g [0 .. i - i0]
     where g (I# i#) = case indexArray# arr# i# of
                           (# e #) -> f e
-
-extractUnboxed  :: [Type] -> Closure -> [[Word]]
-extractUnboxed tt clos = go tt (nonPtrs clos)
-   where sizeofType t = primRepSizeW (typePrimRep t)
-         go [] _ = []
-         go (t:tt) xx 
-           | (x, rest) <- splitAt (sizeofType t) xx
-           = x : go tt rest
diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index 349c001cc8..c7f4459d6e 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -32,7 +32,7 @@ import Name
 import BasicTypes
 import DataCon
 import SrcLoc
-import Util( dropTail )
+import Util
 import StaticFlags( opt_PprStyle_Debug )
 import Outputable
 import FastString
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 305fa54d0e..a69656533c 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -51,6 +51,7 @@ import Outputable
 import Platform
 import FastString
 import Constants
+import Util
 
 import Data.Bits
 import Data.Char
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index d41ee68d20..9456bdaf34 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -38,7 +38,7 @@ import Type
 import Coercion
 
 import TcRnMonad
-import Util		( isSingleton )
+import Util
 import Outputable
 \end{code}
 	
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 4c66a98314..1e776f52a3 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -41,6 +41,7 @@ import FastString
 import UniqSupply
 import SrcLoc
 import BasicTypes
+import Util
 
 import Outputable
 import Exception     ( evaluate )
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index e7360dc935..6a5e423477 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -997,7 +997,7 @@ tcIfaceExpr (IfaceExt gbl)
 tcIfaceExpr (IfaceLit lit)
   = do lit' <- tcIfaceLit lit
        return (Lit lit')
-
+ 
 tcIfaceExpr (IfaceFCall cc ty) = do
     ty' <- tcIfaceType ty
     u <- newUnique
@@ -1081,12 +1081,12 @@ tcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)
 
 -------------------------
 tcIfaceLit :: Literal -> IfL Literal
--- Integer literals deserialise to (LitInteeger i <error thunk>) 
--- so tcIfaceLit just fills in the mkInteger Id 
+-- Integer literals deserialise to (LitInteger i <error thunk>) 
+-- so tcIfaceLit just fills in the type.
 -- See Note [Integer literals] in Literal
 tcIfaceLit (LitInteger i _)
-  = do mkIntegerId <- tcIfaceExtId mkIntegerName
-       return (mkLitInteger i mkIntegerId)
+  = do t <- tcIfaceTyCon (IfaceTc integerTyConName)
+       return (mkLitInteger i (mkTyConTy t))
 tcIfaceLit lit = return lit
 
 -------------------------
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 8d190d4e5e..ba4bfbc7b2 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -147,6 +147,7 @@ import UniqFM           ( emptyUFM )
 import UniqSupply       ( initUs_ )
 import Bag
 import Exception
+import Util
 
 import Data.List
 import Control.Monad
@@ -1258,7 +1259,7 @@ hscGenHardCode cgguts mod_summary = do
         -- PREPARE FOR CODE GENERATION
         -- Do saturation and convert to A-normal form
         prepd_binds <- {-# SCC "CorePrep" #-}
-                       corePrepPgm dflags core_binds data_tycons ;
+                       corePrepPgm dflags hsc_env core_binds data_tycons ;
         -----------------  Convert to STG ------------------
         (stg_binds, cost_centre_info)
             <- {-# SCC "CoreToStg" #-}
@@ -1311,8 +1312,9 @@ hscInteractive (iface, details, cgguts) mod_summary = do
     -------------------
     -- PREPARE FOR CODE GENERATION
     -- Do saturation and convert to A-normal form
+    hsc_env <- getHscEnv
     prepd_binds <- {-# SCC "CorePrep" #-}
-                   liftIO $ corePrepPgm dflags core_binds data_tycons ;
+                   liftIO $ corePrepPgm dflags hsc_env core_binds data_tycons
     -----------------  Generate byte code ------------------
     comp_bc <- liftIO $ byteCodeGen dflags this_mod prepd_binds
                                     data_tycons mod_breaks
@@ -1497,7 +1499,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
     {- Prepare For Code Generation -}
     -- Do saturation and convert to A-normal form
     prepd_binds <- {-# SCC "CorePrep" #-}
-                    liftIO $ corePrepPgm dflags core_binds data_tycons
+                    liftIO $ corePrepPgm dflags hsc_env core_binds data_tycons
 
     {- Generate byte code -}
     cbc <- liftIO $ byteCodeGen dflags this_mod
@@ -1674,7 +1676,7 @@ hscCompileCoreExpr hsc_env srcspan ds_expr
         let tidy_expr = tidyExpr emptyTidyEnv simpl_expr
 
         {- Prepare for codegen -}
-        prepd_expr <- corePrepExpr dflags tidy_expr
+        prepd_expr <- corePrepExpr dflags hsc_env tidy_expr
 
         {- Lint if necessary -}
         -- ToDo: improve SrcLoc
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 43b60afae0..5fa0f6bd57 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -43,6 +43,7 @@ import HscMain
 import HsSyn
 import HscTypes
 import InstEnv
+import TyCon
 import Type     hiding( typeKind )
 import TcType           hiding( typeKind )
 import Var
@@ -72,6 +73,7 @@ import MonadUtils
 
 import System.Directory
 import Data.Dynamic
+import Data.Either
 import Data.List (find)
 import Control.Monad
 #if __GLASGOW_HASKELL__ >= 701
@@ -608,8 +610,9 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
            -- Filter out any unboxed ids;
            -- we can't bind these at the prompt
        pointers = filter (\(id,_) -> isPointer id) vars
-       isPointer id | PtrRep <- idPrimRep id = True
-                    | otherwise              = False
+       isPointer id | UnaryRep ty <- repType (idType id)
+                    , PtrRep <- typePrimRep ty = True
+                    | otherwise                = False
 
        (ids, offsets) = unzip pointers
 
@@ -644,7 +647,6 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
    --    - globalise the Id (Ids are supposed to be Global, apparently).
    --
    let result_ok = isPointer result_id
-                    && not (isUnboxedTupleType (idType result_id))
 
        all_ids | result_ok = result_id : new_ids
                | otherwise = new_ids
@@ -812,20 +814,29 @@ fromListBL bound l = BL (length l) bound l []
 setContext :: GhcMonad m => [InteractiveImport] -> m ()
 setContext imports
   = do { hsc_env <- getSession
-       ; all_env <- liftIO $ findGlobalRdrEnv hsc_env imports
+       ; all_env_err <- liftIO $ findGlobalRdrEnv hsc_env imports
+       ; case all_env_err of
+           Left (mod, err) -> ghcError (formatError mod err)
+           Right all_env -> do {
        ; let old_ic        = hsc_IC hsc_env
              final_rdr_env = ic_tythings old_ic `icPlusGblRdrEnv` all_env
        ; modifySession $ \_ ->
          hsc_env{ hsc_IC = old_ic { ic_imports    = imports
-                                  , ic_rn_gbl_env = final_rdr_env }}}
+                                  , ic_rn_gbl_env = final_rdr_env }}}}
+  where
+    formatError mod err = ProgramError . showSDoc $
+      text "Cannot add module" <+> ppr mod <+>
+      text "to context:" <+> text err
 
-findGlobalRdrEnv :: HscEnv -> [InteractiveImport] -> IO GlobalRdrEnv
+findGlobalRdrEnv :: HscEnv -> [InteractiveImport]
+                 -> IO (Either (ModuleName, String) GlobalRdrEnv)
 -- Compute the GlobalRdrEnv for the interactive context
 findGlobalRdrEnv hsc_env imports
   = do { idecls_env <- hscRnImportDecls hsc_env idecls
                     -- This call also loads any orphan modules
-       ; imods_env  <- mapM (mkTopLevEnv (hsc_HPT hsc_env)) imods
-       ; return (foldr plusGlobalRdrEnv idecls_env imods_env) }
+       ; return $ case partitionEithers (map mkEnv imods) of
+           ([], imods_env) -> Right (foldr plusGlobalRdrEnv idecls_env imods_env)
+           (err : _, _)       -> Left err }
   where
     idecls :: [LImportDecl RdrName]
     idecls = [noLoc d | IIDecl d <- imports]
@@ -833,6 +844,10 @@ findGlobalRdrEnv hsc_env imports
     imods :: [ModuleName]
     imods = [m | IIModule m <- imports]
 
+    mkEnv mod = case mkTopLevEnv (hsc_HPT hsc_env) mod of
+      Left err -> Left (mod, err)
+      Right env -> Right env
+
 availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
 availsToGlobalRdrEnv mod_name avails
   = mkGlobalRdrEnv (gresFromAvails imp_prov avails)
@@ -844,17 +859,14 @@ availsToGlobalRdrEnv mod_name avails
                          is_qual = False,
                          is_dloc = srcLocSpan interactiveSrcLoc }
 
-mkTopLevEnv :: HomePackageTable -> ModuleName -> IO GlobalRdrEnv
+mkTopLevEnv :: HomePackageTable -> ModuleName -> Either String GlobalRdrEnv
 mkTopLevEnv hpt modl
   = case lookupUFM hpt modl of
-      Nothing -> ghcError (ProgramError ("mkTopLevEnv: not a home module " ++
-                                                showSDoc (ppr modl)))
+      Nothing -> Left "not a home module"
       Just details ->
          case mi_globals (hm_iface details) of
-                Nothing  ->
-                   ghcError (ProgramError ("mkTopLevEnv: not interpreted "
-                                                ++ showSDoc (ppr modl)))
-                Just env -> return env
+                Nothing  -> Left "not interpreted"
+                Just env -> Right env
 
 -- | Get the interactive evaluation context, consisting of a pair of the
 -- set of modules from which we take the full top-level scope, and the set
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 288ca411c7..6caae2db05 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -17,6 +17,7 @@ import CoreUnfold
 import CoreFVs
 import CoreTidy
 import CoreMonad
+import CorePrep
 import CoreUtils
 import Literal
 import Rules
@@ -34,7 +35,10 @@ import Name hiding (varName)
 import NameSet
 import NameEnv
 import Avail
+import PrelNames
 import IfaceEnv
+import TcEnv
+import TcRnMonad
 import TcType
 import DataCon
 import TyCon
@@ -51,9 +55,9 @@ import SrcLoc
 import Util
 import FastString
 
-import Control.Monad    ( when )
+import Control.Monad
 import Data.List        ( sortBy )
-import Data.IORef       ( IORef, readIORef, writeIORef )
+import Data.IORef       ( readIORef, writeIORef )
 \end{code}
 
 
@@ -325,8 +329,8 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                 -- Then pick just the ones we need to expose
                 -- See Note [Which rules to expose]
 
-        ; let { (tidy_env, tidy_binds)
-                 = tidyTopBinds hsc_env unfold_env tidy_occ_env binds }
+        ; (tidy_env, tidy_binds)
+                 <- tidyTopBinds hsc_env unfold_env tidy_occ_env binds
 
         ; let { export_set = availsToNameSet exports
               ; final_ids  = [ id | id <- bindersOfBinds tidy_binds,
@@ -1036,38 +1040,41 @@ tidyTopBinds :: HscEnv
              -> UnfoldEnv
              -> TidyOccEnv
              -> CoreProgram
-             -> (TidyEnv, CoreProgram)
+             -> IO (TidyEnv, CoreProgram)
 
 tidyTopBinds hsc_env unfold_env init_occ_env binds
-  = tidy init_env binds
+  = do mkIntegerId <- liftM tyThingId
+                    $ initTcForLookup hsc_env (tcLookupGlobal mkIntegerName)
+       return $ tidy mkIntegerId init_env binds
   where
     init_env = (init_occ_env, emptyVarEnv)
 
     this_pkg = thisPackage (hsc_dflags hsc_env)
 
-    tidy env []     = (env, [])
-    tidy env (b:bs) = let (env1, b')  = tidyTopBind this_pkg unfold_env env b
-                          (env2, bs') = tidy env1 bs
-                      in
-                          (env2, b':bs')
+    tidy _           env []     = (env, [])
+    tidy mkIntegerId env (b:bs) = let (env1, b')  = tidyTopBind this_pkg mkIntegerId unfold_env env b
+                                      (env2, bs') = tidy mkIntegerId env1 bs
+                                  in
+                                      (env2, b':bs')
 
 ------------------------
 tidyTopBind  :: PackageId
+             -> Id
              -> UnfoldEnv
              -> TidyEnv
              -> CoreBind
              -> (TidyEnv, CoreBind)
 
-tidyTopBind this_pkg unfold_env (occ_env,subst1) (NonRec bndr rhs)
+tidyTopBind this_pkg mkIntegerId unfold_env (occ_env,subst1) (NonRec bndr rhs)
   = (tidy_env2,  NonRec bndr' rhs')
   where
     Just (name',show_unfold) = lookupVarEnv unfold_env bndr
-    caf_info      = hasCafRefs this_pkg subst1 (idArity bndr) rhs
+    caf_info      = hasCafRefs this_pkg (mkIntegerId, subst1) (idArity bndr) rhs
     (bndr', rhs') = tidyTopPair show_unfold tidy_env2 caf_info name' (bndr, rhs)
     subst2        = extendVarEnv subst1 bndr bndr'
     tidy_env2     = (occ_env, subst2)
 
-tidyTopBind this_pkg unfold_env (occ_env,subst1) (Rec prs)
+tidyTopBind this_pkg mkIntegerId unfold_env (occ_env,subst1) (Rec prs)
   = (tidy_env2, Rec prs')
   where
     prs' = [ tidyTopPair show_unfold tidy_env2 caf_info name' (id,rhs)
@@ -1084,7 +1091,7 @@ tidyTopBind this_pkg unfold_env (occ_env,subst1) (Rec prs)
         -- the CafInfo for a recursive group says whether *any* rhs in
         -- the group may refer indirectly to a CAF (because then, they all do).
     caf_info
-        | or [ mayHaveCafRefs (hasCafRefs this_pkg subst1 (idArity bndr) rhs)
+        | or [ mayHaveCafRefs (hasCafRefs this_pkg (mkIntegerId, subst1) (idArity bndr) rhs)
              | (bndr,rhs) <- prs ] = MayHaveCafRefs
         | otherwise                = NoCafRefs
 
@@ -1221,7 +1228,7 @@ it as a CAF.  In these cases however, we would need to use an additional
 CAF list to keep track of non-collectable CAFs.
 
 \begin{code}
-hasCafRefs  :: PackageId -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
+hasCafRefs  :: PackageId -> (Id, VarEnv Var) -> Arity -> CoreExpr -> CafInfo
 hasCafRefs this_pkg p arity expr
   | is_caf || mentions_cafs = MayHaveCafRefs
   | otherwise               = NoCafRefs
@@ -1236,7 +1243,7 @@ hasCafRefs this_pkg p arity expr
   -- CorePrep later on, and we don't want to duplicate that
   -- knowledge in rhsIsStatic below.
 
-cafRefsE :: VarEnv Id -> Expr a -> FastBool
+cafRefsE :: (Id, VarEnv Id) -> Expr a -> FastBool
 cafRefsE p (Var id)            = cafRefsV p id
 cafRefsE p (Lit lit)           = cafRefsL p lit
 cafRefsE p (App f a)           = fastOr (cafRefsE p f) (cafRefsE p) a
@@ -1248,18 +1255,19 @@ cafRefsE p (Cast e _co)        = cafRefsE p e
 cafRefsE _ (Type _)            = fastBool False
 cafRefsE _ (Coercion _)        = fastBool False
 
-cafRefsEs :: VarEnv Id -> [Expr a] -> FastBool
+cafRefsEs :: (Id, VarEnv Id) -> [Expr a] -> FastBool
 cafRefsEs _ []    = fastBool False
 cafRefsEs p (e:es) = fastOr (cafRefsE p e) (cafRefsEs p) es
 
-cafRefsL :: VarEnv Id -> Literal -> FastBool
--- Don't forget that the embeded mk_integer id might have Caf refs!
--- See Note [Integer literals] in Literal
-cafRefsL p (LitInteger _ mk_integer) = cafRefsV p mk_integer
+cafRefsL :: (Id, VarEnv Id) -> Literal -> FastBool
+-- Don't forget that mk_integer id might have Caf refs!
+-- We first need to convert the Integer into its final form, to
+-- see whether mkInteger is used.
+cafRefsL p@(mk_integer, _) (LitInteger i _) = cafRefsE p (cvtLitInteger mk_integer i)
 cafRefsL _ _                         = fastBool False
 
-cafRefsV :: VarEnv Id -> Id -> FastBool
-cafRefsV p id
+cafRefsV :: (Id, VarEnv Id) -> Id -> FastBool
+cafRefsV (_, p) id
   | not (isLocalId id)            = fastBool (mayHaveCafRefs (idCafInfo id))
   | Just id' <- lookupVarEnv p id = fastBool (mayHaveCafRefs (idCafInfo id'))
   | otherwise                     = fastBool False
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 2b8bb62ad2..22406073b5 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -57,6 +57,7 @@ import Data.Word
 
 import BasicTypes
 import FastString
+import Util
 
 -- -----------------------------------------------------------------------------
 -- Top-level of the instruction selector
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 98d5e892ad..4fa42820ca 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -54,6 +54,7 @@ import FastString
 import FastBool         ( isFastTrue )
 import Constants        ( wORD_SIZE )
 import DynFlags
+import Util
 
 import Control.Monad
 import Data.Bits
diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index 0382fcae7d..edb8b50864 100644
--- a/compiler/parser/ParserCore.y
+++ b/compiler/parser/ParserCore.y
@@ -18,7 +18,7 @@ import OccName
 import TypeRep ( TyThing(..) )
 import Type ( Kind,
               liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
-              argTypeKindTyCon, ubxTupleKindTyCon, mkTyConApp
+              mkTyConApp
             )
 import Kind( mkArrowKind )
 import Name( Name, nameOccName, nameModule, mkExternalName, wiredInNameTyThing_maybe )
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 350aedb6f0..6da712ce44 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -76,6 +76,8 @@ import Bag              ( Bag, emptyBag, consBag )
 import Outputable
 import FastString
 import Maybes
+import Util
+
 import Control.Applicative ((<$>))
 import Control.Monad
 import Text.ParserCombinators.ReadP as ReadP
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index bc76c77b98..7c4115c3fb 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -255,6 +255,7 @@ basicKnownKeyNames
         integerTyConName, mkIntegerName,
         integerToWord64Name, integerToInt64Name,
         plusIntegerName, timesIntegerName, smallIntegerName,
+        wordToIntegerName,
         integerToWordName, integerToIntName, minusIntegerName,
         negateIntegerName, eqIntegerName, neqIntegerName,
         absIntegerName, signumIntegerName,
@@ -840,6 +841,7 @@ negateName        = methName gHC_NUM (fsLit "negate") negateClassOpKey
 integerTyConName, mkIntegerName,
     integerToWord64Name, integerToInt64Name,
     plusIntegerName, timesIntegerName, smallIntegerName,
+    wordToIntegerName,
     integerToWordName, integerToIntName, minusIntegerName,
     negateIntegerName, eqIntegerName, neqIntegerName,
     absIntegerName, signumIntegerName,
@@ -858,6 +860,7 @@ integerToInt64Name    = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64")    int
 plusIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "plusInteger")       plusIntegerIdKey
 timesIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "timesInteger")      timesIntegerIdKey
 smallIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "smallInteger")      smallIntegerIdKey
+wordToIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "wordToInteger")     wordToIntegerIdKey
 integerToWordName     = varQual gHC_INTEGER_TYPE (fsLit "integerToWord")     integerToWordIdKey
 integerToIntName      = varQual gHC_INTEGER_TYPE (fsLit "integerToInt")      integerToIntIdKey
 minusIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "minusInteger")      minusIntegerIdKey
@@ -1299,14 +1302,11 @@ superKindTyConKey                     = mkPreludeTyConUnique 85
 
 -- Kind constructors
 liftedTypeKindTyConKey, anyKindTyConKey, openTypeKindTyConKey,
-  unliftedTypeKindTyConKey, ubxTupleKindTyConKey, argTypeKindTyConKey,
-  constraintKindTyConKey :: Unique
+  unliftedTypeKindTyConKey, constraintKindTyConKey :: Unique
 anyKindTyConKey                         = mkPreludeTyConUnique 86
 liftedTypeKindTyConKey                  = mkPreludeTyConUnique 87
 openTypeKindTyConKey                    = mkPreludeTyConUnique 88
 unliftedTypeKindTyConKey                = mkPreludeTyConUnique 89
-ubxTupleKindTyConKey                    = mkPreludeTyConUnique 90
-argTypeKindTyConKey                     = mkPreludeTyConUnique 91
 constraintKindTyConKey                  = mkPreludeTyConUnique 92
 
 -- Coercion constructors
@@ -1501,7 +1501,8 @@ otherwiseIdKey                = mkPreludeMiscIdUnique 43
 assertIdKey                   = mkPreludeMiscIdUnique 44
 runSTRepIdKey                 = mkPreludeMiscIdUnique 45
 
-mkIntegerIdKey, smallIntegerIdKey, integerToWordIdKey, integerToIntIdKey,
+mkIntegerIdKey, smallIntegerIdKey, wordToIntegerIdKey,
+    integerToWordIdKey, integerToIntIdKey,
     integerToWord64IdKey, integerToInt64IdKey,
     plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey,
     negateIntegerIdKey,
@@ -1549,6 +1550,7 @@ xorIntegerIdKey               = mkPreludeMiscIdUnique 91
 complementIntegerIdKey        = mkPreludeMiscIdUnique 92
 shiftLIntegerIdKey            = mkPreludeMiscIdUnique 93
 shiftRIntegerIdKey            = mkPreludeMiscIdUnique 94
+wordToIntegerIdKey            = mkPreludeMiscIdUnique 95
 
 rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 100
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index fc0c20ad48..467c4c77de 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -41,6 +41,7 @@ import FastString
 import StaticFlags ( opt_SimplExcessPrecision )
 import Constants
 import BasicTypes
+import Util
 
 import Data.Bits as Bits
 import Data.Int    ( Int64 )
@@ -343,9 +344,9 @@ litEq op_name is_eq
                    ru_fn = op_name,
                    ru_nargs = 2, ru_try = rule_fn }]
   where
-    rule_fn _ [Lit lit, expr] = do_lit_eq lit expr
-    rule_fn _ [expr, Lit lit] = do_lit_eq lit expr
-    rule_fn _ _               = Nothing
+    rule_fn _ _ [Lit lit, expr] = do_lit_eq lit expr
+    rule_fn _ _ [expr, Lit lit] = do_lit_eq lit expr
+    rule_fn _ _ _               = Nothing
 
     do_lit_eq lit expr
       | litIsLifted lit 
@@ -373,8 +374,8 @@ boundsCmp op_name op = [ rule ]
       , ru_nargs = 2
       , ru_try = rule_fn
       }
-    rule_fn _ [a, b] = mkRuleFn op a b
-    rule_fn _ _      = Nothing
+    rule_fn _ _ [a, b] = mkRuleFn op a b
+    rule_fn _ _ _      = Nothing
 
 data Comparison = Gt | Ge | Lt | Le
 
@@ -435,7 +436,7 @@ mkBasicRule :: Name -> Int
 mkBasicRule op_name n_args rule_fn
   = [BuiltinRule { ru_name = occNameFS (nameOccName op_name),
                    ru_fn = op_name,
-                   ru_nargs = n_args, ru_try = rule_fn }]
+                   ru_nargs = n_args, ru_try = \_ -> rule_fn }]
 
 oneLit :: Name -> (Literal -> Maybe CoreExpr)
        -> [CoreRule]
@@ -612,17 +613,17 @@ builtinRules :: [CoreRule]
 builtinRules
   = [BuiltinRule { ru_name = fsLit "AppendLitString",
                    ru_fn = unpackCStringFoldrName,
-                   ru_nargs = 4, ru_try = match_append_lit },
+                   ru_nargs = 4, ru_try = \_ -> match_append_lit },
      BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName,
-                   ru_nargs = 2, ru_try = match_eq_string },
+                   ru_nargs = 2, ru_try = \_ -> match_eq_string },
      BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,
-                   ru_nargs = 2, ru_try = match_inline }]
+                   ru_nargs = 2, ru_try = \_ -> match_inline }]
  ++ builtinIntegerRules
 
 builtinIntegerRules :: [CoreRule]
 builtinIntegerRules =
- [-- TODO: smallInteger rule
-  -- TODO: wordToInteger rule
+ [rule_IntToInteger   "smallInteger"        smallIntegerName,
+  rule_WordToInteger  "wordToInteger"       wordToIntegerName,
   rule_convert        "integerToWord"       integerToWordName       mkWordLitWord,
   rule_convert        "integerToInt"        integerToIntName        mkIntLitInt,
   rule_convert        "integerToWord64"     integerToWord64Name     mkWord64LitWord64,
@@ -662,6 +663,12 @@ builtinIntegerRules =
     where rule_convert str name convert
            = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,
                            ru_try = match_Integer_convert convert }
+          rule_IntToInteger str name
+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,
+                           ru_try = match_IntToInteger }
+          rule_WordToInteger str name
+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,
+                           ru_try = match_WordToInteger }
           rule_unop str name op
            = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,
                            ru_try = match_Integer_unop op }
@@ -749,108 +756,140 @@ match_inline _ _ = Nothing
 
 -- Integer rules
 
+match_IntToInteger :: Id
+                   -> IdUnfoldingFun
+                   -> [Expr CoreBndr]
+                   -> Maybe (Expr CoreBndr)
+match_IntToInteger id id_unf [xl]
+  | Just (MachInt x) <- exprIsLiteral_maybe id_unf xl
+  = case idType id of
+    FunTy _ integerTy ->
+        Just (Lit (LitInteger x integerTy))
+    _ ->
+        panic "match_IntToInteger: Id has the wrong type"
+match_IntToInteger _ _ _ = Nothing
+
+match_WordToInteger :: Id
+                    -> IdUnfoldingFun
+                    -> [Expr CoreBndr]
+                    -> Maybe (Expr CoreBndr)
+match_WordToInteger id id_unf [xl]
+  | Just (MachWord x) <- exprIsLiteral_maybe id_unf xl
+  = case idType id of
+    FunTy _ integerTy ->
+        Just (Lit (LitInteger x integerTy))
+    _ ->
+        panic "match_WordToInteger: Id has the wrong type"
+match_WordToInteger _ _ _ = Nothing
+
 match_Integer_convert :: Num a
                       => (a -> Expr CoreBndr)
+                      -> Id
                       -> IdUnfoldingFun
                       -> [Expr CoreBndr]
                       -> Maybe (Expr CoreBndr)
-match_Integer_convert convert id_unf [xl]
+match_Integer_convert convert _ id_unf [xl]
   | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
   = Just (convert (fromInteger x))
-match_Integer_convert _ _ _ = Nothing
+match_Integer_convert _ _ _ _ = Nothing
 
 match_Integer_unop :: (Integer -> Integer)
+                   -> Id
                    -> IdUnfoldingFun
                    -> [Expr CoreBndr]
                    -> Maybe (Expr CoreBndr)
-match_Integer_unop unop id_unf [xl]
+match_Integer_unop unop _ id_unf [xl]
   | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
   = Just (Lit (LitInteger (unop x) i))
-match_Integer_unop _ _ _ = Nothing
+match_Integer_unop _ _ _ _ = Nothing
 
 match_Integer_binop :: (Integer -> Integer -> Integer)
+                    -> Id
                     -> IdUnfoldingFun
                     -> [Expr CoreBndr]
                     -> Maybe (Expr CoreBndr)
-match_Integer_binop binop id_unf [xl,yl]
+match_Integer_binop binop _ id_unf [xl,yl]
   | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   = Just (Lit (LitInteger (x `binop` y) i))
-match_Integer_binop _ _ _ = Nothing
+match_Integer_binop _ _ _ _ = Nothing
 
 -- This helper is used for the quotRem and divMod functions
 match_Integer_divop_both :: (Integer -> Integer -> (Integer, Integer))
+                         -> Id
                          -> IdUnfoldingFun
                          -> [Expr CoreBndr]
                          -> Maybe (Expr CoreBndr)
-match_Integer_divop_both divop id_unf [xl,yl]
-  | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
+match_Integer_divop_both divop _ id_unf [xl,yl]
+  | Just (LitInteger x t) <- exprIsLiteral_maybe id_unf xl
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   , y /= 0
   , (r,s) <- x `divop` y
-  = case idType i of
-      FunTy _ (FunTy _ integerTy) ->
-              Just $ mkConApp (tupleCon UnboxedTuple 2)
-                              [Type integerTy,
-                               Type integerTy,
-                               Lit (LitInteger r i),
-                               Lit (LitInteger s i)]
-      _ -> panic "match_Integer_divop_both: mkIntegerId has the wrong type"
-match_Integer_divop_both _ _ _ = Nothing
+  = Just $ mkConApp (tupleCon UnboxedTuple 2)
+                    [Type t,
+                     Type t,
+                     Lit (LitInteger r t),
+                     Lit (LitInteger s t)]
+match_Integer_divop_both _ _ _ _ = Nothing
 
 -- This helper is used for the quotRem and divMod functions
 match_Integer_divop_one :: (Integer -> Integer -> Integer)
+                        -> Id
                         -> IdUnfoldingFun
                         -> [Expr CoreBndr]
                         -> Maybe (Expr CoreBndr)
-match_Integer_divop_one divop id_unf [xl,yl]
+match_Integer_divop_one divop _ id_unf [xl,yl]
   | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   , y /= 0
   = Just (Lit (LitInteger (x `divop` y) i))
-match_Integer_divop_one _ _ _ = Nothing
+match_Integer_divop_one _ _ _ _ = Nothing
 
 match_Integer_Int_binop :: (Integer -> Int -> Integer)
+                        -> Id
                         -> IdUnfoldingFun
                         -> [Expr CoreBndr]
                         -> Maybe (Expr CoreBndr)
-match_Integer_Int_binop binop id_unf [xl,yl]
+match_Integer_Int_binop binop _ id_unf [xl,yl]
   | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
   , Just (MachInt y)      <- exprIsLiteral_maybe id_unf yl
   = Just (Lit (LitInteger (x `binop` fromIntegral y) i))
-match_Integer_Int_binop _ _ _ = Nothing
+match_Integer_Int_binop _ _ _ _ = Nothing
 
 match_Integer_binop_Bool :: (Integer -> Integer -> Bool)
+                         -> Id
                          -> IdUnfoldingFun
                          -> [Expr CoreBndr]
                          -> Maybe (Expr CoreBndr)
-match_Integer_binop_Bool binop id_unf [xl, yl]
+match_Integer_binop_Bool binop _ id_unf [xl, yl]
   | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   = Just (if x `binop` y then trueVal else falseVal)
-match_Integer_binop_Bool _ _ _ = Nothing
+match_Integer_binop_Bool _ _ _ _ = Nothing
 
 match_Integer_binop_Ordering :: (Integer -> Integer -> Ordering)
+                             -> Id
                              -> IdUnfoldingFun
                              -> [Expr CoreBndr]
                              -> Maybe (Expr CoreBndr)
-match_Integer_binop_Ordering binop id_unf [xl, yl]
+match_Integer_binop_Ordering binop _ id_unf [xl, yl]
   | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   = Just $ case x `binop` y of
              LT -> ltVal
              EQ -> eqVal
              GT -> gtVal
-match_Integer_binop_Ordering _ _ _ = Nothing
+match_Integer_binop_Ordering _ _ _ _ = Nothing
 
 match_Integer_Int_encodeFloat :: RealFloat a
                               => (a -> Expr CoreBndr)
+                              -> Id
                               -> IdUnfoldingFun
                               -> [Expr CoreBndr]
                               -> Maybe (Expr CoreBndr)
-match_Integer_Int_encodeFloat mkLit id_unf [xl,yl]
+match_Integer_Int_encodeFloat mkLit _ id_unf [xl,yl]
   | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
   , Just (MachInt y)      <- exprIsLiteral_maybe id_unf yl
   = Just (mkLit $ encodeFloat x (fromInteger y))
-match_Integer_Int_encodeFloat _ _ _ = Nothing
+match_Integer_Int_encodeFloat _ _ _ _ = Nothing
 \end{code}
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index 89181e89cb..1b8d96df35 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -21,22 +21,18 @@ module TysPrim(
         tyVarList, alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
 	alphaTy, betaTy, gammaTy, deltaTy,
 	openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, openAlphaTyVars,
-        argAlphaTy, argAlphaTyVar, argAlphaTyVars, argBetaTy, argBetaTyVar,
         kKiVar,
 
         -- Kind constructors...
-        superKindTyCon, superKind, anyKindTyCon,
-        liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
-        argTypeKindTyCon, ubxTupleKindTyCon, constraintKindTyCon,
+        superKindTyCon, superKind, anyKindTyCon, liftedTypeKindTyCon,
+        openTypeKindTyCon, unliftedTypeKindTyCon, constraintKindTyCon,
 
         superKindTyConName, anyKindTyConName, liftedTypeKindTyConName,
         openTypeKindTyConName, unliftedTypeKindTyConName,
-        ubxTupleKindTyConName, argTypeKindTyConName,
         constraintKindTyConName,
 
         -- Kinds
-	anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind,
-        argTypeKind, ubxTupleKind, constraintKind,
+	anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind,
         mkArrowKind, mkArrowKinds,
         typeNatKind, typeStringKind,
 
@@ -137,8 +133,6 @@ primTyCons
     , liftedTypeKindTyCon
     , unliftedTypeKindTyCon
     , openTypeKindTyCon
-    , argTypeKindTyCon
-    , ubxTupleKindTyCon
     , constraintKindTyCon
     , superKindTyCon
     , anyKindTyCon
@@ -226,13 +220,6 @@ openAlphaTy, openBetaTy :: Type
 openAlphaTy = mkTyVarTy openAlphaTyVar
 openBetaTy  = mkTyVarTy openBetaTyVar
 
-argAlphaTyVars :: [TyVar]
-argAlphaTyVar, argBetaTyVar :: TyVar
-argAlphaTyVars@(argAlphaTyVar : argBetaTyVar : _) = tyVarList argTypeKind
-argAlphaTy, argBetaTy :: Type
-argAlphaTy = mkTyVarTy argAlphaTyVar
-argBetaTy  = mkTyVarTy argBetaTyVar
-
 kKiVar :: KindVar
 kKiVar = (tyVarList superKind) !! 10
 
@@ -305,12 +292,10 @@ So you can see it's convenient to have BOX:BOX
 -- | See "Type#kind_subtyping" for details of the distinction between the 'Kind' 'TyCon's
 superKindTyCon, anyKindTyCon, liftedTypeKindTyCon,
       openTypeKindTyCon, unliftedTypeKindTyCon,
-      ubxTupleKindTyCon, argTypeKindTyCon,
       constraintKindTyCon
    :: TyCon
 superKindTyConName, anyKindTyConName, liftedTypeKindTyConName,
       openTypeKindTyConName, unliftedTypeKindTyConName,
-      ubxTupleKindTyConName, argTypeKindTyConName,
       constraintKindTyConName
    :: Name
 
@@ -321,8 +306,6 @@ anyKindTyCon          = mkKindTyCon anyKindTyConName          superKind
 liftedTypeKindTyCon   = mkKindTyCon liftedTypeKindTyConName   superKind
 openTypeKindTyCon     = mkKindTyCon openTypeKindTyConName     superKind
 unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName superKind
-ubxTupleKindTyCon     = mkKindTyCon ubxTupleKindTyConName     superKind
-argTypeKindTyCon      = mkKindTyCon argTypeKindTyConName      superKind
 constraintKindTyCon   = mkKindTyCon constraintKindTyConName   superKind
 
 --------------------------
@@ -333,8 +316,6 @@ anyKindTyConName          = mkPrimTyConName (fsLit "AnyK") anyKindTyConKey anyKi
 liftedTypeKindTyConName   = mkPrimTyConName (fsLit "*") liftedTypeKindTyConKey liftedTypeKindTyCon
 openTypeKindTyConName     = mkPrimTyConName (fsLit "OpenKind") openTypeKindTyConKey openTypeKindTyCon
 unliftedTypeKindTyConName = mkPrimTyConName (fsLit "#") unliftedTypeKindTyConKey unliftedTypeKindTyCon
-ubxTupleKindTyConName     = mkPrimTyConName (fsLit "(#)") ubxTupleKindTyConKey ubxTupleKindTyCon
-argTypeKindTyConName      = mkPrimTyConName (fsLit "ArgKind") argTypeKindTyConKey argTypeKindTyCon
 constraintKindTyConName   = mkPrimTyConName (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon
 
 mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
@@ -352,17 +333,13 @@ kindTyConType :: TyCon -> Type
 kindTyConType kind = TyConApp kind []
 
 -- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's
-anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, 
-  argTypeKind, ubxTupleKind, constraintKind,
-  superKind :: Kind
+anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind, superKind :: Kind
 
 superKind        = kindTyConType superKindTyCon 
 anyKind          = kindTyConType anyKindTyCon  -- See Note [Any kinds]
 liftedTypeKind   = kindTyConType liftedTypeKindTyCon
 unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
 openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind     = kindTyConType ubxTupleKindTyCon
 constraintKind   = kindTyConType constraintKindTyCon
 
 typeNatKind :: Kind
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 7a06bae163..60518bfd9f 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -104,6 +104,7 @@ import Data.Array
 import FastString
 import Outputable
 import Config
+import Util
 
 alpha_tyvar :: [TyVar]
 alpha_tyvar = [alphaTyVar]
@@ -353,12 +354,12 @@ mk_tuple sort arity = (tycon, tuple_con)
     	tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
 	res_kind = case sort of
 	  BoxedTuple   	  -> liftedTypeKind
-	  UnboxedTuple 	  -> ubxTupleKind
+	  UnboxedTuple 	  -> unliftedTypeKind
 	  ConstraintTuple -> constraintKind
 
 	tyvars = take arity $ case sort of
 	  BoxedTuple      -> alphaTyVars
-	  UnboxedTuple    -> argAlphaTyVars	-- No nested unboxed tuples
+	  UnboxedTuple    -> openAlphaTyVars
 	  ConstraintTuple -> tyVarList constraintKind
 
 	tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs
index 6fc44c1df9..a6fe565746 100644
--- a/compiler/profiling/SCCfinal.lhs
+++ b/compiler/profiling/SCCfinal.lhs
@@ -34,6 +34,7 @@ import Outputable
 import DynFlags
 import FastString
 import SrcLoc
+import Util
 
 
 stgMassageForProfiling
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 78566de179..7ff7c7adec 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -46,7 +46,7 @@ import RdrName
 import LoadIface	( loadInterfaceForName )
 import UniqSet
 import Data.List
-import Util		( isSingleton, snocView )
+import Util
 import ListSetOps	( removeDups )
 import Outputable
 import SrcLoc
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index 3e3c2b66d2..df3566d73c 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -55,7 +55,7 @@ import Name
 import NameSet
 import RdrName
 import BasicTypes
-import Util		( notNull )
+import Util
 import ListSetOps	( removeDups )
 import Outputable
 import SrcLoc
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 1b2e8417f3..ecdfdaf36e 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -49,7 +49,7 @@ import Name
 import SrcLoc
 import NameSet
 
-import Util		( filterOut )
+import Util
 import BasicTypes	( IPName(..), ipNameName, compareFixity, funTyFixity, negateFixity, 
 			  Fixity(..), FixityDirection(..) )
 import Outputable
diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 4a92f818d4..18c0178900 100644
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -38,8 +38,7 @@ import CoreSubst
 import Var		( Var )
 import Id		( Id, idType, idInlineActivation, zapIdOccInfo )
 import CoreUtils	( mkAltExpr
-                        , exprIsTrivial, exprIsCheap )
-import DataCon		( isUnboxedTupleCon )
+                        , exprIsTrivial)
 import Type		( tyConAppArgs )
 import CoreSyn
 import Outputable
@@ -112,19 +111,6 @@ to the reverse CSE mapping if the scrutinee is a non-trivial expression.
 	case binder -> scrutinee 
 to the substitution
 
-Note [Unboxed tuple case binders]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-	case f x of t { (# a,b #) -> 
-	case ... of
-	  True -> f x
-	  False -> 0 }
-
-We must not replace (f x) by t, because t is an unboxed-tuple binder.
-Instead, we shoudl replace (f x) by (# a,b #).  That is, the "reverse mapping" is
-	f x --> (# a,b #)
-That is why the CSEMap has pairs of expressions.
-
 Note [CSE for INLINE and NOINLINE]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We are careful to do no CSE inside functions that the user has marked as
@@ -258,20 +244,6 @@ cseExpr env (Case scrut bndr ty alts) = Case scrut' bndr'' ty alts'
 
 cseAlts :: CSEnv -> OutExpr -> InBndr -> InBndr -> [InAlt] -> [OutAlt]
 
-cseAlts env scrut' bndr _bndr' [(DataAlt con, args, rhs)]
-  | isUnboxedTupleCon con
-	-- Unboxed tuples are special because the case binder isn't
-	-- a real value.  See Note [Unboxed tuple case binders]
-  = [(DataAlt con, args'', tryForCSE new_env rhs)]
-  where
-    (env', args') = addBinders env args
-    args'' = map zapIdOccInfo args'	-- They should all be ids
-	-- Same motivation for zapping as [Case binders 2] only this time
-	-- it's Note [Unboxed tuple case binders]
-    new_env | exprIsCheap scrut' = env'
-	    | otherwise 	 = extendCSEnv env' scrut' tup_value
-    tup_value = mkAltExpr (DataAlt con) args'' (tyConAppArgs (idType bndr))
-
 cseAlts env scrut' bndr bndr' alts
   = map cse_alt alts
   where
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index edc5a65ed9..8c5978f495 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -71,7 +71,6 @@ import CoreSyn
 import PprCore
 import CoreUtils
 import CoreLint		( lintCoreBindings )
-import PrelNames        ( iNTERACTIVE )
 import HscTypes
 import Module           ( Module )
 import DynFlags
@@ -84,7 +83,7 @@ import Id		( Id )
 import IOEnv hiding     ( liftIO, failM, failWithM )
 import qualified IOEnv  ( liftIO )
 import TcEnv            ( tcLookupGlobal )
-import TcRnMonad        ( TcM, initTc )
+import TcRnMonad        ( initTcForLookup )
 
 import Outputable
 import FastString
@@ -1022,13 +1021,6 @@ dumpIfSet_dyn :: DynFlag -> String -> SDoc -> CoreM ()
 dumpIfSet_dyn flag str = msg (\dflags -> Err.dumpIfSet_dyn dflags flag str)
 \end{code}
 
-\begin{code}
-
-initTcForLookup :: HscEnv -> TcM a -> IO a
-initTcForLookup hsc_env = liftM (expectJust "initTcInteractive" . snd) . initTc hsc_env HsSrcFile False iNTERACTIVE
-
-\end{code}
-
 
 %************************************************************************
 %*									*
diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs
index c0c6478a7b..5a462443e2 100644
--- a/compiler/simplCore/FloatIn.lhs
+++ b/compiler/simplCore/FloatIn.lhs
@@ -31,7 +31,7 @@ import Id		( isOneShotBndr, idType )
 import Var
 import Type		( isUnLiftedType )
 import VarSet
-import Util		( zipEqual, zipWithEqual, count )
+import Util
 import UniqFM
 import Outputable
 \end{code}
diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index e9ec0bea55..5a204f46b5 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -44,7 +44,7 @@ import Digraph          ( SCC(..), stronglyConnCompFromEdgedVerticesR )
 import PrelNames        ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
 import Unique
 import UniqFM
-import Util             ( mapAndUnzip, filterOut, fstOf3 )
+import Util
 import Bag
 import Outputable
 import FastString
diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 8661d71e04..d6ba24d754 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -63,6 +63,7 @@ import BasicTypes
 import MonadUtils
 import Outputable
 import FastString
+import Util
 
 import Data.List
 \end{code}
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 56e0bededd..726d0d5642 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -49,6 +49,7 @@ import Data.List        ( mapAccumL )
 import Outputable
 import FastString
 import Pair
+import Util
 \end{code}
 
 
diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs
index 1bec3925ac..8493d9c275 100644
--- a/compiler/simplStg/SimplStg.lhs
+++ b/compiler/simplStg/SimplStg.lhs
@@ -21,6 +21,7 @@ import CostCentre       ( CollectedCCs )
 import SCCfinal		( stgMassageForProfiling )
 import StgLint		( lintStgBindings )
 import StgStats	        ( showStgStats )
+import UnariseStg       ( unarise )
 import SRT		( computeSRTs )
 
 import DynFlags		( DynFlags(..), DynFlag(..), dopt, StgToDo(..),
@@ -50,10 +51,11 @@ stg2stg dflags module_name binds
 	; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds
 
 		-- Do the main business!
+        ; let (us0, us1) = splitUniqSupply us'
 	; (processed_binds, _, cost_centres) 
-		<- foldl_mn do_stg_pass (binds', us', ccs) (getStgToDo dflags)
+		<- foldl_mn do_stg_pass (binds', us0, ccs) (getStgToDo dflags)
 
-	; let srt_binds = computeSRTs processed_binds
+	; let srt_binds = computeSRTs (unarise us1 processed_binds)
 
 	; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" 
 	     		(pprStgBindingsWithSRTs srt_binds)
diff --git a/compiler/simplStg/UnariseStg.lhs b/compiler/simplStg/UnariseStg.lhs
new file mode 100644
index 0000000000..ac439ebfd3
--- /dev/null
+++ b/compiler/simplStg/UnariseStg.lhs
@@ -0,0 +1,167 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-2012
+%
+
+Note [Unarisation]
+~~~~~~~~~~~~~~~~~~
+
+The idea of this pass is to translate away *all* unboxed-tuple binders. So for example:
+
+f (x :: (# Int, Bool #)) = f x + f (# 1, True #)
+ ==>
+f (x1 :: Int) (x2 :: Bool) = f x1 x2 + f 1 True
+
+It is important that we do this at the STG level and NOT at the core level
+because it would be very hard to make this pass Core-type-preserving.
+
+STG fed to the code generators *must* be unarised because the code generators do
+not support unboxed tuple binders natively.
+
+
+Note [Unarisation and arity]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Because of unarisation, the arity that will be recorded in the generated info table
+for an Id may be larger than the idArity. Instead we record what we call the RepArity,
+which is the Arity taking into account any expanded arguments, and corresponds to
+the number of (possibly-void) *registers* arguments will arrive in.
+
+\begin{code}
+module UnariseStg (unarise) where
+
+#include "HsVersions.h"
+
+import CoreSyn
+import StgSyn
+import VarEnv
+import UniqSupply
+import Id
+import MkId (realWorldPrimId)
+import Type
+import TysWiredIn
+import DataCon
+import VarSet
+import OccName
+import Name
+import Util
+import Outputable
+import BasicTypes
+
+
+-- | A mapping from unboxed-tuple binders to the Ids they were expanded to.
+--
+-- INVARIANT: Ids in the range don't have unboxed tuple types.
+--
+-- Those in-scope variables without unboxed-tuple types are not present in
+-- the domain of the mapping at all.
+type UnariseEnv = VarEnv [Id]
+
+ubxTupleId0 :: Id
+ubxTupleId0 = dataConWorkId (tupleCon UnboxedTuple 0)
+
+unarise :: UniqSupply -> [StgBinding] -> [StgBinding]
+unarise us binds = zipWith (\us -> unariseBinding us init_env) (listSplitUniqSupply us) binds
+  where -- See Note [Nullary unboxed tuple] in Type.lhs
+        init_env = unitVarEnv ubxTupleId0 [realWorldPrimId]
+
+unariseBinding :: UniqSupply -> UnariseEnv -> StgBinding -> StgBinding
+unariseBinding us rho bind = case bind of
+  StgNonRec x rhs -> StgNonRec x (unariseRhs us rho rhs)
+  StgRec xrhss    -> StgRec $ zipWith (\us (x, rhs) -> (x, unariseRhs us rho rhs)) (listSplitUniqSupply us) xrhss
+
+unariseRhs :: UniqSupply -> UnariseEnv -> StgRhs -> StgRhs
+unariseRhs us rho rhs = case rhs of
+  StgRhsClosure ccs b_info fvs update_flag srt args expr
+    -> StgRhsClosure ccs b_info (unariseIds rho fvs) update_flag (unariseSRT rho srt) args' (unariseExpr us' rho' expr)
+    where (us', rho', args') = unariseIdBinders us rho args
+  StgRhsCon ccs con args
+    -> StgRhsCon ccs con (unariseArgs rho args)
+
+unariseExpr :: UniqSupply -> UnariseEnv -> StgExpr -> StgExpr
+unariseExpr us rho e = case e of
+  -- Particularly important where (##) is concerned (Note [The nullary (# #) constructor])
+  StgApp f [] | UbxTupleRep tys <- repType (idType f)
+    -> StgConApp (tupleCon UnboxedTuple (length tys)) (map StgVarArg (unariseId rho f))
+  StgApp f args -> StgApp f (unariseArgs rho args)
+  StgLit l -> StgLit l
+  StgConApp dc args | isUnboxedTupleCon dc -> StgConApp (tupleCon UnboxedTuple (length args')) args'
+                    | otherwise            -> StgConApp dc args'
+    where args' = unariseArgs rho args
+  StgOpApp op args ty -> StgOpApp op (unariseArgs rho args) ty
+  StgLam xs e -> StgLam xs' (unariseExpr us' rho' e)
+    where (us', rho', xs') = unariseIdBinders us rho xs
+  StgCase e case_lives alts_lives bndr srt alt_ty alts
+    -> StgCase (unariseExpr us1 rho e) (unariseLives rho case_lives) (unariseLives rho alts_lives) bndr (unariseSRT rho srt) alt_ty' alts'
+    where (us1, us2) = splitUniqSupply us
+          (alt_ty', alts') = case repType (idType bndr) of
+                    UbxTupleRep tys -> case alts of 
+                        (DEFAULT,  [], [],    e):_ -> (UbxTupAlt n, [(DataAlt (tupleCon UnboxedTuple n), ys, uses, unariseExpr us2' rho' e)])
+                          where (us2', rho', ys) = unariseIdBinder us2 rho bndr
+                                uses = replicate (length ys) (not (isDeadBinder bndr))
+                                n = length tys
+                        [(DataAlt _, ys, uses, e)] -> (UbxTupAlt n, [(DataAlt (tupleCon UnboxedTuple n), ys', uses', unariseExpr us2' rho'' e)])
+                          where (us2', rho', ys', uses') = unariseUsedIdBinders us2 rho ys uses
+                                rho'' = extendVarEnv rho' bndr ys'
+                                n = length ys'
+                        _                           -> panic "unariseExpr: strange unboxed tuple alts"
+                    UnaryRep _ -> (alt_ty, zipWith (\us alt -> unariseAlt us rho alt) (listSplitUniqSupply us2) alts)
+  StgLet bind e -> StgLet (unariseBinding us1 rho bind) (unariseExpr us2 rho e)
+    where (us1, us2) = splitUniqSupply us
+  StgLetNoEscape live_in_let live_in_bind bind e
+    -> StgLetNoEscape (unariseLives rho live_in_let) (unariseLives rho live_in_bind) (unariseBinding us1 rho bind) (unariseExpr us2 rho e)
+    where (us1, us2) = splitUniqSupply us
+  StgSCC cc bump_entry push_cc e -> StgSCC cc bump_entry push_cc (unariseExpr us rho e)
+  StgTick mod tick_n e -> StgTick mod tick_n (unariseExpr us rho e)
+
+unariseAlt :: UniqSupply -> UnariseEnv -> StgAlt -> StgAlt
+unariseAlt us rho (con, xs, uses, e) = (con, xs', uses', unariseExpr us' rho' e)
+  where (us', rho', xs', uses') = unariseUsedIdBinders us rho xs uses
+
+unariseSRT :: UnariseEnv -> SRT -> SRT
+unariseSRT _   NoSRT            = NoSRT
+unariseSRT rho (SRTEntries ids) = SRTEntries (concatMapVarSet (unariseId rho) ids)
+unariseSRT _   (SRT {})         = panic "unariseSRT"
+
+unariseLives :: UnariseEnv -> StgLiveVars -> StgLiveVars
+unariseLives rho ids = concatMapVarSet (unariseId rho) ids
+
+unariseArgs :: UnariseEnv -> [StgArg] -> [StgArg]
+unariseArgs rho = concatMap (unariseArg rho)
+
+unariseArg :: UnariseEnv -> StgArg -> [StgArg]
+unariseArg rho (StgVarArg x) = map StgVarArg (unariseId rho x)
+unariseArg _   (StgLitArg l) = [StgLitArg l]
+
+unariseIds :: UnariseEnv -> [Id] -> [Id]
+unariseIds rho = concatMap (unariseId rho)
+
+unariseId :: UnariseEnv -> Id -> [Id]
+unariseId rho x = case lookupVarEnv rho x of
+  Just ys -> ASSERT2(case repType (idType x) of UbxTupleRep _ -> True; _ -> x == ubxTupleId0, text "unariseId: not unboxed tuple" <+> ppr x)
+             ys
+  Nothing -> ASSERT2(case repType (idType x) of UbxTupleRep _ -> False; _ -> True, text "unariseId: was unboxed tuple" <+> ppr x)
+             [x]
+
+unariseUsedIdBinders :: UniqSupply -> UnariseEnv -> [Id] -> [Bool] -> (UniqSupply, UnariseEnv, [Id], [Bool])
+unariseUsedIdBinders us rho xs uses = case mapAccumL2 (\us rho (x, use) -> third3 (map (flip (,) use)) $ unariseIdBinder us rho x)
+                                                      us rho (zipEqual "unariseUsedIdBinders" xs uses) of
+                                        (us', rho', xs_usess) -> uncurry ((,,,) us' rho') (unzip (concat xs_usess))
+
+unariseIdBinders :: UniqSupply -> UnariseEnv -> [Id] -> (UniqSupply, UnariseEnv, [Id])
+unariseIdBinders us rho xs = third3 concat $ mapAccumL2 unariseIdBinder us rho xs
+
+unariseIdBinder :: UniqSupply -> UnariseEnv -> Id -> (UniqSupply, UnariseEnv, [Id])
+unariseIdBinder us rho x = case repType (idType x) of
+    UnaryRep _      -> (us, rho, [x])
+    UbxTupleRep tys -> let (us0, us1) = splitUniqSupply us
+                           ys   = unboxedTupleBindersFrom us0 x tys
+                           rho' = extendVarEnv rho x ys
+                       in (us1, rho', ys)
+
+unboxedTupleBindersFrom :: UniqSupply -> Id -> [UnaryType] -> [Id]
+unboxedTupleBindersFrom us x tys = zipWith (mkSysLocal fs) (uniqsFromSupply us) tys
+  where fs = occNameFS (getOccName x)
+
+concatMapVarSet :: (Var -> [Var]) -> VarSet -> VarSet
+concatMapVarSet f xs = mkVarSet [x' | x <- varSetElems xs, x' <- f x]
+\end{code}
\ No newline at end of file
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 8e55be48fd..42c1eda081 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -4,57 +4,50 @@
 \section[CoreRules]{Transformation rules}
 
 \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
-
 -- | Functions for collecting together and applying rewrite rules to a module.
 -- The 'CoreRule' datatype itself is declared elsewhere.
 module Rules (
-	-- * RuleBase
-	RuleBase, 
-	
-	-- ** Constructing 
-	emptyRuleBase, mkRuleBase, extendRuleBaseList, 
-	unionRuleBase, pprRuleBase, 
-	
-	-- ** Checking rule applications
-	ruleCheckProgram,
+        -- * RuleBase
+        RuleBase,
+
+        -- ** Constructing
+        emptyRuleBase, mkRuleBase, extendRuleBaseList,
+        unionRuleBase, pprRuleBase,
+
+        -- ** Checking rule applications
+        ruleCheckProgram,
 
         -- ** Manipulating 'SpecInfo' rules
-	mkSpecInfo, extendSpecInfo, addSpecInfo,
-	addIdSpecialisations, 
-	
-	-- * Misc. CoreRule helpers
-        rulesOfBinds, getRules, pprRulesForUser, 
-        
+        mkSpecInfo, extendSpecInfo, addSpecInfo,
+        addIdSpecialisations,
+
+        -- * Misc. CoreRule helpers
+        rulesOfBinds, getRules, pprRulesForUser,
+
         lookupRule, mkRule, roughTopNames
     ) where
 
 #include "HsVersions.h"
 
-import CoreSyn		-- All of it
+import CoreSyn          -- All of it
 import CoreSubst
 import OccurAnal        ( occurAnalyseExpr )
-import CoreFVs		( exprFreeVars, exprsFreeVars, bindFreeVars, rulesFreeVars )
+import CoreFVs          ( exprFreeVars, exprsFreeVars, bindFreeVars, rulesFreeVars )
 import CoreUtils        ( exprType, eqExpr )
-import PprCore		( pprRules )
+import PprCore          ( pprRules )
 import Type             ( Type )
-import TcType		( tcSplitTyConApp_maybe )
+import TcType           ( tcSplitTyConApp_maybe )
 import Coercion
-import CoreTidy		( tidyRules )
+import CoreTidy         ( tidyRules )
 import Id
-import IdInfo		( SpecInfo( SpecInfo ) )
+import IdInfo           ( SpecInfo( SpecInfo ) )
 import VarEnv
 import VarSet
-import Name		( Name, NamedThing(..) )
+import Name             ( Name, NamedThing(..) )
 import NameEnv
-import Unify 		( ruleMatchTyX, MatchEnv(..) )
-import BasicTypes	( Activation, CompilerPhase, isActive )
-import StaticFlags	( opt_PprStyle_Debug )
+import Unify            ( ruleMatchTyX, MatchEnv(..) )
+import BasicTypes       ( Activation, CompilerPhase, isActive )
+import StaticFlags      ( opt_PprStyle_Debug )
 import Outputable
 import FastString
 import Maybes
@@ -67,11 +60,11 @@ Note [Overall plumbing for rules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * After the desugarer:
    - The ModGuts initially contains mg_rules :: [CoreRule] of
-     locally-declared rules for imported Ids.  
+     locally-declared rules for imported Ids.
    - Locally-declared rules for locally-declared Ids are attached to
      the IdInfo for that Id.  See Note [Attach rules to local ids] in
      DsBinds
- 
+
 * TidyPgm strips off all the rules from local Ids and adds them to
   mg_rules, so that the ModGuts has *all* the locally-declared rules.
 
@@ -87,7 +80,7 @@ Note [Overall plumbing for rules]
   ghc --make compiles one module after another.
 
   During simplification, interface files may get demand-loaded,
-  as the simplifier explores the unfoldings for Ids it has in 
+  as the simplifier explores the unfoldings for Ids it has in
   its hand.  (Via an unsafePerformIO; the EPS is really a cache.)
   That in turn may make the EPS rule-base grow.  In contrast, the
   HPT never grows in this way.
@@ -119,8 +112,8 @@ Note [Overall plumbing for rules]
   pacakges, but we don't.  Same for type-class instances.]
 
 * So in the outer simplifier loop, we combine (b-d) into a single
-  RuleBase, reading 
-     (b) from the ModGuts, 
+  RuleBase, reading
+     (b) from the ModGuts,
      (c) from the CoreMonad, and
      (d) from its mutable variable
   [Of coures this means that we won't see new EPS rules that come in
@@ -129,9 +122,9 @@ Note [Overall plumbing for rules]
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 A @CoreRule@ holds details of one rule for an @Id@, which
@@ -139,12 +132,12 @@ includes its specialisations.
 
 For example, if a rule for @f@ contains the mapping:
 \begin{verbatim}
-	forall a b d. [Type (List a), Type b, Var d]  ===>  f' a b
+        forall a b d. [Type (List a), Type b, Var d]  ===>  f' a b
 \end{verbatim}
 then when we find an application of f to matching types, we simply replace
 it by the matching RHS:
 \begin{verbatim}
-	f (List Int) Bool dict ===>  f' Int Bool
+        f (List Int) Bool dict ===>  f' Int Bool
 \end{verbatim}
 All the stuff about how many dictionaries to discard, and what types
 to apply the specialised function to, are handled by the fact that the
@@ -154,29 +147,29 @@ There is one more exciting case, which is dealt with in exactly the same
 way.  If the specialised value is unboxed then it is lifted at its
 definition site and unlifted at its uses.  For example:
 
-	pi :: forall a. Num a => a
+        pi :: forall a. Num a => a
 
 might have a specialisation
 
-	[Int#] ===>  (case pi' of Lift pi# -> pi#)
+        [Int#] ===>  (case pi' of Lift pi# -> pi#)
 
 where pi' :: Lift Int# is the specialised version of pi.
 
 \begin{code}
-mkRule :: Bool -> Bool -> RuleName -> Activation 
+mkRule :: Bool -> Bool -> RuleName -> Activation
        -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
--- ^ Used to make 'CoreRule' for an 'Id' defined in the module being 
+-- ^ Used to make 'CoreRule' for an 'Id' defined in the module being
 -- compiled. See also 'CoreSyn.CoreRule'
 mkRule is_auto is_local name act fn bndrs args rhs
   = Rule { ru_name = name, ru_fn = fn, ru_act = act,
-	   ru_bndrs = bndrs, ru_args = args,
-	   ru_rhs = occurAnalyseExpr rhs, 
-	   ru_rough = roughTopNames args,
-	   ru_auto = is_auto, ru_local = is_local }
+           ru_bndrs = bndrs, ru_args = args,
+           ru_rhs = occurAnalyseExpr rhs,
+           ru_rough = roughTopNames args,
+           ru_auto = is_auto, ru_local = is_local }
 
 --------------
 roughTopNames :: [CoreExpr] -> [Maybe Name]
--- ^ Find the \"top\" free names of several expressions. 
+-- ^ Find the \"top\" free names of several expressions.
 -- Such names are either:
 --
 -- 1. The function finally being applied to in an application chain
@@ -184,37 +177,37 @@ roughTopNames :: [CoreExpr] -> [Maybe Name]
 --
 -- 2. The 'TyCon' if the expression is a 'Type'
 --
--- This is used for the fast-match-check for rules; 
---	if the top names don't match, the rest can't
+-- This is used for the fast-match-check for rules;
+--      if the top names don't match, the rest can't
 roughTopNames args = map roughTopName args
 
 roughTopName :: CoreExpr -> Maybe Name
 roughTopName (Type ty) = case tcSplitTyConApp_maybe ty of
                                Just (tc,_) -> Just (getName tc)
                                Nothing     -> Nothing
-roughTopName (Coercion _) = Nothing 
+roughTopName (Coercion _) = Nothing
 roughTopName (App f _) = roughTopName f
-roughTopName (Var f)   | isGlobalId f	-- Note [Care with roughTopName]
+roughTopName (Var f)   | isGlobalId f   -- Note [Care with roughTopName]
                        , isDataConWorkId f || idArity f > 0
                        = Just (idName f)
 roughTopName _ = Nothing
 
 ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
 -- ^ @ruleCantMatch tpl actual@ returns True only if @actual@
--- definitely can't match @tpl@ by instantiating @tpl@.  
--- It's only a one-way match; unlike instance matching we 
+-- definitely can't match @tpl@ by instantiating @tpl@.
+-- It's only a one-way match; unlike instance matching we
 -- don't consider unification.
--- 
+--
 -- Notice that [_$_]
---	@ruleCantMatch [Nothing] [Just n2] = False@
+--      @ruleCantMatch [Nothing] [Just n2] = False@
 --      Reason: a template variable can be instantiated by a constant
 -- Also:
---	@ruleCantMatch [Just n1] [Nothing] = False@
+--      @ruleCantMatch [Just n1] [Nothing] = False@
 --      Reason: a local variable @v@ in the actuals might [_$_]
 
 ruleCantMatch (Just n1 : ts) (Just n2 : as) = n1 /= n2 || ruleCantMatch ts as
 ruleCantMatch (_       : ts) (_       : as) = ruleCantMatch ts as
-ruleCantMatch _ 	     _ 		    = False
+ruleCantMatch _              _              = False
 \end{code}
 
 Note [Care with roughTopName]
@@ -223,19 +216,19 @@ Consider this
     module M where { x = a:b }
     module N where { ...f x...
                      RULE f (p:q) = ... }
-You'd expect the rule to match, because the matcher can 
+You'd expect the rule to match, because the matcher can
 look through the unfolding of 'x'.  So we must avoid roughTopName
 returning 'M.x' for the call (f x), or else it'll say "can't match"
 and we won't even try!!
 
 However, suppose we have
-	 RULE g (M.h x) = ...
-	 foo = ...(g (M.k v))....
+         RULE g (M.h x) = ...
+         foo = ...(g (M.k v))....
 where k is a *function* exported by M.  We never really match
 functions (lambdas) except by name, so in this case it seems like
 a good idea to treat 'M.k' as a roughTopName of the call.
 
-    
+
 \begin{code}
 pprRulesForUser :: [CoreRule] -> SDoc
 -- (a) tidy the rules
@@ -248,15 +241,15 @@ pprRulesForUser rules
     pprRules $
     sortLe le_rule  $
     tidyRules emptyTidyEnv rules
-  where 
+  where
     le_rule r1 r2 = ru_name r1 <= ru_name r2
 \end{code}
 
 
 %************************************************************************
-%*									*
-		SpecInfo: the rules in an IdInfo
-%*									*
+%*                                                                      *
+                SpecInfo: the rules in an IdInfo
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -270,7 +263,7 @@ extendSpecInfo (SpecInfo rs1 fvs1) rs2
   = SpecInfo (rs2 ++ rs1) (rulesFreeVars rs2 `unionVarSet` fvs1)
 
 addSpecInfo :: SpecInfo -> SpecInfo -> SpecInfo
-addSpecInfo (SpecInfo rs1 fvs1) (SpecInfo rs2 fvs2) 
+addSpecInfo (SpecInfo rs1 fvs1) (SpecInfo rs2 fvs2)
   = SpecInfo (rs1 ++ rs2) (fvs1 `unionVarSet` fvs2)
 
 addIdSpecialisations :: Id -> [CoreRule] -> Id
@@ -298,7 +291,7 @@ The rules for an Id come from two places:
   (a) the ones it is born with, stored inside the Id iself (idCoreRules fn),
   (b) rules added in other modules, stored in the global RuleBase (imp_rules)
 
-It's tempting to think that 
+It's tempting to think that
      - LocalIds have only (a)
      - non-LocalIds have only (b)
 
@@ -308,21 +301,21 @@ but that isn't quite right:
        even when they are imported
 
      - The rules in PrelRules.builtinRules should be active even
-       in the module defining the Id (when it's a LocalId), but 
+       in the module defining the Id (when it's a LocalId), but
        the rules are kept in the global RuleBase
 
 
 %************************************************************************
-%*									*
-		RuleBase
-%*									*
+%*                                                                      *
+                RuleBase
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 -- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules
 type RuleBase = NameEnv [CoreRule]
-	-- The rules are are unordered; 
-	-- we sort out any overlaps on lookup
+        -- The rules are are unordered;
+        -- we sort out any overlaps on lookup
 
 emptyRuleBase :: RuleBase
 emptyRuleBase = emptyNameEnv
@@ -342,15 +335,15 @@ extendRuleBase rule_base rule
   = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule
 
 pprRuleBase :: RuleBase -> SDoc
-pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs) 
-			 | rs <- nameEnvElts rules ]
+pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs)
+                         | rs <- nameEnvElts rules ]
 \end{code}
 
 
 %************************************************************************
-%*									*
-			Matching
-%*									*
+%*                                                                      *
+                        Matching
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -358,35 +351,35 @@ pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs)
 -- supplied rules to this instance of an application in a given
 -- context, returning the rule applied and the resulting expression if
 -- successful.
-lookupRule :: (Activation -> Bool)	-- When rule is active
-	    -> IdUnfoldingFun		-- When Id can be unfolded
+lookupRule :: (Activation -> Bool)      -- When rule is active
+            -> IdUnfoldingFun           -- When Id can be unfolded
             -> InScopeSet
-	    -> Id -> [CoreExpr]
-	    -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
+            -> Id -> [CoreExpr]
+            -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
 
 -- See Note [Extra args in rule matching]
 -- See comments on matchRule
 lookupRule is_active id_unf in_scope fn args rules
   = -- pprTrace "matchRules" (ppr fn <+> ppr args $$ ppr rules ) $
     case go [] rules of
-	[]     -> Nothing
-	(m:ms) -> Just (findBest (fn,args) m ms)
+        []     -> Nothing
+        (m:ms) -> Just (findBest (fn,args) m ms)
   where
     rough_args = map roughTopName args
 
     go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)]
-    go ms []	       = ms
-    go ms (r:rs) = case (matchRule is_active id_unf in_scope args rough_args r) of
-			Just e  -> go ((r,e):ms) rs
-			Nothing -> -- pprTrace "match failed" (ppr r $$ ppr args $$ 
-				   -- 	ppr [ (arg_id, unfoldingTemplate unf) 
+    go ms []           = ms
+    go ms (r:rs) = case (matchRule fn is_active id_unf in_scope args rough_args r) of
+                        Just e  -> go ((r,e):ms) rs
+                        Nothing -> -- pprTrace "match failed" (ppr r $$ ppr args $$
+                                   --   ppr [ (arg_id, unfoldingTemplate unf)
                                    --       | Var arg_id <- args
                                    --       , let unf = idUnfolding arg_id
                                    --       , isCheapUnfolding unf] )
-				   go ms rs
+                                   go ms rs
 
 findBest :: (Id, [CoreExpr])
-	 -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr)
+         -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr)
 -- All these pairs matched the expression
 -- Return the pair the the most specific rule
 -- The (fn,args) is just for overlap reporting
@@ -396,15 +389,15 @@ findBest target (rule1,ans1) ((rule2,ans2):prs)
   | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs
   | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs
   | debugIsOn = let pp_rule rule
-			| opt_PprStyle_Debug = ppr rule
-			| otherwise          = doubleQuotes (ftext (ru_name rule))
-		in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
-			 (vcat [if opt_PprStyle_Debug then 
-				   ptext (sLit "Expression to match:") <+> ppr fn <+> sep (map ppr args)
-				else empty,
-				ptext (sLit "Rule 1:") <+> pp_rule rule1, 
-				ptext (sLit "Rule 2:") <+> pp_rule rule2]) $
-		findBest target (rule1,ans1) prs
+                        | opt_PprStyle_Debug = ppr rule
+                        | otherwise          = doubleQuotes (ftext (ru_name rule))
+                in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
+                         (vcat [if opt_PprStyle_Debug then
+                                   ptext (sLit "Expression to match:") <+> ppr fn <+> sep (map ppr args)
+                                else empty,
+                                ptext (sLit "Rule 1:") <+> pp_rule rule1,
+                                ptext (sLit "Rule 2:") <+> pp_rule rule2]) $
+                findBest target (rule1,ans1) prs
   | otherwise = findBest target (rule1,ans1) prs
   where
     (fn,args) = target
@@ -415,7 +408,7 @@ isMoreSpecific :: CoreRule -> CoreRule -> Bool
 -- anything else, because we want user-define rules to "win"
 -- In particular, class ops have a built-in rule, but we
 -- any user-specific rules to win
---   eg (Trac #4397)   
+--   eg (Trac #4397)
 --      truncate :: (RealFrac a, Integral b) => a -> b
 --      {-# RULES "truncate/Double->Int" truncate = double2Int #-}
 --      double2Int :: Double -> Int
@@ -423,28 +416,28 @@ isMoreSpecific :: CoreRule -> CoreRule -> Bool
 isMoreSpecific (BuiltinRule {}) _                = False
 isMoreSpecific (Rule {})        (BuiltinRule {}) = True
 isMoreSpecific (Rule { ru_bndrs = bndrs1, ru_args = args1 })
-	       (Rule { ru_bndrs = bndrs2, ru_args = args2 })
+               (Rule { ru_bndrs = bndrs2, ru_args = args2 })
   = isJust (matchN id_unfolding_fun in_scope bndrs2 args2 args1)
   where
-   id_unfolding_fun _ = NoUnfolding	-- Don't expand in templates
+   id_unfolding_fun _ = NoUnfolding     -- Don't expand in templates
    in_scope = mkInScopeSet (mkVarSet bndrs1)
-	-- Actually we should probably include the free vars 
-	-- of rule1's args, but I can't be bothered
+        -- Actually we should probably include the free vars
+        -- of rule1's args, but I can't be bothered
 
 noBlackList :: Activation -> Bool
-noBlackList _ = False		-- Nothing is black listed
+noBlackList _ = False           -- Nothing is black listed
 \end{code}
 
 Note [Extra args in rule matching]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If we find a matching rule, we return (Just (rule, rhs)), 
+If we find a matching rule, we return (Just (rule, rhs)),
 but the rule firing has only consumed as many of the input args
 as the ruleArity says.  It's up to the caller to keep track
 of any left-over args.  E.g. if you call
-	lookupRule ... f [e1, e2, e3]
+        lookupRule ... f [e1, e2, e3]
 and it returns Just (r, rhs), where r has ruleArity 2
 then the real rewrite is
-	f e1 e2 e3 ==> rhs e3
+        f e1 e2 e3 ==> rhs e3
 
 You might think it'd be cleaner for lookupRule to deal with the
 leftover arguments, by applying 'rhs' to them, but the main call
@@ -453,10 +446,10 @@ to lookupRule are the result of a lazy substitution
 
 \begin{code}
 ------------------------------------
-matchRule :: (Activation -> Bool) -> IdUnfoldingFun
+matchRule :: Id -> (Activation -> Bool) -> IdUnfoldingFun
           -> InScopeSet
-	  -> [CoreExpr] -> [Maybe Name]
-	  -> CoreRule -> Maybe CoreExpr
+          -> [CoreExpr] -> [Maybe Name]
+          -> CoreRule -> Maybe CoreExpr
 
 -- If (matchRule rule args) returns Just (name,rhs)
 -- then (f args) matches the rule, and the corresponding
@@ -464,53 +457,53 @@ matchRule :: (Activation -> Bool) -> IdUnfoldingFun
 --
 -- The bndrs and rhs is occurrence-analysed
 --
--- 	Example
+--      Example
 --
 -- The rule
---	forall f g x. map f (map g x) ==> map (f . g) x
+--      forall f g x. map f (map g x) ==> map (f . g) x
 -- is stored
---	CoreRule "map/map" 
---		 [f,g,x]		-- tpl_vars
---		 [f,map g x]		-- tpl_args
---		 map (f.g) x)		-- rhs
---	  
+--      CoreRule "map/map"
+--               [f,g,x]                -- tpl_vars
+--               [f,map g x]            -- tpl_args
+--               map (f.g) x)           -- rhs
+--
 -- Then the call: matchRule the_rule [e1,map e2 e3]
---	  = Just ("map/map", (\f,g,x -> rhs) e1 e2 e3)
+--        = Just ("map/map", (\f,g,x -> rhs) e1 e2 e3)
 --
 -- Any 'surplus' arguments in the input are simply put on the end
 -- of the output.
 
-matchRule _is_active id_unf _in_scope args _rough_args
-	  (BuiltinRule { ru_try = match_fn })
+matchRule fn _is_active id_unf _in_scope args _rough_args
+          (BuiltinRule { ru_try = match_fn })
 -- Built-in rules can't be switched off, it seems
-  = case match_fn id_unf args of
-	Just expr -> Just expr
-	Nothing   -> Nothing
+  = case match_fn fn id_unf args of
+        Just expr -> Just expr
+        Nothing   -> Nothing
 
-matchRule is_active id_unf in_scope args rough_args
+matchRule _ is_active id_unf in_scope args rough_args
           (Rule { ru_act = act, ru_rough = tpl_tops,
-		  ru_bndrs = tpl_vars, ru_args = tpl_args,
-		  ru_rhs = rhs })
-  | not (is_active act)		      = Nothing
+                  ru_bndrs = tpl_vars, ru_args = tpl_args,
+                  ru_rhs = rhs })
+  | not (is_active act)               = Nothing
   | ruleCantMatch tpl_tops rough_args = Nothing
   | otherwise
   = case matchN id_unf in_scope tpl_vars tpl_args args of
-	Nothing		               -> Nothing
-	Just (bind_wrapper, tpl_vals) -> Just (bind_wrapper $
-					       rule_fn `mkApps` tpl_vals)
+        Nothing                        -> Nothing
+        Just (bind_wrapper, tpl_vals) -> Just (bind_wrapper $
+                                               rule_fn `mkApps` tpl_vals)
   where
     rule_fn = occurAnalyseExpr (mkLams tpl_vars rhs)
-	-- We could do this when putting things into the rulebase, I guess
+        -- We could do this when putting things into the rulebase, I guess
 
 ---------------------------------------
-matchN	:: IdUnfoldingFun
+matchN  :: IdUnfoldingFun
         -> InScopeSet           -- ^ In-scope variables
-	-> [Var]		-- ^ Match template type variables
-	-> [CoreExpr]		-- ^ Match template
-	-> [CoreExpr]		-- ^ Target; can have more elements than the template
-	-> Maybe (BindWrapper,	-- Floated bindings; see Note [Matching lets]
-		  [CoreExpr])
--- For a given match template and context, find bindings to wrap around 
+        -> [Var]                -- ^ Match template type variables
+        -> [CoreExpr]           -- ^ Match template
+        -> [CoreExpr]           -- ^ Target; can have more elements than the template
+        -> Maybe (BindWrapper,  -- Floated bindings; see Note [Matching lets]
+                  [CoreExpr])
+-- For a given match template and context, find bindings to wrap around
 -- the entire result and what should be substituted for each template variable.
 -- Fail if there are two few actual arguments from the target to match the template
 
@@ -525,11 +518,11 @@ matchN id_unf in_scope tmpl_vars tmpl_es target_es
     init_menv = RV { rv_tmpls = mkVarSet tmpl_vars', rv_lcl = init_rn_env
                    , rv_fltR = mkEmptySubst (rnInScopeSet init_rn_env)
                    , rv_unf = id_unf }
-		
-    go _    subst []     _  	= Just subst
-    go _    _     _      [] 	= Nothing	-- Fail if too few actual args
+
+    go _    subst []     _      = Just subst
+    go _    _     _      []     = Nothing       -- Fail if too few actual args
     go menv subst (t:ts) (e:es) = do { subst1 <- match menv subst t e
-				     ; go menv subst1 ts es }
+                                     ; go menv subst1 ts es }
 
     lookup_tmpl :: RuleSubst -> Var -> CoreExpr
     lookup_tmpl (RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst }) tmpl_var'
@@ -540,21 +533,21 @@ matchN id_unf in_scope tmpl_vars tmpl_es target_es
                              Just ty -> Type ty
                              Nothing -> unbound tmpl_var'
 
-    unbound var = pprPanic "Template variable unbound in rewrite rule" 
-			(ppr var $$ ppr tmpl_vars $$ ppr tmpl_vars' $$ ppr tmpl_es $$ ppr target_es)
+    unbound var = pprPanic "Template variable unbound in rewrite rule"
+                        (ppr var $$ ppr tmpl_vars $$ ppr tmpl_vars' $$ ppr tmpl_es $$ ppr target_es)
 \end{code}
 
 Note [Template binders]
 ~~~~~~~~~~~~~~~~~~~~~~~
 Consider the following match:
-	Template:  forall x.  f x 
-	Target:     f (x+1)
-This should succeed, because the template variable 'x' has 
-nothing to do with the 'x' in the target. 
+        Template:  forall x.  f x
+        Target:     f (x+1)
+This should succeed, because the template variable 'x' has
+nothing to do with the 'x' in the target.
 
 On reflection, this case probably does just work, but this might not
-	Template:  forall x. f (\x.x) 
-	Target:    f (\y.y)
+        Template:  forall x. f (\x.x)
+        Target:    f (\y.y)
 Here we want to clone when we find the \x, but to know that x must be in scope
 
 To achive this, we use rnBndrL to rename the template variables if
@@ -562,14 +555,14 @@ necessary; the renamed ones are the tmpl_vars'
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
                    The main matcher
-%*									*
+%*                                                                      *
 %************************************************************************
 
         ---------------------------------------------
-		The inner workings of matching
-	---------------------------------------------
+                The inner workings of matching
+        ---------------------------------------------
 
 \begin{code}
 -- * The domain of the TvSubstEnv and IdSubstEnv are the template
@@ -601,19 +594,19 @@ emptyRuleSubst :: RuleSubst
 emptyRuleSubst = RS { rs_tv_subst = emptyVarEnv, rs_id_subst = emptyVarEnv
                     , rs_binds = \e -> e, rs_bndrs = emptyVarSet }
 
---	At one stage I tried to match even if there are more 
---	template args than real args.
+--      At one stage I tried to match even if there are more
+--      template args than real args.
 
---	I now think this is probably a bad idea.
---	Should the template (map f xs) match (map g)?  I think not.
---	For a start, in general eta expansion wastes work.
---	SLPJ July 99
+--      I now think this is probably a bad idea.
+--      Should the template (map f xs) match (map g)?  I think not.
+--      For a start, in general eta expansion wastes work.
+--      SLPJ July 99
 
 
 match :: RuleEnv
       -> RuleSubst
-      -> CoreExpr		-- Template
-      -> CoreExpr		-- Target
+      -> CoreExpr               -- Template
+      -> CoreExpr               -- Target
       -> Maybe RuleSubst
 
 -- See the notes with Unify.match, which matches types
@@ -621,14 +614,14 @@ match :: RuleEnv
 
 -- Interesting examples:
 -- Consider matching
---	\x->f 	   against    \f->f
+--      \x->f      against    \f->f
 -- When we meet the lambdas we must remember to rename f to f' in the
 -- second expresion.  The RnEnv2 does that.
 --
--- Consider matching 
---	forall a. \b->b	   against   \a->3
--- We must rename the \a.  Otherwise when we meet the lambdas we 
--- might substitute [a/b] in the template, and then erroneously 
+-- Consider matching
+--      forall a. \b->b    against   \a->3
+-- We must rename the \a.  Otherwise when we meet the lambdas we
+-- might substitute [a/b] in the template, and then erroneously
 -- succeed in matching what looks like the template variable 'a' against 3.
 
 -- The Var case follows closely what happens in Unify.match
@@ -641,30 +634,30 @@ match renv subst e1 (Var v2)      -- Note [Expanding variables]
   where
     v2'    = lookupRnInScope rn_env v2
     rn_env = rv_lcl renv
-	-- Notice that we look up v2 in the in-scope set
-	-- See Note [Lookup in-scope]
-	-- No need to apply any renaming first (hence no rnOccR)
-	-- because of the not-inRnEnvR
+        -- Notice that we look up v2 in the in-scope set
+        -- See Note [Lookup in-scope]
+        -- No need to apply any renaming first (hence no rnOccR)
+        -- because of the not-inRnEnvR
 
 match renv subst e1 (Let bind e2)
   | okToFloat (rv_lcl renv) (bindFreeVars bind)        -- See Note [Matching lets]
   = match (renv { rv_fltR = flt_subst' })
           (subst { rs_binds = rs_binds subst . Let bind'
                  , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs })
-	  e1 e2
+          e1 e2
   where
     flt_subst = addInScopeSet (rv_fltR renv) (rs_bndrs subst)
     (flt_subst', bind') = substBind flt_subst bind
     new_bndrs = bindersOf bind'
 
 {- Disabled: see Note [Matching cases] below
-match renv (tv_subst, id_subst, binds) e1 
+match renv (tv_subst, id_subst, binds) e1
       (Case scrut case_bndr ty [(con, alt_bndrs, rhs)])
-  | exprOkForSpeculation scrut	-- See Note [Matching cases]
+  | exprOkForSpeculation scrut  -- See Note [Matching cases]
   , okToFloat rn_env bndrs (exprFreeVars scrut)
   = match (renv { me_env = rn_env' })
           (tv_subst, id_subst, binds . case_wrap)
-          e1 rhs 
+          e1 rhs
   where
     rn_env   = me_env renv
     rn_env'  = extendRnInScopeList rn_env bndrs
@@ -677,8 +670,8 @@ match _ subst (Lit lit1) (Lit lit2)
   = Just subst
 
 match renv subst (App f1 a1) (App f2 a2)
-  = do 	{ subst' <- match renv subst f1 f2
-	; match renv subst' a1 a2 }
+  = do  { subst' <- match renv subst f1 f2
+        ; match renv subst' a1 a2 }
 
 match renv subst (Lam x1 e1) (Lam x2 e2)
   = match renv' subst e1 e2
@@ -687,9 +680,9 @@ match renv subst (Lam x1 e1) (Lam x2 e2)
                  , rv_fltR = delBndr (rv_fltR renv) x2 }
 
 -- This rule does eta expansion
---		(\x.M)  ~  N 	iff	M  ~  N x
+--              (\x.M)  ~  N    iff     M  ~  N x
 -- It's important that this is *after* the let rule,
--- so that 	(\x.M)  ~  (let y = e in \y.N)
+-- so that      (\x.M)  ~  (let y = e in \y.N)
 -- does the let thing, and then gets the lam/lam rule above
 match renv subst (Lam x1 e1) e2
   = match renv' subst e1 (App e2 (varToCoreExpr new_x))
@@ -698,7 +691,7 @@ match renv subst (Lam x1 e1) e2
     renv' = renv { rv_lcl = rn_env' }
 
 -- Eta expansion the other way
---	M  ~  (\y.N)	iff   M	y     ~  N
+--      M  ~  (\y.N)    iff   M y     ~  N
 match renv subst e1 (Lam x2 e2)
   = match renv' subst (App e1 (varToCoreExpr new_x)) e2
   where
@@ -706,11 +699,11 @@ match renv subst e1 (Lam x2 e2)
     renv' = renv { rv_lcl = rn_env' }
 
 match renv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2)
-  = do	{ subst1 <- match_ty renv subst ty1 ty2
-	; subst2 <- match renv subst1 e1 e2
+  = do  { subst1 <- match_ty renv subst ty1 ty2
+        ; subst2 <- match renv subst1 e1 e2
         ; let renv' = rnMatchBndr2 renv subst x1 x2
         ; match_alts renv' subst2 alts1 alts2   -- Alts are both sorted
-	}
+        }
 
 match renv subst (Type ty1) (Type ty2)
   = match_ty renv subst ty1 ty2
@@ -718,8 +711,8 @@ match renv subst (Coercion co1) (Coercion co2)
   = match_co renv subst co1 co2
 
 match renv subst (Cast e1 co1) (Cast e2 co2)
-  = do	{ subst1 <- match_co renv subst co1 co2
-	; match renv subst1 e1 e2 }
+  = do  { subst1 <- match_co renv subst co1 co2
+        ; match renv subst1 e1 e2 }
 
 -- Everything else fails
 match _ _ _e1 _e2 = -- pprTrace "Failing at" ((text "e1:" <+> ppr _e1) $$ (text "e2:" <+> ppr _e2)) $
@@ -727,13 +720,13 @@ match _ _ _e1 _e2 = -- pprTrace "Failing at" ((text "e1:" <+> ppr _e1) $$ (text
 
 -------------
 match_co :: RuleEnv
-      	 -> RuleSubst
-      	 -> Coercion
-      	 -> Coercion
-      	 -> Maybe RuleSubst
+         -> RuleSubst
+         -> Coercion
+         -> Coercion
+         -> Maybe RuleSubst
 match_co renv subst (CoVarCo cv) co
   = match_var renv subst cv (Coercion co)
-match_co _ _ co1 _ 
+match_co _ _ co1 _
   = pprTrace "match_co baling out" (ppr co1) Nothing
 
 -------------
@@ -748,10 +741,10 @@ rnMatchBndr2 renv subst x1 x2
 
 ------------------------------------------
 match_alts :: RuleEnv
-      	   -> RuleSubst
-      	   -> [CoreAlt]		-- Template
-      	   -> [CoreAlt]		-- Target
-      	   -> Maybe RuleSubst
+           -> RuleSubst
+           -> [CoreAlt]         -- Template
+           -> [CoreAlt]         -- Target
+           -> Maybe RuleSubst
 match_alts _ subst [] []
   = return subst
 match_alts renv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2)
@@ -774,10 +767,10 @@ okToFloat rn_env bind_fvs
 
 ------------------------------------------
 match_var :: RuleEnv
-     	  -> RuleSubst
-     	  -> Var		-- Template
-     	  -> CoreExpr        -- Target
-     	  -> Maybe RuleSubst
+          -> RuleSubst
+          -> Var                -- Template
+          -> CoreExpr        -- Target
+          -> Maybe RuleSubst
 match_var renv@(RV { rv_tmpls = tmpls, rv_lcl = rn_env, rv_fltR = flt_env })
           subst v1 e2
   | v1' `elemVarSet` tmpls
@@ -796,24 +789,24 @@ match_var renv@(RV { rv_tmpls = tmpls, rv_lcl = rn_env, rv_fltR = flt_env })
 
   where
     v1' = rnOccL rn_env v1
-	-- If the template is
-	--	forall x. f x (\x -> x) = ...
-	-- Then the x inside the lambda isn't the 
-	-- template x, so we must rename first!
+        -- If the template is
+        --      forall x. f x (\x -> x) = ...
+        -- Then the x inside the lambda isn't the
+        -- template x, so we must rename first!
 
 ------------------------------------------
 match_tmpl_var :: RuleEnv
                -> RuleSubst
-	       -> Var                -- Template
-	       -> CoreExpr		-- Target
-	       -> Maybe RuleSubst
+               -> Var                -- Template
+               -> CoreExpr              -- Target
+               -> Maybe RuleSubst
 
 match_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env })
                subst@(RS { rs_id_subst = id_subst, rs_bndrs = let_bndrs })
                v1' e2
   | any (inRnEnvR rn_env) (varSetElems (exprFreeVars e2))
   = Nothing     -- Occurs check failure
-		-- e.g. match forall a. (\x-> a x) against (\y. y y)
+                -- e.g. match forall a. (\x-> a x) against (\y. y y)
 
   | Just e1' <- lookupVarEnv id_subst v1'
   = if eqExpr (rnInScopeSet rn_env) e1' e2'
@@ -822,15 +815,15 @@ match_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env })
 
   | otherwise
   =             -- Note [Matching variable types]
-		-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-		-- However, we must match the *types*; e.g.
-		--   forall (c::Char->Int) (x::Char). 
+                -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+                -- However, we must match the *types*; e.g.
+                --   forall (c::Char->Int) (x::Char).
                 --      f (c x) = "RULE FIRED"
-		-- We must only match on args that have the right type
-		-- It's actually quite difficult to come up with an example that shows
-		-- you need type matching, esp since matching is left-to-right, so type
-		-- args get matched first.  But it's possible (e.g. simplrun008) and
-		-- this is the Right Thing to do
+                -- We must only match on args that have the right type
+                -- It's actually quite difficult to come up with an example that shows
+                -- you need type matching, esp since matching is left-to-right, so type
+                -- args get matched first.  But it's possible (e.g. simplrun008) and
+                -- this is the Right Thing to do
     do { subst' <- match_ty renv subst (idType v1') (exprType e2)
        ; return (subst' { rs_id_subst = id_subst' }) }
   where
@@ -844,14 +837,14 @@ match_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env })
 
 ------------------------------------------
 match_ty :: RuleEnv
-      	 -> RuleSubst
-      	 -> Type		-- Template
-      	 -> Type		-- Target
-      	 -> Maybe RuleSubst
+         -> RuleSubst
+         -> Type                -- Template
+         -> Type                -- Target
+         -> Maybe RuleSubst
 -- Matching Core types: use the matcher in TcType.
--- Notice that we treat newtypes as opaque.  For example, suppose 
--- we have a specialised version of a function at a newtype, say 
---	newtype T = MkT Int
+-- Notice that we treat newtypes as opaque.  For example, suppose
+-- we have a specialised version of a function at a newtype, say
+--      newtype T = MkT Int
 -- We only want to replace (f T) with f', not (f Int).
 
 match_ty renv subst ty1 ty2
@@ -873,16 +866,16 @@ This is the key reason for "constructor-like" Ids.  If we have
      {-# RULE f (g x) = h x #-}
 then in the term
    let v = g 3 in ....(f v)....
-we want to make the rule fire, to replace (f v) with (h 3). 
+we want to make the rule fire, to replace (f v) with (h 3).
 
 Note [Do not expand locally-bound variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Do *not* expand locally-bound variables, else there's a worry that the
 unfolding might mention variables that are themselves renamed.
 Example
-	  case x of y { (p,q) -> ...y... }
-Don't expand 'y' to (p,q) because p,q might themselves have been 
-renamed.  Essentially we only expand unfoldings that are "outside" 
+          case x of y { (p,q) -> ...y... }
+Don't expand 'y' to (p,q) because p,q might themselves have been
+renamed.  Essentially we only expand unfoldings that are "outside"
 the entire match.
 
 Hence, (a) the guard (not (isLocallyBoundR v2))
@@ -898,11 +891,11 @@ patterns] in SpecConstr
 Note [Matching lets]
 ~~~~~~~~~~~~~~~~~~~~
 Matching a let-expression.  Consider
-	RULE forall x.  f (g x) = <rhs>
+        RULE forall x.  f (g x) = <rhs>
 and target expression
-	f (let { w=R } in g E))
+        f (let { w=R } in g E))
 Then we'd like the rule to match, to generate
-	let { w=R } in (\x. <rhs>) E
+        let { w=R } in (\x. <rhs>) E
 In effect, we want to float the let-binding outward, to enable
 the match to happen.  This is the WHOLE REASON for accumulating
 bindings in the RuleSubst
@@ -951,60 +944,60 @@ Note [Matching cases]
 ~~~~~~~~~~~~~~~~~~~~~
 {- NOTE: This idea is currently disabled.  It really only works if
          the primops involved are OkForSpeculation, and, since
-	 they have side effects readIntOfAddr and touch are not.
-	 Maybe we'll get back to this later .  -}
-  
+         they have side effects readIntOfAddr and touch are not.
+         Maybe we'll get back to this later .  -}
+
 Consider
    f (case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->
-      case touch# fp s# of { _ -> 
+      case touch# fp s# of { _ ->
       I# n# } } )
-This happened in a tight loop generated by stream fusion that 
-Roman encountered.  We'd like to treat this just like the let 
+This happened in a tight loop generated by stream fusion that
+Roman encountered.  We'd like to treat this just like the let
 case, because the primops concerned are ok-for-speculation.
 That is, we'd like to behave as if it had been
    case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->
-   case touch# fp s# of { _ -> 
+   case touch# fp s# of { _ ->
    f (I# n# } } )
-  
+
 Note [Lookup in-scope]
 ~~~~~~~~~~~~~~~~~~~~~~
 Consider this example
-	foo :: Int -> Maybe Int -> Int
-	foo 0 (Just n) = n
-	foo m (Just n) = foo (m-n) (Just n)
+        foo :: Int -> Maybe Int -> Int
+        foo 0 (Just n) = n
+        foo m (Just n) = foo (m-n) (Just n)
 
 SpecConstr sees this fragment:
 
-	case w_smT of wild_Xf [Just A] {
-	  Data.Maybe.Nothing -> lvl_smf;
-	  Data.Maybe.Just n_acT [Just S(L)] ->
-	    case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] ->
-	    \$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf
-	    }};
+        case w_smT of wild_Xf [Just A] {
+          Data.Maybe.Nothing -> lvl_smf;
+          Data.Maybe.Just n_acT [Just S(L)] ->
+            case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] ->
+            \$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf
+            }};
 
 and correctly generates the rule
 
-	RULES: "SC:$wfoo1" [0] __forall {y_amr [Just L] :: GHC.Prim.Int#
-					  sc_snn :: GHC.Prim.Int#}
-	  \$wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr))
-	  = \$s\$wfoo_sno y_amr sc_snn ;]
+        RULES: "SC:$wfoo1" [0] __forall {y_amr [Just L] :: GHC.Prim.Int#
+                                          sc_snn :: GHC.Prim.Int#}
+          \$wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr))
+          = \$s\$wfoo_sno y_amr sc_snn ;]
 
 BUT we must ensure that this rule matches in the original function!
 Note that the call to \$wfoo is
-	    \$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf
+            \$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf
 
 During matching we expand wild_Xf to (Just n_acT).  But then we must also
 expand n_acT to (I# y_amr).  And we can only do that if we look up n_acT
 in the in-scope set, because in wild_Xf's unfolding it won't have an unfolding
-at all. 
+at all.
 
 That is why the 'lookupRnInScope' call in the (Var v2) case of 'match'
 is so important.
 
 %************************************************************************
-%*									*
-                   Rule-check the program										
-%*									*
+%*                                                                      *
+                   Rule-check the program
+%*                                                                      *
 %************************************************************************
 
    We want to know what sites have rules that could have fired but didn't.
@@ -1018,27 +1011,27 @@ ruleCheckProgram :: CompilerPhase               -- ^ Rule activation test
                  -> RuleBase                    -- ^ Database of rules
                  -> CoreProgram                 -- ^ Bindings to check in
                  -> SDoc                        -- ^ Resulting check message
-ruleCheckProgram phase rule_pat rule_base binds 
+ruleCheckProgram phase rule_pat rule_base binds
   | isEmptyBag results
   = text "Rule check results: no rule application sites"
   | otherwise
   = vcat [text "Rule check results:",
-	  line,
-	  vcat [ p $$ line | p <- bagToList results ]
-	 ]
+          line,
+          vcat [ p $$ line | p <- bagToList results ]
+         ]
   where
     env = RuleCheckEnv { rc_is_active = isActive phase
-                       , rc_id_unf    = idUnfolding	-- Not quite right
-		       	 	      			-- Should use activeUnfolding
+                       , rc_id_unf    = idUnfolding     -- Not quite right
+                                                        -- Should use activeUnfolding
                        , rc_pattern   = rule_pat
                        , rc_rule_base = rule_base }
     results = unionManyBags (map (ruleCheckBind env) binds)
     line = text (replicate 20 '-')
-	  
+
 data RuleCheckEnv = RuleCheckEnv {
-    rc_is_active :: Activation -> Bool, 
+    rc_is_active :: Activation -> Bool,
     rc_id_unf  :: IdUnfoldingFun,
-    rc_pattern :: String, 
+    rc_pattern :: String,
     rc_rule_base :: RuleBase
 }
 
@@ -1048,8 +1041,8 @@ ruleCheckBind env (NonRec _ r) = ruleCheck env r
 ruleCheckBind env (Rec prs)    = unionManyBags [ruleCheck env r | (_,r) <- prs]
 
 ruleCheck :: RuleCheckEnv -> CoreExpr -> Bag SDoc
-ruleCheck _   (Var _) 	    = emptyBag
-ruleCheck _   (Lit _) 	    = emptyBag
+ruleCheck _   (Var _)       = emptyBag
+ruleCheck _   (Lit _)       = emptyBag
 ruleCheck _   (Type _)      = emptyBag
 ruleCheck _   (Coercion _)  = emptyBag
 ruleCheck env (App f a)     = ruleCheckApp env (App f a) []
@@ -1057,8 +1050,8 @@ ruleCheck env (Tick _ e)  = ruleCheck env e
 ruleCheck env (Cast e _)    = ruleCheck env e
 ruleCheck env (Let bd e)    = ruleCheckBind env bd `unionBags` ruleCheck env e
 ruleCheck env (Lam _ e)     = ruleCheck env e
-ruleCheck env (Case e _ _ as) = ruleCheck env e `unionBags` 
-			        unionManyBags [ruleCheck env r | (_,_,r) <- as]
+ruleCheck env (Case e _ _ as) = ruleCheck env e `unionBags`
+                                unionManyBags [ruleCheck env r | (_,_,r) <- as]
 
 ruleCheckApp :: RuleCheckEnv -> Expr CoreBndr -> [Arg CoreBndr] -> Bag SDoc
 ruleCheckApp env (App f a) as = ruleCheck env a `unionBags` ruleCheckApp env f (a:as)
@@ -1073,16 +1066,16 @@ ruleCheckFun :: RuleCheckEnv -> Id -> [CoreExpr] -> Bag SDoc
 
 ruleCheckFun env fn args
   | null name_match_rules = emptyBag
-  | otherwise		  = unitBag (ruleAppCheck_help env fn args name_match_rules)
+  | otherwise             = unitBag (ruleAppCheck_help env fn args name_match_rules)
   where
     name_match_rules = filter match (getRules (rc_rule_base env) fn)
     match rule = (rc_pattern env) `isPrefixOf` unpackFS (ruleName rule)
 
 ruleAppCheck_help :: RuleCheckEnv -> Id -> [CoreExpr] -> [CoreRule] -> SDoc
 ruleAppCheck_help env fn args rules
-  = 	-- The rules match the pattern, so we want to print something
+  =     -- The rules match the pattern, so we want to print something
     vcat [text "Expression:" <+> ppr (mkApps (Var fn) args),
-	  vcat (map check_rule rules)]
+          vcat (map check_rule rules)]
   where
     n_args = length args
     i_args = args `zip` [1::Int ..]
@@ -1091,32 +1084,32 @@ ruleAppCheck_help env fn args rules
     check_rule rule = rule_herald rule <> colon <+> rule_info rule
 
     rule_herald (BuiltinRule { ru_name = name })
-	= ptext (sLit "Builtin rule") <+> doubleQuotes (ftext name)
+        = ptext (sLit "Builtin rule") <+> doubleQuotes (ftext name)
     rule_herald (Rule { ru_name = name })
-	= ptext (sLit "Rule") <+> doubleQuotes (ftext name)
+        = ptext (sLit "Rule") <+> doubleQuotes (ftext name)
 
     rule_info rule
-	| Just _ <- matchRule noBlackList (rc_id_unf env) emptyInScopeSet args rough_args rule
-	= text "matches (which is very peculiar!)"
+        | Just _ <- matchRule fn noBlackList (rc_id_unf env) emptyInScopeSet args rough_args rule
+        = text "matches (which is very peculiar!)"
 
     rule_info (BuiltinRule {}) = text "does not match"
 
-    rule_info (Rule { ru_act = act, 
-		      ru_bndrs = rule_bndrs, ru_args = rule_args})
-	| not (rc_is_active env act)  = text "active only in later phase"
-	| n_args < n_rule_args	      = text "too few arguments"
-	| n_mismatches == n_rule_args = text "no arguments match"
-	| n_mismatches == 0	      = text "all arguments match (considered individually), but rule as a whole does not"
-	| otherwise		      = text "arguments" <+> ppr mismatches <+> text "do not match (1-indexing)"
-	where
-	  n_rule_args  = length rule_args
-	  n_mismatches = length mismatches
-	  mismatches   = [i | (rule_arg, (arg,i)) <- rule_args `zip` i_args,
-			      not (isJust (match_fn rule_arg arg))]
-
-	  lhs_fvs = exprsFreeVars rule_args	-- Includes template tyvars
+    rule_info (Rule { ru_act = act,
+                      ru_bndrs = rule_bndrs, ru_args = rule_args})
+        | not (rc_is_active env act)  = text "active only in later phase"
+        | n_args < n_rule_args        = text "too few arguments"
+        | n_mismatches == n_rule_args = text "no arguments match"
+        | n_mismatches == 0           = text "all arguments match (considered individually), but rule as a whole does not"
+        | otherwise                   = text "arguments" <+> ppr mismatches <+> text "do not match (1-indexing)"
+        where
+          n_rule_args  = length rule_args
+          n_mismatches = length mismatches
+          mismatches   = [i | (rule_arg, (arg,i)) <- rule_args `zip` i_args,
+                              not (isJust (match_fn rule_arg arg))]
+
+          lhs_fvs = exprsFreeVars rule_args     -- Includes template tyvars
           match_fn rule_arg arg = match renv emptyRuleSubst rule_arg arg
-		where
+                where
                   in_scope = mkInScopeSet (lhs_fvs `unionVarSet` exprFreeVars arg)
                   renv = RV { rv_lcl   = mkRnEnv2 in_scope
                             , rv_tmpls = mkVarSet rule_bndrs
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index c4f289c68e..6dc091961a 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -277,7 +277,7 @@ mkTopStgRhs :: DynFlags -> FreeVarsInfo
             -> SRT -> StgBinderInfo -> StgExpr
             -> StgRhs
 
-mkTopStgRhs _ rhs_fvs srt binder_info (StgLam _ bndrs body)
+mkTopStgRhs _ rhs_fvs srt binder_info (StgLam bndrs body)
   = StgRhsClosure noCCS binder_info
                   (getFVs rhs_fvs)
                   ReEntrant
@@ -343,7 +343,7 @@ coreToStgExpr expr@(Lam _ _)
         fvs             = args' `minusFVBinders` body_fvs
         escs            = body_escs `delVarSetList` args'
         result_expr | null args' = body
-                    | otherwise  = StgLam (exprType expr) args' body
+                    | otherwise  = StgLam args' body
 
     return (result_expr, fvs, escs)
 
@@ -454,15 +454,15 @@ coreToStgExpr e = pprPanic "coreToStgExpr" (ppr e)
 
 \begin{code}
 mkStgAltType :: Id -> [CoreAlt] -> AltType
-mkStgAltType bndr alts
-  = case tyConAppTyCon_maybe (repType (idType bndr)) of
-        Just tc | isUnboxedTupleTyCon tc -> UbxTupAlt tc
-                | isUnLiftedTyCon tc     -> PrimAlt tc
-                | isAbstractTyCon tc     -> look_for_better_tycon
-                | isAlgTyCon tc          -> AlgAlt tc
-                | otherwise              -> ASSERT2( _is_poly_alt_tycon tc, ppr tc )
-                                            PolyAlt
-        Nothing                          -> PolyAlt
+mkStgAltType bndr alts = case repType (idType bndr) of
+    UnaryRep rep_ty -> case tyConAppTyCon_maybe rep_ty of
+        Just tc | isUnLiftedTyCon tc -> PrimAlt tc
+                | isAbstractTyCon tc -> look_for_better_tycon
+                | isAlgTyCon tc      -> AlgAlt tc
+                | otherwise          -> ASSERT2( _is_poly_alt_tycon tc, ppr tc )
+                                        PolyAlt
+        Nothing                      -> PolyAlt
+    UbxTupleRep rep_tys -> UbxTupAlt (length rep_tys)
 
   where
    _is_poly_alt_tycon tc
@@ -623,7 +623,8 @@ coreToStgArgs (arg : args) = do         -- Non-type argument
         arg_ty = exprType arg
         stg_arg_ty = stgArgType stg_arg
         bad_args = (isUnLiftedType arg_ty && not (isUnLiftedType stg_arg_ty))
-                || (typePrimRep arg_ty /= typePrimRep stg_arg_ty)
+                || (map typePrimRep (flattenRepType (repType arg_ty))
+                        /= map typePrimRep (flattenRepType (repType stg_arg_ty)))
         -- In GHCi we coerce an argument of type BCO# (unlifted) to HValue (lifted),
         -- and pass it to a function expecting an HValue (arg_ty).  This is ok because
         -- we can treat an unlifted value as lifted.  But the other way round
@@ -783,7 +784,7 @@ mkStgRhs :: FreeVarsInfo -> SRT -> StgBinderInfo -> StgExpr -> StgRhs
 
 mkStgRhs _ _ _ (StgConApp con args) = StgRhsCon noCCS con args
 
-mkStgRhs rhs_fvs srt binder_info (StgLam _ bndrs body)
+mkStgRhs rhs_fvs srt binder_info (StgLam bndrs body)
   = StgRhsClosure noCCS binder_info
                   (getFVs rhs_fvs)
                   ReEntrant
diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs
index ec09c4d9a7..ac394164b7 100644
--- a/compiler/stgSyn/StgLint.lhs
+++ b/compiler/stgSyn/StgLint.lhs
@@ -83,7 +83,6 @@ lintStgBindings whodunnit binds
 lintStgArg :: StgArg -> LintM (Maybe Type)
 lintStgArg (StgLitArg lit) = return (Just (literalType lit))
 lintStgArg (StgVarArg v)   = lintStgVar v
-lintStgArg a               = pprPanic "lintStgArg" (ppr a)
 
 lintStgVar :: Id -> LintM (Maybe Kind)
 lintStgVar v = do checkInScope v
@@ -175,7 +174,7 @@ lintStgExpr (StgOpApp _ args res_ty) = runMaybeT $ do
     _maybe_arg_tys <- mapM (MaybeT . lintStgArg) args
     return res_ty
 
-lintStgExpr (StgLam _ bndrs _) = do
+lintStgExpr (StgLam bndrs _) = do
     addErrL (ptext (sLit "Unexpected StgLam") <+> ppr bndrs)
     return Nothing
 
@@ -196,18 +195,19 @@ lintStgExpr (StgSCC _ _ _ expr) = lintStgExpr expr
 lintStgExpr (StgCase scrut _ _ bndr _ alts_type alts) = runMaybeT $ do
     _ <- MaybeT $ lintStgExpr scrut
 
-    MaybeT $ liftM Just $
+    in_scope <- MaybeT $ liftM Just $
      case alts_type of
-        AlgAlt tc    -> check_bndr tc
-        PrimAlt tc   -> check_bndr tc
-        UbxTupAlt tc -> check_bndr tc
-        PolyAlt      -> return ()
+        AlgAlt tc    -> check_bndr tc >> return True
+        PrimAlt tc   -> check_bndr tc >> return True
+        UbxTupAlt _  -> return False -- Binder is always dead in this case
+        PolyAlt      -> return True
 
-    MaybeT $ addInScopeVars [bndr] $
+    MaybeT $ addInScopeVars [bndr | in_scope] $
              lintStgAlts alts scrut_ty
   where
-    scrut_ty      = idType bndr
-    check_bndr tc = case tyConAppTyCon_maybe (repType scrut_ty) of
+    scrut_ty          = idType bndr
+    UnaryRep scrut_rep = repType scrut_ty -- Not used if scrutinee is unboxed tuple
+    check_bndr tc = case tyConAppTyCon_maybe scrut_rep of
                         Just bndr_tc -> checkL (tc == bndr_tc) bad_bndr
                         Nothing      -> addErrL bad_bndr
                   where
@@ -431,24 +431,27 @@ stgEqType :: Type -> Type -> Bool
 -- Fundamentally this is a losing battle because of unsafeCoerce
 
 stgEqType orig_ty1 orig_ty2 
-  = go rep_ty1 rep_ty2
+  = gos (repType orig_ty1) (repType orig_ty2)
   where
-    rep_ty1 = deepRepType orig_ty1
-    rep_ty2 = deepRepType orig_ty2
+    gos :: RepType -> RepType -> Bool
+    gos (UbxTupleRep tys1) (UbxTupleRep tys2)
+      = equalLength tys1 tys2 && and (zipWith go tys1 tys2)
+    gos (UnaryRep ty1) (UnaryRep ty2) = go ty1 ty2
+    gos _ _ = False
+
+    go :: UnaryType -> UnaryType -> Bool
     go ty1 ty2
       | Just (tc1, tc_args1) <- splitTyConApp_maybe ty1
       , Just (tc2, tc_args2) <- splitTyConApp_maybe ty2
       , let res = if tc1 == tc2 
-                  then equalLength tc_args1 tc_args2 
-                    && and (zipWith go tc_args1 tc_args2)
+                  then equalLength tc_args1 tc_args2 && and (zipWith (gos `on` repType) tc_args1 tc_args2)
                   else  -- TyCons don't match; but don't bleat if either is a 
                         -- family TyCon because a coercion might have made it 
                         -- equal to something else
                     (isFamilyTyCon tc1 || isFamilyTyCon tc2)
       = if res then True
         else 
-        pprTrace "stgEqType: unequal" (vcat [ppr orig_ty1, ppr orig_ty2, ppr rep_ty1
-                                            , ppr rep_ty2, ppr ty1, ppr ty2]) 
+        pprTrace "stgEqType: unequal" (vcat [ppr ty1, ppr ty2]) 
         False
 
       | otherwise = True  -- Conservatively say "fine".  
diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index defec7516b..3e801c6328 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -35,7 +35,7 @@ module StgSyn (
 
         -- utils
         stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
-        isDllConApp, isStgTypeArg,
+        isDllConApp,
         stgArgType,
 
         pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs,
@@ -67,6 +67,7 @@ import Type        ( Type )
 import Type        ( typePrimRep )
 import UniqSet
 import Unique      ( Unique )
+import Util
 import VarSet      ( IdSet, isEmptyVarSet )
 \end{code}
 
@@ -99,11 +100,6 @@ data GenStgBinding bndr occ
 data GenStgArg occ
   = StgVarArg  occ
   | StgLitArg  Literal
-  | StgTypeArg Type     -- For when we want to preserve all type info
-
-isStgTypeArg :: StgArg -> Bool
-isStgTypeArg (StgTypeArg _) = True
-isStgTypeArg _              = False
 
 -- | Does this constructor application refer to
 -- anything in a different *Windows* DLL?
@@ -114,6 +110,8 @@ isDllConApp dflags con args
     = isDllName this_pkg (dataConName con) || any is_dll_arg args
  | otherwise = False
   where
+    -- NB: typePrimRep is legit because any free variables won't have
+    -- unlifted type (there are no unlifted things at top level)
     is_dll_arg :: StgArg -> Bool
     is_dll_arg (StgVarArg v) =  isAddrRep (typePrimRep (idType v))
                              && isDllName this_pkg (idName v)
@@ -144,7 +142,6 @@ isAddrRep _       = False
 stgArgType :: StgArg -> Type
 stgArgType (StgVarArg v)   = idType v
 stgArgType (StgLitArg lit) = literalType lit
-stgArgType (StgTypeArg _)  = panic "stgArgType called on stgTypeArg"
 \end{code}
 
 %************************************************************************
@@ -212,8 +209,6 @@ finished it encodes (\x -> e) as (let f = \x -> e in f)
 
 \begin{code}
   | StgLam
-        Type       -- Type of whole lambda (useful when
-                   -- making a binder for it)
         [bndr]
         StgExpr    -- Body of lambda
 \end{code}
@@ -520,7 +515,7 @@ type GenStgAlt bndr occ
 
 data AltType
   = PolyAlt             -- Polymorphic (a type variable)
-  | UbxTupAlt TyCon     -- Unboxed tuple
+  | UbxTupAlt Int       -- Unboxed tuple of this arity
   | AlgAlt    TyCon     -- Algebraic data type; the AltCons will be DataAlts
   | PrimAlt   TyCon     -- Primitive data type; the AltCons will be LitAlts
 \end{code}
@@ -636,11 +631,11 @@ Robin Popplestone asked for semi-colon separators on STG binds; here's
 hoping he likes terminators instead...  Ditto for case alternatives.
 
 \begin{code}
-pprGenStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee)
+pprGenStgBinding :: (OutputableBndr bndr, Outputable bdee, Ord bdee)
                  => GenStgBinding bndr bdee -> SDoc
 
 pprGenStgBinding (StgNonRec bndr rhs)
-  = hang (hsep [ppr bndr, equals])
+  = hang (hsep [pprBndr LetBind bndr, equals])
         4 ((<>) (ppr rhs) semi)
 
 pprGenStgBinding (StgRec pairs)
@@ -648,7 +643,7 @@ pprGenStgBinding (StgRec pairs)
            map (ppr_bind) pairs ++ [ifPprDebug $ ptext $ sLit "{- StgRec (end) -}"]
   where
     ppr_bind (bndr, expr)
-      = hang (hsep [ppr bndr, equals])
+      = hang (hsep [pprBndr LetBind bndr, equals])
              4 ((<>) (ppr expr) semi)
 
 pprStgBinding :: StgBinding -> SDoc
@@ -657,7 +652,7 @@ pprStgBinding  bind  = pprGenStgBinding bind
 pprStgBindings :: [StgBinding] -> SDoc
 pprStgBindings binds = vcat (map pprGenStgBinding binds)
 
-pprGenStgBindingWithSRT :: (Outputable bndr, Outputable bdee, Ord bdee)
+pprGenStgBindingWithSRT :: (OutputableBndr bndr, Outputable bdee, Ord bdee)
                         => (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
 pprGenStgBindingWithSRT (bind,srts)
   = vcat $ pprGenStgBinding bind : map pprSRT srts
@@ -670,24 +665,23 @@ pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
 instance (Outputable bdee) => Outputable (GenStgArg bdee) where
     ppr = pprStgArg
 
-instance (Outputable bndr, Outputable bdee, Ord bdee)
+instance (OutputableBndr bndr, Outputable bdee, Ord bdee)
                 => Outputable (GenStgBinding bndr bdee) where
     ppr = pprGenStgBinding
 
-instance (Outputable bndr, Outputable bdee, Ord bdee)
+instance (OutputableBndr bndr, Outputable bdee, Ord bdee)
                 => Outputable (GenStgExpr bndr bdee) where
     ppr = pprStgExpr
 
-instance (Outputable bndr, Outputable bdee, Ord bdee)
+instance (OutputableBndr bndr, Outputable bdee, Ord bdee)
                 => Outputable (GenStgRhs bndr bdee) where
     ppr rhs = pprStgRhs rhs
 
 pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc
 pprStgArg (StgVarArg var) = ppr var
 pprStgArg (StgLitArg con) = ppr con
-pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty
 
-pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee)
+pprStgExpr :: (OutputableBndr bndr, Outputable bdee, Ord bdee)
            => GenStgExpr bndr bdee -> SDoc
 -- special case
 pprStgExpr (StgLit lit)     = ppr lit
@@ -702,9 +696,11 @@ pprStgExpr (StgConApp con args)
 pprStgExpr (StgOpApp op args _)
   = hsep [ pprStgOp op, brackets (interppSP args)]
 
-pprStgExpr (StgLam _ bndrs body)
-  =sep [ char '\\' <+> ppr bndrs <+> ptext (sLit "->"),
+pprStgExpr (StgLam bndrs body)
+  = sep [ char '\\' <+> ppr_list (map (pprBndr LambdaBind) bndrs)
+            <+> ptext (sLit "->"),
          pprStgExpr body ]
+  where ppr_list = brackets . fsep . punctuate comma
 
 -- special case: let v = <very specific thing>
 --               in
@@ -767,7 +763,7 @@ pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
   = sep [sep [ptext (sLit "case"),
            nest 4 (hsep [pprStgExpr expr,
              ifPprDebug (dcolon <+> ppr alt_type)]),
-           ptext (sLit "of"), ppr bndr, char '{'],
+           ptext (sLit "of"), pprBndr CaseBind bndr, char '{'],
            ifPprDebug (
            nest 4 (
              hcat [ptext  (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
@@ -777,10 +773,10 @@ pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
            nest 2 (vcat (map pprStgAlt alts)),
            char '}']
 
-pprStgAlt :: (Outputable bndr, Outputable occ, Ord occ)
+pprStgAlt :: (OutputableBndr bndr, Outputable occ, Ord occ)
           => GenStgAlt bndr occ -> SDoc
 pprStgAlt (con, params, _use_mask, expr)
-  = hang (hsep [ppr con, interppSP params, ptext (sLit "->")])
+  = hang (hsep [ppr con, sep (map (pprBndr CaseBind) params), ptext (sLit "->")])
          4 (ppr expr <> semi)
 
 pprStgOp :: StgOp -> SDoc
@@ -790,7 +786,7 @@ pprStgOp (StgFCallOp op _) = ppr op
 
 instance Outputable AltType where
   ppr PolyAlt        = ptext (sLit "Polymorphic")
-  ppr (UbxTupAlt tc) = ptext (sLit "UbxTup") <+> ppr tc
+  ppr (UbxTupAlt n)  = ptext (sLit "UbxTup") <+> ppr n
   ppr (AlgAlt tc)    = ptext (sLit "Alg")    <+> ppr tc
   ppr (PrimAlt tc)   = ptext (sLit "Prim")   <+> ppr tc
 
@@ -802,7 +798,7 @@ pprStgLVs lvs
     else
         hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
 
-pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee)
+pprStgRhs :: (OutputableBndr bndr, Outputable bdee, Ord bdee)
           => GenStgRhs bndr bdee -> SDoc
 
 -- special case
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index b85c107bea..ddeb1aa864 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -44,7 +44,7 @@ import UniqFM		( addToUFM_Directly, lookupUFM_Directly,
 			  minusUFM, filterUFM )
 import Type		( isUnLiftedType, eqType, tyConAppTyCon_maybe )
 import Coercion         ( coercionKind )
-import Util		( mapAndUnzip, lengthIs, zipEqual )
+import Util
 import BasicTypes	( Arity, TopLevelFlag(..), isTopLevel, isNeverActive,
 			  RecFlag(..), isRec, isMarkedStrict )
 import Maybes		( orElse, expectJust )
diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 2c365887bc..ec351ab7d8 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -27,7 +27,7 @@ import BasicTypes
 import VarEnv		( isEmptyVarEnv )
 import Maybes		( orElse )
 import WwLib
-import Util		( lengthIs, notNull )
+import Util
 import Outputable
 import MonadUtils
 
diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs
index c43450cb17..b6370b5c92 100644
--- a/compiler/typecheck/FamInst.lhs
+++ b/compiler/typecheck/FamInst.lhs
@@ -28,7 +28,7 @@ import Outputable
 import UniqFM
 import VarSet
 import FastString
-import Util( filterOut, sortWith )
+import Util
 import Maybes
 import Control.Monad
 import Data.Map (Map)
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 530d867b20..07d255b1f7 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -223,7 +223,7 @@ tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
         -- Consider     ?x = 4
         --              ?y = ?x + 1
     tc_ip_bind (IPBind ip expr) 
-       = do { ty <- newFlexiTyVarTy argTypeKind
+       = do { ty <- newFlexiTyVarTy openTypeKind
             ; ip_id <- newIP ip ty
             ; expr' <- tcMonoExpr expr ty
             ; return (ip_id, (IPBind (IPName ip_id) expr')) }
@@ -946,7 +946,7 @@ tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name, fun_infix = inf, fun_matc
   = do  { mono_id <- newSigLetBndr no_gen name sig
         ; return (TcFunBind (name, Just sig, mono_id) nm_loc inf matches) }
   | otherwise
-  = do  { mono_ty <- newFlexiTyVarTy argTypeKind
+  = do  { mono_ty <- newFlexiTyVarTy openTypeKind
         ; mono_id <- newNoSigLetBndr no_gen name mono_ty
         ; return (TcFunBind (name, Nothing, mono_id) nm_loc inf matches) }
 
diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index 8a45632bfb..84a5c3dd72 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -36,7 +36,7 @@ import VarSet
 import TcSMonad
 import FastString
 
-import Util ( equalLength )
+import Util
 
 
 import TysWiredIn ( eqTyCon )
diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index cde5eaa613..209215e8ec 100644
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -45,6 +45,7 @@ import Maybes
 import BasicTypes
 import Bag
 import FastString
+import Util
 
 import Control.Monad
 \end{code}
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index b864a13872..163a581dcc 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -985,7 +985,7 @@ cond_typeableOK :: Condition
 --	      (b) 7 or fewer args
 cond_typeableOK (_, tc)
   | tyConArity tc > 7 = Just too_many
-  | not (all (isSubArgTypeKind . tyVarKind) (tyConTyVars tc))
+  | not (all (isSubOpenTypeKind . tyVarKind) (tyConTyVars tc))
                       = Just bad_kind
   | otherwise	      = Nothing
   where
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 2e870da966..3f5fb09f15 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -81,6 +81,7 @@ import Outputable
 import Unique
 import FastString
 import ListSetOps
+import Util
 \end{code}
 
 
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 488e65458c..c915b16c42 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -184,7 +184,7 @@ tcExpr (HsIPVar ip) res_ty
 		-- type scheme.  We enforce this by creating a fresh
 		-- type variable as its type.  (Because res_ty may not
 		-- be a tau-type.)
-	; ip_ty <- newFlexiTyVarTy argTypeKind	-- argTypeKind: it can't be an unboxed tuple
+	; ip_ty <- newFlexiTyVarTy openTypeKind
 	; ip_var <- emitWanted origin (mkIPPred ip ip_ty)
 	; tcWrapResult (HsIPVar (IPName ip_var)) ip_ty res_ty }
 
@@ -344,7 +344,7 @@ tcExpr (ExplicitTuple tup_args boxity) res_ty
   | otherwise
   = -- The tup_args are a mixture of Present and Missing (for tuple sections)
     do { let kind = case boxity of { Boxed   -> liftedTypeKind
-                                   ; Unboxed -> argTypeKind }
+                                   ; Unboxed -> openTypeKind }
              arity = length tup_args 
              tup_tc = tupleTyCon (boxityNormalTupleSort boxity) arity
 
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index e6586d8ff5..90a174081c 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -48,6 +48,7 @@ import Platform
 import SrcLoc
 import Bag
 import FastString
+import Util
 
 import Control.Monad
 \end{code}
diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index c4a2c33ba1..89444b2b9e 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -43,6 +43,7 @@ import Bag
 import Outputable 
 import FastString
 import UniqSupply
+import Util
 
 #include "HsVersions.h"
 \end{code}
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 9104016938..a026c4381c 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -59,6 +59,7 @@ import SrcLoc
 import Bag
 import FastString
 import Outputable
+import Util
 -- import Data.Traversable( traverse )
 \end{code}
 
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 7f4eed87ce..e98191d429 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -73,6 +73,8 @@ import DynFlags ( ExtensionFlag( Opt_DataKinds ) )
 import UniqSupply
 import Outputable
 import FastString
+import Util
+
 import Control.Monad ( unless, when, zipWithM )
 \end{code}
 
@@ -247,7 +249,7 @@ tcHsConArgType NewType  bty = tcHsLiftedType (getBangType bty)
   -- Newtypes can't have bangs, but we don't check that
   -- until checkValidDataCon, so do not want to crash here
 
-tcHsConArgType DataType bty = tcHsArgType (getBangType bty)
+tcHsConArgType DataType bty = tcHsOpenType (getBangType bty)
   -- Can't allow an unlifted type for newtypes, because we're effectively
   -- going to remove the constructor while coercing it to a lifted type.
   -- And newtypes can't be bang'd
@@ -266,10 +268,10 @@ tc_hs_arg_tys what tys kinds
              | (ty,kind,n) <- zip3 tys kinds [1..] ]
 
 ---------------------------
-tcHsArgType, tcHsLiftedType :: LHsType Name -> TcM TcType
+tcHsOpenType, tcHsLiftedType :: LHsType Name -> TcM TcType
 -- Used for type signatures
 -- Do not do validity checking
-tcHsArgType ty 	  = addTypeCtxt ty $ tc_lhs_type ty ekArg  
+tcHsOpenType ty   = addTypeCtxt ty $ tc_lhs_type ty ekOpen
 tcHsLiftedType ty = addTypeCtxt ty $ tc_lhs_type ty ekLifted
 
 -- Like tcHsType, but takes an expected kind
@@ -331,7 +333,7 @@ tc_hs_type hs_ty@(HsTyVar name) exp_kind
        ; return ty }
 
 tc_hs_type ty@(HsFunTy ty1 ty2) exp_kind@(EK _ ctxt)
-  = do { ty1' <- tc_lhs_type ty1 (EK argTypeKind  ctxt)
+  = do { ty1' <- tc_lhs_type ty1 (EK openTypeKind ctxt)
        ; ty2' <- tc_lhs_type ty2 (EK openTypeKind ctxt)
        ; checkExpectedKind ty liftedTypeKind exp_kind
        ; return (mkFunTy ty1' ty2') }
@@ -477,7 +479,7 @@ tc_tuple hs_ty tup_sort tys exp_kind
   where
     arg_kind = case tup_sort of
                  HsBoxedTuple      -> liftedTypeKind
-                 HsUnboxedTuple    -> argTypeKind
+                 HsUnboxedTuple    -> openTypeKind
                  HsConstraintTuple -> constraintKind
                  _                 -> panic "tc_hs_type arg_kind"
     cxt_doc = case tup_sort of
@@ -500,7 +502,7 @@ finish_tuple hs_ty tup_sort tau_tys exp_kind
             _                 -> panic "tc_hs_type HsTupleTy"
 
     res_kind = case tup_sort of
-                 HsUnboxedTuple    -> ubxTupleKind
+                 HsUnboxedTuple    -> unliftedTypeKind
                  HsBoxedTuple      -> liftedTypeKind
                  HsConstraintTuple -> constraintKind
                  _                 -> panic "tc_hs_type arg_kind"
@@ -1228,9 +1230,9 @@ data ExpKind = EK TcKind SDoc
 instance Outputable ExpKind where
   ppr (EK k _) = ptext (sLit "Expected kind:") <+> ppr k
 
-ekLifted, ekArg, ekConstraint :: ExpKind
+ekLifted, ekOpen, ekConstraint :: ExpKind
 ekLifted     = EK liftedTypeKind (ptext (sLit "Expected"))
-ekArg        = EK argTypeKind    (ptext (sLit "Expected"))
+ekOpen       = EK openTypeKind   (ptext (sLit "Expected"))
 ekConstraint = EK constraintKind (ptext (sLit "Expected"))
 
 -- Build an ExpKind for arguments
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index 2a735fe77f..aa7256f707 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -55,6 +55,7 @@ import Pair ()
 import UniqFM
 import FastString ( sLit ) 
 import DynFlags
+import Util
 \end{code}
 **********************************************************************
 *                                                                    * 
diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 75c1e8c235..672e13b71b 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -849,19 +849,16 @@ expectedKindInCtxt :: UserTypeCtxt -> Maybe Kind
 expectedKindInCtxt (TySynCtxt _)  = Nothing -- Any kind will do
 expectedKindInCtxt ThBrackCtxt    = Nothing
 expectedKindInCtxt GhciCtxt       = Nothing
-expectedKindInCtxt ResSigCtxt     = Just openTypeKind
-expectedKindInCtxt ExprSigCtxt    = Just openTypeKind
 expectedKindInCtxt (ForSigCtxt _) = Just liftedTypeKind
 expectedKindInCtxt InstDeclCtxt   = Just constraintKind
 expectedKindInCtxt SpecInstCtxt   = Just constraintKind
-expectedKindInCtxt _              = Just argTypeKind
+expectedKindInCtxt _              = Just openTypeKind
 
 checkValidType :: UserTypeCtxt -> Type -> TcM ()
 -- Checks that the type is valid for the given context
 -- Not used for instance decls; checkValidInstance instead
 checkValidType ctxt ty 
   = do { traceTc "checkValidType" (ppr ty <+> text "::" <+> ppr (typeKind ty))
-       ; unboxed         <- xoptM Opt_UnboxedTuples
        ; rank2_flag      <- xoptM Opt_Rank2Types
        ; rankn_flag      <- xoptM Opt_RankNTypes
        ; polycomp        <- xoptM Opt_PolymorphicComponents
@@ -908,18 +905,9 @@ checkValidType ctxt ty
              kind_ok = case expectedKindInCtxt ctxt of
                          Nothing -> True
                          Just k  -> tcIsSubKind actual_kind k
-	
-	     ubx_tup 
-              | not unboxed = UT_NotOk
-              | otherwise   = case ctxt of
-	                   	   TySynCtxt _ -> UT_Ok
-	                   	   ExprSigCtxt -> UT_Ok
-	                   	   ThBrackCtxt -> UT_Ok
-	     	      	           GhciCtxt    -> UT_Ok
-	                   	   _           -> UT_NotOk
 
 	-- Check the internal validity of the type itself
-       ; check_type rank ubx_tup ty
+       ; check_type rank ty
 
 	-- Check that the thing has kind Type, and is lifted if necessary
 	-- Do this second, because we can't usefully take the kind of an 
@@ -970,49 +958,45 @@ forAllAllowed (LimitedRank forall_ok _) = forall_ok
 forAllAllowed _        	                = False
 
 ----------------------------------------
-data UbxTupFlag = UT_Ok	| UT_NotOk
-	-- The "Ok" version means "ok if UnboxedTuples is on"
-
-----------------------------------------
 check_mono_type :: Rank -> KindOrType -> TcM ()	-- No foralls anywhere
 				      		-- No unlifted types of any kind
 check_mono_type rank ty
   | isKind ty = return ()  -- IA0_NOTE: Do we need to check kinds?
   | otherwise
-   = do { check_type rank UT_NotOk ty
+   = do { check_type rank ty
 	; checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty) }
 
-check_type :: Rank -> UbxTupFlag -> Type -> TcM ()
+check_type :: Rank -> Type -> TcM ()
 -- The args say what the *type context* requires, independent
 -- of *flag* settings.  You test the flag settings at usage sites.
 -- 
 -- Rank is allowed rank for function args
 -- Rank 0 means no for-alls anywhere
 
-check_type rank ubx_tup ty
+check_type rank ty
   | not (null tvs && null theta)
   = do	{ checkTc (forAllAllowed rank) (forAllTyErr rank ty)
 		-- Reject e.g. (Maybe (?x::Int => Int)), 
 		-- with a decent error message
 	; check_valid_theta SigmaCtxt theta
-	; check_type rank ubx_tup tau	-- Allow foralls to right of arrow
+	; check_type rank tau	-- Allow foralls to right of arrow
 	; checkAmbiguity tvs theta (tyVarsOfType tau) }
   where
     (tvs, theta, tau) = tcSplitSigmaTy ty
    
-check_type _ _ (TyVarTy _) = return ()
+check_type _ (TyVarTy _) = return ()
 
-check_type rank _ (FunTy arg_ty res_ty)
-  = do	{ check_type arg_rank UT_NotOk arg_ty
-	; check_type res_rank UT_Ok    res_ty }
+check_type rank (FunTy arg_ty res_ty)
+  = do	{ check_type arg_rank arg_ty
+	; check_type res_rank res_ty }
   where
     (arg_rank, res_rank) = funArgResRank rank
 
-check_type rank _ (AppTy ty1 ty2)
+check_type rank (AppTy ty1 ty2)
   = do	{ check_arg_type rank ty1
 	; check_arg_type rank ty2 }
 
-check_type rank ubx_tup ty@(TyConApp tc tys)
+check_type rank ty@(TyConApp tc tys)
   | isSynTyCon tc
   = do	{ 	-- Check that the synonym has enough args
 		-- This applies equally to open and closed synonyms
@@ -1030,38 +1014,34 @@ check_type rank ubx_tup ty@(TyConApp tc tys)
 
 	  else	-- In the liberal case (only for closed syns), expand then check
 	  case tcView ty of   
-	     Just ty' -> check_type rank ubx_tup ty' 
+	     Just ty' -> check_type rank ty' 
 	     Nothing  -> pprPanic "check_tau_type" (ppr ty)
     }
     
   | isUnboxedTupleTyCon tc
   = do	{ ub_tuples_allowed <- xoptM Opt_UnboxedTuples
-	; checkTc (ubx_tup_ok ub_tuples_allowed) ubx_tup_msg
+	; checkTc ub_tuples_allowed ubx_tup_msg
 
 	; impred <- xoptM Opt_ImpredicativeTypes	
 	; let rank' = if impred then ArbitraryRank else tyConArgMonoType
 		-- c.f. check_arg_type
 		-- However, args are allowed to be unlifted, or
 		-- more unboxed tuples, so can't use check_arg_ty
-	; mapM_ (check_type rank' UT_Ok) tys }
+	; mapM_ (check_type rank') tys }
 
   | otherwise
   = mapM_ (check_arg_type rank) tys
 
   where
-    ubx_tup_ok ub_tuples_allowed = case ubx_tup of
-                                   UT_Ok -> ub_tuples_allowed
-                                   _     -> False
-
     n_args    = length tys
     tc_arity  = tyConArity tc
 
     arity_msg   = arityErr "Type synonym" (tyConName tc) tc_arity n_args
     ubx_tup_msg = ubxArgTyErr ty
 
-check_type _ _ (LitTy {}) = return ()
+check_type _ (LitTy {}) = return ()
 
-check_type _ _ ty = pprPanic "check_type" (ppr ty)
+check_type _ ty = pprPanic "check_type" (ppr ty)
 
 ----------------------------------------
 check_arg_type :: Rank -> KindOrType -> TcM ()
@@ -1096,7 +1076,7 @@ check_arg_type rank ty
 			--    (Ord (forall a.a)) => a -> a
 			-- and so that if it Must be a monotype, we check that it is!
 
-	; check_type rank' UT_NotOk ty
+	; check_type rank' ty
 	; checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty) }
              -- NB the isUnLiftedType test also checks for 
              --    T State#
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 38ef6bc380..8f5287b9f6 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -276,20 +276,7 @@ warnPrags id bad_sigs herald
 -----------------
 mkLocalBinder :: Name -> TcType -> TcM TcId
 mkLocalBinder name ty
-  = do { checkUnboxedTuple ty $ 
-            ptext (sLit "The variable") <+> quotes (ppr name)
-       ; return (Id.mkLocalId name ty) }
-
-checkUnboxedTuple :: TcType -> SDoc -> TcM ()
--- Check for an unboxed tuple type
---      f = (# True, False #)
--- Zonk first just in case it's hidden inside a meta type variable
--- (This shows up as a (more obscure) kind error 
---  in the 'otherwise' case of tcMonoBinds.)
-checkUnboxedTuple ty what
-  = do { zonked_ty <- zonkTcType ty
-       ; checkTc (not (isUnboxedTupleType zonked_ty))
-                 (unboxedTupleErr what zonked_ty) }
+  = return (Id.mkLocalId name ty)
 \end{code}
 
 Note [Polymorphism and pattern bindings]
@@ -413,9 +400,7 @@ tc_pat _ p@(QuasiQuotePat _) _ _
   = pprPanic "Should never see QuasiQuotePat in type checker" (ppr p)
 
 tc_pat _ (WildPat _) pat_ty thing_inside
-  = do	{ checkUnboxedTuple pat_ty $
-               ptext (sLit "A wild-card pattern")
-        ; res <- thing_inside 
+  = do	{ res <- thing_inside 
 	; return (WildPat pat_ty, res) }
 
 tc_pat penv (AsPat (L nm_loc name) pat) pat_ty thing_inside
@@ -431,11 +416,9 @@ tc_pat penv (AsPat (L nm_loc name) pat) pat_ty thing_inside
 	    -- If you fix it, don't forget the bindInstsOfPatIds!
 	; return (mkHsWrapPatCo co (AsPat (L nm_loc bndr_id) pat') pat_ty, res) }
 
-tc_pat penv vpat@(ViewPat expr pat _) overall_pat_ty thing_inside 
-  = do	{ checkUnboxedTuple overall_pat_ty $
-               ptext (sLit "The view pattern") <+> ppr vpat
-
-	 -- Morally, expr must have type `forall a1...aN. OPT' -> B` 
+tc_pat penv (ViewPat expr pat _) overall_pat_ty thing_inside 
+  = do	{
+         -- Morally, expr must have type `forall a1...aN. OPT' -> B` 
          -- where overall_pat_ty is an instance of OPT'.
          -- Here, we infer a rho type for it,
          -- which replaces the leading foralls and constraints
@@ -1060,9 +1043,4 @@ lazyUnliftedPatErr pat
   = failWithTc $
     hang (ptext (sLit "A lazy (~) pattern cannot contain unlifted types:"))
        2 (ppr pat)
-
-unboxedTupleErr :: SDoc -> Type -> SDoc
-unboxedTupleErr what ty
-  = hang (what <+> ptext (sLit "cannot have an unboxed tuple type:"))
-       2 (ppr ty)
 \end{code}
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 08c5cdb0ec..bde75027c0 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -44,6 +44,7 @@ import UniqSupply
 import Unique
 import UniqFM
 import DynFlags
+import Maybes
 import StaticFlags
 import FastString
 import Panic
@@ -185,6 +186,9 @@ initTcPrintErrors       -- Used from the interactive loop only
        -> IO (Messages, Maybe r)
 
 initTcPrintErrors env mod todo = initTc env HsSrcFile False mod todo
+
+initTcForLookup :: HscEnv -> TcM a -> IO a
+initTcForLookup hsc_env = liftM (expectJust "initTcInteractive" . snd) . initTc hsc_env HsSrcFile False iNTERACTIVE
 \end{code}
 
 %************************************************************************
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 8f1bc76222..61540026a5 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -119,6 +119,7 @@ import DynFlags
 import Outputable
 import ListSetOps
 import FastString
+import Util
 
 import Data.Set (Set)
 
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 1bdc0bf5a5..c02f885edf 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -66,7 +66,7 @@ import Serialized
 import ErrUtils
 import SrcLoc
 import Outputable
-import Util             ( dropList )
+import Util
 import Data.List        ( mapAccumL )
 import Pair
 import Unique
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index da55e72a54..effc30d946 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -115,10 +115,10 @@ module TcType (
   --------------------------------
   -- Rexported from Kind
   Kind, typeKind,
-  unliftedTypeKind, liftedTypeKind, argTypeKind,
+  unliftedTypeKind, liftedTypeKind,
   openTypeKind, constraintKind, mkArrowKind, mkArrowKinds, 
   isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind, 
-  isSubArgTypeKind, tcIsSubKind, splitKindFunTys, defaultKind,
+  tcIsSubKind, splitKindFunTys, defaultKind,
   mkMetaKindVar,
 
   --------------------------------
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index c44ce31f2e..29f46f629c 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -159,7 +159,7 @@ matchExpectedFunTys herald arity orig_ty
     ------------
     defer n_req fun_ty 
       = addErrCtxtM mk_ctxt $
-        do { arg_tys <- newFlexiTyVarTys n_req argTypeKind
+        do { arg_tys <- newFlexiTyVarTys n_req openTypeKind
            ; res_ty  <- newFlexiTyVarTy openTypeKind
            ; co   <- unifyType fun_ty (mkFunTys arg_tys res_ty)
            ; return (co, arg_tys, res_ty) }
diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index e28a3fb53e..21e1acd3e7 100644
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.lhs
@@ -32,6 +32,7 @@ import Outputable
 import ErrUtils
 import BasicTypes
 import UniqFM
+import Util
 import Id
 import FastString
 import Data.Data        ( Data, Typeable )
diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs
index 21e828e99c..5f567eba36 100644
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.lhs
@@ -15,15 +15,13 @@ module Kind (
         SuperKind, Kind, typeKind,
 
 	-- Kinds
-	anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind,
-        argTypeKind, ubxTupleKind, constraintKind,
+	anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind,
         mkArrowKind, mkArrowKinds,
         typeNatKind, typeStringKind,
 
         -- Kind constructors...
         anyKindTyCon, liftedTypeKindTyCon, openTypeKindTyCon,
-        unliftedTypeKindTyCon, argTypeKindTyCon, ubxTupleKindTyCon,
-        constraintKindTyCon,
+        unliftedTypeKindTyCon, constraintKindTyCon,
 
         -- Super Kinds
 	superKind, superKindTyCon, 
@@ -36,14 +34,13 @@ module Kind (
 
         -- ** Predicates on Kinds
         isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
-        isUbxTupleKind, isArgTypeKind, isConstraintKind,
-        isConstraintOrLiftedKind, isKind, isKindVar,
+        isConstraintKind, isConstraintOrLiftedKind, isKind, isKindVar,
         isSuperKind, isSuperKindTyCon,
         isLiftedTypeKindCon, isConstraintKindCon,
         isAnyKind, isAnyKindCon,
         okArrowArgKind, okArrowResultKind,
 
-        isSubArgTypeKind, isSubOpenTypeKind, 
+        isSubOpenTypeKind, 
         isSubKind, isSubKindCon, 
         tcIsSubKind, tcIsSubKindCon,
         defaultKind,
@@ -63,6 +60,7 @@ import TyCon
 import VarSet
 import PrelNames
 import Outputable
+import Util
 \end{code}
 
 %************************************************************************
@@ -107,11 +105,10 @@ synTyConResKind :: TyCon -> Kind
 synTyConResKind tycon = kindAppResult (tyConKind tycon) (map mkTyVarTy (tyConTyVars tycon))
 
 -- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's
-isUbxTupleKind, isOpenTypeKind, isArgTypeKind, isUnliftedTypeKind,
+isOpenTypeKind, isUnliftedTypeKind,
   isConstraintKind, isAnyKind, isConstraintOrLiftedKind :: Kind -> Bool
 
-isOpenTypeKindCon, isUbxTupleKindCon, isArgTypeKindCon,
-  isUnliftedTypeKindCon, isSubArgTypeKindCon, 
+isOpenTypeKindCon, isUnliftedTypeKindCon,
   isSubOpenTypeKindCon, isConstraintKindCon,
   isLiftedTypeKindCon, isAnyKindCon :: TyCon -> Bool
 
@@ -119,8 +116,6 @@ isOpenTypeKindCon, isUbxTupleKindCon, isArgTypeKindCon,
 isLiftedTypeKindCon   tc = tyConUnique tc == liftedTypeKindTyConKey
 isAnyKindCon          tc = tyConUnique tc == anyKindTyConKey
 isOpenTypeKindCon     tc = tyConUnique tc == openTypeKindTyConKey
-isUbxTupleKindCon     tc = tyConUnique tc == ubxTupleKindTyConKey
-isArgTypeKindCon      tc = tyConUnique tc == argTypeKindTyConKey
 isUnliftedTypeKindCon tc = tyConUnique tc == unliftedTypeKindTyConKey
 isConstraintKindCon   tc = tyConUnique tc == constraintKindTyConKey
 
@@ -130,12 +125,6 @@ isAnyKind _               = False
 isOpenTypeKind (TyConApp tc _) = isOpenTypeKindCon tc
 isOpenTypeKind _               = False
 
-isUbxTupleKind (TyConApp tc _) = isUbxTupleKindCon tc
-isUbxTupleKind _               = False
-
-isArgTypeKind (TyConApp tc _) = isArgTypeKindCon tc
-isArgTypeKind _               = False
-
 isUnliftedTypeKind (TyConApp tc _) = isUnliftedTypeKindCon tc
 isUnliftedTypeKind _               = False
 
@@ -158,10 +147,7 @@ okArrowArgKindCon kc
   | isConstraintKindCon   kc = True
   | otherwise                = False
 
-okArrowResultKindCon kc
-  | okArrowArgKindCon kc = True
-  | isUbxTupleKindCon kc = True
-  | otherwise            = False
+okArrowResultKindCon = okArrowArgKindCon
 
 okArrowArgKind, okArrowResultKind :: Kind -> Bool
 okArrowArgKind    (TyConApp kc []) = okArrowArgKindCon kc
@@ -181,23 +167,13 @@ isSubOpenTypeKind (TyConApp kc []) = isSubOpenTypeKindCon kc
 isSubOpenTypeKind _                = False
 
 isSubOpenTypeKindCon kc
-  =  isSubArgTypeKindCon kc
-  || isUbxTupleKindCon   kc
-  || isOpenTypeKindCon   kc
-
-isSubArgTypeKindCon kc
-  =  isUnliftedTypeKindCon kc
+  =  isOpenTypeKindCon   kc
+  || isUnliftedTypeKindCon kc
   || isLiftedTypeKindCon   kc  
-  || isArgTypeKindCon      kc     
   || isConstraintKindCon kc   -- Needed for error (Num a) "blah"
                               -- and so that (Ord a -> Eq a) is well-kinded
                               -- and so that (# Eq a, Ord b #) is well-kinded
 
-isSubArgTypeKind :: Kind -> Bool
--- ^ True of any sub-kind of ArgTypeKind 
-isSubArgTypeKind (TyConApp kc []) = isSubArgTypeKindCon kc
-isSubArgTypeKind _                = False
-
 -- | Is this a kind (i.e. a type-of-types)?
 isKind :: Kind -> Bool
 isKind k = isSuperKind (typeKind k)
@@ -233,7 +209,6 @@ isSubKindCon :: TyCon -> TyCon -> Bool
 -- ^ @kc1 \`isSubKindCon\` kc2@ checks that @kc1@ <: @kc2@
 isSubKindCon kc1 kc2
   | kc1 == kc2            = True
-  | isArgTypeKindCon  kc2 = isSubArgTypeKindCon  kc1
   | isOpenTypeKindCon kc2 = isSubOpenTypeKindCon kc1 
   | otherwise             = False
 
@@ -281,7 +256,6 @@ defaultKind :: Kind -> Kind
 -- The test is really whether the kind is strictly above '*'
 defaultKind (TyConApp kc _args)
   | isOpenTypeKindCon kc = ASSERT( null _args ) liftedTypeKind
-  | isArgTypeKindCon  kc = ASSERT( null _args ) liftedTypeKind
 defaultKind k = k
 
 -- Returns the free kind variables in a kind
diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs
index 4880e68a3a..7d707c33c4 100644
--- a/compiler/types/OptCoercion.lhs
+++ b/compiler/types/OptCoercion.lhs
@@ -26,6 +26,7 @@ import Outputable
 import Pair
 import Maybes( allMaybes )
 import FastString
+import Util
 \end{code}
 
 %************************************************************************
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 62cc7bbfd1..4726f26213 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -82,13 +82,11 @@ module Type (
         
         -- ** Common Kinds and SuperKinds
         anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind,
-        argTypeKind, ubxTupleKind, constraintKind,
-        superKind, 
+        constraintKind, superKind, 
 
         -- ** Common Kind type constructors
         liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
-        argTypeKindTyCon, ubxTupleKindTyCon, constraintKindTyCon,
-        anyKindTyCon,
+        constraintKindTyCon, anyKindTyCon,
 
 	-- * Type free variables
 	tyVarsOfType, tyVarsOfTypes,
@@ -105,12 +103,10 @@ module Type (
         -- * Other views onto Types
         coreView, tcView, 
 
-        repType, deepRepType,
+        UnaryType, RepType(..), flattenRepType, repType,
 
 	-- * Type representation for the code generator
-	PrimRep(..),
-
-	typePrimRep,
+	typePrimRep, typeRepArity,
 
 	-- * Main type substitution data types
 	TvSubstEnv,	-- Representation widely visible
@@ -162,7 +158,7 @@ import PrelNames	         ( eqTyConKey )
 -- others
 import {-# SOURCE #-} IParam ( ipTyCon )
 import Unique		( Unique, hasKey )
-import BasicTypes	( IPName(..) )
+import BasicTypes	( Arity, RepArity, IPName(..) )
 import Name		( Name )
 import NameSet
 import StaticFlags
@@ -616,7 +612,27 @@ newtype at outermost level; and bale out if we see it again.
 		Representation types
 		~~~~~~~~~~~~~~~~~~~~
 
+Note [Nullary unboxed tuple]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We represent the nullary unboxed tuple as the unary (but void) type State# RealWorld.
+The reason for this is that the ReprArity is never less than the Arity (as it would
+otherwise be for a function type like (# #) -> Int).
+
+As a result, ReprArity is always strictly positive if Arity is. This is important
+because it allows us to distinguish at runtime between a thunk and a function
+ takes a nullary unboxed tuple as an argument!
+
 \begin{code}
+type UnaryType = Type
+
+data RepType = UbxTupleRep [UnaryType] -- INVARIANT: never an empty list (see Note [Nullary unboxed tuple])
+             | UnaryRep UnaryType
+
+flattenRepType :: RepType -> [UnaryType]
+flattenRepType (UbxTupleRep tys) = tys
+flattenRepType (UnaryRep ty)     = [ty]
+
 -- | Looks through:
 --
 --	1. For-alls
@@ -625,29 +641,11 @@ newtype at outermost level; and bale out if we see it again.
 --	4. All newtypes, including recursive ones, but not newtype families
 --
 -- It's useful in the back end of the compiler.
-repType :: Type -> Type
+repType :: Type -> RepType
 repType ty
   = go emptyNameSet ty
   where
-    go :: NameSet -> Type -> Type
-    go rec_nts ty    	  		-- Expand predicates and synonyms
-      | Just ty' <- coreView ty
-      = go rec_nts ty'
-
-    go rec_nts (ForAllTy _ ty)		-- Drop foralls
-	= go rec_nts ty
-
-    go rec_nts (TyConApp tc tys)	-- Expand newtypes
-      | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
-      = go rec_nts' ty'
-
-    go _ ty = ty
-
-deepRepType :: Type -> Type
--- Same as repType, but looks recursively
-deepRepType ty
-  = go emptyNameSet ty
-  where
+    go :: NameSet -> Type -> RepType
     go rec_nts ty    	  		-- Expand predicates and synonyms
       | Just ty' <- coreView ty
       = go rec_nts ty'
@@ -659,12 +657,12 @@ deepRepType ty
       | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
       = go rec_nts' ty'
 
-      -- Apply recursively; this is the "deep" bit
-    go rec_nts (TyConApp tc tys) = TyConApp tc (map (go rec_nts) tys)
-    go rec_nts (AppTy ty1 ty2)   = mkAppTy (go rec_nts ty1) (go rec_nts ty2)
-    go rec_nts (FunTy ty1 ty2)   = FunTy   (go rec_nts ty1) (go rec_nts ty2)
+      | isUnboxedTupleTyCon tc
+      = if null tys
+         then UnaryRep realWorldStatePrimTy -- See Note [Nullary unboxed tuple]
+         else UbxTupleRep (concatMap (flattenRepType . go rec_nts) tys)
 
-    go _ ty = ty
+    go _ ty = UnaryRep ty
 
 carefullySplitNewType_maybe :: NameSet -> TyCon -> [Type] -> Maybe (NameSet,Type)
 -- Return the representation of a newtype, unless 
@@ -684,15 +682,23 @@ carefullySplitNewType_maybe rec_nts tc tys
 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 -- of inspecting the type directly.
 
--- | Discovers the primitive representation of a more abstract 'Type'
--- Only applied to types of values
-typePrimRep :: Type -> PrimRep
-typePrimRep ty = case repType ty of
-		   TyConApp tc _ -> tyConPrimRep tc
-		   FunTy _ _	 -> PtrRep
-		   AppTy _ _	 -> PtrRep	-- See Note [AppTy rep] 
-		   TyVarTy _	 -> PtrRep
-		   _             -> pprPanic "typePrimRep" (ppr ty)
+-- | Discovers the primitive representation of a more abstract 'UnaryType'
+typePrimRep :: UnaryType -> PrimRep
+typePrimRep ty
+  = case repType ty of
+      UbxTupleRep _ -> pprPanic "typePrimRep: UbxTupleRep" (ppr ty)
+      UnaryRep rep -> case rep of
+        TyConApp tc _ -> tyConPrimRep tc
+        FunTy _ _     -> PtrRep
+        AppTy _ _     -> PtrRep      -- See Note [AppTy rep] 
+        TyVarTy _     -> PtrRep
+        _             -> pprPanic "typePrimRep: UnaryRep" (ppr ty)
+
+typeRepArity :: Arity -> Type -> RepArity
+typeRepArity 0 _ = 0
+typeRepArity n ty = case repType ty of
+  UnaryRep (FunTy ty1 ty2) -> length (flattenRepType (repType ty1)) + typeRepArity (n - 1) ty2
+  _                        -> pprPanic "typeRepArity: arity greater than type can handle" (ppr (n, ty))
 \end{code}
 
 Note [AppTy rep]
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 605c97fcc4..3605851101 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -71,6 +71,7 @@ import Outputable
 import FastString
 import Pair
 import StaticFlags( opt_PprStyle_Debug )
+import Util
 
 -- libraries
 import qualified Data.Data        as Data hiding ( TyCon )
@@ -158,9 +159,7 @@ Note [The kind invariant]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 The kinds
    #          UnliftedTypeKind
-   ArgKind    super-kind of *, #
-   (#)        UbxTupleKind
-   OpenKind   super-kind of ArgKind, ubxTupleKind
+   OpenKind   super-kind of *, #
 
 can never appear under an arrow or type constructor in a kind; they
 can only be at the top level of a kind.  It follows that primitive TyCons,
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 3130f7175f..9076913751 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -78,7 +78,7 @@ import FastString
 import FastTypes
 import Platform
 import qualified Pretty
-import Util             ( snocView )
+import Util
 import Pretty           ( Doc, Mode(..) )
 import Panic
 
@@ -936,6 +936,7 @@ pprPanicFastInt heading pretty_msg =
 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
 -- ^ Just warn about an assertion failure, recording the given file and line number.
 -- Should typically be accessed with the WARN macros
+warnPprTrace _     _     _     _    x | not debugIsOn     = x
 warnPprTrace _     _file _line _msg x | opt_NoDebugOutput = x
 warnPprTrace False _file _line _msg x = x
 warnPprTrace True   file  line  msg x
diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index 1716a26b46..42594c8109 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -8,20 +8,13 @@ It's hard to put these functions anywhere else without causing
 some unnecessary loops in the module dependency graph.
 
 \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 Panic (
      GhcException(..), showGhcException, throwGhcException, handleGhcException,
      ghcError, progName,
      pgmError,
 
      panic, sorry, panicFastInt, assertPanic, trace,
-     
+
      Exception.Exception(..), showException, safeShowException, try, tryMost, throwTo,
 
      installSignalHandlers,
@@ -37,7 +30,7 @@ import Data.Dynamic
 #if __GLASGOW_HASKELL__ < 705
 import Data.Maybe
 #endif
-import Debug.Trace	  ( trace )
+import Debug.Trace        ( trace )
 import System.IO.Unsafe
 import System.Exit
 import System.Environment
@@ -62,31 +55,31 @@ import System.Mem.Weak  ( Weak, deRefWeak )
 --   error messages all take the form:
 --
 --  @
---	<location>: <error>
+--      <location>: <error>
 --  @
--- 
---   If the location is on the command line, or in GHC itself, then 
---   <location>="ghc".  All of the error types below correspond to 
+--
+--   If the location is on the command line, or in GHC itself, then
+--   <location>="ghc".  All of the error types below correspond to
 --   a <location> of "ghc", except for ProgramError (where the string is
 --  assumed to contain a location already, so we don't print one).
 
 data GhcException
-  = PhaseFailed  String		-- name of phase 
-  		 ExitCode	-- an external phase (eg. cpp) failed
+  = PhaseFailed  String         -- name of phase
+                 ExitCode       -- an external phase (eg. cpp) failed
 
   -- | Some other fatal signal (SIGHUP,SIGTERM)
-  | Signal Int 
+  | Signal Int
 
   -- | Prints the short usage msg after the error
-  | UsageError   String		
+  | UsageError   String
 
   -- | A problem with the command line arguments, but don't print usage.
   | CmdLineError String
 
   -- | The 'impossible' happened.
-  | Panic        String		
+  | Panic        String
 
-  -- | The user tickled something that's known not to work yet, 
+  -- | The user tickled something that's known not to work yet,
   --   but we're not counting it as a bug.
   | Sorry        String
 
@@ -137,36 +130,36 @@ safeShowException e = do
 showGhcException :: GhcException -> String -> String
 showGhcException exception
  = case exception of
-	UsageError str
-   	 -> showString str . showChar '\n' . showString short_usage
-
-	PhaseFailed phase code
-	 -> showString "phase `" . showString phase . 
-	    showString "' failed (exitcode = " . shows (int_code code) . 
-	    showString ")"
-
-	CmdLineError str	-> showString str
-	ProgramError str	-> showString str
-	InstallationError str	-> showString str
-	Signal n		-> showString "signal: " . shows n
-
-	Panic s
-	 -> showString $
-		"panic! (the 'impossible' happened)\n"
-		++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
-	        ++ s ++ "\n\n"
-	        ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n"
-
-	Sorry s
-   	 -> showString $
-		"sorry! (unimplemented feature or known bug)\n"
-		 ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
-	         ++ s ++ "\n"
-
-  where	int_code code = 
-      	  case code of
-        	ExitSuccess   -> (0::Int)
-		ExitFailure x -> x
+        UsageError str
+         -> showString str . showChar '\n' . showString short_usage
+
+        PhaseFailed phase code
+         -> showString "phase `" . showString phase .
+            showString "' failed (exitcode = " . shows (int_code code) .
+            showString ")"
+
+        CmdLineError str        -> showString str
+        ProgramError str        -> showString str
+        InstallationError str   -> showString str
+        Signal n                -> showString "signal: " . shows n
+
+        Panic s
+         -> showString $
+                "panic! (the 'impossible' happened)\n"
+                ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
+                ++ s ++ "\n\n"
+                ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n"
+
+        Sorry s
+         -> showString $
+                "sorry! (unimplemented feature or known bug)\n"
+                 ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
+                 ++ s ++ "\n"
+
+  where int_code code =
+          case code of
+                ExitSuccess   -> (0::Int)
+                ExitFailure x -> x
 
 
 -- | Alias for `throwGhcException`
@@ -205,8 +198,8 @@ panicFastInt s = case (panic s) of () -> _ILIT(0)
 
 -- | Throw an failed assertion exception for a given filename and line number.
 assertPanic :: String -> Int -> a
-assertPanic file line = 
-  Exception.throw (Exception.AssertionFailed 
+assertPanic file line =
+  Exception.throw (Exception.AssertionFailed
            ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
 
 
@@ -253,7 +246,7 @@ installSignalHandlers = do
 
   --
 #if !defined(mingw32_HOST_OS)
-  _ <- installHandler sigQUIT  (Catch interrupt) Nothing 
+  _ <- installHandler sigQUIT  (Catch interrupt) Nothing
   _ <- installHandler sigINT   (Catch interrupt) Nothing
   -- see #3656; in the future we should install these automatically for
   -- all Haskell programs in the same way that we install a ^C handler.
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 12249d3a2b..d87f526bc8 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -19,7 +19,7 @@ module Util (
         unzipWith,
 
         mapFst, mapSnd,
-        mapAndUnzip, mapAndUnzip3,
+        mapAndUnzip, mapAndUnzip3, mapAccumL2,
         nOfThem, filterOut, partitionWith, splitEithers,
 
         foldl1', foldl2, count, all2,
@@ -35,6 +35,7 @@ module Util (
         -- * Tuples
         fstOf3, sndOf3, thirdOf3,
         firstM, first3M,
+        third3,
         uncurry3,
 
         -- * List operations controlled by another list
@@ -224,6 +225,9 @@ fstOf3      (a,_,_) =  a
 sndOf3      (_,b,_) =  b
 thirdOf3    (_,_,c) =  c
 
+third3 :: (c -> d) -> (a, b, c) -> (a, b, d)
+third3 f (a, b, c) = (a, b, f c)
+
 uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
 uncurry3 f (a, b, c) = f a b c
 \end{code}
@@ -353,6 +357,12 @@ mapAndUnzip3 f (x:xs)
         (rs1, rs2, rs3) = mapAndUnzip3 f xs
     in
     (r1:rs1, r2:rs2, r3:rs3)
+
+mapAccumL2 :: (s1 -> s2 -> a -> (s1, s2, b)) -> s1 -> s2 -> [a] -> (s1, s2, [b])
+mapAccumL2 f s1 s2 xs = (s1', s2', ys)
+  where ((s1', s2'), ys) = mapAccumL (\(s1, s2) x -> case f s1 s2 x of
+                                                       (s1', s2', y) -> ((s1', s2'), y))
+                                     (s1, s2) xs
 \end{code}
 
 \begin{code}
diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
index e75cf0e009..c984c10a24 100644
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ b/compiler/vectorise/Vectorise/Exp.hs
@@ -49,6 +49,7 @@ import Data.Maybe
 import Data.List
 import TcRnMonad (doptM)
 import DynFlags (DynFlag(Opt_AvoidVect))
+import Util
 
 
 -- Main entry point to vectorise expressions -----------------------------------
diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
index 971fd8ff1f..546da3387e 100644
--- a/compiler/vectorise/Vectorise/Monad/InstEnv.hs
+++ b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
@@ -14,6 +14,7 @@ import Class
 import Type
 import TyCon
 import Outputable
+import Util
 
 
 #include "HsVersions.h"
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 8c1f5ec5ce..7e83565b1a 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -50,8 +50,7 @@ import Maybes ( orElse, expectJust )
 import NameSet
 import Panic hiding ( showException )
 import StaticFlags
-import Util ( on, global, toArgs, toCmdArgs, removeSpaces, getCmd,
-              filterOut, seqList, looksLikeModuleName, partitionWith )
+import Util
 
 -- Haskell Libraries
 import System.Console.Haskeline as Haskeline