is the principal client.
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcType (
--------------------------------
-- Types
UserTypeCtxt(..), pprUserTypeCtxt,
TcTyVarDetails(..), BoxInfo(..), pprTcTyVarDetails,
MetaDetails(Flexi, Indirect), SkolemInfo(..), pprSkolTvBinding, pprSkolInfo,
- isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar, isSigTyVar, isExistentialTyVar,
+ isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar,
+ isSigTyVar, isExistentialTyVar, isTyConableTyVar,
metaTvRef,
isFlexi, isIndirect,
tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
- tcValidInstHeadTy, tcGetTyVar_maybe, tcGetTyVar,
+ tcInstHeadTyNotSynonym, tcInstHeadTyAppAllTyVars,
+ tcGetTyVar_maybe, tcGetTyVar,
tcSplitSigmaTy, tcMultiSplitSigmaTy,
---------------------------------
eqKind,
isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
isDoubleTy, isFloatTy, isIntTy, isStringTy,
- isIntegerTy, isBoolTy, isUnitTy,
+ isIntegerTy, isBoolTy, isUnitTy, isCharTy,
isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
+ isOpenSynTyConApp,
---------------------------------
-- Misc type manipulators
tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
pprKind, pprParendKind,
- pprType, pprParendType, pprTyThingCategory,
+ pprType, pprParendType, pprTypeApp, pprTyThingCategory,
pprPred, pprTheta, pprThetaArrow, pprClassPred
) where
import Unify
import VarSet
import Type
+import Coercion
import TyCon
-- others:
import Data.IORef
\end{code}
-
%************************************************************************
%* *
\subsection{Types}
-- b2 is another (currently empty) box.
data MetaDetails
- = Flexi -- Flexi type variables unify to become
- -- Indirects.
+ = Flexi -- Flexi type variables unify to become
+ -- Indirects.
- | Indirect TcType -- INVARIANT:
- -- For a BoxTv, this type must be non-boxy
- -- For a TauTv, this type must be a tau-type
+ | Indirect TcType -- INVARIANT:
+ -- For a BoxTv, this type must be non-boxy
+ -- For a TauTv, this type must be a tau-type
-- Generally speaking, SkolemInfo should not contain location info
-- that is contained in the Name of the tyvar with this SkolemInfo
| GenSkol [TcTyVar] -- Bound when doing a subsumption check for
TcType -- (forall tvs. ty)
+ | RuntimeUnkSkol -- a type variable used to represent an unknown
+ -- runtime type (used in the GHCi debugger)
+
| UnkSkol -- Unhelpful info (until I improve it)
-------------------------------------
-- They may be jiggled by tidying
kind_var_occ = mkOccName tvName "k"
\end{code}
-\end{code}
%************************************************************************
%* *
-- or nothing if we don't have anything useful to say
pprSkolTvBinding tv
= ASSERT ( isTcTyVar tv )
- ppr_details (tcTyVarDetails tv)
+ quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
where
- ppr_details (MetaTv TauTv _) = quotes (ppr tv) <+> ptext SLIT("is a meta type variable")
- ppr_details (MetaTv BoxTv _) = quotes (ppr tv) <+> ptext SLIT("is a boxy type variable")
+ ppr_details (MetaTv TauTv _) = ptext SLIT("is a meta type variable")
+ ppr_details (MetaTv BoxTv _) = ptext SLIT("is a boxy type variable")
ppr_details (MetaTv (SigTv info) _) = ppr_skol info
ppr_details (SkolemTv info) = ppr_skol info
- ppr_skol UnkSkol = empty -- Unhelpful; omit
- ppr_skol info = quotes (ppr tv) <+> ptext SLIT("is bound by")
- <+> sep [pprSkolInfo info, nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))]
+ ppr_skol UnkSkol = empty -- Unhelpful; omit
+ ppr_skol RuntimeUnkSkol = ptext SLIT("is an unknown runtime type")
+ ppr_skol info = sep [ptext SLIT("is a rigid type variable bound by"),
+ sep [pprSkolInfo info,
+ nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))]]
pprSkolInfo :: SkolemInfo -> SDoc
pprSkolInfo (SigSkol ctxt) = pprUserTypeCtxt ctxt
-- For type variables the others are dealt with by pprSkolTvBinding.
-- For Insts, these cases should not happen
pprSkolInfo UnkSkol = panic "UnkSkol"
+pprSkolInfo RuntimeUnkSkol = panic "RuntimeUnkSkol"
instance Outputable MetaDetails where
- ppr Flexi = ptext SLIT("Flexi")
+ ppr Flexi = ptext SLIT("Flexi")
ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty
\end{code}
%************************************************************************
\begin{code}
-isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isBoxyTyVar, isMetaTyVar :: TyVar -> Bool
+isImmutableTyVar :: TyVar -> Bool
+
isImmutableTyVar tv
| isTcTyVar tv = isSkolemTyVar tv
| otherwise = True
+isTyConableTyVar, isSkolemTyVar, isExistentialTyVar,
+ isBoxyTyVar, isMetaTyVar :: TcTyVar -> Bool
+
+isTyConableTyVar tv
+ -- True of a meta-type variable that can be filled in
+ -- with a type constructor application; in particular,
+ -- not a SigTv
+ = ASSERT( isTcTyVar tv)
+ case tcTyVarDetails tv of
+ MetaTv BoxTv _ -> True
+ MetaTv TauTv _ -> True
+ MetaTv (SigTv {}) _ -> False
+ SkolemTv {} -> False
+
isSkolemTyVar tv
= ASSERT( isTcTyVar tv )
case tcTyVarDetails tv of
metaTvRef :: TyVar -> IORef MetaDetails
metaTvRef tv
- = ASSERT( isTcTyVar tv )
+ = ASSERT2( isTcTyVar tv, ppr tv )
case tcTyVarDetails tv of
MetaTv _ ref -> ref
other -> pprPanic "metaTvRef" (ppr tv)
isFlexi, isIndirect :: MetaDetails -> Bool
-isFlexi Flexi = True
-isFlexi other = False
+isFlexi Flexi = True
+isFlexi other = False
isIndirect (Indirect _) = True
isIndirect other = False
-- A type is rigid if it has no meta type variables in it
isRigidTy ty = all isImmutableTyVar (varSetElems (tcTyVarsOfType ty))
-isRefineableTy :: TcType -> Bool
+isRefineableTy :: TcType -> (Bool,Bool)
-- A type should have type refinements applied to it if it has
-- free type variables, and they are all rigid
-isRefineableTy ty = not (null tc_tvs) && all isImmutableTyVar tc_tvs
+isRefineableTy ty = (null tc_tvs, all isImmutableTyVar tc_tvs)
where
tc_tvs = varSetElems (tcTyVarsOfType ty)
(args,res') = tcSplitFunTys res
tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
-tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
-tcSplitFunTy_maybe (FunTy arg res) = Just (arg, res)
-tcSplitFunTy_maybe other = Nothing
+tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
+tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
+tcSplitFunTy_maybe other = Nothing
+ -- Note the (not (isPredTy arg)) guard
+ -- Consider (?x::Int) => Bool
+ -- We don't want to treat this as a function type!
+ -- A concrete example is test tc230:
+ -- f :: () -> (?p :: ()) => () -> ()
+ --
+ -- g = f () ()
tcSplitFunTysN
:: TcRhoType
Just (ClassP clas tys) -> (clas, tys)
other -> panic "tcSplitDFunHead"
-tcValidInstHeadTy :: Type -> Bool
+tcInstHeadTyNotSynonym :: Type -> Bool
-- Used in Haskell-98 mode, for the argument types of an instance head
-- These must not be type synonyms, but everywhere else type synonyms
-- are transparent, so we need a special function here
-tcValidInstHeadTy ty
+tcInstHeadTyNotSynonym ty
= case ty of
- NoteTy _ ty -> tcValidInstHeadTy ty
- TyConApp tc tys -> not (isSynTyCon tc) && ok tys
+ NoteTy _ ty -> tcInstHeadTyNotSynonym ty
+ TyConApp tc tys -> not (isSynTyCon tc)
+ _ -> True
+
+tcInstHeadTyAppAllTyVars :: Type -> Bool
+-- Used in Haskell-98 mode, for the argument types of an instance head
+-- These must be a constructor applied to type variable arguments
+tcInstHeadTyAppAllTyVars ty
+ = case ty of
+ NoteTy _ ty -> tcInstHeadTyAppAllTyVars ty
+ TyConApp _ tys -> ok tys
FunTy arg res -> ok [arg, res]
other -> False
where
predTyUnique :: PredType -> Unique
predTyUnique (IParam n _) = getUnique (ipNameName n)
predTyUnique (ClassP clas tys) = getUnique clas
+predTyUnique (EqPred a b) = pprPanic "predTyUnique" (ppr (EqPred a b))
\end{code}
= nubBy tcEqPred all_preds
where
all_preds = dataConStupidTheta con1 ++ other_stupids
- res_tys1 = dataConResTys con1
- tvs1 = tyVarsOfTypes res_tys1
+ res_ty1 = dataConOrigResTy con1
other_stupids = [ substPred subst pred
| con <- cons
- , let Just subst = tcMatchTys tvs1 res_tys1 (dataConResTys con)
+ , let (tvs, _, _, res_ty) = dataConSig con
+ Just subst = tcMatchTy (mkVarSet tvs) res_ty res_ty1
, pred <- dataConStupidTheta con ]
dataConsStupidTheta [] = panic "dataConsStupidTheta"
\end{code}
isIntTy = is_tc intTyConKey
isBoolTy = is_tc boolTyConKey
isUnitTy = is_tc unitTyConKey
+isCharTy = is_tc charTyConKey
+
+isStringTy ty
+ = case tcSplitTyConApp_maybe ty of
+ Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
+ other -> False
is_tc :: Unique -> Type -> Bool
-- Newtypes are opaque to this
Nothing -> False
\end{code}
+\begin{code}
+-- NB: Currently used in places where we have already expanded type synonyms;
+-- hence no 'coreView'. This could, however, be changed without breaking
+-- any code.
+isOpenSynTyConApp :: TcTauType -> Bool
+isOpenSynTyConApp (TyConApp tc _) = isOpenSynTyCon tc
+isOpenSynTyConApp _other = False
+\end{code}
+
%************************************************************************
%* *
go (AppTy fun arg) = go fun `unionVarSet` go arg
go (ForAllTy tyvar ty) = delVarSet (go ty) tyvar
`unionVarSet` go_tv tyvar
+ go (NoteTy _ _) = panic "exactTyVarsOfType" -- Handled by tcView
go_pred (IParam _ ty) = go ty
go_pred (ClassP _ tys) = exactTyVarsOfTypes tys
being the )
\begin{code}
-tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
--- (isIOType t) returns (Just (IO,t')) if t is of the form (IO t'), or
--- some newtype wrapping thereof
+tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, CoercionI)
+-- (isIOType t) returns Just (IO,t',co)
+-- if co : t ~ IO t'
-- returns Nothing otherwise
tcSplitIOType_maybe ty
- | Just (io_tycon, [io_res_ty]) <- tcSplitTyConApp_maybe ty,
+ = case tcSplitTyConApp_maybe ty of
-- This split absolutely has to be a tcSplit, because we must
-- see the IO type; and it's a newtype which is transparent to splitTyConApp.
- io_tycon `hasKey` ioTyConKey
- = Just (io_tycon, io_res_ty)
- | Just ty' <- coreView ty -- Look through non-recursive newtypes
- = tcSplitIOType_maybe ty'
+ Just (io_tycon, [io_res_ty])
+ | io_tycon `hasKey` ioTyConKey
+ -> Just (io_tycon, io_res_ty, IdCo)
- | otherwise
- = Nothing
+ Just (tc, tys)
+ | not (isRecursiveTyCon tc)
+ , Just (ty, co1) <- instNewTyCon_maybe tc tys
+ -- Newtypes that require a coercion are ok
+ -> case tcSplitIOType_maybe ty of
+ Nothing -> Nothing
+ Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCoI` co2)
+
+ other -> Nothing
isFFITy :: Type -> Bool
-- True for any TyCon that can possibly be an arg or result of an FFI call
isFFIDotnetTy dflags ty
= checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
isFFIDotnetObjTy ty || isStringTy ty)) ty
+ -- NB: isStringTy used to look through newtypes, but
+ -- it no longer does so. May need to adjust isFFIDotNetTy
+ -- if we do want to look through newtypes.
--- Support String as an argument or result from a .NET FFI call.
-isStringTy ty =
- case tcSplitTyConApp_maybe (repType ty) of
- Just (tc, [arg_ty])
- | tc == listTyCon ->
- case tcSplitTyConApp_maybe (repType arg_ty) of
- Just (cc,[]) -> cc == charTyCon
- _ -> False
- _ -> False
-
--- Support String as an argument or result from a .NET FFI call.
-isFFIDotnetObjTy ty =
- let
+isFFIDotnetObjTy ty
+ = checkRepTyCon check_tc t_ty
+ where
(_, t_ty) = tcSplitForAllTys ty
- in
- case tcSplitTyConApp_maybe (repType t_ty) of
- Just (tc, [arg_ty]) | getName tc == objectTyConName -> True
- _ -> False
+ check_tc tc = getName tc == objectTyConName
toDNType :: Type -> DNType
toDNType ty
= isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
marshalableTyCon dflags tc
- = (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
+ = (dopt Opt_UnliftedFFITypes dflags
+ && isUnLiftedTyCon tc
+ && case tyConPrimRep tc of -- Note [Marshalling VoidRep]
+ VoidRep -> False
+ other -> True)
|| boxedMarshalableTyCon tc
boxedMarshalableTyCon tc
, boolTyConKey
]
\end{code}
+
+Note [Marshalling VoidRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+We don't treat State# (whose PrimRep is VoidRep) as marshalable.
+In turn that means you can't write
+ foreign import foo :: Int -> State# RealWorld
+
+Reason: the back end falls over with panic "primRepHint:VoidRep";
+ and there is no compelling reason to permit it
projects / ghc-hetmet.git / blobdiff