import AnnCoreSyn -- output
import CoreSyn
+import CoreUtils ( idSpecVars )
import Id ( idType, getIdArity, isBottomingId,
- emptyIdSet, unitIdSet, mkIdSet,
+ emptyIdSet, unitIdSet, mkIdSet, unionIdSets,
elementOfIdSet, minusIdSet, unionManyIdSets,
IdSet, Id
)
import BasicTypes ( Unused )
import UniqSet ( unionUniqSets, addOneToUniqSet )
import Util ( panic, assertPanic )
+
\end{code}
%************************************************************************
freeVars :: CoreExpr -> CoreExprWithFVs
freeVars expr = fvExpr noIdCands noTyVarCands expr
+
\end{code}
%************************************************************************
-> CoreExprWithFVs
fvExpr id_cands tyvar_cands (Var v)
- = (FVInfo (if (v `is_among` id_cands)
- then aFreeId v
- else noFreeIds)
- noFreeTyVars
- leakiness,
- AnnVar v)
+ = (FVInfo fvs noFreeTyVars leakiness, AnnVar v)
where
+ {-
+ ToDo: insert motivating example for why we *need*
+ to include the idSpecVars in the FV list.
+ -}
+ fvs = fvs_v `unionIdSets` mkIdSet (idSpecVars v)
+
+ fvs_v
+ | v `is_among` id_cands = aFreeId v
+ | otherwise = noFreeIds
+
leakiness
| isBottomingId v = lEAK_FREE_BIG -- Hack
| otherwise = case getIdArity v of
binder_ftvs = munge_id_ty binder
-- We need to collect free tyvars from the binder
+-- Don't forget to notice that the idSpecVars of the binder
+-- are free in the whole expression; albeit not in the RHS or body
+
fvExpr id_cands tyvar_cands (Let (NonRec binder rhs) body)
- = (FVInfo (freeVarsOf rhs' `combine` body_fvs)
+ = (FVInfo (freeVarsOf rhs' `combine` body_fvs `combine` mkIdSet (idSpecVars binder))
(freeTyVarsOf rhs' `combine` freeTyVarsOf body2 `combine` binder_ftvs)
(leakinessOf rhs' `orLeak` leakinessOf body2),
AnnLet (AnnNonRec binder rhs') body2)
where
- rhs' = fvExpr id_cands tyvar_cands rhs
+ rhs' = fvRhs id_cands tyvar_cands (binder, rhs)
body2 = fvExpr (aFreeId binder `combine` id_cands) tyvar_cands body
body_fvs = freeVarsOf body2 `minusIdSet` aFreeId binder
binder_ftvs = munge_id_ty binder
(binders, rhss) = unzip binds
new_id_cands = binders_set `combine` id_cands
binders_set = mkIdSet binders
- rhss' = map (fvExpr new_id_cands tyvar_cands) rhss
+ rhss' = map (fvRhs new_id_cands tyvar_cands) binds
FVInfo rhss_fvs rhss_tfvs leakiness_of_rhss
= foldr1 combineFVInfo [info | (info,_) <- rhss']
- binds_fvs = rhss_fvs `minusIdSet` binders_set
+ -- Don't forget to notice that the idSpecVars of the binder
+ -- are free in the whole expression; albeit not in the RHS or body
+ binds_fvs = (foldr (unionIdSets . mkIdSet . idSpecVars) rhss_fvs binders)
+ `minusIdSet`
+ binders_set
+
body2 = fvExpr new_id_cands tyvar_cands body
body_fvs = freeVarsOf body2 `minusIdSet` binders_set
binders_ftvs = foldr (combine . munge_id_ty) noFreeTyVars binders
= (fvinfo, AnnNote other_note expr2)
where
expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
+
+fvRhs id_cands tyvar_cands (bndr,rhs)
+ = fvExpr id_cands tyvar_cands rhs
\end{code}
\begin{code}