From 521303d13a4deccceaf1988bbf45e3e79f540bac Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Mon, 25 Aug 1997 22:34:28 +0000
Subject: [PATCH] [project @ 1997-08-25 22:34:28 by sof] improved ppr; better
 zonkage

---
 ghc/compiler/typecheck/TcBinds.lhs |   46 ++++++++++++++++++++----------------
 1 file changed, 26 insertions(+), 20 deletions(-)

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 2417160..39c7716 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -44,7 +44,7 @@ import TcSimplify	( bindInstsOfLocalFuns )
 import TcType		( TcIdOcc(..), SYN_IE(TcIdBndr), 
 			  SYN_IE(TcType), SYN_IE(TcThetaType), SYN_IE(TcTauType), 
 			  SYN_IE(TcTyVarSet), SYN_IE(TcTyVar),
-			  newTyVarTy, zonkTcType, zonkTcTyVar, zonkTcTyVars,
+			  newTyVarTy, zonkTcType, zonkSigTyVar,
 			  newTcTyVar, tcInstSigType, newTyVarTys
 			)
 import Unify		( unifyTauTy, unifyTauTyLists )
@@ -618,28 +618,35 @@ checkSigTyVars :: [TcTyVar s]		-- The original signature type variables
 	       -> TcM s ()
 
 checkSigTyVars sig_tyvars sig_tau
-  = tcGetGlobalTyVars			`thenNF_Tc` \ globals ->
-    let
-	mono_tyvars = filter (`elementOfTyVarSet` globals) sig_tyvars
-    in
-	-- TEMPORARY FIX
-	-- Until the final Bind-handling stuff is in, several type signatures in the same
-	-- bindings group can cause the signature type variable from the different
-	-- signatures to be unified.  So we still need to zonk and check point (b).
-	-- Remove when activating the new binding code
-    mapNF_Tc zonkTcTyVar sig_tyvars	`thenNF_Tc` \ sig_tys ->
-    checkTcM (hasNoDups (map (getTyVar "checkSigTyVars") sig_tys))
+  =	-- Several type signatures in the same bindings group can 
+	-- cause the signature type variable from the different
+	-- signatures to be unified.  So we need to zonk them.
+    mapNF_Tc zonkSigTyVar sig_tyvars	`thenNF_Tc` \ sig_tyvars' ->
+
+	-- Point (a) is forced by the fact that they are signature type
+	-- variables, so the unifer won't bind them to a type.
+
+	-- Check point (b)
+    checkTcM (hasNoDups sig_tyvars')
 	     (zonkTcType sig_tau 	`thenNF_Tc` \ sig_tau' ->
 	      failTc (badMatchErr sig_tau sig_tau')
 	     )				`thenTc_`
 
-
 	-- Check point (c)
 	-- We want to report errors in terms of the original signature tyvars,
-	-- ie sig_tyvars, NOT sig_tyvars'.  sig_tys and sig_tyvars' correspond
+	-- ie sig_tyvars, NOT sig_tyvars'.  sig_tyvars' correspond
 	-- 1-1 with sig_tyvars, so we can just map back.
-    checkTc (null mono_tyvars)
-	    (notAsPolyAsSigErr sig_tau mono_tyvars)
+    tcGetGlobalTyVars			`thenNF_Tc` \ globals ->
+    let
+--	mono_tyvars = [sig_tv | (sig_tv, sig_tv') <- sig_tyvars `zip` sig_tyvars',
+--				 sig_tv' `elementOfTyVarSet` globals
+--		      ]
+	mono_tyvars' = [sig_tv' | sig_tv' <- sig_tyvars', 
+				  sig_tv' `elementOfTyVarSet` globals]
+    in
+    checkTcM (null mono_tyvars')
+	     (zonkTcType sig_tau 	`thenNF_Tc` \ sig_tau' ->
+	      failTc (notAsPolyAsSigErr sig_tau' mono_tyvars'))
 \end{code}
 
 
@@ -850,10 +857,9 @@ valSpecSigCtxt v ty sty
 -----------------------------------------------
 notAsPolyAsSigErr sig_tau mono_tyvars sty
   = hang (ptext SLIT("A type signature is more polymorphic than the inferred type"))
-	4  (vcat [text "Some type variables in the inferred type can't be forall'd, namely:",
-		      interpp'SP sty mono_tyvars,
-		      ptext SLIT("Possible cause: the RHS mentions something subject to the monomorphism restriction")
-		     ])
+	4  (vcat [text "Can't for-all the type variable(s)" <+> interpp'SP sty mono_tyvars,
+		  text "in the inferred type" <+> ppr sty sig_tau
+	   ])
 
 -----------------------------------------------
 badMatchErr sig_ty inferred_ty sty
-- 
1.7.10.4