[project @ 2000-05-31 10:13:57 by lewie]
[ghc-hetmet.git] / ghc / interpreter / stg.c
index 78c60bd..08defee 100644 (file)
@@ -9,16 +9,16 @@
  * included in the distribution.
  *
  * $RCSfile: stg.c,v $
- * $Revision: 1.11 $
- * $Date: 2000/02/15 13:16:20 $
+ * $Revision: 1.16 $
+ * $Date: 2000/04/27 16:35:29 $
  * ------------------------------------------------------------------------*/
 
-#include "prelude.h"
+#include "hugsbasictypes.h"
 #include "storage.h"
-#include "backend.h"
 #include "connect.h"
 #include "errors.h"
-#include "link.h"      /* for nameTrue/False     */
+
+#include "Rts.h"       /* to make StgPtr visible in Assembler.h */
 #include "Assembler.h" /* for AsmRep and primops */
 
 /* --------------------------------------------------------------------------
@@ -138,7 +138,7 @@ StgRhs e; {
     case BIGCELL:
     case FLOATCELL:
     case STRCELL:
-    case PTRCELL:
+    case ADDRCELL:
             return TRUE;
     default:
             return FALSE;
@@ -159,17 +159,16 @@ StgVar mkStgVar( StgRhs rhs, Cell info )
  * Local functions
  * ------------------------------------------------------------------------*/
 
-static Void local pIndent        Args((Int));
-
-static Void local putStgVar       Args((StgVar));
-static Void local putStgVars      Args((List));
-static Void local putStgAtom      Args((StgAtom a));
-static Void local putStgAtoms     Args((List as));
-static Void local putStgBinds     Args((List));
-static Void local putStgExpr      Args((StgExpr));
-static Void local putStgRhs       Args((StgRhs));
-static Void local putStgPat       Args((StgCaseAlt));
-static Void local putStgPrimPat   Args((StgPrimAlt));
+static Void local pIndent         ( Int );
+static Void local putStgVar       ( StgVar );
+static Void local putStgVars      ( List );
+static Void local putStgAtom      ( StgAtom a );
+static Void local putStgAtoms     ( List as );
+static Void local putStgBinds     ( List );
+static Void local putStgExpr      ( StgExpr );
+static Void local putStgRhs       ( StgRhs );
+static Void local putStgPat       ( StgCaseAlt );
+static Void local putStgPrimPat   ( StgPrimAlt );
 
 
 
@@ -194,6 +193,10 @@ static Void putStgAlts    ( Int left, List alts );
 
 static Void local putStgVar(StgVar v) 
 {
+    if (isTuple(v)) {
+       putStr("Tuple");
+       putInt(tupleOf(v));
+    } else
     if (isName(v)) {
         unlexVar(name(v).text);
     } else {
@@ -244,8 +247,8 @@ static Void local putStgAtom( StgAtom a )
     case STRCELL: 
             unlexStrConst(textOf(a));
             break;
-    case PTRCELL: 
-            putPtr(ptrOf(a));
+    case ADDRCELL: 
+            putPtr(addrOf(a));
             putChr('#');
             break;
     case LETREC: case LAMBDA: case CASE: case PRIMCASE: 
@@ -405,7 +408,10 @@ static Void putStgPrimAlts( Int left, List alts )
 
 Void putStgExpr( StgExpr e )                        /* pretty print expr */
 {
-    if (isNull(e)) putStr("(putStgExpr:NIL)");else
+    if (isNull(e)) {
+       putStr("(putStgExpr:NIL)");
+       return;
+    }
 
     switch (whatIs(e)) {
     case LETREC: 
@@ -474,6 +480,7 @@ Void putStgExpr( StgExpr e )                        /* pretty print expr */
             break;
     case STGVAR: 
     case NAME: 
+    case TUPLE:
             putStgVar(e);
             break;
     case CHARCELL: 
@@ -481,7 +488,7 @@ Void putStgExpr( StgExpr e )                        /* pretty print expr */
     case BIGCELL: 
     case FLOATCELL: 
     case STRCELL: 
-    case PTRCELL: 
+    case ADDRCELL: 
             putStgAtom(e);
             break;
     case AP:
@@ -544,7 +551,7 @@ StgVar b;
 {
     Name   n;
     beginStgPP(fp);
-    n = nameFromStgVar(b);
+    n = NIL; /* nameFromStgVar(b); */
     if (nonNull(n)) {
        putStr(textToStr(name(n).text));
     } else {
@@ -556,7 +563,6 @@ StgVar b;
     endStgPP(fp);
 }
 
-#if 1 /*DEBUG_PRINTER*/
 Void ppStg( StgVar v )
 {
    printStg(stdout,v);
@@ -598,6 +604,5 @@ extern Void ppStgVars( List vs )
    printf("\n");
    endStgPP(stdout);
 }
-#endif
 
 /*-------------------------------------------------------------------------*/