[project @ 1999-03-09 14:51:03 by sewardj]

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

diff --git a/ghc/interpreter/optimise.c b/ghc/interpreter/optimise.c
index f16d284..a891389 100644 (file)
--- a/ghc/interpreter/optimise.c
+++ b/ghc/interpreter/optimise.c
@@ -1,4 +1,4 @@
-/* -*- mode: hugs-c; -*- */
+
 /* --------------------------------------------------------------------------
  * Optimiser
  *
@@ -7,16 +7,15 @@
  * Hugs version 1.4, December 1997
  *
  * $RCSfile: optimise.c,v $
- * $Revision: 1.2 $
- * $Date: 1998/12/02 13:22:23 $
+ * $Revision: 1.4 $
+ * $Date: 1999/03/09 14:51:09 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
 #include "storage.h"
+#include "backend.h"
 #include "connect.h"
 #include "errors.h"
-#include "stg.h"
-#include "optimise.h"
 
 /* --------------------------------------------------------------------------
  * Local functions
@@ -46,9 +45,11 @@ static StgAtom optimiseAtom(StgAtom a)
 static StgVar optimiseVar(StgVar v)
 {
     StgRhs rhs = stgVarBody(v);
-    /* short circuit: let x = y in ...x... --> let x = y ...y... */
+fprintf(stderr,"optimiseVar ");printStg(stderr,v);fprintf(stderr,"\n");
+    /* short circuit: let x = y in ...x... --> let x = y in ...y... */
     if (whatIs(rhs) == STGVAR && rhs != v) {
        StgVar v1 = rhs;
+fprintf(stderr, "dumpable\n");
 
        /* find last variable in chain */
        rhs = stgVarBody(v1);
@@ -76,7 +77,8 @@ static StgVar optimiseVar(StgVar v)
 
 void optimiseBind( StgVar v )
 {
-    StgRhs rhs = stgVarBody(v);
+    StgRhs rhs;
+    rhs = stgVarBody(v);
     switch (whatIs(rhs)) {
     case STGCON:
             mapOver(optimiseAtom,stgConArgs(rhs));
@@ -123,7 +125,9 @@ static StgExpr optimiseExpr( StgExpr e )
                         * by optimiseVar so we can drop the binding
                         * right now.
                         */
+fprintf(stderr, "dropping bind ");printStg(stderr,b);fprintf(stderr, "\n");
                    } else {
+fprintf(stderr, "retaining bind ");printStg(stderr,b);fprintf(stderr, "\n");
                        binds = cons(hd(bs),binds);
                    }
                }
@@ -211,4 +215,22 @@ static StgExpr optimiseExpr( StgExpr e )
     return e;
 }
 
+
+void optimiseTopBind( StgVar v )
+{
+if (lastModule() != modulePrelude) {
+fflush(stdout); fflush(stderr);
+fprintf ( stderr, "------------------------------\n" );
+fflush(stderr);
+printStg ( stderr, v );
+fprintf(stderr, "\n" );
+}
+optimiseBind ( v );
+if (lastModule() != modulePrelude) {
+printStg ( stderr,v );
+fprintf(stderr, "\n\n" );
+fflush(stderr);
+}
+}
+
 /*-------------------------------------------------------------------------*/