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
37 tcSplitForAllTys, tcSplitPhiTy,
38 tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy,
39 tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
40 tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcSplitSigmaTy,
41 tcValidInstHeadTy, tcGetTyVar_maybe, tcGetTyVar,
43 ---------------------------------
45 -- Again, newtypes are opaque
46 tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
47 isSigmaTy, isOverloadedTy,
48 isDoubleTy, isFloatTy, isIntTy, isStringTy,
49 isIntegerTy, isAddrTy, isBoolTy, isUnitTy,
50 isTauTy, tcIsTyVarTy, tcIsForAllTy,
52 ---------------------------------
53 -- Misc type manipulators
54 deNoteType, classesOfTheta,
55 tyClsNamesOfType, tyClsNamesOfDFunHead,
58 ---------------------------------
60 getClassPredTys_maybe, getClassPredTys,
61 isClassPred, isTyVarClassPred,
62 mkDictTy, tcSplitPredTy_maybe,
63 isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
64 mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName,
66 ---------------------------------
67 -- Foreign import and export
68 isFFIArgumentTy, -- :: DynFlags -> Safety -> Type -> Bool
69 isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
70 isFFIExportResultTy, -- :: Type -> Bool
71 isFFIExternalTy, -- :: Type -> Bool
72 isFFIDynArgumentTy, -- :: Type -> Bool
73 isFFIDynResultTy, -- :: Type -> Bool
74 isFFILabelTy, -- :: Type -> Bool
75 isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
76 isFFIDotnetObjTy, -- :: Type -> Bool
77 isFFITy, -- :: Type -> Bool
79 toDNType, -- :: Type -> DNType
81 --------------------------------
82 -- Rexported from Type
83 Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
84 unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
85 isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
86 isArgTypeKind, isSubKind, defaultKind,
88 Type, PredType(..), ThetaType,
89 mkForAllTy, mkForAllTys,
90 mkFunTy, mkFunTys, zipFunTys,
91 mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
92 mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
95 TvSubst(..), -- Representation visible to a few friends
96 TvSubstEnv, emptyTvSubst,
97 mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
98 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
99 extendTvSubst, extendTvSubstList, isInScope,
100 substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
102 isUnLiftedType, -- Source types are always lifted
103 isUnboxedTupleType, -- Ditto
106 tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
107 tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, tidySkolemTyVar,
110 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
112 pprKind, pprParendKind,
113 pprType, pprParendType, pprTyThingCategory,
114 pprPred, pprTheta, pprThetaArrow, pprClassPred
118 #include "HsVersions.h"
121 import TypeRep ( Type(..), TyNote(..), funTyCon ) -- friend
123 import Type ( -- Re-exports
124 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
125 tyVarsOfTheta, Kind, PredType(..),
126 ThetaType, unliftedTypeKind,
127 liftedTypeKind, openTypeKind, mkArrowKind,
128 isLiftedTypeKind, isUnliftedTypeKind,
129 mkArrowKinds, mkForAllTy, mkForAllTys,
130 defaultKind, isArgTypeKind, isOpenTypeKind,
131 mkFunTy, mkFunTys, zipFunTys,
132 mkTyConApp, mkGenTyConApp, mkAppTy,
133 mkAppTys, mkSynTy, applyTy, applyTys,
134 mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
135 mkPredTys, isUnLiftedType,
136 isUnboxedTupleType, isPrimitiveType,
138 tidyTopType, tidyType, tidyPred, tidyTypes,
139 tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
140 tidyTyVarBndr, tidyOpenTyVar,
142 isSubKind, deShadowTy,
144 tcEqType, tcEqTypes, tcCmpType, tcCmpTypes,
145 tcEqPred, tcCmpPred, tcEqTypeX,
148 TvSubstEnv, emptyTvSubst,
149 mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
150 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
151 extendTvSubst, extendTvSubstList, isInScope,
152 substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
155 pprKind, pprParendKind,
156 pprType, pprParendType, pprTyThingCategory,
157 pprPred, pprTheta, pprThetaArrow, pprClassPred
159 import TyCon ( TyCon, isUnLiftedTyCon, isSynTyCon, tyConUnique )
160 import DataCon ( DataCon )
161 import Class ( Class )
162 import Var ( TyVar, Id, isTcTyVar, mkTcTyVar, tyVarName, tyVarKind, tcTyVarDetails )
163 import ForeignCall ( Safety, playSafe, DNType(..) )
167 import DynFlags ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
168 import Name ( Name, NamedThing(..), mkInternalName, getSrcLoc )
170 import VarEnv ( TidyEnv )
171 import OccName ( OccName, mkDictOcc )
172 import PrelNames -- Lots (e.g. in isFFIArgumentTy)
173 import TysWiredIn ( unitTyCon, charTyCon, listTyCon )
174 import BasicTypes ( IPName(..), ipNameName )
175 import SrcLoc ( SrcLoc, SrcSpan )
176 import Util ( snocView, equalLength )
177 import Maybes ( maybeToBool, expectJust, mapCatMaybes )
178 import ListSetOps ( hasNoDups )
184 %************************************************************************
188 %************************************************************************
190 The type checker divides the generic Type world into the
191 following more structured beasts:
193 sigma ::= forall tyvars. phi
194 -- A sigma type is a qualified type
196 -- Note that even if 'tyvars' is empty, theta
197 -- may not be: e.g. (?x::Int) => Int
199 -- Note that 'sigma' is in prenex form:
200 -- all the foralls are at the front.
201 -- A 'phi' type has no foralls to the right of
209 -- A 'tau' type has no quantification anywhere
210 -- Note that the args of a type constructor must be taus
212 | tycon tau_1 .. tau_n
216 -- In all cases, a (saturated) type synonym application is legal,
217 -- provided it expands to the required form.
220 type TcType = Type -- A TcType can have mutable type variables
221 -- Invariant on ForAllTy in TcTypes:
223 -- a cannot occur inside a MutTyVar in T; that is,
224 -- T is "flattened" before quantifying over a
226 type TcPredType = PredType
227 type TcThetaType = ThetaType
228 type TcSigmaType = TcType
229 type TcRhoType = TcType
230 type TcTauType = TcType
232 type TcTyVarSet = TyVarSet
234 type TcRef a = IORef a
235 data Expected ty = Infer (TcRef ty) -- The hole to fill in for type inference
236 | Check ty -- The type to check during type checking
240 %************************************************************************
242 \subsection{TyVarDetails}
244 %************************************************************************
246 TyVarDetails gives extra info about type variables, used during type
247 checking. It's attached to mutable type variables only.
248 It's knot-tied back to Var.lhs. There is no reason in principle
249 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
251 Note [Signature skolems]
252 ~~~~~~~~~~~~~~~~~~~~~~~~
257 (x,y,z) = ([y,z], z, head x)
259 Here, x and y have type sigs, which go into the environment. We used to
260 instantiate their types with skolem constants, and push those types into
261 the RHS, so we'd typecheck the RHS with type
263 where a*, b* are skolem constants, and c is an ordinary meta type varible.
265 The trouble is that the occurrences of z in the RHS force a* and b* to
266 be the *same*, so we can't make them into skolem constants that don't unify
267 with each other. Alas.
269 On the other hand, we *must* use skolems for signature type variables,
270 becuase GADT type refinement refines skolems only.
272 One solution woudl be insist that in the above defn the programmer uses
273 the same type variable in both type signatures. But that takes explanation.
275 The alternative (currently implemented) is to have a special kind of skolem
276 constant, SigSkokTv, which can unify with other SigSkolTvs.
280 type TcTyVar = TyVar -- Used only during type inference
282 -- A TyVarDetails is inside a TyVar
284 = MetaTv (IORef MetaDetails) -- A meta type variable stands for a tau-type
285 | SkolemTv SkolemInfo -- A skolem constant
286 | SigSkolTv Name (IORef MetaDetails) -- Ditto, but from a type signature;
287 -- see Note [Signature skolems]
288 -- The MetaDetails, if filled in, will
289 -- always be another SigSkolTv
292 = SigSkol Name -- Bound at a type signature
293 | ClsSkol Class -- Bound at a class decl
294 | InstSkol Id -- Bound at an instance decl
295 | PatSkol DataCon -- An existential type variable bound by a pattern for
296 SrcSpan -- a data constructor with an existential type. E.g.
297 -- data T = forall a. Eq a => MkT a
299 -- The pattern MkT x will allocate an existential type
301 | ArrowSkol SrcSpan -- An arrow form (see TcArrows)
303 | GenSkol [TcTyVar] -- Bound when doing a subsumption check for
304 TcType -- (forall tvs. ty)
308 = Flexi -- Flexi type variables unify to become
311 | Indirect TcType -- Type indirections, treated as wobbly
312 -- for the purpose of GADT unification.
314 tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
315 -- Tidy the type inside a GenSkol, preparatory to printing it
316 tidySkolemTyVar env tv
317 = ASSERT( isSkolemTyVar tv )
318 (env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
320 (env1, info1) = case tcTyVarDetails tv of
321 SkolemTv (GenSkol tvs ty loc) -> (env2, SkolemTv (GenSkol tvs1 ty1 loc))
323 (env1, tvs1) = tidyOpenTyVars env tvs
324 (env2, ty1) = tidyOpenType env1 ty
327 pprTcTyVar :: TcTyVar -> SDoc
328 -- Print tyvar with info about its binding
330 = quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
332 ppr_details (MetaTv _) = ptext SLIT("is a meta type variable")
333 ppr_details (SigSkolTv id _) = ptext SLIT("is bound by") <+> pprSkolInfo (SigSkol id)
334 ppr_details (SkolemTv info) = ptext SLIT("is bound by") <+> pprSkolInfo info
336 pprSkolInfo :: SkolemInfo -> SDoc
337 pprSkolInfo (SigSkol id) = ptext SLIT("the type signature for") <+> quotes (ppr id)
338 pprSkolInfo (ClsSkol cls) = ptext SLIT("the class declaration for") <+> quotes (ppr cls)
339 pprSkolInfo (InstSkol df) = ptext SLIT("the instance declaration at") <+> ppr (getSrcLoc df)
340 pprSkolInfo (ArrowSkol loc) = ptext SLIT("the arrow form at") <+> ppr loc
341 pprSkolInfo (PatSkol dc loc) = sep [ptext SLIT("the pattern for") <+> quotes (ppr dc),
342 nest 2 (ptext SLIT("at") <+> ppr loc)]
343 pprSkolInfo (GenSkol tvs ty loc) = sep [ptext SLIT("the polymorphic type")
344 <+> quotes (ppr (mkForAllTys tvs ty)),
345 nest 2 (ptext SLIT("at") <+> ppr loc)]
347 instance Outputable MetaDetails where
348 ppr Flexi = ptext SLIT("Flexi")
349 ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty
351 isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isMetaTyVar :: TyVar -> Bool
353 | isTcTyVar tv = isSkolemTyVar tv
357 = ASSERT( isTcTyVar tv )
358 case tcTyVarDetails tv of
360 SigSkolTv _ _ -> True
363 isExistentialTyVar tv -- Existential type variable, bound by a pattern
364 = ASSERT( isTcTyVar tv )
365 case tcTyVarDetails tv of
366 SkolemTv (PatSkol _ _) -> True
370 = ASSERT( isTcTyVar tv )
371 case tcTyVarDetails tv of
375 metaTvRef :: TyVar -> IORef MetaDetails
377 = ASSERT( isTcTyVar tv )
378 case tcTyVarDetails tv of
380 other -> pprPanic "metaTvRef" (ppr tv)
382 isFlexi, isIndirect :: MetaDetails -> Bool
384 isFlexi other = False
386 isIndirect (Indirect _) = True
387 isIndirect other = False
391 %************************************************************************
393 \subsection{Tau, sigma and rho}
395 %************************************************************************
398 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
400 mkPhiTy :: [PredType] -> Type -> Type
401 mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
404 @isTauTy@ tests for nested for-alls.
407 isTauTy :: Type -> Bool
408 isTauTy (TyVarTy v) = True
409 isTauTy (TyConApp _ tys) = all isTauTy tys
410 isTauTy (AppTy a b) = isTauTy a && isTauTy b
411 isTauTy (FunTy a b) = isTauTy a && isTauTy b
412 isTauTy (PredTy p) = True -- Don't look through source types
413 isTauTy (NoteTy _ ty) = isTauTy ty
414 isTauTy other = False
418 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
419 -- construct a dictionary function name
420 getDFunTyKey (TyVarTy tv) = getOccName tv
421 getDFunTyKey (TyConApp tc _) = getOccName tc
422 getDFunTyKey (AppTy fun _) = getDFunTyKey fun
423 getDFunTyKey (NoteTy _ t) = getDFunTyKey t
424 getDFunTyKey (FunTy arg _) = getOccName funTyCon
425 getDFunTyKey (ForAllTy _ t) = getDFunTyKey t
426 getDFunTyKey ty = pprPanic "getDFunTyKey" (pprType ty)
427 -- PredTy shouldn't happen
431 %************************************************************************
433 \subsection{Expanding and splitting}
435 %************************************************************************
437 These tcSplit functions are like their non-Tc analogues, but
438 a) they do not look through newtypes
439 b) they do not look through PredTys
440 c) [future] they ignore usage-type annotations
442 However, they are non-monadic and do not follow through mutable type
443 variables. It's up to you to make sure this doesn't matter.
446 tcSplitForAllTys :: Type -> ([TyVar], Type)
447 tcSplitForAllTys ty = split ty ty []
449 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
450 split orig_ty (NoteTy n ty) tvs = split orig_ty ty tvs
451 split orig_ty t tvs = (reverse tvs, orig_ty)
453 tcIsForAllTy (ForAllTy tv ty) = True
454 tcIsForAllTy (NoteTy n ty) = tcIsForAllTy ty
455 tcIsForAllTy t = False
457 tcSplitPhiTy :: Type -> ([PredType], Type)
458 tcSplitPhiTy ty = split ty ty []
460 split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
461 Just p -> split res res (p:ts)
462 Nothing -> (reverse ts, orig_ty)
463 split orig_ty (NoteTy n ty) ts = split orig_ty ty ts
464 split orig_ty ty ts = (reverse ts, orig_ty)
466 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
467 (tvs, rho) -> case tcSplitPhiTy rho of
468 (theta, tau) -> (tvs, theta, tau)
470 tcTyConAppTyCon :: Type -> TyCon
471 tcTyConAppTyCon ty = fst (tcSplitTyConApp ty)
473 tcTyConAppArgs :: Type -> [Type]
474 tcTyConAppArgs ty = snd (tcSplitTyConApp ty)
476 tcSplitTyConApp :: Type -> (TyCon, [Type])
477 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
479 Nothing -> pprPanic "tcSplitTyConApp" (pprType ty)
481 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
482 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
483 tcSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
484 tcSplitTyConApp_maybe (NoteTy n ty) = tcSplitTyConApp_maybe ty
485 -- Newtypes are opaque, so they may be split
486 -- However, predicates are not treated
487 -- as tycon applications by the type checker
488 tcSplitTyConApp_maybe other = Nothing
490 tcValidInstHeadTy :: Type -> Bool
491 -- Used in Haskell-98 mode, for the argument types of an instance head
492 -- These must not be type synonyms, but everywhere else type synonyms
493 -- are transparent, so we need a special function here
496 TyConApp tc tys -> ASSERT( not (isSynTyCon tc) ) ok tys
497 -- A synonym would be a NoteTy
498 FunTy arg res -> ok [arg, res]
499 NoteTy (SynNote _) _ -> False
500 NoteTy other_note ty -> tcValidInstHeadTy ty
503 -- Check that all the types are type variables,
504 -- and that each is distinct
505 ok tys = equalLength tvs tys && hasNoDups tvs
507 tvs = mapCatMaybes get_tv tys
509 get_tv (TyVarTy tv) = Just tv -- Again, do not look
510 get_tv (NoteTy (SynNote _) _) = Nothing -- through synonyms
511 get_tv (NoteTy other_note ty) = get_tv ty
512 get_tv other = Nothing
514 tcSplitFunTys :: Type -> ([Type], Type)
515 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
517 Just (arg,res) -> (arg:args, res')
519 (args,res') = tcSplitFunTys res
521 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
522 tcSplitFunTy_maybe (FunTy arg res) = Just (arg, res)
523 tcSplitFunTy_maybe (NoteTy n ty) = tcSplitFunTy_maybe ty
524 tcSplitFunTy_maybe other = Nothing
526 tcFunArgTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
527 tcFunResultTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> res }
530 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
531 tcSplitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
532 tcSplitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
533 tcSplitAppTy_maybe (NoteTy n ty) = tcSplitAppTy_maybe ty
534 tcSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
535 Just (tys', ty') -> Just (TyConApp tc tys', ty')
537 tcSplitAppTy_maybe other = Nothing
539 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
541 Nothing -> pprPanic "tcSplitAppTy" (pprType ty)
543 tcSplitAppTys :: Type -> (Type, [Type])
547 go ty args = case tcSplitAppTy_maybe ty of
548 Just (ty', arg) -> go ty' (arg:args)
551 tcGetTyVar_maybe :: Type -> Maybe TyVar
552 tcGetTyVar_maybe (TyVarTy tv) = Just tv
553 tcGetTyVar_maybe (NoteTy _ t) = tcGetTyVar_maybe t
554 tcGetTyVar_maybe other = Nothing
556 tcGetTyVar :: String -> Type -> TyVar
557 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
559 tcIsTyVarTy :: Type -> Bool
560 tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
562 tcSplitDFunTy :: Type -> ([TyVar], [PredType], Class, [Type])
563 -- Split the type of a dictionary function
565 = case tcSplitSigmaTy ty of { (tvs, theta, tau) ->
566 case tcSplitDFunHead tau of { (clas, tys) ->
567 (tvs, theta, clas, tys) }}
569 tcSplitDFunHead :: Type -> (Class, [Type])
571 = case tcSplitPredTy_maybe tau of
572 Just (ClassP clas tys) -> (clas, tys)
577 %************************************************************************
579 \subsection{Predicate types}
581 %************************************************************************
584 tcSplitPredTy_maybe :: Type -> Maybe PredType
585 -- Returns Just for predicates only
586 tcSplitPredTy_maybe (NoteTy _ ty) = tcSplitPredTy_maybe ty
587 tcSplitPredTy_maybe (PredTy p) = Just p
588 tcSplitPredTy_maybe other = Nothing
590 predTyUnique :: PredType -> Unique
591 predTyUnique (IParam n _) = getUnique (ipNameName n)
592 predTyUnique (ClassP clas tys) = getUnique clas
594 mkPredName :: Unique -> SrcLoc -> PredType -> Name
595 mkPredName uniq loc (ClassP cls tys) = mkInternalName uniq (mkDictOcc (getOccName cls)) loc
596 mkPredName uniq loc (IParam ip ty) = mkInternalName uniq (getOccName (ipNameName ip)) loc
600 --------------------- Dictionary types ---------------------------------
603 mkClassPred clas tys = ClassP clas tys
605 isClassPred :: PredType -> Bool
606 isClassPred (ClassP clas tys) = True
607 isClassPred other = False
609 isTyVarClassPred (ClassP clas tys) = all tcIsTyVarTy tys
610 isTyVarClassPred other = False
612 getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
613 getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
614 getClassPredTys_maybe _ = Nothing
616 getClassPredTys :: PredType -> (Class, [Type])
617 getClassPredTys (ClassP clas tys) = (clas, tys)
619 mkDictTy :: Class -> [Type] -> Type
620 mkDictTy clas tys = mkPredTy (ClassP clas tys)
622 isDictTy :: Type -> Bool
623 isDictTy (PredTy p) = isClassPred p
624 isDictTy (NoteTy _ ty) = isDictTy ty
625 isDictTy other = False
628 --------------------- Implicit parameters ---------------------------------
631 isIPPred :: PredType -> Bool
632 isIPPred (IParam _ _) = True
633 isIPPred other = False
635 isInheritablePred :: PredType -> Bool
636 -- Can be inherited by a context. For example, consider
637 -- f x = let g y = (?v, y+x)
638 -- in (g 3 with ?v = 8,
640 -- The point is that g's type must be quantifed over ?v:
641 -- g :: (?v :: a) => a -> a
642 -- but it doesn't need to be quantified over the Num a dictionary
643 -- which can be free in g's rhs, and shared by both calls to g
644 isInheritablePred (ClassP _ _) = True
645 isInheritablePred other = False
647 isLinearPred :: TcPredType -> Bool
648 isLinearPred (IParam (Linear n) _) = True
649 isLinearPred other = False
653 %************************************************************************
655 \subsection{Predicates}
657 %************************************************************************
659 isSigmaTy returns true of any qualified type. It doesn't *necessarily* have
661 f :: (?x::Int) => Int -> Int
664 isSigmaTy :: Type -> Bool
665 isSigmaTy (ForAllTy tyvar ty) = True
666 isSigmaTy (FunTy a b) = isPredTy a
667 isSigmaTy (NoteTy n ty) = isSigmaTy ty
670 isOverloadedTy :: Type -> Bool
671 isOverloadedTy (ForAllTy tyvar ty) = isOverloadedTy ty
672 isOverloadedTy (FunTy a b) = isPredTy a
673 isOverloadedTy (NoteTy n ty) = isOverloadedTy ty
674 isOverloadedTy _ = False
676 isPredTy :: Type -> Bool -- Belongs in TcType because it does
677 -- not look through newtypes, or predtypes (of course)
678 isPredTy (NoteTy _ ty) = isPredTy ty
679 isPredTy (PredTy sty) = True
684 isFloatTy = is_tc floatTyConKey
685 isDoubleTy = is_tc doubleTyConKey
686 isIntegerTy = is_tc integerTyConKey
687 isIntTy = is_tc intTyConKey
688 isAddrTy = is_tc addrTyConKey
689 isBoolTy = is_tc boolTyConKey
690 isUnitTy = is_tc unitTyConKey
692 is_tc :: Unique -> Type -> Bool
693 -- Newtypes are opaque to this
694 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
695 Just (tc, _) -> uniq == getUnique tc
702 %************************************************************************
706 %************************************************************************
708 hoistForAllTys is used for user-written type signatures only
709 We want to 'look through' type synonyms when doing this
710 so it's better done on the Type than the HsType
712 It moves all the foralls and constraints to the top
713 e.g. T -> forall a. a ==> forall a. T -> a
714 T -> (?x::Int) -> Int ==> (?x::Int) -> T -> Int
716 Also: it eliminates duplicate constraints. These can show up
717 when hoisting constraints, notably implicit parameters.
719 It tries hard to retain type synonyms if hoisting does not break one
720 up. Not only does this improve error messages, but there's a tricky
721 interaction with Haskell 98. H98 requires no unsaturated type
722 synonyms, which is checked by checkValidType. This runs after
723 hoisting, so we don't want hoisting to remove the SynNotes! (We can't
724 run validity checking before hoisting because in mutually-recursive
725 type definitions we postpone validity checking until after the knot is
729 hoistForAllTys :: Type -> Type
732 -- Running over ty with an empty substitution gives it the
733 -- no-shadowing property. This is important. For example:
734 -- type Foo r = forall a. a -> r
735 -- foo :: Foo (Foo ())
736 -- Here the hoisting should give
737 -- foo :: forall a a1. a -> a1 -> ()
739 -- What about type vars that are lexically in scope in the envt?
740 -- We simply rely on them having a different unique to any
741 -- binder in 'ty'. Otherwise we'd have to slurp the in-scope-tyvars
742 -- out of the envt, which is boring and (I think) not necessary.
745 go (TyVarTy tv) = TyVarTy tv
746 go (TyConApp tc tys) = TyConApp tc (map go tys)
747 go (PredTy pred) = PredTy pred -- No nested foralls
748 go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote (go ty1)) (go ty2)
749 go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
750 go (FunTy arg res) = mk_fun_ty (go arg) (go res)
751 go (AppTy fun arg) = AppTy (go fun) (go arg)
752 go (ForAllTy tv ty) = ForAllTy tv (go ty)
754 -- mk_fun_ty does all the work.
755 -- It's building t1 -> t2:
756 -- if t2 is a for-all type, push t1 inside it
757 -- if t2 is (pred -> t3), check for duplicates
759 | not (isSigmaTy ty2) -- No forall's, or context =>
761 | PredTy p1 <- ty1 -- ty1 is a predicate
762 = if p1 `elem` theta then -- so check for duplicates
765 mkSigmaTy tvs (p1:theta) tau
767 = mkSigmaTy tvs theta (FunTy ty1 tau)
769 (tvs, theta, tau) = tcSplitSigmaTy ty2
773 %************************************************************************
777 %************************************************************************
780 deNoteType :: Type -> Type
781 -- Remove *outermost* type synonyms and other notes
782 deNoteType (NoteTy _ ty) = deNoteType ty
786 Find the free tycons and classes of a type. This is used in the front
790 tyClsNamesOfType :: Type -> NameSet
791 tyClsNamesOfType (TyVarTy tv) = emptyNameSet
792 tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
793 tyClsNamesOfType (NoteTy (SynNote ty1) ty2) = tyClsNamesOfType ty1
794 tyClsNamesOfType (NoteTy other_note ty2) = tyClsNamesOfType ty2
795 tyClsNamesOfType (PredTy (IParam n ty)) = tyClsNamesOfType ty
796 tyClsNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
797 tyClsNamesOfType (FunTy arg res) = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
798 tyClsNamesOfType (AppTy fun arg) = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
799 tyClsNamesOfType (ForAllTy tyvar ty) = tyClsNamesOfType ty
801 tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
803 tyClsNamesOfDFunHead :: Type -> NameSet
804 -- Find the free type constructors and classes
805 -- of the head of the dfun instance type
806 -- The 'dfun_head_type' is because of
807 -- instance Foo a => Baz T where ...
808 -- The decl is an orphan if Baz and T are both not locally defined,
809 -- even if Foo *is* locally defined
810 tyClsNamesOfDFunHead dfun_ty
811 = case tcSplitSigmaTy dfun_ty of
812 (tvs,_,head_ty) -> tyClsNamesOfType head_ty
814 classesOfTheta :: ThetaType -> [Class]
815 -- Looks just for ClassP things; maybe it should check
816 classesOfTheta preds = [ c | ClassP c _ <- preds ]
820 %************************************************************************
822 \subsection[TysWiredIn-ext-type]{External types}
824 %************************************************************************
826 The compiler's foreign function interface supports the passing of a
827 restricted set of types as arguments and results (the restricting factor
831 isFFITy :: Type -> Bool
832 -- True for any TyCon that can possibly be an arg or result of an FFI call
833 isFFITy ty = checkRepTyCon legalFFITyCon ty
835 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
836 -- Checks for valid argument type for a 'foreign import'
837 isFFIArgumentTy dflags safety ty
838 = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
840 isFFIExternalTy :: Type -> Bool
841 -- Types that are allowed as arguments of a 'foreign export'
842 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
844 isFFIImportResultTy :: DynFlags -> Type -> Bool
845 isFFIImportResultTy dflags ty
846 = checkRepTyCon (legalFIResultTyCon dflags) ty
848 isFFIExportResultTy :: Type -> Bool
849 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
851 isFFIDynArgumentTy :: Type -> Bool
852 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
853 -- or a newtype of either.
854 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
856 isFFIDynResultTy :: Type -> Bool
857 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
858 -- or a newtype of either.
859 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
861 isFFILabelTy :: Type -> Bool
862 -- The type of a foreign label must be Ptr, FunPtr, Addr,
863 -- or a newtype of either.
864 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
866 isFFIDotnetTy :: DynFlags -> Type -> Bool
867 isFFIDotnetTy dflags ty
868 = checkRepTyCon (\ tc -> not (isByteArrayLikeTyCon tc) &&
869 (legalFIResultTyCon dflags tc ||
870 isFFIDotnetObjTy ty || isStringTy ty)) ty
872 -- Support String as an argument or result from a .NET FFI call.
874 case tcSplitTyConApp_maybe (repType ty) of
877 case tcSplitTyConApp_maybe (repType arg_ty) of
878 Just (cc,[]) -> cc == charTyCon
882 -- Support String as an argument or result from a .NET FFI call.
883 isFFIDotnetObjTy ty =
885 (_, t_ty) = tcSplitForAllTys ty
887 case tcSplitTyConApp_maybe (repType t_ty) of
888 Just (tc, [arg_ty]) | getName tc == objectTyConName -> True
891 toDNType :: Type -> DNType
893 | isStringTy ty = DNString
894 | isFFIDotnetObjTy ty = DNObject
895 | Just (tc,argTys) <- tcSplitTyConApp_maybe ty =
896 case lookup (getUnique tc) dn_assoc of
899 | tc `hasKey` ioTyConKey -> toDNType (head argTys)
900 | otherwise -> pprPanic ("toDNType: unsupported .NET type") (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
902 dn_assoc :: [ (Unique, DNType) ]
903 dn_assoc = [ (unitTyConKey, DNUnit)
904 , (intTyConKey, DNInt)
905 , (int8TyConKey, DNInt8)
906 , (int16TyConKey, DNInt16)
907 , (int32TyConKey, DNInt32)
908 , (int64TyConKey, DNInt64)
909 , (wordTyConKey, DNInt)
910 , (word8TyConKey, DNWord8)
911 , (word16TyConKey, DNWord16)
912 , (word32TyConKey, DNWord32)
913 , (word64TyConKey, DNWord64)
914 , (floatTyConKey, DNFloat)
915 , (doubleTyConKey, DNDouble)
916 , (addrTyConKey, DNPtr)
917 , (ptrTyConKey, DNPtr)
918 , (funPtrTyConKey, DNPtr)
919 , (charTyConKey, DNChar)
920 , (boolTyConKey, DNBool)
923 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
924 -- Look through newtypes
925 -- Non-recursive ones are transparent to splitTyConApp,
926 -- but recursive ones aren't. Manuel had:
927 -- newtype T = MkT (Ptr T)
928 -- and wanted it to work...
929 checkRepTyCon check_tc ty
930 | Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
933 checkRepTyConKey :: [Unique] -> Type -> Bool
934 -- Like checkRepTyCon, but just looks at the TyCon key
935 checkRepTyConKey keys
936 = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
939 ----------------------------------------------
940 These chaps do the work; they are not exported
941 ----------------------------------------------
944 legalFEArgTyCon :: TyCon -> Bool
945 -- It's illegal to return foreign objects and (mutable)
946 -- bytearrays from a _ccall_ / foreign declaration
947 -- (or be passed them as arguments in foreign exported functions).
949 | isByteArrayLikeTyCon tc
951 -- It's also illegal to make foreign exports that take unboxed
952 -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
954 = boxedMarshalableTyCon tc
956 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
957 legalFIResultTyCon dflags tc
958 | isByteArrayLikeTyCon tc = False
959 | tc == unitTyCon = True
960 | otherwise = marshalableTyCon dflags tc
962 legalFEResultTyCon :: TyCon -> Bool
963 legalFEResultTyCon tc
964 | isByteArrayLikeTyCon tc = False
965 | tc == unitTyCon = True
966 | otherwise = boxedMarshalableTyCon tc
968 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
969 -- Checks validity of types going from Haskell -> external world
970 legalOutgoingTyCon dflags safety tc
971 | playSafe safety && isByteArrayLikeTyCon tc
974 = marshalableTyCon dflags tc
976 legalFFITyCon :: TyCon -> Bool
977 -- True for any TyCon that can possibly be an arg or result of an FFI call
979 = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
981 marshalableTyCon dflags tc
982 = (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
983 || boxedMarshalableTyCon tc
985 boxedMarshalableTyCon tc
986 = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
987 , int32TyConKey, int64TyConKey
988 , wordTyConKey, word8TyConKey, word16TyConKey
989 , word32TyConKey, word64TyConKey
990 , floatTyConKey, doubleTyConKey
991 , addrTyConKey, ptrTyConKey, funPtrTyConKey
994 , byteArrayTyConKey, mutableByteArrayTyConKey
998 isByteArrayLikeTyCon :: TyCon -> Bool
999 isByteArrayLikeTyCon tc =
1000 getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]