X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Ffree.c;h=bee9195ebc3de933af3005a64941123d14bf0e79;hb=3ddfdc19e74af725239b7dfdec776d1d07847fc2;hp=59eb322e04863527d0f8bec98e922a537e9bae4c;hpb=57131ad0203977941eb50d60550fa82e88614496;p=ghc-hetmet.git

diff --git a/ghc/interpreter/free.c b/ghc/interpreter/free.c
index 59eb322..bee9195 100644
--- a/ghc/interpreter/free.c
+++ b/ghc/interpreter/free.c
@@ -2,18 +2,19 @@
 /* --------------------------------------------------------------------------
  * 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.3 $
- * $Date: 1999/02/03 17:08:29 $
+ * $Revision: 1.10 $
+ * $Date: 2000/03/13 11:37:16 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
 #include "storage.h"
-#include "backend.h"
 #include "connect.h"
 #include "errors.h"
 
@@ -22,11 +23,11 @@
  * Local functions
  * ------------------------------------------------------------------------*/
 
-static List freeVarsAlt     Args((List, StgCaseAlt));
-static List freeVarsPrimAlt Args((List, StgPrimAlt));
-static List freeVarsExpr    Args((List, StgExpr));
-static List freeVarsAtom    Args((List, StgAtom));
-static List freeVarsVar     Args((List, StgVar));
+static List freeVarsAlt     ( List, StgCaseAlt );
+static List freeVarsPrimAlt ( List, StgPrimAlt );
+static List freeVarsExpr    ( List, StgExpr );
+static List freeVarsAtom    ( List, StgAtom );
+static List freeVarsVar     ( List, StgVar );
 
 /* --------------------------------------------------------------------------
  * Free variable analysis
@@ -72,23 +73,27 @@ 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);
 }
 
 static List freeVarsExpr( List acc, StgExpr e )
 {
+#if 0
+    printf( "freeVarsExpr: " );ppStgExpr(e);printf("\n");
+#endif
     switch (whatIs(e)) {
     case LETREC:
             mapAccum(freeVarsBind,acc,stgLetBinds(e));
@@ -115,6 +120,9 @@ static List freeVarsExpr( List acc, StgExpr e )
     case NAME:
             return acc;  /* Names are never free vars */
     default:
+            printf("\n");
+            ppStgExpr(e);
+            printf("\n");
             internal("freeVarsExpr");
     }
 }