2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[Type]{Type - public interface}
8 -- re-exports from TypeRep:
9 Type, PredType, ThetaType,
12 TyThing(..), isTyClThing,
14 superKind, superBoxity, -- KX and BX respectively
15 liftedBoxity, unliftedBoxity, -- :: BX
17 typeCon, -- :: BX -> KX
18 liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX
19 mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
20 isTypeKind, isAnyTypeKind,
23 usageKindCon, -- :: KX
24 usageTypeKind, -- :: KX
25 usOnceTyCon, usManyTyCon, -- :: $
26 usOnce, usMany, -- :: $
28 -- exports from this module:
29 hasMoreBoxityInfo, defaultKind,
31 mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
33 mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
35 mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, splitFunTys,
36 funResultTy, funArgTy, zipFunTys, isFunTy,
38 mkGenTyConApp, mkTyConApp, mkTyConTy,
39 tyConAppTyCon, tyConAppArgs,
40 splitTyConApp_maybe, splitTyConApp,
46 mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
47 applyTy, applyTys, isForAllTy, dropForAlls,
50 SourceType(..), sourceTypeRep, mkPredTy, mkPredTys,
56 isUnLiftedType, isUnboxedTupleType, isAlgType, isStrictType, isPrimitiveType,
59 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
60 typeKind, addFreeTyVars,
62 -- Tidying up for printing
64 tidyOpenType, tidyOpenTypes,
65 tidyTyVarBndr, tidyFreeTyVars,
66 tidyOpenTyVar, tidyOpenTyVars,
67 tidyTopType, tidyPred,
70 eqType, eqKind, eqUsage,
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 #-} PprType( pprType ) -- Only called in debug messages
87 import {-# SOURCE #-} Subst ( substTyWith )
90 import Var ( Id, TyVar, tyVarKind, tyVarName, setTyVarName )
94 import Name ( NamedThing(..), mkInternalName, tidyOccName )
95 import Class ( Class, classTyCon )
96 import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon,
97 isUnboxedTupleTyCon, isUnLiftedTyCon,
98 isFunTyCon, isNewTyCon, newTyConRep,
99 isAlgTyCon, isSynTyCon, tyConArity,
100 tyConKind, getSynTyConDefn,
105 import CmdLineOpts ( opt_DictsStrict )
106 import SrcLoc ( noSrcLoc )
107 import PrimRep ( PrimRep(..) )
108 import Unique ( Uniquable(..) )
109 import Util ( mapAccumL, seqList, lengthIs, snocView )
111 import UniqSet ( sizeUniqSet ) -- Should come via VarSet
112 import Maybe ( isJust )
116 %************************************************************************
120 %************************************************************************
123 data TyThing = AnId Id
127 isTyClThing :: TyThing -> Bool
128 isTyClThing (ATyCon _) = True
129 isTyClThing (AClass _) = True
130 isTyClThing (AnId _) = False
132 instance NamedThing TyThing where
133 getName (AnId id) = getName id
134 getName (ATyCon tc) = getName tc
135 getName (AClass cl) = getName cl
139 %************************************************************************
141 \subsection{Stuff to do with kinds.}
143 %************************************************************************
146 hasMoreBoxityInfo :: Kind -> Kind -> Bool
147 -- (k1 `hasMoreBoxityInfo` k2) checks that k1 <: k2
148 hasMoreBoxityInfo k1 k2
149 | k2 `eqKind` openTypeKind = isAnyTypeKind k1
150 | otherwise = k1 `eqKind` k2
153 isAnyTypeKind :: Kind -> Bool
154 -- True of kind * and *# and ?
155 isAnyTypeKind (TyConApp tc _) = tc == typeCon || tc == openKindCon
156 isAnyTypeKind (NoteTy _ k) = isAnyTypeKind k
157 isAnyTypeKind other = False
159 isTypeKind :: Kind -> Bool
160 -- True of kind * and *#
161 isTypeKind (TyConApp tc _) = tc == typeCon
162 isTypeKind (NoteTy _ k) = isTypeKind k
163 isTypeKind other = False
165 defaultKind :: Kind -> Kind
166 -- Used when generalising: default kind '?' to '*'
167 defaultKind kind | kind `eqKind` openTypeKind = liftedTypeKind
172 %************************************************************************
174 \subsection{Constructor-specific functions}
176 %************************************************************************
179 ---------------------------------------------------------------------
183 mkTyVarTy :: TyVar -> Type
186 mkTyVarTys :: [TyVar] -> [Type]
187 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
189 getTyVar :: String -> Type -> TyVar
190 getTyVar msg (TyVarTy tv) = tv
191 getTyVar msg (SourceTy p) = getTyVar msg (sourceTypeRep p)
192 getTyVar msg (NoteTy _ t) = getTyVar msg t
193 getTyVar msg other = panic ("getTyVar: " ++ msg)
195 getTyVar_maybe :: Type -> Maybe TyVar
196 getTyVar_maybe (TyVarTy tv) = Just tv
197 getTyVar_maybe (NoteTy _ t) = getTyVar_maybe t
198 getTyVar_maybe (SourceTy p) = getTyVar_maybe (sourceTypeRep p)
199 getTyVar_maybe other = Nothing
201 isTyVarTy :: Type -> Bool
202 isTyVarTy (TyVarTy tv) = True
203 isTyVarTy (NoteTy _ ty) = isTyVarTy ty
204 isTyVarTy (SourceTy p) = isTyVarTy (sourceTypeRep p)
205 isTyVarTy other = False
209 ---------------------------------------------------------------------
212 We need to be pretty careful with AppTy to make sure we obey the
213 invariant that a TyConApp is always visibly so. mkAppTy maintains the
217 mkAppTy orig_ty1 orig_ty2
218 = ASSERT( not (isSourceTy orig_ty1) ) -- Source types are of kind *
221 mk_app (NoteTy _ ty1) = mk_app ty1
222 mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ [orig_ty2])
223 mk_app ty1 = AppTy orig_ty1 orig_ty2
224 -- We call mkGenTyConApp because the TyConApp could be an
225 -- under-saturated type synonym. GHC allows that; e.g.
226 -- type Foo k = k a -> k a
228 -- foo :: Foo Id -> Foo Id
230 -- Here Id is partially applied in the type sig for Foo,
231 -- but once the type synonyms are expanded all is well
233 mkAppTys :: Type -> [Type] -> Type
234 mkAppTys orig_ty1 [] = orig_ty1
235 -- This check for an empty list of type arguments
236 -- avoids the needless loss of a type synonym constructor.
237 -- For example: mkAppTys Rational []
238 -- returns to (Ratio Integer), which has needlessly lost
239 -- the Rational part.
240 mkAppTys orig_ty1 orig_tys2
241 = ASSERT( not (isSourceTy orig_ty1) ) -- Source types are of kind *
244 mk_app (NoteTy _ ty1) = mk_app ty1
245 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
246 mk_app ty1 = foldl AppTy orig_ty1 orig_tys2
248 splitAppTy_maybe :: Type -> Maybe (Type, Type)
249 splitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
250 splitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
251 splitAppTy_maybe (NoteTy _ ty) = splitAppTy_maybe ty
252 splitAppTy_maybe (SourceTy p) = splitAppTy_maybe (sourceTypeRep p)
253 splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
255 Just (tys',ty') -> Just (TyConApp tc tys', ty')
256 splitAppTy_maybe other = Nothing
258 splitAppTy :: Type -> (Type, Type)
259 splitAppTy ty = case splitAppTy_maybe ty of
261 Nothing -> panic "splitAppTy"
263 splitAppTys :: Type -> (Type, [Type])
264 splitAppTys ty = split ty ty []
266 split orig_ty (AppTy ty arg) args = split ty ty (arg:args)
267 split orig_ty (NoteTy _ ty) args = split orig_ty ty args
268 split orig_ty (SourceTy p) args = split orig_ty (sourceTypeRep p) args
269 split orig_ty (FunTy ty1 ty2) args = ASSERT( null args )
270 (TyConApp funTyCon [], [ty1,ty2])
271 split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
272 split orig_ty ty args = (orig_ty, args)
276 ---------------------------------------------------------------------
281 mkFunTy :: Type -> Type -> Type
282 mkFunTy arg res = FunTy arg res
284 mkFunTys :: [Type] -> Type -> Type
285 mkFunTys tys ty = foldr FunTy ty tys
287 isFunTy :: Type -> Bool
288 isFunTy ty = isJust (splitFunTy_maybe ty)
290 splitFunTy :: Type -> (Type, Type)
291 splitFunTy (FunTy arg res) = (arg, res)
292 splitFunTy (NoteTy _ ty) = splitFunTy ty
293 splitFunTy (SourceTy p) = splitFunTy (sourceTypeRep p)
295 splitFunTy_maybe :: Type -> Maybe (Type, Type)
296 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
297 splitFunTy_maybe (NoteTy _ ty) = splitFunTy_maybe ty
298 splitFunTy_maybe (SourceTy p) = splitFunTy_maybe (sourceTypeRep p)
299 splitFunTy_maybe other = Nothing
301 splitFunTys :: Type -> ([Type], Type)
302 splitFunTys ty = split [] ty ty
304 split args orig_ty (FunTy arg res) = split (arg:args) res res
305 split args orig_ty (NoteTy _ ty) = split args orig_ty ty
306 split args orig_ty (SourceTy p) = split args orig_ty (sourceTypeRep p)
307 split args orig_ty ty = (reverse args, orig_ty)
309 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
310 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
312 split acc [] nty ty = (reverse acc, nty)
313 split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
314 split acc xs nty (NoteTy _ ty) = split acc xs nty ty
315 split acc xs nty (SourceTy p) = split acc xs nty (sourceTypeRep p)
316 split acc (x:xs) nty ty = pprPanic "zipFunTys" (ppr orig_xs <+> pprType orig_ty)
318 funResultTy :: Type -> Type
319 funResultTy (FunTy arg res) = res
320 funResultTy (NoteTy _ ty) = funResultTy ty
321 funResultTy (SourceTy p) = funResultTy (sourceTypeRep p)
322 funResultTy ty = pprPanic "funResultTy" (pprType ty)
324 funArgTy :: Type -> Type
325 funArgTy (FunTy arg res) = arg
326 funArgTy (NoteTy _ ty) = funArgTy ty
327 funArgTy (SourceTy p) = funArgTy (sourceTypeRep p)
328 funArgTy ty = pprPanic "funArgTy" (pprType ty)
332 ---------------------------------------------------------------------
335 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or SourceTy,
339 mkGenTyConApp :: TyCon -> [Type] -> Type
341 | isSynTyCon tc = mkSynTy tc tys
342 | otherwise = mkTyConApp tc tys
344 mkTyConApp :: TyCon -> [Type] -> Type
345 -- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
347 | isFunTyCon tycon, [ty1,ty2] <- tys
350 | isNewTyCon tycon, -- A saturated newtype application;
351 not (isRecursiveTyCon tycon), -- Not recursive (we don't use SourceTypes for them)
352 tys `lengthIs` tyConArity tycon -- use the SourceType form
353 = SourceTy (NType tycon tys)
356 = ASSERT(not (isSynTyCon tycon))
359 mkTyConTy :: TyCon -> Type
360 mkTyConTy tycon = ASSERT( not (isSynTyCon tycon) )
363 -- splitTyConApp "looks through" synonyms, because they don't
364 -- mean a distinct type, but all other type-constructor applications
365 -- including functions are returned as Just ..
367 tyConAppTyCon :: Type -> TyCon
368 tyConAppTyCon ty = fst (splitTyConApp ty)
370 tyConAppArgs :: Type -> [Type]
371 tyConAppArgs ty = snd (splitTyConApp ty)
373 splitTyConApp :: Type -> (TyCon, [Type])
374 splitTyConApp ty = case splitTyConApp_maybe ty of
376 Nothing -> pprPanic "splitTyConApp" (pprType ty)
378 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
379 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
380 splitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
381 splitTyConApp_maybe (NoteTy _ ty) = splitTyConApp_maybe ty
382 splitTyConApp_maybe (SourceTy p) = splitTyConApp_maybe (sourceTypeRep p)
383 splitTyConApp_maybe other = Nothing
387 ---------------------------------------------------------------------
393 | n_args == arity -- Exactly saturated
395 | n_args > arity -- Over-saturated
396 = case splitAt arity tys of { (as,bs) -> mkAppTys (mk_syn as) bs }
397 -- Its important to use mkAppTys, rather than (foldl AppTy),
398 -- because (mk_syn as) might well return a partially-applied
399 -- type constructor; indeed, usually will!
400 | otherwise -- Un-saturated
402 -- For the un-saturated case we build TyConApp directly
403 -- (mkTyConApp ASSERTs that the tc isn't a SynTyCon).
404 -- Here we are relying on checkValidType to find
405 -- the error. What we can't do is use mkSynTy with
406 -- too few arg tys, because that is utterly bogus.
409 mk_syn tys = NoteTy (SynNote (TyConApp tycon tys))
410 (substTyWith tyvars tys body)
412 (tyvars, body) = ASSERT( isSynTyCon tycon ) getSynTyConDefn tycon
413 arity = tyConArity tycon
417 Notes on type synonyms
418 ~~~~~~~~~~~~~~~~~~~~~~
419 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
420 to return type synonyms whereever possible. Thus
425 splitFunTys (a -> Foo a) = ([a], Foo a)
428 The reason is that we then get better (shorter) type signatures in
429 interfaces. Notably this plays a role in tcTySigs in TcBinds.lhs.
434 repType looks through
438 (d) usage annotations
439 (e) [recursive] newtypes
440 It's useful in the back end.
442 Remember, non-recursive newtypes get expanded as part of the SourceTy case,
443 but recursive ones are represented by TyConApps and have to be expanded
447 repType :: Type -> Type
448 repType (ForAllTy _ ty) = repType ty
449 repType (NoteTy _ ty) = repType ty
450 repType (SourceTy p) = repType (sourceTypeRep p)
451 repType (TyConApp tc tys) | isNewTyCon tc && tys `lengthIs` tyConArity tc
452 = repType (newTypeRep tc tys)
456 typePrimRep :: Type -> PrimRep
457 typePrimRep ty = case repType ty of
458 TyConApp tc _ -> tyConPrimRep tc
460 AppTy _ _ -> PtrRep -- ??
466 ---------------------------------------------------------------------
471 mkForAllTy :: TyVar -> Type -> Type
473 = mkForAllTys [tyvar] ty
475 mkForAllTys :: [TyVar] -> Type -> Type
476 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
478 isForAllTy :: Type -> Bool
479 isForAllTy (NoteTy _ ty) = isForAllTy ty
480 isForAllTy (ForAllTy _ _) = True
481 isForAllTy other_ty = False
483 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
484 splitForAllTy_maybe ty = splitFAT_m ty
486 splitFAT_m (NoteTy _ ty) = splitFAT_m ty
487 splitFAT_m (SourceTy p) = splitFAT_m (sourceTypeRep p)
488 splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
489 splitFAT_m _ = Nothing
491 splitForAllTys :: Type -> ([TyVar], Type)
492 splitForAllTys ty = split ty ty []
494 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
495 split orig_ty (NoteTy _ ty) tvs = split orig_ty ty tvs
496 split orig_ty (SourceTy p) tvs = split orig_ty (sourceTypeRep p) tvs
497 split orig_ty t tvs = (reverse tvs, orig_ty)
499 dropForAlls :: Type -> Type
500 dropForAlls ty = snd (splitForAllTys ty)
503 -- (mkPiType now in CoreUtils)
505 Applying a for-all to its arguments. Lift usage annotation as required.
508 applyTy :: Type -> Type -> Type
509 applyTy (SourceTy p) arg = applyTy (sourceTypeRep p) arg
510 applyTy (NoteTy _ fun) arg = applyTy fun arg
511 applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
512 applyTy other arg = panic "applyTy"
514 applyTys :: Type -> [Type] -> Type
515 applyTys orig_fun_ty arg_tys
516 = substTyWith tvs arg_tys ty
518 (tvs, ty) = split orig_fun_ty arg_tys
520 split fun_ty [] = ([], fun_ty)
521 split (NoteTy _ fun_ty) args = split fun_ty args
522 split (SourceTy p) args = split (sourceTypeRep p) args
523 split (ForAllTy tv fun_ty) (arg:args) = case split fun_ty args of
524 (tvs, ty) -> (tv:tvs, ty)
525 split other_ty args = panic "applyTys"
526 -- No show instance for Type yet
530 %************************************************************************
532 \subsection{Source types}
534 %************************************************************************
536 A "source type" is a type that is a separate type as far as the type checker is
537 concerned, but which has low-level representation as far as the back end is concerned.
539 Source types are always lifted.
541 The key function is sourceTypeRep which gives the representation of a source type:
544 mkPredTy :: PredType -> Type
545 mkPredTy pred = SourceTy pred
547 mkPredTys :: ThetaType -> [Type]
548 mkPredTys preds = map SourceTy preds
550 sourceTypeRep :: SourceType -> Type
551 -- Convert a predicate to its "representation type";
552 -- the type of evidence for that predicate, which is actually passed at runtime
553 sourceTypeRep (IParam _ ty) = ty
554 sourceTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
555 -- Note the mkTyConApp; the classTyCon might be a newtype!
556 sourceTypeRep (NType tc tys) = newTypeRep tc tys
557 -- ToDo: Consider caching this substitution in a NType
559 isSourceTy :: Type -> Bool
560 isSourceTy (NoteTy _ ty) = isSourceTy ty
561 isSourceTy (SourceTy sty) = True
565 splitNewType_maybe :: Type -> Maybe Type
566 -- Newtypes that are recursive are reprsented by TyConApp, just
567 -- as they always were. Occasionally we want to find their representation type.
568 -- NB: remember that in this module, non-recursive newtypes are transparent
570 splitNewType_maybe ty
571 = case splitTyConApp_maybe ty of
572 Just (tc,tys) | isNewTyCon tc -> ASSERT( tys `lengthIs` tyConArity tc )
573 -- The assert should hold because repType should
574 -- only be applied to *types* (of kind *)
575 Just (newTypeRep tc tys)
578 -- A local helper function (not exported)
579 newTypeRep new_tycon tys = case newTyConRep new_tycon of
580 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
584 %************************************************************************
586 \subsection{Kinds and free variables}
588 %************************************************************************
590 ---------------------------------------------------------------------
591 Finding the kind of a type
592 ~~~~~~~~~~~~~~~~~~~~~~~~~~
594 typeKind :: Type -> Kind
596 typeKind (TyVarTy tyvar) = tyVarKind tyvar
597 typeKind (TyConApp tycon tys) = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
598 typeKind (NoteTy _ ty) = typeKind ty
599 typeKind (SourceTy _) = liftedTypeKind -- Predicates are always
600 -- represented by lifted types
601 typeKind (AppTy fun arg) = funResultTy (typeKind fun)
603 typeKind (FunTy arg res) = fix_up (typeKind res)
605 fix_up (TyConApp tycon _) | tycon == typeCon
606 || tycon == openKindCon = liftedTypeKind
607 fix_up (NoteTy _ kind) = fix_up kind
609 -- The basic story is
610 -- typeKind (FunTy arg res) = typeKind res
611 -- But a function is lifted regardless of its result type
612 -- Hence the strange fix-up.
613 -- Note that 'res', being the result of a FunTy, can't have
614 -- a strange kind like (*->*).
616 typeKind (ForAllTy tv ty) = typeKind ty
620 ---------------------------------------------------------------------
621 Free variables of a type
622 ~~~~~~~~~~~~~~~~~~~~~~~~
624 tyVarsOfType :: Type -> TyVarSet
625 tyVarsOfType (TyVarTy tv) = unitVarSet tv
626 tyVarsOfType (TyConApp tycon tys) = tyVarsOfTypes tys
627 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
628 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty2 -- See note [Syn] below
629 tyVarsOfType (SourceTy sty) = tyVarsOfSourceType sty
630 tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
631 tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
632 tyVarsOfType (ForAllTy tyvar ty) = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
637 -- What are the free tyvars of (T x)? Empty, of course!
638 -- Here's the example that Ralf Laemmel showed me:
639 -- foo :: (forall a. C u a -> C u a) -> u
640 -- mappend :: Monoid u => u -> u -> u
642 -- bar :: Monoid u => u
643 -- bar = foo (\t -> t `mappend` t)
644 -- We have to generalise at the arg to f, and we don't
645 -- want to capture the constraint (Monad (C u a)) because
646 -- it appears to mention a. Pretty silly, but it was useful to him.
649 tyVarsOfTypes :: [Type] -> TyVarSet
650 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
652 tyVarsOfPred :: PredType -> TyVarSet
653 tyVarsOfPred = tyVarsOfSourceType -- Just a subtype
655 tyVarsOfSourceType :: SourceType -> TyVarSet
656 tyVarsOfSourceType (IParam _ ty) = tyVarsOfType ty
657 tyVarsOfSourceType (ClassP _ tys) = tyVarsOfTypes tys
658 tyVarsOfSourceType (NType _ tys) = tyVarsOfTypes tys
660 tyVarsOfTheta :: ThetaType -> TyVarSet
661 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfSourceType) emptyVarSet
663 -- Add a Note with the free tyvars to the top of the type
664 addFreeTyVars :: Type -> Type
665 addFreeTyVars ty@(NoteTy (FTVNote _) _) = ty
666 addFreeTyVars ty = NoteTy (FTVNote (tyVarsOfType ty)) ty
669 %************************************************************************
671 \subsection{TidyType}
673 %************************************************************************
675 tidyTy tidies up a type for printing in an error message, or in
678 It doesn't change the uniques at all, just the print names.
681 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
682 tidyTyVarBndr (tidy_env, subst) tyvar
683 = case tidyOccName tidy_env (getOccName name) of
684 (tidy', occ') -> -- New occname reqd
685 ((tidy', subst'), tyvar')
687 subst' = extendVarEnv subst tyvar tyvar'
688 tyvar' = setTyVarName tyvar name'
689 name' = mkInternalName (getUnique name) occ' noSrcLoc
690 -- Note: make a *user* tyvar, so it printes nicely
691 -- Could extract src loc, but no need.
693 name = tyVarName tyvar
695 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
696 -- Add the free tyvars to the env in tidy form,
697 -- so that we can tidy the type they are free in
698 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
700 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
701 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
703 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
704 -- Treat a new tyvar as a binder, and give it a fresh tidy name
705 tidyOpenTyVar env@(tidy_env, subst) tyvar
706 = case lookupVarEnv subst tyvar of
707 Just tyvar' -> (env, tyvar') -- Already substituted
708 Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
710 tidyType :: TidyEnv -> Type -> Type
711 tidyType env@(tidy_env, subst) ty
714 go (TyVarTy tv) = case lookupVarEnv subst tv of
715 Nothing -> TyVarTy tv
716 Just tv' -> TyVarTy tv'
717 go (TyConApp tycon tys) = let args = map go tys
718 in args `seqList` TyConApp tycon args
719 go (NoteTy note ty) = (NoteTy $! (go_note note)) $! (go ty)
720 go (SourceTy sty) = SourceTy (tidySourceType env sty)
721 go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
722 go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
723 go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
725 (envp, tvp) = tidyTyVarBndr env tv
727 go_note (SynNote ty) = SynNote $! (go ty)
728 go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
730 tidyTypes env tys = map (tidyType env) tys
732 tidyPred :: TidyEnv -> SourceType -> SourceType
733 tidyPred = tidySourceType
735 tidySourceType :: TidyEnv -> SourceType -> SourceType
736 tidySourceType env (IParam n ty) = IParam n (tidyType env ty)
737 tidySourceType env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
738 tidySourceType env (NType tc tys) = NType tc (tidyTypes env tys)
742 @tidyOpenType@ grabs the free type variables, tidies them
743 and then uses @tidyType@ to work over the type itself
746 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
748 = (env', tidyType env' ty)
750 env' = tidyFreeTyVars env (tyVarsOfType ty)
752 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
753 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
755 tidyTopType :: Type -> Type
756 tidyTopType ty = tidyType emptyTidyEnv ty
761 %************************************************************************
763 \subsection{Liftedness}
765 %************************************************************************
768 isUnLiftedType :: Type -> Bool
769 -- isUnLiftedType returns True for forall'd unlifted types:
770 -- x :: forall a. Int#
771 -- I found bindings like these were getting floated to the top level.
772 -- They are pretty bogus types, mind you. It would be better never to
775 isUnLiftedType (ForAllTy tv ty) = isUnLiftedType ty
776 isUnLiftedType (NoteTy _ ty) = isUnLiftedType ty
777 isUnLiftedType (TyConApp tc _) = isUnLiftedTyCon tc
778 isUnLiftedType (SourceTy _) = False -- All source types are lifted
779 isUnLiftedType other = False
781 isUnboxedTupleType :: Type -> Bool
782 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
783 Just (tc, ty_args) -> isUnboxedTupleTyCon tc
786 -- Should only be applied to *types*; hence the assert
787 isAlgType :: Type -> Bool
788 isAlgType ty = case splitTyConApp_maybe ty of
789 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
794 @isStrictType@ computes whether an argument (or let RHS) should
795 be computed strictly or lazily, based only on its type.
796 Works just like isUnLiftedType, except that it has a special case
797 for dictionaries. Since it takes account of ClassP, you might think
798 this function should be in TcType, but isStrictType is used by DataCon,
799 which is below TcType in the hierarchy, so it's convenient to put it here.
802 isStrictType (ForAllTy tv ty) = isStrictType ty
803 isStrictType (NoteTy _ ty) = isStrictType ty
804 isStrictType (TyConApp tc _) = isUnLiftedTyCon tc
805 isStrictType (SourceTy (ClassP clas _)) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
806 -- We may be strict in dictionary types, but only if it
807 -- has more than one component.
808 -- [Being strict in a single-component dictionary risks
809 -- poking the dictionary component, which is wrong.]
810 isStrictType other = False
814 isPrimitiveType :: Type -> Bool
815 -- Returns types that are opaque to Haskell.
816 -- Most of these are unlifted, but now that we interact with .NET, we
817 -- may have primtive (foreign-imported) types that are lifted
818 isPrimitiveType ty = case splitTyConApp_maybe ty of
819 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
825 %************************************************************************
827 \subsection{Sequencing on types
829 %************************************************************************
832 seqType :: Type -> ()
833 seqType (TyVarTy tv) = tv `seq` ()
834 seqType (AppTy t1 t2) = seqType t1 `seq` seqType t2
835 seqType (FunTy t1 t2) = seqType t1 `seq` seqType t2
836 seqType (NoteTy note t2) = seqNote note `seq` seqType t2
837 seqType (SourceTy p) = seqPred p
838 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
839 seqType (ForAllTy tv ty) = tv `seq` seqType ty
841 seqTypes :: [Type] -> ()
843 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
845 seqNote :: TyNote -> ()
846 seqNote (SynNote ty) = seqType ty
847 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
849 seqPred :: SourceType -> ()
850 seqPred (ClassP c tys) = c `seq` seqTypes tys
851 seqPred (NType tc tys) = tc `seq` seqTypes tys
852 seqPred (IParam n ty) = n `seq` seqType ty
856 %************************************************************************
858 \subsection{Equality on types}
860 %************************************************************************
862 Comparison; don't use instances so that we know where it happens.
863 Look through newtypes but not usage types.
865 Note that eqType can respond 'False' for partial applications of newtypes.
867 newtype Parser m a = MkParser (Foogle m a)
870 Monad (Parser m) `eqType` Monad (Foogle m)
872 Well, yes, but eqType won't see that they are the same.
873 I don't think this is harmful, but it's soemthing to watch out for.
876 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
877 eqKind = eqType -- No worries about looking
878 eqUsage = eqType -- through source types for these two
880 -- Look through Notes
881 eq_ty env (NoteTy _ t1) t2 = eq_ty env t1 t2
882 eq_ty env t1 (NoteTy _ t2) = eq_ty env t1 t2
884 -- Look through SourceTy. This is where the looping danger comes from
885 eq_ty env (SourceTy sty1) t2 = eq_ty env (sourceTypeRep sty1) t2
886 eq_ty env t1 (SourceTy sty2) = eq_ty env t1 (sourceTypeRep sty2)
888 -- The rest is plain sailing
889 eq_ty env (TyVarTy tv1) (TyVarTy tv2) = case lookupVarEnv env tv1 of
890 Just tv1a -> tv1a == tv2
891 Nothing -> tv1 == tv2
892 eq_ty env (ForAllTy tv1 t1) (ForAllTy tv2 t2)
893 | tv1 == tv2 = eq_ty (delVarEnv env tv1) t1 t2
894 | otherwise = eq_ty (extendVarEnv env tv1 tv2) t1 t2
895 eq_ty env (AppTy s1 t1) (AppTy s2 t2) = (eq_ty env s1 s2) && (eq_ty env t1 t2)
896 eq_ty env (FunTy s1 t1) (FunTy s2 t2) = (eq_ty env s1 s2) && (eq_ty env t1 t2)
897 eq_ty env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 == tc2) && (eq_tys env tys1 tys2)
898 eq_ty env t1 t2 = False
900 eq_tys env [] [] = True
901 eq_tys env (t1:tys1) (t2:tys2) = (eq_ty env t1 t2) && (eq_tys env tys1 tys2)
902 eq_tys env tys1 tys2 = False