Commit 10aa06e4 authored by sewardj's avatar sewardj
Browse files

[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.
parent 4b29a7ee
......@@ -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;
}
......
......@@ -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 */
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment