[commit: ghc] master: Make sure PatSyns only get added once to tcg_patsyns (41ef8f7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/41ef8f70819e9b99aacc6d81019e5a33a63dfeab/ghc

>---------------------------------------------------------------

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)