From 1aad16b632df54fa4c430b6abf8c76fe257122b7 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Wed, 5 Jan 2000 15:57:41 +0000
Subject: [PATCH] [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.
---
ghc/interpreter/interface.c | 15 ++++++++++++---
ghc/interpreter/storage.c | 21 +++++++++++++++------
2 files changed, 27 insertions(+), 9 deletions(-)
diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index 6d07a34e13c3..4245ff415e4a 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.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 44d464d52f65..bc7c877c9497 100644
--- 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);
--
GitLab