Synchronize ClsInst.doTyConApp with TcTypeable validity checks (#15862)
[ghc.git] / compiler / typecheck / TcBinds.hs
index 468950a..c8c1bc0 100644 (file)
@@ -8,6 +8,7 @@
 {-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module TcBinds ( tcLocalBinds, tcTopBinds, tcValBinds,
                  tcHsBootSigs, tcPolyCheck,
@@ -19,8 +20,7 @@ import GhcPrelude
 
 import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcMonoExpr )
-import {-# SOURCE #-} TcPatSyn ( tcInferPatSynDecl, tcCheckPatSynDecl
-                               , tcPatSynBuilderBind )
+import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynBuilderBind )
 import CoreSyn (Tickish (..))
 import CostCentre (mkUserCC, CCFlavour(DeclCC))
 import DynFlags
@@ -313,7 +313,7 @@ tcHsBootSigs binds sigs
   where
     tc_boot_sig (TypeSig _ lnames hs_ty) = mapM f lnames
       where
-        f (L _ name)
+        f (dL->L _ name)
           = do { sigma_ty <- tcHsSigWcType (FunSigCtxt name False) hs_ty
                ; return (mkVanillaGlobal name sigma_ty) }
         -- Notice that we make GlobalIds, not LocalIds
@@ -348,12 +348,12 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
 
         ; return (HsIPBinds x (IPBinds ev_binds ip_binds') , result) }
   where
-    ips = [ip | L _ (IPBind _ (Left (L _ ip)) _) <- ip_binds]
+    ips = [ip | (dL->L _ (IPBind _ (Left (dL->L _ ip)) _)) <- ip_binds]
 
         -- I wonder if we should do these one at at time
         -- Consider     ?x = 4
         --              ?y = ?x + 1
-    tc_ip_bind ipClass (IPBind _ (Left (L _ ip)) expr)
+    tc_ip_bind ipClass (IPBind _ (Left (dL->L _ ip)) expr)
        = do { ty <- newOpenFlexiTyVarTy
             ; let p = mkStrLitTy $ hsIPNameFS ip
             ; ip_id <- newDict ipClass [ p, ty ]
@@ -361,7 +361,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
             ; let d = toDict ipClass p ty `fmap` expr'
             ; return (ip_id, (IPBind noExt (Right ip_id) d)) }
     tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind"
-    tc_ip_bind _ (XCIPBind _) = panic "tc_ip_bind"
+    tc_ip_bind _ (XIPBind _) = panic "tc_ip_bind"
 
     -- Coerces a `t` into a dictionry for `IP "x" t`.
     -- co : t -> IP "x" t
@@ -392,14 +392,13 @@ tcValBinds :: TopLevelFlag
            -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)
 
 tcValBinds top_lvl binds sigs thing_inside
-  = do  { let patsyns = getPatSynBinds binds
-
-            -- Typecheck the signature
+  = do  {   -- Typecheck the signatures
+            -- It's easier to do so now, once for all the SCCs together
+            -- because a single signature  f,g :: <type>
+            -- might relate to more than one SCC
         ; (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $
                                 tcTySigs sigs
 
-        ; let prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds)
-
                 -- Extend the envt right away with all the Ids
                 -- declared with complete type signatures
                 -- Do not extend the TcBinderStack; instead
@@ -413,6 +412,9 @@ tcValBinds top_lvl binds sigs thing_inside
                    ; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ]
                    ; return (extra_binds, thing) }
             ; return (binds' ++ extra_binds', thing) }}
+  where
+    patsyns = getPatSynBinds binds
+    prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds)
 
 ------------------------
 tcBindGroups :: TopLevelFlag -> TcSigFun -> TcPragEnv
@@ -509,33 +511,28 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside
     tc_sub_group rec_tc binds =
       tcPolyBinds sig_fn prag_fn Recursive rec_tc closed binds
 
