[project @ 2001-03-01 17:06:53 by simonpj]

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

diff --git a/ghc/compiler/coreSyn/CoreFVs.lhs b/ghc/compiler/coreSyn/CoreFVs.lhs
index c501255..d170a3b 100644 (file)
--- a/ghc/compiler/coreSyn/CoreFVs.lhs
+++ b/ghc/compiler/coreSyn/CoreFVs.lhs
@@ -5,20 +5,26 @@ Taken quite directly from the Peyton Jones/Lester paper.
 
 \begin{code}
 module CoreFVs (
-       exprFreeVars, exprsFreeVars,
+       isLocalVar, mustHaveLocalBinding,
+
+       exprFreeVars,   -- CoreExpr -> VarSet   -- Find all locally-defined free Ids or tyvars
+       exprsFreeVars,  -- [CoreExpr] -> VarSet
+
        exprSomeFreeVars, exprsSomeFreeVars,
-       idRuleVars, idFreeVars, 
-       ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
 
-       mustHaveLocalBinding,
+       idRuleVars, idFreeVars, idFreeTyVars,
+       ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
 
-       CoreExprWithFVs, CoreBindWithFVs, freeVars, freeVarsOf,
+       CoreExprWithFVs,        -- = AnnExpr Id VarSet
+       CoreBindWithFVs,        -- = AnnBind Id VarSet
+       freeVars,               -- CoreExpr -> CoreExprWithFVs
+       freeVarsOf              -- CoreExprWithFVs -> IdSet
     ) where
 
 #include "HsVersions.h"
 
 import CoreSyn
-import Id              ( Id, idFreeTyVars, hasNoBinding, idSpecialisation )
+import Id              ( Id, idType, isLocalId, hasNoBinding, idSpecialisation )
 import VarSet
 import Var             ( Var, isId )
 import Type            ( tyVarsOfType )
@@ -29,6 +35,29 @@ import Outputable
 
 %************************************************************************
 %*                                                                     *
+\subsection{isLocalVar}
+%*                                                                     *
+%************************************************************************
+
+@isLocalVar@ returns True of all TyVars, and of Ids that are defined in 
+this module and are not constants like data constructors and record selectors.
+These are the variables that we need to pay attention to when finding free
+variables, or doing dependency analysis.
+
+\begin{code}
+isLocalVar :: Var -> Bool
+isLocalVar v = isTyVar v || isLocalId v
+\end{code}
+
+\begin{code}
+mustHaveLocalBinding :: Var -> Bool
+-- True <=> the variable must have a binding in this module
+mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \section{Finding the free variables of an expression}
 %*                                                                     *
 %************************************************************************
@@ -138,12 +167,6 @@ expr_fvs (Let (Rec pairs) body)
 
 
 \begin{code}
-idRuleVars ::Id -> VarSet
-idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id)
-
-idFreeVars :: Id -> VarSet
-idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
-
 rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> VarSet
 rulesSomeFreeVars interesting (Rules rules _)
   = foldr (unionVarSet . ruleSomeFreeVars interesting) emptyVarSet rules
@@ -192,9 +215,13 @@ noFVs    = emptyVarSet
 aFreeVar = unitVarSet
 unionFVs = unionVarSet
 
-filters :: Var -> VarSet -> VarSet
+delBindersFV :: [Var] -> VarSet -> VarSet
+delBindersFV bs fvs = foldr delBinderFV fvs bs
+
+delBinderFV :: Var -> VarSet -> VarSet
+-- This way round, so we can do it multiple times using foldr
 
--- (b `filters` s) removes the binder b from the free variable set s,
+-- (b `delBinderFV` s) removes the binder b from the free variable set s,
 -- but *adds* to s
 --     (a) the free variables of b's type
 --     (b) the idSpecVars of b
@@ -222,8 +249,21 @@ filters :: Var -> VarSet -> VarSet
 --                       where
 --                         bottom = bottom -- Never evaluated
 
-filters b s | isId b    = (s `delVarSet` b) `unionFVs` idFreeVars b
-           | otherwise = s `delVarSet` b
+delBinderFV b s | isId b    = (s `delVarSet` b) `unionFVs` idFreeVars b
+               | otherwise = s `delVarSet` b
+
+idFreeVars :: Id -> VarSet
+idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
+
+idFreeTyVars :: Id -> TyVarSet
+-- Only local Ids conjured up locally, can have free type variables.
+-- (During type checking top-level Ids can have free tyvars)
+idFreeTyVars id = tyVarsOfType (idType id)
+-- | isLocalId id = tyVarsOfType (idType id)
+-- | otherwise    = emptyVarSet
+
+idRuleVars ::Id -> VarSet
+idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id)
 \end{code}
 
 
@@ -249,7 +289,7 @@ freeVars (Var v)
 
 freeVars (Lit lit) = (noFVs, AnnLit lit)
 freeVars (Lam b body)
-  = (b `filters` freeVarsOf body', AnnLam b body')
+  = (b `delBinderFV` freeVarsOf body', AnnLam b body')
   where
     body' = freeVars body
 
@@ -260,7 +300,7 @@ freeVars (App fun arg)
     arg2 = freeVars arg
 
 freeVars (Case scrut bndr alts)
-  = ((bndr `filters` alts_fvs) `unionFVs` freeVarsOf scrut2,
+  = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2,
      AnnCase scrut2 bndr alts2)
   where
     scrut2 = freeVars scrut
@@ -268,7 +308,7 @@ freeVars (Case scrut bndr alts)
     (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
     alts_fvs           = foldr1 unionFVs alts_fvs_s
 
-    fv_alt (con,args,rhs) = (foldr filters (freeVarsOf rhs2) args,
+    fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
                             (con, args, rhs2))
                          where
                             rhs2 = freeVars rhs
@@ -279,11 +319,11 @@ freeVars (Let (NonRec binder rhs) body)
   where
     rhs2     = freeVars rhs
     body2    = freeVars body
-    body_fvs = binder `filters` freeVarsOf body2
+    body_fvs = binder `delBinderFV` freeVarsOf body2
 
 freeVars (Let (Rec binds) body)
   = (foldl delVarSet group_fvs binders,
-       -- The "filters" part may have added one of the binders
+       -- The "delBinderFV" part may have added one of the binders
        -- via the idSpecVars part, so we must delete it again
      AnnLet (AnnRec (binders `zip` rhss2)) body2)
   where
@@ -291,7 +331,7 @@ freeVars (Let (Rec binds) body)
 
     rhss2     = map freeVars rhss
     all_fvs   = foldr (unionFVs . fst) body_fvs rhss2
-    group_fvs = foldr filters all_fvs binders
+    group_fvs = delBindersFV binders all_fvs
 
     body2     = freeVars body
     body_fvs  = freeVarsOf body2