1 /* -*- mode: hugs-c; -*- */
2 /* --------------------------------------------------------------------------
3 * Free variable analysis
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
11 * $Date: 1998/12/02 13:22:08 $
12 * ------------------------------------------------------------------------*/
21 /* --------------------------------------------------------------------------
23 * ------------------------------------------------------------------------*/
25 static List freeVarsAlt Args((List, StgCaseAlt));
26 static List freeVarsPrimAlt Args((List, StgPrimAlt));
27 static List freeVarsExpr Args((List, StgExpr));
28 static List freeVarsAtom Args((List, StgAtom));
29 static List freeVarsVar Args((List, StgVar));
31 /* --------------------------------------------------------------------------
32 * Free variable analysis
33 * ------------------------------------------------------------------------*/
35 static List freeVarsAtom( List acc, StgAtom a)
39 return freeVarsVar(acc,a);
40 /* Note that NAMEs have no free vars. */
46 static List freeVarsVar( List acc, StgVar v)
48 if (cellIsMember(v,acc)) {
55 List freeVarsBind( List acc, StgVar v )
57 StgRhs rhs = stgVarBody(v);
59 switch (whatIs(rhs)) {
61 mapAccum(freeVarsAtom,fvs,stgConArgs(rhs));
64 fvs = freeVarsExpr(fvs,rhs);
67 /* fvs = rev(fvs); */ /* todo might cause less stack rearrangement? */
69 mapAccum(freeVarsVar,acc,fvs); /* copy onto acc */
73 static List freeVarsAlt( List acc, StgCaseAlt alt )
75 StgPat pat = stgCaseAltPat(alt);
76 acc = freeVarsExpr(acc,stgCaseAltBody(alt));
77 if (!isDefaultPat(pat)) {
78 acc = diffList(acc,stgPatVars(pat));
80 return deleteCell(acc,pat);
83 static List freeVarsPrimAlt( List acc, StgPrimAlt alt )
85 List vs = stgPrimAltPats(alt);
86 acc = freeVarsExpr(acc,stgPrimAltBody(alt));
87 return diffList(acc,vs);
90 static List freeVarsExpr( List acc, StgExpr e )
94 mapAccum(freeVarsBind,acc,stgLetBinds(e));
95 return diffList(freeVarsExpr(acc,stgLetBody(e)),stgLetBinds(e));
97 return diffList(freeVarsExpr(acc,stgLambdaBody(e)),stgLambdaArgs(e));
99 mapAccum(freeVarsAlt,acc,stgCaseAlts(e));
100 return freeVarsExpr(acc,stgCaseScrut(e));
102 mapAccum(freeVarsPrimAlt,acc,stgPrimCaseAlts(e));
103 return freeVarsExpr(acc,stgPrimCaseScrut(e));
105 mapAccum(freeVarsAtom,acc,stgPrimArgs(e));
106 /* primop is not a var */
109 /* Doing fun first causes slightly less stack rearrangement. */
110 acc = freeVarsExpr(acc,stgAppFun(e));
111 mapAccum(freeVarsAtom,acc,stgAppArgs(e));
114 return freeVarsVar(acc, e);
116 return acc; /* Names are never free vars */
118 internal("freeVarsExpr");
122 /*-------------------------------------------------------------------------*/