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

19 files changed, 284 insertions, 266 deletions

diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index e414269413..e538549265 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -28,6 +28,8 @@ just attach noSrcSpan to everything.
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE GADTs #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -90,10 +92,11 @@ module GHC.Hs.Utils(
   collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
   collectHsIdBinders,
   collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,
+
   collectPatBinders, collectPatsBinders,
   collectLStmtsBinders, collectStmtsBinders,
   collectLStmtBinders, collectStmtBinders,
-  CollectPass(..),
+  CollectPass(..), CollectFlag(..),
 
   hsLTyClDeclBinders, hsTyClForeignBinders,
   hsPatSynSelectors, getPatSynBinds,
@@ -907,7 +910,7 @@ isUnliftedHsBind bind
     -- binding might not be: e.g. forall a. Num a => (# a, a #)
 
   | otherwise
-  = any is_unlifted_id (collectHsBindBinders bind)
+  = any is_unlifted_id (collectHsBindBinders CollNoDictBinders bind)
   where
     is_unlifted_id id = isUnliftedType (idType id)
 
@@ -925,80 +928,91 @@ isBangedHsBind _
   = False
 
 collectLocalBinders :: CollectPass (GhcPass idL)
-                    => HsLocalBindsLR (GhcPass idL) (GhcPass idR)
+                    => CollectFlag (GhcPass idL)
+                    -> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
                     -> [IdP (GhcPass idL)]
-collectLocalBinders (HsValBinds _ binds) = collectHsIdBinders binds
-                                         -- No pattern synonyms here
-collectLocalBinders (HsIPBinds {})      = []
-collectLocalBinders (EmptyLocalBinds _) = []
+collectLocalBinders flag = \case
+    HsValBinds _ binds -> collectHsIdBinders flag binds
+                          -- No pattern synonyms here
+    HsIPBinds {}       -> []
+    EmptyLocalBinds _  -> []
 
 collectHsIdBinders :: CollectPass (GhcPass idL)
-                   => HsValBindsLR (GhcPass idL) (GhcPass idR)
+                   => CollectFlag (GhcPass idL)
+                   -> HsValBindsLR (GhcPass idL) (GhcPass idR)
                    -> [IdP (GhcPass idL)]
 -- ^ Collect 'Id' binders only, or 'Id's + pattern synonyms, respectively
-collectHsIdBinders  = collect_hs_val_binders True
+collectHsIdBinders flag = collect_hs_val_binders True flag
 
 collectHsValBinders :: CollectPass (GhcPass idL)
-                    => HsValBindsLR (GhcPass idL) (GhcPass idR)
+                    => CollectFlag (GhcPass idL)
+                    -> HsValBindsLR (GhcPass idL) (GhcPass idR)
                     -> [IdP (GhcPass idL)]
-collectHsValBinders = collect_hs_val_binders False
+collectHsValBinders flag = collect_hs_val_binders False flag
 
 collectHsBindBinders :: CollectPass p
-                     => HsBindLR p idR
+                     => CollectFlag p
+                     -> HsBindLR p idR
                      -> [IdP p]
 -- ^ Collect both 'Id's and pattern-synonym binders
-collectHsBindBinders b = collect_bind False b []
+collectHsBindBinders flag b = collect_bind False flag b []
 
 collectHsBindsBinders :: CollectPass p
-                      => LHsBindsLR p idR
+                      => CollectFlag p
+                      -> LHsBindsLR p idR
                       -> [IdP p]
-collectHsBindsBinders binds = collect_binds False binds []
+collectHsBindsBinders flag binds = collect_binds False flag binds []
 
 collectHsBindListBinders :: forall p idR. CollectPass p
-                         => [LHsBindLR p idR]
+                         => CollectFlag p
+                         -> [LHsBindLR p idR]
                          -> [IdP p]
 -- ^ Same as 'collectHsBindsBinders', but works over a list of bindings
-collectHsBindListBinders = foldr (collect_bind False . unXRec @p) []
+collectHsBindListBinders flag = foldr (collect_bind False flag . unXRec @p) []
 
 collect_hs_val_binders :: CollectPass (GhcPass idL)
                        => Bool
+                       -> CollectFlag (GhcPass idL)
                        -> HsValBindsLR (GhcPass idL) (GhcPass idR)
                        -> [IdP (GhcPass idL)]
-collect_hs_val_binders ps (ValBinds _ binds _) = collect_binds ps binds []
-collect_hs_val_binders ps (XValBindsLR (NValBinds binds _))
-  = collect_out_binds ps binds
+collect_hs_val_binders ps flag = \case
+    ValBinds _ binds _              -> collect_binds ps flag binds []
+    XValBindsLR (NValBinds binds _) -> collect_out_binds ps flag binds
 
 collect_out_binds :: forall p. CollectPass p
                   => Bool
+                  -> CollectFlag p
                   -> [(RecFlag, LHsBinds p)]
                   -> [IdP p]
-collect_out_binds ps = foldr (collect_binds ps . snd) []
+collect_out_binds ps flag = foldr (collect_binds ps flag . snd) []
 
 collect_binds :: forall p idR. CollectPass p
               => Bool
+              -> CollectFlag p
               -> LHsBindsLR p idR
               -> [IdP p]
               -> [IdP p]
 -- ^ Collect 'Id's, or 'Id's + pattern synonyms, depending on boolean flag
-collect_binds ps binds acc = foldr (collect_bind ps . unXRec @p) acc binds
+collect_binds ps flag binds acc = foldr (collect_bind ps flag . unXRec @p) acc binds
 
 collect_bind :: forall p idR. CollectPass p
              => Bool
+             -> CollectFlag p
              -> HsBindLR p idR
              -> [IdP p]
              -> [IdP p]
-collect_bind _ (PatBind { pat_lhs = p })           acc = collect_lpat p acc
-collect_bind _ (FunBind { fun_id = f })            acc = unXRec @p f : acc
-collect_bind _ (VarBind { var_id = f })            acc = f : acc
-collect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc
+collect_bind _ flag (PatBind { pat_lhs = p })           acc = collect_lpat flag p acc
+collect_bind _ _ (FunBind { fun_id = f })            acc = unXRec @p f : acc
+collect_bind _ _ (VarBind { var_id = f })            acc = f : acc
+collect_bind _ _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc
         -- I don't think we want the binders from the abe_binds
 
         -- binding (hence see AbsBinds) is in zonking in GHC.Tc.Utils.Zonk
-collect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = ps })) acc
+collect_bind omitPatSyn _ (PatSynBind _ (PSB { psb_id = ps })) acc
   | omitPatSyn                  = acc
   | otherwise                   = unXRec @p ps : acc
