[commit: ghc] master: Make sure PatSyns only get added once to tcg_patsyns (41ef8f7)
Simon Peyton Jones
simonpj at microsoft.com
Tue Dec 15 14:43:13 UTC 2015
Good catch Matthew!
Simon
| -----Original Message-----
| From: ghc-commits [mailto:ghc-commits-bounces at haskell.org] On Behalf
| Of git at git.haskell.org
| Sent: 11 December 2015 18:12
| To: ghc-commits at 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 <matthewtpickering at gmail.com>
| 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 at 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 at 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
More information about the ghc-devs
mailing list