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