diff options
Diffstat (limited to 'compiler/GHC/Tc/Deriv')
| -rw-r--r-- | compiler/GHC/Tc/Deriv/Functor.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Deriv/Generate.hs | 10 |
2 files changed, 11 insertions, 11 deletions
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs index d61b7180ef..7b9d538f65 100644 --- a/compiler/GHC/Tc/Deriv/Functor.hs +++ b/compiler/GHC/Tc/Deriv/Functor.hs @@ -163,7 +163,7 @@ gen_Functor_binds loc tycon _ fmap_eqns = [mkSimpleMatch fmap_match_ctxt [nlWildPat] coerce_Expr] - fmap_match_ctxt = mkPrefixFunRhs fmap_name + fmap_match_ctxt = mkPrefixFunRhs (mapLoc CtxIdRdrName fmap_name) gen_Functor_binds loc tycon tycon_args = (listToBag [fmap_bind, replace_bind], emptyBag) @@ -173,7 +173,7 @@ gen_Functor_binds loc tycon tycon_args -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable] fmap_bind = mkRdrFunBindEC 2 id fmap_name fmap_eqns - fmap_match_ctxt = mkPrefixFunRhs fmap_name + fmap_match_ctxt = mkPrefixFunRhs (mapLoc CtxIdRdrName fmap_name) fmap_eqn con = flip evalState bs_RDRs $ match_for_con fmap_match_ctxt [f_Pat] con parts @@ -212,7 +212,7 @@ gen_Functor_binds loc tycon tycon_args -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable] replace_bind = mkRdrFunBindEC 2 id replace_name replace_eqns - replace_match_ctxt = mkPrefixFunRhs replace_name + replace_match_ctxt = mkPrefixFunRhs (mapLoc CtxIdRdrName replace_name) replace_eqn con = flip evalState bs_RDRs $ match_for_con replace_match_ctxt [z_Pat] con parts @@ -797,7 +797,7 @@ gen_Foldable_binds loc tycon _ foldMap_eqns = [mkSimpleMatch foldMap_match_ctxt [nlWildPat, nlWildPat] mempty_Expr] - foldMap_match_ctxt = mkPrefixFunRhs foldMap_name + foldMap_match_ctxt = mkPrefixFunRhs (mapLoc CtxIdRdrName foldMap_name) gen_Foldable_binds loc tycon tycon_args | null data_cons -- There's no real point producing anything but @@ -840,7 +840,7 @@ gen_Foldable_binds loc tycon tycon_args go (NullM a) = Just (Just a) null_name = L (noAnnSrcSpan loc) null_RDR - null_match_ctxt = mkPrefixFunRhs null_name + null_match_ctxt = mkPrefixFunRhs (mapLoc CtxIdRdrName null_name) null_bind = mkRdrFunBind null_name null_eqns null_eqns = map null_eqn data_cons null_eqn con @@ -1027,7 +1027,7 @@ gen_Traversable_binds loc tycon _ [mkSimpleMatch traverse_match_ctxt [nlWildPat, z_Pat] (nlHsApps pure_RDR [nlHsApp coerce_Expr z_Expr])] - traverse_match_ctxt = mkPrefixFunRhs traverse_name + traverse_match_ctxt = mkPrefixFunRhs (mapLoc CtxIdRdrName traverse_name) gen_Traversable_binds loc tycon tycon_args = (unitBag traverse_bind, emptyBag) diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs index 5f2f69bee2..93eadc0b8f 100644 --- a/compiler/GHC/Tc/Deriv/Generate.hs +++ b/compiler/GHC/Tc/Deriv/Generate.hs @@ -1974,7 +1974,7 @@ gen_Newtype_binds loc' cls inst_tvs inst_tys rhs_ty -- @(a -> [T x] -> c -> Int) -- op mkRdrFunBind loc_meth_RDR [mkSimpleMatch - (mkPrefixFunRhs loc_meth_RDR) + (mkPrefixFunRhs (mapLoc CtxIdRdrName loc_meth_RDR)) [] rhs_expr] , -- The derived instance signature, e.g., -- @@ -2245,7 +2245,7 @@ mkFunBindSE :: Arity -> SrcSpan -> RdrName mkFunBindSE arity loc fun pats_and_exprs = mkRdrFunBindSE arity (L (noAnnSrcSpan loc) fun) matches where - matches = [mkMatch (mkPrefixFunRhs (L (noAnnSrcSpan loc) fun)) + matches = [mkMatch (mkPrefixFunRhs (L (noAnnSrcSpan loc) (CtxIdRdrName fun))) (map (parenthesizePat appPrec) p) e emptyLocalBinds | (p,e) <-pats_and_exprs] @@ -2266,7 +2266,7 @@ mkFunBindEC :: Arity -> SrcSpan -> RdrName mkFunBindEC arity loc fun catch_all pats_and_exprs = mkRdrFunBindEC arity catch_all (L (noAnnSrcSpan loc) fun) matches where - matches = [ mkMatch (mkPrefixFunRhs (L (noAnnSrcSpan loc) fun)) + matches = [ mkMatch (mkPrefixFunRhs (L (noAnnSrcSpan loc) (CtxIdRdrName fun))) (map (parenthesizePat appPrec) p) e emptyLocalBinds | (p,e) <- pats_and_exprs ] @@ -2293,7 +2293,7 @@ mkRdrFunBindEC arity catch_all fun@(L loc _fun_rdr) matches -- which can happen with -XEmptyDataDecls -- See #4302 matches' = if null matches - then [mkMatch (mkPrefixFunRhs fun) + then [mkMatch (mkPrefixFunRhs (mapLoc CtxIdRdrName fun)) (replicate (arity - 1) nlWildPat ++ [z_Pat]) (catch_all $ nlHsCase z_Expr []) emptyLocalBinds] @@ -2313,7 +2313,7 @@ mkRdrFunBindSE arity fun@(L loc fun_rdr) matches -- which can happen with -XEmptyDataDecls -- See #4302 matches' = if null matches - then [mkMatch (mkPrefixFunRhs fun) + then [mkMatch (mkPrefixFunRhs (mapLoc CtxIdRdrName fun)) (replicate arity nlWildPat) (error_Expr str) emptyLocalBinds] else matches |