[project @ 2000-03-06 08:38:04 by andy]

Adding the Feb00 changed from Classic Hugs into STG Hugs.

diff --git a/ghc/interpreter/preds.c b/ghc/interpreter/preds.c
index c41ed5c..5da4940 100644 (file)
--- a/ghc/interpreter/preds.c
+++ b/ghc/interpreter/preds.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: preds.c,v $
- * $Revision: 1.9 $
- * $Date: 1999/11/17 16:57:43 $
+ * $Revision: 1.10 $
+ * $Date: 2000/03/06 08:38:04 $
  * ------------------------------------------------------------------------*/
 
 /* --------------------------------------------------------------------------
@@ -448,24 +448,25 @@ Int  d; {
     if (nonNull(in)) {
         Int  beta = typeOff;
         Cell e    = inst(in).builder;
-        Cell es   = inst(in).specifics;
+       List es   = inst(in).specifics;
+       List fs   = NIL;
+       for (; nonNull(es); es=tl(es))
+           fs = cons(triple(hd(es),mkInt(beta),NIL),fs);
+       fs = rev(fs);
+       improve(0,ps,fs);
 #if EXPLAIN_INSTANCE_RESOLUTION
        if (showInstRes) {
            for (i = 0; i < d; i++)
              fputc(' ', stdout);
            fputs("try ", stdout);
-           printContext(stdout, es);
+           printContext(stdout, copyPreds(fs));
            fputs(" => ", stdout);
-           printPred(stdout, inst(in).head);
+           printPred(stdout, copyPred(inst(in).head,beta));
            fputc('\n', stdout);
        }
 #endif
-       /* would need to lift es to triples, so be lazy, and just
-          use improve1 in the loop */
-       /* improve(0,ps,es); */
-       for (; nonNull(es); es=tl(es)) {
+       for (es=inst(in).specifics; nonNull(es); es=tl(es)) {
            Cell ev;
-           improve1(0,ps,hd(es),beta);
            ev = entail(ps,hd(es),beta,d);
             if (nonNull(ev))
                 e = ap(e,ev);
@@ -827,7 +828,10 @@ List sps; {                             /* context ps.  sps = savePreds.   */
 
        if (nonNull(ev)) {              /* Discharge if ps ||- (pi,o)      */
             overEvid(thd3(hd(p)),ev);
-       } else if (!isAp(pi) || isIP(fun(pi)) || !anyGenerics(pi,o)) {
+       } else if (isIP(fun(pi))) {
+           tl(p) = rems;
+           rems  = p;
+       } else if (!isAp(pi) || !anyGenerics(pi,o)) {
            tl(p) = sps;                /* Defer if no generics            */
             sps   = p;
         }

diff --git a/ghc/interpreter/static.c b/ghc/interpreter/static.c
index adbe90d..46af0ac 100644 (file)
--- a/ghc/interpreter/static.c
+++ b/ghc/interpreter/static.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: static.c,v $
- * $Revision: 1.23 $
- * $Date: 2000/02/04 13:41:00 $
+ * $Revision: 1.24 $
+ * $Date: 2000/03/06 08:38:04 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -3027,7 +3027,6 @@ Inst in; {                              /* of the context for a derived    */
         ps     = tl(ps);
        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);
            ERRTEXT " after %d iterations.", its-1   ETHEN
            ERRTEXT
@@ -5037,15 +5036,23 @@ Void checkDefns() {                     /* Top level static analysis       */
     }
     mapProc(checkImportList, unqualImports);
 
+    /* Note: there's a lot of side-effecting going on here, so
+       don't monkey about with the order of operations here unless
+       you know what you are doing */
     if (!combined) linkPreludeTC();     /* Get prelude tycons and classes  */
 
     mapProc(checkTyconDefn,tyconDefns); /* validate tycon definitions      */
     checkSynonyms(tyconDefns);          /* check synonym definitions       */
     mapProc(checkClassDefn,classDefns); /* process class definitions       */
     mapProc(kindTCGroup,tcscc(tyconDefns,classDefns)); /* attach kinds     */
+    mapProc(visitClass,classDefns);    /* check class hierarchy           */
     mapProc(extendFundeps,classDefns);  /* finish class definitions       */
+                                       /* (convenient if we do this after */
+                                       /* calling `visitClass' so that we */
+                                       /* know the class hierarchy is     */
+                                       /* acyclic)                        */
+
     mapProc(addMembers,classDefns);     /* add definitions for member funs */
-    mapProc(visitClass,classDefns);     /* check class hierarchy           */
 
     if (!combined) linkPreludeCM();     /* Get prelude cfuns and mfuns     */
     

diff --git a/ghc/interpreter/subst.c b/ghc/interpreter/subst.c
index 4ca1715..3ca1ed4 100644 (file)
--- a/ghc/interpreter/subst.c
+++ b/ghc/interpreter/subst.c
@@ -10,8 +10,8 @@
  * included in the distribution.
  *
  * $RCSfile: subst.c,v $
- * $Revision: 1.10 $
- * $Date: 1999/12/10 15:59:55 $
+ * $Revision: 1.11 $
+ * $Date: 2000/03/06 08:38:04 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -1530,6 +1530,8 @@ Int o; {
     }
     return improved;
 }
+/* should emulate findInsts behavior of shorting out if the
+   predicate would match a more general signature... */
 
 Bool instImprove(line,c,pi,o)
 Int line;

diff --git a/ghc/interpreter/type.c b/ghc/interpreter/type.c
index c46657b..fec44e1 100644 (file)
--- a/ghc/interpreter/type.c
+++ b/ghc/interpreter/type.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: type.c,v $
- * $Revision: 1.23 $
- * $Date: 2000/02/03 13:55:22 $
+ * $Revision: 1.24 $
+ * $Date: 2000/03/06 08:38:05 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -1114,15 +1114,18 @@ Cell e;
 List qs; {
     static String boolQual = "boolean qualifier";
     static String genQual  = "generator";
+#if IPARAM
+    List svPreds;
+#endif
 
     STACK_CHECK
-    if (isNull(qs))                     /* no qualifiers left              */
-        fst(e) = typeExpr(l,fst(e));
-    else {
+    if (isNull(qs)) {                  /* no qualifiers left              */
+       spTypeExpr(l,fst(e));
+    } else {
         Cell q   = hd(qs);
         List qs1 = tl(qs);
         switch (whatIs(q)) {
-            case BOOLQUAL : check(l,snd(q),NIL,boolQual,typeBool,0);
+           case BOOLQUAL : spCheck(l,snd(q),NIL,boolQual,typeBool,0);
                             typeComp(l,m,e,qs1);
                             break;
 
@@ -1136,7 +1139,7 @@ List qs; {
 
             case FROMQUAL : {   Int beta = newTyvars(1);
                                 saveVarsAss();
-                                check(l,snd(snd(q)),NIL,genQual,m,beta);
+                               spCheck(l,snd(snd(q)),NIL,genQual,m,beta);
                                 enterSkolVars();
                                 fst(snd(q))
                                     = typeFreshPat(l,patBtyvs(fst(snd(q))));
@@ -1148,7 +1151,7 @@ List qs; {
                             }
                             break;
 
-            case DOQUAL   : check(l,snd(q),NIL,genQual,m,newTyvars(1));
+           case DOQUAL   : spCheck(l,snd(q),NIL,genQual,m,newTyvars(1));
                             typeComp(l,m,e,qs1);
                             break;
         }
@@ -1199,6 +1202,9 @@ Cell e; {
     Int  to;
     Int  tf;
     Int  i;
+#if IPARAM
+    List svPreds;
+#endif
 
     instantiate(name(c).type);
     for (; nonNull(predsAre); predsAre=tl(predsAre))
@@ -1217,7 +1223,7 @@ Cell e; {
        if (isPolyOrQualType(t))
             snd(hd(fs)) = typeExpected(l,conExpr,snd(hd(fs)),t,to,tf,TRUE);
         else {
-            check(l,snd(hd(fs)),e,conExpr,t,to);
+           spCheck(l,snd(hd(fs)),e,conExpr,t,to);
         }
     }
     for (i=name(c).arity; i>0; i--)
@@ -1236,10 +1242,13 @@ Cell e; {                               /* bizarre manner for the benefit  */
     Int  alpha = newTyvars(2+n);
     Int  i;
     List fs1;
+#if IPARAM
+    List svPreds;
+#endif
 
     /* Calculate type and translation for each expr in the field list      */
     for (fs1=fs, i=alpha+2; nonNull(fs1); fs1=tl(fs1), i++) {
-        snd(hd(fs1)) = typeExpr(line,snd(hd(fs1)));
+       spTypeExpr(line,snd(hd(fs1)));
         bindTv(i,typeIs,typeOff);
     }
 
@@ -1256,7 +1265,7 @@ Cell e; {                               /* bizarre manner for the benefit  */
     ts = rev(ts);
 
     /* Type check expression to be updated                                 */
-    fst3(snd(e)) = typeExpr(line,fst3(snd(e)));
+    spTypeExpr(line,fst3(snd(e)));
     bindTv(alpha,typeIs,typeOff);
 
     for (; nonNull(cs); cs=tl(cs)) {    /* Loop through constrs            */
@@ -1861,8 +1870,11 @@ Inst in; {                              /* member functions for instance in*/
     Int  beta    = newKindedVars(inst(in).kinds);
     List params  = makePredAss(inst(in).specifics,beta);
     Cell d       = inventDictVar();
+    /*
     List evids   = cons(triple(inst(in).head,mkInt(beta),d),
                         appendOnto(dupList(params),supers));
+    */
+    List evids   = dupList(params);
 
     List imps    = inst(in).implements;
     Cell l       = mkInt(inst(in).line);
@@ -2158,10 +2170,13 @@ Cell gded; {                           /*             ex :: (var,beta)     */
     static String guarded = "guarded expression";
     static String guard   = "guard";
     Int line = intOf(fst(gded));
+#if IPARAM
+    List svPreds;
+#endif
 
     gded     = snd(gded);
-    check(line,fst(gded),NIL,guard,typeBool,0);
-    check(line,snd(gded),NIL,guarded,aVar,beta);
+    spCheck(line,fst(gded),NIL,guard,typeBool,0);
+    spCheck(line,snd(gded),NIL,guarded,aVar,beta);
 }
 
 Cell rhsExpr(rhs)                      /* find first expression on a rhs   */

diff --git a/ghc/interpreter/version.h b/ghc/interpreter/version.h
index ee04810..60e874a 100644 (file)
--- a/ghc/interpreter/version.h
+++ b/ghc/interpreter/version.h
@@ -11,8 +11,8 @@
 #define MAJOR_RELEASE 0
 
 #if MAJOR_RELEASE
-#define HUGS_VERSION "November 1999 "
+#define HUGS_VERSION "March 2000    "
 #else
-#define HUGS_VERSION "STGHugs-991129"
+#define HUGS_VERSION "STGHugs-000306"
 #endif