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 mkGenTyConApp, mkTyConApp, mkTyConTy,
27 tyConAppTyCon, tyConAppArgs,
28 splitTyConApp_maybe, splitTyConApp,
32 repType, typePrimRep, coreView, deepCoreView,
34 mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
35 applyTy, applyTys, isForAllTy, dropForAlls,
38 predTypeRep, mkPredTy, mkPredTys,
41 splitRecNewType_maybe,
44 isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
45 isStrictType, isStrictPred,
48 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
49 typeKind, addFreeTyVars,
51 -- Tidying up for printing
53 tidyOpenType, tidyOpenTypes,
54 tidyTyVarBndr, tidyFreeTyVars,
55 tidyOpenTyVar, tidyOpenTyVars,
56 tidyTopType, tidyPred,
59 coreEqType, tcEqType, tcEqTypes, tcCmpType, tcCmpTypes,
60 tcEqPred, tcCmpPred, tcEqTypeX,
66 TvSubstEnv, emptyTvSubstEnv, -- Representation widely visible
67 TvSubst(..), emptyTvSubst, -- Representation visible to a few friends
68 mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
69 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
70 extendTvSubst, extendTvSubstList, isInScope, composeTvSubst,
72 -- Performing substitution on types
73 substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
77 pprType, pprParendType, pprTyThingCategory,
78 pprPred, pprTheta, pprThetaArrow, pprClassPred
81 #include "HsVersions.h"
83 -- We import the representation and primitive functions from TypeRep.
84 -- Many things are reexported, but not the representation!
90 import Var ( Var, 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, newTyConRhs,
99 isAlgTyCon, isSynTyCon, tyConArity, newTyConRhs_maybe,
100 tyConKind, getSynTyConDefn, PrimRep(..), tyConPrimRep,
104 import CmdLineOpts ( opt_DictsStrict )
105 import SrcLoc ( noSrcLoc )
106 import Unique ( Uniquable(..) )
107 import Util ( mapAccumL, seqList, lengthIs, snocView, thenCmp, isEqual )
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 -- By being non-recursive and inlined, this case analysis gets efficiently
130 -- joined onto the case analysis that the caller is already doing
131 coreView (NoteTy _ ty) = Just ty
132 coreView (PredTy p) = Just (predTypeRep p)
133 coreView (TyConApp tc tys) = expandNewTcApp tc tys
134 coreView ty = Nothing
136 deepCoreView :: Type -> Type
137 -- Apply coreView recursively
139 | Just ty' <- coreView ty = deepCoreView ty'
140 deepCoreView (TyVarTy tv) = TyVarTy tv
141 deepCoreView (TyConApp tc tys) = TyConApp tc (map deepCoreView tys)
142 deepCoreView (AppTy t1 t2) = AppTy (deepCoreView t1) (deepCoreView t2)
143 deepCoreView (FunTy t1 t2) = FunTy (deepCoreView t1) (deepCoreView t2)
144 deepCoreView (ForAllTy tv ty) = ForAllTy tv (deepCoreView ty)
145 -- No NoteTy, no PredTy
147 expandNewTcApp :: TyCon -> [Type] -> Maybe Type
148 -- A local helper function (not exported)
149 -- Expands *the outermoset level of* a newtype application to
150 -- *either* a vanilla TyConApp (recursive newtype, or non-saturated)
151 -- *or* the newtype representation (otherwise), meaning the
152 -- type written in the RHS of the newtype decl,
153 -- which may itself be a newtype
155 -- Example: newtype R = MkR S
157 -- newtype T = MkT (T -> T)
158 -- expandNewTcApp on R gives Just S
160 -- on T gives Nothing (no expansion)
162 expandNewTcApp tc tys = case newTyConRhs_maybe tc tys of
164 Just (tenv, rhs) -> Just (substTy (mkTopTvSubst tenv) rhs)
168 %************************************************************************
170 \subsection{Constructor-specific functions}
172 %************************************************************************
175 ---------------------------------------------------------------------
179 mkTyVarTy :: TyVar -> Type
182 mkTyVarTys :: [TyVar] -> [Type]
183 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
185 getTyVar :: String -> Type -> TyVar
186 getTyVar msg ty = case getTyVar_maybe ty of
188 Nothing -> panic ("getTyVar: " ++ msg)
190 isTyVarTy :: Type -> Bool
191 isTyVarTy ty = isJust (getTyVar_maybe ty)
193 getTyVar_maybe :: Type -> Maybe TyVar
194 getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
195 getTyVar_maybe (TyVarTy tv) = Just tv
196 getTyVar_maybe other = Nothing
200 ---------------------------------------------------------------------
203 We need to be pretty careful with AppTy to make sure we obey the
204 invariant that a TyConApp is always visibly so. mkAppTy maintains the
208 mkAppTy orig_ty1 orig_ty2
211 mk_app (NoteTy _ ty1) = mk_app ty1
212 mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ [orig_ty2])
213 mk_app ty1 = AppTy orig_ty1 orig_ty2
214 -- We call mkGenTyConApp because the TyConApp could be an
215 -- under-saturated type synonym. GHC allows that; e.g.
216 -- type Foo k = k a -> k a
218 -- foo :: Foo Id -> Foo Id
220 -- Here Id is partially applied in the type sig for Foo,
221 -- but once the type synonyms are expanded all is well
223 mkAppTys :: Type -> [Type] -> Type
224 mkAppTys orig_ty1 [] = orig_ty1
225 -- This check for an empty list of type arguments
226 -- avoids the needless loss of a type synonym constructor.
227 -- For example: mkAppTys Rational []
228 -- returns to (Ratio Integer), which has needlessly lost
229 -- the Rational part.
230 mkAppTys orig_ty1 orig_tys2
233 mk_app (NoteTy _ ty1) = mk_app ty1
234 mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ orig_tys2)
235 -- mkGenTyConApp: see notes with mkAppTy
236 mk_app ty1 = foldl AppTy orig_ty1 orig_tys2
238 splitAppTy_maybe :: Type -> Maybe (Type, Type)
239 splitAppTy_maybe ty | Just ty' <- coreView ty = splitAppTy_maybe ty'
240 splitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
241 splitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
242 splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
244 Just (tys',ty') -> Just (TyConApp tc tys', ty')
245 splitAppTy_maybe other = Nothing
247 splitAppTy :: Type -> (Type, Type)
248 splitAppTy ty = case splitAppTy_maybe ty of
250 Nothing -> panic "splitAppTy"
252 splitAppTys :: Type -> (Type, [Type])
253 splitAppTys ty = split ty ty []
255 split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
256 split orig_ty (AppTy ty arg) args = split ty ty (arg:args)
257 split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
258 split orig_ty (FunTy ty1 ty2) args = ASSERT( null args )
259 (TyConApp funTyCon [], [ty1,ty2])
260 split orig_ty ty args = (orig_ty, args)
264 ---------------------------------------------------------------------
269 mkFunTy :: Type -> Type -> Type
270 mkFunTy arg res = FunTy arg res
272 mkFunTys :: [Type] -> Type -> Type
273 mkFunTys tys ty = foldr FunTy ty tys
275 isFunTy :: Type -> Bool
276 isFunTy ty = isJust (splitFunTy_maybe ty)
278 splitFunTy :: Type -> (Type, Type)
279 splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
280 splitFunTy (FunTy arg res) = (arg, res)
281 splitFunTy other = pprPanic "splitFunTy" (ppr other)
283 splitFunTy_maybe :: Type -> Maybe (Type, Type)
284 splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
285 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
286 splitFunTy_maybe other = Nothing
288 splitFunTys :: Type -> ([Type], Type)
289 splitFunTys ty = split [] ty ty
291 split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
292 split args orig_ty (FunTy arg res) = split (arg:args) res res
293 split args orig_ty ty = (reverse args, orig_ty)
295 splitFunTysN :: Int -> Type -> ([Type], Type)
296 -- Split off exactly n arg tys
297 splitFunTysN 0 ty = ([], ty)
298 splitFunTysN n ty = case splitFunTy ty of { (arg, res) ->
299 case splitFunTysN (n-1) res of { (args, res) ->
302 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
303 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
305 split acc [] nty ty = (reverse acc, nty)
307 | Just ty' <- coreView ty = split acc xs nty ty'
308 split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
309 split acc (x:xs) nty ty = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
311 funResultTy :: Type -> Type
312 funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
313 funResultTy (FunTy arg res) = res
314 funResultTy ty = pprPanic "funResultTy" (ppr ty)
316 funArgTy :: Type -> Type
317 funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
318 funArgTy (FunTy arg res) = arg
319 funArgTy ty = pprPanic "funArgTy" (ppr ty)
323 ---------------------------------------------------------------------
326 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or PredTy,
330 mkGenTyConApp :: TyCon -> [Type] -> Type
332 | isSynTyCon tc = mkSynTy tc tys
333 | otherwise = mkTyConApp tc tys
335 mkTyConApp :: TyCon -> [Type] -> Type
336 -- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
338 | isFunTyCon tycon, [ty1,ty2] <- tys
342 = ASSERT(not (isSynTyCon tycon))
345 mkTyConTy :: TyCon -> Type
346 mkTyConTy tycon = mkTyConApp tycon []
348 -- splitTyConApp "looks through" synonyms, because they don't
349 -- mean a distinct type, but all other type-constructor applications
350 -- including functions are returned as Just ..
352 tyConAppTyCon :: Type -> TyCon
353 tyConAppTyCon ty = fst (splitTyConApp ty)
355 tyConAppArgs :: Type -> [Type]
356 tyConAppArgs ty = snd (splitTyConApp ty)
358 splitTyConApp :: Type -> (TyCon, [Type])
359 splitTyConApp ty = case splitTyConApp_maybe ty of
361 Nothing -> pprPanic "splitTyConApp" (ppr ty)
363 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
364 splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
365 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
366 splitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
367 splitTyConApp_maybe other = Nothing
371 ---------------------------------------------------------------------
377 | n_args == arity -- Exactly saturated
379 | n_args > arity -- Over-saturated
380 = case splitAt arity tys of { (as,bs) -> mkAppTys (mk_syn as) bs }
381 -- Its important to use mkAppTys, rather than (foldl AppTy),
382 -- because (mk_syn as) might well return a partially-applied
383 -- type constructor; indeed, usually will!
384 | otherwise -- Un-saturated
386 -- For the un-saturated case we build TyConApp directly
387 -- (mkTyConApp ASSERTs that the tc isn't a SynTyCon).
388 -- Here we are relying on checkValidType to find
389 -- the error. What we can't do is use mkSynTy with
390 -- too few arg tys, because that is utterly bogus.
393 mk_syn tys = NoteTy (SynNote (TyConApp tycon tys))
394 (substTyWith tyvars tys body)
396 (tyvars, body) = ASSERT( isSynTyCon tycon ) getSynTyConDefn tycon
397 arity = tyConArity tycon
401 Notes on type synonyms
402 ~~~~~~~~~~~~~~~~~~~~~~
403 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
404 to return type synonyms whereever possible. Thus
409 splitFunTys (a -> Foo a) = ([a], Foo a)
412 The reason is that we then get better (shorter) type signatures in
413 interfaces. Notably this plays a role in tcTySigs in TcBinds.lhs.
418 repType looks through
422 (d) usage annotations
423 (e) all newtypes, including recursive ones
424 It's useful in the back end.
427 repType :: Type -> Type
428 -- Only applied to types of kind *; hence tycons are saturated
429 repType (ForAllTy _ ty) = repType ty
430 repType (NoteTy _ ty) = repType ty
431 repType (PredTy p) = repType (predTypeRep p)
432 repType (TyConApp tc tys)
433 | isNewTyCon tc = ASSERT( tys `lengthIs` tyConArity tc )
434 repType (new_type_rep tc tys)
437 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
438 -- of inspecting the type directly.
439 typePrimRep :: Type -> PrimRep
440 typePrimRep ty = case repType ty of
441 TyConApp tc _ -> tyConPrimRep tc
443 AppTy _ _ -> PtrRep -- See note below
445 other -> pprPanic "typePrimRep" (ppr ty)
446 -- Types of the form 'f a' must be of kind *, not *#, so
447 -- we are guaranteed that they are represented by pointers.
448 -- The reason is that f must have kind *->*, not *->*#, because
449 -- (we claim) there is no way to constrain f's kind any other
452 -- new_type_rep doesn't ask any questions:
453 -- it just expands newtype, whether recursive or not
454 new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
455 case newTyConRep new_tycon of
456 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
460 ---------------------------------------------------------------------
465 mkForAllTy :: TyVar -> Type -> Type
467 = mkForAllTys [tyvar] ty
469 mkForAllTys :: [TyVar] -> Type -> Type
470 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
472 isForAllTy :: Type -> Bool
473 isForAllTy (NoteTy _ ty) = isForAllTy ty
474 isForAllTy (ForAllTy _ _) = True
475 isForAllTy other_ty = False
477 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
478 splitForAllTy_maybe ty = splitFAT_m ty
480 splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
481 splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
482 splitFAT_m _ = Nothing
484 splitForAllTys :: Type -> ([TyVar], Type)
485 splitForAllTys ty = split ty ty []
487 split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
488 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
489 split orig_ty t tvs = (reverse tvs, orig_ty)
491 dropForAlls :: Type -> Type
492 dropForAlls ty = snd (splitForAllTys ty)
495 -- (mkPiType now in CoreUtils)
499 Instantiate a for-all type with one or more type arguments.
500 Used when we have a polymorphic function applied to type args:
502 Then we use (applyTys type-of-f [t1,t2]) to compute the type of
506 applyTy :: Type -> Type -> Type
507 applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
508 applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
509 applyTy other arg = panic "applyTy"
511 applyTys :: Type -> [Type] -> Type
512 -- This function is interesting because
513 -- a) the function may have more for-alls than there are args
514 -- b) less obviously, it may have fewer for-alls
515 -- For case (b) think of
516 -- applyTys (forall a.a) [forall b.b, Int]
517 -- This really can happen, via dressing up polymorphic types with newtype
518 -- clothing. Here's an example:
519 -- newtype R = R (forall a. a->a)
520 -- foo = case undefined :: R of
523 applyTys orig_fun_ty [] = orig_fun_ty
524 applyTys orig_fun_ty arg_tys
525 | n_tvs == n_args -- The vastly common case
526 = substTyWith tvs arg_tys rho_ty
527 | n_tvs > n_args -- Too many for-alls
528 = substTyWith (take n_args tvs) arg_tys
529 (mkForAllTys (drop n_args tvs) rho_ty)
530 | otherwise -- Too many type args
531 = ASSERT2( n_tvs > 0, ppr orig_fun_ty ) -- Zero case gives infnite loop!
532 applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
535 (tvs, rho_ty) = splitForAllTys orig_fun_ty
537 n_args = length arg_tys
541 %************************************************************************
543 \subsection{Source types}
545 %************************************************************************
547 A "source type" is a type that is a separate type as far as the type checker is
548 concerned, but which has low-level representation as far as the back end is concerned.
550 Source types are always lifted.
552 The key function is predTypeRep which gives the representation of a source type:
555 mkPredTy :: PredType -> Type
556 mkPredTy pred = PredTy pred
558 mkPredTys :: ThetaType -> [Type]
559 mkPredTys preds = map PredTy preds
561 predTypeRep :: PredType -> Type
562 -- Convert a PredType to its "representation type";
563 -- the post-type-checking type used by all the Core passes of GHC.
564 -- Unwraps only the outermost level; for example, the result might
565 -- be a newtype application
566 predTypeRep (IParam _ ty) = ty
567 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
568 -- Result might be a newtype application, but the consumer will
569 -- look through that too if necessary
573 %************************************************************************
577 %************************************************************************
580 splitRecNewType_maybe :: Type -> Maybe Type
581 -- Sometimes we want to look through a recursive newtype, and that's what happens here
582 -- It only strips *one layer* off, so the caller will usually call itself recursively
583 -- Only applied to types of kind *, hence the newtype is always saturated
584 splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty'
585 splitRecNewType_maybe (TyConApp tc tys)
587 = ASSERT( tys `lengthIs` tyConArity tc ) -- splitRecNewType_maybe only be applied
588 -- to *types* (of kind *)
589 ASSERT( isRecursiveTyCon tc ) -- Guaranteed by coreView
590 case newTyConRhs tc of
591 (tvs, rep_ty) -> Just (substTyWith tvs tys rep_ty)
593 splitRecNewType_maybe other = Nothing
597 %************************************************************************
599 \subsection{Kinds and free variables}
601 %************************************************************************
603 ---------------------------------------------------------------------
604 Finding the kind of a type
605 ~~~~~~~~~~~~~~~~~~~~~~~~~~
607 typeKind :: Type -> Kind
609 typeKind (TyVarTy tyvar) = tyVarKind tyvar
610 typeKind (TyConApp tycon tys) = foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
611 typeKind (NoteTy _ ty) = typeKind ty
612 typeKind (PredTy _) = liftedTypeKind -- Predicates are always
613 -- represented by lifted types
614 typeKind (AppTy fun arg) = kindFunResult (typeKind fun)
615 typeKind (FunTy arg res) = liftedTypeKind
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 (PredTy sty) = tyVarsOfPred 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 (IParam _ ty) = tyVarsOfType ty
654 tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
656 tyVarsOfTheta :: ThetaType -> TyVarSet
657 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
659 -- Add a Note with the free tyvars to the top of the type
660 addFreeTyVars :: Type -> Type
661 addFreeTyVars ty@(NoteTy (FTVNote _) _) = ty
662 addFreeTyVars ty = NoteTy (FTVNote (tyVarsOfType ty)) ty
665 %************************************************************************
667 \subsection{TidyType}
669 %************************************************************************
671 tidyTy tidies up a type for printing in an error message, or in
674 It doesn't change the uniques at all, just the print names.
677 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
678 tidyTyVarBndr (tidy_env, subst) tyvar
679 = case tidyOccName tidy_env (getOccName name) of
680 (tidy', occ') -> ((tidy', subst'), tyvar')
682 subst' = extendVarEnv subst tyvar tyvar'
683 tyvar' = setTyVarName tyvar name'
684 name' = mkInternalName (getUnique name) occ' noSrcLoc
685 -- Note: make a *user* tyvar, so it printes nicely
686 -- Could extract src loc, but no need.
688 name = tyVarName tyvar
690 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
691 -- Add the free tyvars to the env in tidy form,
692 -- so that we can tidy the type they are free in
693 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
695 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
696 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
698 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
699 -- Treat a new tyvar as a binder, and give it a fresh tidy name
700 tidyOpenTyVar env@(tidy_env, subst) tyvar
701 = case lookupVarEnv subst tyvar of
702 Just tyvar' -> (env, tyvar') -- Already substituted
703 Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
705 tidyType :: TidyEnv -> Type -> Type
706 tidyType env@(tidy_env, subst) ty
709 go (TyVarTy tv) = case lookupVarEnv subst tv of
710 Nothing -> TyVarTy tv
711 Just tv' -> TyVarTy tv'
712 go (TyConApp tycon tys) = let args = map go tys
713 in args `seqList` TyConApp tycon args
714 go (NoteTy note ty) = (NoteTy $! (go_note note)) $! (go ty)
715 go (PredTy sty) = PredTy (tidyPred env sty)
716 go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
717 go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
718 go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
720 (envp, tvp) = tidyTyVarBndr env tv
722 go_note (SynNote ty) = SynNote $! (go ty)
723 go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
725 tidyTypes env tys = map (tidyType env) tys
727 tidyPred :: TidyEnv -> PredType -> PredType
728 tidyPred env (IParam n ty) = IParam n (tidyType env ty)
729 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
733 @tidyOpenType@ grabs the free type variables, tidies them
734 and then uses @tidyType@ to work over the type itself
737 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
739 = (env', tidyType env' ty)
741 env' = tidyFreeTyVars env (tyVarsOfType ty)
743 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
744 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
746 tidyTopType :: Type -> Type
747 tidyTopType ty = tidyType emptyTidyEnv ty
752 %************************************************************************
754 \subsection{Liftedness}
756 %************************************************************************
759 isUnLiftedType :: Type -> Bool
760 -- isUnLiftedType returns True for forall'd unlifted types:
761 -- x :: forall a. Int#
762 -- I found bindings like these were getting floated to the top level.
763 -- They are pretty bogus types, mind you. It would be better never to
766 isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty'
767 isUnLiftedType (ForAllTy tv ty) = isUnLiftedType ty
768 isUnLiftedType (TyConApp tc _) = isUnLiftedTyCon tc
769 isUnLiftedType other = False
771 isUnboxedTupleType :: Type -> Bool
772 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
773 Just (tc, ty_args) -> isUnboxedTupleTyCon tc
776 -- Should only be applied to *types*; hence the assert
777 isAlgType :: Type -> Bool
778 isAlgType ty = case splitTyConApp_maybe ty of
779 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
784 @isStrictType@ computes whether an argument (or let RHS) should
785 be computed strictly or lazily, based only on its type.
786 Works just like isUnLiftedType, except that it has a special case
787 for dictionaries. Since it takes account of ClassP, you might think
788 this function should be in TcType, but isStrictType is used by DataCon,
789 which is below TcType in the hierarchy, so it's convenient to put it here.
792 isStrictType (PredTy pred) = isStrictPred pred
793 isStrictType ty | Just ty' <- coreView ty = isStrictType ty'
794 isStrictType (ForAllTy tv ty) = isStrictType ty
795 isStrictType (TyConApp tc _) = isUnLiftedTyCon tc
796 isStrictType other = False
798 isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
799 isStrictPred other = False
800 -- We may be strict in dictionary types, but only if it
801 -- has more than one component.
802 -- [Being strict in a single-component dictionary risks
803 -- poking the dictionary component, which is wrong.]
807 isPrimitiveType :: Type -> Bool
808 -- Returns types that are opaque to Haskell.
809 -- Most of these are unlifted, but now that we interact with .NET, we
810 -- may have primtive (foreign-imported) types that are lifted
811 isPrimitiveType ty = case splitTyConApp_maybe ty of
812 Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
818 %************************************************************************
820 \subsection{Sequencing on types
822 %************************************************************************
825 seqType :: Type -> ()
826 seqType (TyVarTy tv) = tv `seq` ()
827 seqType (AppTy t1 t2) = seqType t1 `seq` seqType t2
828 seqType (FunTy t1 t2) = seqType t1 `seq` seqType t2
829 seqType (NoteTy note t2) = seqNote note `seq` seqType t2
830 seqType (PredTy p) = seqPred p
831 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
832 seqType (ForAllTy tv ty) = tv `seq` seqType ty
834 seqTypes :: [Type] -> ()
836 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
838 seqNote :: TyNote -> ()
839 seqNote (SynNote ty) = seqType ty
840 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
842 seqPred :: PredType -> ()
843 seqPred (ClassP c tys) = c `seq` seqTypes tys
844 seqPred (IParam n ty) = n `seq` seqType ty
848 %************************************************************************
851 (We don't use instances so that we know where it happens)
853 %************************************************************************
857 * tcEqType, tcCmpType do *not* look through newtypes, PredTypes
858 * coreEqType *does* look through them
860 Note that eqType can respond 'False' for partial applications of newtypes.
862 newtype Parser m a = MkParser (Foogle m a)
864 Monad (Parser m) `eqType` Monad (Foogle m)
865 Well, yes, but eqType won't see that they are the same.
866 I don't think this is harmful, but it's soemthing to watch out for.
868 First, the external interface
871 coreEqType :: Type -> Type -> Bool
872 coreEqType t1 t2 = isEqual $ cmpType (deepCoreView t1) (deepCoreView t2)
874 tcEqType :: Type -> Type -> Bool
875 tcEqType t1 t2 = isEqual $ cmpType t1 t2
877 tcEqTypes :: [Type] -> [Type] -> Bool
878 tcEqTypes tys1 tys2 = isEqual $ cmpTypes tys1 tys2
880 tcCmpType :: Type -> Type -> Ordering
881 tcCmpType t1 t2 = cmpType t1 t2
883 tcCmpTypes :: [Type] -> [Type] -> Ordering
884 tcCmpTypes tys1 tys2 = cmpTypes tys1 tys2
886 tcEqPred :: PredType -> PredType -> Bool
887 tcEqPred p1 p2 = isEqual $ cmpPred p1 p2
889 tcCmpPred :: PredType -> PredType -> Ordering
890 tcCmpPred p1 p2 = cmpPred p1 p2
892 tcEqTypeX :: RnEnv2 -> Type -> Type -> Bool
893 tcEqTypeX env t1 t2 = isEqual $ cmpTypeX env t1 t2
896 Now here comes the real worker
899 cmpType :: Type -> Type -> Ordering
900 cmpType t1 t2 = cmpTypeX rn_env t1 t2
902 rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
904 cmpTypes :: [Type] -> [Type] -> Ordering
905 cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2
907 rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfTypes ts1 `unionVarSet` tyVarsOfTypes ts2))
909 cmpPred :: PredType -> PredType -> Ordering
910 cmpPred p1 p2 = cmpPredX rn_env p1 p2
912 rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfPred p1 `unionVarSet` tyVarsOfPred p2))
914 cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse
916 -- NB: we *cannot* short-cut the newtype comparison thus:
917 -- eqTypeX env (NewTcApp tc1 tys1) (NewTcApp tc2 tys2)
918 -- | (tc1 == tc2) = (eqTypeXs env tys1 tys2)
921 -- newtype T a = MkT [a]
922 -- newtype Foo m = MkFoo (forall a. m a -> Int)
927 -- w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
929 -- We end up with w2 = w1; so we need that Foo T = Foo []
930 -- but we can only expand saturated newtypes, so just comparing
931 -- T with [] won't do.
933 cmpTypeX env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 `compare` rnOccR env tv2
934 cmpTypeX env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
935 cmpTypeX env (AppTy s1 t1) (AppTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
936 cmpTypeX env (FunTy s1 t1) (FunTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
937 cmpTypeX env (PredTy p1) (PredTy p2) = cmpPredX env p1 p2
938 cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2
939 cmpTypeX env (NoteTy _ t1) t2 = cmpTypeX env t1 t2
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 composeTvSubst in_scope env1 env2
1035 = env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
1036 -- First apply env1 to the range of env2
1037 -- Then combine the two, making sure that env1 loses if
1038 -- both bind the same variable; that's why env1 is the
1039 -- *left* argument to plusVarEnv, becuause the right arg wins
1041 subst1 = TvSubst in_scope env1
1043 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
1044 isEmptyTvSubst :: TvSubst -> Bool
1045 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
1047 getTvSubstEnv :: TvSubst -> TvSubstEnv
1048 getTvSubstEnv (TvSubst _ env) = env
1050 getTvInScope :: TvSubst -> InScopeSet
1051 getTvInScope (TvSubst in_scope _) = in_scope
1053 isInScope :: Var -> TvSubst -> Bool
1054 isInScope v (TvSubst in_scope _) = v `elemInScopeSet` in_scope
1056 notElemTvSubst :: TyVar -> TvSubst -> Bool
1057 notElemTvSubst tv (TvSubst _ env) = not (tv `elemVarEnv` env)
1059 setTvSubstEnv :: TvSubst -> TvSubstEnv -> TvSubst
1060 setTvSubstEnv (TvSubst in_scope _) env = TvSubst in_scope env
1062 extendTvInScope :: TvSubst -> [Var] -> TvSubst
1063 extendTvInScope (TvSubst in_scope env) vars = TvSubst (extendInScopeSetList in_scope vars) env
1065 extendTvSubst :: TvSubst -> TyVar -> Type -> TvSubst
1066 extendTvSubst (TvSubst in_scope env) tv ty = TvSubst in_scope (extendVarEnv env tv ty)
1068 extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
1069 extendTvSubstList (TvSubst in_scope env) tvs tys
1070 = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
1072 -- mkTvSubst and zipTvSubst generate the in-scope set from
1073 -- the types given; but it's just a thunk so with a bit of luck
1074 -- it'll never be evaluated
1076 mkTvSubst :: TvSubstEnv -> TvSubst
1078 = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
1080 zipTvSubst :: [TyVar] -> [Type] -> TvSubst
1081 zipTvSubst tyvars tys
1082 = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
1084 -- mkTopTvSubst is called when doing top-level substitutions.
1085 -- Here we expect that the free vars of the range of the
1086 -- substitution will be empty.
1087 mkTopTvSubst :: [(TyVar, Type)] -> TvSubst
1088 mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs)
1090 zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
1091 zipTopTvSubst tyvars tys = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
1093 zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
1096 | length tyvars /= length tys
1097 = pprTrace "mkTopTvSubst" (ppr tyvars $$ ppr tys) emptyVarEnv
1100 = zip_ty_env tyvars tys emptyVarEnv
1102 -- Later substitutions in the list over-ride earlier ones,
1103 -- but there should be no loops
1104 zip_ty_env [] [] env = env
1105 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendVarEnv env tv ty)
1106 -- There used to be a special case for when
1108 -- (a not-uncommon case) in which case the substitution was dropped.
1109 -- But the type-tidier changes the print-name of a type variable without
1110 -- changing the unique, and that led to a bug. Why? Pre-tidying, we had
1111 -- a type {Foo t}, where Foo is a one-method class. So Foo is really a newtype.
1112 -- And it happened that t was the type variable of the class. Post-tiding,
1113 -- it got turned into {Foo t2}. The ext-core printer expanded this using
1114 -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,
1115 -- and so generated a rep type mentioning t not t2.
1117 -- Simplest fix is to nuke the "optimisation"
1119 instance Outputable TvSubst where
1120 ppr (TvSubst ins env)
1121 = sep[ ptext SLIT("<TvSubst"),
1122 nest 2 (ptext SLIT("In scope:") <+> ppr ins),
1123 nest 2 (ptext SLIT("Env:") <+> ppr env) ]
1126 %************************************************************************
1128 Performing type substitutions
1130 %************************************************************************
1133 substTyWith :: [TyVar] -> [Type] -> Type -> Type
1134 substTyWith tvs tys = substTy (zipTvSubst tvs tys)
1136 substTy :: TvSubst -> Type -> Type
1137 substTy subst ty | isEmptyTvSubst subst = ty
1138 | otherwise = subst_ty subst ty
1140 substTys :: TvSubst -> [Type] -> [Type]
1141 substTys subst tys | isEmptyTvSubst subst = tys
1142 | otherwise = map (subst_ty subst) tys
1144 deShadowTy :: Type -> Type -- Remove any shadowing from the type
1145 deShadowTy ty = subst_ty emptyTvSubst ty
1147 substTheta :: TvSubst -> ThetaType -> ThetaType
1148 substTheta subst theta
1149 | isEmptyTvSubst subst = theta
1150 | otherwise = map (substPred subst) theta
1152 substPred :: TvSubst -> PredType -> PredType
1153 substPred subst (IParam n ty) = IParam n (subst_ty subst ty)
1154 substPred subst (ClassP clas tys) = ClassP clas (map (subst_ty subst) tys)
1156 -- Note that the in_scope set is poked only if we hit a forall
1157 -- so it may often never be fully computed
1161 go (TyVarTy tv) = substTyVar subst tv
1162 go (TyConApp tc tys) = let args = map go tys
1163 in args `seqList` TyConApp tc args
1165 go (PredTy p) = PredTy $! (substPred subst p)
1167 go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote $! (go ty1)) $! (go ty2)
1168 go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
1170 go (FunTy arg res) = (FunTy $! (go arg)) $! (go res)
1171 go (AppTy fun arg) = mkAppTy (go fun) $! (go arg)
1172 -- The mkAppTy smart constructor is important
1173 -- we might be replacing (a Int), represented with App
1174 -- by [Int], represented with TyConApp
1175 go (ForAllTy tv ty) = case substTyVarBndr subst tv of
1176 (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
1178 substTyVar :: TvSubst -> TyVar -> Type
1179 substTyVar (TvSubst in_scope env) tv
1180 = case (lookupVarEnv env tv) of
1181 Nothing -> TyVarTy tv
1182 Just ty' -> ty' -- See Note [Apply Once]
1184 substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar)
1185 substTyVarBndr subst@(TvSubst in_scope env) old_var
1186 | old_var == new_var -- No need to clone
1187 -- But we *must* zap any current substitution for the variable.
1189 -- (\x.e) with id_subst = [x |-> e']
1190 -- Here we must simply zap the substitution for x
1192 -- The new_id isn't cloned, but it may have a different type
1193 -- etc, so we must return it, not the old id
1194 = (TvSubst (in_scope `extendInScopeSet` new_var)
1195 (delVarEnv env old_var),
1198 | otherwise -- The new binder is in scope so
1199 -- we'd better rename it away from the in-scope variables
1200 -- Extending the substitution to do this renaming also
1201 -- has the (correct) effect of discarding any existing
1202 -- substitution for that variable
1203 = (TvSubst (in_scope `extendInScopeSet` new_var)
1204 (extendVarEnv env old_var (TyVarTy new_var)),
1207 new_var = uniqAway in_scope old_var
1208 -- The uniqAway part makes sure the new variable is not already in scope