2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[Type]{Type - public interface}
8 -- re-exports from TypeRep:
9 Type, PredType, TauType, ThetaType,
12 superKind, superBoxity, -- KX and BX respectively
13 liftedBoxity, unliftedBoxity, -- :: BX
15 typeCon, -- :: BX -> KX
16 liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX
17 mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
21 usageKindCon, -- :: KX
22 usageTypeKind, -- :: KX
23 usOnceTyCon, usManyTyCon, -- :: $
24 usOnce, usMany, -- :: $
26 -- exports from this module:
27 hasMoreBoxityInfo, defaultKind,
29 mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
31 mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
33 mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, splitFunTys,
34 funResultTy, funArgTy, zipFunTys,
36 mkTyConApp, mkTyConTy,
37 tyConAppTyCon, tyConAppArgs,
38 splitTyConApp_maybe, splitTyConApp,
40 mkUTy, splitUTy, splitUTy_maybe,
41 isUTy, uaUTy, unUTy, liftUTy, mkUTyM,
42 isUsageKind, isUsage, isUTyVar,
46 repType, splitRepFunTys, typePrimRep,
48 mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
49 applyTy, applyTys, isForAllTy,
52 SourceType(..), sourceTypeRep, mkPredTy, mkPredTys,
58 isUnLiftedType, isUnboxedTupleType, isAlgType, isStrictType, isPrimitiveType,
61 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
62 usageAnnOfType, typeKind, addFreeTyVars,
64 -- Tidying up for printing
66 tidyOpenType, tidyOpenTypes,
67 tidyTyVarBndr, tidyFreeTyVars,
68 tidyOpenTyVar, tidyOpenTyVars,
69 tidyTopType, tidyPred,
72 eqType, eqKind, eqUsage,
79 #include "HsVersions.h"
81 -- We import the representation and primitive functions from TypeRep.
82 -- Many things are reexported, but not the representation!
88 import {-# SOURCE #-} PprType( pprType ) -- Only called in debug messages
89 import {-# SOURCE #-} Subst ( substTyWith )
92 import Var ( Var, TyVar, tyVarKind, tyVarName, setTyVarName )
96 import Name ( NamedThing(..), mkLocalName, tidyOccName )
97 import Class ( classTyCon )
98 import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon,
99 isUnboxedTupleTyCon, isUnLiftedTyCon,
100 isFunTyCon, isNewTyCon, newTyConRep,
101 isAlgTyCon, isSynTyCon, tyConArity,
102 tyConKind, getSynTyConDefn,
107 import CmdLineOpts ( opt_DictsStrict )
108 import Maybes ( maybeToBool )
109 import SrcLoc ( noSrcLoc )
110 import PrimRep ( PrimRep(..) )
111 import Unique ( Uniquable(..) )
112 import Util ( mapAccumL, seqList )
114 import UniqSet ( sizeUniqSet ) -- Should come via VarSet
118 %************************************************************************
120 \subsection{Stuff to do with kinds.}
122 %************************************************************************
125 hasMoreBoxityInfo :: Kind -> Kind -> Bool
126 hasMoreBoxityInfo k1 k2
127 | k2 `eqKind` openTypeKind = True
128 | otherwise = k1 `eqType` k2
130 defaultKind :: Kind -> Kind
131 -- Used when generalising: default kind '?' to '*'
132 defaultKind kind | kind `eqKind` openTypeKind = liftedTypeKind
135 isTypeKind :: Kind -> Bool
136 -- True of kind * and *#
137 isTypeKind k = case splitTyConApp_maybe k of
138 Just (tc,[k]) -> tc == typeCon
143 %************************************************************************
145 \subsection{Constructor-specific functions}
147 %************************************************************************
150 ---------------------------------------------------------------------
154 mkTyVarTy :: TyVar -> Type
157 mkTyVarTys :: [TyVar] -> [Type]
158 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
160 getTyVar :: String -> Type -> TyVar
161 getTyVar msg (TyVarTy tv) = tv
162 getTyVar msg (SourceTy p) = getTyVar msg (sourceTypeRep p)
163 getTyVar msg (NoteTy _ t) = getTyVar msg t
164 getTyVar msg ty@(UsageTy _ _) = pprPanic "getTyVar: UTy:" (text msg $$ pprType ty)
165 getTyVar msg other = panic ("getTyVar: " ++ msg)
167 getTyVar_maybe :: Type -> Maybe TyVar
168 getTyVar_maybe (TyVarTy tv) = Just tv
169 getTyVar_maybe (NoteTy _ t) = getTyVar_maybe t
170 getTyVar_maybe (SourceTy p) = getTyVar_maybe (sourceTypeRep p)
171 getTyVar_maybe ty@(UsageTy _ _) = pprPanic "getTyVar_maybe: UTy:" (pprType ty)
172 getTyVar_maybe other = Nothing
174 isTyVarTy :: Type -> Bool
175 isTyVarTy (TyVarTy tv) = True
176 isTyVarTy (NoteTy _ ty) = isTyVarTy ty
177 isTyVarTy (SourceTy p) = isTyVarTy (sourceTypeRep p)
178 isTyVarTy ty@(UsageTy _ _) = pprPanic "isTyVarTy: UTy:" (pprType ty)
179 isTyVarTy other = False
183 ---------------------------------------------------------------------
186 We need to be pretty careful with AppTy to make sure we obey the
187 invariant that a TyConApp is always visibly so. mkAppTy maintains the
191 mkAppTy orig_ty1 orig_ty2
192 = ASSERT( not (isSourceTy orig_ty1) ) -- Source types are of kind *
193 UASSERT2( not (isUTy orig_ty2), pprType orig_ty1 <+> pprType orig_ty2 )
194 -- argument must be unannotated
197 mk_app (NoteTy _ ty1) = mk_app ty1
198 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
199 mk_app ty@(UsageTy _ _) = pprPanic "mkAppTy: UTy:" (pprType ty)
200 mk_app ty1 = AppTy orig_ty1 orig_ty2
202 mkAppTys :: Type -> [Type] -> Type
203 mkAppTys orig_ty1 [] = orig_ty1
204 -- This check for an empty list of type arguments
205 -- avoids the needless loss of a type synonym constructor.
206 -- For example: mkAppTys Rational []
207 -- returns to (Ratio Integer), which has needlessly lost
208 -- the Rational part.
209 mkAppTys orig_ty1 orig_tys2
210 = ASSERT( not (isSourceTy orig_ty1) ) -- Source types are of kind *
211 UASSERT2( not (any isUTy orig_tys2), pprType orig_ty1 <+> fsep (map pprType orig_tys2) )
212 -- arguments must be unannotated
215 mk_app (NoteTy _ ty1) = mk_app ty1
216 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
217 mk_app ty@(UsageTy _ _) = pprPanic "mkAppTys: UTy:" (pprType ty)
218 mk_app ty1 = foldl AppTy orig_ty1 orig_tys2
220 splitAppTy_maybe :: Type -> Maybe (Type, Type)
221 splitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [unUTy ty1], unUTy ty2)
222 splitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
223 splitAppTy_maybe (NoteTy _ ty) = splitAppTy_maybe ty
224 splitAppTy_maybe (SourceTy p) = splitAppTy_maybe (sourceTypeRep p)
225 splitAppTy_maybe (TyConApp tc []) = Nothing
226 splitAppTy_maybe (TyConApp tc tys) = split tys []
228 split [ty2] acc = Just (TyConApp tc (reverse acc), ty2)
229 split (ty:tys) acc = split tys (ty:acc)
231 splitAppTy_maybe ty@(UsageTy _ _) = pprPanic "splitAppTy_maybe: UTy:" (pprType ty)
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 (SourceTy p) args = split orig_ty (sourceTypeRep p) args
245 split orig_ty (FunTy ty1 ty2) args = ASSERT( null args )
246 (TyConApp funTyCon [], [unUTy ty1,unUTy ty2])
247 split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
248 split orig_ty (UsageTy _ _) args = pprPanic "splitAppTys: UTy:" (pprType orig_ty)
249 split orig_ty ty args = (orig_ty, args)
253 ---------------------------------------------------------------------
258 mkFunTy :: Type -> Type -> Type
259 mkFunTy arg res = UASSERT2( isUTy arg && isUTy res, pprType arg <+> pprType res )
262 mkFunTys :: [Type] -> Type -> Type
263 mkFunTys tys ty = UASSERT2( all isUTy (ty:tys), fsep (map pprType (tys++[ty])) )
266 splitFunTy :: Type -> (Type, Type)
267 splitFunTy (FunTy arg res) = (arg, res)
268 splitFunTy (NoteTy _ ty) = splitFunTy ty
269 splitFunTy (SourceTy p) = splitFunTy (sourceTypeRep p)
270 splitFunTy ty@(UsageTy _ _) = pprPanic "splitFunTy: UTy:" (pprType ty)
272 splitFunTy_maybe :: Type -> Maybe (Type, Type)
273 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
274 splitFunTy_maybe (NoteTy _ ty) = splitFunTy_maybe ty
275 splitFunTy_maybe (SourceTy p) = splitFunTy_maybe (sourceTypeRep p)
276 splitFunTy_maybe ty@(UsageTy _ _) = pprPanic "splitFunTy_maybe: UTy:" (pprType ty)
277 splitFunTy_maybe other = Nothing
279 splitFunTys :: Type -> ([Type], Type)
280 splitFunTys ty = split [] ty ty
282 split args orig_ty (FunTy arg res) = split (arg:args) res res
283 split args orig_ty (NoteTy _ ty) = split args orig_ty ty
284 split args orig_ty (SourceTy p) = split args orig_ty (sourceTypeRep p)
285 split args orig_ty (UsageTy _ _) = pprPanic "splitFunTys: UTy:" (pprType orig_ty)
286 split args orig_ty ty = (reverse args, orig_ty)
288 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
289 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
291 split acc [] nty ty = (reverse acc, nty)
292 split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
293 split acc xs nty (NoteTy _ ty) = split acc xs nty ty
294 split acc xs nty (SourceTy p) = split acc xs nty (sourceTypeRep p)
295 split acc xs nty (UsageTy _ _) = pprPanic "zipFunTys: UTy:" (ppr orig_xs <+> pprType orig_ty)
296 split acc (x:xs) nty ty = pprPanic "zipFunTys" (ppr orig_xs <+> pprType orig_ty)
298 funResultTy :: Type -> Type
299 funResultTy (FunTy arg res) = res
300 funResultTy (NoteTy _ ty) = funResultTy ty
301 funResultTy (SourceTy p) = funResultTy (sourceTypeRep p)
302 funResultTy (UsageTy _ ty) = funResultTy ty
303 funResultTy ty = pprPanic "funResultTy" (pprType ty)
305 funArgTy :: Type -> Type
306 funArgTy (FunTy arg res) = arg
307 funArgTy (NoteTy _ ty) = funArgTy ty
308 funArgTy (SourceTy p) = funArgTy (sourceTypeRep p)
309 funArgTy (UsageTy _ ty) = funArgTy ty
310 funArgTy ty = pprPanic "funArgTy" (pprType ty)
314 ---------------------------------------------------------------------
317 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or SourceTy,
321 mkTyConApp :: TyCon -> [Type] -> Type
322 -- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
324 | isFunTyCon tycon, [ty1,ty2] <- tys
325 = FunTy (mkUTyM ty1) (mkUTyM ty2)
327 | isNewTyCon tycon, -- A saturated newtype application;
328 not (isRecursiveTyCon tycon), -- Not recursive (we don't use SourceTypes for them)
329 length tys == tyConArity tycon -- use the SourceType form
330 = SourceTy (NType tycon tys)
333 = ASSERT(not (isSynTyCon tycon))
334 UASSERT2( not (any isUTy tys), ppr tycon <+> fsep (map pprType tys) )
337 mkTyConTy :: TyCon -> Type
338 mkTyConTy tycon = ASSERT( not (isSynTyCon tycon) )
341 -- splitTyConApp "looks through" synonyms, because they don't
342 -- mean a distinct type, but all other type-constructor applications
343 -- including functions are returned as Just ..
345 tyConAppTyCon :: Type -> TyCon
346 tyConAppTyCon ty = fst (splitTyConApp ty)
348 tyConAppArgs :: Type -> [Type]
349 tyConAppArgs ty = snd (splitTyConApp ty)
351 splitTyConApp :: Type -> (TyCon, [Type])
352 splitTyConApp ty = case splitTyConApp_maybe ty of
354 Nothing -> pprPanic "splitTyConApp" (pprType ty)
356 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
357 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
358 splitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [unUTy arg,unUTy res])
359 splitTyConApp_maybe (NoteTy _ ty) = splitTyConApp_maybe ty
360 splitTyConApp_maybe (SourceTy p) = splitTyConApp_maybe (sourceTypeRep p)
361 splitTyConApp_maybe (UsageTy _ ty) = splitTyConApp_maybe ty
362 splitTyConApp_maybe other = Nothing
366 ---------------------------------------------------------------------
372 | n_args == arity -- Exactly saturated
374 | n_args > arity -- Over-saturated
375 = foldl AppTy (mk_syn (take arity tys)) (drop arity tys)
376 | otherwise -- Un-saturated
378 -- For the un-saturated case we build TyConApp directly
379 -- (mkTyConApp ASSERTs that the tc isn't a SynTyCon).
380 -- Here we are relying on checkValidType to find
381 -- the error. What we can't do is use mkSynTy with
382 -- too few arg tys, because that is utterly bogus.
385 mk_syn tys = NoteTy (SynNote (TyConApp tycon tys))
386 (substTyWith tyvars tys body)
388 (tyvars, body) = ASSERT( isSynTyCon tycon ) getSynTyConDefn tycon
389 arity = tyConArity tycon
393 Notes on type synonyms
394 ~~~~~~~~~~~~~~~~~~~~~~
395 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
396 to return type synonyms whereever possible. Thus
401 splitFunTys (a -> Foo a) = ([a], Foo a)
404 The reason is that we then get better (shorter) type signatures in
405 interfaces. Notably this plays a role in tcTySigs in TcBinds.lhs.
411 repType looks through
415 (d) usage annotations
416 (e) [recursive] newtypes
417 It's useful in the back end.
419 Remember, non-recursive newtypes get expanded as part of the SourceTy case,
420 but recursive ones are represented by TyConApps and have to be expanded
424 repType :: Type -> Type
425 repType (ForAllTy _ ty) = repType ty
426 repType (NoteTy _ ty) = repType ty
427 repType (SourceTy p) = repType (sourceTypeRep p)
428 repType (UsageTy _ ty) = repType ty
429 repType (TyConApp tc tys) | isNewTyCon tc && length tys == tyConArity tc
430 = repType (newTypeRep tc tys)
433 splitRepFunTys :: Type -> ([Type], Type)
434 -- Like splitFunTys, but looks through newtypes and for-alls
435 splitRepFunTys ty = split [] (repType ty)
437 split args (FunTy arg res) = split (arg:args) (repType res)
438 split args ty = (reverse args, ty)
440 typePrimRep :: Type -> PrimRep
441 typePrimRep ty = case repType ty of
442 TyConApp tc _ -> tyConPrimRep tc
444 AppTy _ _ -> PtrRep -- ??
450 ---------------------------------------------------------------------
455 mkForAllTy :: TyVar -> Type -> Type
457 = mkForAllTys [tyvar] ty
459 mkForAllTys :: [TyVar] -> Type -> Type
460 mkForAllTys tyvars ty
461 = case splitUTy_maybe ty of
462 Just (u,ty1) -> UASSERT2( not (mkVarSet tyvars `intersectsVarSet` tyVarsOfType u),
463 ptext SLIT("mkForAllTys: usage scope")
464 <+> ppr tyvars <+> pprType ty )
465 mkUTy u (foldr ForAllTy ty1 tyvars) -- we lift usage annotations over foralls
466 Nothing -> foldr ForAllTy ty tyvars
468 isForAllTy :: Type -> Bool
469 isForAllTy (NoteTy _ ty) = isForAllTy ty
470 isForAllTy (ForAllTy _ _) = True
471 isForAllTy (UsageTy _ ty) = isForAllTy ty
472 isForAllTy other_ty = False
474 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
475 splitForAllTy_maybe ty = splitFAT_m ty
477 splitFAT_m (NoteTy _ ty) = splitFAT_m ty
478 splitFAT_m (SourceTy p) = splitFAT_m (sourceTypeRep p)
479 splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
480 splitFAT_m (UsageTy _ ty) = splitFAT_m ty
481 splitFAT_m _ = Nothing
483 splitForAllTys :: Type -> ([TyVar], Type)
484 splitForAllTys ty = split ty ty []
486 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
487 split orig_ty (NoteTy _ ty) tvs = split orig_ty ty tvs
488 split orig_ty (SourceTy p) tvs = split orig_ty (sourceTypeRep p) tvs
489 split orig_ty (UsageTy _ ty) tvs = split orig_ty ty tvs
490 split orig_ty t tvs = (reverse tvs, orig_ty)
493 -- (mkPiType now in CoreUtils)
495 Applying a for-all to its arguments. Lift usage annotation as required.
498 applyTy :: Type -> Type -> Type
499 applyTy (SourceTy p) arg = applyTy (sourceTypeRep p) arg
500 applyTy (NoteTy _ fun) arg = applyTy fun arg
501 applyTy (ForAllTy tv ty) arg = UASSERT2( not (isUTy arg),
502 ptext SLIT("applyTy")
503 <+> pprType ty <+> pprType arg )
504 substTyWith [tv] [arg] ty
505 applyTy (UsageTy u ty) arg = UsageTy u (applyTy ty arg)
506 applyTy other arg = panic "applyTy"
508 applyTys :: Type -> [Type] -> Type
509 applyTys fun_ty arg_tys
510 = UASSERT2( not (any isUTy arg_tys), ptext SLIT("applyTys") <+> pprType fun_ty )
514 substTyWith tvs arg_tys ty
516 (mu, tvs, ty) = split fun_ty arg_tys
518 split fun_ty [] = (Nothing, [], fun_ty)
519 split (NoteTy _ fun_ty) args = split fun_ty args
520 split (SourceTy p) args = split (sourceTypeRep p) args
521 split (ForAllTy tv fun_ty) (arg:args) = case split fun_ty args of
522 (mu, tvs, ty) -> (mu, tv:tvs, ty)
523 split (UsageTy u ty) args = case split ty args of
524 (Nothing, tvs, ty) -> (Just u, tvs, ty)
525 (Just _ , _ , _ ) -> pprPanic "applyTys:"
527 split other_ty args = panic "applyTys"
531 ---------------------------------------------------------------------
535 Constructing and taking apart usage types.
538 mkUTy :: Type -> Type -> Type
540 = ASSERT2( typeKind u `eqKind` usageTypeKind,
541 ptext SLIT("mkUTy:") <+> pprType u <+> pprType ty )
542 UASSERT2( not (isUTy ty), ptext SLIT("mkUTy:") <+> pprType u <+> pprType ty )
543 -- if u == usMany then ty else : ToDo? KSW 2000-10
550 splitUTy :: Type -> (Type {- :: $ -}, Type)
552 = case splitUTy_maybe orig_ty of
553 Just (u,ty) -> (u,ty)
555 Nothing -> pprPanic "splitUTy:" (pprType orig_ty)
557 Nothing -> (usMany,orig_ty) -- default annotation ToDo KSW 2000-10
560 splitUTy_maybe :: Type -> Maybe (Type {- :: $ -}, Type)
561 splitUTy_maybe (UsageTy u ty) = Just (u,ty)
562 splitUTy_maybe (NoteTy _ ty) = splitUTy_maybe ty
563 splitUTy_maybe other_ty = Nothing
565 isUTy :: Type -> Bool
566 -- has usage annotation
567 isUTy = maybeToBool . splitUTy_maybe
569 uaUTy :: Type -> Type
570 -- extract annotation
571 uaUTy = fst . splitUTy
573 unUTy :: Type -> Type
574 -- extract unannotated type
575 unUTy = snd . splitUTy
579 liftUTy :: (Type -> Type) -> Type -> Type
580 -- lift outer usage annot over operation on unannotated types
583 (u,ty') = splitUTy ty
589 mkUTyM :: Type -> Type
590 -- put TOP (no info) annotation on unannotated type
591 mkUTyM ty = mkUTy usMany ty
595 isUsageKind :: Kind -> Bool
597 = ASSERT( typeKind k `eqKind` superKind )
598 k `eqKind` usageTypeKind
600 isUsage :: Type -> Bool
602 = isUsageKind (typeKind ty)
604 isUTyVar :: Var -> Bool
606 = isUsageKind (tyVarKind v)
610 %************************************************************************
612 \subsection{Source types}
614 %************************************************************************
616 A "source type" is a type that is a separate type as far as the type checker is
617 concerned, but which has low-level representation as far as the back end is concerned.
619 Source types are always lifted.
621 The key function is sourceTypeRep which gives the representation of a source type:
624 mkPredTy :: PredType -> Type
625 mkPredTy pred = SourceTy pred
627 mkPredTys :: ThetaType -> [Type]
628 mkPredTys preds = map SourceTy preds
630 sourceTypeRep :: SourceType -> Type
631 -- Convert a predicate to its "representation type";
632 -- the type of evidence for that predicate, which is actually passed at runtime
633 sourceTypeRep (IParam n ty) = ty
634 sourceTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
635 -- Note the mkTyConApp; the classTyCon might be a newtype!
636 sourceTypeRep (NType tc tys) = newTypeRep tc tys
637 -- ToDo: Consider caching this substitution in a NType
639 isSourceTy :: Type -> Bool
640 isSourceTy (NoteTy _ ty) = isSourceTy ty
641 isSourceTy (UsageTy _ ty) = isSourceTy ty
642 isSourceTy (SourceTy sty) = True
646 splitNewType_maybe :: Type -> Maybe Type
647 -- Newtypes that are recursive are reprsented by TyConApp, just
648 -- as they always were. Occasionally we want to find their representation type.
649 -- NB: remember that in this module, non-recursive newtypes are transparent
651 splitNewType_maybe ty
652 = case splitTyConApp_maybe ty of
653 Just (tc,tys) | isNewTyCon tc -> ASSERT( length tys == tyConArity tc )
654 -- The assert should hold because repType should
655 -- only be applied to *types* (of kind *)
656 Just (newTypeRep tc tys)
659 -- A local helper function (not exported)
660 newTypeRep new_tycon tys = case newTyConRep new_tycon of
661 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
665 %************************************************************************
667 \subsection{Kinds and free variables}
669 %************************************************************************
671 ---------------------------------------------------------------------
672 Finding the kind of a type
673 ~~~~~~~~~~~~~~~~~~~~~~~~~~
675 typeKind :: Type -> Kind
677 typeKind (TyVarTy tyvar) = tyVarKind tyvar
678 typeKind (TyConApp tycon tys) = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
679 typeKind (NoteTy _ ty) = typeKind ty
680 typeKind (SourceTy _) = liftedTypeKind -- Predicates are always
681 -- represented by lifted types
682 typeKind (AppTy fun arg) = funResultTy (typeKind fun)
684 typeKind (FunTy arg res) = fix_up (typeKind res)
686 fix_up (TyConApp tycon _) | tycon == typeCon
687 || tycon == openKindCon = liftedTypeKind
688 fix_up (NoteTy _ kind) = fix_up kind
690 -- The basic story is
691 -- typeKind (FunTy arg res) = typeKind res
692 -- But a function is lifted regardless of its result type
693 -- Hence the strange fix-up.
694 -- Note that 'res', being the result of a FunTy, can't have
695 -- a strange kind like (*->*).
697 typeKind (ForAllTy tv ty) = typeKind ty
698 typeKind (UsageTy _ ty) = typeKind ty -- we don't have separate kinds for ann/unann
702 ---------------------------------------------------------------------
703 Free variables of a type
704 ~~~~~~~~~~~~~~~~~~~~~~~~
706 tyVarsOfType :: Type -> TyVarSet
707 tyVarsOfType (TyVarTy tv) = unitVarSet tv
708 tyVarsOfType (TyConApp tycon tys) = tyVarsOfTypes tys
709 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
710 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty1
711 tyVarsOfType (SourceTy sty) = tyVarsOfSourceType sty
712 tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
713 tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
714 tyVarsOfType (ForAllTy tyvar ty) = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
715 tyVarsOfType (UsageTy u ty) = tyVarsOfType u `unionVarSet` tyVarsOfType ty
717 tyVarsOfTypes :: [Type] -> TyVarSet
718 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
720 tyVarsOfPred :: PredType -> TyVarSet
721 tyVarsOfPred = tyVarsOfSourceType -- Just a subtype
723 tyVarsOfSourceType :: SourceType -> TyVarSet
724 tyVarsOfSourceType (IParam n ty) = tyVarsOfType ty
725 tyVarsOfSourceType (ClassP clas tys) = tyVarsOfTypes tys
726 tyVarsOfSourceType (NType tc tys) = tyVarsOfTypes tys
728 tyVarsOfTheta :: ThetaType -> TyVarSet
729 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfSourceType) emptyVarSet
731 -- Add a Note with the free tyvars to the top of the type
732 addFreeTyVars :: Type -> Type
733 addFreeTyVars ty@(NoteTy (FTVNote _) _) = ty
734 addFreeTyVars ty = NoteTy (FTVNote (tyVarsOfType ty)) ty
737 Usage annotations of a type
738 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
740 Get a list of usage annotations of a type, *in left-to-right pre-order*.
743 usageAnnOfType :: Type -> [Type]
748 goT (AppTy ty1 ty2) = goT ty1 ++ goT ty2
749 goT (TyConApp tc tys) = concatMap goT tys
750 goT (FunTy sty1 sty2) = goS sty1 ++ goS sty2
751 goT (ForAllTy mv ty) = goT ty
752 goT (SourceTy p) = goT (sourceTypeRep p)
753 goT ty@(UsageTy _ _) = pprPanic "usageAnnOfType: unexpected usage:" (pprType ty)
754 goT (NoteTy note ty) = goT ty
756 goS sty = case splitUTy sty of
757 (u,tty) -> u : goT tty
761 %************************************************************************
763 \subsection{TidyType}
765 %************************************************************************
767 tidyTy tidies up a type for printing in an error message, or in
770 It doesn't change the uniques at all, just the print names.
773 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
774 tidyTyVarBndr (tidy_env, subst) tyvar
775 = case tidyOccName tidy_env (getOccName name) of
776 (tidy', occ') -> -- New occname reqd
777 ((tidy', subst'), tyvar')
779 subst' = extendVarEnv subst tyvar tyvar'
780 tyvar' = setTyVarName tyvar name'
781 name' = mkLocalName (getUnique name) occ' noSrcLoc
782 -- Note: make a *user* tyvar, so it printes nicely
783 -- Could extract src loc, but no need.
785 name = tyVarName tyvar
787 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
788 -- Add the free tyvars to the env in tidy form,
789 -- so that we can tidy the type they are free in
790 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
792 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
793 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
795 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
796 -- Treat a new tyvar as a binder, and give it a fresh tidy name
797 tidyOpenTyVar env@(tidy_env, subst) tyvar
798 = case lookupVarEnv subst tyvar of
799 Just tyvar' -> (env, tyvar') -- Already substituted
800 Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
802 tidyType :: TidyEnv -> Type -> Type
803 tidyType env@(tidy_env, subst) ty
806 go (TyVarTy tv) = case lookupVarEnv subst tv of
807 Nothing -> TyVarTy tv
808 Just tv' -> TyVarTy tv'
809 go (TyConApp tycon tys) = let args = map go tys
810 in args `seqList` TyConApp tycon args
811 go (NoteTy note ty) = (NoteTy SAPPLY (go_note note)) SAPPLY (go ty)
812 go (SourceTy sty) = SourceTy (tidySourceType env sty)
813 go (AppTy fun arg) = (AppTy SAPPLY (go fun)) SAPPLY (go arg)
814 go (FunTy fun arg) = (FunTy SAPPLY (go fun)) SAPPLY (go arg)
815 go (ForAllTy tv ty) = ForAllTy tvp SAPPLY (tidyType envp ty)
817 (envp, tvp) = tidyTyVarBndr env tv
818 go (UsageTy u ty) = (UsageTy SAPPLY (go u)) SAPPLY (go ty)
820 go_note (SynNote ty) = SynNote SAPPLY (go ty)
821 go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
823 tidyTypes env tys = map (tidyType env) tys
825 tidyPred :: TidyEnv -> SourceType -> SourceType
826 tidyPred = tidySourceType
828 tidySourceType :: TidyEnv -> SourceType -> SourceType
829 tidySourceType env (IParam n ty) = IParam n (tidyType env ty)
830 tidySourceType env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
831 tidySourceType env (NType tc tys) = NType tc (tidyTypes env tys)
835 @tidyOpenType@ grabs the free type variables, tidies them
836 and then uses @tidyType@ to work over the type itself
839 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
841 = (env', tidyType env' ty)
843 env' = tidyFreeTyVars env (tyVarsOfType ty)
845 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
846 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
848 tidyTopType :: Type -> Type
849 tidyTopType ty = tidyType emptyTidyEnv ty
854 %************************************************************************
856 \subsection{Liftedness}
858 %************************************************************************
861 isUnLiftedType :: Type -> Bool
862 -- isUnLiftedType returns True for forall'd unlifted types:
863 -- x :: forall a. Int#
864 -- I found bindings like these were getting floated to the top level.
865 -- They are pretty bogus types, mind you. It would be better never to
868 isUnLiftedType (ForAllTy tv ty) = isUnLiftedType ty
869 isUnLiftedType (NoteTy _ ty) = isUnLiftedType ty
870 isUnLiftedType (TyConApp tc _) = isUnLiftedTyCon tc
871 isUnLiftedType (UsageTy _ ty) = isUnLiftedType ty
872 isUnLiftedType (SourceTy _) = False -- All source types are lifted
873 isUnLiftedType other = False
875 isUnboxedTupleType :: Type -> Bool
876 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
877 Just (tc, ty_args) -> isUnboxedTupleTyCon tc
880 -- Should only be applied to *types*; hence the assert
881 isAlgType :: Type -> Bool
882 isAlgType ty = case splitTyConApp_maybe ty of
883 Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
888 @isStrictType@ computes whether an argument (or let RHS) should
889 be computed strictly or lazily, based only on its type.
890 Works just like isUnLiftedType, except that it has a special case
891 for dictionaries. Since it takes account of ClassP, you might think
892 this function should be in TcType, but isStrictType is used by DataCon,
893 which is below TcType in the hierarchy, so it's convenient to put it here.
896 isStrictType (ForAllTy tv ty) = isStrictType ty
897 isStrictType (NoteTy _ ty) = isStrictType ty
898 isStrictType (TyConApp tc _) = isUnLiftedTyCon tc
899 isStrictType (UsageTy _ ty) = isStrictType ty
900 isStrictType (SourceTy (ClassP clas _)) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
901 -- We may be strict in dictionary types, but only if it
902 -- has more than one component.
903 -- [Being strict in a single-component dictionary risks
904 -- poking the dictionary component, which is wrong.]
905 isStrictType other = False
909 isPrimitiveType :: Type -> Bool
910 -- Returns types that are opaque to Haskell.
911 -- Most of these are unlifted, but now that we interact with .NET, we
912 -- may have primtive (foreign-imported) types that are lifted
913 isPrimitiveType ty = case splitTyConApp_maybe ty of
914 Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
920 %************************************************************************
922 \subsection{Sequencing on types
924 %************************************************************************
927 seqType :: Type -> ()
928 seqType (TyVarTy tv) = tv `seq` ()
929 seqType (AppTy t1 t2) = seqType t1 `seq` seqType t2
930 seqType (FunTy t1 t2) = seqType t1 `seq` seqType t2
931 seqType (NoteTy note t2) = seqNote note `seq` seqType t2
932 seqType (SourceTy p) = seqPred p
933 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
934 seqType (ForAllTy tv ty) = tv `seq` seqType ty
935 seqType (UsageTy u ty) = seqType u `seq` seqType ty
937 seqTypes :: [Type] -> ()
939 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
941 seqNote :: TyNote -> ()
942 seqNote (SynNote ty) = seqType ty
943 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
945 seqPred :: SourceType -> ()
946 seqPred (ClassP c tys) = c `seq` seqTypes tys
947 seqPred (NType tc tys) = tc `seq` seqTypes tys
948 seqPred (IParam n ty) = n `seq` seqType ty
952 %************************************************************************
954 \subsection{Equality on types}
956 %************************************************************************
958 Comparison; don't use instances so that we know where it happens.
959 Look through newtypes but not usage types.
962 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
963 eqKind = eqType -- No worries about looking
964 eqUsage = eqType -- through source types for these two
966 -- Look through Notes
967 eq_ty env (NoteTy _ t1) t2 = eq_ty env t1 t2
968 eq_ty env t1 (NoteTy _ t2) = eq_ty env t1 t2
970 -- Look through SourceTy. This is where the looping danger comes from
971 eq_ty env (SourceTy sty1) t2 = eq_ty env (sourceTypeRep sty1) t2
972 eq_ty env t1 (SourceTy sty2) = eq_ty env t1 (sourceTypeRep sty2)
974 -- The rest is plain sailing
975 eq_ty env (TyVarTy tv1) (TyVarTy tv2) = case lookupVarEnv env tv1 of
976 Just tv1a -> tv1a == tv2
977 Nothing -> tv1 == tv2
978 eq_ty env (ForAllTy tv1 t1) (ForAllTy tv2 t2)
979 | tv1 == tv2 = eq_ty (delVarEnv env tv1) t1 t2
980 | otherwise = eq_ty (extendVarEnv env tv1 tv2) t1 t2
981 eq_ty env (AppTy s1 t1) (AppTy s2 t2) = (eq_ty env s1 s2) && (eq_ty env t1 t2)
982 eq_ty env (FunTy s1 t1) (FunTy s2 t2) = (eq_ty env s1 s2) && (eq_ty env t1 t2)
983 eq_ty env (UsageTy _ t1) (UsageTy _ t2) = eq_ty env t1 t2
984 eq_ty env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 == tc2) && (eq_tys env tys1 tys2)
985 eq_ty env t1 t2 = False
987 eq_tys env [] [] = True
988 eq_tys env (t1:tys1) (t2:tys2) = (eq_ty env t1 t2) && (eq_tys env tys1 tys2)
989 eq_tys env tys1 tys2 = False