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,
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,
+ defaultKind, isArgTypeKind, isOpenTypeKind,
mkFunTy, mkFunTys, zipFunTys,
mkTyConApp, mkGenTyConApp, mkAppTy,
mkAppTys, mkSynTy, applyTy, applyTys,
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
| 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
+isSkolemTyVar tv = case tcTyVarDetails tv of
SigTv -> True
ClsTv -> True
InstTv -> True
oteher -> False
-tyVarBindingInfo :: TyVar -> SDoc -- Used in checkSigTyVars
+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 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
projects / ghc-hetmet.git / blobdiff