From b8c98e4e8457c58ac0798b78e0431434262c3f54 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Wed, 6 Sep 2006 22:03:09 +0000
Subject: [PATCH] Improve error reporting for SigTvs, and add comments

---
 compiler/typecheck/TcBinds.lhs |   10 ++++++++--
 compiler/typecheck/TcType.lhs  |   22 +++++++++++++++-------
 compiler/typecheck/TcUnify.lhs |    8 ++++----
 3 files changed, 27 insertions(+), 13 deletions(-)

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 33c8ddb..36c71a1 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -1041,9 +1041,15 @@ tcInstSig_maybe sig_fn name
 
 tcInstSig :: Bool -> Name -> [Name] -> TcM TcSigInfo
 -- Instantiate the signature, with either skolems or meta-type variables
--- depending on the use_skols boolean
+-- depending on the use_skols boolean.  This variable is set True
+-- when we are typechecking a single function binding; and False for
+-- pattern bindigs and a group of several function bindings.
+-- Reason: in the latter cases, the "skolems" can be unified together, 
+-- 	   so they aren't properly rigid in the type-refinement sense.
+-- NB: unless we are doing H98, each function with a sig will be done
+--     separately, even if it's mutually recursive, so use_skols will be True
 --
--- We always instantiate with freshs uniques,
+-- We always instantiate with fresh uniques,
 -- although we keep the same print-name
 --	
 --	type T = forall a. [a] -> [a]
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 5ad9a10..ed29d65 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -284,14 +284,14 @@ The trouble is that the occurrences of z in the RHS force a* and b* to
 be the *same*, so we can't make them into skolem constants that don't unify
 with each other.  Alas.
 
-On the other hand, we *must* use skolems for signature type variables, 
-becuase GADT type refinement refines skolems only.  
-
 One solution would be insist that in the above defn the programmer uses
 the same type variable in both type signatures.  But that takes explanation.
 
 The alternative (currently implemented) is to have a special kind of skolem
-constant, SigSkokTv, which can unify with other SigSkolTvs.  
+constant, SigTv, which can unify with other SigTvs.  These are *not* treated
+as righd for the purposes of GADTs.  And they are used *only* for pattern 
+bindings and mutually recursive function bindings.  See the function
+TcBinds.tcInstSig, and its use_skols parameter.
 
 
 \begin{code}
@@ -420,15 +420,23 @@ pprUserTypeCtxt SpecInstCtxt    = ptext SLIT("a SPECIALISE instance pragma")
 tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
 -- Tidy the type inside a GenSkol, preparatory to printing it
 tidySkolemTyVar env tv
-  = ASSERT( isSkolemTyVar tv )
+  = ASSERT( isSkolemTyVar tv || isSigTyVar tv )
     (env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
   where
     (env1, info1) = case tcTyVarDetails tv of
-		      SkolemTv (GenSkol tvs ty loc) -> (env2, SkolemTv (GenSkol tvs1 ty1 loc))
+			SkolemTv info -> (env1, SkolemTv info')
+				where
+				  (env1, info') = tidy_skol_info env info
+			MetaTv (SigTv info) box -> (env1, MetaTv (SigTv info') box)
+				where
+				  (env1, info') = tidy_skol_info env info
+			info -> (env, info)
+
+    tidy_skol_info env (GenSkol tvs ty loc) = (env2, GenSkol tvs1 ty1 loc)
 			    where
 			      (env1, tvs1) = tidyOpenTyVars env tvs
 			      (env2, ty1)  = tidyOpenType env1 ty
-		      info -> (env, info)
+    tidy_skol_info env info = (env, info)
 		     
 pprSkolTvBinding :: TcTyVar -> SDoc
 -- Print info about the binding of a skolem tyvar, 
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index eba9985..649408c 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -48,9 +48,9 @@ import TcType		( TcKind, TcType, TcTyVar, BoxyTyVar, TcTauType,
 			  tcSplitForAllTys, tcSplitAppTy_maybe, tcSplitFunTys, mkTyVarTys,
 			  tcSplitSigmaTy, tyVarsOfType, mkPhiTy, mkTyVarTy, mkPredTy, 
 			  typeKind, mkForAllTys, mkAppTy, isBoxyTyVar,
-			  exactTyVarsOfType, 
+			  tcView, exactTyVarsOfType, 
 			  tidyOpenType, tidyOpenTyVar, tidyOpenTyVars,
-			  pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, tcView, 
+			  pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, isSigTyVar,
 			  TvSubst, mkTvSubst, zipTyEnv, zipOpenTvSubst, emptyTvSubst, 
 			  substTy, substTheta, 
 			  lookupTyVar, extendTvSubst )
@@ -1501,8 +1501,8 @@ ppr_ty env ty
 	     simple_result  = (env1, quotes (ppr tidy_ty), empty)
        ; case tidy_ty of
 	   TyVarTy tv 
-		| isSkolemTyVar tv -> return (env2, pp_rigid tv',
-					      pprSkolTvBinding tv')
+		| isSkolemTyVar tv || isSigTyVar tv
+		-> return (env2, pp_rigid tv', pprSkolTvBinding tv')
 		| otherwise -> return simple_result
 		where
 		  (env2, tv') = tidySkolemTyVar env1 tv
-- 
1.7.10.4