isFFIExternalTy, -- :: Type -> Bool
isFFIDynArgumentTy, -- :: Type -> Bool
isFFIDynResultTy, -- :: Type -> Bool
+ isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
+ isFFIPrimResultTy, -- :: DynFlags -> Type -> Bool
isFFILabelTy, -- :: Type -> Bool
isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
isFFIDotnetObjTy, -- :: Type -> Bool
isFFITy, -- :: Type -> Bool
isFunPtrTy, -- :: Type -> Bool
tcSplitIOType_maybe, -- :: Type -> Maybe Type
- toDNType, -- :: Type -> DNType
--------------------------------
-- Rexported from Type
typeKind, tidyKind,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
- tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
+ tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred, exactTyVarsOfType,
+ exactTyVarsOfTypes,
pprKind, pprParendKind,
pprType, pprParendType, pprTypeApp, pprTyThingCategory,
import Name
import NameSet
import VarEnv
-import OccName
import PrelNames
import TysWiredIn
import BasicTypes
import Outputable
import FastString
-import Data.List
import Data.IORef
\end{code}
| ForSigCtxt Name -- Foreign inport or export signature
| DefaultDeclCtxt -- Types in a default declaration
| SpecInstCtxt -- SPECIALISE instance pragma
+ | ThBrackCtxt -- Template Haskell type brackets [t| ... |]
-- Notes re TySynCtxt
-- We allow type synonyms that aren't types; e.g. type List = []
pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
pprUserTypeCtxt GenPatCtxt = ptext (sLit "the type pattern of a generic definition")
+pprUserTypeCtxt ThBrackCtxt = ptext (sLit "a Template Haskell quotation [t|...|]")
pprUserTypeCtxt LamPatSigCtxt = ptext (sLit "a pattern type signature")
pprUserTypeCtxt BindPatSigCtxt = ptext (sLit "a pattern type signature")
pprUserTypeCtxt ResSigCtxt = ptext (sLit "a result type signature")
These tcSplit functions are like their non-Tc analogues, but
a) they do not look through newtypes
b) they do not look through PredTys
- c) [future] they ignore usage-type annotations
However, they are non-monadic and do not follow through mutable type
variables. It's up to you to make sure this doesn't matter.
tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
-----------------------
-tcSplitDFunTy :: Type -> ([TyVar], [PredType], Class, [Type])
+tcSplitDFunTy :: Type -> ([TyVar], Class, [Type])
-- Split the type of a dictionary function
+-- We don't use tcSplitSigmaTy, because a DFun may (with NDP)
+-- have non-Pred arguments, such as
+-- df :: forall m. (forall b. Eq b => Eq (m b)) -> C m
tcSplitDFunTy ty
- = case tcSplitSigmaTy ty of { (tvs, theta, tau) ->
- case tcSplitDFunHead tau of { (clas, tys) ->
- (tvs, theta, clas, tys) }}
+ = case tcSplitForAllTys ty of { (tvs, rho) ->
+ case tcSplitDFunHead (drop_pred_tys rho) of { (clas, tys) ->
+ (tvs, clas, tys) }}
+ where
+ -- Discard the context of the dfun. This can be a mix of
+ -- coercion and class constraints; or (in the general NDP case)
+ -- some other function argument
+ drop_pred_tys ty | Just ty' <- tcView ty = drop_pred_tys ty'
+ drop_pred_tys (ForAllTy tv ty) = ASSERT( isCoVar tv ) drop_pred_tys ty
+ drop_pred_tys (FunTy _ ty) = drop_pred_tys ty
+ drop_pred_tys ty = ty
tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead tau
= case tcSplitPredTy_maybe tau of
Just (ClassP clas tys) -> (clas, tys)
- _ -> panic "tcSplitDFunHead"
+ _ -> pprPanic "tcSplitDFunHead" (ppr tau)
tcInstHeadTyNotSynonym :: Type -> Bool
-- Used in Haskell-98 mode, for the argument types of an instance head
-- or a newtype of either.
isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
+isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
+-- Checks for valid argument type for a 'foreign import prim'
+-- Currently they must all be simple unlifted types.
+isFFIPrimArgumentTy dflags ty
+ = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
+
+isFFIPrimResultTy :: DynFlags -> Type -> Bool
+-- Checks for valid result type for a 'foreign import prim'
+-- Currently it must be an unlifted type, including unboxed tuples.
+isFFIPrimResultTy dflags ty
+ = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
+
isFFIDotnetTy :: DynFlags -> Type -> Bool
isFFIDotnetTy dflags ty
= checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
isFunPtrTy :: Type -> Bool
isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
-toDNType :: Type -> DNType
-toDNType ty
- | isStringTy ty = DNString
- | isFFIDotnetObjTy ty = DNObject
- | Just (tc,argTys) <- tcSplitTyConApp_maybe ty
- = case lookup (getUnique tc) dn_assoc of
- Just x -> x
- Nothing
- | tc `hasKey` ioTyConKey -> toDNType (head argTys)
- | otherwise -> pprPanic ("toDNType: unsupported .NET type")
- (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
- | otherwise = panic "toDNType" -- Is this right?
- where
- dn_assoc :: [ (Unique, DNType) ]
- dn_assoc = [ (unitTyConKey, DNUnit)
- , (intTyConKey, DNInt)
- , (int8TyConKey, DNInt8)
- , (int16TyConKey, DNInt16)
- , (int32TyConKey, DNInt32)
- , (int64TyConKey, DNInt64)
- , (wordTyConKey, DNInt)
- , (word8TyConKey, DNWord8)
- , (word16TyConKey, DNWord16)
- , (word32TyConKey, DNWord32)
- , (word64TyConKey, DNWord64)
- , (floatTyConKey, DNFloat)
- , (doubleTyConKey, DNDouble)
- , (ptrTyConKey, DNPtr)
- , (funPtrTyConKey, DNPtr)
- , (charTyConKey, DNChar)
- , (boolTyConKey, DNBool)
- ]
-
checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
-- Look through newtypes, but *not* foralls
-- Should work even for recursive newtypes
, stablePtrTyConKey
, boolTyConKey
]
+
+legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
+-- Check args of 'foreign import prim', only allow simple unlifted types.
+-- Strictly speaking it is unnecessary to ban unboxed tuples here since
+-- currently they're of the wrong kind to use in function args anyway.
+legalFIPrimArgTyCon dflags tc
+ = dopt Opt_UnliftedFFITypes dflags
+ && isUnLiftedTyCon tc
+ && not (isUnboxedTupleTyCon tc)
+
+legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
+-- Check result type of 'foreign import prim'. Allow simple unlifted
+-- types and also unboxed tuple result types '... -> (# , , #)'
+legalFIPrimResultTyCon dflags tc
+ = dopt Opt_UnliftedFFITypes dflags
+ && isUnLiftedTyCon tc
+ && (isUnboxedTupleTyCon tc
+ || case tyConPrimRep tc of -- Note [Marshalling VoidRep]
+ VoidRep -> False
+ _ -> True)
\end{code}
Note [Marshalling VoidRep]