-\begin{code}
-freeArgs :: IdCands -> TyVarCands
- -> [CoreArg]
- -> (IdSet, TyVarSet)
-
-freeArgs icands tcands [] = noFreeAnything
-freeArgs icands tcands (arg:args)
- -- this code is written this funny way only for "efficiency" purposes
- = let
- free_first_arg@(arg_fvs, tfvs) = free_arg arg
- in
- if (null args) then
- free_first_arg
- else
- case (freeArgs icands tcands args) of { (irest, trest) ->
- (arg_fvs `combine` irest, tfvs `combine` trest) }
- where
- free_arg (LitArg _) = noFreeAnything
- free_arg (TyArg ty) = (noFreeIds, freeTy tcands ty)
- free_arg (VarArg v)
- | v `is_among` icands = (aFreeId v, noFreeTyVars)
- | otherwise = noFreeAnything
-
----------
-freeTy :: TyVarCands -> Type -> TyVarSet
-
-freeTy cands ty = tyVarsOfType ty `intersectTyVarSets` cands
-
-freeVarsOf :: CoreExprWithFVs -> IdSet
-freeVarsOf (FVInfo free_vars _ _, _) = free_vars
-
-freeTyVarsOf :: CoreExprWithFVs -> TyVarSet
-freeTyVarsOf (FVInfo _ free_tyvars _, _) = free_tyvars
-
-leakinessOf :: CoreExprWithFVs -> LeakInfo
-leakinessOf (FVInfo _ _ leakiness, _) = leakiness
-\end{code}
-
-
-%************************************************************************
-%* *
-\section{Finding the free variables of an expression}
-%* *
-%************************************************************************
-
-This function simply finds the free variables of an expression.
-
-\begin{code}
-type InterestingIdFun
- = Id -- The Id being looked at
- -> Bool -- True <=> interesting
-
-exprFreeVars :: InterestingIdFun -> CoreExpr -> IdSet
-exprFreeVars fv_cand e = expr_fvs fv_cand emptyIdSet e
-\end{code}
-
-
-\begin{code}
-expr_fvs :: InterestingIdFun -- "Interesting id" predicate
- -> IdSet -- In scope ids
- -> CoreExpr
- -> IdSet
-
-expr_fvs fv_cand in_scope (Var v) = id_fvs fv_cand in_scope v
-expr_fvs fv_cand in_scope (Lit lit) = noFreeIds
-expr_fvs fv_cand in_scope (Con con args) = args_fvs fv_cand in_scope args
-expr_fvs fv_cand in_scope (Prim op args) = args_fvs fv_cand in_scope args
-expr_fvs fv_cand in_scope (Note _ expr) = expr_fvs fv_cand in_scope expr
-expr_fvs fv_cand in_scope (App fun arg) = expr_fvs fv_cand in_scope fun `combine`
- arg_fvs fv_cand in_scope arg
-
-
-expr_fvs fv_cand in_scope (Lam (ValBinder b) body)
- = (expr_fvs fv_cand (in_scope `add` b) body)
-expr_fvs fv_cand in_scope (Lam (TyBinder b) body)
- = expr_fvs fv_cand in_scope body
-
-expr_fvs fv_cand in_scope (Case scrut alts)
- = expr_fvs fv_cand in_scope scrut `combine` alts_fvs
- where
- alts_fvs
- = case alts of
- AlgAlts alg_alts deflt -> unionManyIdSets (deflt_fvs : alt_fvs)
- where
- alt_fvs = map do_alg_alt alg_alts
- deflt_fvs = do_deflt deflt
-
- PrimAlts prim_alts deflt -> unionManyIdSets (deflt_fvs : alt_fvs)
- where
- alt_fvs = map do_prim_alt prim_alts
- deflt_fvs = do_deflt deflt
-
- do_alg_alt :: (Id, [Id], CoreExpr) -> IdSet
- do_alg_alt (con, args, rhs) = expr_fvs fv_cand new_in_scope rhs
- where
- new_in_scope = in_scope `combine` mkIdSet args
-
- do_prim_alt (lit, rhs) = expr_fvs fv_cand in_scope rhs
-
- do_deflt NoDefault = noFreeIds
- do_deflt (BindDefault b rhs) = expr_fvs fv_cand (in_scope `add` b) rhs
-
-expr_fvs fv_cand in_scope (Let (NonRec b r) body)
- = expr_fvs fv_cand in_scope r `combine`
- expr_fvs fv_cand (in_scope `add` b) body
-
-expr_fvs fv_cand in_scope (Let (Rec pairs) body)
- = foldr (combine . expr_fvs fv_cand in_scope' . snd) noFreeIds pairs `combine`
- expr_fvs fv_cand in_scope' body
- where
- in_scope' = in_scope `combine` mkIdSet (map fst pairs)
-
-
-
-
---------------------------------------
-arg_fvs fv_cand in_scope (VarArg v) = id_fvs fv_cand in_scope v
-arg_fvs fv_cand in_scope other_arg = noFreeIds
-
---------------------------------------
-args_fvs fv_cand in_scope args = foldr (combine . arg_fvs fv_cand in_scope) noFreeIds args
-
-
---------------------------------------
-id_fvs fv_cand in_scope v
- | v `elementOfIdSet` in_scope = noFreeIds
- | fv_cand v = aFreeId v
- | otherwise = noFreeIds
-\end{code}