[project @ 1999-07-30 11:26:09 by simonmar]
[ghc-hetmet.git] / ghc / compiler / types / Type.lhs
index 56decc5..ccd8af7 100644 (file)
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1998
+%
+\section[Type]{Type - public interface}
+
 \begin{code}
 module Type (
-       GenType(..), TyNote(..),                -- Representation visible to friends
-       Type, GenKind, Kind,
-       TyVarSubst, GenTyVarSubst,
+        -- re-exports from TypeRep:
+       Type,
+       Kind, TyVarSubst,
+
+       superKind, superBoxity,                         -- :: SuperKind
+
+       boxedKind,                                      -- :: Kind :: BX
+       anyBoxKind,                                     -- :: Kind :: BX
+       typeCon,                                        -- :: KindCon :: BX -> KX
+       anyBoxCon,                                      -- :: KindCon :: BX
+
+       boxedTypeKind, unboxedTypeKind, openTypeKind,   -- Kind :: superKind
+
+       mkArrowKind, mkArrowKinds, -- mentioned below: hasMoreBoxityInfo,
 
-       funTyCon, boxedKindCon, unboxedKindCon, openKindCon,
+       funTyCon,
 
-       boxedTypeKind, unboxedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
-       hasMoreBoxityInfo, superKind,
+        -- exports from this module:
+        hasMoreBoxityInfo,
 
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
 
        mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
 
-       mkFunTy, mkFunTys, splitFunTy_maybe, splitFunTys, funResultTy,
+       mkFunTy, mkFunTys, splitFunTy_maybe, splitFunTys, splitFunTysN,
+       funResultTy, funArgTy, zipFunTys,
 
        mkTyConApp, mkTyConTy, splitTyConApp_maybe,
-       splitAlgTyConApp_maybe, splitAlgTyConApp,
+       splitAlgTyConApp_maybe, splitAlgTyConApp, 
        mkDictTy, splitDictTy_maybe, isDictTy,
 
-       mkSynTy, isSynTy,
+       mkSynTy, isSynTy, deNoteType, repType, splitNewType_maybe,
+
+        UsageAnn(..), mkUsgTy, isUsgTy{- dont use -}, isNotUsgTy, splitUsgTy, unUsgTy, tyUsg,
+        mkUsForAllTy, mkUsForAllTys, splitUsForAllTys, substUsTy,
 
        mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
-       applyTy, applyTys, isForAllTy,
-       mkPiType,
+       isForAllTy, applyTy, applyTys, mkPiType,
 
        TauType, RhoType, SigmaType, ThetaType,
        isTauTy,
        mkRhoTy, splitRhoTy,
        mkSigmaTy, splitSigmaTy,
 
-       isUnLiftedType, isUnboxedType, isUnboxedTupleType, isAlgType,
+       -- Lifting and boxity
+       isUnLiftedType, isUnboxedType, isUnboxedTupleType, isAlgType, isDataType, isNewType,
        typePrimRep,
 
+       -- Free variables
        tyVarsOfType, tyVarsOfTypes, namesOfType, typeKind,
        addFreeTyVars,
 
-       substTy, fullSubstTy, substTyVar,
-       substFlexiTy, substFlexiTheta,
+       -- Tidying up for printing
+       tidyType,     tidyTypes,
+       tidyOpenType, tidyOpenTypes,
+       tidyTyVar,    tidyTyVars,
+       tidyTopType,
+
+       -- Seq
+       seqType, seqTypes
 
-       showTypeCategory
     ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}  DataCon( DataCon )
