[project @ 1999-07-27 10:53:53 by sof]

[ghc-hetmet.git] / ghc / interpreter / free.c

diff --git a/ghc/interpreter/free.c b/ghc/interpreter/free.c
index 2d7344c..d58635b 100644 (file)
--- 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");
     }
 }