-collect_bind _ (PatSynBind _ (XPatSynBind _)) acc = acc
-collect_bind _ (XHsBindsLR _) acc = acc
+collect_bind _ _ (PatSynBind _ (XPatSynBind _)) acc = acc
+collect_bind _ _ (XHsBindsLR _) acc = acc
 
 collectMethodBinders :: forall idL idR. UnXRec idL => LHsBindsLR idL idR -> [LIdP idL]
 -- ^ Used exclusively for the bindings of an instance decl which are all
@@ -1010,77 +1024,127 @@ collectMethodBinders binds = foldr (get . unXRec @idL) [] binds
        -- Someone else complains about non-FunBinds
 
 ----------------- Statements --------------------------
-collectLStmtsBinders :: (CollectPass (GhcPass idL))
-                     => [LStmtLR (GhcPass idL) (GhcPass idR) body]
-                     -> [IdP (GhcPass idL)]
-collectLStmtsBinders = concatMap collectLStmtBinders
-
-collectStmtsBinders :: (CollectPass (GhcPass idL))
-                    => [StmtLR (GhcPass idL) (GhcPass idR) body]
-                    -> [IdP (GhcPass idL)]
-collectStmtsBinders = concatMap collectStmtBinders
-
-collectLStmtBinders :: (CollectPass (GhcPass idL))
-                    => LStmtLR (GhcPass idL) (GhcPass idR) body
-                    -> [IdP (GhcPass idL)]
-collectLStmtBinders = collectStmtBinders . unLoc
-
-collectStmtBinders :: (CollectPass (GhcPass idL))
-                   => StmtLR (GhcPass idL) (GhcPass idR) body
-                   -> [IdP (GhcPass idL)]
+--
+collectLStmtsBinders
+  :: CollectPass (GhcPass idL)
+  => CollectFlag (GhcPass idL)
+  -> [LStmtLR (GhcPass idL) (GhcPass idR) body]
+  -> [IdP (GhcPass idL)]
+collectLStmtsBinders flag = concatMap (collectLStmtBinders flag)
+
+collectStmtsBinders
+  :: (CollectPass (GhcPass idL))
+  => CollectFlag (GhcPass idL)
+  -> [StmtLR (GhcPass idL) (GhcPass idR) body]
+  -> [IdP (GhcPass idL)]
+collectStmtsBinders flag = concatMap (collectStmtBinders flag)
+
+collectLStmtBinders
+  :: (CollectPass (GhcPass idL))
+  => CollectFlag (GhcPass idL)
+  -> LStmtLR (GhcPass idL) (GhcPass idR) body
+  -> [IdP (GhcPass idL)]
+collectLStmtBinders flag = collectStmtBinders flag . unLoc
+
+collectStmtBinders
+  :: CollectPass (GhcPass idL)
+  => CollectFlag (GhcPass idL)
+  -> StmtLR (GhcPass idL) (GhcPass idR) body
+  -> [IdP (GhcPass idL)]
   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
-collectStmtBinders (BindStmt _ pat _)      = collectPatBinders pat
-collectStmtBinders (LetStmt _  binds)      = collectLocalBinders (unLoc binds)
-collectStmtBinders (BodyStmt {})           = []
-collectStmtBinders (LastStmt {})           = []
-collectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders
-                                    $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]
-collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
-collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
-collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
- where
-  collectArgBinders (_, ApplicativeArgOne { app_arg_pattern = pat }) = collectPatBinders pat
-  collectArgBinders (_, ApplicativeArgMany { bv_pattern = pat }) = collectPatBinders pat
-  collectArgBinders (_, XApplicativeArg {}) = []
+collectStmtBinders flag = \case
+    BindStmt _ pat _ -> collectPatBinders flag pat
+    LetStmt _  binds -> collectLocalBinders flag (unLoc binds)
+    BodyStmt {}      -> []
+    LastStmt {}      -> []
+    ParStmt _ xs _ _ -> collectLStmtsBinders flag [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]
+    TransStmt { trS_stmts = stmts } -> collectLStmtsBinders flag stmts
+    RecStmt { recS_stmts = ss }     -> collectLStmtsBinders flag ss
+    ApplicativeStmt _ args _        -> concatMap collectArgBinders args
+        where
+         collectArgBinders = \case
+            (_, ApplicativeArgOne { app_arg_pattern = pat }) -> collectPatBinders flag pat
+            (_, ApplicativeArgMany { bv_pattern = pat })     -> collectPatBinders flag pat
 
 
 ----------------- Patterns --------------------------
-collectPatBinders :: CollectPass p => LPat p -> [IdP p]
-collectPatBinders pat = collect_lpat pat []
 
-collectPatsBinders :: CollectPass p => [LPat p] -> [IdP p]
-collectPatsBinders pats = foldr collect_lpat [] pats
+collectPatBinders
+    :: CollectPass p
+    => CollectFlag p
+    -> LPat p
+    -> [IdP p]
+collectPatBinders flag pat = collect_lpat flag pat []
+
+collectPatsBinders
+    :: CollectPass p
+    => CollectFlag p
+    -> [LPat p]
+    -> [IdP p]
+collectPatsBinders flag pats = foldr (collect_lpat flag) [] pats
+
 
 -------------
