[project @ 1999-11-29 18:59:23 by sewardj]

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

diff --git a/ghc/interpreter/lift.c b/ghc/interpreter/lift.c
index 297d9fe..e5ddb05 100644 (file)
--- a/ghc/interpreter/lift.c
+++ b/ghc/interpreter/lift.c
@@ -5,13 +5,15 @@
  * This is a very simple lambda lifter - it doesn't try to do Johnsson-style
  * lambda lifting (yet).
  *
- * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
- * All rights reserved. See NOTICE for details and conditions of use etc...
- * Hugs version 1.4, December 1997
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved.  It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
  *
  * $RCSfile: lift.c,v $
- * $Revision: 1.5 $
- * $Date: 1999/04/27 10:06:54 $
+ * $Revision: 1.9 $
+ * $Date: 1999/11/29 18:59:29 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -65,19 +67,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
     }
 }
 
@@ -104,31 +94,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);
@@ -144,26 +113,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;
         }
@@ -220,20 +174,21 @@ List liftBinds( List binds )
 
     for(bs=binds; nonNull(bs); bs=tl(bs)) {
         StgVar bind = hd(bs);
+
+        if (debugSC) {
+           if (lastModule() != 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;
 }