From 1e440dbcc72d952b5294276b00da1b131a61ceba Mon Sep 17 00:00:00 2001
From: andy <unknown>
Date: Tue, 9 Nov 1999 00:40:12 +0000
Subject: [PATCH] [project @ 1999-11-09 00:40:11 by andy] This is to fix the
 following bugs:

    Reported by    Description
    ----------------------------------------------------------------------
    Various        cutoff value for -c option seems too low.
    Andy           weirdness with :i C if C is a zero parameter class.
    Ross Paterson  Problem with rank 2 parameters and "Showable" class.
    Jeff           Stronger static checking on instances for classes with
                   functional dependencies.
---
 ghc/interpreter/hugs.c   |    9 ++++++---
 ghc/interpreter/static.c |   34 +++++++++++++++++++++++++++++-----
 2 files changed, 35 insertions(+), 8 deletions(-)

diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c
index f670969..c8d2132 100644
--- a/ghc/interpreter/hugs.c
+++ b/ghc/interpreter/hugs.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: hugs.c,v $
- * $Revision: 1.16 $
- * $Date: 1999/10/29 13:41:24 $
+ * $Revision: 1.17 $
+ * $Date: 1999/11/09 00:40:11 $
  * ------------------------------------------------------------------------*/
 
 #include <setjmp.h>
@@ -1724,7 +1724,10 @@ Text t; {
             List ms = cclass(cl).members;
             Printf(" where");
             do {
-                Type t = monotypeOf(name(hd(ms)).type);
+		Type t = name(hd(ms)).type;
+                if (isPolyType(t)) {
+		    t = monotypeOf(t);
+		}
                 Printf("\n  ");
                 printExp(stdout,hd(ms));
                 Printf(" :: ");
diff --git a/ghc/interpreter/static.c b/ghc/interpreter/static.c
index d195831..3313ad6 100644
--- a/ghc/interpreter/static.c
+++ b/ghc/interpreter/static.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: static.c,v $
- * $Revision: 1.14 $
- * $Date: 1999/10/29 11:41:05 $
+ * $Revision: 1.15 $
+ * $Date: 1999/11/09 00:40:12 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -952,8 +952,9 @@ Cell  cd; {                             /* definitions (w or w/o deriving) */
             con      = ty;
         }
 
-        if (nr2>0)                      /* Add rank 2 annotation           */
-            type = ap(RANK2,pair(mkInt(nr2),type));
+	if (nr2>0) {			/* Add rank 2 annotation	   */
+	    type = ap(RANK2,pair(mkInt(nr2-length(lps)),type));
+	}
 
         if (nonNull(evs)) {             /* Add existential annotation      */
             if (nonNull(derivs)) {
@@ -2544,6 +2545,28 @@ Inst in; {
         ERRMSG(line) "Illegal predicate in instance declaration"
         EEND;
     }
+
+    if (nonNull(cclass(inst(in).c).fds)) {
+        List fds = cclass(inst(in).c).fds;
+        for (; nonNull(fds); fds=tl(fds)) {
+            List as = otvars(inst(in).head, fst(hd(fds)));
+            List bs = otvars(inst(in).head, snd(hd(fds)));
+            if (!osubset(bs,as)) {
+		ERRMSG(inst(in).line)
+		   "Instance is more general than a dependency allows"
+		ETHEN
+		ERRTEXT "\n*** Instance         : "
+		ETHEN ERRPRED(inst(in).head);
+		ERRTEXT "\n*** For class        : "
+		ETHEN ERRPRED(cclass(inst(in).c).head);
+		ERRTEXT "\n*** Under dependency : "
+		ETHEN ERRFD(hd(fds));
+		ERRTEXT "\n"
+		EEND;
+            }
+        }
+    }
+
     kindInst(in,length(tyvars));
     insertInst(in);
 
@@ -2883,6 +2906,7 @@ Inst in; {                              /* of the context for a derived    */
     List spcs   = fst(snd(inst(in).specifics));
     Int  beta   = inst(in).numSpecifics;
     Int  its    = 1;
+    Int  factor = 1+length(ps);
 
 #ifdef DEBUG_DERIVING
     Printf("calcInstPreds: ");
@@ -2893,7 +2917,7 @@ Inst in; {                              /* of the context for a derived    */
     while (nonNull(ps)) {
         Cell p = hd(ps);
         ps     = tl(ps);
-	if (its++ >= cutoff) {
+	if (its++ >= factor*cutoff) {
 	    Cell bpi = inst(in).head;
 	    Cell pi  = copyPred(fun(p),intOf(snd(p)));
 	    ERRMSG(inst(in).line) "\n*** Cannot derive " ETHEN ERRPRED(bpi);
-- 
1.7.10.4