-collect_lpat :: forall pass. (CollectPass pass)
-             => LPat pass -> [IdP pass] -> [IdP pass]
-collect_lpat p bndrs = collect_pat (unXRec @pass p) bndrs
+
+-- | Indicate if evidence binders have to be collected.
+--
+-- This type is used as a boolean (should we collect evidence binders or not?)
+-- but also to pass an evidence that the AST has been typechecked when we do
+-- want to collect evidence binders, otherwise these binders are not available.
+--
+-- See Note [Dictionary binders in ConPatOut]
+data CollectFlag p where
+    -- | Don't collect evidence binders
+    CollNoDictBinders   :: CollectFlag p
+    -- | Collect evidence binders
+    CollWithDictBinders :: CollectFlag GhcTc
+
+collect_lpat :: forall p. (CollectPass p)
+             => CollectFlag p
+             -> LPat p
+             -> [IdP p]
+             -> [IdP p]
+collect_lpat flag pat bndrs = collect_pat flag (unXRec @p pat) bndrs
 
 collect_pat :: forall p. CollectPass p
-            => Pat p
+            => CollectFlag p
+            -> Pat p
             -> [IdP p]
             -> [IdP p]
-collect_pat pat bndrs = case pat of
-  (VarPat _ var)          -> unXRec @p var : bndrs
-  (WildPat _)             -> bndrs
-  (LazyPat _ pat)         -> collect_lpat pat bndrs
-  (BangPat _ pat)         -> collect_lpat pat bndrs
-  (AsPat _ a pat)         -> unXRec @p a : collect_lpat pat bndrs
-  (ViewPat _ _ pat)       -> collect_lpat pat bndrs
-  (ParPat _ pat)          -> collect_lpat pat bndrs
-  (ListPat _ pats)        -> foldr collect_lpat bndrs pats
-  (TuplePat _ pats _)     -> foldr collect_lpat bndrs pats
-  (SumPat _ pat _ _)      -> collect_lpat pat bndrs
-  (ConPat {pat_args=ps})  -> foldr collect_lpat bndrs (hsConPatArgs ps)
+collect_pat flag pat bndrs = case pat of
+  VarPat _ var          -> unXRec @p var : bndrs
+  WildPat _             -> bndrs
+  LazyPat _ pat         -> collect_lpat flag pat bndrs
+  BangPat _ pat         -> collect_lpat flag pat bndrs
+  AsPat _ a pat         -> unXRec @p a : collect_lpat flag pat bndrs
+  ViewPat _ _ pat       -> collect_lpat flag pat bndrs
+  ParPat _ pat          -> collect_lpat flag pat bndrs
+  ListPat _ pats        -> foldr (collect_lpat flag) bndrs pats
+  TuplePat _ pats _     -> foldr (collect_lpat flag) bndrs pats
+  SumPat _ pat _ _      -> collect_lpat flag pat bndrs
+  LitPat _ _            -> bndrs
+  NPat {}               -> bndrs
+  NPlusKPat _ n _ _ _ _ -> unXRec @p n : bndrs
+  SigPat _ pat _        -> collect_lpat flag pat bndrs
+  XPat ext              -> collectXXPat (Proxy @p) flag ext bndrs
+  SplicePat _ (HsSpliced _ _ (HsSplicedPat pat))
+                        -> collect_pat flag pat bndrs
+  SplicePat _ _         -> bndrs
   -- See Note [Dictionary binders in ConPatOut]
-  (LitPat _ _)            -> bndrs
-  (NPat {})               -> bndrs
-  (NPlusKPat _ n _ _ _ _) -> unXRec @p n : bndrs
-  (SigPat _ pat _)        -> collect_lpat pat bndrs
-  (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))
-                          -> collect_pat pat bndrs
-  (SplicePat _ _)         -> bndrs
-  (XPat ext)              -> collectXXPat (Proxy @p) ext bndrs
+  ConPat {pat_args=ps}  -> case flag of
+    CollNoDictBinders   -> foldr (collect_lpat flag) bndrs (hsConPatArgs ps)
+    CollWithDictBinders -> foldr (collect_lpat flag) bndrs (hsConPatArgs ps)
+                           ++ collectEvBinders (cpt_binds (pat_con_ext pat))
+
+collectEvBinders :: TcEvBinds -> [Id]
+collectEvBinders (EvBinds bs)   = foldr add_ev_bndr [] bs
+collectEvBinders (TcEvBinds {}) = panic "ToDo: collectEvBinders"
+
+add_ev_bndr :: EvBind -> [Id] -> [Id]
+add_ev_bndr (EvBind { eb_lhs = b }) bs | isId b    = b:bs
+                                       | otherwise = bs
+  -- A worry: what about coercion variable binders??
+
 
 -- | This class specifies how to collect variable identifiers from extension patterns in the given pass.
 -- Consumers of the GHC API that define their own passes should feel free to implement instances in order
@@ -1089,47 +1153,89 @@ collect_pat pat bndrs = case pat of
 -- In particular, Haddock already makes use of this, with an instance for its 'DocNameI' pass so that
 -- it can reuse the code in GHC for collecting binders.
 class UnXRec p => CollectPass p where
-  collectXXPat :: Proxy p -> XXPat p -> [IdP p] -> [IdP p]
+  collectXXPat :: Proxy p -> CollectFlag p -> XXPat p -> [IdP p] -> [IdP p]
 
 instance IsPass p => CollectPass (GhcPass p) where
-  collectXXPat _ ext =
+  collectXXPat _ flag ext =
     case ghcPass @p of
