ghc/compiler/coreSyn/FreeVars.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 Taken quite directly from the Peyton Jones/Lester paper.
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module FreeVars (
  10         freeVars,
  11
  12         -- cheap and cheerful variant...
  13         addTopBindsFVs, addExprFVs,
  14
  15         freeVarsOf, freeTyVarsOf,
  16         SYN_IE(FVCoreExpr), SYN_IE(FVCoreBinding),
  17
  18         SYN_IE(CoreExprWithFVs),                -- For the above functions
  19         SYN_IE(AnnCoreExpr),            -- Dito
  20         FVInfo(..), LeakInfo(..)
  21     ) where
  22
  23 IMP_Ubiq(){-uitous-}
  24
  25 import AnnCoreSyn       -- output
  26
  27 import CoreSyn
  28 import Id               ( idType, getIdArity, isBottomingId,
  29                           emptyIdSet, unitIdSet, mkIdSet,
  30                           elementOfIdSet, minusIdSet, unionManyIdSets,
  31                           SYN_IE(IdSet), SYN_IE(Id)
  32                         )
  33 import IdInfo           ( ArityInfo(..) )
  34 import PrimOp           ( PrimOp(..) )
  35 import Type             ( tyVarsOfType, SYN_IE(Type) )
  36 import TyVar            ( emptyTyVarSet, unitTyVarSet, minusTyVarSet,
  37                           intersectTyVarSets,
  38                           SYN_IE(TyVarSet), SYN_IE(TyVar)
  39                         )
  40 import UniqSet          ( unionUniqSets )
  41 import Usage            ( SYN_IE(UVar) )
  42 import Util             ( panic, assertPanic )
  43 \end{code}
  44
  45 %************************************************************************
  46 %*                                                                      *
  47 \section[freevars-everywhere]{Attaching free variables to every sub-expression
  48 %*                                                                      *
  49 %************************************************************************
  50
  51 The free variable pass annotates every node in the expression with its
  52 NON-GLOBAL free variables and type variables.
  53
  54 The ``free type variables'' are defined to be those which are mentioned
  55 in type applications, {\em not} ones which lie buried in the types of Ids.
  56
  57 *** ALAS: we *do* need to collect tyvars from lambda-bound ids. ***
  58 I've half-convinced myself we don't for case- and letrec bound ids
  59 but I might be wrong. (SLPJ, date unknown)
  60
  61 \begin{code}
  62 type CoreExprWithFVs =  AnnCoreExpr Id Id TyVar UVar FVInfo
  63
  64 type TyVarCands = TyVarSet  -- for when we carry around lists of
  65 type IdCands    = IdSet     -- "candidate" TyVars/Ids.
  66 noTyVarCands    = emptyTyVarSet
  67 noIdCands       = emptyIdSet
  68
  69 data FVInfo
  70   = FVInfo  IdSet       -- Free ids
  71             TyVarSet    -- Free tyvars
  72             LeakInfo
  73
  74 noFreeIds      = emptyIdSet
  75 noFreeTyVars   = emptyTyVarSet
  76 noFreeAnything = (noFreeIds, noFreeTyVars)
  77 aFreeId i      = unitIdSet i
  78 aFreeTyVar t   = unitTyVarSet t
  79 is_among       = elementOfIdSet
  80 munge_id_ty  i = tyVarsOfType (idType i)
  81 combine        = unionUniqSets -- used both for {Id,TyVar}Sets
  82
  83 combineFVInfo (FVInfo fvs1 tfvs1 leak1) (FVInfo fvs2 tfvs2 leak2)
  84   = FVInfo (fvs1  `combine` fvs2)
  85            (tfvs1 `combine` tfvs2)
  86            (leak1 `orLeak`  leak2)
  87 \end{code}
  88
  89 Leak-free-ness is based only on the value, not the type.  In
  90 particular, nested collections of constructors are guaranteed leak
  91 free.  Function applications are not, except for PAPs.
  92
  93 Applications of error gets (LeakFree bigArity) -- a hack!
  94
  95 \begin{code}
  96 data LeakInfo
  97   = MightLeak
  98   | LeakFree Int    -- Leak free, and guarantees to absorb this # of
  99                     -- args before becoming leaky.
 100
 101 lEAK_FREE_0   = LeakFree 0
 102 lEAK_FREE_BIG = LeakFree bigArity
 103               where
 104                 bigArity = 1000::Int    -- NB: arbitrary
 105
 106 orLeak :: LeakInfo -> LeakInfo -> LeakInfo
 107 orLeak MightLeak     _           = MightLeak
 108 orLeak _             MightLeak   = MightLeak
 109 orLeak (LeakFree n) (LeakFree m) = LeakFree (n `min` m)
 110 \end{code}
 111
 112 Main public interface:
 113 \begin{code}
 114 freeVars :: CoreExpr -> CoreExprWithFVs
 115
 116 freeVars expr = fvExpr noIdCands noTyVarCands expr
 117 \end{code}
 118
 119 %************************************************************************
 120 %*                                                                      *
 121 \subsection{Free variables (and types)}
 122 %*                                                                      *
 123 %************************************************************************
 124
 125 We do the free-variable stuff by passing around ``candidates lists''
 126 of @Ids@ and @TyVars@ that may be considered free.  This is useful,
 127 e.g., to avoid considering top-level binders as free variables---don't
 128 put them on the candidates list.
 129
 130 \begin{code}
 131
 132 fvExpr :: IdCands           -- In-scope Ids
 133        -> TyVarCands        -- In-scope tyvars
 134        -> CoreExpr
 135        -> CoreExprWithFVs
 136
 137 fvExpr id_cands tyvar_cands (Var v)
 138   = (FVInfo (if (v `is_among` id_cands)
 139              then aFreeId v
 140              else noFreeIds)
 141             noFreeTyVars
 142             leakiness,
 143      AnnVar v)
 144   where
 145     leakiness
 146       | isBottomingId v = lEAK_FREE_BIG -- Hack
 147       | otherwise       = case getIdArity v of
 148                             UnknownArity       -> lEAK_FREE_0
 149                             ArityAtLeast arity -> LeakFree arity
 150                             ArityExactly arity -> LeakFree arity
 151
 152 fvExpr id_cands tyvar_cands (Lit k)
 153   = (FVInfo noFreeIds noFreeTyVars lEAK_FREE_0, AnnLit k)
 154
 155 fvExpr id_cands tyvar_cands (Con c args)
 156   = (FVInfo args_fvs tfvs lEAK_FREE_0, AnnCon c args)
 157   where
 158     (args_fvs, tfvs) = freeArgs id_cands tyvar_cands args
 159
 160 fvExpr id_cands tyvar_cands (Prim op args)
 161   = (FVInfo args_fvs tfvs lEAK_FREE_0, AnnPrim op args)
 162   where
 163     (args_fvs, tfvs) = freeArgs id_cands tyvar_cands args_to_use{-NB-}
 164     args_to_use
 165       = case op of
 166           CCallOp _ _ _ _ res_ty -> TyArg res_ty : args
 167           _                      -> args
 168
 169 -- this Lam stuff could probably be improved by rewriting (WDP 96/03)
 170
 171 fvExpr id_cands tyvar_cands (Lam (UsageBinder uvar) body)
 172   = panic "fvExpr:Lam UsageBinder"
 173
 174 fvExpr id_cands tyvar_cands (Lam b@(ValBinder binder) body)
 175   = (FVInfo (freeVarsOf body2   `minusIdSet` unitIdSet binder)
 176             (freeTyVarsOf body2 `combine`    munge_id_ty binder)
 177             leakiness,
 178      AnnLam b body2)
 179   where
 180         -- We need to collect free tyvars from the binders
 181     body2 = fvExpr (unitIdSet binder `combine` id_cands) tyvar_cands body
 182
 183     leakiness = case leakinessOf body2 of
 184                   MightLeak  -> LeakFree 1
 185                   LeakFree n -> LeakFree (n + 1)
 186
 187 fvExpr id_cands tyvar_cands (Lam b@(TyBinder tyvar) body)
 188   = (FVInfo (freeVarsOf body2)
 189             (freeTyVarsOf body2 `minusTyVarSet` aFreeTyVar tyvar)
 190             (leakinessOf body2),
 191      AnnLam b body2)
 192   where
 193     body2 = fvExpr id_cands (aFreeTyVar tyvar `combine` tyvar_cands) body
 194
 195 -- ditto on rewriting this App stuff (WDP 96/03)
 196
 197 fvExpr id_cands tyvar_cands (App fun arg)
 198   = (FVInfo (freeVarsOf fun2   `combine` fvs_arg)
 199             (freeTyVarsOf fun2 `combine` tfvs_arg)
 200             leakiness,
 201      AnnApp fun2 arg)
 202   where
 203     fun2 = fvExpr id_cands tyvar_cands fun
 204     fun2_leakiness = leakinessOf fun2
 205
 206     (fvs_arg, tfvs_arg) = freeArgs id_cands tyvar_cands [arg]
 207
 208     leakiness = if (notValArg arg) then
 209                     fun2_leakiness
 210                 else
 211                     case fun2_leakiness of
 212                        LeakFree n | n>1 -> LeakFree (n-1) -- Note > not >=
 213                        other            -> MightLeak
 214
 215 fvExpr id_cands tyvar_cands (Case expr alts)
 216   = (combineFVInfo expr_fvinfo alts_fvinfo,
 217      AnnCase expr2 alts')
 218   where
 219     expr2@(expr_fvinfo,_) = fvExpr id_cands tyvar_cands expr
 220     (alts_fvinfo, alts') = annotate_alts alts
 221
 222     annotate_alts (AlgAlts alts deflt)
 223       = (fvinfo, AnnAlgAlts alts' deflt')
 224       where
 225         (alts_fvinfo_s, alts') = unzip (map ann_boxed_alt alts)
 226         (deflt_fvinfo, deflt') = annotate_default deflt
 227         fvinfo = foldr combineFVInfo deflt_fvinfo alts_fvinfo_s
 228
 229         ann_boxed_alt (con, params, rhs)
 230           = (FVInfo (freeVarsOf rhs' `minusIdSet` mkIdSet params)
 231                     (freeTyVarsOf rhs' `combine` param_ftvs)
 232                     (leakinessOf rhs'),
 233              (con, params, rhs'))
 234           where
 235             rhs' = fvExpr (mkIdSet params `combine` id_cands) tyvar_cands rhs
 236             param_ftvs = foldr (combine . munge_id_ty) noFreeTyVars params
 237                 -- We need to collect free tyvars from the binders
 238
 239     annotate_alts (PrimAlts alts deflt)
 240       = (fvinfo, AnnPrimAlts alts' deflt')
 241       where
 242         (alts_fvinfo_s, alts') = unzip (map ann_unboxed_alt alts)
 243         (deflt_fvinfo, deflt') = annotate_default deflt
 244         fvinfo  = foldr combineFVInfo deflt_fvinfo alts_fvinfo_s
 245
 246         ann_unboxed_alt (lit, rhs) = (rhs_info, (lit, rhs'))
 247           where
 248             rhs'@(rhs_info,_) = fvExpr id_cands tyvar_cands rhs
 249
 250     annotate_default NoDefault = (FVInfo noFreeIds noFreeTyVars lEAK_FREE_BIG,
 251                                     AnnNoDefault)
 252
 253     annotate_default (BindDefault binder rhs)
 254       = (FVInfo (freeVarsOf   rhs' `minusIdSet` aFreeId binder)
 255                 (freeTyVarsOf rhs' `combine` binder_ftvs)
 256                 (leakinessOf rhs'),
 257          AnnBindDefault binder rhs')
 258       where
 259         rhs' = fvExpr (aFreeId binder `combine` id_cands) tyvar_cands rhs
 260         binder_ftvs = munge_id_ty binder
 261             -- We need to collect free tyvars from the binder
 262
 263 fvExpr id_cands tyvar_cands (Let (NonRec binder rhs) body)
 264   = (FVInfo (freeVarsOf rhs'   `combine` body_fvs)
 265             (freeTyVarsOf rhs' `combine` freeTyVarsOf body2 `combine` binder_ftvs)
 266             (leakinessOf rhs' `orLeak` leakinessOf body2),
 267      AnnLet (AnnNonRec binder rhs') body2)
 268   where
 269     rhs'        = fvExpr id_cands tyvar_cands rhs
 270     body2       = fvExpr (aFreeId binder `combine` id_cands) tyvar_cands body
 271     body_fvs    = freeVarsOf body2 `minusIdSet` aFreeId binder
 272     binder_ftvs = munge_id_ty binder
 273         -- We need to collect free tyvars from the binder
 274
 275 fvExpr id_cands tyvar_cands (Let (Rec binds) body)
 276   = (FVInfo (binds_fvs `combine` body_fvs)
 277             (rhss_tfvs `combine` freeTyVarsOf body2 `combine` binders_ftvs)
 278             (leakiness_of_rhss `orLeak` leakinessOf body2),
 279      AnnLet (AnnRec (binders `zip` rhss')) body2)
 280   where
 281     (binders, rhss)   = unzip binds
 282     new_id_cands      = binders_set `combine` id_cands
 283     binders_set       = mkIdSet binders
 284     rhss'             = map (fvExpr new_id_cands tyvar_cands) rhss
 285
 286     FVInfo rhss_fvs rhss_tfvs leakiness_of_rhss
 287         = foldr1 combineFVInfo [info | (info,_) <- rhss']
 288
 289     binds_fvs         = rhss_fvs `minusIdSet` binders_set
 290     body2             = fvExpr new_id_cands tyvar_cands body
 291     body_fvs          = freeVarsOf body2 `minusIdSet` binders_set
 292     binders_ftvs      = foldr (combine . munge_id_ty) noFreeTyVars binders
 293         -- We need to collect free tyvars from the binders
 294
 295 fvExpr id_cands tyvar_cands (SCC label expr)
 296   = (fvinfo, AnnSCC label expr2)
 297   where
 298     expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
 299
 300 fvExpr id_cands tyvar_cands (Coerce c ty expr)
 301   = (FVInfo (freeVarsOf   expr2)
 302             (freeTyVarsOf expr2 `combine` tfvs)
 303             (leakinessOf  expr2),
 304      AnnCoerce c ty expr2)
 305   where
 306     expr2 = fvExpr id_cands tyvar_cands expr
 307     tfvs  = freeTy tyvar_cands ty
 308 \end{code}
 309
 310 \begin{code}
 311 freeArgs :: IdCands -> TyVarCands
 312          -> [CoreArg]
 313          -> (IdSet, TyVarSet)
 314
 315 freeArgs icands tcands [] = noFreeAnything
 316 freeArgs icands tcands (arg:args)
 317   -- this code is written this funny way only for "efficiency" purposes
 318   = let
 319         free_first_arg@(arg_fvs, tfvs) = free_arg arg
 320     in
 321     if (null args) then
 322         free_first_arg
 323     else
 324         case (freeArgs icands tcands args) of { (irest, trest) ->
 325         (arg_fvs `combine` irest, tfvs `combine` trest) }
 326   where
 327     free_arg (LitArg   _) = noFreeAnything
 328     free_arg (UsageArg _) = noFreeAnything
 329     free_arg (TyArg   ty) = (noFreeIds, freeTy tcands ty)
 330     free_arg (VarArg   v)
 331       | v `is_among` icands = (aFreeId v, noFreeTyVars)
 332       | otherwise           = noFreeAnything
 333
 334 ---------
 335 freeTy :: TyVarCands -> Type -> TyVarSet
 336
 337 freeTy cands ty = tyVarsOfType ty `intersectTyVarSets` cands
 338
 339 freeVarsOf :: CoreExprWithFVs -> IdSet
 340 freeVarsOf (FVInfo free_vars _ _, _) = free_vars
 341
 342 freeTyVarsOf :: CoreExprWithFVs -> TyVarSet
 343 freeTyVarsOf (FVInfo _ free_tyvars _, _) = free_tyvars
 344
 345 leakinessOf :: CoreExprWithFVs -> LeakInfo
 346 leakinessOf (FVInfo _ _ leakiness, _) = leakiness
 347 \end{code}
 348
 349
 350 %************************************************************************
 351 %*                                                                      *
 352 \section[freevars-binders]{Attaching free variables to binders
 353 %*                                                                      *
 354 %************************************************************************
 355
 356
 357 Here's an variant of the free-variable pass, which pins free-variable
 358 information on {\em binders} rather than every single jolly
 359 expression!
 360 \begin{itemize}
 361 \item
 362   The free vars attached to a lambda binder are the free vars of the
 363   whole lambda abstraction.  If there are multiple binders, they are
 364   each given the same free-var set.
 365 \item
 366   The free vars attached to a let(rec) binder are the free vars of the
 367   rhs of the binding.  In the case of letrecs, this set excludes the
 368   binders themselves.
 369 \item
 370   The free vars attached to a case alternative binder are the free
 371   vars of the alternative, excluding the alternative's binders.
 372 \end{itemize}
 373
 374 There's a predicate carried in which tells what is a free-var
 375 candidate. It is passed the Id and a set of in-scope Ids.
 376
 377 (Global) constructors used on the rhs in a Con are also treated as
 378 potential free-var candidates (though they will not be recorded in the
 379 in-scope set). The predicate must decide if they are to be recorded as
 380 free-vars.
 381
 382 As it happens this is only ever used by the Specialiser!
 383
 384 \begin{code}
 385 type FVCoreBinder  = (Id, IdSet)
 386 type FVCoreExpr    = GenCoreExpr    FVCoreBinder Id TyVar UVar
 387 type FVCoreBinding = GenCoreBinding FVCoreBinder Id TyVar UVar
 388
 389 type InterestingIdFun
 390   =  IdSet      -- Non-top-level in-scope variables
 391   -> Id         -- The Id being looked at
 392   -> Bool       -- True <=> interesting
 393 \end{code}
 394
 395 \begin{code}
 396 addExprFVs :: InterestingIdFun  -- "Interesting id" predicate
 397            -> IdSet             -- In scope ids
 398            -> CoreExpr
 399            -> (FVCoreExpr, IdSet)
 400
 401 addExprFVs fv_cand in_scope (Var v)
 402   = (Var v, if fv_cand in_scope v
 403               then aFreeId v
 404               else noFreeIds)
 405
 406 addExprFVs fv_cand in_scope (Lit lit) = (Lit lit, noFreeIds)
 407
 408 addExprFVs fv_cand in_scope (Con con args)
 409   = (Con con args,
 410      if fv_cand in_scope con
 411      then aFreeId con
 412      else noFreeIds `combine` fvsOfArgs fv_cand in_scope args)
 413
 414 addExprFVs fv_cand in_scope (Prim op args)
 415   = (Prim op args, fvsOfArgs fv_cand in_scope args)
 416
 417 addExprFVs fv_cand in_scope (Lam binder body)
 418   = (Lam new_binder new_body, lam_fvs)
 419   where
 420     (new_binder, binder_set)
 421       = case binder of
 422           TyBinder    t -> (TyBinder t, emptyIdSet)
 423           UsageBinder u -> (UsageBinder u, emptyIdSet)
 424           ValBinder   b -> (ValBinder (b, lam_fvs),
 425                             unitIdSet b)
 426
 427     new_in_scope         = in_scope `combine` binder_set
 428     (new_body, body_fvs) = addExprFVs fv_cand new_in_scope body
 429     lam_fvs              = body_fvs `minusIdSet` binder_set
 430
 431 addExprFVs fv_cand in_scope (App fun arg)
 432   = (App fun2 arg, fun_fvs `combine` fvsOfArgs fv_cand in_scope [arg])
 433   where
 434     (fun2, fun_fvs) = addExprFVs fv_cand in_scope fun
 435
 436 addExprFVs fv_cand in_scope (Case scrut alts)
 437   = (Case scrut' alts', scrut_fvs `combine` alts_fvs)
 438   where
 439     (scrut', scrut_fvs) = addExprFVs fv_cand in_scope scrut
 440
 441     (alts', alts_fvs)
 442       = case alts of
 443           AlgAlts alg_alts deflt -> (AlgAlts alg_alts' deflt', fvs)
 444             where
 445               (alg_alts', alt_fvs) = unzip (map do_alg_alt alg_alts)
 446               (deflt', deflt_fvs) = do_deflt deflt
 447               fvs = unionManyIdSets (deflt_fvs : alt_fvs)
 448
 449           PrimAlts prim_alts deflt -> (PrimAlts prim_alts' deflt', fvs)
 450             where
 451               (prim_alts', alt_fvs) = unzip (map do_prim_alt prim_alts)
 452               (deflt', deflt_fvs) = do_deflt deflt
 453               fvs = unionManyIdSets (deflt_fvs : alt_fvs)
 454
 455     do_alg_alt :: (Id, [Id], CoreExpr)
 456                -> ((Id, [FVCoreBinder], FVCoreExpr), IdSet)
 457
 458     do_alg_alt (con, args, rhs) = ((con, args `zip` (repeat fvs), rhs'), fvs)
 459       where
 460         new_in_scope = in_scope `combine` arg_set
 461         (rhs', rhs_fvs) = addExprFVs fv_cand new_in_scope rhs
 462         fvs = rhs_fvs `minusIdSet` arg_set
 463         arg_set = mkIdSet args
 464
 465     do_prim_alt (lit, rhs) = ((lit, rhs'), rhs_fvs)
 466       where
 467         (rhs', rhs_fvs) = addExprFVs fv_cand in_scope rhs
 468
 469     do_deflt NoDefault = (NoDefault, noFreeIds)
 470     do_deflt (BindDefault var rhs)
 471       = (BindDefault (var,fvs) rhs', fvs)
 472       where
 473         new_in_scope = in_scope `combine` var_set
 474         (rhs', rhs_fvs) = addExprFVs fv_cand new_in_scope rhs
 475         fvs = rhs_fvs `minusIdSet` var_set
 476         var_set = aFreeId var
 477
 478 addExprFVs fv_cand in_scope (Let binds body)
 479   = (Let binds' body2, fvs_binds `combine` (fvs_body `minusIdSet` binder_set))
 480   where
 481     (binds', fvs_binds, new_in_scope, binder_set)
 482       = addBindingFVs fv_cand in_scope binds
 483
 484     (body2, fvs_body)  = addExprFVs fv_cand new_in_scope body
 485
 486 addExprFVs fv_cand in_scope (SCC label expr)
 487   = (SCC label expr2, expr_fvs)
 488   where
 489     (expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
 490
 491 addExprFVs fv_cand in_scope (Coerce c ty expr)
 492   = (Coerce c ty expr2, expr_fvs)
 493   where
 494     (expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
 495 \end{code}
 496
 497 \begin{code}
 498 addBindingFVs
 499             :: InterestingIdFun -- "Interesting id" predicate
 500             -> IdSet            -- In scope ids
 501             -> CoreBinding
 502             -> (FVCoreBinding,
 503                 IdSet,          -- Free vars of binding group
 504                 IdSet,          -- Augmented in-scope Ids
 505                 IdSet)          -- Set of Ids bound by this binding
 506
 507 addBindingFVs fv_cand in_scope (NonRec binder rhs)
 508   = (NonRec binder' rhs', fvs, new_in_scope, binder_set)
 509   where
 510     ((binder', rhs'), fvs) = do_pair fv_cand in_scope binder_set (binder, rhs)
 511     new_in_scope = in_scope `combine` binder_set
 512     binder_set = aFreeId binder
 513
 514 addBindingFVs fv_cand in_scope (Rec pairs)
 515   = (Rec pairs', unionManyIdSets fvs_s, new_in_scope, binder_set)
 516   where
 517     binders = [binder | (binder,_) <- pairs]
 518     binder_set = mkIdSet binders
 519     new_in_scope = in_scope `combine` binder_set
 520     (pairs', fvs_s) = unzip (map (do_pair fv_cand new_in_scope binder_set) pairs)
 521 \end{code}
 522
 523 \begin{code}
 524 addTopBindsFVs
 525             :: InterestingIdFun -- "Interesting id" predicate
 526             -> [CoreBinding]
 527             -> ([FVCoreBinding],
 528                 IdSet)
 529
 530 addTopBindsFVs fv_cand [] = ([], noFreeIds)
 531 addTopBindsFVs fv_cand (b:bs)
 532   = let
 533       (b',  fvs_b, _, _) = addBindingFVs fv_cand noFreeIds b
 534       (bs', fvs_bs)      = addTopBindsFVs fv_cand bs
 535     in
 536     (b' : bs', fvs_b `combine` fvs_bs)
 537 \end{code}
 538
 539 \begin{code}
 540 fvsOfArgs   :: InterestingIdFun -- "Interesting id" predicate
 541             -> IdSet            -- In scope ids
 542             -> [CoreArg]
 543             -> IdSet
 544
 545 fvsOfArgs _ _ [] = noFreeIds
 546
 547 fvsOfArgs fv_cand in_scope [VarArg v] -- this is only a short-cut...
 548   = if (fv_cand in_scope v) then aFreeId v else noFreeIds
 549 fvsOfArgs _       _        [ _ ] = noFreeIds
 550
 551 fvsOfArgs fv_cand in_scope args
 552   = mkIdSet [ v | (VarArg v) <- args, fv_cand in_scope v ]
 553     -- all other types of args are uninteresting here...
 554
 555 ----------
 556 do_pair :: InterestingIdFun -- "Interesting id" predicate
 557         -> IdSet            -- In scope ids
 558         -> IdSet
 559         -> (Id, CoreExpr)
 560         -> ((FVCoreBinder, FVCoreExpr), IdSet)
 561
 562 do_pair fv_cand in_scope binder_set (binder,rhs)
 563  = (((binder, fvs), rhs'), fvs)
 564  where
 565    (rhs', rhs_fvs) = addExprFVs fv_cand in_scope rhs
 566    fvs = rhs_fvs `minusIdSet` binder_set
 567 \end{code}