2 /* --------------------------------------------------------------------------
3 * Free variable analysis
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: free.c,v $
13 * $Date: 2000/02/03 13:55:21 $
14 * ------------------------------------------------------------------------*/
23 /* --------------------------------------------------------------------------
25 * ------------------------------------------------------------------------*/
27 static List freeVarsAlt Args((List, StgCaseAlt));
28 static List freeVarsPrimAlt Args((List, StgPrimAlt));
29 static List freeVarsExpr Args((List, StgExpr));
30 static List freeVarsAtom Args((List, StgAtom));
31 static List freeVarsVar Args((List, StgVar));
33 /* --------------------------------------------------------------------------
34 * Free variable analysis
35 * ------------------------------------------------------------------------*/
37 static List freeVarsAtom( List acc, StgAtom a)
41 return freeVarsVar(acc,a);
42 /* Note that NAMEs have no free vars. */
48 static List freeVarsVar( List acc, StgVar v)
50 if (cellIsMember(v,acc)) {
57 List freeVarsBind( List acc, StgVar v )
59 StgRhs rhs = stgVarBody(v);
61 switch (whatIs(rhs)) {
63 mapAccum(freeVarsAtom,fvs,stgConArgs(rhs));
66 fvs = freeVarsExpr(fvs,rhs);
69 /* fvs = rev(fvs); */ /* todo might cause less stack rearrangement? */
71 mapAccum(freeVarsVar,acc,fvs); /* copy onto acc */
75 static List freeVarsAlt( List acc, StgCaseAlt alt )
77 if (isDefaultAlt(alt)) {
78 acc = freeVarsExpr(acc,stgDefaultBody(alt));
79 return deleteCell(acc,stgDefaultVar(alt));
81 acc = freeVarsExpr(acc,stgCaseAltBody(alt));
82 return diffList(acc,stgCaseAltVars(alt));
86 static List freeVarsPrimAlt( List acc, StgPrimAlt alt )
88 List vs = stgPrimAltVars(alt);
89 acc = freeVarsExpr(acc,stgPrimAltBody(alt));
90 return diffList(acc,vs);
93 static List freeVarsExpr( List acc, StgExpr e )
96 printf( "freeVarsExpr: " );ppStgExpr(e);printf("\n");
100 mapAccum(freeVarsBind,acc,stgLetBinds(e));
101 return diffList(freeVarsExpr(acc,stgLetBody(e)),stgLetBinds(e));
103 return diffList(freeVarsExpr(acc,stgLambdaBody(e)),stgLambdaArgs(e));
105 mapAccum(freeVarsAlt,acc,stgCaseAlts(e));
106 return freeVarsExpr(acc,stgCaseScrut(e));
108 mapAccum(freeVarsPrimAlt,acc,stgPrimCaseAlts(e));
109 return freeVarsExpr(acc,stgPrimCaseScrut(e));
111 mapAccum(freeVarsAtom,acc,stgPrimArgs(e));
112 /* primop is not a var */
115 /* Doing fun first causes slightly less stack rearrangement. */
116 acc = freeVarsExpr(acc,stgAppFun(e));
117 mapAccum(freeVarsAtom,acc,stgAppArgs(e));
120 return freeVarsVar(acc, e);
122 return acc; /* Names are never free vars */
127 internal("freeVarsExpr");
131 /*-------------------------------------------------------------------------*/