Type.lhs 55.7 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3 4 5
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%

6
Type - public interface
7

8
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
9 10 11 12 13 14 15
{-# 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

batterseapower's avatar
batterseapower committed
16
-- | Main functions for manipulating types and type-related things
17
module Type (
batterseapower's avatar
batterseapower committed
18
	-- Note some of this is just re-exports from TyCon..
19

batterseapower's avatar
batterseapower committed
20 21 22 23
        -- * Main data types representing Types
	-- $type_classification
	
        -- $representation_types
dreixel's avatar
dreixel committed
24
        TyThing(..), Type, KindOrType, PredType, ThetaType,
25
        Var, TyVar, isTyVar, 
26

batterseapower's avatar
batterseapower committed
27 28
        -- ** Constructing and deconstructing types
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe,
29

30 31
	mkAppTy, mkAppTys, splitAppTy, splitAppTys, 
	splitAppTy_maybe, repSplitAppTy_maybe,
32

33 34
	mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, 
	splitFunTys, splitFunTysN,
35
	funResultTy, funArgTy, zipFunTys, 
36

dreixel's avatar
dreixel committed
37
	mkTyConApp, mkTyConTy,
38
	tyConAppTyCon_maybe, tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs, 
39
	splitTyConApp_maybe, splitTyConApp, 
40

batterseapower's avatar
batterseapower committed
41
        mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
42
        mkPiKinds, mkPiType, mkPiTypes,
43
	applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
batterseapower's avatar
batterseapower committed
44 45
	
	-- (Newtypes)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
46
	newTyConInstRhs, carefullySplitNewType_maybe,
batterseapower's avatar
batterseapower committed
47
	
48
	-- Pred types
batterseapower's avatar
batterseapower committed
49 50 51
        mkFamilyTyConApp,
	isDictLikeTy,
        mkEqPred, mkClassPred,
52
	mkIPPred,
batterseapower's avatar
batterseapower committed
53 54 55 56
        noParenPred, isClassPred, isEqPred, isIPPred,
        mkPrimEqType,

        -- Deconstructing predicate types
57
        PredTree(..), predTreePredType, classifyPredType,
batterseapower's avatar
batterseapower committed
58 59 60
        getClassPredTys, getClassPredTys_maybe,
        getEqPredTys, getEqPredTys_maybe,
        getIPPredTy_maybe,
61

batterseapower's avatar
batterseapower committed
62 63
	-- ** Common type constructors
        funTyCon,
64

batterseapower's avatar
batterseapower committed
65
        -- ** Predicates on types
dreixel's avatar
dreixel committed
66
        isTyVarTy, isFunTy, isDictTy, isPredTy, isKindTy,
batterseapower's avatar
batterseapower committed
67 68

	-- (Lifting and boxity)
69
	isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType,
batterseapower's avatar
batterseapower committed
70
	isPrimitiveType, isStrictType,
71

batterseapower's avatar
batterseapower committed
72 73
	-- * Main data types representing Kinds
	-- $kind_subtyping
dreixel's avatar
dreixel committed
74
        Kind, SimpleKind, MetaKindVar,
batterseapower's avatar
batterseapower committed
75 76 77

        -- ** Finding the kind of a type
        typeKind,
batterseapower's avatar
batterseapower committed
78 79
        
        -- ** Common Kinds and SuperKinds
dreixel's avatar
dreixel committed
80
        anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind,
batterseapower's avatar
batterseapower committed
81
        argTypeKind, ubxTupleKind, constraintKind,
82
        tySuperKind, 
batterseapower's avatar
batterseapower committed
83 84 85

        -- ** Common Kind type constructors
        liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
batterseapower's avatar
batterseapower committed
86
        argTypeKindTyCon, ubxTupleKindTyCon, constraintKindTyCon,
dreixel's avatar
dreixel committed
87
        anyKindTyCon,
batterseapower's avatar
batterseapower committed
88 89

	-- * Type free variables
batterseapower's avatar
batterseapower committed
90
	tyVarsOfType, tyVarsOfTypes,
91
	expandTypeSynonyms, 
dreixel's avatar
dreixel committed
92
	typeSize, varSetElemsKvsFirst, sortQuantVars,
93

batterseapower's avatar
batterseapower committed
94
	-- * Type comparison
95 96
        eqType, eqTypeX, eqTypes, cmpType, cmpTypes, 
	eqPred, eqPredX, cmpPred, eqKind,
97

batterseapower's avatar
batterseapower committed
98
	-- * Forcing evaluation of types
batterseapower's avatar
batterseapower committed
99
        seqType, seqTypes,
100

batterseapower's avatar
batterseapower committed
101
        -- * Other views onto Types
102
        coreView, tcView, 
batterseapower's avatar
batterseapower committed
103

Simon Peyton Jones's avatar
Simon Peyton Jones committed
104
        repType, deepRepType,
batterseapower's avatar
batterseapower committed
105 106 107 108

	-- * Type representation for the code generator
	PrimRep(..),

batterseapower's avatar
batterseapower committed
109
	typePrimRep,
batterseapower's avatar
batterseapower committed
110 111 112 113 114 115 116 117

	-- * Main type substitution data types
	TvSubstEnv,	-- Representation widely visible
	TvSubst(..), 	-- Representation visible to a few friends
	
	-- ** Manipulating type substitutions
	emptyTvSubstEnv, emptyTvSubst,
	
118
	mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
119 120
        getTvSubstEnv, setTvSubstEnv,
        zapTvSubstEnv, getTvInScope,
121
        extendTvInScope, extendTvInScopeList,
122 123
 	extendTvSubst, extendTvSubstList,
        isInScope, composeTvSubst, zipTyEnv,
124
        isEmptyTvSubst, unionTvSubst,
125

dreixel's avatar
dreixel committed
126
	-- ** Performing substitution on types and kinds
127
	substTy, substTys, substTyWith, substTysWith, substTheta, 
batterseapower's avatar
batterseapower committed
128
        substTyVar, substTyVars, substTyVarBndr,
dreixel's avatar
dreixel committed
129 130
        cloneTyVarBndr, deShadowTy, lookupTyVar,
        substKiWith, substKisWith,
131

batterseapower's avatar
batterseapower committed
132
	-- * Pretty-printing
133
	pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing, pprForAll,
batterseapower's avatar
batterseapower committed
134
	pprEqPred, pprTheta, pprThetaArrowTy, pprClassPred, 
dreixel's avatar
dreixel committed
135
        pprKind, pprParendKind, pprSourceTyCon,
136
    ) where
137

138 139
#include "HsVersions.h"

140 141 142
-- We import the representation and primitive functions from TypeRep.
-- Many things are reexported, but not the representation!

dreixel's avatar
dreixel committed
143
import Kind
144 145
import TypeRep

146
-- friends:
147
import Var
148 149 150
import VarEnv
import VarSet

151 152
import Class
import TyCon
153
import TysPrim
batterseapower's avatar
batterseapower committed
154
import {-# SOURCE #-} TysWiredIn ( eqTyCon, mkBoxedTupleTy )
dreixel's avatar
dreixel committed
155
import PrelNames	         ( eqTyConKey )
156

157
-- others
batterseapower's avatar
batterseapower committed
158
import {-# SOURCE #-} IParam ( ipTyCon )
159
import Unique		( Unique, hasKey )
batterseapower's avatar
batterseapower committed
160
import BasicTypes	( IPName(..) )
161
import Name		( Name )
Simon Peyton Jones's avatar
Simon Peyton Jones committed
162
import NameSet
163 164
import StaticFlags
import Util
165
import Outputable
166
import FastString
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
167

168
import Maybes		( orElse )
169
import Data.Maybe	( isJust )
170 171

infixr 3 `mkFunTy`	-- Associates to the right
172 173
\end{code}

batterseapower's avatar
batterseapower committed
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222
\begin{code}
-- $type_classification
-- #type_classification#
-- 
-- Types are one of:
-- 
-- [Unboxed]            Iff its representation is other than a pointer
-- 			Unboxed types are also unlifted.
-- 
-- [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.
-- 			Only lifted types may be unified with a type variable.
-- 
-- [Algebraic]          Iff it is a type with one or more constructors, whether
-- 			declared with @data@ or @newtype@.
-- 			An algebraic type is one that can be deconstructed
-- 			with a case expression. This is /not/ the same as 
--			lifted types, because we also include unboxed
-- 			tuples in this classification.
-- 
-- [Data]               Iff it is a type declared with @data@, or a boxed tuple.
-- 
-- [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: for example, @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.
-- 
-- Some examples of type classifications that may make this a bit clearer are:
-- 
-- @
-- 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
-- @

-- $representation_types
-- A /source type/ is a type that is a separate type as far as the type checker is
-- concerned, but which has a more low-level representation as far as Core-to-Core
batterseapower's avatar
batterseapower committed
223
-- passes and the rest of the back end is concerned.
batterseapower's avatar
batterseapower committed
224 225 226 227 228 229
--
-- You don't normally have to worry about this, as the utility functions in
-- this module will automatically convert a source into a representation type
-- if they are spotted, to the best of it's abilities. If you don't want this
-- to happen, use the equivalent functions from the "TcType" module.
\end{code}
230

231 232 233 234 235 236 237 238 239
%************************************************************************
%*									*
		Type representation
%*									*
%************************************************************************

\begin{code}
{-# INLINE coreView #-}
coreView :: Type -> Maybe Type
batterseapower's avatar
batterseapower committed
240 241 242 243
-- ^ In Core, we \"look through\" non-recursive newtypes and 'PredTypes': this
-- function tries to obtain a different view of the supplied type given this
--
-- Strips off the /top layer only/ of a type to give 
244 245 246
-- its underlying representation type. 
-- Returns Nothing if there is nothing to look through.
--
247 248 249
-- By being non-recursive and inlined, this case analysis gets efficiently
-- joined onto the case analysis that the caller is already doing
coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys 
batterseapower's avatar
batterseapower committed
250 251 252 253
              = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
               -- Its important to use mkAppTys, rather than (foldl AppTy),
               -- because the function part might well return a 
               -- partially-applied type constructor; indeed, usually will!
254
coreView _                 = Nothing
255 256 257 258

-----------------------------------------------
{-# INLINE tcView #-}
tcView :: Type -> Maybe Type
batterseapower's avatar
batterseapower committed
259
-- ^ Similar to 'coreView', but for the type checker, which just looks through synonyms
260 261
tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys 
			 = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
262
tcView _                 = Nothing
263 264 265
  -- 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.
266

267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283
-----------------------------------------------
expandTypeSynonyms :: Type -> Type
-- ^ Expand out all type synonyms.  Actually, it'd suffice to expand out
-- just the ones that discard type variables (e.g.  type Funny a = Int)
-- But we don't know which those are currently, so we just expand all.
expandTypeSynonyms ty 
  = go ty
  where
    go (TyConApp tc tys)
      | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys 
      = go (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
      | otherwise
      = TyConApp tc (map go tys)
    go (TyVarTy tv)    = TyVarTy tv
    go (AppTy t1 t2)   = AppTy (go t1) (go t2)
    go (FunTy t1 t2)   = FunTy (go t1) (go t2)
    go (ForAllTy tv t) = ForAllTy tv (go t)
284 285 286
\end{code}


287 288 289 290 291
%************************************************************************
%*									*
\subsection{Constructor-specific functions}
%*									*
%************************************************************************
sof's avatar
sof committed
292 293


294 295 296
---------------------------------------------------------------------
				TyVarTy
				~~~~~~~
297
\begin{code}
batterseapower's avatar
batterseapower committed
298 299
-- | Attempts to obtain the type variable underlying a 'Type', and panics with the
-- given message if this is not a type variable type. See also 'getTyVar_maybe'
300
getTyVar :: String -> Type -> TyVar
301 302 303
getTyVar msg ty = case getTyVar_maybe ty of
		    Just tv -> tv
		    Nothing -> panic ("getTyVar: " ++ msg)
304

305
isTyVarTy :: Type -> Bool
306 307
isTyVarTy ty = isJust (getTyVar_maybe ty)

batterseapower's avatar
batterseapower committed
308
-- | Attempts to obtain the type variable underlying a 'Type'
309
getTyVar_maybe :: Type -> Maybe TyVar
310 311
getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
getTyVar_maybe (TyVarTy tv) 	 	    = Just tv  
312
getTyVar_maybe _                            = Nothing
313

314 315 316
\end{code}


317 318 319 320 321 322
---------------------------------------------------------------------
				AppTy
				~~~~~
We need to be pretty careful with AppTy to make sure we obey the 
invariant that a TyConApp is always visibly so.  mkAppTy maintains the
invariant: use it.
323

324
\begin{code}
batterseapower's avatar
batterseapower committed
325
-- | Applies a type to another, as in e.g. @k a@
326
mkAppTy :: Type -> Type -> Type
327
mkAppTy orig_ty1 orig_ty2
328
  = mk_app orig_ty1
329
  where
330
    mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
331
    mk_app _                 = AppTy orig_ty1 orig_ty2
332
	-- Note that the TyConApp could be an 
333 334 335 336 337 338 339
	-- under-saturated type synonym.  GHC allows that; e.g.
	--	type Foo k = k a -> k a
	--	type Id x = x
	--	foo :: Foo Id -> Foo Id
	--
	-- Here Id is partially applied in the type sig for Foo,
	-- but once the type synonyms are expanded all is well
340

341
mkAppTys :: Type -> [Type] -> Type
342 343
mkAppTys orig_ty1 []	    = orig_ty1
	-- This check for an empty list of type arguments
344
	-- avoids the needless loss of a type synonym constructor.
345 346 347
	-- For example: mkAppTys Rational []
	--   returns to (Ratio Integer), which has needlessly lost
	--   the Rational part.
348
mkAppTys orig_ty1 orig_tys2
349
  = mk_app orig_ty1
350
  where
351 352
    mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
				-- mkTyConApp: see notes with mkAppTy
353
    mk_app _                 = foldl AppTy orig_ty1 orig_tys2
354

355
-------------
356
splitAppTy_maybe :: Type -> Maybe (Type, Type)
batterseapower's avatar
batterseapower committed
357 358 359
-- ^ Attempt to take a type application apart, whether it is a
-- function, type constructor, or plain type application. Note
-- that type family applications are NEVER unsaturated by this!
360 361 362
splitAppTy_maybe ty | Just ty' <- coreView ty
		    = splitAppTy_maybe ty'
splitAppTy_maybe ty = repSplitAppTy_maybe ty
363

364 365
-------------
repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
batterseapower's avatar
batterseapower committed
366 367
-- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that 
-- any Core view stuff is already done
368 369
repSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
repSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
370
repSplitAppTy_maybe (TyConApp tc tys) 
371 372 373
  | isDecomposableTyCon tc || tys `lengthExceeds` tyConArity tc 
  , Just (tys', ty') <- snocView tys
  = Just (TyConApp tc tys', ty')    -- Never create unsaturated type family apps!
374
repSplitAppTy_maybe _other = Nothing
375
-------------
376
splitAppTy :: Type -> (Type, Type)
batterseapower's avatar
batterseapower committed
377 378
-- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe',
-- and panics if this is not possible
379 380 381
splitAppTy ty = case splitAppTy_maybe ty of
			Just pr -> pr
			Nothing -> panic "splitAppTy"
382

383
-------------
384
splitAppTys :: Type -> (Type, [Type])
batterseapower's avatar
batterseapower committed
385 386 387
-- ^ Recursively splits a type as far as is possible, leaving a residual
-- type being applied to and the type arguments applied to it. Never fails,
-- even if that means returning an empty list of type applications.
388
splitAppTys ty = split ty ty []
389
  where
390
    split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
391 392
    split _       (AppTy ty arg)        args = split ty ty (arg:args)
    split _       (TyConApp tc tc_args) args
393
      = let -- keep type families saturated
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
394 395
            n | isDecomposableTyCon tc = 0
              | otherwise              = tyConArity tc
396
            (tc_args1, tc_args2) = splitAt n tc_args
397 398
        in
        (TyConApp tc tc_args1, tc_args2 ++ args)
399
    split _       (FunTy ty1 ty2)       args = ASSERT( null args )
400
					       (TyConApp funTyCon [], [ty1,ty2])
401
    split orig_ty _                     args = (orig_ty, args)
402

403 404
\end{code}

405 406 407 408 409

---------------------------------------------------------------------
				FunTy
				~~~~~

410
\begin{code}
411
mkFunTy :: Type -> Type -> Type
batterseapower's avatar
batterseapower committed
412
-- ^ Creates a function type from the given argument and result type
413
mkFunTy arg res = FunTy arg res
414

415
mkFunTys :: [Type] -> Type -> Type
416
mkFunTys tys ty = foldr mkFunTy ty tys
417

418 419 420
isFunTy :: Type -> Bool 
isFunTy ty = isJust (splitFunTy_maybe ty)

421
splitFunTy :: Type -> (Type, Type)
batterseapower's avatar
batterseapower committed
422 423
-- ^ Attempts to extract the argument and result types from a type, and
-- panics if that is not possible. See also 'splitFunTy_maybe'
424
splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
425
splitFunTy (FunTy arg res)   = (arg, res)
426
splitFunTy other	     = pprPanic "splitFunTy" (ppr other)
427

428
splitFunTy_maybe :: Type -> Maybe (Type, Type)
batterseapower's avatar
batterseapower committed
429
-- ^ Attempts to extract the argument and result types from a type
430
splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
431
splitFunTy_maybe (FunTy arg res)   = Just (arg, res)
432
splitFunTy_maybe _                 = Nothing
433

434
splitFunTys :: Type -> ([Type], Type)
435
splitFunTys ty = split [] ty ty
436
  where
437
    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
438 439
    split args _       (FunTy arg res)   = split (arg:args) res res
    split args orig_ty _                 = (reverse args, orig_ty)
440

441
splitFunTysN :: Int -> Type -> ([Type], Type)
batterseapower's avatar
batterseapower committed
442
-- ^ Split off exactly the given number argument types, and panics if that is not possible
443
splitFunTysN 0 ty = ([], ty)
simonpj@microsoft.com's avatar
Assert  
simonpj@microsoft.com committed
444 445
splitFunTysN n ty = ASSERT2( isFunTy ty, int n <+> ppr ty )
                    case splitFunTy ty of { (arg, res) ->
446 447 448
		    case splitFunTysN (n-1) res of { (args, res) ->
		    (arg:args, res) }}

batterseapower's avatar
batterseapower committed
449 450 451 452 453 454
-- | Splits off argument types from the given type and associating
-- them with the things in the input list from left to right. The
-- final result type is returned, along with the resulting pairs of
-- objects and types, albeit with the list of pairs in reverse order.
-- Panics if there are not enough argument types for the input list.
zipFunTys :: Outputable a => [a] -> Type -> ([(a, Type)], Type)
455 456
zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
  where
457
    split acc []     nty _                 = (reverse acc, nty)
458 459
    split acc xs     nty ty 
	  | Just ty' <- coreView ty 	   = split acc xs nty ty'
460 461
    split acc (x:xs) _   (FunTy arg res)   = split ((x,arg):acc) xs res res
    split _   _      _   _                 = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
462 463
    
funResultTy :: Type -> Type
batterseapower's avatar
batterseapower committed
464
-- ^ Extract the function result type and panic if that is not possible
465
funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
466 467
funResultTy (FunTy _arg res)  = res
funResultTy ty                = pprPanic "funResultTy" (ppr ty)
468 469

funArgTy :: Type -> Type
batterseapower's avatar
batterseapower committed
470
-- ^ Extract the function argument type and panic if that is not possible
471
funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
472 473
funArgTy (FunTy arg _res)  = arg
funArgTy ty                = pprPanic "funArgTy" (ppr ty)
474 475
\end{code}

476 477 478
---------------------------------------------------------------------
				TyConApp
				~~~~~~~~
479

480 481 482 483 484
\begin{code}
-- splitTyConApp "looks through" synonyms, because they don't
-- mean a distinct type, but all other type-constructor applications
-- including functions are returned as Just ..

batterseapower's avatar
batterseapower committed
485
-- | The same as @fst . splitTyConApp@
486 487 488 489 490 491
tyConAppTyCon_maybe :: Type -> Maybe TyCon
tyConAppTyCon_maybe ty | Just ty' <- coreView ty = tyConAppTyCon_maybe ty'
tyConAppTyCon_maybe (TyConApp tc _) = Just tc
tyConAppTyCon_maybe (FunTy {})      = Just funTyCon
tyConAppTyCon_maybe _               = Nothing

492
tyConAppTyCon :: Type -> TyCon
493
tyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic "tyConAppTyCon" (ppr ty)
494

batterseapower's avatar
batterseapower committed
495
-- | The same as @snd . splitTyConApp@
496 497 498 499 500 501 502
tyConAppArgs_maybe :: Type -> Maybe [Type]
tyConAppArgs_maybe ty | Just ty' <- coreView ty = tyConAppArgs_maybe ty'
tyConAppArgs_maybe (TyConApp _ tys) = Just tys
tyConAppArgs_maybe (FunTy arg res)  = Just [arg,res]
tyConAppArgs_maybe _                = Nothing


503
tyConAppArgs :: Type -> [Type]
504
tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty)
505

batterseapower's avatar
batterseapower committed
506 507 508
-- | Attempts to tease a type apart into a type constructor and the application
-- of a number of arguments to that constructor. Panics if that is not possible.
-- See also 'splitTyConApp_maybe'
509 510 511
splitTyConApp :: Type -> (TyCon, [Type])
splitTyConApp ty = case splitTyConApp_maybe ty of
			Just stuff -> stuff
512
			Nothing	   -> pprPanic "splitTyConApp" (ppr ty)
513

batterseapower's avatar
batterseapower committed
514 515
-- | Attempts to tease a type apart into a type constructor and the application
-- of a number of arguments to that constructor
516
splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
517
splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
518
splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
519
splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
520
splitTyConApp_maybe _                 = Nothing
521

522
newTyConInstRhs :: TyCon -> [Type] -> Type
523
-- ^ Unwrap one 'layer' of newtype on a type constructor and its arguments, using an 
batterseapower's avatar
batterseapower committed
524
-- eta-reduced version of the @newtype@ if possible
525 526 527 528 529 530
newTyConInstRhs tycon tys 
    = ASSERT2( equalLength tvs tys1, ppr tycon $$ ppr tys $$ ppr tvs )
      mkAppTys (substTyWith tvs tys1 ty) tys2
  where
    (tvs, ty)    = newTyConEtadRhs tycon
    (tys1, tys2) = splitAtList tvs tys
sof's avatar
sof committed
531
\end{code}
532

533

534 535 536 537 538 539 540 541
---------------------------------------------------------------------
				SynTy
				~~~~~

Notes on type synonyms
~~~~~~~~~~~~~~~~~~~~~~
The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
to return type synonyms whereever possible. Thus
542

543 544 545 546 547 548 549 550
	type Foo a = a -> a

we want 
	splitFunTys (a -> Foo a) = ([a], Foo a)
not			           ([a], a -> a)

The reason is that we then get better (shorter) type signatures in 
interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
551 552


553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577
Note [Expanding newtypes]
~~~~~~~~~~~~~~~~~~~~~~~~~
When expanding a type to expose a data-type constructor, we need to be
careful about newtypes, lest we fall into an infinite loop. Here are
the key examples:

  newtype Id  x = MkId x
  newtype Fix f = MkFix (f (Fix f))
  newtype T     = MkT (T -> T) 
  
  Type	         Expansion
 --------------------------
  T		 T -> T
  Fix Maybe      Maybe (Fix Maybe)
  Id (Id Int)    Int
  Fix Id         NO NO NO

Notice that we can expand T, even though it's recursive.
And we can expand Id (Id Int), even though the Id shows up
twice at the outer level.  

So, when expanding, we keep track of when we've seen a recursive
newtype at outermost level; and bale out if we see it again.


578 579
		Representation types
		~~~~~~~~~~~~~~~~~~~~
580 581

\begin{code}
batterseapower's avatar
batterseapower committed
582 583 584 585 586
-- | Looks through:
--
--	1. For-alls
--	2. Synonyms
--	3. Predicates
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
587
--	4. All newtypes, including recursive ones, but not newtype families
batterseapower's avatar
batterseapower committed
588 589
--
-- It's useful in the back end of the compiler.
590
repType :: Type -> Type
591
repType ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
592
  = go emptyNameSet ty
593
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
594 595 596 597 598 599
    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
600 601
	= go rec_nts ty

Simon Peyton Jones's avatar
Simon Peyton Jones committed
602 603 604 605 606 607 608 609 610 611 612 613 614 615
    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 rec_nts ty    	  		-- Expand predicates and synonyms
      | Just ty' <- coreView ty
      = go rec_nts ty'
616

Simon Peyton Jones's avatar
Simon Peyton Jones committed
617 618
    go rec_nts (ForAllTy _ ty)		-- Drop foralls
	= go rec_nts ty
619

Simon Peyton Jones's avatar
Simon Peyton Jones committed
620
    go rec_nts (TyConApp tc tys)	-- Expand newtypes
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
621 622
      | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
      = go rec_nts' ty'
623

Simon Peyton Jones's avatar
Simon Peyton Jones committed
624
      -- Apply recursively; this is the "deep" bit
batterseapower's avatar
batterseapower committed
625
    go rec_nts (TyConApp tc tys) = TyConApp tc (map (go rec_nts) tys)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
626 627
    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)
628

Simon Peyton Jones's avatar
Simon Peyton Jones committed
629
    go _ ty = ty
630

Simon Peyton Jones's avatar
Simon Peyton Jones committed
631
carefullySplitNewType_maybe :: NameSet -> TyCon -> [Type] -> Maybe (NameSet,Type)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
632 633
-- Return the representation of a newtype, unless 
-- we've seen it already: see Note [Expanding newtypes]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
634
-- Assumes the newtype is saturated
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
635 636
carefullySplitNewType_maybe rec_nts tc tys
  | isNewTyCon tc
Simon Peyton Jones's avatar
Simon Peyton Jones committed
637 638 639
  , tys `lengthAtLeast` tyConArity tc
  , not (tc_name `elemNameSet` rec_nts) = Just (rec_nts', newTyConInstRhs tc tys)
  | otherwise	   	                = Nothing
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
640
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
641 642
    tc_name = tyConName tc
    rec_nts' | isRecursiveTyCon tc = addOneToNameSet rec_nts tc_name
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
643 644 645
	     | otherwise	   = rec_nts


646 647
-- ToDo: this could be moved to the code generator, using splitTyConApp instead
-- of inspecting the type directly.
batterseapower's avatar
batterseapower committed
648 649

-- | Discovers the primitive representation of a more abstract 'Type'
650 651 652 653
typePrimRep :: Type -> PrimRep
typePrimRep ty = case repType ty of
		   TyConApp tc _ -> tyConPrimRep tc
		   FunTy _ _	 -> PtrRep
654
		   AppTy _ _	 -> PtrRep	-- See note below
655
		   TyVarTy _	 -> PtrRep
656
		   _             -> pprPanic "typePrimRep" (ppr ty)
657 658 659 660 661
	-- Types of the form 'f a' must be of kind *, not *#, so
	-- we are guaranteed that they are represented by pointers.
	-- The reason is that f must have kind *->*, not *->*#, because
	-- (we claim) there is no way to constrain f's kind any other
	-- way.
662 663 664
\end{code}


665 666 667
---------------------------------------------------------------------
				ForAllTy
				~~~~~~~~
668 669

\begin{code}
670
mkForAllTy :: TyVar -> Type -> Type
671
mkForAllTy tyvar ty
672
  = ForAllTy tyvar ty
673

batterseapower's avatar
batterseapower committed
674
-- | Wraps foralls over the type using the provided 'TyVar's from left to right
675
mkForAllTys :: [TyVar] -> Type -> Type
676
mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
677

678 679
mkPiKinds :: [TyVar] -> Kind -> Kind
-- mkPiKinds [k1, k2, (a:k1 -> *)] k2
dreixel's avatar
dreixel committed
680
-- returns forall k1 k2. (k1 -> *) -> k2
681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696
mkPiKinds [] res = res
mkPiKinds (tv:tvs) res 
  | isKiVar tv = ForAllTy tv          (mkPiKinds tvs res)
  | otherwise  = FunTy (tyVarKind tv) (mkPiKinds tvs res)

mkPiType  :: Var -> Type -> Type
-- ^ Makes a @(->)@ type or a forall type, depending
-- on whether it is given a type variable or a term variable.
mkPiTypes :: [Var] -> Type -> Type
-- ^ 'mkPiType' for multiple type or value arguments

mkPiType v ty
   | isId v    = mkFunTy (varType v) ty
   | otherwise = mkForAllTy v ty

mkPiTypes vs ty = foldr mkPiType ty vs
dreixel's avatar
dreixel committed
697

698 699
isForAllTy :: Type -> Bool
isForAllTy (ForAllTy _ _) = True
700
isForAllTy _              = False
701

batterseapower's avatar
batterseapower committed
702 703
-- | Attempts to take a forall type apart, returning the bound type variable
-- and the remainder of the type
704
splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
705
splitForAllTy_maybe ty = splitFAT_m ty
706
  where
707 708 709
    splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
    splitFAT_m (ForAllTy tyvar ty)	    = Just(tyvar, ty)
    splitFAT_m _			    = Nothing
sof's avatar
sof committed
710

batterseapower's avatar
batterseapower committed
711 712 713
-- | Attempts to take a forall type apart, returning all the immediate such bound
-- type variables and the remainder of the type. Always suceeds, even if that means
-- returning an empty list of 'TyVar's
714
splitForAllTys :: Type -> ([TyVar], Type)
715
splitForAllTys ty = split ty ty []
716
   where
717
     split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
718 719
     split _       (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
     split orig_ty _                 tvs = (reverse tvs, orig_ty)
720

batterseapower's avatar
batterseapower committed
721
-- | Equivalent to @snd . splitForAllTys@
722 723
dropForAlls :: Type -> Type
dropForAlls ty = snd (splitForAllTys ty)
724 725
\end{code}

726
-- (mkPiType now in CoreUtils)
727

728 729
applyTy, applyTys
~~~~~~~~~~~~~~~~~
730

731
\begin{code}
batterseapower's avatar
batterseapower committed
732 733 734 735 736 737 738
-- | Instantiate a forall type with one or more type arguments.
-- Used when we have a polymorphic function applied to type args:
--
-- > f t1 t2
--
-- We use @applyTys type-of-f [t1,t2]@ to compute the type of the expression.
-- Panics if no application is possible.
dreixel's avatar
dreixel committed
739
applyTy :: Type -> KindOrType -> Type
740 741
applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
742
applyTy _                _   = panic "applyTy"
743

dreixel's avatar
dreixel committed
744
applyTys :: Type -> [KindOrType] -> Type
batterseapower's avatar
batterseapower committed
745 746 747 748 749 750 751 752 753 754
-- ^ This function is interesting because:
--
--	1. The function may have more for-alls than there are args
--
--	2. Less obviously, it may have fewer for-alls
--
-- For case 2. think of:
--
-- > applyTys (forall a.a) [forall b.b, Int]
--
dreixel's avatar
dreixel committed
755 756 757 758 759 760
-- This really can happen, but only (I think) in situations involving
-- undefined.  For example:
--       undefined :: forall a. a
-- Term: undefined @(forall b. b->b) @Int 
-- This term should have type (Int -> Int), but notice that
-- there are more type args than foralls in 'undefined's type.
761

762 763 764 765 766
applyTys ty args = applyTysD empty ty args

applyTysD :: SDoc -> Type -> [Type] -> Type	-- Debug version
applyTysD _   orig_fun_ty []      = orig_fun_ty
applyTysD doc orig_fun_ty arg_tys 
767 768 769 770 771 772
  | n_tvs == n_args 	-- The vastly common case
  = substTyWith tvs arg_tys rho_ty
  | n_tvs > n_args 	-- Too many for-alls
  = substTyWith (take n_args tvs) arg_tys 
		(mkForAllTys (drop n_args tvs) rho_ty)
  | otherwise		-- Too many type args
773
  = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty )	-- Zero case gives infnite loop!
774 775
    applyTysD doc (substTyWith tvs (take n_tvs arg_tys) rho_ty)
	          (drop n_tvs arg_tys)
776 777 778 779
  where
    (tvs, rho_ty) = splitForAllTys orig_fun_ty 
    n_tvs = length tvs
    n_args = length arg_tys     
780
\end{code}
781

782

783 784
%************************************************************************
%*									*
785
                         Pred
786 787
%*									*
%************************************************************************
788

batterseapower's avatar
batterseapower committed
789
Predicates on PredType
790

791
\begin{code}
batterseapower's avatar
batterseapower committed
792 793 794 795 796 797 798
noParenPred :: PredType -> Bool
-- A predicate that can appear without parens before a "=>"
--       C a => a -> a
--       a~b => a -> b
-- But   (?x::Int) => Int -> Int
noParenPred p = isClassPred p || isEqPred p

799
isPredTy :: Type -> Bool
dreixel's avatar
dreixel committed
800 801 802 803 804 805
isPredTy ty
  | isSuperKind ty = False
  | otherwise = typeKind ty `eqKind` constraintKind

isKindTy :: Type -> Bool
isKindTy = isSuperKind . typeKind
806

batterseapower's avatar
batterseapower committed
807 808 809 810 811 812 813 814 815 816
isClassPred, isEqPred, isIPPred :: PredType -> Bool
isClassPred ty = case tyConAppTyCon_maybe ty of
    Just tyCon | isClassTyCon tyCon -> True
    _                               -> False
isEqPred ty = case tyConAppTyCon_maybe ty of
    Just tyCon -> tyCon `hasKey` eqTyConKey
    _          -> False
isIPPred ty = case tyConAppTyCon_maybe ty of
    Just tyCon | Just _ <- tyConIP_maybe tyCon -> True
    _                                          -> False
817 818 819
\end{code}

Make PredTypes
820

821 822 823
--------------------- Equality types ---------------------------------
\begin{code}
-- | Creates a type equality predicate
batterseapower's avatar
batterseapower committed
824
mkEqPred :: (Type, Type) -> PredType
dreixel's avatar
dreixel committed
825 826 827 828
mkEqPred (ty1, ty2)
  -- IA0_TODO: The caller should give the kind.
  = TyConApp eqTyCon [k, ty1, ty2]
  where k = defaultKind (typeKind ty1)
batterseapower's avatar
batterseapower committed
829 830

mkPrimEqType :: (Type, Type) -> Type
dreixel's avatar
dreixel committed
831 832 833 834
mkPrimEqType (ty1, ty2)
  -- IA0_TODO: The caller should give the kind.
  = TyConApp eqPrimTyCon [k, ty1, ty2]
  where k = defaultKind (typeKind ty1)
835
\end{code}
836

837 838 839 840
--------------------- Implicit parameters ---------------------------------

\begin{code}
mkIPPred :: IPName Name -> Type -> PredType
batterseapower's avatar
batterseapower committed
841
mkIPPred ip ty = TyConApp (ipTyCon ip) [ty]
842 843
\end{code}

844
--------------------- Dictionary types ---------------------------------
845
\begin{code}
846
mkClassPred :: Class -> [Type] -> PredType
batterseapower's avatar
batterseapower committed
847
mkClassPred clas tys = TyConApp (classTyCon clas) tys
848

849
isDictTy :: Type -> Bool
batterseapower's avatar
batterseapower committed
850
isDictTy = isClassPred
851

852 853
isDictLikeTy :: Type -> Bool
-- Note [Dictionary-like types]
854 855 856 857 858
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
859
\end{code}
860

861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889
Note [Dictionary-like types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Being "dictionary-like" means either a dictionary type or a tuple thereof.
In GHC 6.10 we build implication constraints which construct such tuples,
and if we land up with a binding
    t :: (C [a], Eq [a])
    t = blah
then we want to treat t as cheap under "-fdicts-cheap" for example.
(Implication constraints are normally inlined, but sadly not if the
occurrence is itself inside an INLINE function!  Until we revise the 
handling of implication constraints, that is.)  This turned out to
be important in getting good arities in DPH code.  Example:

    class C a
    class D a where { foo :: a -> a }
    instance C a => D (Maybe a) where { foo x = x }

    bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)
    {-# INLINE bar #-}
    bar x y = (foo (Just x), foo (Just y))

Then 'bar' should jolly well have arity 4 (two dicts, two args), but
we ended up with something like
   bar = __inline_me__ (\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...
                                in \x,y. <blah>)

This is all a bit ad-hoc; eg it relies on knowing that implication
constraints build tuples.

batterseapower's avatar
batterseapower committed
890 891 892 893 894 895 896

Decomposing PredType

\begin{code}
data PredTree = ClassPred Class [Type]
              | EqPred Type Type
              | IPPred (IPName Name) Type
897
              | TuplePred [PredType]
batterseapower's avatar
batterseapower committed
898 899 900 901 902 903
              | IrredPred PredType

predTreePredType :: PredTree -> PredType
predTreePredType (ClassPred clas tys) = mkClassPred clas tys
predTreePredType (EqPred ty1 ty2)     = mkEqPred (ty1, ty2)
predTreePredType (IPPred ip ty)       = mkIPPred ip ty
904
predTreePredType (TuplePred tys)      = mkBoxedTupleTy tys
batterseapower's avatar
batterseapower committed
905 906
predTreePredType (IrredPred ty)       = ty

907 908
classifyPredType :: PredType -> PredTree
classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
batterseapower's avatar
batterseapower committed
909 910 911
    Just (tc, tys) | Just clas <- tyConClass_maybe tc
                   -> ClassPred clas tys
    Just (tc, tys) | tc `hasKey` eqTyConKey
dreixel's avatar
dreixel committed
912
                   , let [_, ty1, ty2] = tys
batterseapower's avatar
batterseapower committed
913 914 915 916 917
                   -> EqPred ty1 ty2
    Just (tc, tys) | Just ip <- tyConIP_maybe tc
                   , let [ty] = tys
                   -> IPPred ip ty
    Just (tc, tys) | isTupleTyCon tc
918
                   -> TuplePred tys
batterseapower's avatar
batterseapower committed
919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939
    _ -> IrredPred ev_ty
\end{code}

\begin{code}
getClassPredTys :: PredType -> (Class, [Type])
getClassPredTys ty = case getClassPredTys_maybe ty of
        Just (clas, tys) -> (clas, tys)
        Nothing          -> pprPanic "getClassPredTys" (ppr ty)

getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
getClassPredTys_maybe ty = case splitTyConApp_maybe ty of 
        Just (tc, tys) | Just clas <- tyConClass_maybe tc -> Just (clas, tys)
        _ -> Nothing

getEqPredTys :: PredType -> (Type, Type)
getEqPredTys ty = case getEqPredTys_maybe ty of
        Just (ty1, ty2) -> (ty1, ty2)
        Nothing         -> pprPanic "getEqPredTys" (ppr ty)

getEqPredTys_maybe :: PredType -> Maybe (Type, Type)
getEqPredTys_maybe ty = case splitTyConApp_maybe ty of 
dreixel's avatar
dreixel committed
940
        Just (tc, [_, ty1, ty2]) | tc `hasKey` eqTyConKey -> Just (ty1, ty2)
batterseapower's avatar
batterseapower committed
941 942 943 944 945 946 947 948
        _ -> Nothing

getIPPredTy_maybe :: PredType -> Maybe (IPName Name, Type)
getIPPredTy_maybe ty = case splitTyConApp_maybe ty of 
        Just (tc, [ty1]) | Just ip <- tyConIP_maybe tc -> Just (ip, ty1)
        _ -> Nothing
\end{code}

949 950 951 952 953 954 955 956 957 958 959 960 961
%************************************************************************
%*									*
                   Size									
%*									*
%************************************************************************

\begin{code}
typeSize :: Type -> Int
typeSize (TyVarTy _)     = 1
typeSize (AppTy t1 t2)   = typeSize t1 + typeSize t2
typeSize (FunTy t1 t2)   = typeSize t1 + typeSize t2
typeSize (ForAllTy _ t)  = 1 + typeSize t
typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts)
dreixel's avatar
dreixel committed
962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981

varSetElemsKvsFirst :: VarSet -> [TyVar]
-- {k1,a,k2,b} --> [k1,k2,a,b]
varSetElemsKvsFirst set = uncurry (++) $ partitionKiTyVars (varSetElems set)

sortQuantVars :: [Var] -> [Var]
-- Sort the variables so the true kind then type variables come first
sortQuantVars = sortLe le
  where
    v1 `le` v2 = case (is_tv v1, is_tv v2) of
                   (True, False)  -> True
                   (False, True)  -> False
                   (True, True)   ->
                     case (is_kv v1, is_kv v2) of
                       (True, False) -> True
                       (False, True) -> False
                       _             -> v1 <= v2  -- Same family
                   (False, False) -> v1 <= v2
    is_tv v = isTyVar v
    is_kv v = isSuperKind (tyVarKind v)
982 983 984
\end{code}


985 986 987 988 989 990 991
%************************************************************************
%*									*
\subsection{Type families}
%*									*
%************************************************************************

\begin{code}
992 993 994