Commit a61b7e6e authored by lewie's avatar lewie
Browse files

[project @ 2000-03-01 18:10:43 by lewie]

Filled in some missing support for importing defs w/ implicit params.
Fixed bug in improvement w/ implicit params.
parent c4574ceb
......@@ -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)
......
......@@ -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
......
......@@ -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) ->
......
......@@ -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' ->
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment