[project @ 1998-02-25 12:59:55 by sof]

[ghc-hetmet.git] / ghc / compiler / coreSyn / FreeVars.lhs

diff --git a/ghc/compiler/coreSyn/FreeVars.lhs b/ghc/compiler/coreSyn/FreeVars.lhs
index e6987a8..6140164 100644 (file)
--- a/ghc/compiler/coreSyn/FreeVars.lhs
+++ b/ghc/compiler/coreSyn/FreeVars.lhs
@@ -4,23 +4,21 @@
 Taken quite directly from the Peyton Jones/Lester paper.
 
 \begin{code}
-#include "HsVersions.h"
-
 module FreeVars (
        freeVars,
 
        -- cheap and cheerful variant...
-       addTopBindsFVs,
+       addTopBindsFVs, addExprFVs,
 
        freeVarsOf, freeTyVarsOf,
-       FVCoreExpr(..), FVCoreBinding(..),
+       FVCoreExpr, FVCoreBinding,
 
-       CoreExprWithFVs(..),            -- For the above functions
-       AnnCoreExpr(..),                -- Dito
+       CoreExprWithFVs,                -- For the above functions
+       AnnCoreExpr,            -- Dito
        FVInfo(..), LeakInfo(..)
     ) where
 
-import Ubiq{-uitous-}
+#include "HsVersions.h"
 
 import AnnCoreSyn      -- output
 
@@ -28,17 +26,17 @@ import CoreSyn
 import Id              ( idType, getIdArity, isBottomingId,
                          emptyIdSet, unitIdSet, mkIdSet,
                          elementOfIdSet, minusIdSet, unionManyIdSets,
-                         IdSet(..)
+                         IdSet, Id
                        )
-import IdInfo          ( arityMaybe )
+import IdInfo          ( ArityInfo(..) )
 import PrimOp          ( PrimOp(..) )
-import Type            ( tyVarsOfType )
+import Type            ( tyVarsOfType, Type )
 import TyVar           ( emptyTyVarSet, unitTyVarSet, minusTyVarSet,
                          intersectTyVarSets,
-                         TyVarSet(..)
+                         TyVarSet, TyVar
                        )
+import BasicTypes      ( Unused )
 import UniqSet         ( unionUniqSets )
-import Usage           ( UVar(..) )
 import Util            ( panic, assertPanic )
 \end{code}
 
@@ -59,7 +57,7 @@ I've half-convinced myself we don't for case- and letrec bound ids
 but I might be wrong. (SLPJ, date unknown)
 
 \begin{code}
-type CoreExprWithFVs =  AnnCoreExpr Id Id TyVar UVar FVInfo
+type CoreExprWithFVs =  AnnCoreExpr Id Id Unused FVInfo
 
 type TyVarCands = TyVarSet  -- for when we carry around lists of
 type IdCands   = IdSet     -- "candidate" TyVars/Ids.
@@ -144,9 +142,10 @@ fvExpr id_cands tyvar_cands (Var v)
   where
     leakiness
       | isBottomingId v = lEAK_FREE_BIG        -- Hack
-      | otherwise       = case arityMaybe (getIdArity v) of
-                           Nothing    -> lEAK_FREE_0
-                           Just arity -> LeakFree arity
+      | otherwise       = case getIdArity v of
+                           UnknownArity       -> lEAK_FREE_0
+                           ArityAtLeast arity -> LeakFree arity
+                           ArityExactly arity -> LeakFree arity
 
 fvExpr id_cands tyvar_cands (Lit k)
   = (FVInfo noFreeIds noFreeTyVars lEAK_FREE_0, AnnLit k)
@@ -167,9 +166,6 @@ fvExpr id_cands tyvar_cands (Prim op args)
 
 -- this Lam stuff could probably be improved by rewriting (WDP 96/03)
 
-fvExpr id_cands tyvar_cands (Lam (UsageBinder uvar) body)
-  = panic "fvExpr:Lam UsageBinder"
-
 fvExpr id_cands tyvar_cands (Lam b@(ValBinder binder) body)
   = (FVInfo (freeVarsOf body2   `minusIdSet` unitIdSet binder)
            (freeTyVarsOf body2 `combine`    munge_id_ty binder)
@@ -324,7 +320,6 @@ freeArgs icands tcands (arg:args)
        (arg_fvs `combine` irest, tfvs `combine` trest) }
   where
     free_arg (LitArg   _) = noFreeAnything
-    free_arg (UsageArg _) = noFreeAnything
     free_arg (TyArg   ty) = (noFreeIds, freeTy tcands ty)
     free_arg (VarArg   v)
       | v `is_among` icands = (aFreeId v, noFreeTyVars)
@@ -382,8 +377,8 @@ As it happens this is only ever used by the Specialiser!
 
 \begin{code}
 type FVCoreBinder  = (Id, IdSet)
-type FVCoreExpr    = GenCoreExpr    FVCoreBinder Id TyVar UVar
-type FVCoreBinding = GenCoreBinding FVCoreBinder Id TyVar UVar
+type FVCoreExpr    = GenCoreExpr    FVCoreBinder Id Unused
+type FVCoreBinding = GenCoreBinding FVCoreBinder Id Unused
 
 type InterestingIdFun
   =  IdSet     -- Non-top-level in-scope variables
@@ -419,7 +414,6 @@ addExprFVs fv_cand in_scope (Lam binder body)
     (new_binder, binder_set)
       = case binder of
          TyBinder    t -> (TyBinder t, emptyIdSet)
-         UsageBinder u -> (UsageBinder u, emptyIdSet)
           ValBinder   b -> (ValBinder (b, lam_fvs),
                            unitIdSet b)