[project @ 2000-01-11 14:51:43 by sewardj]

[ghc-hetmet.git] / ghc / interpreter / storage.c

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index f4380ed..9fa88dd 100644 (file)
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.28 $
- * $Date: 1999/12/20 16:55:27 $
+ * $Revision: 1.37 $
+ * $Date: 2000/01/11 14:51:43 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -488,7 +488,9 @@ Text t; {
 
 Tycon addTycon(tc)  /* Insert Tycon in tycon table - if no clash is caused */
 Tycon tc; {
-    Tycon oldtc = findTycon(tycon(tc).text);
+    Tycon oldtc; 
+    assert(whatIs(tc)==TYCON || whatIs(tc)==TUPLE);
+    oldtc = findTycon(tycon(tc).text);
     if (isNull(oldtc)) {
         hashTycon(tc);
         module(currentModule).tycons=cons(tc,module(currentModule).tycons);
@@ -499,7 +501,10 @@ Tycon tc; {
 
 static Void local hashTycon(tc)         /* Insert Tycon into hash table    */
 Tycon tc; {
-   assert(isTycon(tc) || isTuple(tc));
+  if (!(isTycon(tc) || isTuple(tc))) {
+    printf("\nbad stuff: " ); print(tc,10); printf("\n");
+      assert(isTycon(tc) || isTuple(tc));
+  }
    if (1) {
      Text  t = tycon(tc).text;
      Int   h = tHash(t);
@@ -668,7 +673,9 @@ Text t; {
 
 Name addName(nm)                        /* Insert Name in name table - if  */
 Name nm; {                              /* no clash is caused              */
-    Name oldnm = findName(name(nm).text);
+    Name oldnm; 
+    assert(whatIs(nm)==NAME);
+    oldnm = findName(name(nm).text);
     if (isNull(oldnm)) {
         hashName(nm);
         module(currentModule).names=cons(nm,module(currentModule).names);
@@ -796,10 +803,11 @@ Name addWiredInBoxingTycon
 
 Tycon addTupleTycon ( Int n )
 {
-   Int   i;
-   Kind  k;
-   Tycon t;
+   Int    i;
+   Kind   k;
+   Tycon  t;
    Module m;
+   Name   nm;
 
    for (i = TYCMIN; i < tyconHw; i++)
       if (tycon(i).tuple == n) return i;
@@ -815,6 +823,13 @@ Tycon addTupleTycon ( Int n )
    tycon(t).kind  = k;
    tycon(t).tuple = n;
    tycon(t).what  = DATATYPE;
+
+   if (n == 0) {
+      /* maybe we want to do this for all n ? */
+      nm = newName(ghcTupleText_n(n), t);
+      name(nm).type = t;   /* ummm ... for n > 0 */
+   }
+
    return t;
 }
 
@@ -1047,7 +1062,9 @@ Text t; {
 
 Class addClass(c)                       /* Insert Class in class list      */
 Class c; {                              /*  - if no clash caused           */
-    Class oldc = findClass(cclass(c).text);
+    Class oldc; 
+    assert(whatIs(c)==CLASS);
+    oldc = findClass(cclass(c).text);
     if (isNull(oldc)) {
         classes=cons(c,classes);
         module(currentModule).classes=cons(c,module(currentModule).classes);
@@ -1192,6 +1209,29 @@ Tycon findQualTyconWithoutConsultingExportList ( QualId q )
    return NIL;
 }
 
+Tycon findTyconInAnyModule ( Text t )
+{
+   Tycon tc;
+   for (tc = TYCMIN; tc < tyconHw; tc++)
+      if (tycon(tc).text == t) return tc;
+   return NIL;
+}
+
+Class findClassInAnyModule ( Text t )
+{
+   Class cc;
+   for (cc = CLASSMIN; cc < classHw; cc++)
+      if (cclass(cc).text == t) return cc;
+   return NIL;
+}
+
+Name findNameInAnyModule ( Text t )
+{
+   Name nm;
+   for (nm = NAMEMIN; nm < nameHw; nm++)
+      if (name(nm).text == t) return nm;
+   return NIL;
+}
 
 /* Same deal, except for Names. */
 Name findQualNameWithoutConsultingExportList ( QualId q )
@@ -1429,8 +1469,10 @@ char* nameFromOPtr ( void* p )
    int i;
    Module m;
    for (m=MODMIN; m<moduleHw; m++) {
-      char* nm = ocLookupAddr ( module(m).object, p );
-      if (nm) return nm;
+      if (module(m).object) {
+         char* nm = ocLookupAddr ( module(m).object, p );
+         if (nm) return nm;
+      }
    }
    return NULL;
 }
@@ -1458,13 +1500,22 @@ void* lookupOExtraTabName ( char* sym )
 
 OSectionKind lookupSection ( void* ad )
 {
-   int i;
-   Module m;
+   int          i;
+   Module       m;
+   ObjectCode*  oc;
+   OSectionKind sect;
+
    for (m=MODMIN; m<moduleHw; m++) {
-      OSectionKind sect
-         = ocLookupSection ( module(m).object, ad );
-      if (sect != HUGS_SECTIONKIND_NOINFOAVAIL)
-         return sect;
+      if (module(m).object) {
+         sect = ocLookupSection ( module(m).object, ad );
+         if (sect != HUGS_SECTIONKIND_NOINFOAVAIL)
+            return sect;
+      }
+      for (oc = module(m).objectExtras; oc; oc=oc->next) {
+         sect = ocLookupSection ( oc, ad );
+         if (sect != HUGS_SECTIONKIND_NOINFOAVAIL)
+            return sect;
+      }
    }
    return HUGS_SECTIONKIND_OTHER;
 }