2 /* --------------------------------------------------------------------------
3 * Substitute variables in an expression
5 * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
6 * Yale Haskell Group, and the Oregon Graduate Institute of Science and
7 * Technology, 1994-1999, All rights reserved. It is distributed as
8 * free software under the license in the file "License", which is
9 * included in the distribution.
11 * $RCSfile: stgSubst.c,v $
13 * $Date: 2000/03/23 14:54:21 $
14 * ------------------------------------------------------------------------*/
16 #include "hugsbasictypes.h"
21 /* --------------------------------------------------------------------------
22 * Local function prototypes:
23 * ------------------------------------------------------------------------*/
25 static StgVar substVar ( List sub, StgVar v );
26 static StgAtom substAtom ( List sub, StgAtom a );
27 static void substBind ( List sub, StgVar bind );
28 static void substAlt ( List sub, StgCaseAlt alt );
29 static void substPrimAlt ( List sub, StgPrimAlt alt );
31 /* --------------------------------------------------------------------------
32 * Substitute variables throughout an expression - updating in place.
33 * ------------------------------------------------------------------------*/
35 static StgVar substVar( List sub, StgVar v )
37 Pair p = cellAssoc(v,sub);
45 static StgAtom substAtom ( List sub, StgAtom a )
49 return substVar(sub,a);
55 static Void substBind( List sub, StgVar bind )
57 StgRhs rhs = stgVarBody(bind);
58 switch (whatIs(rhs)) {
60 map1Over(substAtom,sub,stgConArgs(rhs));
63 stgVarBody(bind) = substExpr(sub,rhs);
68 static Void substAlt( List sub, StgCaseAlt alt )
70 if (isDefaultAlt(alt))
71 stgDefaultBody(alt) = substExpr(sub,stgDefaultBody(alt)); else
72 stgCaseAltBody(alt) = substExpr(sub,stgCaseAltBody(alt));
75 static Void substPrimAlt( List sub, StgPrimAlt alt )
77 stgPrimAltBody(alt) = substExpr(sub,stgPrimAltBody(alt));
80 StgExpr substExpr( List sub, StgExpr e )
84 map1Proc(substBind,sub,stgLetBinds(e));
85 stgLetBody(e) = substExpr(sub,stgLetBody(e));
88 stgLambdaBody(e) = substExpr(sub,stgLambdaBody(e));
91 stgCaseScrut(e) = substExpr(sub,stgCaseScrut(e));
92 map1Proc(substAlt,sub,stgCaseAlts(e));
95 stgPrimCaseScrut(e) = substExpr(sub,stgPrimCaseScrut(e));
96 map1Proc(substPrimAlt,sub,stgPrimCaseAlts(e));
99 map1Over(substAtom,sub,stgPrimArgs(e));
102 stgAppFun(e) = substVar(sub,stgAppFun(e));
103 map1Over(substAtom,sub,stgAppArgs(e));
106 map1Over(substAtom,sub,stgConArgs(e));
110 return substVar(sub,e);
112 internal("substExpr");
118 /*-------------------------------------------------------------------------*/