[project @ 2000-02-08 17:50:46 by sewardj]

-- finishGHCClass(): fill in the .number fields for members in the
   correct order.
-- Let nullary constructors be called via their _closure labels so they
   don't get heap-allocated.

diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index 993e640..cf4e399 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.28 $
- * $Date: 2000/02/08 15:32:30 $
+ * $Revision: 1.29 $
+ * $Date: 2000/02/08 17:50:46 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -566,7 +566,6 @@ static void* ifFindItblFor ( Name n )
    t = enZcodeThenFindText(buf);
    p = lookupOTabName ( name(n).mod, textToStr(t) );
 
-if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t));
    if (p) return p;
 
    if (name(n).arity == 0) {
@@ -575,7 +574,6 @@ if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t));
                      textToStr( name(n).text ) );
       t = enZcodeThenFindText(buf);
       p = lookupOTabName ( name(n).mod, textToStr(t) );
-if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t));
       if (p) return p;
    }
 
@@ -587,11 +585,14 @@ if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t));
 void ifLinkConstrItbl ( Name n )
 {
    /* name(n) is either a constructor or a field name.  
-      If the latter, ignore it.  Otherwise, find its info table
-      in the object code.
+      If the latter, ignore it.  If it is a non-nullary constructor,
+      find its info table in the object code.  If it's nullary,
+      we can skip the info table, since all accesses will go via
+      the _closure label.
    */
-   if (!islower(textToStr(name(n).text)[0]))
-      name(n).itbl = ifFindItblFor(n);
+   if (islower(textToStr(name(n).text)[0])) return;
+   if (name(n).arity == 0) return;
+   name(n).itbl = ifFindItblFor(n);
 }
 
 
@@ -1971,7 +1972,7 @@ static Class finishGHCClass ( Tycon cls_tyc )
     if (isNull(nw)) internal("finishGHCClass");
 
     line = cclass(nw).line;
-    ctr  = - length(cclass(nw).members);
+    ctr = -2;
     assert (currentModule == cclass(nw).mod);
 
     cclass(nw).level   = 0;
@@ -1986,10 +1987,9 @@ static Class finishGHCClass ( Tycon cls_tyc )
        Name n   = findName(txt);
        assert(nonNull(n));
        name(n).text   = txt;
-fprintf(stderr, "TEXT IS `%s'\n", textToStr(name(n).text));
        name(n).line   = cclass(nw).line;
        name(n).type   = ty;
-       name(n).number = ctr++;
+       name(n).number = ctr--;
        name(n).arity  = arityInclDictParams(name(n).type);
        name(n).parent = nw;
        hd(mems) = n;
@@ -2063,7 +2063,6 @@ VarId var; {   /* VarId */
 
     {
         Name b         = newName( /*inventText()*/ textOf(var),NIL);
-fprintf(stderr, "DICTIONARY NAME `%s'\n", textToStr(textOf(var)) );
         name(b).line   = line;
         name(b).arity  = length(spec); /* unused? */ /* and surely wrong */
         name(b).number = DFUNNAME;

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index bb42e1c..f107aa7 100644 (file)
--- a/ghc/interpreter/link.c
+++ b/ghc/interpreter/link.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: link.c,v $
- * $Revision: 1.40 $
- * $Date: 2000/02/08 15:32:30 $
+ * $Revision: 1.41 $
+ * $Date: 2000/02/08 17:50:46 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -530,7 +530,7 @@ assert(nonNull(namePMFail));
 
 
                /* pmc                                   */
-               xyzzy(nameSel,            "_SEL");
+               pFun(nameSel,            "_SEL");
 
                /* strict constructors                   */
                xyzzy(nameFlip,           "flip"     );

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 193613e..39558ff 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.41 $
- * $Date: 2000/02/08 15:32:30 $
+ * $Revision: 1.42 $
+ * $Date: 2000/02/08 17:50:46 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -2942,6 +2942,11 @@ static String maybeTyconStr ( Tycon t )
    if (isTycon(t)) return textToStr(tycon(t).text); else return "??";
 }
 
+static String maybeClassStr ( Class c )
+{
+   if (isClass(c)) return textToStr(cclass(c).text); else return "??";
+}
+
 static String maybeText ( Text t )
 {
    if (isNull(t)) return "(nil)";
@@ -2963,8 +2968,7 @@ void dumpTycon ( Int t )
    printf ( "{\n" );
    printf ( "    text: %s\n",     textToStr(tycon(t).text) );
    printf ( "    line: %d\n",     tycon(t).line );
-   printf ( "     mod: %d %s\n",  tycon(t).mod, 
-                                  maybeModuleStr(tycon(t).mod));
+   printf ( "     mod: %s\n",     maybeModuleStr(tycon(t).mod));
    printf ( "   tuple: %d\n",     tycon(t).tuple);
    printf ( "   arity: %d\n",     tycon(t).arity);
    printf ( "    kind: ");        print100(tycon(t).kind);
@@ -2990,8 +2994,7 @@ void dumpName ( Int n )
    printf ( "{\n" );
    printf ( "    text: %s\n",     textToStr(name(n).text) );
    printf ( "    line: %d\n",     name(n).line );
-   printf ( "     mod: %d %s\n",  name(n).mod, 
-                                  maybeModuleStr(name(n).mod));
+   printf ( "     mod: %s\n",     maybeModuleStr(name(n).mod));
    printf ( "  syntax: %d\n",     name(n).syntax );
    printf ( "  parent: %d\n",     name(n).parent );
    printf ( "   arity: %d\n",     name(n).arity );
@@ -3017,8 +3020,7 @@ void dumpClass ( Int c )
    printf ( "{\n" );
    printf ( "    text: %s\n",     textToStr(cclass(c).text) );
    printf ( "    line: %d\n",     cclass(c).line );
-   printf ( "     mod: %d %s\n",  cclass(c).mod, 
-                                  maybeModuleStr(cclass(c).mod));
+   printf ( "     mod: %s\n",     maybeModuleStr(cclass(c).mod));
    printf ( "   arity: %d\n",     cclass(c).arity );
    printf ( "   level: %d\n",     cclass(c).level );
    printf ( "   kinds: ");        print100( cclass(c).kinds );
@@ -3045,7 +3047,15 @@ void dumpInst ( Int i )
       return;
    }
    printf ( "{\n" );
-//   printf ( "    text: %s\n",     textToStr(cclass(c)).text) );
+   printf ( "   class: %s\n",     maybeClassStr(inst(i).c) );
+   printf ( "    line: %d\n",     inst(i).line );
+   printf ( "     mod: %s\n",     maybeModuleStr(inst(i).mod));
+   printf ( "   kinds: ");        print100( inst(i).kinds );
+   printf ( "    head: ");        print100( inst(i).head );
+   printf ( "   specs: ");        print100( inst(i).specifics );
+   printf ( "  #specs: %d\n",     inst(i).numSpecifics );
+   printf ( "   impls: ");        print100( inst(i).implements );
+   printf ( " builder: %s\n",     maybeNameStr( inst(i).builder ) );
    printf ( "}\n" );
 }