then
Unify, PprType (PprEnv)
then
- Literal (TysPrim, PprType), DataCon (PprType)
+ Literal (TysPrim, PprType), DataCon (loop PprType)
then
TysWiredIn (DataCon.mkDataCon, loop MkId.mkDataConId, loop Generics.mkGenInfo)
then
+ TcType( lots of TywWiredIn stuff)
+then
+ PprType( lots of TcType stuff )
+then
PrimOp (PprType, TysWiredIn)
then
CoreSyn
#include "HsVersions.h"
import {-# SOURCE #-} Subst( substTyWith )
+import {-# SOURCE #-} PprType( pprType )
import CmdLineOpts ( opt_DictsStrict )
import Type ( Type, TauType, ThetaType,
mkForAllTys, mkFunTys, mkTyConApp,
- mkTyVarTys, splitTyConApp_maybe, repType
+ mkTyVarTys, splitTyConApp_maybe, repType,
+ mkPredTys, isStrictType
)
-import TcType ( isStrictPred, mkPredTys )
import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isProductTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
import Class ( Class, classTyCon )
import Outputable
import Unique ( Unique, Uniquable(..) )
import CmdLineOpts ( opt_UnboxStrictFields )
-import PprType () -- Instances
import Maybe
import ListSetOps ( assoc )
import Util ( zipEqual, zipWithEqual )
-- Strictness marks for source-args
-- *after unboxing choices*,
-- but *including existential dictionaries*
- real_stricts = (map mk_dict_strict_mark ex_theta) ++
+ ex_dict_tys = mkPredTys ex_theta
+ real_stricts = (map mk_dict_strict_mark ex_dict_tys) ++
zipWithEqual "mkDataCon1" (chooseBoxingStrategy tycon)
orig_arg_tys arg_stricts
= unzip $ concat $
zipWithEqual "mkDataCon2" unbox_strict_arg_ty
real_stricts
- (mkPredTys ex_theta ++ orig_arg_tys)
+ (ex_dict_tys ++ orig_arg_tys)
tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
ty = mkForAllTys (tyvars ++ ex_tyvars)
result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
-mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
- | otherwise = NotMarkedStrict
+mk_dict_strict_mark ty | isStrictType ty = MarkedStrict
+ | otherwise = NotMarkedStrict
\end{code}
\begin{code}
splitProductType str ty
= case splitProductType_maybe ty of
Just stuff -> stuff
- Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
+ Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
-- We attempt to unbox/unpack a strict field when either:
-- (i) The tycon is imported, and the field is marked '! !', or
= getSrcLocDs `thenDs` \ l ->
pprPanic "unboxArg: " (ppr l <+> ppr arg_ty)
where
- arg_ty = repType (exprType arg)
+ arg_ty = repType (exprType arg)
-- The repType looks through any newtype or
-- implicit-parameter wrappings on the argument;
-- this is necessary, because isBoolTy (in particular) does not.
voidTy,
wordDataCon,
wordTy,
- wordTyCon,
-
- isFFIArgumentTy, -- :: DynFlags -> Safety -> Type -> Bool
- isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
- isFFIExportResultTy, -- :: Type -> Bool
- isFFIExternalTy, -- :: Type -> Bool
- isFFIDynArgumentTy, -- :: Type -> Bool
- isFFIDynResultTy, -- :: Type -> Bool
- isFFILabelTy, -- :: Type -> Bool
+ wordTyCon
) where
#include "HsVersions.h"
import TysPrim
-- others:
-import ForeignCall ( Safety, playSafe )
import Constants ( mAX_TUPLE_SIZE )
import Module ( mkPrelModule )
import Name ( Name, nameRdrName, nameUnique, nameOccName,
%************************************************************************
%* *
-\subsection[TysWiredIn-ext-type]{External types}
-%* *
-%************************************************************************
-
-The compiler's foreign function interface supports the passing of a
-restricted set of types as arguments and results (the restricting factor
-being the )
-
-\begin{code}
-isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
--- Checks for valid argument type for a 'foreign import'
-isFFIArgumentTy dflags safety ty
- = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
-
-isFFIExternalTy :: Type -> Bool
--- Types that are allowed as arguments of a 'foreign export'
-isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
-
-isFFIImportResultTy :: DynFlags -> Type -> Bool
-isFFIImportResultTy dflags ty
- = checkRepTyCon (legalFIResultTyCon dflags) ty
-
-isFFIExportResultTy :: Type -> Bool
-isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
-
-isFFIDynArgumentTy :: Type -> Bool
--- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFIDynArgumentTy = checkRepTyCon (\tc -> tc == ptrTyCon || tc == funPtrTyCon || tc == addrTyCon)
-
-isFFIDynResultTy :: Type -> Bool
--- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFIDynResultTy = checkRepTyCon (\tc -> tc == ptrTyCon || tc == funPtrTyCon || tc == addrTyCon)
-
-isFFILabelTy :: Type -> Bool
--- The type of a foreign label must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFILabelTy = checkRepTyCon (\tc -> tc == ptrTyCon || tc == funPtrTyCon || tc == addrTyCon)
-
-checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
- -- Look through newtypes
-checkRepTyCon check_tc ty = case splitTyConApp_maybe ty of
- Just (tycon, _) -> check_tc tycon
- Nothing -> False
-\end{code}
-
-----------------------------------------------
-These chaps do the work; they are not exported
-----------------------------------------------
-
-\begin{code}
-legalFEArgTyCon :: TyCon -> Bool
--- It's illegal to return foreign objects and (mutable)
--- bytearrays from a _ccall_ / foreign declaration
--- (or be passed them as arguments in foreign exported functions).
-legalFEArgTyCon tc
- | getUnique tc `elem` [ foreignObjTyConKey, foreignPtrTyConKey,
- byteArrayTyConKey, mutableByteArrayTyConKey ]
- = False
- -- It's also illegal to make foreign exports that take unboxed
- -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
- | otherwise
- = boxedMarshalableTyCon tc
-
-legalFIResultTyCon :: DynFlags -> TyCon -> Bool
-legalFIResultTyCon dflags tc
- | getUnique tc `elem`
- [ foreignObjTyConKey, foreignPtrTyConKey,
- byteArrayTyConKey, mutableByteArrayTyConKey ] = False
- | tc == unitTyCon = True
- | otherwise = marshalableTyCon dflags tc
-
-legalFEResultTyCon :: TyCon -> Bool
-legalFEResultTyCon tc
- | getUnique tc `elem`
- [ foreignObjTyConKey, foreignPtrTyConKey,
- byteArrayTyConKey, mutableByteArrayTyConKey ] = False
- | tc == unitTyCon = True
- | otherwise = boxedMarshalableTyCon tc
-
-legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
--- Checks validity of types going from Haskell -> external world
-legalOutgoingTyCon dflags safety tc
- | playSafe safety && getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]
- = False
- | otherwise
- = marshalableTyCon dflags tc
-
-marshalableTyCon dflags tc
- = (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
- || boxedMarshalableTyCon tc
-
-boxedMarshalableTyCon tc
- = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
- , int32TyConKey, int64TyConKey
- , wordTyConKey, word8TyConKey, word16TyConKey
- , word32TyConKey, word64TyConKey
- , floatTyConKey, doubleTyConKey
- , addrTyConKey, ptrTyConKey, funPtrTyConKey
- , charTyConKey, foreignObjTyConKey
- , foreignPtrTyConKey
- , stablePtrTyConKey
- , byteArrayTyConKey, mutableByteArrayTyConKey
- , boolTyConKey
- ]
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection[TysWiredIn-Bool]{The @Bool@ type}
%* *
%************************************************************************
import SimplMonad
import Type ( Type, mkForAllTys, seqType,
splitTyConApp_maybe, tyConAppArgs, mkTyVarTys,
- isUnLiftedType,
+ isUnLiftedType, isStrictType,
splitRepFunTys
)
-import TcType ( isStrictType )
import TyCon ( tyConDataConsIfAvailable )
import DataCon ( dataConRepArity )
import VarEnv ( SubstEnv )
import ErrUtils ( Message )
import Id ( Id, mkLocalId )
import Name ( nameOccName )
-import TysWiredIn ( isFFIArgumentTy, isFFIImportResultTy,
- isFFIExportResultTy,
- isFFIExternalTy, isFFIDynArgumentTy, isFFIDynResultTy,
- isFFILabelTy
- )
import PrimRep ( getPrimRepSize )
import Type ( typePrimRep )
-import TcType ( Type, tcSplitFunTys, tcSplitTyConApp_maybe, tcSplitForAllTys )
+import TcType ( Type, tcSplitFunTys, tcSplitTyConApp_maybe, tcSplitForAllTys,
+ isFFIArgumentTy, isFFIImportResultTy,
+ isFFIExportResultTy, isFFILabelTy,
+ isFFIExternalTy, isFFIDynArgumentTy, isFFIDynResultTy
+ )
import ForeignCall ( CCallSpec(..), CExportSpec(..), CCallTarget(..), isDynamicTarget, isCasmTarget )
import CStrings ( CLabelString, isCLabelString )
import PrelNames ( hasKey, ioTyConKey )
= hang (ptext SLIT("When checking declaration:"))
4 (ppr fo)
\end{code}
+
liftedTypeKind, unliftedTypeKind, openTypeKind, defaultKind, superKind,
superBoxity, liftedBoxity, hasMoreBoxityInfo, typeKind,
tyVarsOfType, tyVarsOfTypes, tidyOpenType, tidyOpenTypes, tidyTyVar,
- eqKind, isTypeKind
+ eqKind, isTypeKind,
+
+ isFFIArgumentTy, isFFIImportResultTy
)
import Subst ( Subst, mkTopTyVarSubst, substTy )
import Class ( classArity, className )
-- others:
import TcMonad -- TcType, amongst others
-import TysWiredIn ( voidTy, listTyCon, mkListTy, mkTupleTy,
- isFFIArgumentTy, isFFIImportResultTy )
+import TysWiredIn ( voidTy, listTyCon, mkListTy, mkTupleTy )
import PrelNames ( cCallableClassKey, cReturnableClassKey, hasKey )
import ForeignCall ( Safety(..) )
import FunDeps ( grow )
-- Predicates.
-- Again, newtypes are opaque
tcEqType, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred,
- isQualifiedTy, isOverloadedTy, isStrictType, isStrictPred,
+ isQualifiedTy, isOverloadedTy,
isDoubleTy, isFloatTy, isIntTy,
- isIntegerTy, isAddrTy, isBoolTy, isUnitTy, isForeignPtrTy, isPrimitiveType,
+ isIntegerTy, isAddrTy, isBoolTy, isUnitTy, isForeignPtrTy,
isTauTy, tcIsTyVarTy, tcIsForAllTy,
---------------------------------
---------------------------------
-- Predicate types
- PredType, mkPredTy, mkPredTys, getClassPredTys_maybe, getClassPredTys,
+ PredType, getClassPredTys_maybe, getClassPredTys,
isPredTy, isClassPred, isTyVarClassPred, predHasFDs,
mkDictTy, tcSplitPredTy_maybe, predTyUnique,
isDictTy, tcSplitDFunTy, predTyUnique,
mkClassPred, predMentionsIPs, inheritablePred, isIPPred, mkPredName,
---------------------------------
+ -- Foreign import and export
+ isFFIArgumentTy, -- :: DynFlags -> Safety -> Type -> Bool
+ isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
+ isFFIExportResultTy, -- :: Type -> Bool
+ isFFIExternalTy, -- :: Type -> Bool
+ isFFIDynArgumentTy, -- :: Type -> Bool
+ isFFIDynResultTy, -- :: Type -> Bool
+ isFFILabelTy, -- :: Type -> Bool
+
+ ---------------------------------
-- Unifier and matcher
unifyTysX, unifyTyListsX, unifyExtendTysX,
allDistinctTyVars,
mkForAllTy, mkForAllTys,
mkFunTy, mkFunTys, zipFunTys,
mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
- mkTyVarTy, mkTyVarTys, mkTyConTy,
+ mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
isUnLiftedType, -- Source types are always lifted
isUnboxedTupleType, -- Ditto
+ isPrimitiveType,
tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
tidyTyVar, tidyTyVars,
mkForAllTy, mkForAllTys, defaultKind, isTypeKind,
mkFunTy, mkFunTys, zipFunTys,
mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
- mkTyVarTy, mkTyVarTys, mkTyConTy,
- isUnLiftedType, isUnboxedTupleType,
+ mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
+ isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
+ splitNewType_maybe, splitTyConApp_maybe,
tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
tidyTyVar, tidyTyVars, eqKind, eqUsage,
hasMoreBoxityInfo, liftedBoxity, superBoxity, typeKind, superKind
)
-import TyCon ( TyCon, isPrimTyCon, tyConArity, isNewTyCon )
+import TyCon ( TyCon, isPrimTyCon, tyConArity, isNewTyCon, isUnLiftedTyCon )
import Class ( classTyCon, classHasFDs, Class )
import Var ( TyVar, tyVarKind )
+import ForeignCall ( Safety, playSafe )
import VarEnv
import VarSet
-- others:
-import CmdLineOpts ( opt_DictsStrict )
+import CmdLineOpts ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
import Name ( Name, NamedThing(..), mkLocalName )
import OccName ( OccName, mkDictOcc )
import NameSet
-import PrelNames ( floatTyConKey, doubleTyConKey, foreignPtrTyConKey,
- integerTyConKey, intTyConKey, addrTyConKey, boolTyConKey )
+import PrelNames -- Lots (e.g. in isFFIArgumentTy
+import TysWiredIn ( ptrTyCon, funPtrTyCon, addrTyCon, unitTyCon )
import Unique ( Unique, Uniquable(..), mkTupleTyConUnique )
import SrcLoc ( SrcLoc )
import Util ( cmpList, thenCmp )
tcSplitPredTy_maybe (SourceTy p) | isPred p = Just p
tcSplitPredTy_maybe other = Nothing
-mkPredTy :: PredType -> Type
-mkPredTy pred = SourceTy pred
-
-mkPredTys :: ThetaType -> [Type]
-mkPredTys preds = map SourceTy preds
-
predTyUnique :: PredType -> Unique
predTyUnique (IParam n _) = getUnique n
predTyUnique (ClassP clas tys) = getUnique clas
Nothing -> False
\end{code}
-\begin{code}
-isPrimitiveType :: Type -> Bool
--- Returns types that are opaque to Haskell.
--- Most of these are unlifted, but now that we interact with .NET, we
--- may have primtive (foreign-imported) types that are lifted
-isPrimitiveType ty = case tcSplitTyConApp_maybe ty of
- Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
- isPrimTyCon tc
- other -> False
-\end{code}
-
-@isStrictType@ computes whether an argument (or let RHS) should
-be computed strictly or lazily, based only on its type
-
-\begin{code}
-isStrictType :: Type -> Bool
-isStrictType ty
- | isUnLiftedType ty = True
- | Just pred <- tcSplitPredTy_maybe ty = isStrictPred pred
- | otherwise = False
-
-isStrictPred (ClassP clas _) = opt_DictsStrict
- && not (isNewTyCon (classTyCon clas))
-isStrictPred pred = False
- -- We may be strict in dictionary types, but only if it
- -- has more than one component.
- -- [Being strict in a single-component dictionary risks
- -- poking the dictionary component, which is wrong.]
-\end{code}
-
%************************************************************************
%* *
%************************************************************************
%* *
+\subsection[TysWiredIn-ext-type]{External types}
+%* *
+%************************************************************************
+
+The compiler's foreign function interface supports the passing of a
+restricted set of types as arguments and results (the restricting factor
+being the )
+
+\begin{code}
+isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
+-- Checks for valid argument type for a 'foreign import'
+isFFIArgumentTy dflags safety ty
+ = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
+
+isFFIExternalTy :: Type -> Bool
+-- Types that are allowed as arguments of a 'foreign export'
+isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
+
+isFFIImportResultTy :: DynFlags -> Type -> Bool
+isFFIImportResultTy dflags ty
+ = checkRepTyCon (legalFIResultTyCon dflags) ty
+
+isFFIExportResultTy :: Type -> Bool
+isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
+
+isFFIDynArgumentTy :: Type -> Bool
+-- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
+-- or a newtype of either.
+isFFIDynArgumentTy = checkRepTyCon (\tc -> tc == ptrTyCon || tc == funPtrTyCon || tc == addrTyCon)
+
+isFFIDynResultTy :: Type -> Bool
+-- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
+-- or a newtype of either.
+isFFIDynResultTy = checkRepTyCon (\tc -> tc == ptrTyCon || tc == funPtrTyCon || tc == addrTyCon)
+
+isFFILabelTy :: Type -> Bool
+-- The type of a foreign label must be Ptr, FunPtr, Addr,
+-- or a newtype of either.
+isFFILabelTy = checkRepTyCon (\tc -> tc == ptrTyCon || tc == funPtrTyCon || tc == addrTyCon)
+
+checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
+ -- Look through newtypes
+ -- Non-recursive ones are transparent to splitTyConApp,
+ -- but recursive ones aren't; hence the splitNewType_maybe
+checkRepTyCon check_tc ty
+ | Just ty' <- splitNewType_maybe ty = checkRepTyCon check_tc ty'
+ | Just (tc,_) <- splitTyConApp_maybe ty = check_tc tc
+ | otherwise = False
+\end{code}
+
+----------------------------------------------
+These chaps do the work; they are not exported
+----------------------------------------------
+
+\begin{code}
+legalFEArgTyCon :: TyCon -> Bool
+-- It's illegal to return foreign objects and (mutable)
+-- bytearrays from a _ccall_ / foreign declaration
+-- (or be passed them as arguments in foreign exported functions).
+legalFEArgTyCon tc
+ | getUnique tc `elem` [ foreignObjTyConKey, foreignPtrTyConKey,
+ byteArrayTyConKey, mutableByteArrayTyConKey ]
+ = False
+ -- It's also illegal to make foreign exports that take unboxed
+ -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
+ | otherwise
+ = boxedMarshalableTyCon tc
+
+legalFIResultTyCon :: DynFlags -> TyCon -> Bool
+legalFIResultTyCon dflags tc
+ | getUnique tc `elem`
+ [ foreignObjTyConKey, foreignPtrTyConKey,
+ byteArrayTyConKey, mutableByteArrayTyConKey ] = False
+ | tc == unitTyCon = True
+ | otherwise = marshalableTyCon dflags tc
+
+legalFEResultTyCon :: TyCon -> Bool
+legalFEResultTyCon tc
+ | getUnique tc `elem`
+ [ foreignObjTyConKey, foreignPtrTyConKey,
+ byteArrayTyConKey, mutableByteArrayTyConKey ] = False
+ | tc == unitTyCon = True
+ | otherwise = boxedMarshalableTyCon tc
+
+legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
+-- Checks validity of types going from Haskell -> external world
+legalOutgoingTyCon dflags safety tc
+ | playSafe safety && getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]
+ = False
+ | otherwise
+ = marshalableTyCon dflags tc
+
+marshalableTyCon dflags tc
+ = (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
+ || boxedMarshalableTyCon tc
+
+boxedMarshalableTyCon tc
+ = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
+ , int32TyConKey, int64TyConKey
+ , wordTyConKey, word8TyConKey, word16TyConKey
+ , word32TyConKey, word64TyConKey
+ , floatTyConKey, doubleTyConKey
+ , addrTyConKey, ptrTyConKey, funPtrTyConKey
+ , charTyConKey, foreignObjTyConKey
+ , foreignPtrTyConKey
+ , stablePtrTyConKey
+ , byteArrayTyConKey, mutableByteArrayTyConKey
+ , boolTyConKey
+ ]
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Unification with an explicit substitution}
%* *
%************************************************************************
applyTy, applyTys, isForAllTy,
-- Source types
- SourceType(..), sourceTypeRep,
+ SourceType(..), sourceTypeRep, mkPredTy, mkPredTys,
-- Newtypes
splitNewType_maybe,
-- Lifting and boxity
- isUnLiftedType, isUnboxedTupleType, isAlgType,
+ isUnLiftedType, isUnboxedTupleType, isAlgType, isStrictType, isPrimitiveType,
-- Free variables
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
import Name ( NamedThing(..), mkLocalName, tidyOccName )
import Class ( classTyCon )
-import TyCon ( TyCon, isRecursiveTyCon,
+import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon,
isUnboxedTupleTyCon, isUnLiftedTyCon,
isFunTyCon, isNewTyCon, newTyConRep,
isAlgTyCon, isSynTyCon, tyConArity,
)
-- others
+import CmdLineOpts ( opt_DictsStrict )
import Maybes ( maybeToBool )
import SrcLoc ( noSrcLoc )
import PrimRep ( PrimRep(..) )
The key function is sourceTypeRep which gives the representation of a source type:
\begin{code}
+mkPredTy :: PredType -> Type
+mkPredTy pred = SourceTy pred
+
+mkPredTys :: ThetaType -> [Type]
+mkPredTys preds = map SourceTy preds
+
sourceTypeRep :: SourceType -> Type
-- Convert a predicate to its "representation type";
-- the type of evidence for that predicate, which is actually passed at runtime
Free variables of a type
~~~~~~~~~~~~~~~~~~~~~~~~
\begin{code}
-
tyVarsOfType :: Type -> TyVarSet
tyVarsOfType (TyVarTy tv) = unitVarSet tv
tyVarsOfType (TyConApp tycon tys) = tyVarsOfTypes tys
other -> False
\end{code}
+@isStrictType@ computes whether an argument (or let RHS) should
+be computed strictly or lazily, based only on its type.
+Works just like isUnLiftedType, except that it has a special case
+for dictionaries. Since it takes account of ClassP, you might think
+this function should be in TcType, but isStrictType is used by DataCon,
+which is below TcType in the hierarchy, so it's convenient to put it here.
+
+\begin{code}
+isStrictType (ForAllTy tv ty) = isStrictType ty
+isStrictType (NoteTy _ ty) = isStrictType ty
+isStrictType (TyConApp tc _) = isUnLiftedTyCon tc
+isStrictType (UsageTy _ ty) = isStrictType ty
+isStrictType (SourceTy (ClassP clas _)) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
+ -- We may be strict in dictionary types, but only if it
+ -- has more than one component.
+ -- [Being strict in a single-component dictionary risks
+ -- poking the dictionary component, which is wrong.]
+isStrictType other = False
+\end{code}
+
+\begin{code}
+isPrimitiveType :: Type -> Bool
+-- Returns types that are opaque to Haskell.
+-- Most of these are unlifted, but now that we interact with .NET, we
+-- may have primtive (foreign-imported) types that are lifted
+isPrimitiveType ty = case splitTyConApp_maybe ty of
+ Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
+ isPrimTyCon tc
+ other -> False
+\end{code}
+
%************************************************************************
%* *
projects / ghc-hetmet.git / commitdiff