X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=59286304da952d9e6ea5c806f1d89ebb62be0776;hb=940524aec90652b5ef81789c9a453c57c0e42cc9;hp=bfff2c8e552a5b9b67c969dff19c4f5ac3294dc8;hpb=ad17cf6e34b6ab03f19914e7d2c1262b073db3fa;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index bfff2c8..5928630 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -55,7 +55,7 @@ module TcType ( eqKind, isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy, isDoubleTy, isFloatTy, isIntTy, isStringTy, - isIntegerTy, isBoolTy, isUnitTy, + isIntegerTy, isBoolTy, isUnitTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, --------------------------------- @@ -323,6 +323,9 @@ data 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) ------------------------------------- @@ -447,6 +450,7 @@ pprSkolTvBinding tv ppr_details (SkolemTv info) = ppr_skol info ppr_skol UnkSkol = empty -- Unhelpful; omit + ppr_skol RuntimeUnkSkol = quotes (ppr tv) <+> ptext SLIT("is an unknown runtime type") ppr_skol info = quotes (ppr tv) <+> ptext SLIT("is bound by") <+> sep [pprSkolInfo info, nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))] @@ -465,6 +469,7 @@ pprSkolInfo (GenSkol tvs ty) = sep [ptext SLIT("the polymorphic type"), -- 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") @@ -890,11 +895,11 @@ dataConsStupidTheta (con1:cons) = 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} @@ -937,6 +942,12 @@ isIntegerTy = is_tc integerTyConKey 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 @@ -1130,18 +1141,10 @@ isFFIDotnetTy :: DynFlags -> Type -> Bool 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