2 /* --------------------------------------------------------------------------
3 * Substitute variables in an expression
5 * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
6 * All rights reserved. See NOTICE for details and conditions of use etc...
7 * Hugs version 1.4, December 1997
9 * $RCSfile: stgSubst.c,v $
11 * $Date: 1999/04/27 10:07:04 $
12 * ------------------------------------------------------------------------*/
20 /* --------------------------------------------------------------------------
21 * Local function prototypes:
22 * ------------------------------------------------------------------------*/
24 static StgVar substVar ( List sub, StgVar v );
25 static StgAtom substAtom ( List sub, StgAtom a );
26 static void substBind ( List sub, StgVar bind );
27 static void substAlt ( List sub, StgCaseAlt alt );
28 static void substPrimAlt ( List sub, StgPrimAlt alt );
30 /* --------------------------------------------------------------------------
31 * Substitute variables throughout an expression - updating in place.
32 * ------------------------------------------------------------------------*/
34 static StgVar substVar( List sub, StgVar v )
36 Pair p = cellAssoc(v,sub);
44 static StgAtom substAtom ( List sub, StgAtom a )
48 return substVar(sub,a);
54 static Void substBind( List sub, StgVar bind )
56 StgRhs rhs = stgVarBody(bind);
57 switch (whatIs(rhs)) {
59 map1Over(substAtom,sub,stgConArgs(rhs));
62 stgVarBody(bind) = substExpr(sub,rhs);
67 static Void substAlt( List sub, StgCaseAlt alt )
69 if (isDefaultAlt(alt))
70 stgDefaultBody(alt) = substExpr(sub,stgDefaultBody(alt)); else
71 stgCaseAltBody(alt) = substExpr(sub,stgCaseAltBody(alt));
74 static Void substPrimAlt( List sub, StgPrimAlt alt )
76 stgPrimAltBody(alt) = substExpr(sub,stgPrimAltBody(alt));
79 StgExpr substExpr( List sub, StgExpr e )
83 map1Proc(substBind,sub,stgLetBinds(e));
84 stgLetBody(e) = substExpr(sub,stgLetBody(e));
87 stgLambdaBody(e) = substExpr(sub,stgLambdaBody(e));
90 stgCaseScrut(e) = substExpr(sub,stgCaseScrut(e));
91 map1Proc(substAlt,sub,stgCaseAlts(e));
94 stgPrimCaseScrut(e) = substExpr(sub,stgPrimCaseScrut(e));
95 map1Proc(substPrimAlt,sub,stgPrimCaseAlts(e));
98 map1Over(substAtom,sub,stgPrimArgs(e));
101 stgAppFun(e) = substVar(sub,stgAppFun(e));
102 map1Over(substAtom,sub,stgAppArgs(e));
105 map1Over(substAtom,sub,stgConArgs(e));
109 return substVar(sub,e);
111 internal("substExpr");
117 /* A substitution engine more suitable for the optimiser.
118 Doesn't make so many assumptions about what is an atom.
120 StgExpr zubstExpr( List sub, StgExpr e )
125 for (bs=stgLetBinds(e); nonNull(bs); bs=tl(bs))
126 stgVarBody(hd(bs)) = zubstExpr(sub,stgVarBody(hd(bs)));
127 stgLetBody(e) = zubstExpr(sub,stgLetBody(e));
130 stgLambdaBody(e) = zubstExpr(sub,stgLambdaBody(e));
133 stgCaseScrut(e) = zubstExpr(sub,stgCaseScrut(e));
134 map1Proc(zubstExpr,sub,stgCaseAlts(e));
137 stgPrimCaseScrut(e) = zubstExpr(sub,stgPrimCaseScrut(e));
138 map1Proc(zubstExpr,sub,stgPrimCaseAlts(e));
141 stgCaseAltBody(e) = zubstExpr(sub,stgCaseAltBody(e));
144 stgDefaultBody(e) = zubstExpr(sub,stgDefaultBody(e));
147 stgPrimAltBody(e) = zubstExpr(sub,stgPrimAltBody(e));
150 map1Over(zubstExpr,sub,stgPrimArgs(e));
153 stgAppFun(e) = zubstExpr(sub,stgAppFun(e));
154 map1Over(zubstExpr,sub,stgAppArgs(e));
157 map1Over(zubstExpr,sub,stgConArgs(e));
160 return substVar(sub,e);
169 internal("zubstExpr");
176 /*-------------------------------------------------------------------------*/