* included in the distribution.
*
* $RCSfile: stgSubst.c,v $
- * $Revision: 1.5 $
- * $Date: 1999/10/15 21:40:57 $
+ * $Revision: 1.9 $
+ * $Date: 2000/04/28 13:03:47 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
-#include "backend.h"
#include "connect.h"
#include "errors.h"
break;
case STGVAR:
case NAME:
+ case TUPLE:
return substVar(sub,e);
default:
internal("substExpr");
}
-/* A substitution engine more suitable for the optimiser.
- Doesn't make so many assumptions about what is an atom.
-*/
-StgExpr zubstExpr( List sub, StgExpr e )
-{
- List bs;
- switch (whatIs(e)) {
- case LETREC:
- for (bs=stgLetBinds(e); nonNull(bs); bs=tl(bs))
- stgVarBody(hd(bs)) = zubstExpr(sub,stgVarBody(hd(bs)));
- stgLetBody(e) = zubstExpr(sub,stgLetBody(e));
- break;
- case LAMBDA:
- stgLambdaBody(e) = zubstExpr(sub,stgLambdaBody(e));
- break;
- case CASE:
- stgCaseScrut(e) = zubstExpr(sub,stgCaseScrut(e));
- map1Proc(zubstExpr,sub,stgCaseAlts(e));
- break;
- case PRIMCASE:
- stgPrimCaseScrut(e) = zubstExpr(sub,stgPrimCaseScrut(e));
- map1Proc(zubstExpr,sub,stgPrimCaseAlts(e));
- break;
- case CASEALT:
- stgCaseAltBody(e) = zubstExpr(sub,stgCaseAltBody(e));
- break;
- case DEEFALT:
- stgDefaultBody(e) = zubstExpr(sub,stgDefaultBody(e));
- break;
- case PRIMALT:
- stgPrimAltBody(e) = zubstExpr(sub,stgPrimAltBody(e));
- break;
- case STGPRIM:
- map1Over(zubstExpr,sub,stgPrimArgs(e));
- break;
- case STGAPP:
- stgAppFun(e) = zubstExpr(sub,stgAppFun(e));
- map1Over(zubstExpr,sub,stgAppArgs(e));
- break;
- case STGCON:
- map1Over(zubstExpr,sub,stgConArgs(e));
- break;
- case STGVAR:
- return substVar(sub,e);
- case NAME:
- case INTCELL:
- case STRCELL:
- case PTRCELL:
- case CHARCELL:
- case FLOATCELL:
- break;
- default:
- internal("zubstExpr");
- }
- return e;
-}
-
-
-
/*-------------------------------------------------------------------------*/