Commit e5ccc92c authored by Ian Lynagh's avatar Ian Lynagh

Whitespace in coreSyn/CoreFVs.lhs

parent d535ef00
......@@ -5,13 +5,6 @@
Taken quite directly from the Peyton Jones/Lester paper.
\begin{code}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
{-# OPTIONS -fno-warn-incomplete-patterns #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
......@@ -32,11 +25,11 @@ module CoreFVs (
exprSomeFreeVars, exprsSomeFreeVars,
-- * Free variables of Rules, Vars and Ids
varTypeTyVars, varTypeTcTyVars,
varTypeTyVars, varTypeTcTyVars,
idUnfoldingVars, idFreeVars, idRuleAndUnfoldingVars,
idRuleVars, idRuleRhsVars, stableUnfoldingVars,
ruleRhsFreeVars, rulesFreeVars,
ruleLhsOrphNames, ruleLhsFreeIds,
ruleLhsOrphNames, ruleLhsFreeIds,
vectsFreeVars,
-- * Core syntax tree annotation with free variables
......@@ -66,16 +59,16 @@ import Outputable
%************************************************************************
%* *
%* *
\section{Finding the free variables of an expression}
%* *
%* *
%************************************************************************
This function simply finds the free variables of an expression.
So far as type variables are concerned, it only finds tyvars that are
* free in type arguments,
* free in the type of a binder,
* free in type arguments,
* free in the type of a binder,
but not those that are free in the type of variable occurrence.
......@@ -85,7 +78,7 @@ exprFreeVars :: CoreExpr -> VarSet
exprFreeVars = exprSomeFreeVars isLocalVar
-- | Find all locally-defined free Ids in an expression
exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids
exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids
exprFreeIds = exprSomeFreeVars isLocalId
-- | Find all locally-defined free Ids or type variables in several expressions
......@@ -95,20 +88,20 @@ exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
-- | Find all locally defined free Ids in a binding group
bindFreeVars :: CoreBind -> VarSet
bindFreeVars (NonRec _ r) = exprFreeVars r
bindFreeVars (Rec prs) = addBndrs (map fst prs)
(foldr (union . rhs_fvs) noVars prs)
isLocalVar emptyVarSet
bindFreeVars (Rec prs) = addBndrs (map fst prs)
(foldr (union . rhs_fvs) noVars prs)
isLocalVar emptyVarSet
-- | Finds free variables in an expression selected by a predicate
exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting
-> CoreExpr
-> VarSet
exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting
-> CoreExpr
-> VarSet
exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
-- | Finds free variables in several expressions selected by a predicate
exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting
-> [CoreExpr]
-> VarSet
exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting
-> [CoreExpr]
-> VarSet
exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
-- | Predicate on possible free variables: returns @True@ iff the variable is interesting
......@@ -117,9 +110,9 @@ type InterestingVarFun = Var -> Bool
\begin{code}
type FV = InterestingVarFun
-> VarSet -- In scope
-> VarSet -- Free vars
type FV = InterestingVarFun
-> VarSet -- In scope
-> VarSet -- Free vars
union :: FV -> FV -> FV
union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
......@@ -127,7 +120,7 @@ union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand
noVars :: FV
noVars _ _ = emptyVarSet
-- Comment about obselete code
-- Comment about obselete code
-- We used to gather the free variables the RULES at a variable occurrence
-- with the following cryptic comment:
-- "At a variable occurrence, add in any free variables of its rule rhss
......@@ -138,27 +131,27 @@ noVars _ _ = emptyVarSet
-- a variable mentions itself one of its own rule RHSs"
-- Not only is this "weird", but it's also pretty bad because it can make
-- a function seem more recursive than it is. Suppose
-- f = ...g...
-- g = ...
-- f = ...g...
-- g = ...
-- RULE g x = ...f...
-- Then f is not mentioned in its own RHS, and needn't be a loop breaker
-- (though g may be). But if we collect the rule fvs from g's occurrence,
-- it looks as if f mentions itself. (This bites in the eftInt/eftIntFB
-- code in GHC.Enum.)
--
--
-- Anyway, it seems plain wrong. The RULE is like an extra RHS for the
-- function, so its free variables belong at the definition site.
--
-- Deleted code looked like
-- foldVarSet add_rule_var var_itself_set (idRuleVars var)
-- add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
-- | otherwise = set
-- SLPJ Feb06
-- | otherwise = set
-- SLPJ Feb06
oneVar :: Id -> FV
oneVar var fv_cand in_scope
= ASSERT( isId var )
if keep_it fv_cand in_scope var
= ASSERT( isId var )
if keep_it fv_cand in_scope var
then unitVarSet var
else emptyVarSet
......@@ -169,16 +162,16 @@ someVars vars fv_cand in_scope
keep_it :: InterestingVarFun -> VarSet -> Var -> Bool
keep_it fv_cand in_scope var
| var `elemVarSet` in_scope = False
| fv_cand var = True
| otherwise = False
| fv_cand var = True
| otherwise = False
addBndr :: CoreBndr -> FV -> FV
addBndr bndr fv fv_cand in_scope
= someVars (varTypeTyVars bndr) fv_cand in_scope
-- Include type varibles in the binder's type
-- (not just Ids; coercion variables too!)
`unionVarSet` fv fv_cand (in_scope `extendVarSet` bndr)
-- Include type varibles in the binder's type
-- (not just Ids; coercion variables too!)
`unionVarSet` fv fv_cand (in_scope `extendVarSet` bndr)
addBndrs :: [CoreBndr] -> FV -> FV
addBndrs bndrs fv = foldr addBndr fv bndrs
......@@ -188,9 +181,9 @@ addBndrs bndrs fv = foldr addBndr fv bndrs
\begin{code}
expr_fvs :: CoreExpr -> FV
expr_fvs (Type ty) = someVars (tyVarsOfType ty)
expr_fvs (Type ty) = someVars (tyVarsOfType ty)
expr_fvs (Coercion co) = someVars (tyCoVarsOfCo co)
expr_fvs (Var var) = oneVar var
expr_fvs (Var var) = oneVar var
expr_fvs (Lit _) = noVars
expr_fvs (Tick t expr) = tickish_fvs t `union` expr_fvs expr
expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
......@@ -198,7 +191,7 @@ expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
expr_fvs (Cast expr co) = expr_fvs expr `union` someVars (tyCoVarsOfCo co)
expr_fvs (Case scrut bndr ty alts)
= expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
= expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
(foldr (union . alt_fvs) noVars alts)
where
alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
......@@ -207,14 +200,14 @@ expr_fvs (Let (NonRec bndr rhs) body)
= rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
expr_fvs (Let (Rec pairs) body)
= addBndrs (map fst pairs)
(foldr (union . rhs_fvs) (expr_fvs body) pairs)
= addBndrs (map fst pairs)
(foldr (union . rhs_fvs) (expr_fvs body) pairs)
---------
rhs_fvs :: (Id,CoreExpr) -> FV
rhs_fvs (bndr, rhs) = expr_fvs rhs `union`
rhs_fvs (bndr, rhs) = expr_fvs rhs `union`
someVars (bndrRuleAndUnfoldingVars bndr)
-- Treat any RULES as extra RHSs of the binding
-- Treat any RULES as extra RHSs of the binding
---------
exprs_fvs :: [CoreExpr] -> FV
......@@ -227,16 +220,16 @@ tickish_fvs _ = noVars
%************************************************************************
%* *
%* *
\section{Free names}
%* *
%* *
%************************************************************************
\begin{code}
-- | ruleLhsOrphNames is used when deciding whether
-- a rule is an orphan. In particular, suppose that T is defined in this
-- | ruleLhsOrphNames is used when deciding whether
-- a rule is an orphan. In particular, suppose that T is defined in this
-- module; we want to avoid declaring that a rule like:
--
--
-- > fromIntegral T = fromIntegral_T
--
-- is an orphan. Of course it isn't, and declaring it an orphan would
......@@ -245,8 +238,8 @@ ruleLhsOrphNames :: CoreRule -> NameSet
ruleLhsOrphNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
ruleLhsOrphNames (Rule { ru_fn = fn, ru_args = tpl_args })
= addOneToNameSet (exprsOrphNames tpl_args) fn
-- No need to delete bndrs, because
-- exprsOrphNames finds only External names
-- No need to delete bndrs, because
-- exprsOrphNames finds only External names
-- | Finds the free /external/ names of an expression, notably
-- including the names of type constructors (which of course do not show
......@@ -257,15 +250,15 @@ exprOrphNames :: CoreExpr -> NameSet
exprOrphNames e
= go e
where
go (Var v)
go (Var v)
| isExternalName n = unitNameSet n
| otherwise = emptyNameSet
| otherwise = emptyNameSet
where n = idName v
go (Lit _) = emptyNameSet
go (Type ty) = orphNamesOfType ty -- Don't need free tyvars
go (Lit _) = emptyNameSet
go (Type ty) = orphNamesOfType ty -- Don't need free tyvars
go (Coercion co) = orphNamesOfCo co
go (App e1 e2) = go e1 `unionNameSets` go e2
go (Lam v e) = go e `delFromNameSet` idName v
go (App e1 e2) = go e1 `unionNameSets` go e2
go (Lam v e) = go e `delFromNameSet` idName v
go (Tick _ e) = go e
go (Cast e co) = go e `unionNameSets` orphNamesOfCo co
go (Let (NonRec _ r) e) = go e `unionNameSets` go r
......@@ -303,7 +296,7 @@ ruleFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args }
idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
-- Just the variables free on the *rhs* of a rule
idRuleRhsVars is_active id
idRuleRhsVars is_active id
= foldr (unionVarSet . get_fvs) emptyVarSet (idCoreRules id)
where
get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs
......@@ -332,7 +325,7 @@ We used not to include the Id in its own rhs free-var set.
Otherwise the occurrence analyser makes bindings recursive:
f x y = x+y
RULE: f (f x y) z ==> f x (f y z)
However, the occurrence analyser distinguishes "non-rule loop breakers"
However, the occurrence analyser distinguishes "non-rule loop breakers"
from "rule-only loop breakers" (see BasicTypes.OccInfo). So it will
put this 'f' in a Rec block, but will mark the binding as a non-rule loop
breaker, which is perfectly inlinable.
......@@ -362,10 +355,10 @@ The free variable pass annotates every node in the expression with its
NON-GLOBAL free variables and type variables.
\begin{code}
-- | Every node in a binding group annotated with its
-- | Every node in a binding group annotated with its
-- (non-global) free variables, both Ids and TyVars
type CoreBindWithFVs = AnnBind Id VarSet
-- | Every node in an expression annotated with its
-- | Every node in an expression annotated with its
-- (non-global) free variables, both Ids and TyVars
type CoreExprWithFVs = AnnExpr Id VarSet
......@@ -391,64 +384,64 @@ delBinderFV :: Var -> VarSet -> VarSet
-- (b `delBinderFV` s) removes the binder b from the free variable set s,
-- but *adds* to s
--
-- the free variables of b's type
-- the free variables of b's type
--
-- This is really important for some lambdas:
-- In (\x::a -> x) the only mention of "a" is in the binder.
-- In (\x::a -> x) the only mention of "a" is in the binder.
--
-- Also in
-- let x::a = b in ...
-- let x::a = b in ...
-- we should really note that "a" is free in this expression.
-- It'll be pinned inside the /\a by the binding for b, but
-- it seems cleaner to make sure that a is in the free-var set
-- it seems cleaner to make sure that a is in the free-var set
-- when it is mentioned.
--
-- This also shows up in recursive bindings. Consider:
-- /\a -> letrec x::a = x in E
-- /\a -> letrec x::a = x in E
-- Now, there are no explicit free type variables in the RHS of x,
-- but nevertheless "a" is free in its definition. So we add in
-- the free tyvars of the types of the binders, and include these in the
-- free vars of the group, attached to the top level of each RHS.
--
-- This actually happened in the defn of errorIO in IOBase.lhs:
-- errorIO (ST io) = case (errorIO# io) of
-- _ -> bottom
-- where
-- bottom = bottom -- Never evaluated
-- errorIO (ST io) = case (errorIO# io) of
-- _ -> bottom
-- where
-- bottom = bottom -- Never evaluated
delBinderFV b s = (s `delVarSet` b) `unionFVs` varTypeTyVars b
-- Include coercion variables too!
-- Include coercion variables too!
varTypeTyVars :: Var -> TyVarSet
-- Find the type variables free in the type of the variable
-- Remember, coercion variables can mention type variables...
varTypeTyVars var
| isLocalId var = tyVarsOfType (idType var)
| otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
| otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
varTypeTcTyVars :: Var -> TyVarSet
-- Find the type variables free in the type of the variable
-- Remember, coercion variables can mention type variables...
varTypeTcTyVars var
| isLocalId var = tcTyVarsOfType (idType var)
| otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
| otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
idFreeVars :: Id -> VarSet
-- Type variables, rule variables, and inline variables
idFreeVars id = ASSERT( isId id)
varTypeTyVars id `unionVarSet`
idRuleAndUnfoldingVars id
idFreeVars id = ASSERT( isId id)
varTypeTyVars id `unionVarSet`
idRuleAndUnfoldingVars id
bndrRuleAndUnfoldingVars ::Var -> VarSet
-- A 'let' can bind a type variable, and idRuleVars assumes
-- A 'let' can bind a type variable, and idRuleVars assumes
-- it's seeing an Id. This function tests first.
bndrRuleAndUnfoldingVars v | isTyVar v = emptyVarSet
| otherwise = idRuleAndUnfoldingVars v
| otherwise = idRuleAndUnfoldingVars v
idRuleAndUnfoldingVars :: Id -> VarSet
idRuleAndUnfoldingVars id = ASSERT( isId id)
idRuleVars id `unionVarSet`
idUnfoldingVars id
idRuleAndUnfoldingVars id = ASSERT( isId id)
idRuleVars id `unionVarSet`
idUnfoldingVars id
idRuleVars ::Id -> VarSet -- Does *not* include CoreUnfolding vars
idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
......@@ -472,9 +465,9 @@ stableUnfoldingVars fv_cand unf
%************************************************************************
%* *
%* *
\subsection{Free variables (and types)}
%* *
%* *
%************************************************************************
\begin{code}
......@@ -483,13 +476,13 @@ freeVars :: CoreExpr -> CoreExprWithFVs
freeVars (Var v)
= (fvs, AnnVar v)
where
-- ToDo: insert motivating example for why we *need*
-- to include the idSpecVars in the FV list.
-- Actually [June 98] I don't think it's necessary
-- fvs = fvs_v `unionVarSet` idSpecVars v
-- ToDo: insert motivating example for why we *need*
-- to include the idSpecVars in the FV list.
-- Actually [June 98] I don't think it's necessary
-- fvs = fvs_v `unionVarSet` idSpecVars v
fvs | isLocalVar v = aFreeVar v
| otherwise = noFVs
| otherwise = noFVs
freeVars (Lit lit) = (noFVs, AnnLit lit)
freeVars (Lam b body)
......@@ -510,18 +503,18 @@ freeVars (Case scrut bndr ty alts)
scrut2 = freeVars scrut
(alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
alts_fvs = foldr1 unionFVs alts_fvs_s
alts_fvs = foldr1 unionFVs alts_fvs_s
fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
(con, args, rhs2))
where
rhs2 = freeVars rhs
(con, args, rhs2))
where
rhs2 = freeVars rhs
freeVars (Let (NonRec binder rhs) body)
= (freeVarsOf rhs2
`unionFVs` body_fvs
= (freeVarsOf rhs2
`unionFVs` body_fvs
`unionFVs` bndrRuleAndUnfoldingVars binder,
-- Remember any rules; cf rhs_fvs above
-- Remember any rules; cf rhs_fvs above
AnnLet (AnnNonRec binder rhs2) body2)
where
rhs2 = freeVars rhs
......@@ -537,8 +530,8 @@ freeVars (Let (Rec binds) body)
rhss2 = map freeVars rhss
rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
all_fvs = foldr (unionFVs . idRuleAndUnfoldingVars) rhs_body_fvs binders
-- The "delBinderFV" happens after adding the idSpecVars,
-- since the latter may add some of the binders as fvs
-- The "delBinderFV" happens after adding the idSpecVars,
-- since the latter may add some of the binders as fvs
body2 = freeVars body
body_fvs = freeVarsOf body2
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment