* included in the distribution.
*
* $RCSfile: lift.c,v $
- * $Revision: 1.10 $
- * $Date: 1999/12/10 15:59:47 $
+ * $Revision: 1.14 $
+ * $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"
* ------------------------------------------------------------------------*/
static List liftedBinds = NIL;
-static Bool makeInlineable = FALSE;
-static Int inlineCounter = 0;
-static StgExpr abstractExpr ( List vars, StgExpr e );
-static inline Bool isTopLevel( StgVar v );
-static List filterFreeVars( List vs );
-static List liftLetBinds ( List binds, Bool topLevel );
-static void liftAlt ( StgCaseAlt alt );
-static void liftPrimAlt ( StgPrimAlt alt );
-static void liftExpr ( StgExpr e );
+static StgExpr abstractExpr ( List vars, StgExpr e );
+static Bool isTopLevel ( StgVar v );
+static List filterFreeVars ( List vs );
+static List liftLetBinds ( List binds, Bool topLevel );
+static void liftAlt ( StgCaseAlt alt );
+static void liftPrimAlt ( StgPrimAlt alt );
+static void liftExpr ( StgExpr e );
/* --------------------------------------------------------------------------
* Lambda lifter
/* ToDo: should be conservative estimate but isn't */
/* Will a variable be floated out to top level - conservative estimate? */
-static inline Bool isTopLevel( StgVar v )
+static Bool isTopLevel( StgVar v )
{
if (isNull(stgVarBody(v))) {
return FALSE; /* only let bound vars can be floated */
}
}
+static Int nameCounter;
+
static List liftLetBinds( List binds, Bool topLevel )
{
- List bs = NIL;
+ List bs = NIL;
for(; nonNull(binds); binds=tl(binds)) {
StgVar bind = hd(binds);
StgRhs rhs = stgVarBody(bind);
liftExpr(rhs);
if (nonNull(fvs)) {
StgVar v = mkStgVar(abstractExpr(fvs,rhs),NONE);
- liftedBinds = cons(v,liftedBinds);
- if (makeInlineable) {
+ {
Name n;
char s[16];
- sprintf(s,"lam%d",inlineCounter++);
+ sprintf(s,"(lift%d)",nameCounter++);
n = newName(findText(s),NIL);
- name(n).stgVar = v;
+ name(n).closure = v;
stgVarBody(bind) = makeStgApp(n, fvs);
- } else {
- stgVarBody(bind) = makeStgApp(v, fvs);
+ liftedBinds = cons(n,liftedBinds);
}
}
bs = cons(bind,bs);
break;
case STGVAR:
case NAME:
+ case TUPLE:
break;
default:
internal("liftExpr");
}
}
-/* Lift a list of top-level binds. */
-List liftBinds( List binds )
+/* Lift the list of top-level binds for a module. */
+void liftModule ( Module mod )
{
- List bs;
-
- for(bs=binds; nonNull(bs); bs=tl(bs)) {
- StgVar bind = hd(bs);
-
+ List binds = NIL;
+ List cl;
+
+ nameCounter = 0;
+ for (cl = module(mod).codeList; nonNull(cl); cl = tl(cl)) {
+ StgVar bind = getNameOrTupleClosure(hd(cl));
+ if (isCPtr(bind)) continue;
+ assert(nonNull(bind));
if (debugSC) {
- if (lastModule() != modulePrelude) {
+ if (currentModule != modulePrelude) {
fprintf(stderr, "\n");
- ppStg(hd(bs));
+ ppStg(bind);
fprintf(stderr, "\n");
}
}
freeVarsBind(NIL,bind);
stgVarInfo(bind) = NONE; /* mark as top level */
+ binds = cons(bind,binds);
}
liftedBinds = NIL;
binds = liftLetBinds(binds,TRUE);
- binds = revOnto(liftedBinds,binds);
+ module(mod).codeList = revOnto(liftedBinds, module(mod).codeList);
liftedBinds = NIL;
- return binds;
}
/* --------------------------------------------------------------------------