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(..), pprSkolemTyVar,
27 isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isExistentialTyVar, skolemTvInfo, 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 tcGetTyVar_maybe, tcGetTyVar,
43 ---------------------------------
45 -- Again, newtypes are opaque
46 tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
47 isSigmaTy, isOverloadedTy,
48 isDoubleTy, isFloatTy, isIntTy,
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,
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, tyConUnique )
160 import DataCon ( DataCon )
161 import Class ( Class )
162 import Var ( TyVar, Id, isTcTyVar, tcTyVarDetails )
163 import ForeignCall ( Safety, playSafe, DNType(..) )
167 import CmdLineOpts ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
168 import Name ( Name, NamedThing(..), mkInternalName, getSrcLoc )
170 import OccName ( OccName, mkDictOcc )
171 import PrelNames -- Lots (e.g. in isFFIArgumentTy)
172 import TysWiredIn ( unitTyCon, charTyCon, listTyCon )
173 import BasicTypes ( IPName(..), ipNameName )
174 import SrcLoc ( SrcLoc, SrcSpan )
175 import Util ( snocView )
176 import Maybes ( maybeToBool, expectJust )
182 %************************************************************************
186 %************************************************************************
188 The type checker divides the generic Type world into the
189 following more structured beasts:
191 sigma ::= forall tyvars. phi
192 -- A sigma type is a qualified type
194 -- Note that even if 'tyvars' is empty, theta
195 -- may not be: e.g. (?x::Int) => Int
197 -- Note that 'sigma' is in prenex form:
198 -- all the foralls are at the front.
199 -- A 'phi' type has no foralls to the right of
207 -- A 'tau' type has no quantification anywhere
208 -- Note that the args of a type constructor must be taus
210 | tycon tau_1 .. tau_n
214 -- In all cases, a (saturated) type synonym application is legal,
215 -- provided it expands to the required form.
218 type TcType = Type -- A TcType can have mutable type variables
219 -- Invariant on ForAllTy in TcTypes:
221 -- a cannot occur inside a MutTyVar in T; that is,
222 -- T is "flattened" before quantifying over a
224 type TcPredType = PredType
225 type TcThetaType = ThetaType
226 type TcSigmaType = TcType
227 type TcRhoType = TcType
228 type TcTauType = TcType
230 type TcTyVarSet = TyVarSet
232 type TcRef a = IORef a
233 data Expected ty = Infer (TcRef ty) -- The hole to fill in for type inference
234 | Check ty -- The type to check during type checking
238 %************************************************************************
240 \subsection{TyVarDetails}
242 %************************************************************************
244 TyVarDetails gives extra info about type variables, used during type
245 checking. It's attached to mutable type variables only.
246 It's knot-tied back to Var.lhs. There is no reason in principle
247 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
250 type TcTyVar = TyVar -- Used only during type inference
252 -- A TyVarDetails is inside a TyVar
254 = SkolemTv SkolemInfo -- A skolem constant
255 | MetaTv (IORef MetaDetails) -- A meta type variable stands for a tau-type
258 = SigSkol Name -- Bound at a type signature
259 | ClsSkol Class -- Bound at a class decl
260 | InstSkol Id -- Bound at an instance decl
261 | PatSkol DataCon -- An existential type variable bound by a pattern for
262 SrcSpan -- a data constructor with an existential type. E.g.
263 -- data T = forall a. Eq a => MkT a
265 -- The pattern MkT x will allocate an existential type
267 | ArrowSkol SrcSpan -- An arrow form (see TcArrows)
269 | GenSkol TcType -- Bound when doing a subsumption check for this type
273 = Flexi -- Flexi type variables unify to become
276 | Indirect TcType -- Type indirections, treated as wobbly
277 -- for the purpose of GADT unification.
279 pprSkolemTyVar :: TcTyVar -> SDoc
281 = ASSERT( isSkolemTyVar tv )
282 quotes (ppr tv) <+> ptext SLIT("is bound by") <+> ppr (skolemTvInfo tv)
284 instance Outputable SkolemInfo where
285 ppr (SigSkol id) = ptext SLIT("the type signature for") <+> quotes (ppr id)
286 ppr (ClsSkol cls) = ptext SLIT("the class declaration for") <+> quotes (ppr cls)
287 ppr (InstSkol df) = ptext SLIT("the instance declaration at") <+> ppr (getSrcLoc df)
288 ppr (ArrowSkol loc) = ptext SLIT("the arrow form at") <+> ppr loc
289 ppr (PatSkol dc loc) = sep [ptext SLIT("the pattern for") <+> quotes (ppr dc),
290 nest 2 (ptext SLIT("at") <+> ppr loc)]
291 ppr (GenSkol ty loc) = sep [ptext SLIT("the polymorphic type") <+> quotes (ppr ty),
292 nest 2 (ptext SLIT("at") <+> ppr loc)]
294 instance Outputable MetaDetails where
295 ppr Flexi = ptext SLIT("Flexi")
296 ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty
298 isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isMetaTyVar :: TyVar -> Bool
300 | isTcTyVar tv = isSkolemTyVar tv
304 = ASSERT( isTcTyVar tv )
305 case tcTyVarDetails tv of
309 isExistentialTyVar tv -- Existential type variable, bound by a pattern
310 = ASSERT( isTcTyVar tv )
311 case tcTyVarDetails tv of
312 SkolemTv (PatSkol _ _) -> True
316 = ASSERT( isTcTyVar tv )
317 case tcTyVarDetails tv of
321 skolemTvInfo :: TyVar -> SkolemInfo
323 = ASSERT( isTcTyVar tv )
324 case tcTyVarDetails tv of
325 SkolemTv info -> info
327 metaTvRef :: TyVar -> IORef MetaDetails
329 = ASSERT( isTcTyVar tv )
330 case tcTyVarDetails tv of
333 isFlexi, isIndirect :: MetaDetails -> Bool
335 isFlexi other = False
337 isIndirect (Indirect _) = True
338 isIndirect other = False
342 %************************************************************************
344 \subsection{Tau, sigma and rho}
346 %************************************************************************
349 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
351 mkPhiTy :: [PredType] -> Type -> Type
352 mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
355 @isTauTy@ tests for nested for-alls.
358 isTauTy :: Type -> Bool
359 isTauTy (TyVarTy v) = True
360 isTauTy (TyConApp _ tys) = all isTauTy tys
361 isTauTy (AppTy a b) = isTauTy a && isTauTy b
362 isTauTy (FunTy a b) = isTauTy a && isTauTy b
363 isTauTy (PredTy p) = True -- Don't look through source types
364 isTauTy (NoteTy _ ty) = isTauTy ty
365 isTauTy other = False
369 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
370 -- construct a dictionary function name
371 getDFunTyKey (TyVarTy tv) = getOccName tv
372 getDFunTyKey (TyConApp tc _) = getOccName tc
373 getDFunTyKey (AppTy fun _) = getDFunTyKey fun
374 getDFunTyKey (NoteTy _ t) = getDFunTyKey t
375 getDFunTyKey (FunTy arg _) = getOccName funTyCon
376 getDFunTyKey (ForAllTy _ t) = getDFunTyKey t
377 getDFunTyKey ty = pprPanic "getDFunTyKey" (pprType ty)
378 -- PredTy shouldn't happen
382 %************************************************************************
384 \subsection{Expanding and splitting}
386 %************************************************************************
388 These tcSplit functions are like their non-Tc analogues, but
389 a) they do not look through newtypes
390 b) they do not look through PredTys
391 c) [future] they ignore usage-type annotations
393 However, they are non-monadic and do not follow through mutable type
394 variables. It's up to you to make sure this doesn't matter.
397 tcSplitForAllTys :: Type -> ([TyVar], Type)
398 tcSplitForAllTys ty = split ty ty []
400 split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
401 split orig_ty (NoteTy n ty) tvs = split orig_ty ty tvs
402 split orig_ty t tvs = (reverse tvs, orig_ty)
404 tcIsForAllTy (ForAllTy tv ty) = True
405 tcIsForAllTy (NoteTy n ty) = tcIsForAllTy ty
406 tcIsForAllTy t = False
408 tcSplitPhiTy :: Type -> ([PredType], Type)
409 tcSplitPhiTy ty = split ty ty []
411 split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
412 Just p -> split res res (p:ts)
413 Nothing -> (reverse ts, orig_ty)
414 split orig_ty (NoteTy n ty) ts = split orig_ty ty ts
415 split orig_ty ty ts = (reverse ts, orig_ty)
417 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
418 (tvs, rho) -> case tcSplitPhiTy rho of
419 (theta, tau) -> (tvs, theta, tau)
421 tcTyConAppTyCon :: Type -> TyCon
422 tcTyConAppTyCon ty = fst (tcSplitTyConApp ty)
424 tcTyConAppArgs :: Type -> [Type]
425 tcTyConAppArgs ty = snd (tcSplitTyConApp ty)
427 tcSplitTyConApp :: Type -> (TyCon, [Type])
428 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
430 Nothing -> pprPanic "tcSplitTyConApp" (pprType ty)
432 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
433 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
434 tcSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
435 tcSplitTyConApp_maybe (NoteTy n ty) = tcSplitTyConApp_maybe ty
436 -- Newtypes are opaque, so they may be split
437 -- However, predicates are not treated
438 -- as tycon applications by the type checker
439 tcSplitTyConApp_maybe other = Nothing
441 tcSplitFunTys :: Type -> ([Type], Type)
442 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
444 Just (arg,res) -> (arg:args, res')
446 (args,res') = tcSplitFunTys res
448 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
449 tcSplitFunTy_maybe (FunTy arg res) = Just (arg, res)
450 tcSplitFunTy_maybe (NoteTy n ty) = tcSplitFunTy_maybe ty
451 tcSplitFunTy_maybe other = Nothing
453 tcFunArgTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
454 tcFunResultTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> res }
457 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
458 tcSplitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
459 tcSplitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
460 tcSplitAppTy_maybe (NoteTy n ty) = tcSplitAppTy_maybe ty
461 tcSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
462 Just (tys', ty') -> Just (TyConApp tc tys', ty')
464 tcSplitAppTy_maybe other = Nothing
466 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
468 Nothing -> pprPanic "tcSplitAppTy" (pprType ty)
470 tcSplitAppTys :: Type -> (Type, [Type])
474 go ty args = case tcSplitAppTy_maybe ty of
475 Just (ty', arg) -> go ty' (arg:args)
478 tcGetTyVar_maybe :: Type -> Maybe TyVar
479 tcGetTyVar_maybe (TyVarTy tv) = Just tv
480 tcGetTyVar_maybe (NoteTy _ t) = tcGetTyVar_maybe t
481 tcGetTyVar_maybe other = Nothing
483 tcGetTyVar :: String -> Type -> TyVar
484 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
486 tcIsTyVarTy :: Type -> Bool
487 tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
489 tcSplitDFunTy :: Type -> ([TyVar], [PredType], Class, [Type])
490 -- Split the type of a dictionary function
492 = case tcSplitSigmaTy ty of { (tvs, theta, tau) ->
493 case tcSplitDFunHead tau of { (clas, tys) ->
494 (tvs, theta, clas, tys) }}
496 tcSplitDFunHead :: Type -> (Class, [Type])
498 = case tcSplitPredTy_maybe tau of
499 Just (ClassP clas tys) -> (clas, tys)
504 %************************************************************************
506 \subsection{Predicate types}
508 %************************************************************************
511 tcSplitPredTy_maybe :: Type -> Maybe PredType
512 -- Returns Just for predicates only
513 tcSplitPredTy_maybe (NoteTy _ ty) = tcSplitPredTy_maybe ty
514 tcSplitPredTy_maybe (PredTy p) = Just p
515 tcSplitPredTy_maybe other = Nothing
517 predTyUnique :: PredType -> Unique
518 predTyUnique (IParam n _) = getUnique (ipNameName n)
519 predTyUnique (ClassP clas tys) = getUnique clas
521 mkPredName :: Unique -> SrcLoc -> PredType -> Name
522 mkPredName uniq loc (ClassP cls tys) = mkInternalName uniq (mkDictOcc (getOccName cls)) loc
523 mkPredName uniq loc (IParam ip ty) = mkInternalName uniq (getOccName (ipNameName ip)) loc
527 --------------------- Dictionary types ---------------------------------
530 mkClassPred clas tys = ClassP clas tys
532 isClassPred :: PredType -> Bool
533 isClassPred (ClassP clas tys) = True
534 isClassPred other = False
536 isTyVarClassPred (ClassP clas tys) = all tcIsTyVarTy tys
537 isTyVarClassPred other = False
539 getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
540 getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
541 getClassPredTys_maybe _ = Nothing
543 getClassPredTys :: PredType -> (Class, [Type])
544 getClassPredTys (ClassP clas tys) = (clas, tys)
546 mkDictTy :: Class -> [Type] -> Type
547 mkDictTy clas tys = mkPredTy (ClassP clas tys)
549 isDictTy :: Type -> Bool
550 isDictTy (PredTy p) = isClassPred p
551 isDictTy (NoteTy _ ty) = isDictTy ty
552 isDictTy other = False
555 --------------------- Implicit parameters ---------------------------------
558 isIPPred :: PredType -> Bool
559 isIPPred (IParam _ _) = True
560 isIPPred other = False
562 isInheritablePred :: PredType -> Bool
563 -- Can be inherited by a context. For example, consider
564 -- f x = let g y = (?v, y+x)
565 -- in (g 3 with ?v = 8,
567 -- The point is that g's type must be quantifed over ?v:
568 -- g :: (?v :: a) => a -> a
569 -- but it doesn't need to be quantified over the Num a dictionary
570 -- which can be free in g's rhs, and shared by both calls to g
571 isInheritablePred (ClassP _ _) = True
572 isInheritablePred other = False
574 isLinearPred :: TcPredType -> Bool
575 isLinearPred (IParam (Linear n) _) = True
576 isLinearPred other = False
580 %************************************************************************
582 \subsection{Predicates}
584 %************************************************************************
586 isSigmaTy returns true of any qualified type. It doesn't *necessarily* have
588 f :: (?x::Int) => Int -> Int
591 isSigmaTy :: Type -> Bool
592 isSigmaTy (ForAllTy tyvar ty) = True
593 isSigmaTy (FunTy a b) = isPredTy a
594 isSigmaTy (NoteTy n ty) = isSigmaTy ty
597 isOverloadedTy :: Type -> Bool
598 isOverloadedTy (ForAllTy tyvar ty) = isOverloadedTy ty
599 isOverloadedTy (FunTy a b) = isPredTy a
600 isOverloadedTy (NoteTy n ty) = isOverloadedTy ty
601 isOverloadedTy _ = False
603 isPredTy :: Type -> Bool -- Belongs in TcType because it does
604 -- not look through newtypes, or predtypes (of course)
605 isPredTy (NoteTy _ ty) = isPredTy ty
606 isPredTy (PredTy sty) = True
611 isFloatTy = is_tc floatTyConKey
612 isDoubleTy = is_tc doubleTyConKey
613 isIntegerTy = is_tc integerTyConKey
614 isIntTy = is_tc intTyConKey
615 isAddrTy = is_tc addrTyConKey
616 isBoolTy = is_tc boolTyConKey
617 isUnitTy = is_tc unitTyConKey
619 is_tc :: Unique -> Type -> Bool
620 -- Newtypes are opaque to this
621 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
622 Just (tc, _) -> uniq == getUnique tc
629 %************************************************************************
633 %************************************************************************
635 hoistForAllTys is used for user-written type signatures only
636 We want to 'look through' type synonyms when doing this
637 so it's better done on the Type than the HsType
639 It moves all the foralls and constraints to the top
640 e.g. T -> forall a. a ==> forall a. T -> a
641 T -> (?x::Int) -> Int ==> (?x::Int) -> T -> Int
643 Also: it eliminates duplicate constraints. These can show up
644 when hoisting constraints, notably implicit parameters.
646 It tries hard to retain type synonyms if hoisting does not break one
647 up. Not only does this improve error messages, but there's a tricky
648 interaction with Haskell 98. H98 requires no unsaturated type
649 synonyms, which is checked by checkValidType. This runs after
650 hoisting, so we don't want hoisting to remove the SynNotes! (We can't
651 run validity checking before hoisting because in mutually-recursive
652 type definitions we postpone validity checking until after the knot is
656 hoistForAllTys :: Type -> Type
659 -- Running over ty with an empty substitution gives it the
660 -- no-shadowing property. This is important. For example:
661 -- type Foo r = forall a. a -> r
662 -- foo :: Foo (Foo ())
663 -- Here the hoisting should give
664 -- foo :: forall a a1. a -> a1 -> ()
666 -- What about type vars that are lexically in scope in the envt?
667 -- We simply rely on them having a different unique to any
668 -- binder in 'ty'. Otherwise we'd have to slurp the in-scope-tyvars
669 -- out of the envt, which is boring and (I think) not necessary.
672 go (TyVarTy tv) = TyVarTy tv
673 go (TyConApp tc tys) = TyConApp tc (map go tys)
674 go (PredTy pred) = PredTy pred -- No nested foralls
675 go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote (go ty1)) (go ty2)
676 go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
677 go (FunTy arg res) = mk_fun_ty (go arg) (go res)
678 go (AppTy fun arg) = AppTy (go fun) (go arg)
679 go (ForAllTy tv ty) = ForAllTy tv (go ty)
681 -- mk_fun_ty does all the work.
682 -- It's building t1 -> t2:
683 -- if t2 is a for-all type, push t1 inside it
684 -- if t2 is (pred -> t3), check for duplicates
686 | not (isSigmaTy ty2) -- No forall's, or context =>
688 | PredTy p1 <- ty1 -- ty1 is a predicate
689 = if p1 `elem` theta then -- so check for duplicates
692 mkSigmaTy tvs (p1:theta) tau
694 = mkSigmaTy tvs theta (FunTy ty1 tau)
696 (tvs, theta, tau) = tcSplitSigmaTy ty2
700 %************************************************************************
704 %************************************************************************
707 deNoteType :: Type -> Type
708 -- Remove synonyms, but not predicate types
709 deNoteType ty@(TyVarTy tyvar) = ty
710 deNoteType (TyConApp tycon tys) = TyConApp tycon (map deNoteType tys)
711 deNoteType (PredTy p) = PredTy (deNotePredType p)
712 deNoteType (NoteTy _ ty) = deNoteType ty
713 deNoteType (AppTy fun arg) = AppTy (deNoteType fun) (deNoteType arg)
714 deNoteType (FunTy fun arg) = FunTy (deNoteType fun) (deNoteType arg)
715 deNoteType (ForAllTy tv ty) = ForAllTy tv (deNoteType ty)
717 deNotePredType :: PredType -> PredType
718 deNotePredType (ClassP c tys) = ClassP c (map deNoteType tys)
719 deNotePredType (IParam n ty) = IParam n (deNoteType ty)
722 Find the free tycons and classes of a type. This is used in the front
726 tyClsNamesOfType :: Type -> NameSet
727 tyClsNamesOfType (TyVarTy tv) = emptyNameSet
728 tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
729 tyClsNamesOfType (NoteTy (SynNote ty1) ty2) = tyClsNamesOfType ty1
730 tyClsNamesOfType (NoteTy other_note ty2) = tyClsNamesOfType ty2
731 tyClsNamesOfType (PredTy (IParam n ty)) = tyClsNamesOfType ty
732 tyClsNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
733 tyClsNamesOfType (FunTy arg res) = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
734 tyClsNamesOfType (AppTy fun arg) = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
735 tyClsNamesOfType (ForAllTy tyvar ty) = tyClsNamesOfType ty
737 tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
739 tyClsNamesOfDFunHead :: Type -> NameSet
740 -- Find the free type constructors and classes
741 -- of the head of the dfun instance type
742 -- The 'dfun_head_type' is because of
743 -- instance Foo a => Baz T where ...
744 -- The decl is an orphan if Baz and T are both not locally defined,
745 -- even if Foo *is* locally defined
746 tyClsNamesOfDFunHead dfun_ty
747 = case tcSplitSigmaTy dfun_ty of
748 (tvs,_,head_ty) -> tyClsNamesOfType head_ty
750 classesOfTheta :: ThetaType -> [Class]
751 -- Looks just for ClassP things; maybe it should check
752 classesOfTheta preds = [ c | ClassP c _ <- preds ]
756 %************************************************************************
758 \subsection[TysWiredIn-ext-type]{External types}
760 %************************************************************************
762 The compiler's foreign function interface supports the passing of a
763 restricted set of types as arguments and results (the restricting factor
767 isFFITy :: Type -> Bool
768 -- True for any TyCon that can possibly be an arg or result of an FFI call
769 isFFITy ty = checkRepTyCon legalFFITyCon ty
771 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
772 -- Checks for valid argument type for a 'foreign import'
773 isFFIArgumentTy dflags safety ty
774 = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
776 isFFIExternalTy :: Type -> Bool
777 -- Types that are allowed as arguments of a 'foreign export'
778 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
780 isFFIImportResultTy :: DynFlags -> Type -> Bool
781 isFFIImportResultTy dflags ty
782 = checkRepTyCon (legalFIResultTyCon dflags) ty
784 isFFIExportResultTy :: Type -> Bool
785 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
787 isFFIDynArgumentTy :: Type -> Bool
788 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
789 -- or a newtype of either.
790 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
792 isFFIDynResultTy :: Type -> Bool
793 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
794 -- or a newtype of either.
795 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
797 isFFILabelTy :: Type -> Bool
798 -- The type of a foreign label must be Ptr, FunPtr, Addr,
799 -- or a newtype of either.
800 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
802 isFFIDotnetTy :: DynFlags -> Type -> Bool
803 isFFIDotnetTy dflags ty
804 = checkRepTyCon (\ tc -> not (isByteArrayLikeTyCon tc) &&
805 (legalFIResultTyCon dflags tc ||
806 isFFIDotnetObjTy ty || isStringTy ty)) ty
808 -- Support String as an argument or result from a .NET FFI call.
810 case tcSplitTyConApp_maybe (repType ty) of
813 case tcSplitTyConApp_maybe (repType arg_ty) of
814 Just (cc,[]) -> cc == charTyCon
818 -- Support String as an argument or result from a .NET FFI call.
819 isFFIDotnetObjTy ty =
821 (_, t_ty) = tcSplitForAllTys ty
823 case tcSplitTyConApp_maybe (repType t_ty) of
824 Just (tc, [arg_ty]) | getName tc == objectTyConName -> True
827 toDNType :: Type -> DNType
829 | isStringTy ty = DNString
830 | isFFIDotnetObjTy ty = DNObject
831 | Just (tc,argTys) <- tcSplitTyConApp_maybe ty =
832 case lookup (getUnique tc) dn_assoc of
835 | tc `hasKey` ioTyConKey -> toDNType (head argTys)
836 | otherwise -> pprPanic ("toDNType: unsupported .NET type") (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
838 dn_assoc :: [ (Unique, DNType) ]
839 dn_assoc = [ (unitTyConKey, DNUnit)
840 , (intTyConKey, DNInt)
841 , (int8TyConKey, DNInt8)
842 , (int16TyConKey, DNInt16)
843 , (int32TyConKey, DNInt32)
844 , (int64TyConKey, DNInt64)
845 , (wordTyConKey, DNInt)
846 , (word8TyConKey, DNWord8)
847 , (word16TyConKey, DNWord16)
848 , (word32TyConKey, DNWord32)
849 , (word64TyConKey, DNWord64)
850 , (floatTyConKey, DNFloat)
851 , (doubleTyConKey, DNDouble)
852 , (addrTyConKey, DNPtr)
853 , (ptrTyConKey, DNPtr)
854 , (funPtrTyConKey, DNPtr)
855 , (charTyConKey, DNChar)
856 , (boolTyConKey, DNBool)
859 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
860 -- Look through newtypes
861 -- Non-recursive ones are transparent to splitTyConApp,
862 -- but recursive ones aren't. Manuel had:
863 -- newtype T = MkT (Ptr T)
864 -- and wanted it to work...
865 checkRepTyCon check_tc ty
866 | Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
869 checkRepTyConKey :: [Unique] -> Type -> Bool
870 -- Like checkRepTyCon, but just looks at the TyCon key
871 checkRepTyConKey keys
872 = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
875 ----------------------------------------------
876 These chaps do the work; they are not exported
877 ----------------------------------------------
880 legalFEArgTyCon :: TyCon -> Bool
881 -- It's illegal to return foreign objects and (mutable)
882 -- bytearrays from a _ccall_ / foreign declaration
883 -- (or be passed them as arguments in foreign exported functions).
885 | isByteArrayLikeTyCon tc
887 -- It's also illegal to make foreign exports that take unboxed
888 -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
890 = boxedMarshalableTyCon tc
892 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
893 legalFIResultTyCon dflags tc
894 | isByteArrayLikeTyCon tc = False
895 | tc == unitTyCon = True
896 | otherwise = marshalableTyCon dflags tc
898 legalFEResultTyCon :: TyCon -> Bool
899 legalFEResultTyCon tc
900 | isByteArrayLikeTyCon tc = False
901 | tc == unitTyCon = True
902 | otherwise = boxedMarshalableTyCon tc
904 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
905 -- Checks validity of types going from Haskell -> external world
906 legalOutgoingTyCon dflags safety tc
907 | playSafe safety && isByteArrayLikeTyCon tc
910 = marshalableTyCon dflags tc
912 legalFFITyCon :: TyCon -> Bool
913 -- True for any TyCon that can possibly be an arg or result of an FFI call
915 = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
917 marshalableTyCon dflags tc
918 = (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
919 || boxedMarshalableTyCon tc
921 boxedMarshalableTyCon tc
922 = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
923 , int32TyConKey, int64TyConKey
924 , wordTyConKey, word8TyConKey, word16TyConKey
925 , word32TyConKey, word64TyConKey
926 , floatTyConKey, doubleTyConKey
927 , addrTyConKey, ptrTyConKey, funPtrTyConKey
930 , byteArrayTyConKey, mutableByteArrayTyConKey
934 isByteArrayLikeTyCon :: TyCon -> Bool
935 isByteArrayLikeTyCon tc =
936 getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]