[project @ 2000-01-05 15:57:40 by sewardj]

Remember to add entities to module(m).names/.tycons/.classes as well as
to module(m).exports.  Otherwise the 'eval environment' will be wrong.

Add assertions in storage.c for addName/addTycon/addClass.

diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index 6d07a34..4245ff4 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.15 $
- * $Date: 2000/01/05 13:53:36 $
+ * $Revision: 1.16 $
+ * $Date: 2000/01/05 15:57:40 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -1092,6 +1092,7 @@ Void finishGHCModule ( Cell root )
                if (isNull(c)) goto notfound;
                fprintf(stderr, "   var %s\n", textToStr(textOf(ex)) );
                module(mod).exports = cons(c, module(mod).exports);
+               addName(c);
                break;
 
             case CONIDCELL: /* non data tycon */
@@ -1100,6 +1101,7 @@ Void finishGHCModule ( Cell root )
                if (isNull(c)) goto notfound;
                fprintf(stderr, "   type %s\n", textToStr(textOf(ex)) );
                module(mod).exports = cons(c, module(mod).exports);
+               addTycon(c);
                break;
 
             case ZTUP2: /* data T = C1 ... Cn  or class C where f1 ... fn */
@@ -1119,10 +1121,12 @@ Void finishGHCModule ( Cell root )
                      original (defining) module.
                  */
                   if (abstract) {
-                     module(mod).exports = cons ( ex, module(mod).exports );
+                     module(mod).exports = cons(c, module(mod).exports);
+                     addTycon(c);
                      fprintf ( stderr, "(abstract) ");
                  } else {
                      module(mod).exports = cons(pair(c,DOTDOT), module(mod).exports);
+                     addTycon(c);
                      for (; nonNull(subents); subents = tl(subents)) {
                         Cell ent2 = hd(subents);
                         assert(isCon(ent2) || isVar(ent2)); 
@@ -1132,6 +1136,7 @@ Void finishGHCModule ( Cell root )
                         fprintf(stderr, "%s ", textToStr(name(c).text));
                         assert(nonNull(c));
                         module(mod).exports = cons(c, module(mod).exports);
+                        addName(c);
                      }
                   }
                   fprintf(stderr, "}\n" );
@@ -1141,6 +1146,7 @@ Void finishGHCModule ( Cell root )
                   if (isNull(c)) goto notfound;
                   fprintf(stderr, "   class %s { ", textToStr(textOf(ex)) );
                   module(mod).exports = cons(pair(c,DOTDOT), module(mod).exports);
+                  addClass(c);
                   for (; nonNull(subents); subents = tl(subents)) {
                      Cell ent2 = hd(subents);
                      assert(isVar(ent2));
@@ -1149,6 +1155,7 @@ Void finishGHCModule ( Cell root )
                      fprintf(stderr, "%s ", textToStr(name(c).text));
                      if (isNull(c)) goto notfound;
                      module(mod).exports = cons(c, module(mod).exports);
+                     addName(c);
                   }
                   fprintf(stderr, "}\n" );
                }
@@ -1169,6 +1176,7 @@ Void finishGHCModule ( Cell root )
       }
    }
 
+#if 0
    if (preludeLoaded) {
       /* do the implicit 'import Prelude' thing */
       List pxs = module(modulePrelude).exports;
@@ -1195,6 +1203,7 @@ Void finishGHCModule ( Cell root )
          }
       }
    }
+#endif
 
    /* Last, but by no means least ... */
    if (!ocResolve(module(mod).object,0||VERBOSE))

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 44d464d..bc7c877 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.29 $
- * $Date: 2000/01/05 13:53:37 $
+ * $Revision: 1.30 $
+ * $Date: 2000/01/05 15:57:41 $
  * ------------------------------------------------------------------------*/
 
 #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);
@@ -1047,7 +1054,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);