2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcType]{Types used in the typechecker}
6 This module provides the Type interface for front-end parts of the
9 * treat "source types" as opaque:
10 newtypes, and predicates are meaningful.
11 * look through usage types
13 The "tc" prefix is for "typechechecker", because the type checker
14 is the principal client.
18 --------------------------------
20 TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
21 TcTyVar, TcTyVarSet, TcKind,
23 --------------------------------
25 Expected(..), TcRef, TcTyVarDetails(..),
26 MetaDetails(Flexi, Indirect), SkolemInfo(..), pprTcTyVar, pprSkolInfo,
27 isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isExistentialTyVar, metaTvRef,
30 --------------------------------
32 mkPhiTy, mkSigmaTy, hoistForAllTys,
34 --------------------------------
36 -- These are important because they do not look through newtypes
38 tcSplitForAllTys, tcSplitPhiTy,
39 tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy,
40 tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
41 tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcSplitSigmaTy,
42 tcValidInstHeadTy, tcGetTyVar_maybe, tcGetTyVar,
44 ---------------------------------
46 -- Again, newtypes are opaque
47 tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
48 isSigmaTy, isOverloadedTy,
49 isDoubleTy, isFloatTy, isIntTy, isStringTy,
50 isIntegerTy, isAddrTy, isBoolTy, isUnitTy,
51 isTauTy, tcIsTyVarTy, tcIsForAllTy,
53 ---------------------------------
54 -- Misc type manipulators
55 deNoteType, classesOfTheta,
56 tyClsNamesOfType, tyClsNamesOfDFunHead,
59 ---------------------------------
61 getClassPredTys_maybe, getClassPredTys,
62 isClassPred, isTyVarClassPred,
63 mkDictTy, tcSplitPredTy_maybe,
64 isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
65 mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName,
68 ---------------------------------
69 -- Foreign import and export
70 isFFIArgumentTy, -- :: DynFlags -> Safety -> Type -> Bool
71 isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
72 isFFIExportResultTy, -- :: Type -> Bool
73 isFFIExternalTy, -- :: Type -> Bool
74 isFFIDynArgumentTy, -- :: Type -> Bool
75 isFFIDynResultTy, -- :: Type -> Bool
76 isFFILabelTy, -- :: Type -> Bool
77 isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
78 isFFIDotnetObjTy, -- :: Type -> Bool
79 isFFITy, -- :: Type -> Bool
81 toDNType, -- :: Type -> DNType
83 --------------------------------
84 -- Rexported from Type
85 Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
86 unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
87 isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
88 isArgTypeKind, isSubKind, defaultKind,
90 Type, PredType(..), ThetaType,
91 mkForAllTy, mkForAllTys,
92 mkFunTy, mkFunTys, zipFunTys,
93 mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
94 mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
97 TvSubst(..), -- Representation visible to a few friends
98 TvSubstEnv, emptyTvSubst,
99 mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
100 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
101 extendTvSubst, extendTvSubstList, isInScope,
102 substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
104 isUnLiftedType, -- Source types are always lifted
105 isUnboxedTupleType, -- Ditto
108 tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
109 tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, tidySkolemTyVar,
112 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
114 pprKind, pprParendKind,
115 pprType, pprParendType, pprTyThingCategory,
116 pprPred, pprTheta, pprThetaArrow, pprClassPred
120 #include "HsVersions.h"
123 import TypeRep ( Type(..), funTyCon ) -- friend
125 import Type ( -- Re-exports
126 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
127 tyVarsOfTheta, Kind, PredType(..),
128 ThetaType, unliftedTypeKind,
129 liftedTypeKind, openTypeKind, mkArrowKind,
130 isLiftedTypeKind, isUnliftedTypeKind,
131 mkArrowKinds, mkForAllTy, mkForAllTys,
132 defaultKind, isArgTypeKind, isOpenTypeKind,
133 mkFunTy, mkFunTys, zipFunTys,
134 mkTyConApp, mkGenTyConApp, mkAppTy,
135 mkAppTys, mkSynTy, applyTy, applyTys,
136 mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
137 mkPredTys, isUnLiftedType,
138 isUnboxedTupleType, isPrimitiveType,
140 tidyTopType, tidyType, tidyPred, tidyTypes,
141 tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
142 tidyTyVarBndr, tidyOpenTyVar,
143 tidyOpenTyVars, tidyKind,
144 isSubKind, deShadowTy, tcView,
146 tcEqType, tcEqTypes, tcCmpType, tcCmpTypes,
147 tcEqPred, tcCmpPred, tcEqTypeX,
150 TvSubstEnv, emptyTvSubst,
151 mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
152 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
153 extendTvSubst, extendTvSubstList, isInScope,
154 substTy, substTys, substTyWith, substTheta,
155 substTyVar, substTyVarBndr, substPred,
158 pprKind, pprParendKind,
159 pprType, pprParendType, pprTyThingCategory,
160 pprPred, pprTheta, pprThetaArrow, pprClassPred
162 import TyCon ( TyCon, isUnLiftedTyCon, isSynTyCon, tyConUnique )
163 import DataCon ( DataCon, dataConStupidTheta, dataConResTys )
164 import Class ( Class )
165 import Var ( TyVar, Id, isTcTyVar, mkTcTyVar, tyVarName, tyVarKind, tcTyVarDetails )
166 import ForeignCall ( Safety, playSafe, DNType(..) )
167 import Unify ( tcMatchTys )
171 import DynFlags ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
172 import Name ( Name, NamedThing(..), mkInternalName, getSrcLoc )
174 import VarEnv ( TidyEnv )
175 import OccName ( OccName, mkDictOcc )
176 import PrelNames -- Lots (e.g. in isFFIArgumentTy)
177 import TysWiredIn ( unitTyCon, charTyCon, listTyCon )
178 import BasicTypes ( IPName(..), ipNameName )
179 import SrcLoc ( SrcLoc, SrcSpan )
180 import Util ( snocView, equalLength )
181 import Maybes ( maybeToBool, expectJust, mapCatMaybes )
182 import ListSetOps ( hasNoDups )
183 import List ( nubBy )
189 %************************************************************************
193 %************************************************************************
195 The type checker divides the generic Type world into the
196 following more structured beasts:
198 sigma ::= forall tyvars. phi
199 -- A sigma type is a qualified type
201 -- Note that even if 'tyvars' is empty, theta
202 -- may not be: e.g. (?x::Int) => Int
204 -- Note that 'sigma' is in prenex form:
205 -- all the foralls are at the front.
206 -- A 'phi' type has no foralls to the right of
214 -- A 'tau' type has no quantification anywhere
215 -- Note that the args of a type constructor must be taus
217 | tycon tau_1 .. tau_n
221 -- In all cases, a (saturated) type synonym application is legal,
222 -- provided it expands to the required form.
225 type TcType = Type -- A TcType can have mutable type variables
226 -- Invariant on ForAllTy in TcTypes:
228 -- a cannot occur inside a MutTyVar in T; that is,
229 -- T is "flattened" before quantifying over a
231 type TcPredType = PredType
232 type TcThetaType = ThetaType
233 type TcSigmaType = TcType
234 type TcRhoType = TcType
235 type TcTauType = TcType
237 type TcTyVarSet = TyVarSet
239 type TcRef a = IORef a
240 data Expected ty = Infer (TcRef ty) -- The hole to fill in for type inference
241 | Check ty -- The type to check during type checking
245 %************************************************************************
247 \subsection{TyVarDetails}
249 %************************************************************************
251 TyVarDetails gives extra info about type variables, used during type
252 checking. It's attached to mutable type variables only.
253 It's knot-tied back to Var.lhs. There is no reason in principle
254 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
256 Note [Signature skolems]
257 ~~~~~~~~~~~~~~~~~~~~~~~~
262 (x,y,z) = ([y,z], z, head x)
264 Here, x and y have type sigs, which go into the environment. We used to
265 instantiate their types with skolem constants, and push those types into
266 the RHS, so we'd typecheck the RHS with type
268 where a*, b* are skolem constants, and c is an ordinary meta type varible.
270 The trouble is that the occurrences of z in the RHS force a* and b* to
271 be the *same*, so we can't make them into skolem constants that don't unify
272 with each other. Alas.
274 On the other hand, we *must* use skolems for signature type variables,
275 becuase GADT type refinement refines skolems only.
277 One solution woudl be insist that in the above defn the programmer uses
278 the same type variable in both type signatures. But that takes explanation.
280 The alternative (currently implemented) is to have a special kind of skolem
281 constant, SigSkokTv, which can unify with other SigSkolTvs.
285 type TcTyVar = TyVar -- Used only during type inference
287 -- A TyVarDetails is inside a TyVar
289 = MetaTv (IORef MetaDetails) -- A meta type variable stands for a tau-type
290 | SkolemTv SkolemInfo -- A skolem constant
291 | SigSkolTv Name (IORef MetaDetails) -- Ditto, but from a type signature;
292 -- see Note [Signature skolems]
293 -- The MetaDetails, if filled in, will
294 -- always be another SigSkolTv
297 = SigSkol Name -- Bound at a type signature
298 | ClsSkol Class -- Bound at a class decl
299 | InstSkol Id -- Bound at an instance decl
300 | PatSkol DataCon -- An existential type variable bound by a pattern for
301 SrcSpan -- a data constructor with an existential type. E.g.
302 -- data T = forall a. Eq a => MkT a
304 -- The pattern MkT x will allocate an existential type
306 | ArrowSkol SrcSpan -- An arrow form (see TcArrows)
308 | GenSkol [TcTyVar] -- Bound when doing a subsumption check for
309 TcType -- (forall tvs. ty)
313 = Flexi -- Flexi type variables unify to become
316 | Indirect TcType -- Type indirections, treated as wobbly
317 -- for the purpose of GADT unification.
319 tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
320 -- Tidy the type inside a GenSkol, preparatory to printing it
321 tidySkolemTyVar env tv
322 = ASSERT( isSkolemTyVar tv )
323 (env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
325 (env1, info1) = case tcTyVarDetails tv of
326 SkolemTv (GenSkol tvs ty loc) -> (env2, SkolemTv (GenSkol tvs1 ty1 loc))
328 (env1, tvs1) = tidyOpenTyVars env tvs
329 (env2, ty1) = tidyOpenType env1 ty
332 pprTcTyVar :: TcTyVar -> SDoc
333 -- Print tyvar with info about its binding
335 = quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
337 ppr_details (MetaTv _) = ptext SLIT("is a meta type variable")
338 ppr_details (SigSkolTv id _) = ptext SLIT("is bound by") <+> pprSkolInfo (SigSkol id)
339 ppr_details (SkolemTv info) = ptext SLIT("is bound by") <+> pprSkolInfo info
341 pprSkolInfo :: SkolemInfo -> SDoc
342 pprSkolInfo (SigSkol id) = ptext SLIT("the type signature for") <+> quotes (ppr id)
343 pprSkolInfo (ClsSkol cls) = ptext SLIT("the class declaration for") <+> quotes (ppr cls)
344 pprSkolInfo (InstSkol df) = ptext SLIT("the instance declaration at") <+> ppr (getSrcLoc df)
345 pprSkolInfo (ArrowSkol loc) = ptext SLIT("the arrow form at") <+> ppr loc
346 pprSkolInfo (PatSkol dc loc) = sep [ptext SLIT("the pattern for") <+> quotes (ppr dc),
347 nest 2 (ptext SLIT("at") <+> ppr loc)]
348 pprSkolInfo (GenSkol tvs ty loc) = sep [ptext SLIT("the polymorphic type")
349 <+> quotes (ppr (mkForAllTys tvs ty)),
350 nest 2 (ptext SLIT("at") <+> ppr loc)]
352 instance Outputable MetaDetails where
353 ppr Flexi = ptext SLIT("Flexi")
354 ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty
356 isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isMetaTyVar :: TyVar -> Bool
358 | isTcTyVar tv = isSkolemTyVar tv
362 = ASSERT( isTcTyVar tv )
363 case tcTyVarDetails tv of
365 SigSkolTv _ _ -> True
368 isExistentialTyVar tv -- Existential type variable, bound by a pattern
369 = ASSERT( isTcTyVar tv )
370 case tcTyVarDetails tv of
371 SkolemTv (PatSkol _ _) -> True
375 = ASSERT( isTcTyVar tv )
376 case tcTyVarDetails tv of
380 metaTvRef :: TyVar -> IORef MetaDetails
382 = ASSERT( isTcTyVar tv )
383 case tcTyVarDetails tv of
385 other -> pprPanic "metaTvRef" (ppr tv)
387 isFlexi, isIndirect :: MetaDetails -> Bool
389 isFlexi other = False
391 isIndirect (Indirect _) = True
392 isIndirect other = False
396 %************************************************************************
398 \subsection{Tau, sigma and rho}
400 %************************************************************************
403 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
405 mkPhiTy :: [PredType] -> Type -> Type
406 mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
409 @isTauTy@ tests for nested for-alls.
412 isTauTy :: Type -> Bool
413 isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
414 isTauTy (TyVarTy v) = True
415 isTauTy (TyConApp _ tys) = all isTauTy tys
416 isTauTy (AppTy a b) = isTauTy a && isTauTy b
417 isTauTy (FunTy a b) = isTauTy a && isTauTy b
418 isTauTy (PredTy p) = True -- Don't look through source types
419 isTauTy other = False
423 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
424 -- construct a dictionary function name
425 getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
426 getDFunTyKey (TyVarTy tv) = getOccName tv
427 getDFunTyKey (TyConApp tc _) = getOccName tc
428 getDFunTyKey (AppTy fun _) = getDFunTyKey fun
429 getDFunTyKey (FunTy arg _) = getOccName funTyCon
430 getDFunTyKey (ForAllTy _ t) = getDFunTyKey t
431 getDFunTyKey ty = pprPanic "getDFunTyKey" (pprType ty)
432 -- PredTy shouldn't happen
436 %************************************************************************
438 \subsection{Expanding and splitting}
440 %************************************************************************
442 These tcSplit functions are like their non-Tc analogues, but
443 a) they do not look through newtypes
444 b) they do not look through PredTys
445 c) [future] they ignore usage-type annotations
447 However, they are non-monadic and do not follow through mutable type
448 variables. It's up to you to make sure this doesn't matter.
451 tcSplitForAllTys :: Type -> ([TyVar], Type)
452 tcSplitForAllTys ty = split ty ty []
454 split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
455 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
456 split orig_ty t tvs = (reverse tvs, orig_ty)
458 tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
459 tcIsForAllTy (ForAllTy tv ty) = True
460 tcIsForAllTy t = False
462 tcSplitPhiTy :: Type -> ([PredType], Type)
463 tcSplitPhiTy ty = split ty ty []
465 split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
466 split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
467 Just p -> split res res (p:ts)
468 Nothing -> (reverse ts, orig_ty)
469 split orig_ty ty ts = (reverse ts, orig_ty)
471 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
472 (tvs, rho) -> case tcSplitPhiTy rho of
473 (theta, tau) -> (tvs, theta, tau)
475 tcTyConAppTyCon :: Type -> TyCon
476 tcTyConAppTyCon ty = fst (tcSplitTyConApp ty)
478 tcTyConAppArgs :: Type -> [Type]
479 tcTyConAppArgs ty = snd (tcSplitTyConApp ty)
481 tcSplitTyConApp :: Type -> (TyCon, [Type])
482 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
484 Nothing -> pprPanic "tcSplitTyConApp" (pprType ty)
486 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
487 tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
488 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
489 tcSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
490 -- Newtypes are opaque, so they may be split
491 -- However, predicates are not treated
492 -- as tycon applications by the type checker
493 tcSplitTyConApp_maybe other = Nothing
495 tcValidInstHeadTy :: Type -> Bool
496 -- Used in Haskell-98 mode, for the argument types of an instance head
497 -- These must not be type synonyms, but everywhere else type synonyms
498 -- are transparent, so we need a special function here
501 NoteTy _ ty -> tcValidInstHeadTy ty
502 TyConApp tc tys -> not (isSynTyCon tc) && ok tys
503 FunTy arg res -> ok [arg, res]
506 -- Check that all the types are type variables,
507 -- and that each is distinct
508 ok tys = equalLength tvs tys && hasNoDups tvs
510 tvs = mapCatMaybes get_tv tys
512 get_tv (NoteTy _ ty) = get_tv ty -- through synonyms
513 get_tv (TyVarTy tv) = Just tv -- Again, do not look
514 get_tv other = Nothing
516 tcSplitFunTys :: Type -> ([Type], Type)
517 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
519 Just (arg,res) -> (arg:args, res')
521 (args,res') = tcSplitFunTys res
523 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
524 tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
525 tcSplitFunTy_maybe (FunTy arg res) = Just (arg, res)
526 tcSplitFunTy_maybe other = Nothing
528 tcFunArgTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
529 tcFunResultTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> res }
532 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
533 tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
534 tcSplitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
535 tcSplitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
536 tcSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
537 Just (tys', ty') -> Just (TyConApp tc tys', ty')
539 tcSplitAppTy_maybe other = Nothing
541 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
543 Nothing -> pprPanic "tcSplitAppTy" (pprType ty)
545 tcSplitAppTys :: Type -> (Type, [Type])
549 go ty args = case tcSplitAppTy_maybe ty of
550 Just (ty', arg) -> go ty' (arg:args)
553 tcGetTyVar_maybe :: Type -> Maybe TyVar
554 tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
555 tcGetTyVar_maybe (TyVarTy tv) = Just tv
556 tcGetTyVar_maybe other = Nothing
558 tcGetTyVar :: String -> Type -> TyVar
559 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
561 tcIsTyVarTy :: Type -> Bool
562 tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
564 tcSplitDFunTy :: Type -> ([TyVar], [PredType], Class, [Type])
565 -- Split the type of a dictionary function
567 = case tcSplitSigmaTy ty of { (tvs, theta, tau) ->
568 case tcSplitDFunHead tau of { (clas, tys) ->
569 (tvs, theta, clas, tys) }}
571 tcSplitDFunHead :: Type -> (Class, [Type])
573 = case tcSplitPredTy_maybe tau of
574 Just (ClassP clas tys) -> (clas, tys)
579 %************************************************************************
581 \subsection{Predicate types}
583 %************************************************************************
586 tcSplitPredTy_maybe :: Type -> Maybe PredType
587 -- Returns Just for predicates only
588 tcSplitPredTy_maybe ty | Just ty' <- tcView ty = tcSplitPredTy_maybe ty'
589 tcSplitPredTy_maybe (PredTy p) = Just p
590 tcSplitPredTy_maybe other = Nothing
592 predTyUnique :: PredType -> Unique
593 predTyUnique (IParam n _) = getUnique (ipNameName n)
594 predTyUnique (ClassP clas tys) = getUnique clas
596 mkPredName :: Unique -> SrcLoc -> PredType -> Name
597 mkPredName uniq loc (ClassP cls tys) = mkInternalName uniq (mkDictOcc (getOccName cls)) loc
598 mkPredName uniq loc (IParam ip ty) = mkInternalName uniq (getOccName (ipNameName ip)) loc
602 --------------------- Dictionary types ---------------------------------
605 mkClassPred clas tys = ClassP clas tys
607 isClassPred :: PredType -> Bool
608 isClassPred (ClassP clas tys) = True
609 isClassPred other = False
611 isTyVarClassPred (ClassP clas tys) = all tcIsTyVarTy tys
612 isTyVarClassPred other = False
614 getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
615 getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
616 getClassPredTys_maybe _ = Nothing
618 getClassPredTys :: PredType -> (Class, [Type])
619 getClassPredTys (ClassP clas tys) = (clas, tys)
621 mkDictTy :: Class -> [Type] -> Type
622 mkDictTy clas tys = mkPredTy (ClassP clas tys)
624 isDictTy :: Type -> Bool
625 isDictTy ty | Just ty' <- tcView ty = isDictTy ty'
626 isDictTy (PredTy p) = isClassPred p
627 isDictTy other = False
630 --------------------- Implicit parameters ---------------------------------
633 isIPPred :: PredType -> Bool
634 isIPPred (IParam _ _) = True
635 isIPPred other = False
637 isInheritablePred :: PredType -> Bool
638 -- Can be inherited by a context. For example, consider
639 -- f x = let g y = (?v, y+x)
640 -- in (g 3 with ?v = 8,
642 -- The point is that g's type must be quantifed over ?v:
643 -- g :: (?v :: a) => a -> a
644 -- but it doesn't need to be quantified over the Num a dictionary
645 -- which can be free in g's rhs, and shared by both calls to g
646 isInheritablePred (ClassP _ _) = True
647 isInheritablePred other = False
649 isLinearPred :: TcPredType -> Bool
650 isLinearPred (IParam (Linear n) _) = True
651 isLinearPred other = False
654 --------------------- The stupid theta (sigh) ---------------------------------
657 dataConsStupidTheta :: [DataCon] -> ThetaType
658 -- Union the stupid thetas from all the specified constructors (non-empty)
659 -- All the constructors should have the same result type, modulo alpha conversion
660 -- The resulting ThetaType uses type variables from the *first* constructor in the list
662 -- It's here because it's used in MkId.mkRecordSelId, and in TcExpr
663 dataConsStupidTheta (con1:cons)
664 = nubBy tcEqPred all_preds
666 all_preds = dataConStupidTheta con1 ++ other_stupids
667 res_tys1 = dataConResTys con1
668 tvs1 = tyVarsOfTypes res_tys1
669 other_stupids = [ substPred subst pred
671 , let Just subst = tcMatchTys tvs1 res_tys1 (dataConResTys con)
672 , pred <- dataConStupidTheta con ]
676 %************************************************************************
678 \subsection{Predicates}
680 %************************************************************************
682 isSigmaTy returns true of any qualified type. It doesn't *necessarily* have
684 f :: (?x::Int) => Int -> Int
687 isSigmaTy :: Type -> Bool
688 isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
689 isSigmaTy (ForAllTy tyvar ty) = True
690 isSigmaTy (FunTy a b) = isPredTy a
693 isOverloadedTy :: Type -> Bool
694 isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
695 isOverloadedTy (ForAllTy tyvar ty) = isOverloadedTy ty
696 isOverloadedTy (FunTy a b) = isPredTy a
697 isOverloadedTy _ = False
699 isPredTy :: Type -> Bool -- Belongs in TcType because it does
700 -- not look through newtypes, or predtypes (of course)
701 isPredTy ty | Just ty' <- tcView ty = isPredTy ty'
702 isPredTy (PredTy sty) = True
707 isFloatTy = is_tc floatTyConKey
708 isDoubleTy = is_tc doubleTyConKey
709 isIntegerTy = is_tc integerTyConKey
710 isIntTy = is_tc intTyConKey
711 isAddrTy = is_tc addrTyConKey
712 isBoolTy = is_tc boolTyConKey
713 isUnitTy = is_tc unitTyConKey
715 is_tc :: Unique -> Type -> Bool
716 -- Newtypes are opaque to this
717 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
718 Just (tc, _) -> uniq == getUnique tc
725 %************************************************************************
729 %************************************************************************
731 hoistForAllTys is used for user-written type signatures only
732 We want to 'look through' type synonyms when doing this
733 so it's better done on the Type than the HsType
735 It moves all the foralls and constraints to the top
736 e.g. T -> forall a. a ==> forall a. T -> a
737 T -> (?x::Int) -> Int ==> (?x::Int) -> T -> Int
739 Also: it eliminates duplicate constraints. These can show up
740 when hoisting constraints, notably implicit parameters.
742 It tries hard to retain type synonyms if hoisting does not break one
743 up. Not only does this improve error messages, but there's a tricky
744 interaction with Haskell 98. H98 requires no unsaturated type
745 synonyms, which is checked by checkValidType. This runs after
746 hoisting, so we don't want hoisting to remove the SynNotes! (We can't
747 run validity checking before hoisting because in mutually-recursive
748 type definitions we postpone validity checking until after the knot is
752 hoistForAllTys :: Type -> Type
759 go (TyVarTy tv) = TyVarTy tv
760 go ty@(TyConApp tc tys)
761 | isSynTyCon tc, any isSigmaTy tys'
762 = go (expectJust "hoistForAllTys" (tcView ty))
763 -- Revolting special case. If a type synonym has foralls
764 -- at the top of its argument, then expanding the type synonym
765 -- might lead to more hositing. So we just abandon the synonym
766 -- altogether right here.
767 -- Note that we must go back to hoistForAllTys, because
768 -- expanding the type synonym may expose new binders. Yuk.
773 go (PredTy pred) = PredTy pred -- No nested foralls
774 go (NoteTy _ ty2) = go ty2 -- Discard the free tyvar note
775 go (FunTy arg res) = mk_fun_ty (go arg) (go res)
776 go (AppTy fun arg) = AppTy (go fun) (go arg)
777 go (ForAllTy tv ty) = ForAllTy tv (go ty)
779 -- mk_fun_ty does all the work.
780 -- It's building t1 -> t2:
781 -- if t2 is a for-all type, push t1 inside it
782 -- if t2 is (pred -> t3), check for duplicates
784 | not (isSigmaTy ty2) -- No forall's, or context =>
786 | PredTy p1 <- ty1 -- ty1 is a predicate
787 = if p1 `elem` theta2 then -- so check for duplicates
790 mkSigmaTy tvs2 (p1:theta2) tau2
792 = mkSigmaTy tvs2 theta2 (FunTy ty1 tau2)
794 (tvs2, theta2, tau2) = tcSplitSigmaTy $
795 deShadowTy (tyVarsOfType ty1) $
798 -- deShadowTy is important. For example:
799 -- type Foo r = forall a. a -> r
800 -- foo :: Foo (Foo ())
801 -- Here the hoisting should give
802 -- foo :: forall a a1. a -> a1 -> ()
804 -- deNoteType is important too, so that the deShadow sees that
805 -- synonym expanded! Sigh
809 %************************************************************************
813 %************************************************************************
816 deNoteType :: Type -> Type
817 -- Remove *outermost* type synonyms and other notes
818 deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
822 Find the free tycons and classes of a type. This is used in the front
826 tyClsNamesOfType :: Type -> NameSet
827 tyClsNamesOfType (TyVarTy tv) = emptyNameSet
828 tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
829 tyClsNamesOfType (NoteTy _ ty2) = tyClsNamesOfType ty2
830 tyClsNamesOfType (PredTy (IParam n ty)) = tyClsNamesOfType ty
831 tyClsNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
832 tyClsNamesOfType (FunTy arg res) = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
833 tyClsNamesOfType (AppTy fun arg) = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
834 tyClsNamesOfType (ForAllTy tyvar ty) = tyClsNamesOfType ty
836 tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
838 tyClsNamesOfDFunHead :: Type -> NameSet
839 -- Find the free type constructors and classes
840 -- of the head of the dfun instance type
841 -- The 'dfun_head_type' is because of
842 -- instance Foo a => Baz T where ...
843 -- The decl is an orphan if Baz and T are both not locally defined,
844 -- even if Foo *is* locally defined
845 tyClsNamesOfDFunHead dfun_ty
846 = case tcSplitSigmaTy dfun_ty of
847 (tvs,_,head_ty) -> tyClsNamesOfType head_ty
849 classesOfTheta :: ThetaType -> [Class]
850 -- Looks just for ClassP things; maybe it should check
851 classesOfTheta preds = [ c | ClassP c _ <- preds ]
855 %************************************************************************
857 \subsection[TysWiredIn-ext-type]{External types}
859 %************************************************************************
861 The compiler's foreign function interface supports the passing of a
862 restricted set of types as arguments and results (the restricting factor
866 isFFITy :: Type -> Bool
867 -- True for any TyCon that can possibly be an arg or result of an FFI call
868 isFFITy ty = checkRepTyCon legalFFITyCon ty
870 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
871 -- Checks for valid argument type for a 'foreign import'
872 isFFIArgumentTy dflags safety ty
873 = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
875 isFFIExternalTy :: Type -> Bool
876 -- Types that are allowed as arguments of a 'foreign export'
877 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
879 isFFIImportResultTy :: DynFlags -> Type -> Bool
880 isFFIImportResultTy dflags ty
881 = checkRepTyCon (legalFIResultTyCon dflags) ty
883 isFFIExportResultTy :: Type -> Bool
884 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
886 isFFIDynArgumentTy :: Type -> Bool
887 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
888 -- or a newtype of either.
889 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
891 isFFIDynResultTy :: Type -> Bool
892 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
893 -- or a newtype of either.
894 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
896 isFFILabelTy :: Type -> Bool
897 -- The type of a foreign label must be Ptr, FunPtr, Addr,
898 -- or a newtype of either.
899 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
901 isFFIDotnetTy :: DynFlags -> Type -> Bool
902 isFFIDotnetTy dflags ty
903 = checkRepTyCon (\ tc -> not (isByteArrayLikeTyCon tc) &&
904 (legalFIResultTyCon dflags tc ||
905 isFFIDotnetObjTy ty || isStringTy ty)) ty
907 -- Support String as an argument or result from a .NET FFI call.
909 case tcSplitTyConApp_maybe (repType ty) of
912 case tcSplitTyConApp_maybe (repType arg_ty) of
913 Just (cc,[]) -> cc == charTyCon
917 -- Support String as an argument or result from a .NET FFI call.
918 isFFIDotnetObjTy ty =
920 (_, t_ty) = tcSplitForAllTys ty
922 case tcSplitTyConApp_maybe (repType t_ty) of
923 Just (tc, [arg_ty]) | getName tc == objectTyConName -> True
926 toDNType :: Type -> DNType
928 | isStringTy ty = DNString
929 | isFFIDotnetObjTy ty = DNObject
930 | Just (tc,argTys) <- tcSplitTyConApp_maybe ty =
931 case lookup (getUnique tc) dn_assoc of
934 | tc `hasKey` ioTyConKey -> toDNType (head argTys)
935 | otherwise -> pprPanic ("toDNType: unsupported .NET type") (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
937 dn_assoc :: [ (Unique, DNType) ]
938 dn_assoc = [ (unitTyConKey, DNUnit)
939 , (intTyConKey, DNInt)
940 , (int8TyConKey, DNInt8)
941 , (int16TyConKey, DNInt16)
942 , (int32TyConKey, DNInt32)
943 , (int64TyConKey, DNInt64)
944 , (wordTyConKey, DNInt)
945 , (word8TyConKey, DNWord8)
946 , (word16TyConKey, DNWord16)
947 , (word32TyConKey, DNWord32)
948 , (word64TyConKey, DNWord64)
949 , (floatTyConKey, DNFloat)
950 , (doubleTyConKey, DNDouble)
951 , (addrTyConKey, DNPtr)
952 , (ptrTyConKey, DNPtr)
953 , (funPtrTyConKey, DNPtr)
954 , (charTyConKey, DNChar)
955 , (boolTyConKey, DNBool)
958 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
959 -- Look through newtypes
960 -- Non-recursive ones are transparent to splitTyConApp,
961 -- but recursive ones aren't. Manuel had:
962 -- newtype T = MkT (Ptr T)
963 -- and wanted it to work...
964 checkRepTyCon check_tc ty
965 | Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
968 checkRepTyConKey :: [Unique] -> Type -> Bool
969 -- Like checkRepTyCon, but just looks at the TyCon key
970 checkRepTyConKey keys
971 = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
974 ----------------------------------------------
975 These chaps do the work; they are not exported
976 ----------------------------------------------
979 legalFEArgTyCon :: TyCon -> Bool
980 -- It's illegal to return foreign objects and (mutable)
981 -- bytearrays from a _ccall_ / foreign declaration
982 -- (or be passed them as arguments in foreign exported functions).
984 | isByteArrayLikeTyCon tc
986 -- It's also illegal to make foreign exports that take unboxed
987 -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
989 = boxedMarshalableTyCon tc
991 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
992 legalFIResultTyCon dflags tc
993 | isByteArrayLikeTyCon tc = False
994 | tc == unitTyCon = True
995 | otherwise = marshalableTyCon dflags tc
997 legalFEResultTyCon :: TyCon -> Bool
998 legalFEResultTyCon tc
999 | isByteArrayLikeTyCon tc = False
1000 | tc == unitTyCon = True
1001 | otherwise = boxedMarshalableTyCon tc
1003 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
1004 -- Checks validity of types going from Haskell -> external world
1005 legalOutgoingTyCon dflags safety tc
1006 | playSafe safety && isByteArrayLikeTyCon tc
1009 = marshalableTyCon dflags tc
1011 legalFFITyCon :: TyCon -> Bool
1012 -- True for any TyCon that can possibly be an arg or result of an FFI call
1014 = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
1016 marshalableTyCon dflags tc
1017 = (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
1018 || boxedMarshalableTyCon tc
1020 boxedMarshalableTyCon tc
1021 = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
1022 , int32TyConKey, int64TyConKey
1023 , wordTyConKey, word8TyConKey, word16TyConKey
1024 , word32TyConKey, word64TyConKey
1025 , floatTyConKey, doubleTyConKey
1026 , addrTyConKey, ptrTyConKey, funPtrTyConKey
1029 , byteArrayTyConKey, mutableByteArrayTyConKey
1033 isByteArrayLikeTyCon :: TyCon -> Bool
1034 isByteArrayLikeTyCon tc =
1035 getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]