3 Type(..), TyNote(..), -- Representation visible to friends
6 superKind, superBoxity, -- :: SuperKind
8 boxedKind, -- :: Kind :: BX
9 anyBoxKind, -- :: Kind :: BX
10 typeCon, -- :: KindCon :: BX -> KX
11 anyBoxCon, -- :: KindCon :: BX
13 boxedTypeKind, unboxedTypeKind, openTypeKind, -- Kind :: superKind
15 mkArrowKind, mkArrowKinds, hasMoreBoxityInfo,
19 mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
21 mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
23 mkFunTy, mkFunTys, splitFunTy_maybe, splitFunTys, funResultTy,
26 mkTyConApp, mkTyConTy, splitTyConApp_maybe,
27 splitAlgTyConApp_maybe, splitAlgTyConApp,
28 mkDictTy, splitDictTy_maybe, isDictTy,
32 mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
33 applyTy, applyTys, isForAllTy,
36 TauType, RhoType, SigmaType, ThetaType,
39 mkSigmaTy, splitSigmaTy,
42 isUnLiftedType, isUnboxedType, isUnboxedTupleType, isAlgType,
46 tyVarsOfType, tyVarsOfTypes, namesOfType, typeKind,
50 substTy, substTheta, fullSubstTy, substTyVar,
51 substTopTy, substTopTheta,
53 -- Tidying up for printing
55 tidyOpenType, tidyOpenTypes,
56 tidyTyVar, tidyTyVars,
60 #include "HsVersions.h"
62 import {-# SOURCE #-} DataCon( DataCon )
63 import {-# SOURCE #-} PprType( pprType ) -- Only called in debug messages
66 import Var ( Id, TyVar, IdOrTyVar,
67 tyVarKind, isId, idType, setVarOcc
72 import Name ( NamedThing(..), Provenance(..), ExportFlag(..),
73 mkWiredInTyConName, mkGlobalName, tcOcc,
74 tidyOccName, TidyOccEnv
77 import Class ( classTyCon, Class )
78 import TyCon ( TyCon, KindCon,
79 mkFunTyCon, mkKindCon, mkSuperKindCon,
80 matchesTyCon, isUnboxedTupleTyCon, isUnLiftedTyCon,
82 isAlgTyCon, isSynTyCon, tyConArity,
83 tyConKind, tyConDataCons, getSynTyConDefn,
84 tyConPrimRep, tyConClass_maybe
88 import BasicTypes ( Unused )
89 import SrcLoc ( mkBuiltinSrcLoc )
90 import PrelMods ( pREL_GHC )
91 import Maybes ( maybeToBool )
92 import PrimRep ( PrimRep(..), isFollowableRep )
93 import Unique -- quite a few *Keys
94 import Util ( thenCmp, mapAccumL )
99 %************************************************************************
101 \subsection{Type Classifications}
103 %************************************************************************
107 *unboxed* iff its representation is other than a pointer
108 Unboxed types cannot instantiate a type variable
109 Unboxed types are always unlifted.
111 *lifted* A type is lifted iff it has bottom as an element.
112 Closures always have lifted types: i.e. any
113 let-bound identifier in Core must have a lifted
114 type. Operationally, a lifted object is one that
116 (NOTE: previously "pointed").
118 *algebraic* A type with one or more constructors. An algebraic
119 type is one that can be deconstructed with a case
120 expression. *NOT* the same as lifted types,
121 because we also include unboxed tuples in this
124 *primitive* iff it is a built-in type that can't be expressed
127 Currently, all primitive types are unlifted, but that's not necessarily
128 the case. (E.g. Int could be primitive.)
130 Some primitive types are unboxed, such as Int#, whereas some are boxed
131 but unlifted (such as ByteArray#). The only primitive types that we
132 classify as algebraic are the unboxed tuples.
134 examples of type classifications:
136 Type primitive boxed lifted algebraic
137 -----------------------------------------------------------------------------
139 ByteArray# Yes Yes No No
140 (# a, b #) Yes No No Yes
141 ( a, b ) No Yes Yes Yes
144 %************************************************************************
146 \subsection{The data type}
148 %************************************************************************
152 type SuperKind = Type
155 type TyVarSubst = TyVarEnv Type
161 Type -- Function is *not* a TyConApp
164 | TyConApp -- Application of a TyCon
165 TyCon -- *Invariant* saturated appliations of FunTyCon and
166 -- synonyms have their own constructors, below.
167 [Type] -- Might not be saturated.
169 | FunTy -- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
173 | NoteTy -- Saturated application of a type synonym
175 Type -- The expanded version
182 = SynNote Type -- The unexpanded version of the type synonym; always a TyConApp
183 | FTVNote TyVarSet -- The free type variables of the noted expression
187 %************************************************************************
191 %************************************************************************
199 kv :: KX is a kind variable
205 | AnyBox -- Used *only* for special built-in things
206 -- like error :: forall (a::*?). String -> a
207 -- Here, the 'a' can be instantiated to a boxed or
211 bxv :: BX is a boxity variable
215 | sk -> sk -- In ptic (BX -> KX)
218 mk_kind_name key str = mkGlobalName key pREL_GHC (tcOcc str)
219 (LocalDef mkBuiltinSrcLoc NotExported)
220 -- mk_kind_name is a bit of a hack
221 -- The LocalDef means that we print the name without
222 -- a qualifier, which is what we want for these kinds.
223 -- It's used for both Kinds and Boxities
229 superKind :: SuperKind -- KX, the type of all kinds
230 superKindName = mk_kind_name kindConKey SLIT("KX")
231 superKind = TyConApp (mkSuperKindCon superKindName) []
233 superBoxity :: SuperKind -- BX, the type of all boxities
234 superBoxityName = mk_kind_name boxityConKey SLIT("BX")
235 superBoxity = TyConApp (mkSuperKindCon superBoxityName) []
238 Define Boxed, Unboxed, AnyBox
241 boxedKind, unboxedKind, anyBoxKind :: Kind -- Of superkind superBoxity
243 boxedConName = mk_kind_name boxedConKey SLIT("*")
244 boxedKind = TyConApp (mkKindCon boxedConName superBoxity) []
246 unboxedConName = mk_kind_name unboxedConKey SLIT("#")
247 unboxedKind = TyConApp (mkKindCon unboxedConName superBoxity) []
249 anyBoxConName = mk_kind_name anyBoxConKey SLIT("?")
250 anyBoxCon = mkKindCon anyBoxConName superBoxity -- A kind of wild card
251 anyBoxKind = TyConApp anyBoxCon []
258 typeConName = mk_kind_name typeConKey SLIT("Type")
259 typeCon = mkKindCon typeConName (superBoxity `FunTy` superKind)
262 Define (Type Boxed), (Type Unboxed), (Type AnyBox)
265 boxedTypeKind, unboxedTypeKind, openTypeKind :: Kind
266 boxedTypeKind = TyConApp typeCon [boxedKind]
267 unboxedTypeKind = TyConApp typeCon [unboxedKind]
268 openTypeKind = TyConApp typeCon [anyBoxKind]
270 mkArrowKind :: Kind -> Kind -> Kind
271 mkArrowKind k1 k2 = k1 `FunTy` k2
273 mkArrowKinds :: [Kind] -> Kind -> Kind
274 mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
278 hasMoreBoxityInfo :: Kind -> Kind -> Bool
279 hasMoreBoxityInfo k1 k2
280 | k2 == openTypeKind = ASSERT( is_type_kind k1) True
281 | otherwise = k1 == k2
283 -- Returns true for things of form (Type x)
284 is_type_kind k = case splitTyConApp_maybe k of
285 Just (tc,[_]) -> tc == typeCon
290 %************************************************************************
292 \subsection{Wired-in type constructors
294 %************************************************************************
296 We define a few wired-in type constructors here to avoid module knots
299 funTyConName = mkWiredInTyConName funTyConKey pREL_GHC SLIT("->") funTyCon
300 funTyCon = mkFunTyCon funTyConName (mkArrowKinds [boxedTypeKind, boxedTypeKind] boxedTypeKind)
305 %************************************************************************
307 \subsection{Constructor-specific functions}
309 %************************************************************************
312 ---------------------------------------------------------------------
316 mkTyVarTy :: TyVar -> Type
319 mkTyVarTys :: [TyVar] -> [Type]
320 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
322 getTyVar :: String -> Type -> TyVar
323 getTyVar msg (TyVarTy tv) = tv
324 getTyVar msg (NoteTy _ t) = getTyVar msg t
325 getTyVar msg other = panic ("getTyVar: " ++ msg)
327 getTyVar_maybe :: Type -> Maybe TyVar
328 getTyVar_maybe (TyVarTy tv) = Just tv
329 getTyVar_maybe (NoteTy _ t) = getTyVar_maybe t
330 getTyVar_maybe other = Nothing
332 isTyVarTy :: Type -> Bool
333 isTyVarTy (TyVarTy tv) = True
334 isTyVarTy (NoteTy _ ty) = isTyVarTy ty
335 isTyVarTy other = False
339 ---------------------------------------------------------------------
342 We need to be pretty careful with AppTy to make sure we obey the
343 invariant that a TyConApp is always visibly so. mkAppTy maintains the
347 mkAppTy orig_ty1 orig_ty2 = mk_app orig_ty1
349 mk_app (NoteTy _ ty1) = mk_app ty1
350 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
351 mk_app ty1 = AppTy orig_ty1 orig_ty2
353 mkAppTys :: Type -> [Type] -> Type
354 mkAppTys orig_ty1 [] = orig_ty1
355 -- This check for an empty list of type arguments
356 -- avoids the needless of a type synonym constructor.
357 -- For example: mkAppTys Rational []
358 -- returns to (Ratio Integer), which has needlessly lost
359 -- the Rational part.
360 mkAppTys orig_ty1 orig_tys2 = mk_app orig_ty1
362 mk_app (NoteTy _ ty1) = mk_app ty1
363 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
364 mk_app ty1 = foldl AppTy orig_ty1 orig_tys2
366 splitAppTy_maybe :: Type -> Maybe (Type, Type)
367 splitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
368 splitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
369 splitAppTy_maybe (NoteTy _ ty) = splitAppTy_maybe ty
370 splitAppTy_maybe (TyConApp tc []) = Nothing
371 splitAppTy_maybe (TyConApp tc tys) = split tys []
373 split [ty2] acc = Just (TyConApp tc (reverse acc), ty2)
374 split (ty:tys) acc = split tys (ty:acc)
376 splitAppTy_maybe other = Nothing
378 splitAppTy :: Type -> (Type, Type)
379 splitAppTy ty = case splitAppTy_maybe ty of
381 Nothing -> panic "splitAppTy"
383 splitAppTys :: Type -> (Type, [Type])
384 splitAppTys ty = split ty ty []
386 split orig_ty (AppTy ty arg) args = split ty ty (arg:args)
387 split orig_ty (NoteTy _ ty) args = split orig_ty ty args
388 split orig_ty (FunTy ty1 ty2) args = ASSERT( null args )
389 (TyConApp funTyCon [], [ty1,ty2])
390 split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
391 split orig_ty ty args = (orig_ty, args)
395 ---------------------------------------------------------------------
400 mkFunTy :: Type -> Type -> Type
401 mkFunTy arg res = FunTy arg res
403 mkFunTys :: [Type] -> Type -> Type
404 mkFunTys tys ty = foldr FunTy ty tys
406 splitFunTy_maybe :: Type -> Maybe (Type, Type)
407 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
408 splitFunTy_maybe (NoteTy _ ty) = splitFunTy_maybe ty
409 splitFunTy_maybe other = Nothing
412 splitFunTys :: Type -> ([Type], Type)
413 splitFunTys ty = split [] ty ty
415 split args orig_ty (FunTy arg res) = split (arg:args) res res
416 split args orig_ty (NoteTy _ ty) = split args orig_ty ty
417 split args orig_ty ty = (reverse args, orig_ty)
419 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
420 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
422 split acc [] nty ty = (reverse acc, nty)
423 split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
424 split acc xs nty (NoteTy _ ty) = split acc xs nty ty
425 split acc (x:xs) nty ty = pprPanic "zipFunTys" (ppr orig_xs <+> pprType orig_ty)
427 funResultTy :: Type -> Type
428 funResultTy (FunTy arg res) = res
429 funResultTy (NoteTy _ ty) = funResultTy ty
430 funResultTy ty = pprPanic "funResultTy" (pprType ty)
435 ---------------------------------------------------------------------
440 mkTyConApp :: TyCon -> [Type] -> Type
442 | isFunTyCon tycon && length tys == 2
444 (ty1:ty2:_) -> FunTy ty1 ty2
447 = ASSERT(not (isSynTyCon tycon))
450 mkTyConTy :: TyCon -> Type
451 mkTyConTy tycon = ASSERT( not (isSynTyCon tycon) )
454 -- splitTyConApp "looks through" synonyms, because they don't
455 -- mean a distinct type, but all other type-constructor applications
456 -- including functions are returned as Just ..
458 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
459 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
460 splitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
461 splitTyConApp_maybe (NoteTy _ ty) = splitTyConApp_maybe ty
462 splitTyConApp_maybe other = Nothing
464 -- splitAlgTyConApp_maybe looks for
465 -- *saturated* applications of *algebraic* data types
466 -- "Algebraic" => newtype, data type, or dictionary (not function types)
467 -- We return the constructors too.
469 splitAlgTyConApp_maybe :: Type -> Maybe (TyCon, [Type], [DataCon])
470 splitAlgTyConApp_maybe (TyConApp tc tys)
472 tyConArity tc == length tys = Just (tc, tys, tyConDataCons tc)
473 splitAlgTyConApp_maybe (NoteTy _ ty) = splitAlgTyConApp_maybe ty
474 splitAlgTyConApp_maybe other = Nothing
476 splitAlgTyConApp :: Type -> (TyCon, [Type], [DataCon])
477 -- Here the "algebraic" property is an *assertion*
478 splitAlgTyConApp (TyConApp tc tys) = ASSERT( isAlgTyCon tc && tyConArity tc == length tys )
479 (tc, tys, tyConDataCons tc)
480 splitAlgTyConApp (NoteTy _ ty) = splitAlgTyConApp ty
483 "Dictionary" types are just ordinary data types, but you can
484 tell from the type constructor whether it's a dictionary or not.
487 mkDictTy :: Class -> [Type] -> Type
488 mkDictTy clas tys = TyConApp (classTyCon clas) tys
490 splitDictTy_maybe :: Type -> Maybe (Class, [Type])
491 splitDictTy_maybe (TyConApp tc tys)
492 | maybeToBool maybe_class
493 && tyConArity tc == length tys = Just (clas, tys)
495 maybe_class = tyConClass_maybe tc
496 Just clas = maybe_class
498 splitDictTy_maybe (NoteTy _ ty) = splitDictTy_maybe ty
499 splitDictTy_maybe other = Nothing
501 isDictTy :: Type -> Bool
502 -- This version is slightly more efficient than (maybeToBool . splitDictTy)
503 isDictTy (TyConApp tc tys)
504 | maybeToBool (tyConClass_maybe tc)
505 && tyConArity tc == length tys
507 isDictTy (NoteTy _ ty) = isDictTy ty
508 isDictTy other = False
512 ---------------------------------------------------------------------
517 mkSynTy syn_tycon tys
518 = ASSERT(isSynTyCon syn_tycon)
519 NoteTy (SynNote (TyConApp syn_tycon tys))
520 (substTopTy (zipVarEnv tyvars tys) body)
522 (tyvars, body) = getSynTyConDefn syn_tycon
524 isSynTy (NoteTy (SynNote _) _) = True
525 isSynTy other = False
528 Notes on type synonyms
529 ~~~~~~~~~~~~~~~~~~~~~~
530 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
531 to return type synonyms whereever possible. Thus
536 splitFunTys (a -> Foo a) = ([a], Foo a)
539 The reason is that we then get better (shorter) type signatures in
540 interfaces. Notably this plays a role in tcTySigs in TcBinds.lhs.
545 ---------------------------------------------------------------------
550 mkForAllTy = ForAllTy
552 mkForAllTys :: [TyVar] -> Type -> Type
553 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
555 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
556 splitForAllTy_maybe (NoteTy _ ty) = splitForAllTy_maybe ty
557 splitForAllTy_maybe (ForAllTy tyvar ty) = Just(tyvar, ty)
558 splitForAllTy_maybe _ = Nothing
560 isForAllTy :: Type -> Bool
561 isForAllTy (NoteTy _ ty) = isForAllTy ty
562 isForAllTy (ForAllTy tyvar ty) = True
565 splitForAllTys :: Type -> ([TyVar], Type)
566 splitForAllTys ty = split ty ty []
568 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
569 split orig_ty (NoteTy _ ty) tvs = split orig_ty ty tvs
570 split orig_ty t tvs = (reverse tvs, orig_ty)
573 @mkPiType@ makes a (->) type or a forall type, depending on whether
574 it is given a type variable or a term variable.
577 mkPiType :: IdOrTyVar -> Type -> Type -- The more polymorphic version doesn't work...
578 mkPiType v ty | isId v = mkFunTy (idType v) ty
579 | otherwise = ForAllTy v ty
583 applyTy :: Type -> Type -> Type
584 applyTy (NoteTy _ fun) arg = applyTy fun arg
585 applyTy (ForAllTy tv ty) arg = substTy (mkVarEnv [(tv,arg)]) ty
586 applyTy other arg = panic "applyTy"
588 applyTys :: Type -> [Type] -> Type
589 applyTys fun_ty arg_tys
590 = go [] fun_ty arg_tys
592 go env ty [] = substTy (mkVarEnv env) ty
593 go env (NoteTy _ fun) args = go env fun args
594 go env (ForAllTy tv ty) (arg:args) = go ((tv,arg):env) ty args
595 go env other args = panic "applyTys"
599 %************************************************************************
601 \subsection{Stuff to do with the source-language types}
603 %************************************************************************
608 type ThetaType = [(Class, [Type])]
609 type SigmaType = Type
612 @isTauTy@ tests for nested for-alls.
615 isTauTy :: Type -> Bool
616 isTauTy (TyVarTy v) = True
617 isTauTy (TyConApp _ tys) = all isTauTy tys
618 isTauTy (AppTy a b) = isTauTy a && isTauTy b
619 isTauTy (FunTy a b) = isTauTy a && isTauTy b
620 isTauTy (NoteTy _ ty) = isTauTy ty
621 isTauTy other = False
625 mkRhoTy :: [(Class, [Type])] -> Type -> Type
626 mkRhoTy theta ty = foldr (\(c,t) r -> FunTy (mkDictTy c t) r) ty theta
628 splitRhoTy :: Type -> ([(Class, [Type])], Type)
629 splitRhoTy ty = split ty ty []
631 split orig_ty (FunTy arg res) ts = case splitDictTy_maybe arg of
632 Just pair -> split res res (pair:ts)
633 Nothing -> (reverse ts, orig_ty)
634 split orig_ty (NoteTy _ ty) ts = split orig_ty ty ts
635 split orig_ty ty ts = (reverse ts, orig_ty)
641 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
643 splitSigmaTy :: Type -> ([TyVar], [(Class, [Type])], Type)
647 (tyvars,rho) = splitForAllTys ty
648 (theta,tau) = splitRhoTy rho
652 %************************************************************************
654 \subsection{Kinds and free variables}
656 %************************************************************************
658 ---------------------------------------------------------------------
659 Finding the kind of a type
660 ~~~~~~~~~~~~~~~~~~~~~~~~~~
662 typeKind :: Type -> Kind
664 typeKind (TyVarTy tyvar) = tyVarKind tyvar
665 typeKind (TyConApp tycon tys) = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
666 typeKind (NoteTy _ ty) = typeKind ty
667 typeKind (AppTy fun arg) = funResultTy (typeKind fun)
668 typeKind (FunTy fun arg) = typeKindF arg
669 typeKind (ForAllTy _ ty) = typeKindF ty -- We could make this a new kind polyTypeKind
670 -- to prevent a forall type unifying with a
671 -- boxed type variable, but I didn't think it
674 -- The complication is that a *function* is boxed even if
675 -- its *result* type is unboxed. Seems wierd.
677 typeKindF :: Type -> Kind
678 typeKindF (NoteTy _ ty) = typeKindF ty
679 typeKindF (FunTy _ ty) = typeKindF ty
680 typeKindF (ForAllTy _ ty) = typeKindF ty
681 typeKindF other = fix_up (typeKind other)
683 fix_up (TyConApp kc _) | kc == typeCon = boxedTypeKind
684 -- Functions at the type level are always boxed
685 fix_up (NoteTy _ kind) = fix_up kind
690 ---------------------------------------------------------------------
691 Free variables of a type
692 ~~~~~~~~~~~~~~~~~~~~~~~~
694 tyVarsOfType :: Type -> TyVarSet
696 tyVarsOfType (TyVarTy tv) = unitVarSet tv
697 tyVarsOfType (TyConApp tycon tys) = tyVarsOfTypes tys
698 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
699 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty1
700 tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
701 tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
702 tyVarsOfType (ForAllTy tyvar ty) = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
704 tyVarsOfTypes :: [Type] -> TyVarSet
705 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
707 -- Add a Note with the free tyvars to the top of the type
708 addFreeTyVars :: Type -> Type
709 addFreeTyVars ty@(NoteTy (FTVNote _) _) = ty
710 addFreeTyVars ty = NoteTy (FTVNote (tyVarsOfType ty)) ty
712 -- Find the free names of a type, including the type constructors and classes it mentions
713 namesOfType :: Type -> NameSet
714 namesOfType (TyVarTy tv) = unitNameSet (getName tv)
715 namesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets`
717 namesOfType (NoteTy (SynNote ty1) ty2) = namesOfType ty1
718 namesOfType (NoteTy other_note ty2) = namesOfType ty2
719 namesOfType (FunTy arg res) = namesOfType arg `unionNameSets` namesOfType res
720 namesOfType (AppTy fun arg) = namesOfType fun `unionNameSets` namesOfType arg
721 namesOfType (ForAllTy tyvar ty) = namesOfType ty `minusNameSet` unitNameSet (getName tyvar)
723 namesOfTypes tys = foldr (unionNameSets . namesOfType) emptyNameSet tys
727 %************************************************************************
729 \subsection{Instantiating a type}
731 %************************************************************************
733 @substTy@ applies a substitution to a type. It deals correctly with name capture.
736 substTy :: TyVarSubst -> Type -> Type
738 | isEmptyVarEnv tenv = ty
739 | otherwise = subst_ty tenv tset ty
741 tset = foldVarEnv (unionVarSet . tyVarsOfType) emptyVarSet tenv
742 -- If ty doesn't have any for-alls, then this thunk
743 -- will never be evaluated
745 substTheta :: TyVarSubst -> ThetaType -> ThetaType
746 substTheta tenv theta
747 | isEmptyVarEnv tenv = theta
748 | otherwise = [(clas, map (subst_ty tenv tset) tys) | (clas, tys) <- theta]
750 tset = foldVarEnv (unionVarSet . tyVarsOfType) emptyVarSet tenv
751 -- If ty doesn't have any for-alls, then this thunk
752 -- will never be evaluated
754 substTopTy :: TyVarSubst -> Type -> Type
755 substTopTy = substTy -- Called when doing top-level substitutions.
756 -- Here we expect that the free vars of the range of the
757 -- substitution will be empty; but during typechecking I'm
758 -- a bit dubious about that (mutable tyvars bouund to Int, say)
759 -- So I've left it as substTy for the moment. SLPJ Nov 98
760 substTopTheta = substTheta
763 @fullSubstTy@ is like @substTy@ except that it needs to be given a set
764 of in-scope type variables. In exchange it's a bit more efficient, at least
765 if you happen to have that set lying around.
768 fullSubstTy :: TyVarSubst -- Substitution to apply
769 -> TyVarSet -- Superset of the free tyvars of
770 -- the range of the tyvar env
772 -- ASSUMPTION: The substitution is idempotent.
773 -- Equivalently: No tyvar is both in scope, and in the domain of the substitution.
774 fullSubstTy tenv tset ty | isEmptyVarEnv tenv = ty
775 | otherwise = subst_ty tenv tset ty
777 -- subst_ty does the business
778 subst_ty tenv tset ty
781 go (TyConApp tc tys) = TyConApp tc (map go tys)
782 go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote (go ty1)) (go ty2)
783 go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
784 go (FunTy arg res) = FunTy (go arg) (go res)
785 go (AppTy fun arg) = mkAppTy (go fun) (go arg)
786 go ty@(TyVarTy tv) = case (lookupVarEnv tenv tv) of
789 go (ForAllTy tv ty) = case substTyVar tenv tset tv of
790 (tenv', tset', tv') -> ForAllTy tv' (subst_ty tenv' tset' ty)
792 substTyVar :: TyVarSubst -> TyVarSet -> TyVar
793 -> (TyVarSubst, TyVarSet, TyVar)
795 substTyVar tenv tset tv
796 | not (tv `elemVarSet` tset) -- No need to clone
797 -- But must delete from substitution
798 = (tenv `delVarEnv` tv, tset `extendVarSet` tv, tv)
800 | otherwise -- The forall's variable is in scope so
801 -- we'd better rename it away from the in-scope variables
802 -- Extending the substitution to do this renaming also
803 -- has the (correct) effect of discarding any existing
804 -- substitution for that variable
805 = (extendVarEnv tenv tv (TyVarTy tv'), tset `extendVarSet` tv', tv')
807 tv' = uniqAway tset tv
811 %************************************************************************
813 \subsection{TidyType}
815 %************************************************************************
817 tidyTy tidies up a type for printing in an error message, or in
820 It doesn't change the uniques at all, just the print names.
823 tidyTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
824 tidyTyVar env@(tidy_env, subst) tyvar
825 = case lookupVarEnv subst tyvar of
827 Just tyvar' -> -- Already substituted
830 Nothing -> -- Make a new nice name for it
832 case tidyOccName tidy_env (getOccName tyvar) of
833 (tidy', occ') -> -- New occname reqd
834 ((tidy', subst'), tyvar')
836 subst' = extendVarEnv subst tyvar tyvar'
837 tyvar' = setVarOcc tyvar occ'
839 tidyTyVars env tyvars = mapAccumL tidyTyVar env tyvars
841 tidyType :: TidyEnv -> Type -> Type
842 tidyType env@(tidy_env, subst) ty
845 go (TyVarTy tv) = case lookupVarEnv subst tv of
846 Nothing -> TyVarTy tv
847 Just tv' -> TyVarTy tv'
848 go (TyConApp tycon tys) = TyConApp tycon (map go tys)
849 go (NoteTy note ty) = NoteTy (go_note note) (go ty)
850 go (AppTy fun arg) = AppTy (go fun) (go arg)
851 go (FunTy fun arg) = FunTy (go fun) (go arg)
852 go (ForAllTy tv ty) = ForAllTy tv' (tidyType env' ty)
854 (env', tv') = tidyTyVar env tv
856 go_note (SynNote ty) = SynNote (go ty)
857 go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
859 tidyTypes env tys = map (tidyType env) tys
863 @tidyOpenType@ grabs the free type varibles, tidies them
864 and then uses @tidyType@ to work over the type itself
867 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
869 = (env', tidyType env' ty)
871 env' = foldl go env (varSetElems (tyVarsOfType ty))
872 go env tyvar = fst (tidyTyVar env tyvar)
874 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
875 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
877 tidyTopType :: Type -> Type
878 tidyTopType ty = tidyType emptyTidyEnv ty
882 %************************************************************************
884 \subsection{Boxedness and liftedness}
886 %************************************************************************
889 isUnboxedType :: Type -> Bool
890 isUnboxedType ty = not (isFollowableRep (typePrimRep ty))
892 isUnLiftedType :: Type -> Bool
893 isUnLiftedType ty = case splitTyConApp_maybe ty of
894 Just (tc, ty_args) -> isUnLiftedTyCon tc
897 isUnboxedTupleType :: Type -> Bool
898 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
899 Just (tc, ty_args) -> isUnboxedTupleTyCon tc
902 isAlgType :: Type -> Bool
903 isAlgType ty = case splitTyConApp_maybe ty of
904 Just (tc, ty_args) -> isAlgTyCon tc
907 typePrimRep :: Type -> PrimRep
908 typePrimRep ty = case splitTyConApp_maybe ty of
909 Just (tc, ty_args) -> tyConPrimRep tc
913 %************************************************************************
915 \subsection{Equality on types}
917 %************************************************************************
919 For the moment at least, type comparisons don't work if
920 there are embedded for-alls.
923 instance Eq Type where
924 ty1 == ty2 = case ty1 `cmpTy` ty2 of { EQ -> True; other -> False }
926 instance Ord Type where
927 compare ty1 ty2 = cmpTy ty1 ty2
929 cmpTy :: Type -> Type -> Ordering
931 = cmp emptyVarEnv ty1 ty2
933 -- The "env" maps type variables in ty1 to type variables in ty2
934 -- So when comparing for-alls.. (forall tv1 . t1) (forall tv2 . t2)
935 -- we in effect substitute tv2 for tv1 in t1 before continuing
936 lookup env tv1 = case lookupVarEnv env tv1 of
941 cmp env (NoteTy _ ty1) ty2 = cmp env ty1 ty2
942 cmp env ty1 (NoteTy _ ty2) = cmp env ty1 ty2
944 -- Deal with equal constructors
945 cmp env (TyVarTy tv1) (TyVarTy tv2) = lookup env tv1 `compare` tv2
946 cmp env (AppTy f1 a1) (AppTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
947 cmp env (FunTy f1 a1) (FunTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
948 cmp env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmps env tys1 tys2)
949 cmp env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmp (extendVarEnv env tv1 tv2) t1 t2
951 -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy
952 cmp env (AppTy _ _) (TyVarTy _) = GT
954 cmp env (FunTy _ _) (TyVarTy _) = GT
955 cmp env (FunTy _ _) (AppTy _ _) = GT
957 cmp env (TyConApp _ _) (TyVarTy _) = GT
958 cmp env (TyConApp _ _) (AppTy _ _) = GT
959 cmp env (TyConApp _ _) (FunTy _ _) = GT
961 cmp env (ForAllTy _ _) other = GT
966 cmps env (t:ts) [] = GT
967 cmps env [] (t:ts) = LT
968 cmps env (t1:t1s) (t2:t2s) = cmp env t1 t2 `thenCmp` cmps env t1s t2s