[project @ 2000-03-23 14:54:20 by sewardj]

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

diff --git a/ghc/interpreter/lift.c b/ghc/interpreter/lift.c
index 82544f4..b41d1f5 100644 (file)
--- a/ghc/interpreter/lift.c
+++ b/ghc/interpreter/lift.c
@@ -12,13 +12,12 @@
  * included in the distribution.
  *
  * $RCSfile: lift.c,v $
- * $Revision: 1.6 $
- * $Date: 1999/10/15 21:40:51 $
+ * $Revision: 1.13 $
+ * $Date: 2000/03/23 14:54:21 $
  * ------------------------------------------------------------------------*/
 
-#include "prelude.h"
+#include "hugsbasictypes.h"
 #include "storage.h"
-#include "backend.h"
 #include "connect.h"
 #include "errors.h"
 
@@ -67,19 +66,7 @@ static inline Bool isTopLevel( StgVar v )
     } else if (stgVarInfo(v) == NONE) {
         return TRUE;  /* those at top level are already there */
     } else {
-#if LIFT_CONSTANTS
-#error lift constants
-        StgRhs rhs  = stgVarBody(v);
-        switch (whatIs(rhs)) {
-        case STGCON:
-        case STGAPP:
-                return isNull(stgVarInfo(v));
-        default:
-                return FALSE;
-        }
-#else
         return FALSE;
-#endif
     }
 }
 
@@ -106,31 +93,10 @@ static List liftLetBinds( List binds, Bool topLevel )
         StgVar bind = hd(binds);
         StgRhs rhs  = stgVarBody(bind);
         List   fvs  = filterFreeVars(stgVarInfo(bind));
-        /* stgVarInfo(bind) = NIL; */ /* ToDo: discard fv list */
-
-        /* if starting on a new top-level inlineable bind, ensure that
-           the lifted-out binds get marked inlineable too
-        */
-        if (topLevel) {
-           Name n         = nameFromStgVar(bind);
-           makeInlineable = FALSE;
-           if (nonNull(n) && name(n).inlineMe==TRUE) makeInlineable = TRUE;
-        }
 
         switch (whatIs(rhs)) {
         case STGCON:
         case STGAPP:
-#if LIFT_CONSTANTS
-#error lift constants
-                if (isNull(fvs)) {
-                    StgVar v = mkStgVar(rhs,NONE);
-                    stgVarBody(bind) = mkStgLet(singleton(v),v);
-                    /* ppStg(v); */ /* check inlinable */
-                    liftedBinds = cons(bind,liftedBinds);
-                    break;
-                }
-                /* deliberate fall through */
-#endif
         case STGVAR:
         case NAME:
                 bs = cons(bind,bs);
@@ -146,26 +112,11 @@ static List liftLetBinds( List binds, Bool topLevel )
                        sprintf(s,"lam%d",inlineCounter++);
                        n = newName(findText(s),NIL);
                        name(n).stgVar = v;
-                       name(n).simplified = TRUE; /* optimiser is upstream of lifter */
-                       if (makeInlineable) name(n).inlineMe = TRUE;
                        stgVarBody(bind) = makeStgApp(n, fvs);
                     } else {
                        stgVarBody(bind) = makeStgApp(v, fvs);
                     }
                 }
-#if LIFT_CONSTANTS
-#error lift constants
-                else {
-                    StgVar r = mkStgVar(rhs,NIL); /* copy the var */
-                    StgVar v = mkStgVar(mkStgLet(singleton(r),r),NONE);
-                    stgVarBody(bind) = v; /* indirection to r */
-                    /* ppStg(v); */
-                    liftedBinds = cons(v,liftedBinds);
-                    bs = cons(bind,bs); /* keep the old binding */
-                    break;
-                }
-                /* deliberate fall through */
-#endif
                 bs = cons(bind,bs);
                 break;
         }
@@ -222,20 +173,21 @@ List liftBinds( List binds )
 
     for(bs=binds; nonNull(bs); bs=tl(bs)) {
         StgVar bind = hd(bs);
+
+        if (debugSC) {
+           if (currentModule != modulePrelude) {
+              fprintf(stderr, "\n");
+              ppStg(hd(bs));
+              fprintf(stderr, "\n");
+           }
+        }
         freeVarsBind(NIL,bind);
         stgVarInfo(bind) = NONE; /* mark as top level */
     }
 
     liftedBinds = NIL;
-    binds = liftLetBinds(binds,TRUE);
-    binds = revOnto(liftedBinds,binds);
-
-    for (bs=binds; nonNull(bs); bs=tl(bs)) {
-       Name n = nameFromStgVar(hd(bs));
-       if (nonNull(n))
-          name(n).stgSize = stgSize(stgVarBody(name(n).stgVar));
-    }
-    
+    binds       = liftLetBinds(binds,TRUE);
+    binds       = revOnto(liftedBinds,binds);
     liftedBinds = NIL;
     return binds;
 }
@@ -247,14 +199,15 @@ List liftBinds( List binds )
 Void liftControl(what)
 Int what; {
     switch (what) {
-    case INSTALL:
-            /* deliberate fall though */
-    case RESET: 
-            liftedBinds = NIL;
-            break;
-    case MARK: 
-            mark(liftedBinds);
-            break;
+       case POSTPREL: break;
+
+       case PREPREL:
+       case RESET: 
+          liftedBinds = NIL;
+          break;
+       case MARK: 
+          mark(liftedBinds);
+          break;
     }
 }