2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[Type]{Type - public interface}
8 -- re-exports from TypeRep:
10 Type, PredType(..), ThetaType,
13 superKind, superBoxity, -- KX and BX respectively
14 liftedBoxity, unliftedBoxity, -- :: BX
16 typeCon, -- :: BX -> KX
17 liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX
18 isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, isSuperKind,
19 mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
20 isTypeKind, isAnyTypeKind,
23 -- exports from this module:
24 hasMoreBoxityInfo, defaultKind,
26 mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
28 mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
30 mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, splitFunTys,
31 funResultTy, funArgTy, zipFunTys, isFunTy,
33 mkGenTyConApp, mkTyConApp, mkTyConTy,
34 tyConAppTyCon, tyConAppArgs,
35 splitTyConApp_maybe, splitTyConApp,
41 mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
42 applyTy, applyTys, isForAllTy, dropForAlls,
45 predTypeRep, mkPredTy, mkPredTys,
48 splitRecNewType_maybe,
51 isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
52 isStrictType, isStrictPred,
55 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
56 typeKind, addFreeTyVars,
58 -- Tidying up for printing
60 tidyOpenType, tidyOpenTypes,
61 tidyTyVarBndr, tidyFreeTyVars,
62 tidyOpenTyVar, tidyOpenTyVars,
63 tidyTopType, tidyPred,
72 pprKind, pprParendKind,
73 pprType, pprParendType,
74 pprPred, pprTheta, pprThetaArrow, pprClassPred
77 #include "HsVersions.h"
79 -- We import the representation and primitive functions from TypeRep.
80 -- Many things are reexported, but not the representation!
86 import {-# SOURCE #-} Subst ( substTyWith )
89 import Var ( TyVar, tyVarKind, tyVarName, setTyVarName )
93 import Name ( NamedThing(..), mkInternalName, tidyOccName )
94 import Class ( Class, classTyCon )
95 import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon,
96 isUnboxedTupleTyCon, isUnLiftedTyCon,
97 isFunTyCon, isNewTyCon, newTyConRep,
98 isAlgTyCon, isSynTyCon, tyConArity,
99 tyConKind, getSynTyConDefn,
104 import CmdLineOpts ( opt_DictsStrict )
105 import SrcLoc ( noSrcLoc )
106 import PrimRep ( PrimRep(..) )
107 import Unique ( Uniquable(..) )
108 import Util ( mapAccumL, seqList, lengthIs, snocView )
110 import UniqSet ( sizeUniqSet ) -- Should come via VarSet
111 import Maybe ( isJust )
115 %************************************************************************
117 \subsection{Stuff to do with kinds.}
119 %************************************************************************
122 hasMoreBoxityInfo :: Kind -> Kind -> Bool
123 -- (k1 `hasMoreBoxityInfo` k2) checks that k1 <: k2
124 hasMoreBoxityInfo k1 k2
125 | k2 `eqKind` openTypeKind = isAnyTypeKind k1
126 | otherwise = k1 `eqKind` k2
128 isAnyTypeKind :: Kind -> Bool
129 -- True of kind * and *# and ?
130 isAnyTypeKind (TyConApp tc _) = tc == typeCon || tc == openKindCon
131 isAnyTypeKind (NoteTy _ k) = isAnyTypeKind k
132 isAnyTypeKind other = False
134 isTypeKind :: Kind -> Bool
135 -- True of kind * and *#
136 isTypeKind (TyConApp tc _) = tc == typeCon
137 isTypeKind (NoteTy _ k) = isTypeKind k
138 isTypeKind other = False
140 defaultKind :: Kind -> Kind
141 -- Used when generalising: default kind '?' to '*'
142 defaultKind kind | kind `eqKind` openTypeKind = liftedTypeKind
147 %************************************************************************
149 \subsection{Constructor-specific functions}
151 %************************************************************************
154 ---------------------------------------------------------------------
158 mkTyVarTy :: TyVar -> Type
161 mkTyVarTys :: [TyVar] -> [Type]
162 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
164 getTyVar :: String -> Type -> TyVar
165 getTyVar msg ty = case getTyVar_maybe ty of
167 Nothing -> panic ("getTyVar: " ++ msg)
169 isTyVarTy :: Type -> Bool
170 isTyVarTy ty = isJust (getTyVar_maybe ty)
172 getTyVar_maybe :: Type -> Maybe TyVar
173 getTyVar_maybe (TyVarTy tv) = Just tv
174 getTyVar_maybe (NoteTy _ t) = getTyVar_maybe t
175 getTyVar_maybe (PredTy p) = getTyVar_maybe (predTypeRep p)
176 getTyVar_maybe (NewTcApp tc tys) = getTyVar_maybe (newTypeRep tc tys)
177 getTyVar_maybe other = Nothing
181 ---------------------------------------------------------------------
184 We need to be pretty careful with AppTy to make sure we obey the
185 invariant that a TyConApp is always visibly so. mkAppTy maintains the
189 mkAppTy orig_ty1 orig_ty2
192 mk_app (NoteTy _ ty1) = mk_app ty1
193 mk_app (NewTcApp tc tys) = NewTcApp tc (tys ++ [orig_ty2])
194 mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ [orig_ty2])
195 mk_app ty1 = AppTy orig_ty1 orig_ty2
196 -- We call mkGenTyConApp because the TyConApp could be an
197 -- under-saturated type synonym. GHC allows that; e.g.
198 -- type Foo k = k a -> k a
200 -- foo :: Foo Id -> Foo Id
202 -- Here Id is partially applied in the type sig for Foo,
203 -- but once the type synonyms are expanded all is well
205 mkAppTys :: Type -> [Type] -> Type
206 mkAppTys orig_ty1 [] = orig_ty1
207 -- This check for an empty list of type arguments
208 -- avoids the needless loss of a type synonym constructor.
209 -- For example: mkAppTys Rational []
210 -- returns to (Ratio Integer), which has needlessly lost
211 -- the Rational part.
212 mkAppTys orig_ty1 orig_tys2
215 mk_app (NoteTy _ ty1) = mk_app ty1
216 mk_app (NewTcApp tc tys) = NewTcApp tc (tys ++ orig_tys2)
217 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
218 -- Use mkTyConApp in case tc is (->)
219 mk_app ty1 = foldl AppTy orig_ty1 orig_tys2
221 splitAppTy_maybe :: Type -> Maybe (Type, Type)
222 splitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
223 splitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
224 splitAppTy_maybe (NoteTy _ ty) = splitAppTy_maybe ty
225 splitAppTy_maybe (PredTy p) = splitAppTy_maybe (predTypeRep p)
226 splitAppTy_maybe (NewTcApp tc tys) = splitAppTy_maybe (newTypeRep tc tys)
227 splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
229 Just (tys',ty') -> Just (mkGenTyConApp tc tys', ty')
230 -- mkGenTyConApp just in case the tc is a newtype
232 splitAppTy_maybe other = Nothing
234 splitAppTy :: Type -> (Type, Type)
235 splitAppTy ty = case splitAppTy_maybe ty of
237 Nothing -> panic "splitAppTy"
239 splitAppTys :: Type -> (Type, [Type])
240 splitAppTys ty = split ty ty []
242 split orig_ty (AppTy ty arg) args = split ty ty (arg:args)
243 split orig_ty (NoteTy _ ty) args = split orig_ty ty args
244 split orig_ty (PredTy p) args = split orig_ty (predTypeRep p) args
245 split orig_ty (NewTcApp tc tc_args) args = split orig_ty (newTypeRep tc tc_args) args
246 split orig_ty (TyConApp tc tc_args) args = (mkGenTyConApp tc [], tc_args ++ args)
247 -- mkGenTyConApp just in case the tc is a newtype
248 split orig_ty (FunTy ty1 ty2) args = ASSERT( null args )
249 (TyConApp funTyCon [], [ty1,ty2])
250 split orig_ty ty args = (orig_ty, args)
254 ---------------------------------------------------------------------
259 mkFunTy :: Type -> Type -> Type
260 mkFunTy arg res = FunTy arg res
262 mkFunTys :: [Type] -> Type -> Type
263 mkFunTys tys ty = foldr FunTy ty tys
265 isFunTy :: Type -> Bool
266 isFunTy ty = isJust (splitFunTy_maybe ty)
268 splitFunTy :: Type -> (Type, Type)
269 splitFunTy (FunTy arg res) = (arg, res)
270 splitFunTy (NoteTy _ ty) = splitFunTy ty
271 splitFunTy (PredTy p) = splitFunTy (predTypeRep p)
272 splitFunTy (NewTcApp tc tys) = splitFunTy (newTypeRep tc tys)
273 splitFunTy other = pprPanic "splitFunTy" (ppr other)
275 splitFunTy_maybe :: Type -> Maybe (Type, Type)
276 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
277 splitFunTy_maybe (NoteTy _ ty) = splitFunTy_maybe ty
278 splitFunTy_maybe (PredTy p) = splitFunTy_maybe (predTypeRep p)
279 splitFunTy_maybe (NewTcApp tc tys) = splitFunTy_maybe (newTypeRep tc tys)
280 splitFunTy_maybe other = Nothing
282 splitFunTys :: Type -> ([Type], Type)
283 splitFunTys ty = split [] ty ty
285 split args orig_ty (FunTy arg res) = split (arg:args) res res
286 split args orig_ty (NoteTy _ ty) = split args orig_ty ty
287 split args orig_ty (PredTy p) = split args orig_ty (predTypeRep p)
288 split args orig_ty (NewTcApp tc tys) = split args orig_ty (newTypeRep tc tys)
289 split args orig_ty ty = (reverse args, orig_ty)
291 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
292 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
294 split acc [] nty ty = (reverse acc, nty)
295 split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
296 split acc xs nty (NoteTy _ ty) = split acc xs nty ty
297 split acc xs nty (PredTy p) = split acc xs nty (predTypeRep p)
298 split acc xs nty (NewTcApp tc tys) = split acc xs nty (newTypeRep tc tys)
299 split acc (x:xs) nty ty = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
301 funResultTy :: Type -> Type
302 funResultTy (FunTy arg res) = res
303 funResultTy (NoteTy _ ty) = funResultTy ty
304 funResultTy (PredTy p) = funResultTy (predTypeRep p)
305 funResultTy (NewTcApp tc tys) = funResultTy (newTypeRep tc tys)
306 funResultTy ty = pprPanic "funResultTy" (ppr ty)
308 funArgTy :: Type -> Type
309 funArgTy (FunTy arg res) = arg
310 funArgTy (NoteTy _ ty) = funArgTy ty
311 funArgTy (PredTy p) = funArgTy (predTypeRep p)
312 funArgTy (NewTcApp tc tys) = funArgTy (newTypeRep tc tys)
313 funArgTy ty = pprPanic "funArgTy" (ppr ty)
317 ---------------------------------------------------------------------
320 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or PredTy,
324 mkGenTyConApp :: TyCon -> [Type] -> Type
326 | isSynTyCon tc = mkSynTy tc tys
327 | otherwise = mkTyConApp tc tys
329 mkTyConApp :: TyCon -> [Type] -> Type
330 -- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
332 | isFunTyCon tycon, [ty1,ty2] <- tys
339 = ASSERT(not (isSynTyCon tycon))
342 mkTyConTy :: TyCon -> Type
343 mkTyConTy tycon = mkTyConApp tycon []
345 -- splitTyConApp "looks through" synonyms, because they don't
346 -- mean a distinct type, but all other type-constructor applications
347 -- including functions are returned as Just ..
349 tyConAppTyCon :: Type -> TyCon
350 tyConAppTyCon ty = fst (splitTyConApp ty)
352 tyConAppArgs :: Type -> [Type]
353 tyConAppArgs ty = snd (splitTyConApp ty)
355 splitTyConApp :: Type -> (TyCon, [Type])
356 splitTyConApp ty = case splitTyConApp_maybe ty of
358 Nothing -> pprPanic "splitTyConApp" (ppr ty)
360 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
361 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
362 splitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
363 splitTyConApp_maybe (NoteTy _ ty) = splitTyConApp_maybe ty
364 splitTyConApp_maybe (PredTy p) = splitTyConApp_maybe (predTypeRep p)
365 splitTyConApp_maybe (NewTcApp tc tys) = splitTyConApp_maybe (newTypeRep tc tys)
366 splitTyConApp_maybe other = Nothing
370 ---------------------------------------------------------------------
376 | n_args == arity -- Exactly saturated
378 | n_args > arity -- Over-saturated
379 = case splitAt arity tys of { (as,bs) -> mkAppTys (mk_syn as) bs }
380 -- Its important to use mkAppTys, rather than (foldl AppTy),
381 -- because (mk_syn as) might well return a partially-applied
382 -- type constructor; indeed, usually will!
383 | otherwise -- Un-saturated
385 -- For the un-saturated case we build TyConApp directly
386 -- (mkTyConApp ASSERTs that the tc isn't a SynTyCon).
387 -- Here we are relying on checkValidType to find
388 -- the error. What we can't do is use mkSynTy with
389 -- too few arg tys, because that is utterly bogus.
392 mk_syn tys = NoteTy (SynNote (TyConApp tycon tys))
393 (substTyWith tyvars tys body)
395 (tyvars, body) = ASSERT( isSynTyCon tycon ) getSynTyConDefn tycon
396 arity = tyConArity tycon
400 Notes on type synonyms
401 ~~~~~~~~~~~~~~~~~~~~~~
402 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
403 to return type synonyms whereever possible. Thus
408 splitFunTys (a -> Foo a) = ([a], Foo a)
411 The reason is that we then get better (shorter) type signatures in
412 interfaces. Notably this plays a role in tcTySigs in TcBinds.lhs.
417 repType looks through
421 (d) usage annotations
422 (e) [recursive] newtypes
423 It's useful in the back end.
426 repType :: Type -> Type
427 -- Only applied to types of kind *; hence tycons are saturated
428 repType (ForAllTy _ ty) = repType ty
429 repType (NoteTy _ ty) = repType ty
430 repType (PredTy p) = repType (predTypeRep p)
431 repType (NewTcApp tc tys) = ASSERT( tys `lengthIs` tyConArity tc )
432 repType (new_type_rep tc tys)
436 typePrimRep :: Type -> PrimRep
437 typePrimRep ty = case repType ty of
438 TyConApp tc _ -> tyConPrimRep tc
440 AppTy _ _ -> PtrRep -- ??
442 other -> pprPanic "typePrimRep" (ppr ty)
447 ---------------------------------------------------------------------
452 mkForAllTy :: TyVar -> Type -> Type
454 = mkForAllTys [tyvar] ty
456 mkForAllTys :: [TyVar] -> Type -> Type
457 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
459 isForAllTy :: Type -> Bool
460 isForAllTy (NoteTy _ ty) = isForAllTy ty
461 isForAllTy (ForAllTy _ _) = True
462 isForAllTy other_ty = False
464 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
465 splitForAllTy_maybe ty = splitFAT_m ty
467 splitFAT_m (NoteTy _ ty) = splitFAT_m ty
468 splitFAT_m (PredTy p) = splitFAT_m (predTypeRep p)
469 splitFAT_m (NewTcApp tc tys) = splitFAT_m (newTypeRep tc tys)
470 splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
471 splitFAT_m _ = Nothing
473 splitForAllTys :: Type -> ([TyVar], Type)
474 splitForAllTys ty = split ty ty []
476 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
477 split orig_ty (NoteTy _ ty) tvs = split orig_ty ty tvs
478 split orig_ty (PredTy p) tvs = split orig_ty (predTypeRep p) tvs
479 split orig_ty (NewTcApp tc tys) tvs = split orig_ty (newTypeRep tc tys) tvs
480 split orig_ty t tvs = (reverse tvs, orig_ty)
482 dropForAlls :: Type -> Type
483 dropForAlls ty = snd (splitForAllTys ty)
486 -- (mkPiType now in CoreUtils)
490 Instantiate a for-all type with one or more type arguments.
491 Used when we have a polymorphic function applied to type args:
493 Then we use (applyTys type-of-f [t1,t2]) to compute the type of
497 applyTy :: Type -> Type -> Type
498 applyTy (PredTy p) arg = applyTy (predTypeRep p) arg
499 applyTy (NewTcApp tc tys) arg = applyTy (newTypeRep tc tys) arg
500 applyTy (NoteTy _ fun) arg = applyTy fun arg
501 applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
502 applyTy other arg = panic "applyTy"
504 applyTys :: Type -> [Type] -> Type
505 -- This function is interesting because
506 -- a) the function may have more for-alls than there are args
507 -- b) less obviously, it may have fewer for-alls
508 -- For case (b) think of
509 -- applyTys (forall a.a) [forall b.b, Int]
510 -- This really can happen, via dressing up polymorphic types with newtype
511 -- clothing. Here's an example:
512 -- newtype R = R (forall a. a->a)
513 -- foo = case undefined :: R of
516 applyTys orig_fun_ty [] = orig_fun_ty
517 applyTys orig_fun_ty arg_tys
518 | n_tvs == n_args -- The vastly common case
519 = substTyWith tvs arg_tys rho_ty
520 | n_tvs > n_args -- Too many for-alls
521 = substTyWith (take n_args tvs) arg_tys
522 (mkForAllTys (drop n_args tvs) rho_ty)
523 | otherwise -- Too many type args
524 = ASSERT2( n_tvs > 0, ppr orig_fun_ty ) -- Zero case gives infnite loop!
525 applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
528 (tvs, rho_ty) = splitForAllTys orig_fun_ty
530 n_args = length arg_tys
534 %************************************************************************
536 \subsection{Source types}
538 %************************************************************************
540 A "source type" is a type that is a separate type as far as the type checker is
541 concerned, but which has low-level representation as far as the back end is concerned.
543 Source types are always lifted.
545 The key function is predTypeRep which gives the representation of a source type:
548 mkPredTy :: PredType -> Type
549 mkPredTy pred = PredTy pred
551 mkPredTys :: ThetaType -> [Type]
552 mkPredTys preds = map PredTy preds
554 predTypeRep :: PredType -> Type
555 -- Convert a PredType to its "representation type";
556 -- the post-type-checking type used by all the Core passes of GHC.
557 predTypeRep (IParam _ ty) = ty
558 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
559 -- Result might be a NewTcApp, but the consumer will
560 -- look through that too if necessary
564 %************************************************************************
568 %************************************************************************
571 splitRecNewType_maybe :: Type -> Maybe Type
572 -- Newtypes are always represented by a NewTcApp
573 -- Sometimes we want to look through a recursive newtype, and that's what happens here
574 -- Only applied to types of kind *, hence the newtype is always saturated
575 splitRecNewType_maybe (NoteTy _ ty) = splitRecNewType_maybe ty
576 splitRecNewType_maybe (NewTcApp tc tys)
577 | isRecursiveTyCon tc
578 = ASSERT( tys `lengthIs` tyConArity tc && isNewTyCon tc )
579 -- The assert should hold because repType should
580 -- only be applied to *types* (of kind *)
581 Just (new_type_rep tc tys)
582 splitRecNewType_maybe other = Nothing
584 -----------------------------
585 newTypeRep :: TyCon -> [Type] -> Type
586 -- A local helper function (not exported)
587 -- Expands a newtype application to
588 -- *either* a vanilla TyConApp (recursive newtype, or non-saturated)
589 -- *or* the newtype representation (otherwise)
590 -- Either way, the result is not a NewTcApp
592 -- NB: the returned TyConApp is always deconstructed immediately by the
593 -- caller... a TyConApp with a newtype type constructor never lives
594 -- in an ordinary type
596 | not (isRecursiveTyCon tc), -- Not recursive and saturated
597 tys `lengthIs` tyConArity tc -- treat as equivalent to expansion
598 = new_type_rep tc tys
601 -- ToDo: Consider caching this substitution in a NType
603 ----------------------------
604 -- new_type_rep doesn't ask any questions:
605 -- it just expands newtype, whether recursive or not
606 new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
607 case newTyConRep new_tycon of
608 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
612 %************************************************************************
614 \subsection{Kinds and free variables}
616 %************************************************************************
618 ---------------------------------------------------------------------
619 Finding the kind of a type
620 ~~~~~~~~~~~~~~~~~~~~~~~~~~
622 typeKind :: Type -> Kind
624 typeKind (TyVarTy tyvar) = tyVarKind tyvar
625 typeKind (TyConApp tycon tys) = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
626 typeKind (NewTcApp tycon tys) = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
627 typeKind (NoteTy _ ty) = typeKind ty
628 typeKind (PredTy _) = liftedTypeKind -- Predicates are always
629 -- represented by lifted types
630 typeKind (AppTy fun arg) = funResultTy (typeKind fun)
632 typeKind (FunTy arg res) = fix_up (typeKind res)
634 fix_up (TyConApp tycon _) | tycon == typeCon
635 || tycon == openKindCon = liftedTypeKind
636 fix_up (NoteTy _ kind) = fix_up kind
638 -- The basic story is
639 -- typeKind (FunTy arg res) = typeKind res
640 -- But a function is lifted regardless of its result type
641 -- Hence the strange fix-up.
642 -- Note that 'res', being the result of a FunTy, can't have
643 -- a strange kind like (*->*).
645 typeKind (ForAllTy tv ty) = typeKind ty
649 ---------------------------------------------------------------------
650 Free variables of a type
651 ~~~~~~~~~~~~~~~~~~~~~~~~
653 tyVarsOfType :: Type -> TyVarSet
654 tyVarsOfType (TyVarTy tv) = unitVarSet tv
655 tyVarsOfType (TyConApp tycon tys) = tyVarsOfTypes tys
656 tyVarsOfType (NewTcApp tycon tys) = tyVarsOfTypes tys
657 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
658 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty2 -- See note [Syn] below
659 tyVarsOfType (PredTy sty) = tyVarsOfPred sty
660 tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
661 tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
662 tyVarsOfType (ForAllTy tyvar ty) = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
667 -- What are the free tyvars of (T x)? Empty, of course!
668 -- Here's the example that Ralf Laemmel showed me:
669 -- foo :: (forall a. C u a -> C u a) -> u
670 -- mappend :: Monoid u => u -> u -> u
672 -- bar :: Monoid u => u
673 -- bar = foo (\t -> t `mappend` t)
674 -- We have to generalise at the arg to f, and we don't
675 -- want to capture the constraint (Monad (C u a)) because
676 -- it appears to mention a. Pretty silly, but it was useful to him.
679 tyVarsOfTypes :: [Type] -> TyVarSet
680 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
682 tyVarsOfPred :: PredType -> TyVarSet
683 tyVarsOfPred (IParam _ ty) = tyVarsOfType ty
684 tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
686 tyVarsOfTheta :: ThetaType -> TyVarSet
687 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
689 -- Add a Note with the free tyvars to the top of the type
690 addFreeTyVars :: Type -> Type
691 addFreeTyVars ty@(NoteTy (FTVNote _) _) = ty
692 addFreeTyVars ty = NoteTy (FTVNote (tyVarsOfType ty)) ty
695 %************************************************************************
697 \subsection{TidyType}
699 %************************************************************************
701 tidyTy tidies up a type for printing in an error message, or in
704 It doesn't change the uniques at all, just the print names.
707 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
708 tidyTyVarBndr (tidy_env, subst) tyvar
709 = case tidyOccName tidy_env (getOccName name) of
710 (tidy', occ') -> -- New occname reqd
711 ((tidy', subst'), tyvar')
713 subst' = extendVarEnv subst tyvar tyvar'
714 tyvar' = setTyVarName tyvar name'
715 name' = mkInternalName (getUnique name) occ' noSrcLoc
716 -- Note: make a *user* tyvar, so it printes nicely
717 -- Could extract src loc, but no need.
719 name = tyVarName tyvar
721 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
722 -- Add the free tyvars to the env in tidy form,
723 -- so that we can tidy the type they are free in
724 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
726 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
727 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
729 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
730 -- Treat a new tyvar as a binder, and give it a fresh tidy name
731 tidyOpenTyVar env@(tidy_env, subst) tyvar
732 = case lookupVarEnv subst tyvar of
733 Just tyvar' -> (env, tyvar') -- Already substituted
734 Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
736 tidyType :: TidyEnv -> Type -> Type
737 tidyType env@(tidy_env, subst) ty
740 go (TyVarTy tv) = case lookupVarEnv subst tv of
741 Nothing -> TyVarTy tv
742 Just tv' -> TyVarTy tv'
743 go (TyConApp tycon tys) = let args = map go tys
744 in args `seqList` TyConApp tycon args
745 go (NewTcApp tycon tys) = let args = map go tys
746 in args `seqList` NewTcApp tycon args
747 go (NoteTy note ty) = (NoteTy $! (go_note note)) $! (go ty)
748 go (PredTy sty) = PredTy (tidyPred env sty)
749 go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
750 go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
751 go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
753 (envp, tvp) = tidyTyVarBndr env tv
755 go_note (SynNote ty) = SynNote $! (go ty)
756 go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
758 tidyTypes env tys = map (tidyType env) tys
760 tidyPred :: TidyEnv -> PredType -> PredType
761 tidyPred env (IParam n ty) = IParam n (tidyType env ty)
762 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
766 @tidyOpenType@ grabs the free type variables, tidies them
767 and then uses @tidyType@ to work over the type itself
770 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
772 = (env', tidyType env' ty)
774 env' = tidyFreeTyVars env (tyVarsOfType ty)
776 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
777 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
779 tidyTopType :: Type -> Type
780 tidyTopType ty = tidyType emptyTidyEnv ty
785 %************************************************************************
787 \subsection{Liftedness}
789 %************************************************************************
792 isUnLiftedType :: Type -> Bool
793 -- isUnLiftedType returns True for forall'd unlifted types:
794 -- x :: forall a. Int#
795 -- I found bindings like these were getting floated to the top level.
796 -- They are pretty bogus types, mind you. It would be better never to
799 isUnLiftedType (ForAllTy tv ty) = isUnLiftedType ty
800 isUnLiftedType (NoteTy _ ty) = isUnLiftedType ty
801 isUnLiftedType (TyConApp tc _) = isUnLiftedTyCon tc
802 isUnLiftedType (PredTy _) = False -- All source types are lifted
803 isUnLiftedType (NewTcApp tc tys) = isUnLiftedType (newTypeRep tc tys)
804 isUnLiftedType other = False
806 isUnboxedTupleType :: Type -> Bool
807 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
808 Just (tc, ty_args) -> isUnboxedTupleTyCon tc
811 -- Should only be applied to *types*; hence the assert
812 isAlgType :: Type -> Bool
813 isAlgType ty = case splitTyConApp_maybe ty of
814 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
819 @isStrictType@ computes whether an argument (or let RHS) should
820 be computed strictly or lazily, based only on its type.
821 Works just like isUnLiftedType, except that it has a special case
822 for dictionaries. Since it takes account of ClassP, you might think
823 this function should be in TcType, but isStrictType is used by DataCon,
824 which is below TcType in the hierarchy, so it's convenient to put it here.
827 isStrictType (ForAllTy tv ty) = isStrictType ty
828 isStrictType (NoteTy _ ty) = isStrictType ty
829 isStrictType (TyConApp tc _) = isUnLiftedTyCon tc
830 isStrictType (NewTcApp tc tys) = isStrictType (newTypeRep tc tys)
831 isStrictType (PredTy pred) = isStrictPred pred
832 isStrictType other = False
834 isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
835 isStrictPred other = False
836 -- We may be strict in dictionary types, but only if it
837 -- has more than one component.
838 -- [Being strict in a single-component dictionary risks
839 -- poking the dictionary component, which is wrong.]
843 isPrimitiveType :: Type -> Bool
844 -- Returns types that are opaque to Haskell.
845 -- Most of these are unlifted, but now that we interact with .NET, we
846 -- may have primtive (foreign-imported) types that are lifted
847 isPrimitiveType ty = case splitTyConApp_maybe ty of
848 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
854 %************************************************************************
856 \subsection{Sequencing on types
858 %************************************************************************
861 seqType :: Type -> ()
862 seqType (TyVarTy tv) = tv `seq` ()
863 seqType (AppTy t1 t2) = seqType t1 `seq` seqType t2
864 seqType (FunTy t1 t2) = seqType t1 `seq` seqType t2
865 seqType (NoteTy note t2) = seqNote note `seq` seqType t2
866 seqType (PredTy p) = seqPred p
867 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
868 seqType (NewTcApp tc tys) = tc `seq` seqTypes tys
869 seqType (ForAllTy tv ty) = tv `seq` seqType ty
871 seqTypes :: [Type] -> ()
873 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
875 seqNote :: TyNote -> ()
876 seqNote (SynNote ty) = seqType ty
877 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
879 seqPred :: PredType -> ()
880 seqPred (ClassP c tys) = c `seq` seqTypes tys
881 seqPred (IParam n ty) = n `seq` seqType ty
885 %************************************************************************
887 \subsection{Equality on types}
889 %************************************************************************
891 Comparison; don't use instances so that we know where it happens.
892 Look through newtypes but not usage types.
894 Note that eqType can respond 'False' for partial applications of newtypes.
896 newtype Parser m a = MkParser (Foogle m a)
899 Monad (Parser m) `eqType` Monad (Foogle m)
901 Well, yes, but eqType won't see that they are the same.
902 I don't think this is harmful, but it's soemthing to watch out for.
905 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
906 eqKind = eqType -- No worries about looking
908 -- Look through Notes
909 eq_ty env (NoteTy _ t1) t2 = eq_ty env t1 t2
910 eq_ty env t1 (NoteTy _ t2) = eq_ty env t1 t2
912 -- Look through PredTy and NewTcApp. This is where the looping danger comes from.
913 -- We don't bother to check for the PredType/PredType case, no good reason
914 -- Hmm: maybe there is a good reason: see the notes below about newtypes
915 eq_ty env (PredTy sty1) t2 = eq_ty env (predTypeRep sty1) t2
916 eq_ty env t1 (PredTy sty2) = eq_ty env t1 (predTypeRep sty2)
918 -- NB: we *cannot* short-cut the newtype comparison thus:
919 -- eq_ty env (NewTcApp tc1 tys1) (NewTcApp tc2 tys2)
920 -- | (tc1 == tc2) = (eq_tys env tys1 tys2)
923 -- newtype T a = MkT [a]
924 -- newtype Foo m = MkFoo (forall a. m a -> Int)
929 -- w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
931 -- We end up with w2 = w1; so we need that Foo T = Foo []
932 -- but we can only expand saturated newtypes, so just comparing
933 -- T with [] won't do.
935 eq_ty env (NewTcApp tc1 tys1) t2 = eq_ty env (newTypeRep tc1 tys1) t2
936 eq_ty env t1 (NewTcApp tc2 tys2) = eq_ty env t1 (newTypeRep tc2 tys2)
938 -- The rest is plain sailing
939 eq_ty env (TyVarTy tv1) (TyVarTy tv2) = case lookupVarEnv env tv1 of
940 Just tv1a -> tv1a == tv2
941 Nothing -> tv1 == tv2
942 eq_ty env (ForAllTy tv1 t1) (ForAllTy tv2 t2)
943 | tv1 == tv2 = eq_ty (delVarEnv env tv1) t1 t2
944 | otherwise = eq_ty (extendVarEnv env tv1 tv2) t1 t2
945 eq_ty env (AppTy s1 t1) (AppTy s2 t2) = (eq_ty env s1 s2) && (eq_ty env t1 t2)
946 eq_ty env (FunTy s1 t1) (FunTy s2 t2) = (eq_ty env s1 s2) && (eq_ty env t1 t2)
947 eq_ty env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 == tc2) && (eq_tys env tys1 tys2)
948 eq_ty env t1 t2 = False
950 eq_tys env [] [] = True
951 eq_tys env (t1:tys1) (t2:tys2) = (eq_ty env t1 t2) && (eq_tys env tys1 tys2)
952 eq_tys env tys1 tys2 = False