X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Ffree.c;h=d58635bb1898fe88fe19bf6789b8daa68abbc950;hb=bc3bcc2c6b53b712b5a4e290581ef82dd73cd528;hp=2d7344c8ace831b71d5859db8111c83229dd7570;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git diff --git a/ghc/interpreter/free.c b/ghc/interpreter/free.c index 2d7344c..d58635b 100644 --- a/ghc/interpreter/free.c +++ b/ghc/interpreter/free.c @@ -1,4 +1,4 @@ -/* -*- mode: hugs-c; -*- */ + /* -------------------------------------------------------------------------- * Free variable analysis * @@ -7,16 +7,16 @@ * Hugs version 1.4, December 1997 * * $RCSfile: free.c,v $ - * $Revision: 1.2 $ - * $Date: 1998/12/02 13:22:08 $ + * $Revision: 1.4 $ + * $Date: 1999/04/27 10:06:52 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" +#include "backend.h" #include "connect.h" #include "errors.h" -#include "stg.h" -#include "free.h" + /* -------------------------------------------------------------------------- * Local functions @@ -72,17 +72,18 @@ List freeVarsBind( List acc, StgVar v ) static List freeVarsAlt( List acc, StgCaseAlt alt ) { - StgPat pat = stgCaseAltPat(alt); - acc = freeVarsExpr(acc,stgCaseAltBody(alt)); - if (!isDefaultPat(pat)) { - acc = diffList(acc,stgPatVars(pat)); + if (isDefaultAlt(alt)) { + acc = freeVarsExpr(acc,stgDefaultBody(alt)); + return deleteCell(acc,stgDefaultVar(alt)); + } else { + acc = freeVarsExpr(acc,stgCaseAltBody(alt)); + return diffList(acc,stgCaseAltVars(alt)); } - return deleteCell(acc,pat); } static List freeVarsPrimAlt( List acc, StgPrimAlt alt ) { - List vs = stgPrimAltPats(alt); + List vs = stgPrimAltVars(alt); acc = freeVarsExpr(acc,stgPrimAltBody(alt)); return diffList(acc,vs); } @@ -115,6 +116,9 @@ static List freeVarsExpr( List acc, StgExpr e ) case NAME: return acc; /* Names are never free vars */ default: +printf("\n\n"); +ppStgExpr(e); +printf("\n"); internal("freeVarsExpr"); } }