From: sewardj <unknown>
Date: Thu, 3 Feb 2000 15:56:13 +0000 (+0000)
Subject: [project @ 2000-02-03 15:56:13 by sewardj]
X-Git-Tag: Approximately_9120_patches~5159
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=10aa06e429e216eec97d3d7e7be468c1643309c3;p=ghc-hetmet.git

[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
--- 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
--- 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    */