[project @ 2000-11-14 10:46:39 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 3c4d5c8..fc0d7bd 100644 (file)
--- a/ghc/compiler/coreSyn/CoreFVs.lhs
+++ b/ghc/compiler/coreSyn/CoreFVs.lhs
@@ -5,9 +5,12 @@ Taken quite directly from the Peyton Jones/Lester paper.
 
 \begin{code}
 module CoreFVs (
+       isLocalVar, mustHaveLocalBinding,
+
        exprFreeVars, exprsFreeVars,
        exprSomeFreeVars, exprsSomeFreeVars,
-       idRuleVars, idFreeVars, ruleSomeFreeVars, ruleSomeLhsFreeVars,
+       idRuleVars, idFreeVars, idFreeTyVars,
+       ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
 
        CoreExprWithFVs, CoreBindWithFVs, freeVars, freeVarsOf,
     ) where
@@ -15,14 +18,38 @@ module CoreFVs (
 #include "HsVersions.h"
 
 import CoreSyn
-import Id              ( Id, idFreeTyVars, idSpecialisation )
+import Id              ( Id, idName, idType, isLocalId, hasNoBinding, idSpecialisation )
 import VarSet
 import Var             ( Var, isId )
-import Name            ( isLocallyDefined )
-import Type            ( tyVarsOfType, Type )
+import Type            ( tyVarsOfType )
 import Util            ( mapAndUnzip )
+import Outputable
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+\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}
@@ -39,7 +66,7 @@ but not those that are free in the type of variable occurrence.
 
 \begin{code}
 exprFreeVars :: CoreExpr -> VarSet     -- Find all locally-defined free Ids or tyvars
-exprFreeVars = exprSomeFreeVars isLocallyDefined
+exprFreeVars = exprSomeFreeVars isLocalVar
 
 exprsFreeVars :: [CoreExpr] -> VarSet
 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
@@ -75,9 +102,10 @@ noVars fv_cand in_scope = emptyVarSet
 -- is a little weird.  The reason is that the former is more efficient,
 -- but the latter is more fine grained, and a makes a difference when
 -- a variable mentions itself one of its own rule RHSs
-oneVar :: Var -> FV
+oneVar :: Id -> FV
 oneVar var fv_cand in_scope
-  = foldVarSet add_rule_var var_itself_set (idRuleVars var)
+  = ASSERT( isId var ) 
+    foldVarSet add_rule_var var_itself_set (idRuleVars var)
   where
     var_itself_set | keep_it fv_cand in_scope var = unitVarSet var
                   | otherwise                = emptyVarSet
@@ -133,16 +161,30 @@ expr_fvs (Let (Rec pairs) body)
 
 
 \begin{code}
-idRuleVars ::Id -> VarSet
-idRuleVars id = rulesRhsFreeVars (idSpecialisation id)
-
 idFreeVars :: Id -> VarSet
-idFreeVars id = idRuleVars id `unionVarSet` idFreeTyVars id
+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)
 
 rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> VarSet
 rulesSomeFreeVars interesting (Rules rules _)
   = foldr (unionVarSet . ruleSomeFreeVars interesting) emptyVarSet rules
 
+ruleRhsFreeVars :: CoreRule -> VarSet
+ruleRhsFreeVars (BuiltinRule _) = noFVs
+ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
+  = rule_fvs isLocalVar emptyVarSet
+  where
+    rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
+
 ruleSomeFreeVars :: InterestingVarFun -> CoreRule -> VarSet
 ruleSomeFreeVars interesting (BuiltinRule _) = noFVs
 ruleSomeFreeVars interesting (Rule _ tpl_vars tpl_args rhs)
@@ -232,8 +274,8 @@ freeVars (Var v)
        --      Actually [June 98] I don't think it's necessary
        -- fvs = fvs_v `unionVarSet` idSpecVars v
 
-    fvs | isLocallyDefined v = aFreeVar v
-       | otherwise          = noFVs
+    fvs | isLocalVar v = aFreeVar v
+       | otherwise    = noFVs
 
 freeVars (Lit lit) = (noFVs, AnnLit lit)
 freeVars (Lam b body)