Factorize and document binder collect functions

Parameterize collect*Binders functions with a flag indicating if
evidence binders should be collected.

The related note in GHC.Hs.Utils has been updated.

Bump haddock submodule

5 files changed, 19 insertions, 18 deletions

diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index ea76feea82..fdcf89104f 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -266,7 +266,7 @@ rnLocalValBindsLHS fix_env binds
          --   import A(f)
          --   g = let f = ... in f
          -- should.
-       ; let bound_names = collectHsValBinders binds'
+       ; let bound_names = collectHsValBinders CollNoDictBinders binds'
              -- There should be only Ids, but if there are any bogus
              -- pattern synonyms, we'll collect them anyway, so that
              -- we don't generate subsequent out-of-scope messages
@@ -285,7 +285,7 @@ rnValBindsLHS topP (ValBinds x mbinds sigs)
   = do { mbinds' <- mapBagM (wrapLocM (rnBindLHS topP doc)) mbinds
        ; return $ ValBinds x mbinds' sigs }
   where
-    bndrs = collectHsBindsBinders mbinds
+    bndrs = collectHsBindsBinders CollNoDictBinders mbinds
     doc   = text "In the binding group for:" <+> pprWithCommas ppr bndrs
 
 rnValBindsLHS _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
@@ -472,7 +472,7 @@ rnBind _ bind@(PatBind { pat_lhs = pat
                 -- Keep locally-defined Names
                 -- As well as dependency analysis, we need these for the
                 -- MonoLocalBinds test in GHC.Tc.Gen.Bind.decideGeneralisationPlan
-              bndrs = collectPatBinders pat
+              bndrs = collectPatBinders CollNoDictBinders pat
               bind' = bind { pat_rhs  = grhss'
                            , pat_ext = fvs' }
 
@@ -864,7 +864,7 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
        --       (==) :: a -> a -> a
        --       {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
        ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs
-             bound_nms = mkNameSet (collectHsBindsBinders binds')
+             bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds')
              sig_ctxt | is_cls_decl = ClsDeclCtxt cls
                       | otherwise   = InstDeclCtxt bound_nms
        ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index b38b4679b1..bfa773ed9f 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -838,7 +838,7 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body)) thing_inside
         ; (fail_op, fvs2) <- monadFailOp pat ctxt
 
         ; rnPat (StmtCtxt ctxt) pat $ \ pat' -> do
-        { (thing, fvs3) <- thing_inside (collectPatBinders pat')
+        { (thing, fvs3) <- thing_inside (collectPatBinders CollNoDictBinders pat')
         ; let xbsrn = XBindStmtRn { xbsrn_bindOp = bind_op, xbsrn_failOp = fail_op }
         ; return (( [( L loc (BindStmt xbsrn pat' body'), fv_expr )]
                   , thing),
@@ -848,7 +848,7 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body)) thing_inside
 
 rnStmt _ _ (L loc (LetStmt _ (L l binds))) thing_inside
   =     rnLocalBindsAndThen binds $ \binds' bind_fvs -> do
-        { (thing, fvs) <- thing_inside (collectLocalBinders binds')
+        { (thing, fvs) <- thing_inside (collectLocalBinders CollNoDictBinders binds')
         ; return ( ([(L loc (LetStmt noExtField (L l binds')), bind_fvs)], thing)
                  , fvs) }
 
@@ -1064,7 +1064,7 @@ rnRecStmtsAndThen ctxt rnBody s cont
         ; new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s
 
           --    ...bring them and their fixities into scope
-        ; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv)
+        ; let bound_names = collectLStmtsBinders CollNoDictBinders (map fst new_lhs_and_fv)
               -- Fake uses of variables introduced implicitly (warning suppression, see #4404)
               rec_uses = lStmtsImplicits (map fst new_lhs_and_fv)
               implicit_uses = mkNameSet $ concatMap snd $ rec_uses
@@ -1141,7 +1141,7 @@ rn_rec_stmts_lhs :: Outputable body => MiniFixityEnv
                  -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
 rn_rec_stmts_lhs fix_env stmts
   = do { ls <- concatMapM (rn_rec_stmt_lhs fix_env) stmts
-       ; let boundNames = collectLStmtsBinders (map fst ls)
+       ; let boundNames = collectLStmtsBinders CollNoDictBinders (map fst ls)
             -- First do error checking: we need to check for dups here because we
             -- don't bind all of the variables from the Stmt at once
             -- with bindLocatedLocals.
@@ -1178,7 +1178,7 @@ rn_rec_stmt ctxt rnBody _ (L loc (BindStmt _ pat' body), fv_pat)
 
        ; (fail_op, fvs2) <- getMonadFailOp ctxt
 
-       ; let bndrs = mkNameSet (collectPatBinders pat')
+       ; let bndrs = mkNameSet (collectPatBinders CollNoDictBinders pat')
              fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
        ; let xbsrn = XBindStmtRn { xbsrn_bindOp = bind_op, xbsrn_failOp = fail_op }
        ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
@@ -1734,7 +1734,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do
              }, emptyFVs)
    stmtTreeArg ctxt tail_fvs tree = do
      let stmts = flattenStmtTree tree
-         pvarset = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts)
+         pvarset = mkNameSet (concatMap (collectStmtBinders CollNoDictBinders . unLoc . fst) stmts)
                      `intersectNameSet` tail_fvs
          pvars = nameSetElemsStable pvarset
            -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]
@@ -1765,7 +1765,7 @@ segments
   -> [[(ExprLStmt GhcRn, FreeVars)]]
 segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts)
   where
-    allvars = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts)
+    allvars = mkNameSet (concatMap (collectStmtBinders CollNoDictBinders . unLoc . fst) stmts)
 
     -- We would rather not have a segment that just has LetStmts in
     -- it, so combine those with an adjacent segment where possible.
@@ -1805,7 +1805,7 @@ segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts)
       | isLetStmt stmt = (pvars, fvs' `minusNameSet` pvars)
       | otherwise      = (pvars, fvs')
       where fvs' = fvs `intersectNameSet` allvars
-            pvars = mkNameSet (collectStmtBinders (unLoc stmt))
+            pvars = mkNameSet (collectStmtBinders CollNoDictBinders (unLoc stmt))
 
     isStrictPatternBind :: ExprLStmt GhcRn -> Bool
     isStrictPatternBind (L _ (BindStmt _ pat _)) = isStrictPattern pat
@@ -1912,7 +1912,7 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts
     | disjointNameSet bndrs fvs && not (isStrictPattern pat)
     = go lets ((L loc (BindStmt xbs pat body), fvs) : indep)
          bndrs' rest
-    where bndrs' = bndrs `unionNameSet` mkNameSet (collectPatBinders pat)
+    where bndrs' = bndrs `unionNameSet` mkNameSet (collectPatBinders CollNoDictBinders pat)
   -- If we encounter a LetStmt that doesn't depend on a BindStmt in this
   -- group, then move it to the beginning, so that it doesn't interfere with
   -- grouping more BindStmts.
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index e098156d1d..7fd73855ba 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -141,8 +141,9 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
 
    -- Bind the LHSes (and their fixities) in the global rdr environment
-   let { id_bndrs = collectHsIdBinders new_lhs } ;  -- Excludes pattern-synonym binders
-                                                    -- They are already in scope
+   let { id_bndrs = collectHsIdBinders CollNoDictBinders new_lhs } ;
+                    -- Excludes pattern-synonym binders
+                    -- They are already in scope
    traceRn "rnSrcDecls" (ppr id_bndrs) ;
    tc_envs <- extendGlobalRdrEnvRn (map avail id_bndrs) local_fix_env ;
    setEnvs tc_envs $ do {
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index a52f7bca3c..0f6e4e1cce 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1432,7 +1432,7 @@ warnMissingSignatures gbl_env
   = do { let exports = availsToNameSet (tcg_exports gbl_env)
              sig_ns  = tcg_sigs gbl_env
                -- We use sig_ns to exclude top-level bindings that are generated by GHC
-             binds    = collectHsBindsBinders $ tcg_binds gbl_env
+             binds    = collectHsBindsBinders CollNoDictBinders $ tcg_binds gbl_env
              pat_syns = tcg_patsyns gbl_env
 
          -- Warn about missing signatures
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 80ab505ee5..80341b27ac 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -341,7 +341,7 @@ rnPats ctxt pats thing_inside
           --    complain *twice* about duplicates e.g. f (x,x) = ...
           --
           -- See note [Don't report shadowing for pattern synonyms]
-        ; let bndrs = collectPatsBinders pats'
+        ; let bndrs = collectPatsBinders CollNoDictBinders pats'
         ; addErrCtxt doc_pat $
           if isPatSynCtxt ctxt
              then checkDupNames bndrs
@@ -596,7 +596,7 @@ rnHsRecPatsAndThen mk (L _ con)
     loc = maybe noSrcSpan getLoc dd
 
     -- Get the arguments of the implicit binders
-    implicit_binders fs (unLoc -> n) = collectPatsBinders implicit_pats
+    implicit_binders fs (unLoc -> n) = collectPatsBinders CollNoDictBinders implicit_pats
       where
         implicit_pats = map (hsRecFieldArg . unLoc) (drop n fs)