[project @ 2000-02-03 15:56:13 by sewardj]

Remember all the classes loaded from an object file group, and
call visitClass on them at the end of processInterfaces(), so that
the .level numbers on the class get calculated.

diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index 0778639..ceefd4f 100644 (file)
--- a/ghc/interpreter/interface.c
+++ b/ghc/interpreter/interface.c
@@ -7,8 +7,8 @@
  * Hugs version 1.4, December 1997
  *
  * $RCSfile: interface.c,v $
- * $Revision: 1.25 $
- * $Date: 2000/01/11 14:56:07 $
+ * $Revision: 1.26 $
+ * $Date: 2000/02/03 15:56:13 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -127,8 +127,8 @@ static Void finishGHCValue      Args((VarId));
 static Void startGHCSynonym     Args((Int,Cell,List,Type));
 static Void finishGHCSynonym    Args((Tycon)); 
 
-static Void startGHCClass       Args((Int,List,Cell,List,List));
-static Void finishGHCClass      Args((Class)); 
+static Void  startGHCClass      Args((Int,List,Cell,List,List));
+static Class finishGHCClass     Args((Class)); 
 
 static Inst startGHCInstance    Args((Int,List,Pair,VarId));
 static Void finishGHCInstance   Args((Inst));
@@ -554,6 +554,7 @@ Bool processInterfaces ( void )
     List    all_known_types;
     Int     num_known_types;
     Bool    didPrelude;
+    List    cls_list;
 
     List ifaces       = NIL;  /* :: List I_INTERFACE */
     List iface_sizes  = NIL;  /* :: List Int         */
@@ -845,6 +846,7 @@ fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent)
        the export lists; those must wait for later.
     */
     didPrelude = FALSE;
+    cls_list   = NIL;
     for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
        iface   = unap(I_INTERFACE,hd(xs));
        mname   = textOf(zfst(iface));
@@ -888,8 +890,9 @@ fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent)
                 break;
              }
              case I_CLASS: {
-                Cell klass = unap(I_CLASS,decl);
-                finishGHCClass ( zsel35(klass) );
+                Cell  klass = unap(I_CLASS,decl);
+                Class cls   = finishGHCClass ( zsel35(klass) );
+                cls_list = cons(cls,cls_list);
                 break;
              }
              case I_VALUE: {
@@ -913,6 +916,8 @@ fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent)
     for (xs = ifaces; nonNull(xs); xs = tl(xs))
        finishGHCModule(hd(xs));
 
+    mapProc(visitClass,cls_list);
+
     /* Finished! */
     ifaces_outstanding = NIL;
 
@@ -1788,7 +1793,7 @@ List  mems0; {    /* [((VarId, Type))]     */
 }
 
 
-static Void finishGHCClass ( Tycon cls_tyc )
+static Class finishGHCClass ( Tycon cls_tyc )
 {
     List  mems;
     Int   line;
@@ -1820,6 +1825,8 @@ static Void finishGHCClass ( Tycon cls_tyc )
        name(n).arity  = arityInclDictParams(name(n).type);
        hd(mems) = n;
     }
+
+    return nw;
 }
 
 

diff --git a/ghc/interpreter/static.c b/ghc/interpreter/static.c
index dd7ee47..a8985ed 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.21 $
- * $Date: 2000/01/07 15:31:12 $
+ * $Revision: 1.22 $
+ * $Date: 2000/02/03 15:56:13 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -60,7 +60,7 @@ static Void   local addMembers          Args((Class));
 static Name   local newMember           Args((Int,Int,Cell,Type,Class));
 static Name   local newDSel             Args((Class,Int));
 static Text   local generateText        Args((String,Class));
-static Int    local visitClass          Args((Class));
+       Int          visitClass          Args((Class));
 
 static List   local classBindings       Args((String,Class,List));
 static Name   local memberName          Args((Class,Text));
@@ -1664,7 +1664,7 @@ Class  c; {                             /* to each class.                  */
     return findText(buffer);
 }
 
-static Int local visitClass(c)          /* visit class defn to check that  */
+       Int visitClass(c)                /* visit class defn to check that  */
 Class c; {                              /* class hierarchy is acyclic      */
 #if TREX
     if (isExt(c)) {                     /* special case for lacks preds    */