-recursivePatSynErr :: OutputableBndrId name => LHsBinds name -> TcM a
+recursivePatSynErr :: OutputableBndrId (GhcPass p) =>
+                      LHsBinds (GhcPass p) -> TcM a
 recursivePatSynErr binds
   = failWithTc $
     hang (text "Recursive pattern synonym definition with following bindings:")
        2 (vcat $ map pprLBind . bagToList $ binds)
   where
     pprLoc loc  = parens (text "defined at" <+> ppr loc)
-    pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders bind) <+>
-                            pprLoc loc
+    pprLBind (dL->L loc bind) = pprWithCommas ppr (collectHsBindBinders bind)
+                                <+> pprLoc loc
 
 tc_single :: forall thing.
             TopLevelFlag -> TcSigFun -> TcPragEnv
           -> LHsBind GhcRn -> IsGroupClosed -> TcM thing
           -> TcM (LHsBinds GhcTcId, thing)
 tc_single _top_lvl sig_fn _prag_fn
-          (L _ (PatSynBind _ psb@PSB{ psb_id = L _ name }))
+          (dL->L _ (PatSynBind _ psb@PSB{ psb_id = (dL->L _ name) }))
           _ thing_inside
-  = do { (aux_binds, tcg_env) <- tc_pat_syn_decl
+  = do { (aux_binds, tcg_env) <- tcPatSynDecl psb (sig_fn name)
        ; thing <- setGblEnv tcg_env thing_inside
        ; return (aux_binds, thing)
        }
-  where
-    tc_pat_syn_decl :: TcM (LHsBinds GhcTcId, TcGblEnv)
-    tc_pat_syn_decl = case sig_fn name of
-        Nothing                 -> tcInferPatSynDecl psb
-        Just (TcPatSynSig tpsi) -> tcCheckPatSynDecl psb tpsi
-        Just                 _  -> panic "tc_single"
 
 tc_single top_lvl sig_fn prag_fn lbind closed thing_inside
   = do { (binds1, ids) <- tcPolyBinds sig_fn prag_fn
@@ -569,7 +566,7 @@ mkEdges sig_fn binds
     keyd_binds = bagToList binds `zip` [0::BKey ..]
 
     key_map :: NameEnv BKey     -- Which binding it comes from
-    key_map = mkNameEnv [(bndr, key) | (L _ bind, key) <- keyd_binds
+    key_map = mkNameEnv [(bndr, key) | (dL->L _ bind, key) <- keyd_binds
                                      , bndr <- collectHsBindBinders bind ]
 
 ------------------------
@@ -642,7 +639,7 @@ forall_a_a :: TcType
 -- Another alternative would be (forall (a :: TYPE kappa). a), where
 -- kappa is a unification variable. But I don't think we need that
 -- complication here. I'm going to just use (forall (a::*). a).
--- See Trac #15276
+-- See #15276
 forall_a_a = mkSpecForAllTys [alphaTyVar] alphaTy
 
 {- *********************************************************************
@@ -691,8 +688,8 @@ tcPolyCheck prag_fn
             (CompleteSig { sig_bndr  = poly_id
                          , sig_ctxt  = ctxt
                          , sig_loc   = sig_loc })
-            (L loc (FunBind { fun_id = L nm_loc name
-                            , fun_matches = matches }))
+            (dL->L loc (FunBind { fun_id = (dL->L nm_loc name)
+                                , fun_matches = matches }))
   = setSrcSpan sig_loc $
     do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc)
        ; (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id
@@ -709,7 +706,7 @@ tcPolyCheck prag_fn
                tcExtendBinderStack [TcIdBndr mono_id NotTopLevel]  $
                tcExtendNameTyVarEnv tv_prs $
                setSrcSpan loc           $
-               tcMatchesFun (L nm_loc mono_name) matches (mkCheckExpType tau)
+               tcMatchesFun (cL nm_loc mono_name) matches (mkCheckExpType tau)
 
        ; let prag_sigs = lookupPragEnv prag_fn name
        ; spec_prags <- tcSpecPrags poly_id prag_sigs
@@ -717,7 +714,7 @@ tcPolyCheck prag_fn
 
        ; mod <- getModule
        ; tick <- funBindTicks nm_loc mono_id mod prag_sigs
-       ; let bind' = FunBind { fun_id      = L nm_loc mono_id
+       ; let bind' = FunBind { fun_id      = cL nm_loc mono_id
                              , fun_matches = matches'
                              , fun_co_fn   = co_fn
                              , fun_ext     = placeHolderNamesTc
@@ -729,13 +726,13 @@ tcPolyCheck prag_fn
                           , abe_mono  = mono_id
                           , abe_prags = SpecPrags spec_prags }
 
-             abs_bind = L loc $
+             abs_bind = cL loc $
                         AbsBinds { abs_ext = noExt
                                  , abs_tvs      = skol_tvs
                                  , abs_ev_vars  = ev_vars
                                  , abs_ev_binds = [ev_binds]
                                  , abs_exports  = [export]
-                                 , abs_binds    = unitBag (L loc bind')
+                                 , abs_binds    = unitBag (cL loc bind')
                                  , abs_sig      = True }
 
        ; return (unitBag abs_bind, [poly_id]) }
@@ -746,7 +743,7 @@ tcPolyCheck _prag_fn sig bind
 funBindTicks :: SrcSpan -> TcId -> Module -> [LSig GhcRn]
              -> TcM [Tickish TcId]
 funBindTicks loc fun_id mod sigs
-  | (mb_cc_str : _) <- [ cc_name | L _ (SCCFunSig _ _ _ cc_name) <- sigs ]
+  | (mb_cc_str : _) <- [ cc_name | (dL->L _ (SCCFunSig _ _ _ cc_name)) <- sigs ]
       -- this can only be a singleton list, as duplicate pragmas are rejected
       -- by the renamer
   , let cc_str
@@ -802,8 +799,9 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
        ; mapM_ (checkOverloadedSig mono) sigs
 
        ; traceTc "simplifyInfer call" (ppr tclvl $$ ppr name_taus $$ ppr wanted)
-       ; (qtvs, givens, ev_binds, insoluble)
+       ; (qtvs, givens, ev_binds, residual, insoluble)
                  <- simplifyInfer tclvl infer_mode sigs name_taus wanted
+       ; emitConstraints residual
 
        ; let inferred_theta = map evVarPred givens
        ; exports <- checkNoErrs $
@@ -811,7 +809,7 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
 
        ; loc <- getSrcSpanM
        ; let poly_ids = map abe_poly exports
-             abs_bind = L loc $
+             abs_bind = cL loc $
                         AbsBinds { abs_ext = noExt
                                  , abs_tvs = qtvs
                                  , abs_ev_vars = givens, abs_ev_binds = [ev_binds]
@@ -921,7 +919,7 @@ mkInferredPolyId insoluble qtvs inferred_theta poly_name mb_sig_inst mono_ty
          checkValidType (InfSigCtxt poly_name) inferred_poly_ty
          -- See Note [Validity of inferred types]
          -- If we found an insoluble error in the function definition, don't
-         -- do this check; otherwise (Trac #14000) we may report an ambiguity
+         -- do this check; otherwise (#14000) we may report an ambiguity
          -- error for a rather bogus type.
 
        ; return (mkLocalIdOrCoVar poly_name inferred_poly_ty) }
@@ -935,7 +933,7 @@ chooseInferredQuantifiers :: TcThetaType   -- inferred
 chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing
   = -- No type signature (partial or complete) for this binder,
     do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs)
-                        -- Include kind variables!  Trac #7916
+                        -- Include kind variables!  #7916
              my_theta = pickCapturedPreds free_tvs inferred_theta
              binders  = [ mkTyVarBinder Inferred tv
                         | tv <- qtvs
@@ -948,12 +946,12 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
                                       , sig_inst_theta = annotated_theta
                                       , sig_inst_skols = annotated_tvs }))
   = -- Choose quantifiers for a partial type signature
-    do { psig_qtv_prs <- zonkSigTyVarPairs annotated_tvs
+    do { psig_qtv_prs <- zonkTyVarTyVarPairs annotated_tvs
 
             -- Check whether the quantified variables of the
             -- partial signature have been unified together
             -- See Note [Quantified variables in partial type signatures]
-       ; mapM_ report_dup_sig_tv_err  (findDupSigTvs psig_qtv_prs)
+       ; mapM_ report_dup_tyvar_tv_err  (findDupTyVarTvs psig_qtv_prs)
 
             -- Check whether a quantified variable of the partial type
             -- signature is not actually quantified.  How can that happen?
@@ -976,7 +974,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
 
        ; return (final_qtvs, my_theta) }
   where
-    report_dup_sig_tv_err (n1,n2)
+    report_dup_tyvar_tv_err (n1,n2)
       | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig
       = addErrTc (hang (text "Couldn't match" <+> quotes (ppr n1)
                         <+> text "with" <+> quotes (ppr n2))
@@ -984,7 +982,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
                            2 (ppr fn_name <+> dcolon <+> ppr hs_ty)))
 
       | otherwise -- Can't happen; by now we know it's a partial sig
-      = pprPanic "report_sig_tv_err" (ppr sig)
+      = pprPanic "report_tyvar_tv_err" (ppr sig)
 
     report_mono_sig_tv_err n
       | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig
@@ -992,7 +990,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
                      2 (hang (text "bound by the partial type signature:")
                            2 (ppr fn_name <+> dcolon <+> ppr hs_ty)))
       | otherwise -- Can't happen; by now we know it's a partial sig
-      = pprPanic "report_sig_tv_err" (ppr sig)
+      = pprPanic "report_mono_sig_tv_err" (ppr sig)
 
     choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType
                         -> TcM (VarSet, TcThetaType)
@@ -1089,7 +1087,7 @@ checkOverloadedSig :: Bool -> TcIdSigInst -> TcM ()
 --   K f = e
 -- The MR applies, but the signature is overloaded, and it's
 -- best to complain about this directly
--- c.f Trac #11339
+-- c.f #11339
 checkOverloadedSig monomorphism_restriction_applies sig
   | not (null (sig_inst_theta sig))
   , monomorphism_restriction_applies
@@ -1127,7 +1125,7 @@ doesn't seem much point.  Indeed, adding a partial type signature is a
 way to get per-binding inferred generalisation.
 
 We apply the MR if /all/ of the partial signatures lack a context.
-In particular (Trac #11016):
+In particular (#11016):
    f2 :: (?loc :: Int) => _
    f2 = ?loc
 It's stupid to apply the MR here.  This test includes an extra-constraints
@@ -1143,7 +1141,7 @@ Consider
   g x y = [x, y]
 
 Here, 'f' and 'g' are mutually recursive, and we end up unifying 'a' and 'b'
-together, which is fine.  So we bind 'a' and 'b' to SigTvs, which can then
+together, which is fine.  So we bind 'a' and 'b' to TyVarTvs, which can then
 unify with each other.
 
 But now consider:
@@ -1153,7 +1151,7 @@ But now consider:
 We want to get an error from this, because 'a' and 'b' get unified.
 So we make a test, one per parital signature, to check that the
 explicitly-quantified type variables have not been unified together.
-Trac #14449 showed this up.
+#14449 showed this up.
 
 
 Note [Validity of inferred types]
@@ -1203,7 +1201,7 @@ Then we want to check that
      forall qtvs. theta => f_mono_ty   is more polymorphic than   f's polytype
 and the proof is the impedance matcher.
 
-Notice that the impedance matcher may do defaulting.  See Trac #7173.
+Notice that the impedance matcher may do defaulting.  See #7173.
 
 It also cleverly does an ambiguity check; for example, rejecting
    f :: F a -> F a
@@ -1254,8 +1252,9 @@ tcMonoBinds :: RecFlag  -- Whether the binding is recursive for typechecking pur
             -> [LHsBind GhcRn]
             -> TcM (LHsBinds GhcTcId, [MonoBindInfo])
 tcMonoBinds is_rec sig_fn no_gen
-           [ L b_loc (FunBind { fun_id = L nm_loc name,
-                                fun_matches = matches, fun_ext = fvs })]
+           [ dL->L b_loc (FunBind { fun_id = (dL->L nm_loc name)
+                                  , fun_matches = matches
+                                  , fun_ext = fvs })]
                              -- Single function binding,
   | NonRecursive <- is_rec   -- ...binder isn't mentioned in RHS
   , Nothing <- sig_fn name   -- ...with no type signature
@@ -1270,16 +1269,16 @@ tcMonoBinds is_rec sig_fn no_gen
     do  { ((co_fn, matches'), rhs_ty)
             <- tcInferInst $ \ exp_ty ->
                   -- tcInferInst: see TcUnify,
-                  -- Note [Deep instantiation of InferResult]
+                  -- Note [Deep instantiation of InferResult] in TcUnify
                tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $
                   -- We extend the error context even for a non-recursive
                   -- function so that in type error messages we show the
                   -- type of the thing whose rhs we are type checking
-               tcMatchesFun (L nm_loc name) matches exp_ty
+               tcMatchesFun (cL nm_loc name) matches exp_ty
 
         ; mono_id <- newLetBndr no_gen name rhs_ty
-        ; return (unitBag $ L b_loc $
-                     FunBind { fun_id = L nm_loc mono_id,
+        ; return (unitBag $ cL b_loc $
+                     FunBind { fun_id = cL nm_loc mono_id,
                                fun_matches = matches', fun_ext = fvs,
                                fun_co_fn = co_fn, fun_tick = [] },
                   [MBI { mbi_poly_name = name
@@ -1336,7 +1335,8 @@ tcLhs :: TcSigFun -> LetBndrSpec -> HsBind GhcRn -> TcM TcMonoBind
 -- CheckGen is used only for functions with a complete type signature,
 --          and tcPolyCheck doesn't use tcMonoBinds at all
 
-tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name, fun_matches = matches })
+tcLhs sig_fn no_gen (FunBind { fun_id = (dL->L nm_loc name)
+                             , fun_matches = matches })
   | Just (TcIdSig sig) <- sig_fn name
   = -- There is a type signature.
     -- It must be partial; if complete we'd be in tcPolyCheck!
@@ -1423,9 +1423,9 @@ tcRhs (TcFunBind info@(MBI { mbi_sig = mb_sig, mbi_mono_id = mono_id })
   = tcExtendIdBinderStackForRhs [info]  $
     tcExtendTyVarEnvForRhs mb_sig       $
     do  { traceTc "tcRhs: fun bind" (ppr mono_id $$ ppr (idType mono_id))
-        ; (co_fn, matches') <- tcMatchesFun (L loc (idName mono_id))
+        ; (co_fn, matches') <- tcMatchesFun (cL loc (idName mono_id))
                                  matches (mkCheckExpType $ idType mono_id)
-        ; return ( FunBind { fun_id = L loc mono_id
+        ; return ( FunBind { fun_id = cL loc mono_id
                            , fun_matches = matches'
                            , fun_co_fn = co_fn
                            , fun_ext = placeHolderNamesTc
@@ -1453,7 +1453,6 @@ tcExtendTyVarEnvForRhs (Just sig) thing_inside
 tcExtendTyVarEnvFromSig :: TcIdSigInst -> TcM a -> TcM a
 tcExtendTyVarEnvFromSig sig_inst thing_inside
   | TISI { sig_inst_skols = skol_prs, sig_inst_wcs = wcs } <- sig_inst
-     -- Note [Use tcExtendTyVar not scopeTyVars in tcRhs]
   = tcExtendNameTyVarEnv wcs $
     tcExtendNameTyVarEnv skol_prs $
     thing_inside
@@ -1489,7 +1488,7 @@ getMonoBindInfo tc_binds
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Look at:
    - typecheck/should_compile/ExPat
-   - Trac #12427, typecheck/should_compile/T12427{a,b}
+   - #12427, typecheck/should_compile/T12427{a,b}
 
   data T where
     MkT :: Integral a => a -> Int -> T
@@ -1568,7 +1567,7 @@ We typecheck pattern bindings as follows.  First tcLhs does this:
        CheckGen), then the let_bndr_spec will be LetLclBndr.  In that case
        we want to bind a cloned, local version of the variable, with the
        type given by the pattern context, *not* by the signature (even if
-       there is one; see Trac #7268). The mkExport part of the
+       there is one; see #7268). The mkExport part of the
        generalisation step will do the checking and impedance matching
        against the signature.
 
@@ -1590,32 +1589,9 @@ beta is untouchable.)
 
 Example for (E2), we generate
      q :: beta:1, with constraint (forall:3 a. Integral a => Int ~ beta)
-The beta is untoucable, but floats out of the constraint and can
+The beta is untouchable, but floats out of the constraint and can
 be solved absolutely fine.
 
-Note [Use tcExtendTyVar not scopeTyVars in tcRhs]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Normally, any place that corresponds to Λ or ∀ in Core should be flagged
-with a call to scopeTyVars, which arranges for an implication constraint
-to be made, bumps the TcLevel, and (crucially) prevents a unification
-variable created outside the scope of a local skolem to unify with that
-skolem.
-
-We do not need to do this here, however.
-
-- Note that this happens only in the case of a partial signature.
-  Complete signatures go via tcPolyCheck, not tcPolyInfer.
-
-- The TcLevel is incremented in tcPolyInfer, right outside the call
-  to tcMonoBinds. We thus don't have to worry about outer metatvs unifying
-  with local skolems.
-
-- The other potential concern is that we need SkolemInfo associated with
-  the skolems. This, too, is OK, though: the constraints pass through
-  simplifyInfer (which doesn't report errors), at the end of which
-  the skolems will get quantified and put into an implication constraint.
-  Thus, by the time any errors are reported, the SkolemInfo will be
-  in place.
 
 ************************************************************************
 *                                                                      *
@@ -1661,7 +1637,7 @@ decideGeneralisationPlan dflags lbinds closed sig_fn
       = [ null theta
         | TcIdSig (PartialSig { psig_hs_ty = hs_ty })
             <- mapMaybe sig_fn (collectHsBindListBinders lbinds)
-        , let (_, L _ theta, _) = splitLHsSigmaTy (hsSigWcType hs_ty) ]
+        , let (_, dL->L _ theta, _) = splitLHsSigmaTy (hsSigWcType hs_ty) ]
 
     has_partial_sigs   = not (null partial_sig_mrs)
 
@@ -1677,7 +1653,7 @@ decideGeneralisationPlan dflags lbinds closed sig_fn
     -- With OutsideIn, all nested bindings are monomorphic
     -- except a single function binding with a signature
     one_funbind_with_sig
-      | [lbind@(L _ (FunBind { fun_id = v }))] <- lbinds
+      | [lbind@(dL->L _ (FunBind { fun_id = v }))] <- lbinds
       , Just (TcIdSig sig) <- sig_fn (unLoc v)
       = Just (lbind, sig)
       | otherwise
@@ -1706,7 +1682,8 @@ isClosedBndrGroup type_env binds
     fv_env = mkNameEnv $ concatMap (bindFvs . unLoc) binds
 
     bindFvs :: HsBindLR GhcRn GhcRn -> [(Name, NameSet)]
-    bindFvs (FunBind { fun_id = L _ f, fun_ext = fvs })
+    bindFvs (FunBind { fun_id = (dL->L _ f)
+                     , fun_ext = fvs })
        = let open_fvs = get_open_fvs fvs
          in [(f, open_fvs)]
     bindFvs (PatBind { pat_lhs = pat, pat_ext = fvs })