Good catch Matthew! Simon | -----Original Message----- | From: ghc-commits [mailto:ghc-commits-bounces@haskell.org] On Behalf | Of git@git.haskell.org | Sent: 11 December 2015 18:12 | To: ghc-commits@haskell.org | Subject: [commit: ghc] master: Make sure PatSyns only get added once | to tcg_patsyns (41ef8f7) | | Repository : ssh://git@git.haskell.org/ghc | | On branch : master | Link : | https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fghc.ha | skell.org%2ftrac%2fghc%2fchangeset%2f41ef8f70819e9b99aacc6d81019e5a33a | 63dfeab%2fghc&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7cd98265 | a98dcc44ba27f808d30256abde%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdat | a=aH%2bCJDOGW%2f2iqa%2fVNndOfAq2bJfBRBGiCADHYBzt5Uc%3d | | >--------------------------------------------------------------- | | commit 41ef8f70819e9b99aacc6d81019e5a33a63dfeab | Author: Matthew Pickering | Date: Fri Dec 11 18:10:45 2015 +0000 | | Make sure PatSyns only get added once to tcg_patsyns | | Summary: Before, `PatSyn`s were getting added twice to | `tcg_patsyns` so | when inspecting afterwards there were duplicates in the list. | This makes sure that only they only get added once. | | Reviewers: austin, bgamari | | Reviewed By: bgamari | | Subscribers: thomie | | Differential Revision: https://phabricator.haskell.org/D1597 | | | >--------------------------------------------------------------- | | 41ef8f70819e9b99aacc6d81019e5a33a63dfeab | compiler/typecheck/TcBinds.hs | 8 +++----- | compiler/typecheck/TcPatSyn.hs | 10 +++++----- | compiler/typecheck/TcPatSyn.hs-boot | 7 +++---- | 3 files changed, 11 insertions(+), 14 deletions(-) | | diff --git a/compiler/typecheck/TcBinds.hs | b/compiler/typecheck/TcBinds.hs index 673109b..1254b78 100644 | --- a/compiler/typecheck/TcBinds.hs | +++ b/compiler/typecheck/TcBinds.hs | @@ -49,7 +49,6 @@ import NameSet | import NameEnv | import SrcLoc | import Bag | -import PatSyn | import ListSetOps | import ErrUtils | import Digraph | @@ -483,13 +482,12 @@ tc_single :: forall thing. | -> LHsBind Name -> TcM thing | -> TcM (LHsBinds TcId, thing) tc_single _top_lvl sig_fn | _prag_fn (L _ (PatSynBind psb@PSB{ psb_id = L _ name })) thing_inside | - = do { (pat_syn, aux_binds, tcg_env) <- tc_pat_syn_decl | - ; let tything = AConLike (PatSynCon pat_syn) | - ; thing <- setGblEnv tcg_env $ tcExtendGlobalEnv [tything] | thing_inside | + = do { (aux_binds, tcg_env) <- tc_pat_syn_decl | + ; thing <- setGblEnv tcg_env thing_inside | ; return (aux_binds, thing) | } | where | - tc_pat_syn_decl :: TcM (PatSyn, LHsBinds TcId, TcGblEnv) | + tc_pat_syn_decl :: TcM (LHsBinds TcId, TcGblEnv) | tc_pat_syn_decl = case sig_fn name of | Nothing -> tcInferPatSynDecl psb | Just (TcPatSynSig tpsi) -> tcCheckPatSynDecl psb tpsi diff -- | git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs | index 30dcbf7..69eeef0 100644 | --- a/compiler/typecheck/TcPatSyn.hs | +++ b/compiler/typecheck/TcPatSyn.hs | @@ -61,7 +61,7 @@ import Control.Monad (forM) -} | | tcInferPatSynDecl :: PatSynBind Name Name | - -> TcM (PatSyn, LHsBinds Id, TcGblEnv) | + -> TcM (LHsBinds Id, TcGblEnv) | tcInferPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = | details, | psb_def = lpat, psb_dir = dir } | = setSrcSpan loc $ | @@ -96,7 +96,7 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L loc name), | psb_args = details, | | tcCheckPatSynDecl :: PatSynBind Name Name | -> TcPatSynInfo | - -> TcM (PatSyn, LHsBinds Id, TcGblEnv) | + -> TcM (LHsBinds Id, TcGblEnv) | tcCheckPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = | details, | psb_def = lpat, psb_dir = dir } | TPSI{ patsig_tau = tau, @@ -163,7 +163,7 @@ | tcCheckPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = | details, | (univ_tvs, req_theta, req_ev_binds, | req_dicts) | (ex_tvs, ex_tys, prov_theta, prov_ev_binds, | prov_dicts) | wrapped_args | - pat_ty rec_fields } | + pat_ty rec_fields } | where | (arg_tys, pat_ty) = tcSplitFunTys tau | | @@ -199,7 +199,7 @@ tc_patsyn_finish :: Located Name -- ^ PatSyn Name | -> TcType -- ^ Pattern type | -> [Name] -- ^ Selector names | -- ^ Whether fields, empty if not record PatSyn | - -> TcM (PatSyn, LHsBinds Id, TcGblEnv) | + -> TcM (LHsBinds Id, TcGblEnv) | tc_patsyn_finish lname dir is_infix lpat' | (univ_tvs, req_theta, req_ev_binds, req_dicts) | (ex_tvs, subst, prov_theta, prov_ev_binds, | prov_dicts) @@ -262,7 +262,7 @@ tc_patsyn_finish lname dir is_infix | lpat' | tcRecSelBinds | (ValBindsOut (zip (repeat NonRecursive) selector_binds) | sigs) | | - ; return (patSyn, matcher_bind, tcg_env) } | + ; return (matcher_bind, tcg_env) } | | where | zonk_wrapped_arg :: (Var, HsWrapper) -> TcM (Var, HsWrapper) diff | --git a/compiler/typecheck/TcPatSyn.hs-boot | b/compiler/typecheck/TcPatSyn.hs-boot | index 61f7958..11c1bc1 100644 | --- a/compiler/typecheck/TcPatSyn.hs-boot | +++ b/compiler/typecheck/TcPatSyn.hs-boot | @@ -4,16 +4,15 @@ import Name ( Name ) | import Id ( Id ) | import HsSyn ( PatSynBind, LHsBinds ) | import TcRnTypes ( TcM, TcPatSynInfo ) | -import PatSyn ( PatSyn ) | -import TcRnMonad ( TcGblEnv ) | +import TcRnMonad ( TcGblEnv) | import Outputable ( Outputable ) | | tcInferPatSynDecl :: PatSynBind Name Name | - -> TcM (PatSyn, LHsBinds Id, TcGblEnv) | + -> TcM (LHsBinds Id, TcGblEnv) | | tcCheckPatSynDecl :: PatSynBind Name Name | -> TcPatSynInfo | - -> TcM (PatSyn, LHsBinds Id, TcGblEnv) | + -> TcM (LHsBinds Id, TcGblEnv) | | tcPatSynBuilderBind :: PatSynBind Name Name | -> TcM (LHsBinds Id) | | _______________________________________________ | ghc-commits mailing list | ghc-commits@haskell.org | https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fmail.h | askell.org%2fcgi-bin%2fmailman%2flistinfo%2fghc- | commits&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7cd98265a98dcc | 44ba27f808d30256abde%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=B6Hb | JaANWHnlqhBaZ5AOMvHAQ0Mzs4t8cvtkQLIo4t4%3d