[project @ 2000-11-14 10:46:39 by simonpj]
[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreFVs.lhs
index 5784439..fc0d7bd 100644 (file)
@@ -5,40 +5,48 @@ Taken quite directly from the Peyton Jones/Lester paper.
 
 \begin{code}
 module CoreFVs (
+       isLocalVar, mustHaveLocalBinding,
+
        exprFreeVars, exprsFreeVars,
        exprSomeFreeVars, exprsSomeFreeVars,
-       idRuleVars, idFreeVars, 
+       idRuleVars, idFreeVars, idFreeTyVars,
        ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
 
-       mustHaveLocalBinding,
-
        CoreExprWithFVs, CoreBindWithFVs, freeVars, freeVarsOf,
     ) where
 
 #include "HsVersions.h"
 
 import CoreSyn
-import Id              ( Id, idFreeTyVars, mayHaveNoBinding, 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}
 
+
 %************************************************************************
 %*                                                                     *
-\section{Utilities}
+\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
-  | isId v    = isLocallyDefined v && not (mayHaveNoBinding v)
-  | otherwise = True   -- TyVars etc must
+mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
 \end{code}
 
 
@@ -58,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
@@ -153,12 +161,19 @@ 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
 
+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
@@ -166,7 +181,7 @@ rulesSomeFreeVars interesting (Rules rules _)
 ruleRhsFreeVars :: CoreRule -> VarSet
 ruleRhsFreeVars (BuiltinRule _) = noFVs
 ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
-  = rule_fvs isLocallyDefined emptyVarSet
+  = rule_fvs isLocalVar emptyVarSet
   where
     rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
 
@@ -259,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)