-/* -*- mode: hugs-c; -*- */
+
/* --------------------------------------------------------------------------
* Free variable analysis
*
- * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
- * All rights reserved. See NOTICE for details and conditions of use etc...
- * Hugs version 1.4, December 1997
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved. It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
*
* $RCSfile: free.c,v $
- * $Revision: 1.2 $
- * $Date: 1998/12/02 13:22:08 $
+ * $Revision: 1.7 $
+ * $Date: 1999/11/01 11:07:07 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
+#include "backend.h"
#include "connect.h"
#include "errors.h"
-#include "stg.h"
-#include "free.h"
+
/* --------------------------------------------------------------------------
* Local functions
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);
}
case NAME:
return acc; /* Names are never free vars */
default:
+ /*
+ printf("\n");
+ ppStgExpr(e);
+ printf("\n");
+ */
internal("freeVarsExpr");
}
}