-      GhcTc -> let CoPat _ pat _ = ext in collect_pat pat
+      GhcTc -> let CoPat _ pat _ = ext in collect_pat flag pat
       GhcRn -> noExtCon ext
       GhcPs -> noExtCon ext
 
 {-
-Note [Dictionary binders in ConPatOut] See also same Note in GHC.HsToCore.Arrows
+Note [Dictionary binders in ConPatOut]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Do *not* gather (a) dictionary and (b) dictionary bindings as binders
-of a ConPatOut pattern.  For most calls it doesn't matter, because
-it's pre-typechecker and there are no ConPatOuts.  But it does matter
-more in the desugarer; for example, GHC.HsToCore.Utils.mkSelectorBinds uses
-collectPatBinders.  In a lazy pattern, for example f ~(C x y) = ...,
-we want to generate bindings for x,y but not for dictionaries bound by
-C.  (The type checker ensures they would not be used.)
 
-Desugaring of arrow case expressions needs these bindings (see GHC.HsToCore.Arrows
-and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
-own pat-binder-collector:
+Should we collect dictionary binders in ConPatOut? It depends! Use CollectFlag
+to choose.
+
+1. Pre-typechecker there are no ConPatOuts. Use CollNoDictBinders flag.
+
+2. In the desugarer, most of the time we don't want to collect evidence binders,
+   so we also use CollNoDictBinders flag.
+
+   Example of why it matters:
+
+   In a lazy pattern, for example f ~(C x y) = ..., we want to generate bindings
+   for x,y but not for dictionaries bound by C.
+   (The type checker ensures they would not be used.)
+
+   Here's the problem.  Consider
+
+        data T a where
+           C :: Num a => a -> Int -> T a
+
+        f ~(C (n+1) m) = (n,m)
+
+   Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
+   and *also* uses that dictionary to match the (n+1) pattern.  Yet, the
+   variables bound by the lazy pattern are n,m, *not* the dictionary d.
+   So in mkSelectorBinds in GHC.HsToCore.Utils, we want just m,n as the
+   variables bound.
+
+   So in this case, we do *not* gather (a) dictionary and (b) dictionary
+   bindings as binders of a ConPatOut pattern.
+
+
+3. On the other hand, desugaring of arrows needs evidence bindings and uses
+   CollWithDictBinders flag.
+
+   Consider
+
+        h :: (ArrowChoice a, Arrow a) => Int -> a (Int,Int) Int
+        h x = proc (y,z) -> case compare x y of
+                        GT -> returnA -< z+x
+
+   The type checker turns the case into
+
+        case compare x y of
+          GT { $dNum_123 = $dNum_Int } -> returnA -< (+) $dNum_123 z x
+
+   That is, it attaches the $dNum_123 binding to a ConPatOut in scope.
+
+   During desugaring, evidence binders must be collected because their sets are
+   intersected with free variable sets of subsequent commands to create
+   (minimal) command environments.  Failing to do it properly leads to bugs
+   (e.g., #18950).
 
-Here's the problem.  Consider
+   Note: attaching evidence binders to existing ConPatOut may be suboptimal for
+   arrows.  In the example above we would prefer to generate:
 
-data T a where
-   C :: Num a => a -> Int -> T a
+        case compare x y of
+          GT -> returnA -< let $dNum_123 = $dNum_Int in (+) $dNum_123 z x
 
-f ~(C (n+1) m) = (n,m)
+   So that the evidence isn't passed into the command environment. This issue
+   doesn't arise with desugaring of non-arrow code because the simplifier can
+   freely float and inline let-expressions created for evidence binders. But
+   with arrow desugaring, the simplifier would have to see through the command
+   environment tuple which is more complicated.
 
-Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
-and *also* uses that dictionary to match the (n+1) pattern.  Yet, the
-variables bound by the lazy pattern are n,m, *not* the dictionary d.
-So in mkSelectorBinds in GHC.HsToCore.Utils, we want just m,n as the variables bound.
 -}
 
 hsGroupBinders :: HsGroup GhcRn -> [Name]
 hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
                           hs_fords = foreign_decls })
-  =  collectHsValBinders val_decls
+  =  collectHsValBinders CollNoDictBinders val_decls
   ++ hsTyClForeignBinders tycl_decls foreign_decls
 
 hsTyClForeignBinders :: [TyClGroup GhcRn]
@@ -1398,7 +1504,7 @@ lPatImplicits = hs_lpat
     details :: Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
     details _ (PrefixCon _ ps) = hs_lpats ps
     details n (RecCon fs)      =
-      [(err_loc, collectPatsBinders implicit_pats) | Just{} <- [rec_dotdot fs] ]
+      [(err_loc, collectPatsBinders CollNoDictBinders implicit_pats) | Just{} <- [rec_dotdot fs] ]
         ++ hs_lpats explicit_pats
 
       where implicit_pats = map (hsRecFieldArg . unLoc) implicit
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 60e3346ee7..6ebbcc9fd1 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -21,9 +21,7 @@ import GHC.HsToCore.Match
 import GHC.HsToCore.Utils
 import GHC.HsToCore.Monad
 
-import GHC.Hs   hiding (collectPatBinders, collectPatsBinders,
-                        collectLStmtsBinders, collectLStmtBinders,
-                        collectStmtBinders )
+import GHC.Hs
 import GHC.Tc.Utils.Zonk
 
 -- NB: The desugarer, which straddles the source and Core worlds, sometimes
@@ -319,7 +317,7 @@ dsProcExpr
         -> DsM CoreExpr
 dsProcExpr pat (L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do
     (meth_binds, meth_ids) <- mkCmdEnv ids
-    let locals = mkVarSet (collectPatBinders pat)
+    let locals = mkVarSet (collectPatBinders CollWithDictBinders pat)
     (core_cmd, _free_vars, env_ids)
        <- dsfixCmd meth_ids locals unitTy cmd_ty cmd
     let env_ty = mkBigCoreVarTupTy env_ids
@@ -608,7 +606,7 @@ dsCmd ids local_vars stack_ty res_ty
 dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@(L _ binds) body)
                                                                     env_ids = do
     let
