2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[Type]{Type - public interface}
8 -- re-exports from TypeRep
9 TyThing(..), Type, PredType(..), ThetaType,
12 -- Re-exports from Kind
15 -- Re-exports from TyCon
18 mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
20 mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
22 mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe,
23 splitFunTys, splitFunTysN,
24 funResultTy, funArgTy, zipFunTys, isFunTy,
26 mkTyConApp, mkTyConTy,
27 tyConAppTyCon, tyConAppArgs,
28 splitTyConApp_maybe, splitTyConApp,
30 repType, typePrimRep, coreView, tcView,
32 mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
33 applyTy, applyTys, isForAllTy, dropForAlls,
36 predTypeRep, mkPredTy, mkPredTys,
39 splitRecNewType_maybe,
42 isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
43 isStrictType, isStrictPred,
46 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
47 typeKind, addFreeTyVars,
49 -- Tidying up for printing
51 tidyOpenType, tidyOpenTypes,
52 tidyTyVarBndr, tidyFreeTyVars,
53 tidyOpenTyVar, tidyOpenTyVars,
54 tidyTopType, tidyPred,
58 coreEqType, tcEqType, tcEqTypes, tcCmpType, tcCmpTypes,
59 tcEqPred, tcCmpPred, tcEqTypeX,
65 TvSubstEnv, emptyTvSubstEnv, -- Representation widely visible
66 TvSubst(..), emptyTvSubst, -- Representation visible to a few friends
67 mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
68 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
69 extendTvSubst, extendTvSubstList, isInScope, composeTvSubst, zipTyEnv,
71 -- Performing substitution on types
72 substTy, substTys, substTyWith, substTheta,
73 substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar,
76 pprType, pprParendType, pprTyThingCategory,
77 pprPred, pprTheta, pprThetaArrow, pprClassPred
80 #include "HsVersions.h"
82 -- We import the representation and primitive functions from TypeRep.
83 -- Many things are reexported, but not the representation!
89 import Var ( Var, TyVar, tyVarKind, tyVarName, setTyVarName, mkTyVar )
93 import OccName ( tidyOccName )
94 import Name ( NamedThing(..), mkInternalName, tidyNameOcc )
95 import Class ( Class, classTyCon )
96 import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon,
97 isUnboxedTupleTyCon, isUnLiftedTyCon,
98 isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
99 isAlgTyCon, tyConArity,
100 tcExpandTyCon_maybe, coreExpandTyCon_maybe,
101 tyConKind, PrimRep(..), tyConPrimRep,
105 import StaticFlags ( opt_DictsStrict )
106 import SrcLoc ( noSrcLoc )
107 import Util ( mapAccumL, seqList, lengthIs, snocView, thenCmp, isEqual, all2 )
109 import UniqSet ( sizeUniqSet ) -- Should come via VarSet
110 import Maybe ( isJust )
114 %************************************************************************
118 %************************************************************************
120 In Core, we "look through" non-recursive newtypes and PredTypes.
123 {-# INLINE coreView #-}
124 coreView :: Type -> Maybe Type
125 -- Srips off the *top layer only* of a type to give
126 -- its underlying representation type.
127 -- Returns Nothing if there is nothing to look through.
129 -- In the case of newtypes, it returns
130 -- *either* a vanilla TyConApp (recursive newtype, or non-saturated)
131 -- *or* the newtype representation (otherwise), meaning the
132 -- type written in the RHS of the newtype decl,
133 -- which may itself be a newtype
135 -- Example: newtype R = MkR S
137 -- newtype T = MkT (T -> T)
138 -- expandNewTcApp on R gives Just S
140 -- on T gives Nothing (no expansion)
142 -- By being non-recursive and inlined, this case analysis gets efficiently
143 -- joined onto the case analysis that the caller is already doing
144 coreView (NoteTy _ ty) = Just ty
145 coreView (PredTy p) = Just (predTypeRep p)
146 coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys
147 = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
148 -- Its important to use mkAppTys, rather than (foldl AppTy),
149 -- because the function part might well return a
150 -- partially-applied type constructor; indeed, usually will!
151 coreView ty = Nothing
153 -----------------------------------------------
154 {-# INLINE tcView #-}
155 tcView :: Type -> Maybe Type
156 -- Same, but for the type checker, which just looks through synonyms
157 tcView (NoteTy _ ty) = Just ty
158 tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys
159 = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
164 %************************************************************************
166 \subsection{Constructor-specific functions}
168 %************************************************************************
171 ---------------------------------------------------------------------
175 mkTyVarTy :: TyVar -> Type
178 mkTyVarTys :: [TyVar] -> [Type]
179 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
181 getTyVar :: String -> Type -> TyVar
182 getTyVar msg ty = case getTyVar_maybe ty of
184 Nothing -> panic ("getTyVar: " ++ msg)
186 isTyVarTy :: Type -> Bool
187 isTyVarTy ty = isJust (getTyVar_maybe ty)
189 getTyVar_maybe :: Type -> Maybe TyVar
190 getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
191 getTyVar_maybe (TyVarTy tv) = Just tv
192 getTyVar_maybe other = Nothing
196 ---------------------------------------------------------------------
199 We need to be pretty careful with AppTy to make sure we obey the
200 invariant that a TyConApp is always visibly so. mkAppTy maintains the
204 mkAppTy orig_ty1 orig_ty2
207 mk_app (NoteTy _ ty1) = mk_app ty1
208 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
209 mk_app ty1 = AppTy orig_ty1 orig_ty2
210 -- Note that the TyConApp could be an
211 -- under-saturated type synonym. GHC allows that; e.g.
212 -- type Foo k = k a -> k a
214 -- foo :: Foo Id -> Foo Id
216 -- Here Id is partially applied in the type sig for Foo,
217 -- but once the type synonyms are expanded all is well
219 mkAppTys :: Type -> [Type] -> Type
220 mkAppTys orig_ty1 [] = orig_ty1
221 -- This check for an empty list of type arguments
222 -- avoids the needless loss of a type synonym constructor.
223 -- For example: mkAppTys Rational []
224 -- returns to (Ratio Integer), which has needlessly lost
225 -- the Rational part.
226 mkAppTys orig_ty1 orig_tys2
229 mk_app (NoteTy _ ty1) = mk_app ty1
230 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
231 -- mkTyConApp: see notes with mkAppTy
232 mk_app ty1 = foldl AppTy orig_ty1 orig_tys2
234 splitAppTy_maybe :: Type -> Maybe (Type, Type)
235 splitAppTy_maybe ty | Just ty' <- coreView ty = splitAppTy_maybe ty'
236 splitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
237 splitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
238 splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
240 Just (tys',ty') -> Just (TyConApp tc tys', ty')
241 splitAppTy_maybe other = Nothing
243 splitAppTy :: Type -> (Type, Type)
244 splitAppTy ty = case splitAppTy_maybe ty of
246 Nothing -> panic "splitAppTy"
248 splitAppTys :: Type -> (Type, [Type])
249 splitAppTys ty = split ty ty []
251 split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
252 split orig_ty (AppTy ty arg) args = split ty ty (arg:args)
253 split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
254 split orig_ty (FunTy ty1 ty2) args = ASSERT( null args )
255 (TyConApp funTyCon [], [ty1,ty2])
256 split orig_ty ty args = (orig_ty, args)
260 ---------------------------------------------------------------------
265 mkFunTy :: Type -> Type -> Type
266 mkFunTy arg res = FunTy arg res
268 mkFunTys :: [Type] -> Type -> Type
269 mkFunTys tys ty = foldr FunTy ty tys
271 isFunTy :: Type -> Bool
272 isFunTy ty = isJust (splitFunTy_maybe ty)
274 splitFunTy :: Type -> (Type, Type)
275 splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
276 splitFunTy (FunTy arg res) = (arg, res)
277 splitFunTy other = pprPanic "splitFunTy" (ppr other)
279 splitFunTy_maybe :: Type -> Maybe (Type, Type)
280 splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
281 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
282 splitFunTy_maybe other = Nothing
284 splitFunTys :: Type -> ([Type], Type)
285 splitFunTys ty = split [] ty ty
287 split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
288 split args orig_ty (FunTy arg res) = split (arg:args) res res
289 split args orig_ty ty = (reverse args, orig_ty)
291 splitFunTysN :: Int -> Type -> ([Type], Type)
292 -- Split off exactly n arg tys
293 splitFunTysN 0 ty = ([], ty)
294 splitFunTysN n ty = case splitFunTy ty of { (arg, res) ->
295 case splitFunTysN (n-1) res of { (args, res) ->
298 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
299 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
301 split acc [] nty ty = (reverse acc, nty)
303 | Just ty' <- coreView ty = split acc xs nty ty'
304 split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
305 split acc (x:xs) nty ty = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
307 funResultTy :: Type -> Type
308 funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
309 funResultTy (FunTy arg res) = res
310 funResultTy ty = pprPanic "funResultTy" (ppr ty)
312 funArgTy :: Type -> Type
313 funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
314 funArgTy (FunTy arg res) = arg
315 funArgTy ty = pprPanic "funArgTy" (ppr ty)
319 ---------------------------------------------------------------------
322 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or PredTy,
326 mkTyConApp :: TyCon -> [Type] -> Type
328 | isFunTyCon tycon, [ty1,ty2] <- tys
334 mkTyConTy :: TyCon -> Type
335 mkTyConTy tycon = mkTyConApp tycon []
337 -- splitTyConApp "looks through" synonyms, because they don't
338 -- mean a distinct type, but all other type-constructor applications
339 -- including functions are returned as Just ..
341 tyConAppTyCon :: Type -> TyCon
342 tyConAppTyCon ty = fst (splitTyConApp ty)
344 tyConAppArgs :: Type -> [Type]
345 tyConAppArgs ty = snd (splitTyConApp ty)
347 splitTyConApp :: Type -> (TyCon, [Type])
348 splitTyConApp ty = case splitTyConApp_maybe ty of
350 Nothing -> pprPanic "splitTyConApp" (ppr ty)
352 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
353 splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
354 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
355 splitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
356 splitTyConApp_maybe other = Nothing
360 ---------------------------------------------------------------------
364 Notes on type synonyms
365 ~~~~~~~~~~~~~~~~~~~~~~
366 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
367 to return type synonyms whereever possible. Thus
372 splitFunTys (a -> Foo a) = ([a], Foo a)
375 The reason is that we then get better (shorter) type signatures in
376 interfaces. Notably this plays a role in tcTySigs in TcBinds.lhs.
381 repType looks through
385 (d) usage annotations
386 (e) all newtypes, including recursive ones
387 It's useful in the back end.
390 repType :: Type -> Type
391 -- Only applied to types of kind *; hence tycons are saturated
392 repType ty | Just ty' <- coreView ty = repType ty'
393 repType (ForAllTy _ ty) = repType ty
394 repType (TyConApp tc tys)
395 | isNewTyCon tc = -- Recursive newtypes are opaque to coreView
396 -- but we must expand them here. Sure to
397 -- be saturated because repType is only applied
398 -- to types of kind *
399 ASSERT( isRecursiveTyCon tc &&
400 tys `lengthIs` tyConArity tc )
401 repType (new_type_rep tc tys)
404 -- new_type_rep doesn't ask any questions:
405 -- it just expands newtype, whether recursive or not
406 new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
407 case newTyConRep new_tycon of
408 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
410 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
411 -- of inspecting the type directly.
412 typePrimRep :: Type -> PrimRep
413 typePrimRep ty = case repType ty of
414 TyConApp tc _ -> tyConPrimRep tc
416 AppTy _ _ -> PtrRep -- See note below
418 other -> pprPanic "typePrimRep" (ppr ty)
419 -- Types of the form 'f a' must be of kind *, not *#, so
420 -- we are guaranteed that they are represented by pointers.
421 -- The reason is that f must have kind *->*, not *->*#, because
422 -- (we claim) there is no way to constrain f's kind any other
428 ---------------------------------------------------------------------
433 mkForAllTy :: TyVar -> Type -> Type
435 = mkForAllTys [tyvar] ty
437 mkForAllTys :: [TyVar] -> Type -> Type
438 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
440 isForAllTy :: Type -> Bool
441 isForAllTy (NoteTy _ ty) = isForAllTy ty
442 isForAllTy (ForAllTy _ _) = True
443 isForAllTy other_ty = False
445 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
446 splitForAllTy_maybe ty = splitFAT_m ty
448 splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
449 splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
450 splitFAT_m _ = Nothing
452 splitForAllTys :: Type -> ([TyVar], Type)
453 splitForAllTys ty = split ty ty []
455 split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
456 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
457 split orig_ty t tvs = (reverse tvs, orig_ty)
459 dropForAlls :: Type -> Type
460 dropForAlls ty = snd (splitForAllTys ty)
463 -- (mkPiType now in CoreUtils)
467 Instantiate a for-all type with one or more type arguments.
468 Used when we have a polymorphic function applied to type args:
470 Then we use (applyTys type-of-f [t1,t2]) to compute the type of
474 applyTy :: Type -> Type -> Type
475 applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
476 applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
477 applyTy other arg = panic "applyTy"
479 applyTys :: Type -> [Type] -> Type
480 -- This function is interesting because
481 -- a) the function may have more for-alls than there are args
482 -- b) less obviously, it may have fewer for-alls
483 -- For case (b) think of
484 -- applyTys (forall a.a) [forall b.b, Int]
485 -- This really can happen, via dressing up polymorphic types with newtype
486 -- clothing. Here's an example:
487 -- newtype R = R (forall a. a->a)
488 -- foo = case undefined :: R of
491 applyTys orig_fun_ty [] = orig_fun_ty
492 applyTys orig_fun_ty arg_tys
493 | n_tvs == n_args -- The vastly common case
494 = substTyWith tvs arg_tys rho_ty
495 | n_tvs > n_args -- Too many for-alls
496 = substTyWith (take n_args tvs) arg_tys
497 (mkForAllTys (drop n_args tvs) rho_ty)
498 | otherwise -- Too many type args
499 = ASSERT2( n_tvs > 0, ppr orig_fun_ty ) -- Zero case gives infnite loop!
500 applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
503 (tvs, rho_ty) = splitForAllTys orig_fun_ty
505 n_args = length arg_tys
509 %************************************************************************
511 \subsection{Source types}
513 %************************************************************************
515 A "source type" is a type that is a separate type as far as the type checker is
516 concerned, but which has low-level representation as far as the back end is concerned.
518 Source types are always lifted.
520 The key function is predTypeRep which gives the representation of a source type:
523 mkPredTy :: PredType -> Type
524 mkPredTy pred = PredTy pred
526 mkPredTys :: ThetaType -> [Type]
527 mkPredTys preds = map PredTy preds
529 predTypeRep :: PredType -> Type
530 -- Convert a PredType to its "representation type";
531 -- the post-type-checking type used by all the Core passes of GHC.
532 -- Unwraps only the outermost level; for example, the result might
533 -- be a newtype application
534 predTypeRep (IParam _ ty) = ty
535 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
536 -- Result might be a newtype application, but the consumer will
537 -- look through that too if necessary
541 %************************************************************************
545 %************************************************************************
548 splitRecNewType_maybe :: Type -> Maybe Type
549 -- Sometimes we want to look through a recursive newtype, and that's what happens here
550 -- It only strips *one layer* off, so the caller will usually call itself recursively
551 -- Only applied to types of kind *, hence the newtype is always saturated
552 splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty'
553 splitRecNewType_maybe (TyConApp tc tys)
555 = ASSERT( tys `lengthIs` tyConArity tc ) -- splitRecNewType_maybe only be applied
556 -- to *types* (of kind *)
557 ASSERT( isRecursiveTyCon tc ) -- Guaranteed by coreView
558 case newTyConRhs tc of
559 (tvs, rep_ty) -> ASSERT( length tvs == length tys )
560 Just (substTyWith tvs tys rep_ty)
562 splitRecNewType_maybe other = Nothing
566 %************************************************************************
568 \subsection{Kinds and free variables}
570 %************************************************************************
572 ---------------------------------------------------------------------
573 Finding the kind of a type
574 ~~~~~~~~~~~~~~~~~~~~~~~~~~
576 typeKind :: Type -> Kind
578 typeKind (TyVarTy tyvar) = tyVarKind tyvar
579 typeKind (TyConApp tycon tys) = foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
580 typeKind (NoteTy _ ty) = typeKind ty
581 typeKind (PredTy _) = liftedTypeKind -- Predicates are always
582 -- represented by lifted types
583 typeKind (AppTy fun arg) = kindFunResult (typeKind fun)
584 typeKind (FunTy arg res) = liftedTypeKind
585 typeKind (ForAllTy tv ty) = typeKind ty
589 ---------------------------------------------------------------------
590 Free variables of a type
591 ~~~~~~~~~~~~~~~~~~~~~~~~
593 tyVarsOfType :: Type -> TyVarSet
594 -- NB: for type synonyms tyVarsOfType does *not* expand the synonym
595 tyVarsOfType (TyVarTy tv) = unitVarSet tv
596 tyVarsOfType (TyConApp tycon tys) = tyVarsOfTypes tys
597 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
598 tyVarsOfType (PredTy sty) = tyVarsOfPred sty
599 tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
600 tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
601 tyVarsOfType (ForAllTy tyvar ty) = delVarSet (tyVarsOfType ty) tyvar
603 tyVarsOfTypes :: [Type] -> TyVarSet
604 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
606 tyVarsOfPred :: PredType -> TyVarSet
607 tyVarsOfPred (IParam _ ty) = tyVarsOfType ty
608 tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
610 tyVarsOfTheta :: ThetaType -> TyVarSet
611 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
613 -- Add a Note with the free tyvars to the top of the type
614 addFreeTyVars :: Type -> Type
615 addFreeTyVars ty@(NoteTy (FTVNote _) _) = ty
616 addFreeTyVars ty = NoteTy (FTVNote (tyVarsOfType ty)) ty
620 %************************************************************************
622 \subsection{TidyType}
624 %************************************************************************
626 tidyTy tidies up a type for printing in an error message, or in
629 It doesn't change the uniques at all, just the print names.
632 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
633 tidyTyVarBndr (tidy_env, subst) tyvar
634 = case tidyOccName tidy_env (getOccName name) of
635 (tidy', occ') -> ((tidy', subst'), tyvar')
637 subst' = extendVarEnv subst tyvar tyvar'
638 tyvar' = setTyVarName tyvar name'
639 name' = tidyNameOcc name occ'
641 name = tyVarName tyvar
643 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
644 -- Add the free tyvars to the env in tidy form,
645 -- so that we can tidy the type they are free in
646 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
648 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
649 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
651 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
652 -- Treat a new tyvar as a binder, and give it a fresh tidy name
653 tidyOpenTyVar env@(tidy_env, subst) tyvar
654 = case lookupVarEnv subst tyvar of
655 Just tyvar' -> (env, tyvar') -- Already substituted
656 Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
658 tidyType :: TidyEnv -> Type -> Type
659 tidyType env@(tidy_env, subst) ty
662 go (TyVarTy tv) = case lookupVarEnv subst tv of
663 Nothing -> TyVarTy tv
664 Just tv' -> TyVarTy tv'
665 go (TyConApp tycon tys) = let args = map go tys
666 in args `seqList` TyConApp tycon args
667 go (NoteTy note ty) = (NoteTy $! (go_note note)) $! (go ty)
668 go (PredTy sty) = PredTy (tidyPred env sty)
669 go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
670 go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
671 go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
673 (envp, tvp) = tidyTyVarBndr env tv
675 go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
677 tidyTypes env tys = map (tidyType env) tys
679 tidyPred :: TidyEnv -> PredType -> PredType
680 tidyPred env (IParam n ty) = IParam n (tidyType env ty)
681 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
685 @tidyOpenType@ grabs the free type variables, tidies them
686 and then uses @tidyType@ to work over the type itself
689 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
691 = (env', tidyType env' ty)
693 env' = tidyFreeTyVars env (tyVarsOfType ty)
695 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
696 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
698 tidyTopType :: Type -> Type
699 tidyTopType ty = tidyType emptyTidyEnv ty
703 %************************************************************************
707 %************************************************************************
709 We use a grevious hack for tidying KindVars. A TidyEnv contains
710 a (VarEnv Var) substitution, to express the renaming; but
711 KindVars are not Vars. The Right Thing ultimately is to make them
712 into Vars (and perhaps make Kinds into Types), but I just do a hack
713 here: I make up a TyVar just to remember the new OccName for the
717 tidyKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
718 tidyKind env@(tidy_env, subst) (KindVar kvar)
719 | Just tv <- lookupVarEnv_Directly subst uniq
720 = (env, KindVar (setKindVarOcc kvar (getOccName tv)))
722 = ((tidy', subst'), KindVar kvar')
724 uniq = kindVarUniq kvar
725 (tidy', occ') = tidyOccName tidy_env (kindVarOcc kvar)
726 kvar' = setKindVarOcc kvar occ'
727 fake_tv = mkTyVar tv_name (panic "tidyKind:fake tv kind")
728 tv_name = mkInternalName uniq occ' noSrcLoc
729 subst' = extendVarEnv subst fake_tv fake_tv
731 tidyKind env (FunKind k1 k2)
732 = (env2, FunKind k1' k2')
734 (env1, k1') = tidyKind env k1
735 (env2, k2') = tidyKind env1 k2
737 tidyKind env k = (env, k) -- Atomic kinds
741 %************************************************************************
743 \subsection{Liftedness}
745 %************************************************************************
748 isUnLiftedType :: Type -> Bool
749 -- isUnLiftedType returns True for forall'd unlifted types:
750 -- x :: forall a. Int#
751 -- I found bindings like these were getting floated to the top level.
752 -- They are pretty bogus types, mind you. It would be better never to
755 isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty'
756 isUnLiftedType (ForAllTy tv ty) = isUnLiftedType ty
757 isUnLiftedType (TyConApp tc _) = isUnLiftedTyCon tc
758 isUnLiftedType other = False
760 isUnboxedTupleType :: Type -> Bool
761 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
762 Just (tc, ty_args) -> isUnboxedTupleTyCon tc
765 -- Should only be applied to *types*; hence the assert
766 isAlgType :: Type -> Bool
767 isAlgType ty = case splitTyConApp_maybe ty of
768 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
773 @isStrictType@ computes whether an argument (or let RHS) should
774 be computed strictly or lazily, based only on its type.
775 Works just like isUnLiftedType, except that it has a special case
776 for dictionaries. Since it takes account of ClassP, you might think
777 this function should be in TcType, but isStrictType is used by DataCon,
778 which is below TcType in the hierarchy, so it's convenient to put it here.
781 isStrictType (PredTy pred) = isStrictPred pred
782 isStrictType ty | Just ty' <- coreView ty = isStrictType ty'
783 isStrictType (ForAllTy tv ty) = isStrictType ty
784 isStrictType (TyConApp tc _) = isUnLiftedTyCon tc
785 isStrictType other = False
787 isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
788 isStrictPred other = False
789 -- We may be strict in dictionary types, but only if it
790 -- has more than one component.
791 -- [Being strict in a single-component dictionary risks
792 -- poking the dictionary component, which is wrong.]
796 isPrimitiveType :: Type -> Bool
797 -- Returns types that are opaque to Haskell.
798 -- Most of these are unlifted, but now that we interact with .NET, we
799 -- may have primtive (foreign-imported) types that are lifted
800 isPrimitiveType ty = case splitTyConApp_maybe ty of
801 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
807 %************************************************************************
809 \subsection{Sequencing on types
811 %************************************************************************
814 seqType :: Type -> ()
815 seqType (TyVarTy tv) = tv `seq` ()
816 seqType (AppTy t1 t2) = seqType t1 `seq` seqType t2
817 seqType (FunTy t1 t2) = seqType t1 `seq` seqType t2
818 seqType (NoteTy note t2) = seqNote note `seq` seqType t2
819 seqType (PredTy p) = seqPred p
820 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
821 seqType (ForAllTy tv ty) = tv `seq` seqType ty
823 seqTypes :: [Type] -> ()
825 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
827 seqNote :: TyNote -> ()
828 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
830 seqPred :: PredType -> ()
831 seqPred (ClassP c tys) = c `seq` seqTypes tys
832 seqPred (IParam n ty) = n `seq` seqType ty
836 %************************************************************************
838 Equality for Core types
839 (We don't use instances so that we know where it happens)
841 %************************************************************************
843 Note that eqType works right even for partial applications of newtypes.
844 See Note [Newtype eta] in TyCon.lhs
847 coreEqType :: Type -> Type -> Bool
851 rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
853 eq env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
854 eq env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = eq (rnBndr2 env tv1 tv2) t1 t2
855 eq env (AppTy s1 t1) (AppTy s2 t2) = eq env s1 s2 && eq env t1 t2
856 eq env (FunTy s1 t1) (FunTy s2 t2) = eq env s1 s2 && eq env t1 t2
857 eq env (TyConApp tc1 tys1) (TyConApp tc2 tys2)
858 | tc1 == tc2, all2 (eq env) tys1 tys2 = True
859 -- The lengths should be equal because
860 -- the two types have the same kind
861 -- NB: if the type constructors differ that does not
862 -- necessarily mean that the types aren't equal
863 -- (synonyms, newtypes)
864 -- Even if the type constructors are the same, but the arguments
865 -- differ, the two types could be the same (e.g. if the arg is just
866 -- ignored in the RHS). In both these cases we fall through to an
867 -- attempt to expand one side or the other.
869 -- Now deal with newtypes, synonyms, pred-tys
870 eq env t1 t2 | Just t1' <- coreView t1 = eq env t1' t2
871 | Just t2' <- coreView t2 = eq env t1 t2'
873 -- Fall through case; not equal!
878 %************************************************************************
880 Comparision for source types
881 (We don't use instances so that we know where it happens)
883 %************************************************************************
887 do *not* look through newtypes, PredTypes
890 tcEqType :: Type -> Type -> Bool
891 tcEqType t1 t2 = isEqual $ cmpType t1 t2
893 tcEqTypes :: [Type] -> [Type] -> Bool
894 tcEqTypes tys1 tys2 = isEqual $ cmpTypes tys1 tys2
896 tcCmpType :: Type -> Type -> Ordering
897 tcCmpType t1 t2 = cmpType t1 t2
899 tcCmpTypes :: [Type] -> [Type] -> Ordering
900 tcCmpTypes tys1 tys2 = cmpTypes tys1 tys2
902 tcEqPred :: PredType -> PredType -> Bool
903 tcEqPred p1 p2 = isEqual $ cmpPred p1 p2
905 tcCmpPred :: PredType -> PredType -> Ordering
906 tcCmpPred p1 p2 = cmpPred p1 p2
908 tcEqTypeX :: RnEnv2 -> Type -> Type -> Bool
909 tcEqTypeX env t1 t2 = isEqual $ cmpTypeX env t1 t2
912 Now here comes the real worker
915 cmpType :: Type -> Type -> Ordering
916 cmpType t1 t2 = cmpTypeX rn_env t1 t2
918 rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
920 cmpTypes :: [Type] -> [Type] -> Ordering
921 cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2
923 rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfTypes ts1 `unionVarSet` tyVarsOfTypes ts2))
925 cmpPred :: PredType -> PredType -> Ordering
926 cmpPred p1 p2 = cmpPredX rn_env p1 p2
928 rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfPred p1 `unionVarSet` tyVarsOfPred p2))
930 cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse
931 cmpTypeX env t1 t2 | Just t1' <- tcView t1 = cmpTypeX env t1' t2
932 | Just t2' <- tcView t2 = cmpTypeX env t1 t2'
934 cmpTypeX env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 `compare` rnOccR env tv2
935 cmpTypeX env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
936 cmpTypeX env (AppTy s1 t1) (AppTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
937 cmpTypeX env (FunTy s1 t1) (FunTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
938 cmpTypeX env (PredTy p1) (PredTy p2) = cmpPredX env p1 p2
939 cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2
940 cmpTypeX env t1 (NoteTy _ t2) = cmpTypeX env t1 t2
942 -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < PredTy
943 cmpTypeX env (AppTy _ _) (TyVarTy _) = GT
945 cmpTypeX env (FunTy _ _) (TyVarTy _) = GT
946 cmpTypeX env (FunTy _ _) (AppTy _ _) = GT
948 cmpTypeX env (TyConApp _ _) (TyVarTy _) = GT
949 cmpTypeX env (TyConApp _ _) (AppTy _ _) = GT
950 cmpTypeX env (TyConApp _ _) (FunTy _ _) = GT
952 cmpTypeX env (ForAllTy _ _) (TyVarTy _) = GT
953 cmpTypeX env (ForAllTy _ _) (AppTy _ _) = GT
954 cmpTypeX env (ForAllTy _ _) (FunTy _ _) = GT
955 cmpTypeX env (ForAllTy _ _) (TyConApp _ _) = GT
957 cmpTypeX env (PredTy _) t2 = GT
959 cmpTypeX env _ _ = LT
962 cmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering
963 cmpTypesX env [] [] = EQ
964 cmpTypesX env (t1:tys1) (t2:tys2) = cmpTypeX env t1 t2 `thenCmp` cmpTypesX env tys1 tys2
965 cmpTypesX env [] tys = LT
966 cmpTypesX env ty [] = GT
969 cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
970 cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
971 -- Compare types as well as names for implicit parameters
972 -- This comparison is used exclusively (I think) for the
973 -- finite map built in TcSimplify
974 cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2
975 cmpPredX env (IParam _ _) (ClassP _ _) = LT
976 cmpPredX env (ClassP _ _) (IParam _ _) = GT
979 PredTypes are used as a FM key in TcSimplify,
980 so we take the easy path and make them an instance of Ord
983 instance Eq PredType where { (==) = tcEqPred }
984 instance Ord PredType where { compare = tcCmpPred }
988 %************************************************************************
992 %************************************************************************
996 = TvSubst InScopeSet -- The in-scope type variables
997 TvSubstEnv -- The substitution itself
998 -- See Note [Apply Once]
1000 {- ----------------------------------------------------------
1003 We use TvSubsts to instantiate things, and we might instantiate
1007 So the substition might go [a->b, b->a]. A similar situation arises in Core
1008 when we find a beta redex like
1009 (/\ a /\ b -> e) b a
1010 Then we also end up with a substition that permutes type variables. Other
1011 variations happen to; for example [a -> (a, b)].
1013 ***************************************************
1014 *** So a TvSubst must be applied precisely once ***
1015 ***************************************************
1017 A TvSubst is not idempotent, but, unlike the non-idempotent substitution
1018 we use during unifications, it must not be repeatedly applied.
1019 -------------------------------------------------------------- -}
1022 type TvSubstEnv = TyVarEnv Type
1023 -- A TvSubstEnv is used both inside a TvSubst (with the apply-once
1024 -- invariant discussed in Note [Apply Once]), and also independently
1025 -- in the middle of matching, and unification (see Types.Unify)
1026 -- So you have to look at the context to know if it's idempotent or
1027 -- apply-once or whatever
1028 emptyTvSubstEnv :: TvSubstEnv
1029 emptyTvSubstEnv = emptyVarEnv
1031 composeTvSubst :: InScopeSet -> TvSubstEnv -> TvSubstEnv -> TvSubstEnv
1032 -- (compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1
1033 -- It assumes that both are idempotent
1034 -- Typically, env1 is the refinement to a base substitution env2
1035 composeTvSubst in_scope env1 env2
1036 = env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
1037 -- First apply env1 to the range of env2
1038 -- Then combine the two, making sure that env1 loses if
1039 -- both bind the same variable; that's why env1 is the
1040 -- *left* argument to plusVarEnv, because the right arg wins
1042 subst1 = TvSubst in_scope env1
1044 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
1046 isEmptyTvSubst :: TvSubst -> Bool
1047 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
1049 mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
1052 getTvSubstEnv :: TvSubst -> TvSubstEnv
1053 getTvSubstEnv (TvSubst _ env) = env
1055 getTvInScope :: TvSubst -> InScopeSet
1056 getTvInScope (TvSubst in_scope _) = in_scope
1058 isInScope :: Var -> TvSubst -> Bool
1059 isInScope v (TvSubst in_scope _) = v `elemInScopeSet` in_scope
1061 notElemTvSubst :: TyVar -> TvSubst -> Bool
1062 notElemTvSubst tv (TvSubst _ env) = not (tv `elemVarEnv` env)
1064 setTvSubstEnv :: TvSubst -> TvSubstEnv -> TvSubst
1065 setTvSubstEnv (TvSubst in_scope _) env = TvSubst in_scope env
1067 extendTvInScope :: TvSubst -> [Var] -> TvSubst
1068 extendTvInScope (TvSubst in_scope env) vars = TvSubst (extendInScopeSetList in_scope vars) env
1070 extendTvSubst :: TvSubst -> TyVar -> Type -> TvSubst
1071 extendTvSubst (TvSubst in_scope env) tv ty = TvSubst in_scope (extendVarEnv env tv ty)
1073 extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
1074 extendTvSubstList (TvSubst in_scope env) tvs tys
1075 = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
1077 -- mkOpenTvSubst and zipOpenTvSubst generate the in-scope set from
1078 -- the types given; but it's just a thunk so with a bit of luck
1079 -- it'll never be evaluated
1081 mkOpenTvSubst :: TvSubstEnv -> TvSubst
1082 mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
1084 zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
1085 zipOpenTvSubst tyvars tys
1087 | length tyvars /= length tys
1088 = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
1091 = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
1093 -- mkTopTvSubst is called when doing top-level substitutions.
1094 -- Here we expect that the free vars of the range of the
1095 -- substitution will be empty.
1096 mkTopTvSubst :: [(TyVar, Type)] -> TvSubst
1097 mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs)
1099 zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
1100 zipTopTvSubst tyvars tys
1102 | length tyvars /= length tys
1103 = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
1106 = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
1108 zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
1111 | length tyvars /= length tys
1112 = pprTrace "mkTopTvSubst" (ppr tyvars $$ ppr tys) emptyVarEnv
1115 = zip_ty_env tyvars tys emptyVarEnv
1117 -- Later substitutions in the list over-ride earlier ones,
1118 -- but there should be no loops
1119 zip_ty_env [] [] env = env
1120 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendVarEnv env tv ty)
1121 -- There used to be a special case for when
1123 -- (a not-uncommon case) in which case the substitution was dropped.
1124 -- But the type-tidier changes the print-name of a type variable without
1125 -- changing the unique, and that led to a bug. Why? Pre-tidying, we had
1126 -- a type {Foo t}, where Foo is a one-method class. So Foo is really a newtype.
1127 -- And it happened that t was the type variable of the class. Post-tiding,
1128 -- it got turned into {Foo t2}. The ext-core printer expanded this using
1129 -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,
1130 -- and so generated a rep type mentioning t not t2.
1132 -- Simplest fix is to nuke the "optimisation"
1133 zip_ty_env tvs tys env = pprTrace "Var/Type length mismatch: " (ppr tvs $$ ppr tys) env
1134 -- zip_ty_env _ _ env = env
1136 instance Outputable TvSubst where
1137 ppr (TvSubst ins env)
1138 = sep[ ptext SLIT("<TvSubst"),
1139 nest 2 (ptext SLIT("In scope:") <+> ppr ins),
1140 nest 2 (ptext SLIT("Env:") <+> ppr env) ]
1143 %************************************************************************
1145 Performing type substitutions
1147 %************************************************************************
1150 substTyWith :: [TyVar] -> [Type] -> Type -> Type
1151 substTyWith tvs tys = ASSERT( length tvs == length tys )
1152 substTy (zipOpenTvSubst tvs tys)
1154 substTy :: TvSubst -> Type -> Type
1155 substTy subst ty | isEmptyTvSubst subst = ty
1156 | otherwise = subst_ty subst ty
1158 substTys :: TvSubst -> [Type] -> [Type]
1159 substTys subst tys | isEmptyTvSubst subst = tys
1160 | otherwise = map (subst_ty subst) tys
1162 substTheta :: TvSubst -> ThetaType -> ThetaType
1163 substTheta subst theta
1164 | isEmptyTvSubst subst = theta
1165 | otherwise = map (substPred subst) theta
1167 substPred :: TvSubst -> PredType -> PredType
1168 substPred subst (IParam n ty) = IParam n (subst_ty subst ty)
1169 substPred subst (ClassP clas tys) = ClassP clas (map (subst_ty subst) tys)
1171 deShadowTy :: TyVarSet -> Type -> Type -- Remove any nested binders mentioning tvs
1173 = subst_ty (mkTvSubst in_scope emptyTvSubstEnv) ty
1175 in_scope = mkInScopeSet tvs
1177 -- Note that the in_scope set is poked only if we hit a forall
1178 -- so it may often never be fully computed
1182 go (TyVarTy tv) = substTyVar subst tv
1183 go (TyConApp tc tys) = let args = map go tys
1184 in args `seqList` TyConApp tc args
1186 go (PredTy p) = PredTy $! (substPred subst p)
1188 go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
1190 go (FunTy arg res) = (FunTy $! (go arg)) $! (go res)
1191 go (AppTy fun arg) = mkAppTy (go fun) $! (go arg)
1192 -- The mkAppTy smart constructor is important
1193 -- we might be replacing (a Int), represented with App
1194 -- by [Int], represented with TyConApp
1195 go (ForAllTy tv ty) = case substTyVarBndr subst tv of
1196 (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
1198 substTyVar :: TvSubst -> TyVar -> Type
1200 = case lookupTyVar subst tv of
1201 Nothing -> TyVarTy tv
1202 Just ty' -> ty' -- See Note [Apply Once]
1204 lookupTyVar :: TvSubst -> TyVar -> Maybe Type
1205 lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv
1207 substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar)
1208 substTyVarBndr subst@(TvSubst in_scope env) old_var
1209 | old_var == new_var -- No need to clone
1210 -- But we *must* zap any current substitution for the variable.
1212 -- (\x.e) with id_subst = [x |-> e']
1213 -- Here we must simply zap the substitution for x
1215 -- The new_id isn't cloned, but it may have a different type
1216 -- etc, so we must return it, not the old id
1217 = (TvSubst (in_scope `extendInScopeSet` new_var)
1218 (delVarEnv env old_var),
1221 | otherwise -- The new binder is in scope so
1222 -- we'd better rename it away from the in-scope variables
1223 -- Extending the substitution to do this renaming also
1224 -- has the (correct) effect of discarding any existing
1225 -- substitution for that variable
1226 = (TvSubst (in_scope `extendInScopeSet` new_var)
1227 (extendVarEnv env old_var (TyVarTy new_var)),
1230 new_var = uniqAway in_scope old_var
1231 -- The uniqAway part makes sure the new variable is not already in scope