+-- We import the representation and primitive functions from TypeRep.
+-- Many things are reexported, but not the representation!
+
+import TypeRep
+
+-- Other imports:
+
+import {-# SOURCE #-}  DataCon( DataCon, dataConType )
+import {-# SOURCE #-}  PprType( pprType )      -- Only called in debug messages
+import {-# SOURCE #-}   Subst  ( mkTyVarSubst, substTy )
 
 -- friends:
-import Var     ( Id, TyVar, GenTyVar, IdOrTyVar,
-                 removeTyVarFlexi, 
-                 tyVarKind, isId, idType
+import Var     ( TyVar, IdOrTyVar, UVar,
+                 tyVarKind, tyVarName, setTyVarName, isId, idType,
                )
 import VarEnv
 import VarSet
 
-import Name    ( NamedThing(..), Provenance(..), ExportFlag(..),
-                 mkWiredInTyConName, mkGlobalName, varOcc
+import Name    ( NamedThing(..), mkLocalName, tidyOccName,
                )
 import NameSet
 import Class   ( classTyCon, Class )
-import TyCon   ( TyCon, Boxity(..),
-                 mkFunTyCon, mkKindCon, superKindCon,
-                 matchesTyCon, isUnboxedTupleTyCon, isUnLiftedTyCon,
-                 isFunTyCon, isEnumerationTyCon, 
-                 isTupleTyCon, maybeTyConSingleCon,
-                 isPrimTyCon, isAlgTyCon, isSynTyCon, tyConArity,
-                 tyConKind, tyConDataCons, getSynTyConDefn, 
+import TyCon   ( TyCon,
+                 isUnboxedTupleTyCon, isUnLiftedTyCon,
+                 isFunTyCon, isDataTyCon, isNewTyCon,
+                 isAlgTyCon, isSynTyCon, tyConArity,
+                 tyConKind, tyConDataCons, getSynTyConDefn,
                  tyConPrimRep, tyConClass_maybe
                )
 
 -- others
-import BasicTypes      ( Unused )
-import SrcLoc          ( mkBuiltinSrcLoc )
-import PrelMods                ( pREL_GHC )
+import SrcLoc          ( noSrcLoc )
 import Maybes          ( maybeToBool )
 import PrimRep         ( PrimRep(..), isFollowableRep )
-import Unique          -- quite a few *Keys
-import Util            ( thenCmp )
+import Unique          ( Uniquable(..) )
+import Util            ( mapAccumL, seqList )
 import Outputable
-
+import UniqSet         ( sizeUniqSet )         -- Should come via VarSet
 \end{code}
 
-%************************************************************************
-%*                                                                     *
-\subsection{Type Classifications}
-%*                                                                     *
-%************************************************************************
-
-A type is
-
-       *unboxed*       iff its representation is other than a pointer
-                       Unboxed types cannot instantiate a type variable
-                       Unboxed types are always unlifted.
-
-       *lifted*        A type is lifted iff it has bottom as an element.
-                       Closures always have lifted types:  i.e. any
-                       let-bound identifier in Core must have a lifted
-                       type.  Operationally, a lifted object is one that
-                       can be entered.
-                       (NOTE: previously "pointed").                   
-
-       *algebraic*     A type with one or more constructors.  An algebraic
-                       type is one that can be deconstructed with a case
-                       expression.  *NOT* the same as lifted types, 
-                       because we also include unboxed tuples in this
-                       classification.
-
-       *primitive*     iff it is a built-in type that can't be expressed
-                       in Haskell.
-
-Currently, all primitive types are unlifted, but that's not necessarily
-the case.  (E.g. Int could be primitive.)
-
-Some primitive types are unboxed, such as Int#, whereas some are boxed
-but unlifted (such as ByteArray#).  The only primitive types that we
-classify as algebraic are the unboxed tuples.
-
-examples of type classifications:
-
-Type           primitive       boxed           lifted          algebraic    
------------------------------------------------------------------------------
-Int#,          Yes             No              No              No
-ByteArray#     Yes             Yes             No              No
-(# a, b #)     Yes             No              No              Yes
-(  a, b  )     No              Yes             Yes             Yes
-[a]            No              Yes             Yes             Yes
 
 %************************************************************************
 %*                                                                     *
-\subsection{The data type}
+\subsection{Stuff to do with kinds.}
 %*                                                                     *
 %************************************************************************
 
-
 \begin{code}
-type Type  = GenType Unused    -- Used after typechecker
-
-type GenKind flexi = GenType flexi
-type Kind  = Type
-
-type TyVarSubst         = TyVarEnv Type
-type GenTyVarSubst flexi = TyVarEnv (GenType flexi) 
-
-data GenType flexi                     -- Parameterised over the "flexi" part of a type variable
-  = TyVarTy (GenTyVar flexi)
-
-  | AppTy
-       (GenType flexi)         -- Function is *not* a TyConApp
-       (GenType flexi)
-
-  | TyConApp                   -- Application of a TyCon
-       TyCon                   -- *Invariant* saturated appliations of FunTyCon and
-                               --      synonyms have their own constructors, below.
-       [GenType flexi]         -- Might not be saturated.
-
-  | FunTy                      -- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
-       (GenType flexi)
-       (GenType flexi)
-
-  | NoteTy                     -- Saturated application of a type synonym
-       (TyNote flexi)
-       (GenType flexi)         -- The expanded version
-
-  | ForAllTy
-       (GenTyVar flexi)
-       (GenType flexi)         -- TypeKind
-
-data TyNote flexi
-  = SynNote (GenType flexi)    -- The unexpanded version of the type synonym; always a TyConApp
-  | FTVNote (GenTyVarSet flexi)        -- The free type variables of the noted expression
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
-\subsection{Wired-in type constructors
-%*                                                                     *
-%************************************************************************
-
-We define a few wired-in type constructors here to avoid module knots
-
-\begin{code}
-funTyConName = mkWiredInTyConName funTyConKey pREL_GHC SLIT("->") funTyCon
-funTyCon = mkFunTyCon funTyConName (mkArrowKinds [boxedTypeKind, boxedTypeKind] boxedTypeKind)
-\end{code}
-
-\begin{code}
-mk_kind_name key str = mkGlobalName key pREL_GHC (varOcc str)
-                                 (LocalDef mkBuiltinSrcLoc NotExported)
-       -- mk_kind_name is a bit of a hack
-       -- The LocalDef means that we print the name without
-       -- a qualifier, which is what we want for these kinds.
-
-boxedKindConName = mk_kind_name boxedKindConKey SLIT("*")
-boxedKindCon     = mkKindCon boxedKindConName superKind Boxed
-
-unboxedKindConName = mk_kind_name unboxedKindConKey SLIT("*#")
-unboxedKindCon     = mkKindCon unboxedKindConName superKind Unboxed
-
-openKindConName = mk_kind_name openKindConKey SLIT("*?")
-openKindCon     = mkKindCon openKindConName superKind Open
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
-\subsection{Kinds}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-superKind :: GenKind flexi     -- Box, the type of all kinds
-superKind = TyConApp superKindCon []
-
-boxedTypeKind, unboxedTypeKind, openTypeKind :: GenKind flexi
-boxedTypeKind   = TyConApp boxedKindCon   []
-unboxedTypeKind = TyConApp unboxedKindCon []
-openTypeKind   = TyConApp openKindCon    []
-
-mkArrowKind :: GenKind flexi -> GenKind flexi -> GenKind flexi
-mkArrowKind = FunTy
-
-mkArrowKinds :: [GenKind flexi] -> GenKind flexi -> GenKind flexi
-mkArrowKinds arg_kinds result_kind = foldr FunTy result_kind arg_kinds
-\end{code}
-
-\begin{code}
-hasMoreBoxityInfo :: GenKind flexi -> GenKind flexi -> Bool
-
-(NoteTy _ k1) `hasMoreBoxityInfo` k2 = k1 `hasMoreBoxityInfo` k2
-k1 `hasMoreBoxityInfo` (NoteTy _ k2) = k1 `hasMoreBoxityInfo` k2
-
-(TyConApp kc1 ts1) `hasMoreBoxityInfo` (TyConApp kc2 ts2) 
-  = ASSERT( null ts1 && null ts2 )
-    kc2 `matchesTyCon` kc1     -- NB the reversal of arguments
-
-kind1@(FunTy _ _) `hasMoreBoxityInfo` kind2@(FunTy _ _)
-  = ASSERT( kind1 == kind2 )
-    True
-       -- The two kinds can be arrow kinds; for example when unifying
-       -- (m1 Int) and (m2 Int) we end up unifying m1 and m2, which should
-       -- have the same kind.
-
--- Other cases are impossible
+hasMoreBoxityInfo :: Kind -> Kind -> Bool
+hasMoreBoxityInfo k1 k2
+  | k2 == openTypeKind = ASSERT( is_type_kind k1) True
+  | otherwise         = k1 == k2
+  where
+       -- Returns true for things of form (Type x)
+    is_type_kind k = case splitTyConApp_maybe k of
+                       Just (tc,[_]) -> tc == typeCon
+                       Nothing       -> False
 \end{code}
 
 
@@ -257,23 +141,23 @@ kind1@(FunTy _ _) `hasMoreBoxityInfo` kind2@(FunTy _ _)
                                TyVarTy
                                ~~~~~~~
 \begin{code}
-mkTyVarTy  :: GenTyVar flexi   -> GenType flexi
+mkTyVarTy  :: TyVar   -> Type
 mkTyVarTy  = TyVarTy
 
-mkTyVarTys :: [GenTyVar flexi] -> [GenType flexi]
+mkTyVarTys :: [TyVar] -> [Type]
 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 
-getTyVar :: String -> GenType flexi -> GenTyVar flexi
+getTyVar :: String -> Type -> TyVar
 getTyVar msg (TyVarTy tv) = tv
 getTyVar msg (NoteTy _ t) = getTyVar msg t
 getTyVar msg other       = panic ("getTyVar: " ++ msg)
 
-getTyVar_maybe :: GenType flexi -> Maybe (GenTyVar flexi)
+getTyVar_maybe :: Type -> Maybe TyVar
 getTyVar_maybe (TyVarTy tv) = Just tv
 getTyVar_maybe (NoteTy _ t) = getTyVar_maybe t
 getTyVar_maybe other       = Nothing
 
-isTyVarTy :: GenType flexi -> Bool
+isTyVarTy :: Type -> Bool
 isTyVarTy (TyVarTy tv)  = True
 isTyVarTy (NoteTy _ ty) = isTyVarTy ty
 isTyVarTy other         = False
@@ -288,26 +172,29 @@ invariant that a TyConApp is always visibly so.  mkAppTy maintains the
 invariant: use it.
 
 \begin{code}
-mkAppTy orig_ty1 orig_ty2 = mk_app orig_ty1
+mkAppTy orig_ty1 orig_ty2 = ASSERT2( isNotUsgTy orig_ty1 && isNotUsgTy orig_ty2, pprType orig_ty1 <+> text "to" <+> pprType orig_ty2 )
+                            mk_app orig_ty1
   where
     mk_app (NoteTy _ ty1)    = mk_app ty1
     mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
     mk_app ty1              = AppTy orig_ty1 orig_ty2
 
-mkAppTys :: GenType flexi -> [GenType flexi] -> GenType flexi
+mkAppTys :: Type -> [Type] -> Type
 mkAppTys orig_ty1 []       = orig_ty1
        -- This check for an empty list of type arguments
        -- avoids the needless of a type synonym constructor.
        -- For example: mkAppTys Rational []
        --   returns to (Ratio Integer), which has needlessly lost
        --   the Rational part.
-mkAppTys orig_ty1 orig_tys2 = mk_app orig_ty1
+mkAppTys orig_ty1 orig_tys2 = ASSERT2( isNotUsgTy orig_ty1, pprType orig_ty1 )
+                              mk_app orig_ty1
   where
     mk_app (NoteTy _ ty1)    = mk_app ty1
     mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
-    mk_app ty1              = foldl AppTy orig_ty1 orig_tys2
+    mk_app ty1              = ASSERT2( all isNotUsgTy orig_tys2, pprType orig_ty1 <+> text "to" <+> hsep (map pprType orig_tys2) )
+                               foldl AppTy orig_ty1 orig_tys2
 
-splitAppTy_maybe :: GenType flexi -> Maybe (GenType flexi, GenType flexi)
+splitAppTy_maybe :: Type -> Maybe (Type, Type)
 splitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
 splitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
 splitAppTy_maybe (NoteTy _ ty)     = splitAppTy_maybe ty
@@ -319,12 +206,12 @@ splitAppTy_maybe (TyConApp tc tys) = split tys []
 
 splitAppTy_maybe other           = Nothing
 
-splitAppTy :: GenType flexi -> (GenType flexi, GenType flexi)
+splitAppTy :: Type -> (Type, Type)
 splitAppTy ty = case splitAppTy_maybe ty of
                        Just pr -> pr
                        Nothing -> panic "splitAppTy"
 
-splitAppTys :: GenType flexi -> (GenType flexi, [GenType flexi])
+splitAppTys :: Type -> (Type, [Type])
 splitAppTys ty = split ty ty []
   where
     split orig_ty (AppTy ty arg)        args = split ty ty (arg:args)
@@ -341,31 +228,50 @@ splitAppTys ty = split ty ty []
                                ~~~~~
 
 \begin{code}
-mkFunTy :: GenType flexi -> GenType flexi -> GenType flexi
+mkFunTy :: Type -> Type -> Type
 mkFunTy arg res = FunTy arg res
 
-mkFunTys :: [GenType flexi] -> GenType flexi -> GenType flexi
+mkFunTys :: [Type] -> Type -> Type
 mkFunTys tys ty = foldr FunTy ty tys
 
-splitFunTy_maybe :: GenType flexi -> Maybe (GenType flexi, GenType flexi)
+splitFunTy_maybe :: Type -> Maybe (Type, Type)
 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
 splitFunTy_maybe (NoteTy _ ty)   = splitFunTy_maybe ty
 splitFunTy_maybe other          = Nothing
 
-
-splitFunTys :: GenType flexi -> ([GenType flexi], GenType flexi)
+splitFunTys :: Type -> ([Type], Type)
 splitFunTys ty = split [] ty ty
   where
     split args orig_ty (FunTy arg res) = split (arg:args) res res
     split args orig_ty (NoteTy _ ty)   = split args orig_ty ty
     split args orig_ty ty              = (reverse args, orig_ty)
 
-funResultTy :: GenType flexi -> GenType flexi
+splitFunTysN :: String -> Int -> Type -> ([Type], Type)
+splitFunTysN msg orig_n orig_ty = split orig_n [] orig_ty orig_ty
+  where
+    split 0 args syn_ty ty             = (reverse args, syn_ty) 
+    split n args syn_ty (FunTy arg res) = split (n-1) (arg:args) res    res
+    split n args syn_ty (NoteTy _ ty)   = split n     args       syn_ty ty
+    split n args syn_ty ty              = pprPanic ("splitFunTysN: " ++ msg) (int orig_n <+> pprType orig_ty)
+
+zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
+zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
+  where
+    split acc []     nty ty             = (reverse acc, nty)
+    split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
+    split acc xs     nty (NoteTy _ ty)   = split acc           xs nty ty
+    split acc (x:xs) nty ty              = pprPanic "zipFunTys" (ppr orig_xs <+> pprType orig_ty)
+    
+funResultTy :: Type -> Type
 funResultTy (FunTy arg res) = res
 funResultTy (NoteTy _ ty)   = funResultTy ty
-funResultTy ty             = ty
-\end{code}
+funResultTy ty             = pprPanic "funResultTy" (pprType ty)
 
+funArgTy :: Type -> Type
+funArgTy (FunTy arg res) = arg
+funArgTy (NoteTy _ ty)   = funArgTy ty
+funArgTy ty             = pprPanic "funArgTy" (pprType ty)
+\end{code}
 
 
 ---------------------------------------------------------------------
@@ -373,7 +279,7 @@ funResultTy ty                  = ty
                                ~~~~~~~~
 
 \begin{code}
-mkTyConApp :: TyCon -> [GenType flexi] -> GenType flexi
+mkTyConApp :: TyCon -> [Type] -> Type
 mkTyConApp tycon tys
   | isFunTyCon tycon && length tys == 2
   = case tys of 
@@ -383,7 +289,7 @@ mkTyConApp tycon tys
   = ASSERT(not (isSynTyCon tycon))
     TyConApp tycon tys
 
-mkTyConTy :: TyCon -> GenType flexi
+mkTyConTy :: TyCon -> Type
 mkTyConTy tycon = ASSERT( not (isSynTyCon tycon) ) 
                  TyConApp tycon []
 
@@ -391,7 +297,7 @@ mkTyConTy tycon = ASSERT( not (isSynTyCon tycon) )
 -- mean a distinct type, but all other type-constructor applications
 -- including functions are returned as Just ..
 
-splitTyConApp_maybe :: GenType flexi -> Maybe (TyCon, [GenType flexi])
+splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 splitTyConApp_maybe (NoteTy _ ty)     = splitTyConApp_maybe ty
@@ -402,14 +308,14 @@ splitTyConApp_maybe other       = Nothing
 -- "Algebraic" => newtype, data type, or dictionary (not function types)
 -- We return the constructors too.
 
-splitAlgTyConApp_maybe :: GenType flexi -> Maybe (TyCon, [GenType flexi], [DataCon])
+splitAlgTyConApp_maybe :: Type -> Maybe (TyCon, [Type], [DataCon])
 splitAlgTyConApp_maybe (TyConApp tc tys) 
   | isAlgTyCon tc &&
     tyConArity tc == length tys      = Just (tc, tys, tyConDataCons tc)
 splitAlgTyConApp_maybe (NoteTy _ ty) = splitAlgTyConApp_maybe ty
 splitAlgTyConApp_maybe other        = Nothing
 
-splitAlgTyConApp :: GenType flexi -> (TyCon, [GenType flexi], [DataCon])
+splitAlgTyConApp :: Type -> (TyCon, [Type], [DataCon])
        -- Here the "algebraic" property is an *assertion*
 splitAlgTyConApp (TyConApp tc tys) = ASSERT( isAlgTyCon tc && tyConArity tc == length tys )
                                     (tc, tys, tyConDataCons tc)
@@ -420,10 +326,10 @@ splitAlgTyConApp (NoteTy _ ty)     = splitAlgTyConApp ty
 tell from the type constructor whether it's a dictionary or not.
 
 \begin{code}
-mkDictTy :: Class -> [GenType flexi] -> GenType flexi
+mkDictTy :: Class -> [Type] -> Type
 mkDictTy clas tys = TyConApp (classTyCon clas) tys
 
-splitDictTy_maybe :: GenType flexi -> Maybe (Class, [GenType flexi])
+splitDictTy_maybe :: Type -> Maybe (Class, [Type])
 splitDictTy_maybe (TyConApp tc tys) 
   |  maybeToBool maybe_class
   && tyConArity tc == length tys = Just (clas, tys)
@@ -434,7 +340,7 @@ splitDictTy_maybe (TyConApp tc tys)
 splitDictTy_maybe (NoteTy _ ty)        = splitDictTy_maybe ty
 splitDictTy_maybe other                = Nothing
 
-isDictTy :: GenType flexi -> Bool
+isDictTy :: Type -> Bool
        -- This version is slightly more efficient than (maybeToBool . splitDictTy)
 isDictTy (TyConApp tc tys) 
   |  maybeToBool (tyConClass_maybe tc)
@@ -444,22 +350,31 @@ isDictTy (NoteTy _ ty)    = isDictTy ty
 isDictTy other         = False
 \end{code}
 
-
 ---------------------------------------------------------------------
                                SynTy
                                ~~~~~
 
 \begin{code}
 mkSynTy syn_tycon tys
-  = ASSERT(isSynTyCon syn_tycon)
+  = ASSERT( isSynTyCon syn_tycon )
+    ASSERT( isNotUsgTy body )
+    ASSERT( length tyvars == length tys )
     NoteTy (SynNote (TyConApp syn_tycon tys))
-          (substFlexiTy (zipVarEnv tyvars tys) body)
-               -- The "flexi" is needed so we can get a TcType from a synonym
+          (substTy (mkTyVarSubst tyvars tys) body)
   where
     (tyvars, body) = getSynTyConDefn syn_tycon
 
 isSynTy (NoteTy (SynNote _) _) = True
 isSynTy other                  = False
+
+deNoteType :: Type -> Type
+       -- Sorry for the cute name
+deNoteType ty@(TyVarTy tyvar)  = ty
+deNoteType (TyConApp tycon tys) = TyConApp tycon (map deNoteType tys)
+deNoteType (NoteTy _ ty)       = deNoteType ty
+deNoteType (AppTy fun arg)     = AppTy (deNoteType fun) (deNoteType arg)
+deNoteType (FunTy fun arg)     = FunTy (deNoteType fun) (deNoteType arg)
+deNoteType (ForAllTy tv ty)    = ForAllTy tv (deNoteType ty)
 \end{code}
 
 Notes on type synonyms
@@ -478,29 +393,186 @@ interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
 
 
 
+repType looks through 
+       (a) for-alls, and
+       (b) newtypes
+in addition to synonyms.  It's useful in the back end where we're not
+interested in newtypes anymore.
+
+\begin{code}
+repType :: Type -> Type
+repType (NoteTy _ ty)                    = repType ty
+repType (ForAllTy _ ty)                  = repType ty
+repType (TyConApp tc tys) | isNewTyCon tc = repType (new_type_rep tc tys)
+repType other_ty                         = other_ty
+
+splitNewType_maybe :: Type -> Maybe Type
+-- Find the representation of a newtype, if it is one
+-- Looks through multiple levels of newtype
+splitNewType_maybe (NoteTy _ ty)                    = splitNewType_maybe ty
+splitNewType_maybe (TyConApp tc tys) | isNewTyCon tc = case splitNewType_maybe rep_ty of
+                                                               Just rep_ty' -> Just rep_ty'
+                                                               Nothing      -> Just rep_ty
+                                                    where
+                                                      rep_ty = new_type_rep tc tys
+
+splitNewType_maybe other                            = Nothing                                          
+
+new_type_rep :: TyCon -> [Type] -> Type
+-- The representation type for (T t1 .. tn), where T is a newtype 
+-- Looks through one layer only
+new_type_rep tc tys 
+  = ASSERT( isNewTyCon tc )
+    case splitFunTy_maybe (applyTys (dataConType (head (tyConDataCons tc))) tys) of
+       Just (rep_ty, _) -> rep_ty
+\end{code}
+
+
 
 ---------------------------------------------------------------------
-                               ForAllTy
-                               ~~~~~~~~
+                               UsgNote
+                               ~~~~~~~
+
+NB: Invariant: if present, usage note is at the very top of the type.
+This should be carefully preserved.
+
+In some parts of the compiler, comments use the _Once Upon a
+Polymorphic Type_ (POPL'99) usage of "rho = generalised
+usage-annotated type; sigma = usage-annotated type; tau =
+usage-annotated type except on top"; unfortunately this conflicts with
+the rho/tau/theta/sigma usage in the rest of the compiler.  (KSW
+1999-07)
 
 \begin{code}
-mkForAllTy = ForAllTy
+mkUsgTy :: UsageAnn -> Type -> Type
+#ifndef USMANY
+mkUsgTy UsMany ty = ASSERT2( isNotUsgTy ty, pprType ty )
+                    ty
+#endif
+mkUsgTy usg    ty = ASSERT2( isNotUsgTy ty, pprType ty )
+                    NoteTy (UsgNote usg) ty
+
+-- The isUsgTy function is utterly useless if UsManys are omitted.
+-- Be warned!  KSW 1999-04.
+isUsgTy :: Type -> Bool
+#ifndef USMANY
+isUsgTy _ = True
+#else
+isUsgTy (NoteTy (UsgForAll _) ty) = isUsgTy ty
+isUsgTy (NoteTy (UsgNote   _) _ ) = True
+isUsgTy other                     = False
+#endif
+
+-- The isNotUsgTy function may return a false True if UsManys are omitted;
+-- in other words, A SSERT( isNotUsgTy ty ) may be useful but
+-- A SSERT( not (isNotUsg ty) ) is asking for trouble.  KSW 1999-04.
+isNotUsgTy :: Type -> Bool
+isNotUsgTy (NoteTy (UsgForAll _) _) = False
+isNotUsgTy (NoteTy (UsgNote   _) _) = False
+isNotUsgTy other                    = True
+
+-- splitUsgTy_maybe is not exported, since it is meaningless if
+-- UsManys are omitted.  It is used in several places in this module,
+-- however.  KSW 1999-04.
+splitUsgTy_maybe :: Type -> Maybe (UsageAnn,Type)
+splitUsgTy_maybe (NoteTy (UsgNote usg) ty2) = ASSERT( isNotUsgTy ty2 )
+                                              Just (usg,ty2)
+splitUsgTy_maybe ty@(NoteTy (UsgForAll _) _) = pprPanic "splitUsgTy_maybe:" $ pprType ty
+splitUsgTy_maybe ty                          = Nothing
+
+splitUsgTy :: Type -> (UsageAnn,Type)
+splitUsgTy ty = case splitUsgTy_maybe ty of
+                  Just ans -> ans
+                  Nothing  -> 
+#ifndef USMANY
+                              (UsMany,ty)
+#else
+                              pprPanic "splitUsgTy: no usage annot:" $ pprType ty
+#endif
+
+tyUsg :: Type -> UsageAnn
+tyUsg = fst . splitUsgTy
+
+unUsgTy :: Type -> Type
+-- strip outer usage annotation if present
+unUsgTy ty = case splitUsgTy_maybe ty of
+               Just (_,ty1) -> ASSERT2( isNotUsgTy ty1, pprType ty )
+                               ty1
+               Nothing      -> ty
+
+mkUsForAllTy :: UVar -> Type -> Type
+mkUsForAllTy uv ty = NoteTy (UsgForAll uv) ty
+
+mkUsForAllTys :: [UVar] -> Type -> Type
+mkUsForAllTys uvs ty = foldr (NoteTy . UsgForAll) ty uvs
+
+splitUsForAllTys :: Type -> ([UVar],Type)
+splitUsForAllTys ty = split ty []
+  where split (NoteTy (UsgForAll u) ty) uvs = split ty (u:uvs)
+        split other_ty                  uvs = (reverse uvs, other_ty)
+
+substUsTy :: VarEnv UsageAnn -> Type -> Type
+-- assumes range is fresh uvars, so no conflicts
+substUsTy ve    (NoteTy  note@(UsgNote (UsVar u))
+                                            ty ) = NoteTy (case lookupVarEnv ve u of
+                                                             Just ua -> UsgNote ua
+                                                             Nothing -> note)
+                                                          (substUsTy ve ty)
+substUsTy ve    (NoteTy  note@(UsgNote   _) ty ) = NoteTy note (substUsTy ve ty)
+substUsTy ve    (NoteTy  note@(UsgForAll _) ty ) = NoteTy note (substUsTy ve ty)
+substUsTy ve    (NoteTy  (SynNote ty1)      ty2) = NoteTy (SynNote (substUsTy ve ty1))
+                                                          (substUsTy ve ty2)
+substUsTy ve    (NoteTy  note@(FTVNote _)   ty ) = NoteTy note (substUsTy ve ty)
+substUsTy ve ty@(TyVarTy _                     ) = ty
+substUsTy ve    (AppTy   ty1                ty2) = AppTy (substUsTy ve ty1)
+                                                         (substUsTy ve ty2)
+substUsTy ve    (FunTy   ty1                ty2) = FunTy (substUsTy ve ty1)
+                                                         (substUsTy ve ty2)
+substUsTy ve    (TyConApp tyc               tys) = TyConApp tyc (map (substUsTy ve) tys)
+substUsTy ve    (ForAllTy yv                ty ) = ForAllTy yv (substUsTy ve ty)
+\end{code}
+
 
-mkForAllTys :: [GenTyVar flexi] -> GenType flexi -> GenType flexi
-mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
+---------------------------------------------------------------------
+                               ForAllTy
+                               ~~~~~~~~
 
-splitForAllTy_maybe :: GenType flexi -> Maybe (GenTyVar flexi, GenType flexi)
-splitForAllTy_maybe (NoteTy _ ty)       = splitForAllTy_maybe ty
-splitForAllTy_maybe (ForAllTy tyvar ty) = Just(tyvar, ty)
-splitForAllTy_maybe _                  = Nothing
+We need to be clever here with usage annotations; they need to be
+lifted or lowered through the forall as appropriate.
 
-isForAllTy :: GenType flexi -> Bool
+\begin{code}
+mkForAllTy :: TyVar -> Type -> Type
+mkForAllTy tyvar ty = case splitUsgTy_maybe ty of
+                        Just (usg,ty') -> NoteTy (UsgNote usg)
+                                                (ForAllTy tyvar ty')
+                        Nothing        -> ForAllTy tyvar ty
+
+mkForAllTys :: [TyVar] -> Type -> Type
+mkForAllTys tyvars ty = case splitUsgTy_maybe ty of
+                          Just (usg,ty') -> NoteTy (UsgNote usg)
+                                                  (foldr ForAllTy ty' tyvars)
+                          Nothing        -> foldr ForAllTy ty tyvars
+
+splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
+splitForAllTy_maybe ty = case splitUsgTy_maybe ty of
+                           Just (usg,ty') -> do (tyvar,ty'') <- splitFAT_m ty'
+                                               return (tyvar, NoteTy (UsgNote usg) ty'')
+                          Nothing        -> splitFAT_m ty
+  where
+    splitFAT_m (NoteTy _ ty)       = splitFAT_m ty
+    splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
+    splitFAT_m _                  = Nothing
+
+isForAllTy :: Type -> Bool
 isForAllTy (NoteTy _ ty)       = isForAllTy ty
 isForAllTy (ForAllTy tyvar ty) = True
 isForAllTy _                = False
 
-splitForAllTys :: GenType flexi -> ([GenTyVar flexi], GenType flexi)
-splitForAllTys ty = split ty ty []
+splitForAllTys :: Type -> ([TyVar], Type)
+splitForAllTys ty = case splitUsgTy_maybe ty of
+                      Just (usg,ty') -> let (tvs,ty'') = split ty' ty' []
+                                       in  (tvs, NoteTy (UsgNote usg) ty'')
+                     Nothing        -> split ty ty []
    where
      split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
      split orig_ty (NoteTy _ ty)    tvs = split orig_ty ty tvs
@@ -513,25 +585,45 @@ it is given a type variable or a term variable.
 \begin{code}
 mkPiType :: IdOrTyVar -> Type -> Type  -- The more polymorphic version doesn't work...
 mkPiType v ty | isId v    = mkFunTy (idType v) ty
-             | otherwise = ForAllTy v ty
+             | otherwise = mkForAllTy v ty
 \end{code}
 
-\begin{code}
-applyTy :: GenType flexi -> GenType flexi -> GenType flexi
-applyTy (NoteTy _ fun)   arg = applyTy fun arg
-applyTy (ForAllTy tv ty) arg = substTy (mkVarEnv [(tv,arg)]) ty
-applyTy other           arg = panic "applyTy"
+Applying a for-all to its arguments
 
-applyTys :: GenType flexi -> [GenType flexi] -> GenType flexi
+\begin{code}
+applyTy :: Type -> Type -> Type
+applyTy (NoteTy note@(UsgNote   _) fun) arg = NoteTy note (applyTy fun arg)
+applyTy (NoteTy note@(UsgForAll _) fun) arg = NoteTy note (applyTy fun arg)
+applyTy (NoteTy _ fun)                  arg = applyTy fun arg
+applyTy (ForAllTy tv ty)                arg = ASSERT( isNotUsgTy arg )
+                                              substTy (mkTyVarSubst [tv] [arg]) ty
+applyTy other                          arg = panic "applyTy"
+
+applyTys :: Type -> [Type] -> Type
 applyTys fun_ty arg_tys
- = go [] fun_ty arg_tys
+ = substTy (mkTyVarSubst tvs arg_tys) ty
  where
-   go env ty               []         = substTy (mkVarEnv env) ty
-   go env (NoteTy _ fun)   args       = go env fun args
-   go env (ForAllTy tv ty) (arg:args) = go ((tv,arg):env) ty args
-   go env other            args       = panic "applyTys"
+   (tvs, ty) = split fun_ty arg_tys
+   
+   split fun_ty               []         = ([], fun_ty)
+   split (NoteTy note@(UsgNote   _) fun_ty)
+                              args       = case split fun_ty args of
+                                             (tvs, ty) -> (tvs, NoteTy note ty)
+   split (NoteTy note@(UsgForAll _) fun_ty)
+                              args       = case split fun_ty args of
+                                             (tvs, ty) -> (tvs, NoteTy note ty)
+   split (NoteTy _ fun_ty)    args       = split fun_ty args
+   split (ForAllTy tv fun_ty) (arg:args) = ASSERT2( isNotUsgTy arg, vcat (map pprType arg_tys) $$
+                                                                   text "in application of" <+> pprType fun_ty)
+                                          case split fun_ty args of
+                                                 (tvs, ty) -> (tv:tvs, ty)
+   split other_ty             args       = panic "applyTys"
 \end{code}
 
+Note that we allow applications to be of usage-annotated- types, as an
+extension: we handle them by lifting the annotation outside.  The
+argument, however, must still be unannotated.
+
 
 %************************************************************************
 %*                                                                     *
@@ -549,7 +641,7 @@ type SigmaType = Type
 @isTauTy@ tests for nested for-alls.
 
 \begin{code}
-isTauTy :: GenType flexi -> Bool
+isTauTy :: Type -> Bool
 isTauTy (TyVarTy v)      = True
 isTauTy (TyConApp _ tys) = all isTauTy tys
 isTauTy (AppTy a b)             = isTauTy a && isTauTy b
@@ -559,10 +651,10 @@ isTauTy other              = False
 \end{code}
 
 \begin{code}
-mkRhoTy :: [(Class, [GenType flexi])] -> GenType flexi -> GenType flexi
+mkRhoTy :: [(Class, [Type])] -> Type -> Type
 mkRhoTy theta ty = foldr (\(c,t) r -> FunTy (mkDictTy c t) r) ty theta
 
-splitRhoTy :: GenType flexi -> ([(Class, [GenType flexi])], GenType flexi)
+splitRhoTy :: Type -> ([(Class, [Type])], Type)
 splitRhoTy ty = split ty ty []
  where
   split orig_ty (FunTy arg res) ts = case splitDictTy_maybe arg of
@@ -577,7 +669,7 @@ splitRhoTy ty = split ty ty []
 \begin{code}
 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
 
-splitSigmaTy :: GenType flexi -> ([GenTyVar flexi], [(Class, [GenType flexi])], GenType flexi)
+splitSigmaTy :: Type -> ([TyVar], [(Class, [Type])], Type)
 splitSigmaTy ty =
   (tyvars, theta, tau)
  where
@@ -596,19 +688,18 @@ splitSigmaTy ty =
                Finding the kind of a type
                ~~~~~~~~~~~~~~~~~~~~~~~~~~
 \begin{code}
--- typeKind is only ever used on Types, never Kinds
--- If it were used on Kinds, the typeKind of FunTy would not be boxedTypeKind;
--- yet at the type level functions are boxed even if neither argument nor
--- result are boxed.   This seems pretty fishy to me.
+typeKind :: Type -> Kind
 
-typeKind :: GenType flexi -> Kind
-
-typeKind (TyVarTy tyvar)       = tyVarKind tyvar
+typeKind (TyVarTy tyvar)       = tyVarKind tyvar
 typeKind (TyConApp tycon tys)  = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
 typeKind (NoteTy _ ty)         = typeKind ty
-typeKind (FunTy fun arg)       = boxedTypeKind
 typeKind (AppTy fun arg)       = funResultTy (typeKind fun)
-typeKind (ForAllTy _ _)                = boxedTypeKind
+
+typeKind (FunTy arg res)       = boxedTypeKind -- A function is boxed regardless of its result type
+                                               -- No functions at the type level, hence we don't need
+                                               -- to say (typeKind res).
+
+typeKind (ForAllTy tv ty)      = typeKind ty
 \end{code}
 
 
@@ -616,26 +707,31 @@ typeKind (ForAllTy _ _)           = boxedTypeKind
                Free variables of a type
                ~~~~~~~~~~~~~~~~~~~~~~~~
 \begin{code}
-tyVarsOfType :: GenType flexi -> GenTyVarSet flexi
+tyVarsOfType :: Type -> TyVarSet
 
 tyVarsOfType (TyVarTy tv)              = unitVarSet tv
 tyVarsOfType (TyConApp tycon tys)      = tyVarsOfTypes tys
 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 tyVarsOfType (NoteTy (SynNote ty1) ty2)        = tyVarsOfType ty1
+tyVarsOfType (NoteTy (UsgNote _) ty)   = tyVarsOfType ty
+tyVarsOfType (NoteTy (UsgForAll _) ty) = tyVarsOfType ty
 tyVarsOfType (FunTy arg res)           = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 tyVarsOfType (AppTy fun arg)           = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 tyVarsOfType (ForAllTy tyvar ty)       = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 
-tyVarsOfTypes :: [GenType flexi] -> GenTyVarSet flexi
+tyVarsOfTypes :: [Type] -> TyVarSet
 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 
 -- Add a Note with the free tyvars to the top of the type
-addFreeTyVars :: GenType flexi -> GenType flexi
-addFreeTyVars ty@(NoteTy (FTVNote _) _) = ty
-addFreeTyVars ty                       = NoteTy (FTVNote (tyVarsOfType ty)) ty
+-- (but under a usage if there is one)
+addFreeTyVars :: Type -> Type
+addFreeTyVars (NoteTy note@(UsgNote   _) ty) = NoteTy note (addFreeTyVars ty)
+addFreeTyVars (NoteTy note@(UsgForAll _) ty) = NoteTy note (addFreeTyVars ty)
+addFreeTyVars ty@(NoteTy (FTVNote _) _)      = ty
+addFreeTyVars ty                            = NoteTy (FTVNote (tyVarsOfType ty)) ty
 
 -- Find the free names of a type, including the type constructors and classes it mentions
-namesOfType :: GenType flexi -> NameSet
+namesOfType :: Type -> NameSet
 namesOfType (TyVarTy tv)               = unitNameSet (getName tv)
 namesOfType (TyConApp tycon tys)       = unitNameSet (getName tycon) `unionNameSets`
                                          namesOfTypes tys
@@ -651,100 +747,80 @@ namesOfTypes tys = foldr (unionNameSets . namesOfType) emptyNameSet tys
 
 %************************************************************************
 %*                                                                     *
-\subsection{Instantiating a type}
+\subsection{TidyType}
 %*                                                                     *
 %************************************************************************
 
-@substTy@ applies a substitution to a type.  It deals correctly with name capture.
-
-\begin{code}
-substTy :: GenTyVarSubst flexi -> GenType flexi -> GenType flexi
-substTy tenv ty = subst_ty tenv tset ty
-                where
-                   tset = foldVarEnv (unionVarSet . tyVarsOfType) emptyVarSet tenv
-                               -- If ty doesn't have any for-alls, then this thunk
-                               -- will never be evaluated
-\end{code}
+tidyTy tidies up a type for printing in an error message, or in
+an interface file.
 
-@fullSubstTy@ is like @substTy@ except that it needs to be given a set
-of in-scope type variables.  In exchange it's a bit more efficient, at least
-if you happen to have that set lying around.
+It doesn't change the uniques at all, just the print names.
 
 \begin{code}
-fullSubstTy :: GenTyVarSubst flexi             -- Substitution to apply
-            -> GenTyVarSet flexi               -- Superset of the free tyvars of
-                                               -- the range of the tyvar env
-            -> GenType flexi  -> GenType flexi
--- ASSUMPTION: The substitution is idempotent.
--- Equivalently: No tyvar is both in scope, and in the domain of the substitution.
-fullSubstTy tenv tset ty | isEmptyVarEnv tenv = ty
-                        | otherwise          = subst_ty tenv tset ty
-
--- subst_ty does the business
-subst_ty tenv tset ty
-   = go ty
+tidyTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
+tidyTyVar env@(tidy_env, subst) tyvar
+  = case lookupVarEnv subst tyvar of
+
+       Just tyvar' ->  -- Already substituted
+               (env, tyvar')
+
+       Nothing ->      -- Make a new nice name for it
+
+               case tidyOccName tidy_env (getOccName name) of
+                   (tidy', occ') ->    -- New occname reqd
+                               ((tidy', subst'), tyvar')
+                             where
+                               subst' = extendVarEnv subst tyvar tyvar'
+                               tyvar' = setTyVarName tyvar name'
+                               name'  = mkLocalName (getUnique name) occ' noSrcLoc
+                                       -- Note: make a *user* tyvar, so it printes nicely
+                                       -- Could extract src loc, but no need.
   where
-    go (TyConApp tc tys)          = TyConApp tc (map go tys)
-    go (NoteTy (SynNote ty1) ty2)  = NoteTy (SynNote (go ty1)) (go ty2)
-    go (NoteTy (FTVNote _) ty2)    = go ty2            -- Discard the free tyvar note
-    go (FunTy arg res)            = FunTy (go arg) (go res)
-    go (AppTy fun arg)            = mkAppTy (go fun) (go arg)
-    go ty@(TyVarTy tv)            = case (lookupVarEnv tenv tv) of
-                                     Nothing  -> ty
-                                             Just ty' -> ty'
-    go (ForAllTy tv ty)                   = case substTyVar tenv tset tv of
-                                       (tenv', tset', tv') -> ForAllTy tv' (subst_ty tenv' tset' ty)
-
-substTyVar ::  GenTyVarSubst flexi -> GenTyVarSet flexi -> GenTyVar flexi
-          -> (GenTyVarSubst flexi,   GenTyVarSet flexi,   GenTyVar flexi)
-
-substTyVar tenv tset tv
-  | not (tv `elemVarSet` tset) -- No need to clone
-                               -- But must delete from substitution
-  = (tenv `delVarEnv` tv, tset `extendVarSet` tv, tv)
-
-  | otherwise  -- The forall's variable is in scope so
-               -- we'd better rename it away from the in-scope variables
-               -- Extending the substitution to do this renaming also
-               -- has the (correct) effect of discarding any existing
-               -- substitution for that variable
-  = (extendVarEnv tenv tv (TyVarTy tv'), tset `extendVarSet` tv', tv')
-  where
-     tv' = uniqAway tset tv
-\end{code}
+    name = tyVarName tyvar
 
+tidyTyVars env tyvars = mapAccumL tidyTyVar env tyvars
 
-@substFlexiTy@ applies a substitution to a (GenType flexi1) returning
-a (GenType flexi2).  Note that we convert from one flexi status to another.
+tidyType :: TidyEnv -> Type -> Type
+tidyType env@(tidy_env, subst) ty
+  = go ty
+  where
+    go (TyVarTy tv)        = case lookupVarEnv subst tv of
+                               Nothing  -> TyVarTy tv
+                               Just tv' -> TyVarTy tv'
+    go (TyConApp tycon tys) = let args = map go tys
+                             in args `seqList` TyConApp tycon args
+    go (NoteTy note ty)     = (NoteTy SAPPLY (go_note note)) SAPPLY (go ty)
+    go (AppTy fun arg)     = (AppTy SAPPLY (go fun)) SAPPLY (go arg)
+    go (FunTy fun arg)     = (FunTy SAPPLY (go fun)) SAPPLY (go arg)
+    go (ForAllTy tv ty)            = ForAllTy tvp SAPPLY (tidyType envp ty)
+                             where
+                               (envp, tvp) = tidyTyVar env tv
+
+    go_note (SynNote ty)        = SynNote SAPPLY (go ty)
+    go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
+    go_note note@(UsgNote _)    = note  -- Usage annotation is already tidy
+    go_note note@(UsgForAll _)  = note  -- Uvar binder is already tidy
+
+tidyTypes  env tys    = map (tidyType env) tys
+\end{code}
 
-Two assumptions, for (substFlexiTy env ty)
-       (a) the substitution, env, must cover all free tyvars of the type, ty
-       (b) the free vars of the range of the substitution must be
-               different than any of the forall'd variables in the type, ty
 
-The latter assumption is reasonable because, after all, ty has a different
-type to the range of the substitution.
+@tidyOpenType@ grabs the free type variables, tidies them
+and then uses @tidyType@ to work over the type itself
 
 \begin{code}
-substFlexiTy :: GenTyVarSubst flexi2 -> GenType flexi1 -> GenType flexi2
-substFlexiTy env ty = go ty
+tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
+tidyOpenType env ty
+  = (env', tidyType env' ty)
   where
-    go (TyVarTy tv)              = case lookupVarEnv env tv of
-                                       Just ty -> ty
-                                        Nothing -> pprPanic "substFlexiTy" (ppr tv)
-    go (TyConApp tc tys)         = TyConApp tc (map go tys)
-    go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote (go ty1)) (go ty2)
-    go (NoteTy (FTVNote _)   ty2) = go ty2     -- Discard free tyvar note
-    go (FunTy arg res)           = FunTy (go arg) (go res)
-    go (AppTy fun arg)           = mkAppTy (go fun) (go arg)
-    go (ForAllTy tv ty)          = ForAllTy tv' (substFlexiTy env' ty)
-                                 where
-                                   tv' = removeTyVarFlexi tv
-                                   env' = extendVarEnv env tv (TyVarTy tv')
-
-substFlexiTheta :: GenTyVarSubst flexi2 -> [(Class, [GenType flexi1])]
-                                       -> [(Class, [GenType flexi2])]
-substFlexiTheta env theta = [(clas, map (substFlexiTy env) tys) | (clas,tys) <- theta]
+    env'         = foldl go env (varSetElems (tyVarsOfType ty))
+    go env tyvar = fst (tidyTyVar env tyvar)
+
+tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
+tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
+
+tidyTopType :: Type -> Type
+tidyTopType ty = tidyType emptyTidyEnv ty
 \end{code}
 
 
@@ -755,144 +831,75 @@ substFlexiTheta env theta = [(clas, map (substFlexiTy env) tys) | (clas,tys) <-
 %************************************************************************
 
 \begin{code}
-isUnboxedType :: GenType flexi -> Bool
+isUnboxedType :: Type -> Bool
 isUnboxedType ty = not (isFollowableRep (typePrimRep ty))
 
-isUnLiftedType :: GenType flexi -> Bool
-isUnLiftedType ty = case splitTyConApp_maybe ty of
-                          Just (tc, ty_args) -> isUnLiftedTyCon tc
-                          other              -> False
+isUnLiftedType :: Type -> Bool
+       -- isUnLiftedType returns True for forall'd unlifted types:
+       --      x :: forall a. Int#
+       -- I found bindings like these were getting floated to the top level.
+       -- They are pretty bogus types, mind you.  It would be better never to
+       -- construct them
 
-isUnboxedTupleType :: GenType flexi -> Bool
+isUnLiftedType (ForAllTy tv ty) = isUnLiftedType ty
+isUnLiftedType (NoteTy _ ty)   = isUnLiftedType ty
+isUnLiftedType (TyConApp tc _)  = isUnLiftedTyCon tc
+isUnLiftedType other           = False
+
+isUnboxedTupleType :: Type -> Bool
 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
                           Just (tc, ty_args) -> isUnboxedTupleTyCon tc
                           other              -> False
 
-isAlgType :: GenType flexi -> Bool
+-- Should only be applied to *types*; hence the assert
+isAlgType :: Type -> Bool
 isAlgType ty = case splitTyConApp_maybe ty of
-                       Just (tc, ty_args) -> isAlgTyCon tc
+                       Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
+                                             isAlgTyCon tc
                        other              -> False
 
-typePrimRep :: GenType flexi -> PrimRep
-typePrimRep ty = case splitTyConApp_maybe ty of
-                  Just (tc, ty_args) -> tyConPrimRep tc
-                  other              -> PtrRep
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsection{Equality on types}
-%*                                                                     *
-%************************************************************************
-
-For the moment at least, type comparisons don't work if 
-there are embedded for-alls.
-
-\begin{code}
-instance Eq (GenType flexi) where
-  ty1 == ty2 = case ty1 `cmpTy` ty2 of { EQ -> True; other -> False }
-
-instance Ord (GenType flexi) where
-  compare ty1 ty2 = cmpTy ty1 ty2
+-- Should only be applied to *types*; hence the assert
+isDataType :: Type -> Bool
+isDataType ty = case splitTyConApp_maybe ty of
+                       Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
+                                             isDataTyCon tc
+                       other              -> False
 
-cmpTy :: GenType flexi -> GenType flexi -> Ordering
-cmpTy ty1 ty2
-  = cmp emptyVarEnv ty1 ty2
-  where
-  -- The "env" maps type variables in ty1 to type variables in ty2
-  -- So when comparing for-alls.. (forall tv1 . t1) (forall tv2 . t2)
-  -- we in effect substitute tv2 for tv1 in t1 before continuing
-    lookup env tv1 = case lookupVarEnv env tv1 of
-                         Just tv2 -> tv2
-                         Nothing  -> tv1
-
-    -- Get rid of NoteTy
-    cmp env (NoteTy _ ty1) ty2 = cmp env ty1 ty2
-    cmp env ty1 (NoteTy _ ty2) = cmp env ty1 ty2
-    
-    -- Deal with equal constructors
-    cmp env (TyVarTy tv1) (TyVarTy tv2) = lookup env tv1 `compare` tv2
-    cmp env (AppTy f1 a1) (AppTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
-    cmp env (FunTy f1 a1) (FunTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
-    cmp env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmps env tys1 tys2)
-    cmp env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)   = cmp (extendVarEnv env tv1 tv2) t1 t2
-    
-    -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy
-    cmp env (AppTy _ _) (TyVarTy _) = GT
-    
-    cmp env (FunTy _ _) (TyVarTy _) = GT
-    cmp env (FunTy _ _) (AppTy _ _) = GT
-    
-    cmp env (TyConApp _ _) (TyVarTy _) = GT
-    cmp env (TyConApp _ _) (AppTy _ _) = GT
-    cmp env (TyConApp _ _) (FunTy _ _) = GT
-    
-    cmp env (ForAllTy _ _) other       = GT
-    
-    cmp env _ _                               = LT
+isNewType :: Type -> Bool
+isNewType ty = case splitTyConApp_maybe ty of
+                       Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
+                                             isNewTyCon tc
+                       other              -> False
 
-    cmps env []     [] = EQ
-    cmps env (t:ts) [] = GT
-    cmps env [] (t:ts) = LT
-    cmps env (t1:t1s) (t2:t2s) = cmp env t1 t2 `thenCmp` cmps env t1s t2s
+typePrimRep :: Type -> PrimRep
+typePrimRep ty = case splitTyConApp_maybe (repType ty) of
+                  Just (tc, ty_args) -> tyConPrimRep tc
+                  other              -> PtrRep
 \end{code}
 
 
-
 %************************************************************************
 %*                                                                     *
-\subsection{Grime}
+\subsection{Sequencing on types
 %*                                                                     *
 %************************************************************************
 
-
-
 \begin{code}
-showTypeCategory :: Type -> Char
-  {-
-       {C,I,F,D}   char, int, float, double
-       T           tuple
-       S           other single-constructor type
-       {c,i,f,d}   unboxed ditto
-       t           *unpacked* tuple
-       s           *unpacked" single-cons...
-
-       v           void#
-       a           primitive array
-
-       E           enumeration type
-       +           dictionary, unless it's a ...
-       L           List
-       >           function
-       M           other (multi-constructor) data-con type
-       .           other type
-       -           reserved for others to mark as "uninteresting"
-    -}
-showTypeCategory ty
-  = if isDictTy ty
-    then '+'
-    else
-      case splitTyConApp_maybe ty of
-       Nothing -> if maybeToBool (splitFunTy_maybe ty)
-                  then '>'
-                  else '.'
-
-       Just (tycon, _) ->
-          let utc = getUnique tycon in
-         if      utc == charDataConKey    then 'C'
-         else if utc == intDataConKey     then 'I'
-         else if utc == floatDataConKey   then 'F'
-         else if utc == doubleDataConKey  then 'D'
-         else if utc == integerDataConKey then 'J'
-         else if utc == charPrimTyConKey  then 'c'
-         else if (utc == intPrimTyConKey || utc == wordPrimTyConKey
-               || utc == addrPrimTyConKey)                then 'i'
-         else if utc  == floatPrimTyConKey                then 'f'
-         else if utc  == doublePrimTyConKey               then 'd'
-         else if isPrimTyCon tycon {- array, we hope -}   then 'A'
-         else if isEnumerationTyCon tycon                 then 'E'
-         else if isTupleTyCon tycon                       then 'T'
-         else if maybeToBool (maybeTyConSingleCon tycon)  then 'S'
-         else if utc == listTyConKey                      then 'L'
-         else 'M' -- oh, well...
+seqType :: Type -> ()
+seqType (TyVarTy tv)     = tv `seq` ()
+seqType (AppTy t1 t2)    = seqType t1 `seq` seqType t2
+seqType (FunTy t1 t2)    = seqType t1 `seq` seqType t2
+seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
+seqType (TyConApp tc tys) = tc `seq` seqTypes tys
+seqType (ForAllTy tv ty)  = tv `seq` seqType ty
+
+seqTypes :: [Type] -> ()
+seqTypes []       = ()
+seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
+
+seqNote :: TyNote -> ()
+seqNote (SynNote ty)  = seqType ty
+seqNote (FTVNote set) = sizeUniqSet set `seq` ()
+seqNote (UsgNote usg) = usg `seq` ()
 \end{code}
+