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,
---------------------------------
| 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)
-------------------------------------
-- 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")
(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 -> 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 -> tcValidInstHeadTy ty
- TyConApp tc tys -> not (isSynTyCon tc) && ok tys
+ NoteTy _ ty -> tcInstHeadTyAppAllTyVars ty
+ TyConApp _ tys -> ok tys
FunTy arg res -> ok [arg, res]
other -> False
where
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
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
(_, t_ty) = tcSplitForAllTys ty
= isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
marshalableTyCon dflags tc
- = (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
+ = (dopt Opt_UnliftedFFITypes dflags && isUnLiftedTyCon tc)
|| boxedMarshalableTyCon tc
boxedMarshalableTyCon tc