From a61b7e6edcf2fa8e1a882b6c786126560ec6090d Mon Sep 17 00:00:00 2001
From: lewie <unknown>
Date: Wed, 1 Mar 2000 18:10:44 +0000
Subject: [PATCH 1/1] [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.

---
 ghc/compiler/hsSyn/HsTypes.lhs        |    3 +++
 ghc/compiler/rename/RnHsSyn.lhs       |    1 +
 ghc/compiler/rename/RnSource.lhs      |    5 +++++
 ghc/compiler/typecheck/TcImprove.lhs  |    2 +-
 ghc/compiler/typecheck/TcMonoType.lhs |    9 +++++++--
 5 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index c9637b4..2536e8d 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 d30ef40..58d7128 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 26e6dee..0ef3d39 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 dfe35dd..1451d44 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 29ae73f..1d6087c 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)
-- 
1.7.10.4