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

17 files changed, 207 insertions, 204 deletions

diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index a62d8a8e1f..e66fbeb008 100644
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -58,7 +58,7 @@ module Id (
 	hasNoBinding, 
 
 	-- ** Evidence variables
-	DictId, isDictId, isEvVar, evVarPred,
+	DictId, isDictId, isCertainlyEvVar,
 
 	-- ** Inline pragma stuff
 	idInlinePragma, setInlinePragma, modifyInlinePragma,
@@ -98,7 +98,7 @@ import IdInfo
 import BasicTypes
 
 -- Imported and re-exported 
-import Var( Var, Id, DictId, EvVar,
+import Var( Var, Id, DictId,
             idInfo, idDetails, globaliseId, varType,
             isId, isLocalId, isGlobalId, isExportedId )
 import qualified Var
@@ -447,17 +447,11 @@ isTickBoxOp_maybe id =
 %************************************************************************
 
 \begin{code}
-isEvVar :: Var -> Bool
-isEvVar var = isPredTy (varType var)
+isCertainlyEvVar :: Var -> Bool
+isCertainlyEvVar var = isCertainlyPredReprTy (varType var)
 
 isDictId :: Id -> Bool
 isDictId id = isDictTy (idType id)
-
-evVarPred :: EvVar -> PredType
-evVarPred var
-  = case splitPredTy_maybe (varType var) of
-      Just pred -> pred
-      Nothing   -> pprPanic "evVarPred" (ppr var <+> ppr (varType var))
 \end{code}
 
 %************************************************************************
diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs
index 45cede5ca9..629754fcb5 100644
--- a/compiler/codeGen/CgTicky.hs
+++ b/compiler/codeGen/CgTicky.hs
@@ -60,6 +60,7 @@ import Module
 -- Turgid imports for showTypeCategory
 import PrelNames
 import TcType
+import Type
 import TyCon
 
 import DynFlags
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index e8642eb4e6..a02a698410 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -66,6 +66,7 @@ import DynFlags
 -- Turgid imports for showTypeCategory
 import PrelNames
 import TcType
+import Type
 import TyCon
 
 import Data.Maybe
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 55315c99ea..fe781eb348 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -630,7 +630,7 @@ isExpandableApp fn n_val_args
      go n_val_args ty 
        | Just (_, ty) <- splitForAllTy_maybe ty   = go n_val_args ty
        | Just (arg, ty) <- splitFunTy_maybe ty
-       , isPredTy arg                             = go (n_val_args-1) ty
+       , isCertainlyPredReprTy arg                = go (n_val_args-1) ty
        | otherwise                                = False
 \end{code}
 
@@ -1395,7 +1395,7 @@ tryEtaReduce bndrs body
        | otherwise = idArity fun   	      
 
     ---------------
-    ok_lam v = isTyVar v || isEvVar v
+    ok_lam v = isTyVar v || isCertainlyEvVar v
 
     ---------------
     ok_arg :: Var              -- Of type bndr_t
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index a878e74c6b..36dc4eefb2 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -614,9 +614,9 @@ decomposeRuleLhs bndrs lhs
 			     , ptext (sLit "is not bound in RULE lhs")])
                       2 (ppr opt_lhs)
    pp_bndr bndr
-    | isTyVar bndr  = ptext (sLit "type variable") <+> quotes (ppr bndr)
-    | isEvVar bndr  = ptext (sLit "constraint") <+> quotes (ppr (evVarPred bndr))
-    | otherwise     = ptext (sLit "variable") <+> quotes (ppr bndr)
+    | isTyVar bndr                      = ptext (sLit "type variable") <+> quotes (ppr bndr)
+    | Just pred <- evVarPred_maybe bndr = ptext (sLit "constraint") <+> quotes (ppr pred)
+    | otherwise                         = ptext (sLit "variable") <+> quotes (ppr bndr)
 \end{code}
 
 Note [Simplifying the left-hand side of a RULE]
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index b1f50acfb8..ebd8d39a5a 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1666,15 +1666,13 @@ linkBinary dflags o_files dep_packages = do
                           then ["-Wl,--enable-auto-import"]
                           else [])
 
-                      -- '-no_pie' - On OS X, the linker otherwise complains that it cannot build 
-                      --             position independent code due to some offensive code in GMP.
                       -- '-no_compact_unwind'
                       --           - C++/Objective-C exceptions cannot use optimised stack
                       --             unwinding code (the optimised form is the default in Xcode 4 on
                       --             x86_64).
-                      ++ (if platformOS   (targetPlatform dflags) == OSDarwin   && 
+                      ++ (if platformOS   (targetPlatform dflags) == OSDarwin   &&
                              platformArch (targetPlatform dflags) == ArchX86_64
-                          then ["-Wl,-no_pie", "-Wl,-no_compact_unwind"]
+                          then ["-Wl,-no_compact_unwind"]
                           else [])
 
                       ++ o_files
diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 7cd493400f..ff536f5e78 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -10,6 +10,7 @@ module Specialise ( specProgram ) where
 
 import Id
 import TcType
+import Type
 import CoreMonad
 import CoreSubst 
 import CoreUnfold
diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index 07ada2bd04..a18ddb3375 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -8,7 +8,6 @@ module TcCanonical(
 #include "HsVersions.h"
 
 import BasicTypes
-import Id	( evVarPred )
 import TcErrors
 import TcRnTypes
 import FunDeps
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 7ed7145863..2f258340c9 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -22,7 +22,7 @@ import InstEnv
 import TyCon
 import Name
 import NameEnv
-import Id	( idType, evVarPred )
+import Id	( idType )
 import Var
 import VarSet
 import VarEnv
diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 627fc02f95..6962a19dbc 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -1510,7 +1510,7 @@ checkValidTypeInst typats rhs
          -- we have a decidable instance unless otherwise permitted
        ; undecidable_ok <- xoptM Opt_UndecidableInstances
        ; unless undecidable_ok $
-	   mapM_ addErrTc (checkFamInst typats (tyFamInsts rhs))
+	   mapM_ addErrTc (checkFamInst typats (tcTyFamInsts rhs))
        }
 
 -- Make sure that each type family instance is 
@@ -1548,7 +1548,7 @@ checkTyFamFreeness ty
 -- Check that a type does not contain any type family applications.
 --
 isTyFamFree :: Type -> Bool
-isTyFamFree = null . tyFamInsts
+isTyFamFree = null . tcTyFamInsts
 
 -- Error messages
 
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index c618da0a65..9ddb36b8c3 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -64,7 +64,6 @@ module TcRnTypes(
 import HsSyn
 import HscTypes
 import Type
-import Id	( evVarPred )
 import Class    ( Class )
 import DataCon  ( DataCon, dataConUserType )
 import TcType
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 07493dca45..eb5578eb15 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -15,7 +15,6 @@ import TcType
 import TcSMonad 
 import TcInteract
 import Inst
-import Id	( evVarPred )
 import Unify	( niFixTvSubst, niSubstTvSet )
 import Var
 import VarSet
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 6602c79f89..2526d22fa4 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -43,9 +43,10 @@ module TcType (
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
+  tcSplitPredTy_maybe,
   tcInstHeadTyNotSynonym, tcInstHeadTyAppAllTyVars,
   tcGetTyVar_maybe, tcGetTyVar,
-  tcSplitSigmaTy, tcDeepSplitSigmaTy_maybe, 
+  tcSplitSigmaTy, tcDeepSplitSigmaTy_maybe,  
 
   ---------------------------------
   -- Predicates. 
@@ -57,16 +58,25 @@ module TcType (
   isIntegerTy, isBoolTy, isUnitTy, isCharTy,
   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, 
   isSynFamilyTyConApp,
-
+  isPredTy, isTyVarClassPred,
+  
   ---------------------------------
   -- Misc type manipulators
   deNoteType,
   orphNamesOfType, orphNamesOfDFunHead, orphNamesOfCo,
   getDFunTyKey,
+  evVarPred_maybe, evVarPred,
 
   ---------------------------------
   -- Predicate types  
   mkMinimalBySCs, transSuperClasses, immSuperClasses,
+  getClassPredTys, getClassPredTys_maybe,
+
+  -- * Finding type instances
+  tcTyFamInsts,
+
+  -- * Finding "exact" (non-dead) type variables
+  exactTyVarsOfType, exactTyVarsOfTypes,
 
   -- * Tidying type related things up for printing
   tidyType,      tidyTypes,
@@ -111,12 +121,11 @@ module TcType (
   mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
   mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys, 
 
-  getClassPredTys_maybe, getClassPredTys, 
-  isClassPred, isTyVarClassPred, isEqPred, 
-  mkClassPred, mkIPPred, splitPredTy_maybe, 
-  mkDictTy, isPredTy, isDictTy, isDictLikeTy,
+  isClassPred, isEqPred, isIPPred,
+  mkClassPred, mkIPPred, mkDictTy,
+  isDictLikeTy,
   tcSplitDFunTy, tcSplitDFunHead, 
-  isIPPred, mkEqPred,
+  mkEqPred,
 
   -- Type substitutions
   TvSubst(..), 	-- Representation visible to a few friends
@@ -133,8 +142,7 @@ module TcType (
   isPrimitiveType, 
 
   tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-  tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred, exactTyVarsOfType,
-  exactTyVarsOfTypes, 
+  tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred,
 
   pprKind, pprParendKind,
   pprType, pprParendType, pprTypeApp, pprTyThingCategory,
@@ -561,6 +569,93 @@ tidyCos env = map (tidyCo env)
 \end{code}
 
 %************************************************************************
+%*                  *
+    Finding type family instances
+%*                  *
+%************************************************************************
+
+\begin{code}
+
+-- | Finds type family instances occuring in a type after expanding synonyms.
+tcTyFamInsts :: Type -> [(TyCon, [Type])]
+tcTyFamInsts ty 
+  | Just exp_ty <- tcView ty    = tcTyFamInsts exp_ty
+tcTyFamInsts (TyVarTy _)          = []
+tcTyFamInsts (TyConApp tc tys) 
+  | isSynFamilyTyCon tc           = [(tc, tys)]
+  | otherwise                   = concat (map tcTyFamInsts tys)
+tcTyFamInsts (FunTy ty1 ty2)      = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
+tcTyFamInsts (AppTy ty1 ty2)      = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
+tcTyFamInsts (ForAllTy _ ty)      = tcTyFamInsts ty
+tcTyFamInsts (PredTy pty)         = tcPredFamInsts pty
+
+-- | Finds type family instances occuring in a predicate type after expanding 
+-- synonyms.
+tcPredFamInsts :: PredType -> [(TyCon, [Type])]
+tcPredFamInsts (ClassP _cla tys) = concat (map tcTyFamInsts tys)
+tcPredFamInsts (IParam _ ty)     = tcTyFamInsts ty
+tcPredFamInsts (EqPred ty1 ty2)  = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
+
+\end{code}
+
+%************************************************************************
+%*                  *
+          The "exact" free variables of a type
+%*                  *
+%************************************************************************
+
+Note [Silly type synonym]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  type T a = Int
+What are the free tyvars of (T x)?  Empty, of course!  
+Here's the example that Ralf Laemmel showed me:
+  foo :: (forall a. C u a -> C u a) -> u
+  mappend :: Monoid u => u -> u -> u
+
+  bar :: Monoid u => u
+  bar = foo (\t -> t `mappend` t)
+We have to generalise at the arg to f, and we don't
+want to capture the constraint (Monad (C u a)) because
+it appears to mention a.  Pretty silly, but it was useful to him.
+
+exactTyVarsOfType is used by the type checker to figure out exactly
+which type variables are mentioned in a type.  It's also used in the
+smart-app checking code --- see TcExpr.tcIdApp
+
+On the other hand, consider a *top-level* definition
+  f = (\x -> x) :: T a -> T a
+If we don't abstract over 'a' it'll get fixed to GHC.Prim.Any, and then
+if we have an application like (f "x") we get a confusing error message 
+involving Any.  So the conclusion is this: when generalising
+  - at top level use tyVarsOfType
+  - in nested bindings use exactTyVarsOfType
+See Trac #1813 for example.
+
+\begin{code}
+exactTyVarsOfType :: Type -> TyVarSet
+-- Find the free type variables (of any kind)
+-- but *expand* type synonyms.  See Note [Silly type synonym] above.
+exactTyVarsOfType ty
+  = go ty
+  where
+    go ty | Just ty' <- tcView ty = go ty'  -- This is the key line
+    go (TyVarTy tv)         = unitVarSet tv
+    go (TyConApp _ tys)     = exactTyVarsOfTypes tys
+    go (PredTy ty)      = go_pred ty
+    go (FunTy arg res)      = go arg `unionVarSet` go res
+    go (AppTy fun arg)      = go fun `unionVarSet` go arg
+    go (ForAllTy tyvar ty)  = delVarSet (go ty) tyvar
+
+    go_pred (IParam _ ty)    = go ty
+    go_pred (ClassP _ tys)   = exactTyVarsOfTypes tys
+    go_pred (EqPred ty1 ty2) = go ty1 `unionVarSet` go ty2
+
+exactTyVarsOfTypes :: [Type] -> TyVarSet
+exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
+\end{code}
+
+%************************************************************************
 %*									*
 		Predicates
 %*									*
@@ -724,9 +819,8 @@ tcIsForAllTy _             = False
 
 tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
 -- Split off the first predicate argument from a type
-tcSplitPredFunTy_maybe ty | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
 tcSplitPredFunTy_maybe (FunTy arg res)
-  | Just p <- splitPredTy_maybe arg = Just (p, res)
+  | Just p <- tcSplitPredTy_maybe arg = Just (p, res)
 tcSplitPredFunTy_maybe _
   = Nothing
 
@@ -881,7 +975,7 @@ tcSplitDFunTy ty
 
 tcSplitDFunHead :: Type -> (Class, [Type])
 tcSplitDFunHead tau  
-  = case splitPredTy_maybe tau of 
+  = case tcSplitPredTy_maybe tau of 
 	Just (ClassP clas tys) -> (clas, tys)
 	_ -> pprPanic "tcSplitDFunHead" (ppr tau)
 
@@ -924,6 +1018,40 @@ tcInstHeadTyAppAllTyVars ty
 %*									*
 %************************************************************************
 
+Deconstructors and tests on predicate types
+
+\begin{code}
+tcSplitPredTy_maybe :: Type -> Maybe PredType
+-- Returns Just for predicates only
+tcSplitPredTy_maybe ty | Just ty' <- tcView ty = tcSplitPredTy_maybe ty'
+tcSplitPredTy_maybe (PredTy p)    = Just p
+tcSplitPredTy_maybe _             = Nothing
+
+isPredTy :: Type -> Bool
+isPredTy ty = isJust (tcSplitPredTy_maybe ty)
+
+isTyVarClassPred :: PredType -> Bool
+isTyVarClassPred (ClassP _ tys) = all isTyVarTy tys
+isTyVarClassPred _              = False
+
+getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
+getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
+getClassPredTys_maybe _                 = Nothing
+
+getClassPredTys :: PredType -> (Class, [Type])
+getClassPredTys (ClassP clas tys) = (clas, tys)
+getClassPredTys _ = panic "getClassPredTys"
+
+evVarPred_maybe :: EvVar -> Maybe PredType
+evVarPred_maybe = tcSplitPredTy_maybe . varType
+
+evVarPred :: EvVar -> PredType
+evVarPred var
+  = case evVarPred_maybe var of
+      Just pred -> pred
+      Nothing   -> pprPanic "tcEvVarPred" (ppr var <+> ppr (varType var))
+\end{code}
+
 Superclasses
 
 \begin{code}
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index cf458c7889..7d7280a6b8 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -462,11 +462,9 @@ splitForAllCo_maybe _                = Nothing
 -- and some coercion kind stuff
 
 coVarPred :: CoVar -> PredType
-coVarPred cv
-  = ASSERT( isCoVar cv )
-    case splitPredTy_maybe (varType cv) of
-	Just pred -> pred
-	other	  -> pprPanic "coVarPred" (ppr cv $$ ppr other)
+coVarPred cv = case coVarKind_maybe cv of
+  Just (ty1, ty2) -> mkEqPred (ty1, ty2)
+  Nothing         -> pprPanic "coVarPred" (ppr cv $$ ppr (varType cv))
 
 coVarKind :: CoVar -> (Type,Type) 
 -- c :: t1 ~ t2
@@ -475,7 +473,9 @@ coVarKind cv = case coVarKind_maybe cv of
                  Nothing -> pprPanic "coVarKind" (ppr cv $$ ppr (tyVarKind cv))
 
 coVarKind_maybe :: CoVar -> Maybe (Type,Type) 
-coVarKind_maybe cv = splitEqPredTy_maybe (varType cv)
+coVarKind_maybe cv = case splitTyConApp_maybe (varType cv) of
+  Just (tc, [ty1, ty2]) | tc `hasKey` eqPredPrimTyConKey -> Just (ty1, ty2)
+  _ -> Nothing
 
 -- | Makes a coercion type from two types: the types whose equality 
 -- is proven by the relevant 'Coercion'
diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs
index 5d0eb58f4e..c5b3e2955a 100644
--- a/compiler/types/OptCoercion.lhs
+++ b/compiler/types/OptCoercion.lhs
@@ -9,6 +9,7 @@ module OptCoercion ( optCoercion ) where
 
 import Coercion
 import Type hiding( substTyVarBndr, substTy, extendTvSubst )
+import TcType       ( exactTyVarsOfType )
 import TyCon
 import Var
 import VarSet
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 2dc77824bd..db943d4fde 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -43,23 +43,18 @@ module Type (
 	-- (Newtypes)
 	newTyConInstRhs, carefullySplitNewType_maybe,
 	
-	-- (Type families)
-        tyFamInsts, predFamInsts,
-
-        -- Pred types
+	-- Pred types
+        isClassPred, isEqPred, isIPPred,
         mkPredTy, mkPredTys, mkFamilyTyConApp,
-	mkDictTy, isDictLikeTy, isClassPred,
-        isEqPred, allPred, mkEqPred, 
-	mkClassPred, getClassPredTys, getClassPredTys_maybe,
-	isTyVarClassPred, 
-	mkIPPred, isIPPred,
+	mkDictTy, isDictLikeTy,
+         mkEqPred, mkClassPred,
+	mkIPPred,
 
 	-- ** Common type constructors
         funTyCon,
 
         -- ** Predicates on types
-        isTyVarTy, isFunTy, isPredTy,
-	isDictTy, isEqPredTy, isReflPredTy, splitPredTy_maybe, splitEqPredTy_maybe, 
+        isTyVarTy, isFunTy, isDictTy, isCertainlyPredReprTy,
 
 	-- (Lifting and boxity)
 	isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType,
@@ -80,7 +75,7 @@ module Type (
 
 	-- * Type free variables
 	tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-	exactTyVarsOfType, exactTyVarsOfTypes, expandTypeSynonyms, 
+	expandTypeSynonyms, 
 	typeSize,
 
 	-- * Type comparison
@@ -143,9 +138,10 @@ import VarSet
 import Class
 import TyCon
 import TysPrim
+import PrelNames	( eqPredPrimTyConKey )
 
 -- others
-import Unique		( Unique )
+import Unique		( Unique, hasKey )
 import BasicTypes	( IPName )
 import Name		( Name )
 import NameSet
@@ -252,6 +248,9 @@ tcView :: Type -> Maybe Type
 tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys 
 			 = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
 tcView _                 = Nothing
+  -- You might think that tcView belows in TcType rather than Type, but unfortunately
+  -- it is needed by Unify, which is turn imported by Coercion (for MatchEnv and matchList).
+  -- So we will leave it here to avoid module loops.
 
 -----------------------------------------------
 expandTypeSynonyms :: Type -> Type
@@ -763,11 +762,6 @@ applyTysD doc orig_fun_ty arg_tys
 Polymorphic functions over Pred
 
 \begin{code}
-allPred :: (a -> Bool) -> Pred a -> Bool
-allPred p (ClassP _ ts)  = all p ts
-allPred p (IParam _ t)   = p t
-allPred p (EqPred t1 t2) = p t1 && p t2
-
 isClassPred :: Pred a -> Bool
 isClassPred (ClassP {}) = True
 isClassPred _            = False
@@ -797,70 +791,51 @@ predTypeRep (IParam _ ty)     = ty
 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 predTypeRep (EqPred ty1 ty2)  = mkTyConApp eqPredPrimTyCon [ty1,ty2]
 
-splitPredTy_maybe :: Type -> Maybe PredType
--- Returns Just for predicates only
-splitPredTy_maybe ty | Just ty' <- tcView ty = splitPredTy_maybe ty'
-splitPredTy_maybe (PredTy p)    = Just p
-splitPredTy_maybe _             = Nothing
-
-isPredTy :: Type -> Bool
-isPredTy ty = isJust (splitPredTy_maybe ty)
+-- We can't tell if a type originated from an IParam predicate, so
+-- this function is conservative. It is only used in the eta-contraction/expansion
+-- logic at the moment, so this doesn't matter a great deal.
+isCertainlyPredReprTy :: Type -> Bool
+isCertainlyPredReprTy ty | Just ty' <- coreView ty = isCertainlyPredReprTy ty'
+isCertainlyPredReprTy ty = case tyConAppTyCon_maybe ty of
+	Just tc -> tc `hasKey` eqPredPrimTyConKey || isClassTyCon tc
+	Nothing -> False
 \end{code}
 
 --------------------- Equality types ---------------------------------
 \begin{code}
-isReflPredTy :: Type -> Bool
-isReflPredTy ty = case splitPredTy_maybe ty of
-                    Just (EqPred ty1 ty2) -> ty1 `eqType` ty2
-                    _                     -> False
-
-splitEqPredTy_maybe :: Type -> Maybe (Type,Type)
-splitEqPredTy_maybe ty = case splitPredTy_maybe ty of
-                            Just (EqPred ty1 ty2) -> Just (ty1,ty2)
-                            _                     -> Nothing
-
-isEqPredTy :: Type -> Bool
-isEqPredTy ty = case splitPredTy_maybe ty of
-                  Just (EqPred {}) -> True
-		  _                -> False
-
 -- | Creates a type equality predicate
 mkEqPred :: (a, a) -> Pred a
 mkEqPred (ty1, ty2) = EqPred ty1 ty2
 \end{code}
 
+--------------------- Implicit parameters ---------------------------------
+
+\begin{code}
+mkIPPred :: IPName Name -> Type -> PredType
+mkIPPred ip ty = IParam ip ty
+\end{code}
+
 --------------------- Dictionary types ---------------------------------
 \begin{code}
 mkClassPred :: Class -> [Type] -> PredType
 mkClassPred clas tys = ClassP clas tys
 
-isDictTy :: Type -> Bool
-isDictTy ty = case splitPredTy_maybe ty of
-                Just p  -> isClassPred p
-		Nothing -> False
-
-isTyVarClassPred :: PredType -> Bool
-isTyVarClassPred (ClassP _ tys) = all isTyVarTy tys
-isTyVarClassPred _              = False
-
-getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
-getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
-getClassPredTys_maybe _                 = Nothing
-
-getClassPredTys :: PredType -> (Class, [Type])
-getClassPredTys (ClassP clas tys) = (clas, tys)
-getClassPredTys _ = panic "getClassPredTys"
-
 mkDictTy :: Class -> [Type] -> Type
 mkDictTy clas tys = mkPredTy (ClassP clas tys)
 
+isDictTy :: Type -> Bool
+isDictTy ty | Just ty' <- coreView ty = isDictTy ty'
+isDictTy ty = case tyConAppTyCon_maybe ty of
+	Just tyCon -> isClassTyCon tyCon
+	_		   -> False
+
 isDictLikeTy :: Type -> Bool
 -- Note [Dictionary-like types]
-isDictLikeTy ty | Just ty' <- tcView ty = isDictTy ty'
-isDictLikeTy (PredTy p) = isClassPred p
-isDictLikeTy (TyConApp tc tys) 
-  | isTupleTyCon tc     = all isDictLikeTy tys
-isDictLikeTy _          = False
+isDictLikeTy ty | Just ty' <- coreView ty = isDictLikeTy ty'
+isDictLikeTy ty = case splitTyConApp_maybe ty of
+	Just (tc, tys) | isClassTyCon tc -> True
+	 			   | isTupleTyCon tc -> all isDictLikeTy tys
+	_other                           -> False
 \end{code}
 
 Note [Dictionary-like types]
@@ -892,13 +867,6 @@ we ended up with something like
 This is all a bit ad-hoc; eg it relies on knowing that implication
 constraints build tuples.
 
---------------------- Implicit parameters ---------------------------------
-
-\begin{code}
-mkIPPred :: IPName Name -> Type -> PredType
-mkIPPred ip ty = IParam ip ty
-\end{code}
-
 %************************************************************************
 %*									*
                    Size									
@@ -923,26 +891,6 @@ typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts)
 %************************************************************************
 
 \begin{code}
--- | Finds type family instances occuring in a type after expanding synonyms.
-tyFamInsts :: Type -> [(TyCon, [Type])]
-tyFamInsts ty 
-  | Just exp_ty <- tcView ty    = tyFamInsts exp_ty
-tyFamInsts (TyVarTy _)          = []
-tyFamInsts (TyConApp tc tys) 
-  | isSynFamilyTyCon tc           = [(tc, tys)]
-  | otherwise                   = concat (map tyFamInsts tys)
-tyFamInsts (FunTy ty1 ty2)      = tyFamInsts ty1 ++ tyFamInsts ty2
-tyFamInsts (AppTy ty1 ty2)      = tyFamInsts ty1 ++ tyFamInsts ty2
-tyFamInsts (ForAllTy _ ty)      = tyFamInsts ty
-tyFamInsts (PredTy pty)         = predFamInsts pty
-
--- | Finds type family instances occuring in a predicate type after expanding 
--- synonyms.
-predFamInsts :: PredType -> [(TyCon, [Type])]
-predFamInsts (ClassP _cla tys) = concat (map tyFamInsts tys)
-predFamInsts (IParam _ ty)     = tyFamInsts ty
-predFamInsts (EqPred ty1 ty2)  = tyFamInsts ty1 ++ tyFamInsts ty2
-
 mkFamilyTyConApp :: TyCon -> [Type] -> Type
 -- ^ Given a family instance TyCon and its arg types, return the
 -- corresponding family type.  E.g:
@@ -990,10 +938,10 @@ isUnLiftedType :: Type -> Bool
 	-- construct them
 
 isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty'
-isUnLiftedType (ForAllTy _ ty)   = isUnLiftedType ty
-isUnLiftedType (PredTy p)        = isEqPred p
-isUnLiftedType (TyConApp tc _)   = isUnLiftedTyCon tc
-isUnLiftedType _                 = False
+isUnLiftedType (ForAllTy _ ty)      = isUnLiftedType ty
+isUnLiftedType (TyConApp tc _)      = isUnLiftedTyCon tc
+isUnLiftedType _                    = False
+  -- There is no need to check for (PredTy (EqPred {})) because coreView eliminates PredTy
 
 isUnboxedTupleType :: Type -> Bool
 isUnboxedTupleType ty = case tyConAppTyCon_maybe ty of
@@ -1063,64 +1011,6 @@ isPrimitiveType ty = case splitTyConApp_maybe ty of
 
 %************************************************************************
 %*									*
-          The "exact" free variables of a type
-%*									*
-%************************************************************************
-
-Note [Silly type synonym]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-	type T a = Int
-What are the free tyvars of (T x)?  Empty, of course!  
-Here's the example that Ralf Laemmel showed me:
-	foo :: (forall a. C u a -> C u a) -> u
-	mappend :: Monoid u => u -> u -> u
-
-	bar :: Monoid u => u
-	bar = foo (\t -> t `mappend` t)
-We have to generalise at the arg to f, and we don't
-want to capture the constraint (Monad (C u a)) because
-it appears to mention a.  Pretty silly, but it was useful to him.
-
-exactTyVarsOfType is used by the type checker to figure out exactly
-which type variables are mentioned in a type.  It's also used in the
-smart-app checking code --- see TcExpr.tcIdApp
-
-On the other hand, consider a *top-level* definition
-	f = (\x -> x) :: T a -> T a
-If we don't abstract over 'a' it'll get fixed to GHC.Prim.Any, and then
-if we have an application like (f "x") we get a confusing error message 
-involving Any.  So the conclusion is this: when generalising
-  - at top level use tyVarsOfType
-  - in nested bindings use exactTyVarsOfType
-See Trac #1813 for example.
-
-\begin{code}
-exactTyVarsOfType :: Type -> TyVarSet
--- Find the free type variables (of any kind)
--- but *expand* type synonyms.  See Note [Silly type synonym] above.
-exactTyVarsOfType ty
-  = go ty
-  where
-    go ty | Just ty' <- tcView ty = go ty'	-- This is the key line
-    go (TyVarTy tv)         = unitVarSet tv
-    go (TyConApp _ tys)     = exactTyVarsOfTypes tys
-    go (PredTy ty)	    = go_pred ty
-    go (FunTy arg res)	    = go arg `unionVarSet` go res
-    go (AppTy fun arg)	    = go fun `unionVarSet` go arg
-    go (ForAllTy tyvar ty)  = delVarSet (go ty) tyvar
-
-    go_pred (IParam _ ty)    = go ty
-    go_pred (ClassP _ tys)   = exactTyVarsOfTypes tys
-    go_pred (EqPred ty1 ty2) = go ty1 `unionVarSet` go ty2
-
-exactTyVarsOfTypes :: [Type] -> TyVarSet
-exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
-\end{code}
-
-
-%************************************************************************
-%*									*
 \subsection{Sequencing on types}
 %*									*
 %************************************************************************
diff --git a/compiler/vectorise/Vectorise/Type/Type.hs b/compiler/vectorise/Vectorise/Type/Type.hs
index a6d9b2a4fd..0753c9b4bd 100644
--- a/compiler/vectorise/Vectorise/Type/Type.hs
+++ b/compiler/vectorise/Vectorise/Type/Type.hs
@@ -64,7 +64,7 @@ vectType ty@(ForAllTy _ _)
       let (tyArgs, tyResult) = splitFunTys    tyBody
 
       let (tyArgs_dict, tyArgs_regular) 
-                  = partition isDictType tyArgs
+                  = partition isDictTy tyArgs
 
       -- vectorise the body.
       let tyBody' = mkFunTys tyArgs_regular tyResult
@@ -88,14 +88,6 @@ abstractType :: [TyVar] -> [Type] -> Type -> Type
 abstractType tyvars dicts = mkForAllTys tyvars . mkFunTys dicts
 
 
--- | Check if some type is a type class dictionary.
-isDictType :: Type -> Bool
-isDictType ty
- = case splitTyConApp_maybe ty of
-	Just (tyCon, _)		-> isClassTyCon tyCon
-	_			-> False
-
-
 -- | Create the boxed version of a vectorised type.
 vectAndBoxType :: Type -> VM Type
 vectAndBoxType ty = vectType ty >>= boxType