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,
  14
  15         freeVarsOf, freeTyVarsOf,
  16         FVCoreExpr(..), FVCoreBinding(..),
  17
  18         CoreExprWithFVs(..),            -- For the above functions
  19         AnnCoreExpr(..),                -- Dito
  20         FVInfo(..), LeakInfo(..)
  21     ) where
  22
  23 import 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                           IdSet(..)
  32                         )
  33 import IdInfo           ( arityMaybe )
  34 import PrimOp           ( PrimOp(..) )
  35 import Type             ( tyVarsOfType )
  36 import TyVar            ( emptyTyVarSet, unitTyVarSet, minusTyVarSet,
  37                           intersectTyVarSets,
  38                           TyVarSet(..)
  39                         )
  40 import UniqSet          ( unionUniqSets )
  41 import Usage            ( 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 arityMaybe (getIdArity v) of
 148                             Nothing    -> lEAK_FREE_0
 149                             Just arity -> LeakFree arity
 150
 151 fvExpr id_cands tyvar_cands (Lit k)
 152   = (FVInfo noFreeIds noFreeTyVars lEAK_FREE_0, AnnLit k)
 153
 154 fvExpr id_cands tyvar_cands (Con c args)
 155   = (FVInfo args_fvs tfvs lEAK_FREE_0, AnnCon c args)
 156   where
 157     (args_fvs, tfvs) = freeArgs id_cands tyvar_cands args
 158
 159 fvExpr id_cands tyvar_cands (Prim op args)
 160   = (FVInfo args_fvs tfvs lEAK_FREE_0, AnnPrim op args)
 161   where
 162     (args_fvs, tfvs) = freeArgs id_cands tyvar_cands args_to_use{-NB-}
 163     args_to_use
 164       = case op of
 165           CCallOp _ _ _ _ res_ty -> TyArg res_ty : args
 166           _                      -> args
 167
 168 -- this Lam stuff could probably be improved by rewriting (WDP 96/03)
 169
 170 fvExpr id_cands tyvar_cands (Lam (UsageBinder uvar) body)
 171   = panic "fvExpr:Lam UsageBinder"
 172
 173 fvExpr id_cands tyvar_cands (Lam b@(ValBinder binder) body)
 174   = (FVInfo (freeVarsOf body2   `minusIdSet` unitIdSet binder)
 175             (freeTyVarsOf body2 `combine`    munge_id_ty binder)
 176             leakiness,
 177      AnnLam b body2)
 178   where
 179         -- We need to collect free tyvars from the binders
 180     body2 = fvExpr (unitIdSet binder `combine` id_cands) tyvar_cands body
 181
 182     leakiness = case leakinessOf body2 of
 183                   MightLeak  -> LeakFree 1
 184                   LeakFree n -> LeakFree (n + 1)
 185
 186 fvExpr id_cands tyvar_cands (Lam b@(TyBinder tyvar) body)
 187   = (FVInfo (freeVarsOf body2)
 188             (freeTyVarsOf body2 `minusTyVarSet` aFreeTyVar tyvar)
 189             (leakinessOf body2),
 190      AnnLam b body2)
 191   where
 192     body2 = fvExpr id_cands (aFreeTyVar tyvar `combine` tyvar_cands) body
 193
 194 -- ditto on rewriting this App stuff (WDP 96/03)
 195
 196 fvExpr id_cands tyvar_cands (App fun arg)
 197   = (FVInfo (freeVarsOf fun2   `combine` fvs_arg)
 198             (freeTyVarsOf fun2 `combine` tfvs_arg)
 199             leakiness,
 200      AnnApp fun2 arg)
 201   where
 202     fun2 = fvExpr id_cands tyvar_cands fun
 203     fun2_leakiness = leakinessOf fun2
 204
 205     (fvs_arg, tfvs_arg) = freeArgs id_cands tyvar_cands [arg]
 206
 207     leakiness = if (notValArg arg) then
 208                     fun2_leakiness
 209                 else
 210                     case fun2_leakiness of
 211                        LeakFree n | n>1 -> LeakFree (n-1) -- Note > not >=
 212                        other            -> MightLeak
 213
 214 fvExpr id_cands tyvar_cands (Case expr alts)
 215   = (combineFVInfo expr_fvinfo alts_fvinfo,
 216      AnnCase expr2 alts')
 217   where
 218     expr2@(expr_fvinfo,_) = fvExpr id_cands tyvar_cands expr
 219     (alts_fvinfo, alts') = annotate_alts alts
 220
 221     annotate_alts (AlgAlts alts deflt)
 222       = (fvinfo, AnnAlgAlts alts' deflt')
 223       where
 224         (alts_fvinfo_s, alts') = unzip (map ann_boxed_alt alts)
 225         (deflt_fvinfo, deflt') = annotate_default deflt
 226         fvinfo = foldr combineFVInfo deflt_fvinfo alts_fvinfo_s
 227
 228         ann_boxed_alt (con, params, rhs)
 229           = (FVInfo (freeVarsOf rhs' `minusIdSet` mkIdSet params)
 230                     (freeTyVarsOf rhs' `combine` param_ftvs)
 231                     (leakinessOf rhs'),
 232              (con, params, rhs'))
 233           where
 234             rhs' = fvExpr (mkIdSet params `combine` id_cands) tyvar_cands rhs
 235             param_ftvs = foldr (combine . munge_id_ty) noFreeTyVars params
 236                 -- We need to collect free tyvars from the binders
 237
 238     annotate_alts (PrimAlts alts deflt)
 239       = (fvinfo, AnnPrimAlts alts' deflt')
 240       where
 241         (alts_fvinfo_s, alts') = unzip (map ann_unboxed_alt alts)
 242         (deflt_fvinfo, deflt') = annotate_default deflt
 243         fvinfo  = foldr combineFVInfo deflt_fvinfo alts_fvinfo_s
 244
 245         ann_unboxed_alt (lit, rhs) = (rhs_info, (lit, rhs'))
 246           where
 247             rhs'@(rhs_info,_) = fvExpr id_cands tyvar_cands rhs
 248
 249     annotate_default NoDefault = (FVInfo noFreeIds noFreeTyVars lEAK_FREE_BIG,
 250                                     AnnNoDefault)
 251
 252     annotate_default (BindDefault binder rhs)
 253       = (FVInfo (freeVarsOf   rhs' `minusIdSet` aFreeId binder)
 254                 (freeTyVarsOf rhs' `combine` binder_ftvs)
 255                 (leakinessOf rhs'),
 256          AnnBindDefault binder rhs')
 257       where
 258         rhs' = fvExpr (aFreeId binder `combine` id_cands) tyvar_cands rhs
 259         binder_ftvs = munge_id_ty binder
 260             -- We need to collect free tyvars from the binder
 261
 262 fvExpr id_cands tyvar_cands (Let (NonRec binder rhs) body)
 263   = (FVInfo (freeVarsOf rhs'   `combine` body_fvs)
 264             (freeTyVarsOf rhs' `combine` freeTyVarsOf body2 `combine` binder_ftvs)
 265             (leakinessOf rhs' `orLeak` leakinessOf body2),
 266      AnnLet (AnnNonRec binder rhs') body2)
 267   where
 268     rhs'        = fvExpr id_cands tyvar_cands rhs
 269     body2       = fvExpr (aFreeId binder `combine` id_cands) tyvar_cands body
 270     body_fvs    = freeVarsOf body2 `minusIdSet` aFreeId binder
 271     binder_ftvs = munge_id_ty binder
 272         -- We need to collect free tyvars from the binder
 273
 274 fvExpr id_cands tyvar_cands (Let (Rec binds) body)
 275   = (FVInfo (binds_fvs `combine` body_fvs)
 276             (rhss_tfvs `combine` freeTyVarsOf body2 `combine` binders_ftvs)
 277             (leakiness_of_rhss `orLeak` leakinessOf body2),
 278      AnnLet (AnnRec (binders `zip` rhss')) body2)
 279   where
 280     (binders, rhss)   = unzip binds
 281     new_id_cands      = binders_set `combine` id_cands
 282     binders_set       = mkIdSet binders
 283     rhss'             = map (fvExpr new_id_cands tyvar_cands) rhss
 284
 285     FVInfo rhss_fvs rhss_tfvs leakiness_of_rhss
 286         = foldr1 combineFVInfo [info | (info,_) <- rhss']
 287
 288     binds_fvs         = rhss_fvs `minusIdSet` binders_set
 289     body2             = fvExpr new_id_cands tyvar_cands body
 290     body_fvs          = freeVarsOf body2 `minusIdSet` binders_set
 291     binders_ftvs      = foldr (combine . munge_id_ty) noFreeTyVars binders
 292         -- We need to collect free tyvars from the binders
 293
 294 fvExpr id_cands tyvar_cands (SCC label expr)
 295   = (fvinfo, AnnSCC label expr2)
 296   where
 297     expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
 298 \end{code}
 299
 300 \begin{code}
 301 freeArgs :: IdCands -> TyVarCands
 302          -> [CoreArg]
 303          -> (IdSet, TyVarSet)
 304
 305 freeArgs icands tcands [] = noFreeAnything
 306 freeArgs icands tcands (arg:args)
 307   -- this code is written this funny way only for "efficiency" purposes
 308   = let
 309         free_first_arg@(arg_fvs, tfvs) = free_arg arg
 310     in
 311     if (null args) then
 312         free_first_arg
 313     else
 314         case (freeArgs icands tcands args) of { (irest, trest) ->
 315         (arg_fvs `combine` irest, tfvs `combine` trest) }
 316   where
 317     free_arg (LitArg   _) = noFreeAnything
 318     free_arg (UsageArg _) = noFreeAnything
 319     free_arg (TyArg   ty) = (noFreeIds, freeTy tcands ty)
 320     free_arg (VarArg   v)
 321       | v `is_among` icands = (aFreeId v, noFreeTyVars)
 322       | otherwise           = noFreeAnything
 323
 324 ---------
 325 freeTy :: TyVarCands -> Type -> TyVarSet
 326
 327 freeTy cands ty = tyVarsOfType ty `intersectTyVarSets` cands
 328
 329 freeVarsOf :: CoreExprWithFVs -> IdSet
 330 freeVarsOf (FVInfo free_vars _ _, _) = free_vars
 331
 332 freeTyVarsOf :: CoreExprWithFVs -> TyVarSet
 333 freeTyVarsOf (FVInfo _ free_tyvars _, _) = free_tyvars
 334
 335 leakinessOf :: CoreExprWithFVs -> LeakInfo
 336 leakinessOf (FVInfo _ _ leakiness, _) = leakiness
 337 \end{code}
 338
 339
 340 %************************************************************************
 341 %*                                                                      *
 342 \section[freevars-binders]{Attaching free variables to binders
 343 %*                                                                      *
 344 %************************************************************************
 345
 346
 347 Here's an variant of the free-variable pass, which pins free-variable
 348 information on {\em binders} rather than every single jolly
 349 expression!
 350 \begin{itemize}
 351 \item
 352   The free vars attached to a lambda binder are the free vars of the
 353   whole lambda abstraction.  If there are multiple binders, they are
 354   each given the same free-var set.
 355 \item
 356   The free vars attached to a let(rec) binder are the free vars of the
 357   rhs of the binding.  In the case of letrecs, this set excludes the
 358   binders themselves.
 359 \item
 360   The free vars attached to a case alternative binder are the free
 361   vars of the alternative, excluding the alternative's binders.
 362 \end{itemize}
 363
 364 There's a predicate carried in which tells what is a free-var
 365 candidate. It is passed the Id and a set of in-scope Ids.
 366
 367 (Global) constructors used on the rhs in a Con are also treated as
 368 potential free-var candidates (though they will not be recorded in the
 369 in-scope set). The predicate must decide if they are to be recorded as
 370 free-vars.
 371
 372 As it happens this is only ever used by the Specialiser!
 373
 374 \begin{code}
 375 type FVCoreBinder  = (Id, IdSet)
 376 type FVCoreExpr    = GenCoreExpr    FVCoreBinder Id TyVar UVar
 377 type FVCoreBinding = GenCoreBinding FVCoreBinder Id TyVar UVar
 378
 379 type InterestingIdFun
 380   =  IdSet      -- Non-top-level in-scope variables
 381   -> Id         -- The Id being looked at
 382   -> Bool       -- True <=> interesting
 383 \end{code}
 384
 385 \begin{code}
 386 addExprFVs :: InterestingIdFun  -- "Interesting id" predicate
 387            -> IdSet             -- In scope ids
 388            -> CoreExpr
 389            -> (FVCoreExpr, IdSet)
 390
 391 addExprFVs fv_cand in_scope (Var v)
 392   = (Var v, if fv_cand in_scope v
 393               then aFreeId v
 394               else noFreeIds)
 395
 396 addExprFVs fv_cand in_scope (Lit lit) = (Lit lit, noFreeIds)
 397
 398 addExprFVs fv_cand in_scope (Con con args)
 399   = (Con con args,
 400      if fv_cand in_scope con
 401      then aFreeId con
 402      else noFreeIds `combine` fvsOfArgs fv_cand in_scope args)
 403
 404 addExprFVs fv_cand in_scope (Prim op args)
 405   = (Prim op args, fvsOfArgs fv_cand in_scope args)
 406
 407 addExprFVs fv_cand in_scope (Lam binder body)
 408   = (Lam new_binder new_body, lam_fvs)
 409   where
 410     (new_binder, binder_set)
 411       = case binder of
 412           TyBinder    t -> (TyBinder t, emptyIdSet)
 413           UsageBinder u -> (UsageBinder u, emptyIdSet)
 414           ValBinder   b -> (ValBinder (b, lam_fvs),
 415                             unitIdSet b)
 416
 417     new_in_scope         = in_scope `combine` binder_set
 418     (new_body, body_fvs) = addExprFVs fv_cand new_in_scope body
 419     lam_fvs              = body_fvs `minusIdSet` binder_set
 420
 421 addExprFVs fv_cand in_scope (App fun arg)
 422   = (App fun2 arg, fun_fvs `combine` fvsOfArgs fv_cand in_scope [arg])
 423   where
 424     (fun2, fun_fvs) = addExprFVs fv_cand in_scope fun
 425
 426 addExprFVs fv_cand in_scope (Case scrut alts)
 427   = (Case scrut' alts', scrut_fvs `combine` alts_fvs)
 428   where
 429     (scrut', scrut_fvs) = addExprFVs fv_cand in_scope scrut
 430
 431     (alts', alts_fvs)
 432       = case alts of
 433           AlgAlts alg_alts deflt -> (AlgAlts alg_alts' deflt', fvs)
 434             where
 435               (alg_alts', alt_fvs) = unzip (map do_alg_alt alg_alts)
 436               (deflt', deflt_fvs) = do_deflt deflt
 437               fvs = unionManyIdSets (deflt_fvs : alt_fvs)
 438
 439           PrimAlts prim_alts deflt -> (PrimAlts prim_alts' deflt', fvs)
 440             where
 441               (prim_alts', alt_fvs) = unzip (map do_prim_alt prim_alts)
 442               (deflt', deflt_fvs) = do_deflt deflt
 443               fvs = unionManyIdSets (deflt_fvs : alt_fvs)
 444
 445     do_alg_alt :: (Id, [Id], CoreExpr)
 446                -> ((Id, [FVCoreBinder], FVCoreExpr), IdSet)
 447
 448     do_alg_alt (con, args, rhs) = ((con, args `zip` (repeat fvs), rhs'), fvs)
 449       where
 450         new_in_scope = in_scope `combine` arg_set
 451         (rhs', rhs_fvs) = addExprFVs fv_cand new_in_scope rhs
 452         fvs = rhs_fvs `minusIdSet` arg_set
 453         arg_set = mkIdSet args
 454
 455     do_prim_alt (lit, rhs) = ((lit, rhs'), rhs_fvs)
 456       where
 457         (rhs', rhs_fvs) = addExprFVs fv_cand in_scope rhs
 458
 459     do_deflt NoDefault = (NoDefault, noFreeIds)
 460     do_deflt (BindDefault var rhs)
 461       = (BindDefault (var,fvs) rhs', fvs)
 462       where
 463         new_in_scope = in_scope `combine` var_set
 464         (rhs', rhs_fvs) = addExprFVs fv_cand new_in_scope rhs
 465         fvs = rhs_fvs `minusIdSet` var_set
 466         var_set = aFreeId var
 467
 468 addExprFVs fv_cand in_scope (Let binds body)
 469   = (Let binds' body2, fvs_binds `combine` (fvs_body `minusIdSet` binder_set))
 470   where
 471     (binds', fvs_binds, new_in_scope, binder_set)
 472       = addBindingFVs fv_cand in_scope binds
 473
 474     (body2, fvs_body)  = addExprFVs fv_cand new_in_scope body
 475
 476 addExprFVs fv_cand in_scope (SCC label expr)
 477   = (SCC label expr2, expr_fvs)
 478   where
 479     (expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
 480 \end{code}
 481
 482 \begin{code}
 483 addBindingFVs
 484             :: InterestingIdFun -- "Interesting id" predicate
 485             -> IdSet            -- In scope ids
 486             -> CoreBinding
 487             -> (FVCoreBinding,
 488                 IdSet,          -- Free vars of binding group
 489                 IdSet,          -- Augmented in-scope Ids
 490                 IdSet)          -- Set of Ids bound by this binding
 491
 492 addBindingFVs fv_cand in_scope (NonRec binder rhs)
 493   = (NonRec binder' rhs', fvs, new_in_scope, binder_set)
 494   where
 495     ((binder', rhs'), fvs) = do_pair fv_cand in_scope binder_set (binder, rhs)
 496     new_in_scope = in_scope `combine` binder_set
 497     binder_set = aFreeId binder
 498
 499 addBindingFVs fv_cand in_scope (Rec pairs)
 500   = (Rec pairs', unionManyIdSets fvs_s, new_in_scope, binder_set)
 501   where
 502     binders = [binder | (binder,_) <- pairs]
 503     binder_set = mkIdSet binders
 504     new_in_scope = in_scope `combine` binder_set
 505     (pairs', fvs_s) = unzip (map (do_pair fv_cand new_in_scope binder_set) pairs)
 506 \end{code}
 507
 508 \begin{code}
 509 addTopBindsFVs
 510             :: InterestingIdFun -- "Interesting id" predicate
 511             -> [CoreBinding]
 512             -> ([FVCoreBinding],
 513                 IdSet)
 514
 515 addTopBindsFVs fv_cand [] = ([], noFreeIds)
 516 addTopBindsFVs fv_cand (b:bs)
 517   = let
 518       (b',  fvs_b, _, _) = addBindingFVs fv_cand noFreeIds b
 519       (bs', fvs_bs)      = addTopBindsFVs fv_cand bs
 520     in
 521     (b' : bs', fvs_b `combine` fvs_bs)
 522 \end{code}
 523
 524 \begin{code}
 525 fvsOfArgs   :: InterestingIdFun -- "Interesting id" predicate
 526             -> IdSet            -- In scope ids
 527             -> [CoreArg]
 528             -> IdSet
 529
 530 fvsOfArgs _ _ [] = noFreeIds
 531
 532 fvsOfArgs fv_cand in_scope [VarArg v] -- this is only a short-cut...
 533   = if (fv_cand in_scope v) then aFreeId v else noFreeIds
 534 fvsOfArgs _       _        [ _ ] = noFreeIds
 535
 536 fvsOfArgs fv_cand in_scope args
 537   = mkIdSet [ v | (VarArg v) <- args, fv_cand in_scope v ]
 538     -- all other types of args are uninteresting here...
 539
 540 ----------
 541 do_pair :: InterestingIdFun -- "Interesting id" predicate
 542         -> IdSet            -- In scope ids
 543         -> IdSet
 544         -> (Id, CoreExpr)
 545         -> ((FVCoreBinder, FVCoreExpr), IdSet)
 546
 547 do_pair fv_cand in_scope binder_set (binder,rhs)
 548  = (((binder, fvs), rhs'), fvs)
 549  where
 550    (rhs', rhs_fvs) = addExprFVs fv_cand in_scope rhs
 551    fvs = rhs_fvs `minusIdSet` binder_set
 552 \end{code}