[project @ 2000-01-10 17:19:32 by sewardj]

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

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index d18eabf..6ec7514 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.32 $
- * $Date: 2000/01/07 16:56:47 $
+ * $Revision: 1.36 $
+ * $Date: 2000/01/10 17:19:32 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -803,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;
@@ -822,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;
 }
 
@@ -1201,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 )