X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fstg.c;h=78c60bd17bbaddaa2e7699a1f3761fe8ab0bf455;hb=3cb2eab4d6617c9fa43eccf2d9eb3ea0c80a18ee;hp=742fe27052c2349ce1dd5624404337262f540b5b;hpb=8aaa69d48f3d866727620c7d7e3a663dde3fb02a;p=ghc-hetmet.git

diff --git a/ghc/interpreter/stg.c b/ghc/interpreter/stg.c
index 742fe27..78c60bd 100644
--- a/ghc/interpreter/stg.c
+++ b/ghc/interpreter/stg.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: stg.c,v $
- * $Revision: 1.8 $
- * $Date: 1999/11/12 17:32:45 $
+ * $Revision: 1.11 $
+ * $Date: 2000/02/15 13:16:20 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -25,28 +25,40 @@
  * Utility functions
  * ------------------------------------------------------------------------*/
 
-void* stgConInfo( StgDiscr d )
+/* Make an info table for a constructor or tuple. */
+void* stgConInfo ( StgDiscr d )
 {
+    int tag;
     switch (whatIs(d)) {
-    case NAME:
-            return asmMkInfo(cfunOf(d),name(d).arity);
-    case TUPLE: 
-            return asmMkInfo(0,tupleOf(d));
-    default: 
-            internal("stgConInfo");
+       case NAME: {
+          tag = cfunOf(d);
+          if (tag > 0) tag--;
+          if (!name(d).itbl)
+             name(d).itbl = asmMkInfo(tag,name(d).arity);
+          return name(d).itbl;
+       }
+       case TUPLE: {
+          tag = 0;
+          if (!tycon(d).itbl)
+             tycon(d).itbl = asmMkInfo(tag,tupleOf(d));
+          return tycon(d).itbl;
+       }
+       default: 
+          internal("stgConInfo");
     }
 }
 
-int stgDiscrTag( StgDiscr d )
+/* Return the tag for a constructor or tuple, starting at zero. */
+int stgDiscrTag ( StgDiscr d )
 {
+    int tag;
     switch (whatIs(d)) {
-    case NAME:
-            return cfunOf(d);
-    case TUPLE: 
-            return 0;
-    default: 
-            internal("stgDiscrTag");
+       case NAME:  tag = cfunOf(d); break;
+       case TUPLE: tag = 0;
+       default:    internal("stgDiscrTag");   
     }
+    if (tag > 0) tag--;
+    return tag;
 }
 
 /* --------------------------------------------------------------------------
@@ -449,7 +461,7 @@ Void putStgExpr( StgExpr e )                        /* pretty print expr */
     case STGPRIM: 
         {
             Cell op = stgPrimOp(e);
-            unlexVar(name(op).text);
+            unlexVarStr(asmGetPrimopName(name(op).primop));
             putStgAtoms(stgPrimArgs(e));
             break;
         }