--------------------------------
-- TyVarDetails
- TyVarDetails(..), isUserTyVar, isSkolemTyVar,
+ TyVarDetails(..), isUserTyVar, isSkolemTyVar, isExistentialTyVar,
tyVarBindingInfo,
--------------------------------
isFFILabelTy, -- :: Type -> Bool
isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
isFFIDotnetObjTy, -- :: Type -> Bool
+ isFFITy, -- :: Type -> Bool
toDNType, -- :: Type -> DNType
-- Rexported from Type
Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
- superBoxity, liftedBoxity, hasMoreBoxityInfo, defaultKind, superKind,
- isTypeKind, isAnyTypeKind, typeCon,
+ isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
+ isArgTypeKind, isSubKind, defaultKind,
Type, PredType(..), ThetaType,
mkForAllTy, mkForAllTys,
tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
- typeKind, eqKind,
+ typeKind,
- tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta
- ) where
+ tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-#include "HsVersions.h"
+ pprKind, pprParendKind,
+ pprType, pprParendType,
+ pprPred, pprTheta, pprThetaArrow, pprClassPred
+ ) where
-import {-# SOURCE #-} PprType( pprType )
--- PprType imports TcType so that it can print intelligently
+#include "HsVersions.h"
-- friends:
import TypeRep ( Type(..), TyNote(..), funTyCon ) -- friend
import Type ( -- Re-exports
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
tyVarsOfTheta, Kind, Type, PredType(..),
- ThetaType, unliftedTypeKind, typeCon,
+ ThetaType, unliftedTypeKind,
liftedTypeKind, openTypeKind, mkArrowKind,
+ isLiftedTypeKind, isUnliftedTypeKind,
+ isOpenTypeKind,
mkArrowKinds, mkForAllTy, mkForAllTys,
- defaultKind, isTypeKind, isAnyTypeKind,
- mkFunTy, mkFunTys, zipFunTys, isTyVarTy,
+ defaultKind, isArgTypeKind, isOpenTypeKind,
+ mkFunTy, mkFunTys, zipFunTys,
mkTyConApp, mkGenTyConApp, mkAppTy,
mkAppTys, mkSynTy, applyTy, applyTys,
mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
tidyTopType, tidyType, tidyPred, tidyTypes,
tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
tidyTyVarBndr, tidyOpenTyVar,
- tidyOpenTyVars, eqKind,
- hasMoreBoxityInfo, liftedBoxity,
- superBoxity, typeKind, superKind, repType
+ tidyOpenTyVars,
+ isSubKind,
+ typeKind, repType,
+ pprKind, pprParendKind,
+ pprType, pprParendType,
+ pprPred, pprTheta, pprThetaArrow, pprClassPred
)
import TyCon ( TyCon, isUnLiftedTyCon, tyConUnique )
import Class ( Class )
-import Var ( TyVar, tyVarKind, isMutTyVar, mutTyVarDetails )
-import ForeignCall ( Safety, playSafe
- , DNType(..)
- )
+import Var ( TyVar, tyVarKind, tcTyVarDetails )
+import ForeignCall ( Safety, playSafe, DNType(..) )
import VarEnv
import VarSet
-- provided it expands to the required form.
\begin{code}
-type TcTyVar = TyVar -- Might be a mutable tyvar
-type TcTyVarSet = TyVarSet
-
type TcType = Type -- A TcType can have mutable type variables
-- Invariant on ForAllTy in TcTypes:
-- forall a. T
type TcSigmaType = TcType
type TcRhoType = TcType
type TcTauType = TcType
-type TcKind = TcType
+
+type TcKind = Kind
\end{code}
why Var.lhs shouldn't actually have the definition, but it "belongs" here.
\begin{code}
+type TcTyVar = TyVar -- Used only during type inference
+
data TyVarDetails
= SigTv -- Introduced when instantiating a type signature,
-- prior to checking that the defn of a fn does
-- have the expected type. Should not be instantiated.
- --
-- f :: forall a. a -> a
-- f = e
-- When checking e, with expected type (a->a), we
| InstTv -- Ditto, but instance decl
| PatSigTv -- Scoped type variable, introduced by a pattern
- -- type signature
- -- \ x::a -> e
+ -- type signature \ x::a -> e
+
+ | ExistTv -- An existential type variable bound by a pattern for
+ -- a data constructor with an existential type. E.g.
+ -- data T = forall a. Eq a => MkT a
+ -- f (MkT x) = ...
+ -- The pattern MkT x will allocate an existential type
+ -- variable for 'a'. We distinguish these from all others
+ -- on one place, namely InstEnv.lookupInstEnv.
| VanillaTv -- Everything else
isUserTyVar :: TcTyVar -> Bool -- Avoid unifying these if possible
-isUserTyVar tv = case mutTyVarDetails tv of
+isUserTyVar tv = case tcTyVarDetails tv of
VanillaTv -> False
other -> True
isSkolemTyVar :: TcTyVar -> Bool
-isSkolemTyVar tv = case mutTyVarDetails tv of
- SigTv -> True
- ClsTv -> True
- InstTv -> True
- oteher -> False
-
-tyVarBindingInfo :: TyVar -> SDoc -- Used in checkSigTyVars
+isSkolemTyVar tv = case tcTyVarDetails tv of
+ SigTv -> True
+ ClsTv -> True
+ InstTv -> True
+ ExistTv -> True
+ other -> False
+
+isExistentialTyVar :: TcTyVar -> Bool
+isExistentialTyVar tv = case tcTyVarDetails tv of
+ ExistTv -> True
+ other -> False
+
+tyVarBindingInfo :: TcTyVar -> SDoc -- Used in checkSigTyVars
tyVarBindingInfo tv
- | isMutTyVar tv
- = sep [ptext SLIT("is bound by the") <+> details (mutTyVarDetails tv),
+ = sep [ptext SLIT("is bound by the") <+> details (tcTyVarDetails tv),
ptext SLIT("at") <+> ppr (getSrcLoc tv)]
- | otherwise
- = empty
where
details SigTv = ptext SLIT("type signature")
details ClsTv = ptext SLIT("class declaration")
details InstTv = ptext SLIT("instance declaration")
details PatSigTv = ptext SLIT("pattern type signature")
+ details ExistTv = ptext SLIT("existential constructor")
details VanillaTv = ptext SLIT("//vanilla//") -- Ditto
\end{code}
+\begin{code}
+type TcTyVarSet = TyVarSet
+\end{code}
%************************************************************************
%* *
being the )
\begin{code}
+isFFITy :: Type -> Bool
+-- True for any TyCon that can possibly be an arg or result of an FFI call
+isFFITy ty = checkRepTyCon legalFFITyCon ty
+
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
-- Checks for valid argument type for a 'foreign import'
isFFIArgumentTy dflags safety ty
checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
-- Look through newtypes
-- Non-recursive ones are transparent to splitTyConApp,
- -- but recursive ones aren't
+ -- but recursive ones aren't. Manuel had:
+ -- newtype T = MkT (Ptr T)
+ -- and wanted it to work...
checkRepTyCon check_tc ty
| Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
| otherwise = False
| otherwise
= marshalableTyCon dflags tc
+legalFFITyCon :: TyCon -> Bool
+-- True for any TyCon that can possibly be an arg or result of an FFI call
+legalFFITyCon tc
+ = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
+
marshalableTyCon dflags tc
= (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
|| boxedMarshalableTyCon tc
uTysX ty1 ty2 k subst
Nothing -- Not already bound
- | typeKind ty2 `eqKind` tyVarKind tv1
+ | typeKind ty2 == tyVarKind tv1
&& occur_check_ok ty2
-> -- No kind mismatch nor occur check
k (tmpls, extendSubstEnv env tv1 (DoneTy ty2))
| v `elemVarSet` tmpls
= -- v is a template variable
case lookupSubstEnv senv v of
- Nothing | typeKind ty `eqKind` tyVarKind v
+ Nothing | typeKind ty `isSubKind` tyVarKind v
-- We do a kind check, just as in the uVarX above
-- The kind check is needed to avoid bogus matches
-- of (a b) with (c d), where the kinds don't match
match (FunTy arg1 res1) (FunTy arg2 res2) tmpls k senv
= match arg1 arg2 tmpls (match res1 res2 tmpls k) senv
+ -- If the template is an application, try to make the
+ -- thing we are matching look like an application
match (AppTy fun1 arg1) ty2 tmpls k senv
= case tcSplitAppTy_maybe ty2 of
Just (fun2,arg2) -> match fun1 fun2 tmpls (match arg1 arg2 tmpls k) senv
Nothing -> Nothing -- Fail
--- Newtypes are opaque; predicate types should not happen
+ -- Newtypes are opaque; predicate types should not happen
match (NewTcApp tc1 tys1) (NewTcApp tc2 tys2) tmpls k senv
| tc1 == tc2 = match_list_exactly tys1 tys2 tmpls k senv
match (TyConApp tc1 tys1) (TyConApp tc2 tys2) tmpls k senv