diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs index c9637b41d71854f9b26e1daac794ae901c3b26dd..2536e8d07ca8f2f694c30880a22e64476aa7d21f 100644 --- a/ghc/compiler/hsSyn/HsTypes.lhs +++ b/ghc/compiler/hsSyn/HsTypes.lhs @@ -186,6 +186,9 @@ ppr_mono_ty ctxt_prec (MonoTyApp fun_ty arg_ty) = maybeParen (ctxt_prec >= pREC_CON) (hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty]) +ppr_mono_ty ctxt_prec (MonoIParamTy n ty) + = hsep [{- char '?' <> -} ppr n, text "::", ppr_mono_ty pREC_TOP ty] + ppr_mono_ty ctxt_prec (MonoDictTy clas tys) = ppr clas <+> hsep (map (ppr_mono_ty pREC_CON) tys) diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs index d30ef40cacae55c73db5e178f9e63b7c44b971c6..58d71289f059fe623b8e24b2cad76e761bae4b8d 100644 --- a/ghc/compiler/rename/RnHsSyn.lhs +++ b/ghc/compiler/rename/RnHsSyn.lhs @@ -81,6 +81,7 @@ extractHsTyNames ty get (MonoTupleTy tys boxed) = unitNameSet (tupleTyCon_name boxed (length tys)) `unionNameSets` extractHsTyNames_s tys get (MonoFunTy ty1 ty2) = get ty1 `unionNameSets` get ty2 + get (MonoIParamTy n ty) = get ty get (MonoDictTy cls tys) = unitNameSet cls `unionNameSets` extractHsTyNames_s tys get (MonoUsgForAllTy uv ty) = get ty get (MonoUsgTy u ty) = get ty diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index 26e6dee936f88cd196c79a3bcb7798f96948a757..0ef3d39e3b245d31764d4919a25fabdef0806603 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/ghc/compiler/rename/RnSource.lhs @@ -646,6 +646,11 @@ rnHsType doc (MonoTyApp ty1 ty2) rnHsType doc ty2 `thenRn` \ (ty2', fvs2) -> returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2) +rnHsType doc (MonoIParamTy n ty) + = getIPName n `thenRn` \ name -> + rnHsType doc ty `thenRn` \ (ty', fvs) -> + returnRn (MonoIParamTy name ty', fvs) + rnHsType doc (MonoDictTy clas tys) = lookupOccRn clas `thenRn` \ clas' -> rnHsTypes doc tys `thenRn` \ (tys', fvs) -> diff --git a/ghc/compiler/typecheck/TcImprove.lhs b/ghc/compiler/typecheck/TcImprove.lhs index dfe35ddb2255e0e58a71f3697a7e60811ffa5de6..1451d440270d361b2cc06e5e69a904a446b3bf6a 100644 --- a/ghc/compiler/typecheck/TcImprove.lhs +++ b/ghc/compiler/typecheck/TcImprove.lhs @@ -25,7 +25,7 @@ import List ( elemIndex, nub ) \begin{code} tcImprove lie = - if null cfdss then + if null nfdss then returnTc () else -- zonkCfdss cfdss `thenTc` \ cfdss' -> diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs index 29ae73fab5ac9d49579844d7fa3604d9f601a643..1d6087cf4ebec66059fccd89ceaf0ef59f603595 100644 --- a/ghc/compiler/typecheck/TcMonoType.lhs +++ b/ghc/compiler/typecheck/TcMonoType.lhs @@ -33,7 +33,8 @@ import TcUnify ( unifyKind, unifyKinds, unifyTypeKind ) import Type ( Type, PredType(..), ThetaType, UsageAnn(..), mkTyVarTy, mkTyVarTys, mkFunTy, mkSynTy, mkUsgTy, mkUsForAllTy, zipFunTys, - mkSigmaTy, mkDictTy, mkTyConApp, mkAppTys, splitForAllTys, splitRhoTy, + mkSigmaTy, mkDictTy, mkPredTy, mkTyConApp, + mkAppTys, splitForAllTys, splitRhoTy, boxedTypeKind, unboxedTypeKind, tyVarsOfType, mkArrowKinds, getTyVar_maybe, getTyVar, tidyOpenType, tidyOpenTypes, tidyTyVar, @@ -140,7 +141,7 @@ tc_type ty tc_type_kind :: RenamedHsType -> TcM s (TcKind, Type) tc_type_kind ty@(MonoTyVar name) = tc_app ty [] - + tc_type_kind (MonoListTy ty) = tc_boxed_type ty `thenTc` \ tau_ty -> returnTc (boxedTypeKind, mkListTy tau_ty) @@ -161,6 +162,10 @@ tc_type_kind (MonoFunTy ty1 ty2) tc_type_kind (MonoTyApp ty1 ty2) = tc_app ty1 [ty2] +tc_type_kind (MonoIParamTy n ty) + = tc_type ty `thenTc` \ tau -> + returnTc (boxedTypeKind, mkPredTy (IParam n tau)) + tc_type_kind (MonoDictTy class_name tys) = tcClassAssertion (HsPClass class_name tys) `thenTc` \ (Class clas arg_tys) -> returnTc (boxedTypeKind, mkDictTy clas arg_tys)