tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred,
isSigmaTy, isOverloadedTy,
isDoubleTy, isFloatTy, isIntTy,
- isIntegerTy, isAddrTy, isBoolTy, isUnitTy, isForeignPtrTy,
+ isIntegerTy, isAddrTy, isBoolTy, isUnitTy,
isTauTy, tcIsTyVarTy, tcIsForAllTy,
allDistinctTyVars,
---------------------------------
-- Misc type manipulators
- hoistForAllTys, deNoteType,
- namesOfType, namesOfDFunHead,
+ deNoteType, classNamesOfTheta,
+ tyClsNamesOfType, tyClsNamesOfDFunHead,
getDFunTyKey,
---------------------------------
-- Predicate types
- PredType, getClassPredTys_maybe, getClassPredTys,
+ getClassPredTys_maybe, getClassPredTys,
isPredTy, isClassPred, isTyVarClassPred, predHasFDs,
- mkDictTy, tcSplitPredTy_maybe, predTyUnique,
+ mkDictTy, tcSplitPredTy_maybe,
isDictTy, tcSplitDFunTy, predTyUnique,
mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName,
isUnLiftedType, -- Source types are always lifted
isUnboxedTupleType, -- Ditto
- isPrimitiveType,
+ isPrimitiveType, isTyVarTy,
tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
import {-# SOURCE #-} PprType( pprType )
+-- PprType imports TcType so that it can print intelligently
-- friends:
import TypeRep ( Type(..), TyNote(..), funTyCon ) -- friend
Kind, Type, SourceType(..), PredType, ThetaType,
unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
mkForAllTy, mkForAllTys, defaultKind, isTypeKind, isAnyTypeKind,
- mkFunTy, mkFunTys, zipFunTys,
+ mkFunTy, mkFunTys, zipFunTys, isTyVarTy,
mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
\begin{code}
isFloatTy = is_tc floatTyConKey
isDoubleTy = is_tc doubleTyConKey
-isForeignPtrTy = is_tc foreignPtrTyConKey
isIntegerTy = is_tc integerTyConKey
isIntTy = is_tc intTyConKey
isAddrTy = is_tc addrTyConKey
%************************************************************************
\begin{code}
-hoistForAllTys :: Type -> Type
--- Used for user-written type signatures only
--- Move all the foralls and constraints to the top
--- e.g. T -> forall a. a ==> forall a. T -> a
--- T -> (?x::Int) -> Int ==> (?x::Int) -> T -> Int
---
--- We want to 'look through' type synonyms when doing this
--- so it's better done on the Type than the HsType
-
-hoistForAllTys ty
- = case hoist ty ty of
- (tvs, theta, body) -> mkForAllTys tvs (mkFunTys theta body)
- where
- hoist orig_ty (ForAllTy tv ty) = case hoist ty ty of
- (tvs,theta,tau) -> (tv:tvs,theta,tau)
- hoist orig_ty (FunTy arg res)
- | isPredTy arg' = case hoist res res of
- (tvs,theta,tau) -> (tvs,arg':theta,tau)
- | otherwise = case hoist res res of
- (tvs,theta,tau) -> (tvs,theta,mkFunTy arg' tau)
- where
- arg' = hoistForAllTys arg -- Don't forget to apply hoist recursively
- -- to the argument type
-
- hoist orig_ty (NoteTy _ ty) = hoist orig_ty ty
- hoist orig_ty ty = ([], [], orig_ty)
-\end{code}
-
-
-\begin{code}
deNoteType :: Type -> Type
-- Remove synonyms, but not source types
deNoteType ty@(TyVarTy tyvar) = ty
deNoteSourceType (NType tc tys) = NType tc (map deNoteType tys)
\end{code}
-Find the free names of a type, including the type constructors and classes it mentions
-This is used in the front end of the compiler
+Find the free tycons and classes of a type. This is used in the front
+end of the compiler.
\begin{code}
-namesOfType :: Type -> NameSet
-namesOfType (TyVarTy tv) = unitNameSet (getName tv)
-namesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` namesOfTypes tys
-namesOfType (NoteTy (SynNote ty1) ty2) = namesOfType ty1
-namesOfType (NoteTy other_note ty2) = namesOfType ty2
-namesOfType (SourceTy (IParam n ty)) = namesOfType ty
-namesOfType (SourceTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` namesOfTypes tys
-namesOfType (SourceTy (NType tc tys)) = unitNameSet (getName tc) `unionNameSets` namesOfTypes tys
-namesOfType (FunTy arg res) = namesOfType arg `unionNameSets` namesOfType res
-namesOfType (AppTy fun arg) = namesOfType fun `unionNameSets` namesOfType arg
-namesOfType (ForAllTy tyvar ty) = namesOfType ty `delFromNameSet` getName tyvar
-
-namesOfTypes tys = foldr (unionNameSets . namesOfType) emptyNameSet tys
-
-namesOfDFunHead :: Type -> NameSet
+tyClsNamesOfType :: Type -> NameSet
+tyClsNamesOfType (TyVarTy tv) = emptyNameSet
+tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
+tyClsNamesOfType (NoteTy (SynNote ty1) ty2) = tyClsNamesOfType ty1
+tyClsNamesOfType (NoteTy other_note ty2) = tyClsNamesOfType ty2
+tyClsNamesOfType (SourceTy (IParam n ty)) = tyClsNamesOfType ty
+tyClsNamesOfType (SourceTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
+tyClsNamesOfType (SourceTy (NType tc tys)) = unitNameSet (getName tc) `unionNameSets` tyClsNamesOfTypes tys
+tyClsNamesOfType (FunTy arg res) = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
+tyClsNamesOfType (AppTy fun arg) = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
+tyClsNamesOfType (ForAllTy tyvar ty) = tyClsNamesOfType ty
+
+tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
+
+tyClsNamesOfDFunHead :: Type -> NameSet
-- Find the free type constructors and classes
-- of the head of the dfun instance type
-- The 'dfun_head_type' is because of
-- instance Foo a => Baz T where ...
-- The decl is an orphan if Baz and T are both not locally defined,
-- even if Foo *is* locally defined
-namesOfDFunHead dfun_ty = case tcSplitSigmaTy dfun_ty of
- (tvs,_,head_ty) -> delListFromNameSet (namesOfType head_ty)
- (map getName tvs)
+tyClsNamesOfDFunHead dfun_ty
+ = case tcSplitSigmaTy dfun_ty of
+ (tvs,_,head_ty) -> tyClsNamesOfType head_ty
+
+classNamesOfTheta :: ThetaType -> [Name]
+-- Looks just for ClassP things; maybe it should check
+classNamesOfTheta preds = [ getName c | ClassP c _ <- preds ]
\end{code}
-- 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 ]
+ | getUnique tc `elem` [ 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
legalFIResultTyCon :: DynFlags -> TyCon -> Bool
legalFIResultTyCon dflags tc
| getUnique tc `elem`
- [ foreignObjTyConKey, foreignPtrTyConKey,
- byteArrayTyConKey, mutableByteArrayTyConKey ] = False
+ [ byteArrayTyConKey, mutableByteArrayTyConKey ] = False
| tc == unitTyCon = True
| otherwise = marshalableTyCon dflags tc
legalFEResultTyCon :: TyCon -> Bool
legalFEResultTyCon tc
| getUnique tc `elem`
- [ foreignObjTyConKey, foreignPtrTyConKey,
- byteArrayTyConKey, mutableByteArrayTyConKey ] = False
+ [ byteArrayTyConKey, mutableByteArrayTyConKey ] = False
| tc == unitTyCon = True
| otherwise = boxedMarshalableTyCon tc
, word32TyConKey, word64TyConKey
, floatTyConKey, doubleTyConKey
, addrTyConKey, ptrTyConKey, funPtrTyConKey
- , charTyConKey, foreignObjTyConKey
- , foreignPtrTyConKey
+ , charTyConKey
, stablePtrTyConKey
, byteArrayTyConKey, mutableByteArrayTyConKey
, boolTyConKey
projects / ghc-hetmet.git / blobdiff