-        defined_vars = mkVarSet (collectLocalBinders binds)
+        defined_vars = mkVarSet (collectLocalBinders CollWithDictBinders binds)
         local_vars' = defined_vars `unionVarSet` local_vars
 
     (core_body, _free_vars, env_ids')
@@ -745,7 +743,7 @@ dsCmdLam :: DsCmdEnv            -- arrow combinators
          -> DsM (CoreExpr,      -- desugared expression
                  DIdSet)        -- subset of local vars that occur free
 dsCmdLam ids local_vars stack_ty res_ty pats body env_ids = do
-    let pat_vars = mkVarSet (collectPatsBinders pats)
+    let pat_vars = mkVarSet (collectPatsBinders CollWithDictBinders pats)
     let local_vars' = pat_vars `unionVarSet` local_vars
         (pat_tys, stack_ty') = splitTypeAt (length pats) stack_ty
     (core_body, free_vars, env_ids')
@@ -812,7 +810,7 @@ dsCmdDo ids local_vars res_ty [L loc (LastStmt _ body _ _)] env_ids = do
         env_ids')
 
 dsCmdDo ids local_vars res_ty (stmt:stmts) env_ids = do
-    let bound_vars  = mkVarSet (collectLStmtBinders stmt)
+    let bound_vars  = mkVarSet (collectLStmtBinders CollWithDictBinders stmt)
     let local_vars' = bound_vars `unionVarSet` local_vars
     (core_stmts, _, env_ids') <- trimInput (dsCmdDo ids local_vars' res_ty stmts)
     (core_stmt, fv_stmt) <- dsCmdLStmt ids local_vars env_ids' stmt env_ids
@@ -888,7 +886,7 @@ dsCmdStmt ids local_vars out_ids (BodyStmt c_ty cmd _ _) env_ids = do
 dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd) env_ids = do
     let pat_ty = hsLPatType pat
     (core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars unitTy pat_ty cmd
-    let pat_vars = mkVarSet (collectPatBinders pat)
+    let pat_vars = mkVarSet (collectPatBinders CollWithDictBinders pat)
     let
         env_ids2 = filterOut (`elemVarSet` pat_vars) out_ids
         env_ty2 = mkBigCoreVarTupTy env_ids2
@@ -1125,7 +1123,7 @@ dsCmdStmts ids local_vars out_ids [stmt] env_ids
   = dsCmdLStmt ids local_vars out_ids stmt env_ids
 
 dsCmdStmts ids local_vars out_ids (stmt:stmts) env_ids = do
-    let bound_vars  = mkVarSet (collectLStmtBinders stmt)
+    let bound_vars  = mkVarSet (collectLStmtBinders CollWithDictBinders stmt)
     let local_vars' = bound_vars `unionVarSet` local_vars
     (core_stmts, _fv_stmts, env_ids') <- dsfixCmdStmts ids local_vars' out_ids stmts
     (core_stmt, fv_stmt) <- dsCmdLStmt ids local_vars env_ids' stmt env_ids
@@ -1160,12 +1158,12 @@ leavesMatch :: LMatch GhcTc (Located (body GhcTc))
 leavesMatch (L _ (Match { m_pats = pats
                         , m_grhss = GRHSs _ grhss (L _ binds) }))
   = let
-        defined_vars = mkVarSet (collectPatsBinders pats)
+        defined_vars = mkVarSet (collectPatsBinders CollWithDictBinders pats)
                         `unionVarSet`
-                       mkVarSet (collectLocalBinders binds)
+                       mkVarSet (collectLocalBinders CollWithDictBinders binds)
     in
     [(body,
-      mkVarSet (collectLStmtsBinders stmts)
+      mkVarSet (collectLStmtsBinders CollWithDictBinders stmts)
         `unionVarSet` defined_vars)
     | L _ (GRHS _ stmts body) <- grhss]
 
@@ -1204,90 +1202,3 @@ foldb f xs = foldb f (fold_pairs xs)
     fold_pairs [] = []
     fold_pairs [x] = [x]
     fold_pairs (x1:x2:xs) = f x1 x2:fold_pairs xs
-
-{-
-Note [Dictionary binders in ConPatOut] See also same Note in GHC.Hs.Utils
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The following functions to collect value variables from patterns are
-copied from GHC.Hs.Utils, with one change: we also collect the dictionary
-bindings (cpt_binds) from ConPatOut.  We need them for cases like
-
-h :: Arrow a => Int -> a (Int,Int) Int
-h x = proc (y,z) -> case compare x y of
-                GT -> returnA -< z+x
-
-The type checker turns the case into
-
-                case compare x y of
-                  GT { p77 = plusInt } -> returnA -< p77 z x
-
-Here p77 is a local binding for the (+) operation.
-
-See comments in GHC.Hs.Utils for why the other version does not include
-these bindings.
--}
-
-collectPatBinders :: LPat GhcTc -> [Id]
-collectPatBinders pat = collectl pat []
-
-collectPatsBinders :: [LPat GhcTc] -> [Id]
-collectPatsBinders pats = foldr collectl [] pats
-
----------------------
-collectl :: LPat GhcTc -> [Id] -> [Id]
--- See Note [Dictionary binders in ConPatOut]
-collectl (L _ pat) bndrs
-  = go pat
-  where
-    go (VarPat _ (L _ var))       = var : bndrs
-    go (WildPat _)                = bndrs
-    go (LazyPat _ pat)            = collectl pat bndrs
-    go (BangPat _ pat)            = collectl pat bndrs
-    go (AsPat _ (L _ a) pat)      = a : collectl pat bndrs
-    go (ParPat _ pat)             = collectl pat bndrs
-
-    go (ListPat _ pats)           = foldr collectl bndrs pats
-    go (TuplePat _ pats _)        = foldr collectl bndrs pats
-    go (SumPat _ pat _ _)         = collectl pat bndrs
-
-    go (ConPat { pat_args = ps
-               , pat_con_ext = ConPatTc { cpt_binds = ds }}) =
-                                    collectEvBinders ds
-                                    ++ foldr collectl bndrs (hsConPatArgs ps)
-    go (LitPat _ _)               = bndrs
-    go (NPat {})                  = bndrs
-    go (NPlusKPat _ (L _ n) _ _ _ _) = n : bndrs
-
-    go (SigPat _ pat _)           = collectl pat bndrs
-    go (XPat (CoPat _ pat _))     = collectl (noLoc pat) bndrs
-    go (ViewPat _ _ pat)          = collectl pat bndrs
-    go p@(SplicePat {})           = pprPanic "collectl/go" (ppr p)
-
-collectEvBinders :: TcEvBinds -> [Id]
-collectEvBinders (EvBinds bs)   = foldr add_ev_bndr [] bs
-collectEvBinders (TcEvBinds {}) = panic "ToDo: collectEvBinders"
-
-add_ev_bndr :: EvBind -> [Id] -> [Id]
-add_ev_bndr (EvBind { eb_lhs = b }) bs | isId b    = b:bs
-                                       | otherwise = bs
-  -- A worry: what about coercion variable binders??
-
-collectLStmtsBinders :: [LStmt GhcTc body] -> [Id]
-collectLStmtsBinders = concatMap collectLStmtBinders
-
-collectLStmtBinders :: LStmt GhcTc body -> [Id]
-collectLStmtBinders = collectStmtBinders . unLoc
-
-collectStmtBinders :: Stmt GhcTc body -> [Id]
-collectStmtBinders (BindStmt _ pat _)      = collectPatBinders pat
-collectStmtBinders (LetStmt _  binds)      = collectLocalBinders (unLoc binds)
-collectStmtBinders (BodyStmt {})           = []
-collectStmtBinders (LastStmt {})           = []
-collectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders
-                                    $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]
-collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
-collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
-collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
- where
-  collectArgBinders (_, ApplicativeArgOne { app_arg_pattern = pat }) = collectPatBinders pat
-  collectArgBinders (_, ApplicativeArgMany { bv_pattern = pat }) = collectPatBinders pat
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index db0d72bc9d..09f3165b26 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -370,7 +370,7 @@ addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
     patvar_tickss <- case simplePatId of
       Just{} -> return initial_patvar_tickss
       Nothing -> do
-        let patvars = map getOccString (collectPatBinders lhs)
+        let patvars = map getOccString (collectPatBinders CollNoDictBinders lhs)
         patvar_ticks <- mapM (\v -> bindTick density v pos fvs) patvars
         return
           (zipWith mbCons patvar_ticks
@@ -572,7 +572,7 @@ addTickHsExpr (HsMultiIf ty alts)
        ; alts' <- mapM (liftL $ addTickGRHS isOneOfMany False) alts
        ; return $ HsMultiIf ty alts' }
 addTickHsExpr (HsLet x (L l binds) e) =
-        bindLocals (collectLocalBinders binds) $
+        bindLocals (collectLocalBinders CollNoDictBinders binds) $
           liftM2 (HsLet x . L l)
                   (addTickHsLocalBinds binds) -- to think about: !patterns.
                   (addTickLHsExprLetBody e)
@@ -662,7 +662,7 @@ addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
              -> TM (Match GhcTc (LHsExpr GhcTc))
 addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats
                                                , m_grhss = gRHSs }) =
-  bindLocals (collectPatsBinders pats) $ do
+  bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
     gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
     return $ match { m_grhss = gRHSs' }
 
@@ -674,7 +674,7 @@ addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (L l local_binds)) =
     guarded' <- mapM (liftL (addTickGRHS isOneOfMany isLambda)) guarded
     return $ GRHSs x guarded' (L l local_binds')
   where
-    binders = collectLocalBinders local_binds
+    binders = collectLocalBinders CollNoDictBinders local_binds
 
 addTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
             -> TM (GRHS GhcTc (LHsExpr GhcTc))
@@ -704,7 +704,7 @@ addTickLStmts isGuard stmts = do
 addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a
                -> TM ([ExprLStmt GhcTc], a)
 addTickLStmts' isGuard lstmts res
-  = bindLocals (collectLStmtsBinders lstmts) $
+  = bindLocals (collectLStmtsBinders CollNoDictBinders lstmts) $
     do { lstmts' <- mapM (liftL (addTickStmt isGuard)) lstmts
        ; a <- res
        ; return (lstmts', a) }
@@ -878,7 +878,7 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) =
                 (addTickLHsCmd c2)
                 (addTickLHsCmd c3)
 addTickHsCmd (HsCmdLet x (L l binds) c) =
-        bindLocals (collectLocalBinders binds) $
+        bindLocals (collectLocalBinders CollNoDictBinders binds) $
           liftM2 (HsCmdLet x . L l)
                    (addTickHsLocalBinds binds) -- to think about: !patterns.
                    (addTickLHsCmd c)
@@ -915,7 +915,7 @@ addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do
 
 addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
 addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =
-  bindLocals (collectPatsBinders pats) $ do
+  bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
     gRHSs' <- addTickCmdGRHSs gRHSs
     return $ match { m_grhss = gRHSs' }
 
@@ -926,7 +926,7 @@ addTickCmdGRHSs (GRHSs x guarded (L l local_binds)) =
     guarded' <- mapM (liftL addTickCmdGRHS) guarded
     return $ GRHSs x guarded' (L l local_binds')
   where
-    binders = collectLocalBinders local_binds
+    binders = collectLocalBinders CollNoDictBinders local_binds
 
 addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
 -- The *guards* are *not* Cmds, although the body is
@@ -950,7 +950,7 @@ addTickLCmdStmts' lstmts res
         a <- res
         return (lstmts', a)
   where
-        binders = collectLStmtsBinders lstmts
+        binders = collectLStmtsBinders CollNoDictBinders lstmts
 
 addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
 addTickCmdStmt (BindStmt x pat c) =
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 0f80c61d65..21da052de6 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -118,7 +118,7 @@ user-written. This lets us relate Names (from ClsInsts) to comments
 getMainDeclBinder :: CollectPass (GhcPass p) => HsDecl (GhcPass p) -> [IdP (GhcPass p)]
 getMainDeclBinder (TyClD _ d) = [tcdName d]
 getMainDeclBinder (ValD _ d) =
-  case collectHsBindBinders d of
+  case collectHsBindBinders CollNoDictBinders d of
     []       -> []
     (name:_) -> [name]
 getMainDeclBinder (SigD _ d) = sigNameNoLoc d
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index bd48a19024..8007f36f02 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -453,7 +453,7 @@ tidy1 v _ (LazyPat _ pat)
     -- This is a convenient place to check for unlifted types under a lazy pattern.
     -- Doing this check during type-checking is unsatisfactory because we may
     -- not fully know the zonked types yet. We sure do here.
-  = do  { let unlifted_bndrs = filter (isUnliftedType . idType) (collectPatBinders pat)
+  = do  { let unlifted_bndrs = filter (isUnliftedType . idType) (collectPatBinders CollNoDictBinders pat)
         ; unless (null unlifted_bndrs) $
           putSrcSpanDs (getLoc pat) $
           errDs (hang (text "A lazy (~) pattern cannot bind variables of unlifted type." $$
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index d39a6d716a..629b082f6e 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -265,7 +265,7 @@ first generate a polymorphic definition and then just apply the wrapper at the e
 data M a
 
 repTopP :: LPat GhcRn -> MetaM (Core (M TH.Pat))
-repTopP pat = do { ss <- mkGenSyms (collectPatBinders pat)
+repTopP pat = do { ss <- mkGenSyms (collectPatBinders CollNoDictBinders pat)
                  ; pat' <- addBinds ss (repLP pat)
                  ; wrapGenSyms ss pat' }
 
@@ -1618,7 +1618,7 @@ repE e                     = notHandled "Expression form" (ppr e)
 repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match))
 repMatchTup (L _ (Match { m_pats = [p]
                         , m_grhss = GRHSs _ guards (L _ wheres) })) =
-  do { ss1 <- mkGenSyms (collectPatBinders p)
+  do { ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
      ; (ss2,ds) <- repBinds wheres
@@ -1631,7 +1631,7 @@ repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Clause))
 repClauseTup (L _ (Match { m_pats = ps
                          , m_grhss = GRHSs _ guards (L _ wheres) })) =
-  do { ss1 <- mkGenSyms (collectPatsBinders ps)
+  do { ss1 <- mkGenSyms (collectPatsBinders CollNoDictBinders ps)
      ; addBinds ss1 $ do {
        ps1 <- repLPs ps
      ; (ss2,ds) <- repBinds wheres
@@ -1714,7 +1714,7 @@ repLSts stmts = repSts (map unLoc stmts)
 repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> MetaM ([GenSymBind], [Core (M TH.Stmt)])
 repSts (BindStmt _ p e : ss) =
    do { e2 <- repLE e
-      ; ss1 <- mkGenSyms (collectPatBinders p)
+      ; ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p)
       ; addBinds ss1 $ do {
       ; p1 <- repLP p;
       ; (ss2,zs) <- repSts ss
@@ -1749,7 +1749,7 @@ repSts [LastStmt _ e _ _]
        ; z <- repNoBindSt e2
        ; return ([], [z]) }
 repSts (stmt@RecStmt{} : ss)
-  = do { let binders = collectLStmtsBinders (recS_stmts stmt)
+  = do { let binders = collectLStmtsBinders CollNoDictBinders (recS_stmts stmt)
        ; ss1 <- mkGenSyms binders
        -- Bring all of binders in the recursive group into scope for the
        -- whole group.
@@ -1779,7 +1779,7 @@ repBinds (HsIPBinds _ (IPBinds _ decs))
         }
 
 repBinds (HsValBinds _ decs)
- = do   { let { bndrs = hsScopedTvBinders decs ++ collectHsValBinders decs }
+ = do   { let { bndrs = hsScopedTvBinders decs ++ collectHsValBinders CollNoDictBinders decs }
                 -- No need to worry about detailed scopes within
                 -- the binding group, because we are talking Names
                 -- here, so we can safely treat it as a mutually
@@ -1971,7 +1971,7 @@ repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Exp))
 repLambda (L _ (Match { m_pats = ps
                       , m_grhss = GRHSs _ [L _ (GRHS _ [] e)]
                                               (L _ (EmptyLocalBinds _)) } ))
- = do { let bndrs = collectPatsBinders ps ;
+ = do { let bndrs = collectPatsBinders CollNoDictBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
                 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 6384867a93..493324cf97 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -722,7 +722,7 @@ mkSelectorBinds ticks pat val_expr
            -- Strip the bangs before looking for case (A) or (B)
            -- The incoming pattern may well have a bang on it
 
-    binders = collectPatBinders pat'
+    binders = collectPatBinders CollNoDictBinders pat'
     ticks'  = ticks ++ repeat []
 
     local_binders = map localiseId binders      -- See Note [Localise pattern binders]
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)
 
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 4528bb5f1b..b61d265583 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -438,7 +438,7 @@ recursivePatSynErr loc binds
        2 (vcat $ map pprLBind . bagToList $ binds)
   where
     pprLoc loc  = parens (text "defined at" <+> ppr loc)
-    pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders bind)
+    pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders CollNoDictBinders bind)
                                 <+> pprLoc loc
 
 tc_single :: forall thing.
@@ -488,7 +488,7 @@ mkEdges sig_fn binds
 
     key_map :: NameEnv BKey     -- Which binding it comes from
     key_map = mkNameEnv [(bndr, key) | (L _ bind, key) <- keyd_binds
-                                     , bndr <- collectHsBindBinders bind ]
+                                     , bndr <- collectHsBindBinders CollNoDictBinders bind ]
 
 ------------------------
 tcPolyBinds :: TcSigFun -> TcPragEnv
@@ -531,7 +531,7 @@ tcPolyBinds sig_fn prag_fn rec_group rec_tc closed bind_list
 
     ; return result }
   where
-    binder_names = collectHsBindListBinders bind_list
+    binder_names = collectHsBindListBinders CollNoDictBinders bind_list
     loc = foldr1 combineSrcSpans (map getLoc bind_list)
          -- The mbinds have been dependency analysed and
          -- may no longer be adjacent; so find the narrowest
@@ -1245,7 +1245,7 @@ tcMonoBinds is_rec sig_fn no_gen
 
                 , mbis ) }
   where
-    bndrs = collectPatBinders pat
+    bndrs = collectPatBinders CollNoDictBinders pat
 
 -- GENERAL CASE
 tcMonoBinds _ sig_fn no_gen binds
@@ -1407,7 +1407,7 @@ tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss })
 
         ; return (TcPatBind mbis pat' grhss pat_ty) }
   where
-    bndr_names = collectPatBinders pat
+    bndr_names = collectPatBinders CollNoDictBinders pat
     (nosig_names, sig_names) = partitionWith find_sig bndr_names
 
     find_sig :: Name -> Either Name (Name, TcIdSigInfo)
@@ -1672,7 +1672,7 @@ decideGeneralisationPlan dflags lbinds closed sig_fn
     partial_sig_mrs
       = [ null theta
         | TcIdSig (PartialSig { psig_hs_ty = hs_ty })
-            <- mapMaybe sig_fn (collectHsBindListBinders lbinds)
+            <- mapMaybe sig_fn (collectHsBindListBinders CollNoDictBinders lbinds)
         , let (L _ theta, _) = splitLHsQualTy (hsSigWcType hs_ty) ]
 
     has_partial_sigs   = not (null partial_sig_mrs)
@@ -1724,7 +1724,7 @@ isClosedBndrGroup type_env binds
          in [(f, open_fvs)]
     bindFvs (PatBind { pat_lhs = pat, pat_ext = fvs })
        = let open_fvs = get_open_fvs fvs
-         in [(b, open_fvs) | b <- collectPatBinders pat]
+         in [(b, open_fvs) | b <- collectPatBinders CollNoDictBinders pat]
     bindFvs _
        = []
 
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs
index 3d20305c88..fb8d58c520 100644
--- a/compiler/GHC/Tc/Gen/Match.hs
+++ b/compiler/GHC/Tc/Gen/Match.hs
@@ -1062,8 +1062,8 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside
            ; return (ApplicativeArgMany x stmts' ret' pat' ctxt) }
 
     get_arg_bndrs :: ApplicativeArg GhcTc -> [Id]
-    get_arg_bndrs (ApplicativeArgOne { app_arg_pattern = pat }) = collectPatBinders pat
-    get_arg_bndrs (ApplicativeArgMany { bv_pattern =  pat }) = collectPatBinders pat
+    get_arg_bndrs (ApplicativeArgOne { app_arg_pattern = pat }) = collectPatBinders CollNoDictBinders pat
+    get_arg_bndrs (ApplicativeArgMany { bv_pattern =  pat })    = collectPatBinders CollNoDictBinders pat
 
 {- Note [ApplicativeDo and constraints]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index dfb6e4fe3e..2e55974f90 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -1153,7 +1153,7 @@ instance TH.Quasi TcM where
     where
       checkTopDecl :: HsDecl GhcPs -> TcM ()
       checkTopDecl (ValD _ binds)
-        = mapM_ bindName (collectHsBindBinders binds)
+        = mapM_ bindName (collectHsBindBinders CollNoDictBinders binds)
       checkTopDecl (SigD _ _)
         = return ()
       checkTopDecl (AnnD _ _)
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index a77f9fe71a..e8073d763e 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -1493,7 +1493,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
             ; fo_fvs = foldr (\gre fvs -> fvs `addOneFV` greMangledName gre)
                                 emptyFVs fo_gres
 
-            ; sig_names = mkNameSet (collectHsValBinders hs_val_binds)
+            ; sig_names = mkNameSet (collectHsValBinders CollNoDictBinders hs_val_binds)
                           `minusNameSet` getTypeSigNames val_sigs
 
                 -- Extend the GblEnv with the (as yet un-zonked)
@@ -2363,8 +2363,8 @@ tcUserStmt rdr_stmt@(L loc _)
        ; opt_pr_flag <- goptM Opt_PrintBindResult
        ; let print_result_plan
                | opt_pr_flag                         -- The flag says "print result"
-               , [v] <- collectLStmtBinders gi_stmt  -- One binder
-                           =  [mk_print_result_plan gi_stmt v]
+               , [v] <- collectLStmtBinders CollNoDictBinders gi_stmt  -- One binder
+               = [mk_print_result_plan gi_stmt v]
                | otherwise = []
 
         -- The plans are:
@@ -2414,7 +2414,7 @@ tcGhciStmts stmts
             io_ret_ty   = mkTyConApp ioTyCon [ret_ty]
             tc_io_stmts = tcStmtsAndThen GhciStmtCtxt tcDoStmt stmts
                                          (mkCheckExpType io_ret_ty)
-            names = collectLStmtsBinders stmts
+            names = collectLStmtsBinders CollNoDictBinders stmts
 
         -- OK, we're ready to typecheck the stmts
       ; traceTc "GHC.Tc.Module.tcGhciStmts: tc stmts" empty
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 69656b41da..d4e8827d3d 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -1153,9 +1153,9 @@ tcInstDecls2 tycl_decls inst_decls
         ; let dm_binds = unionManyBags dm_binds_s
 
           -- (b) instance declarations
-        ; let dm_ids = collectHsBindsBinders dm_binds
+        ; let dm_ids = collectHsBindsBinders CollNoDictBinders dm_binds
               -- Add the default method Ids (again)
-              -- (they were arready added in GHC.Tc.TyCl.Utils.tcAddImplicits)
+              -- (they were already added in GHC.Tc.TyCl.Utils.tcAddImplicits)
               -- See Note [Default methods in the type environment]
         ; inst_binds_s <- tcExtendGlobalValEnv dm_ids $
                           mapM tcInstDecl2 inst_decls
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 9e2908fff8..b34e3269a1 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -531,7 +531,7 @@ zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do
 zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
 zonkRecMonoBinds env binds
  = fixM (\ ~(_, new_binds) -> do
-        { let env1 = extendIdZonkEnvRec env (collectHsBindsBinders new_binds)
+        { let env1 = extendIdZonkEnvRec env (collectHsBindsBinders CollNoDictBinders new_binds)
         ; binds' <- zonkMonoBinds env1 binds
         ; return (env1, binds') })
 
@@ -580,7 +580,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
        ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds
        ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) ->
          do { let env3 = extendIdZonkEnvRec env2 $
-                         collectHsBindsBinders new_val_binds
+                         collectHsBindsBinders CollNoDictBinders new_val_binds
             ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds
             ; new_exports   <- mapM (zonk_export env3) exports
             ; return (new_val_binds, new_exports) }
diff --git a/utils/haddock b/utils/haddock
-Subproject e7c225587eb59941adb1c46e3888245ae99281b
+Subproject 911357bcd3eb2f1f03ba06831e07d45595b3a45