Remove second tcLookupTcTyCon in tcDataDefnwip/tctc-extra-lookup

Before this patch, tcDataDefn used to call tcLookupTcTyCon twice in a row:
	1. in bindTyClTyVars itself
	2. in the continuation passed to it

Now bindTyClTyVars passes the TcTyCon to the continuation, making
the second lookup unnecessary.

2 files changed, 14 insertions, 14 deletions

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index b18b56fb56..fcf94c5ce5 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -2748,7 +2748,7 @@ tcHsQTyVarBndr _ _ (XTyVarBndr nec) = noExtCon nec
 --------------------------------------
 
 bindTyClTyVars :: Name
-               -> ([TyConBinder] -> Kind -> TcM a) -> TcM a
+               -> (TcTyCon -> [TyConBinder] -> Kind -> TcM a) -> TcM a
 -- ^ Used for the type variables of a type or class decl
 -- in the "kind checking" and "type checking" pass,
 -- but not in the initial-kind run.
@@ -2759,7 +2759,7 @@ bindTyClTyVars tycon_name thing_inside
              binders    = tyConBinders tycon
        ; traceTc "bindTyClTyVars" (ppr tycon_name <+> ppr binders $$ ppr scoped_prs)
        ; tcExtendNameTyVarEnv scoped_prs $
-         thing_inside binders res_kind }
+         thing_inside tycon binders res_kind }
 
 
 {- *********************************************************************
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 7f4b7c6b6e..b085947f54 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1536,20 +1536,20 @@ kcTyClDecl (DataDecl { tcdLName    = (L _ name)
   | HsDataDefn { dd_ctxt = ctxt
                , dd_cons = cons
                , dd_ND = new_or_data } <- defn
-  = bindTyClTyVars name $ \ _ _ ->
+  = bindTyClTyVars name $ \ _ _ _ ->
     do { _ <- tcHsContext ctxt
        ; kcConDecls new_or_data (tyConResKind tyCon) cons
        }
 
 kcTyClDecl (SynDecl { tcdLName = L _ name, tcdRhs = rhs }) _tycon
-  = bindTyClTyVars name $ \ _ res_kind ->
+  = bindTyClTyVars name $ \ _ _ res_kind ->
     discardResult $ tcCheckLHsType rhs res_kind
         -- NB: check against the result kind that we allocated
         -- in inferInitialKinds.
 
 kcTyClDecl (ClassDecl { tcdLName = L _ name
                       , tcdCtxt = ctxt, tcdSigs = sigs }) _tycon
-  = bindTyClTyVars name $ \ _ _ ->
+  = bindTyClTyVars name $ \ _ _ _ ->
     do  { _ <- tcHsContext ctxt
         ; mapM_ (wrapLocM_ kc_sig) sigs }
   where
@@ -2017,7 +2017,7 @@ tcClassDecl1 :: RolesInfo -> Name -> LHsContext GhcRn
 tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs
   = fixM $ \ clas ->
     -- We need the knot because 'clas' is passed into tcClassATs
-    bindTyClTyVars class_name $ \ binders res_kind ->
+    bindTyClTyVars class_name $ \ _ binders res_kind ->
     do { checkClassKindSig res_kind
        ; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders)
        ; let tycon_name = class_name        -- We use the same name
@@ -2294,7 +2294,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
                               , fdResultSig = L _ sig
                               , fdInjectivityAnn = inj })
   | DataFamily <- fam_info
-  = bindTyClTyVars tc_name $ \ binders res_kind -> do
+  = bindTyClTyVars tc_name $ \ _ binders res_kind -> do
   { traceTc "data family:" (ppr tc_name)
   ; checkFamFlag tc_name
 
@@ -2320,7 +2320,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
   ; return tycon }
 
   | OpenTypeFamily <- fam_info
-  = bindTyClTyVars tc_name $ \ binders res_kind -> do
+  = bindTyClTyVars tc_name $ \ _ binders res_kind -> do
   { traceTc "open type family:" (ppr tc_name)
   ; checkFamFlag tc_name
   ; inj' <- tcInjectivity binders inj
@@ -2337,7 +2337,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
          -- the variables in the header scope only over the injectivity
          -- declaration but this is not involved here
        ; (inj', binders, res_kind)
-            <- bindTyClTyVars tc_name $ \ binders res_kind ->
+            <- bindTyClTyVars tc_name $ \ _ binders res_kind ->
                do { inj' <- tcInjectivity binders inj
                   ; return (inj', binders, res_kind) }
 
@@ -2435,7 +2435,7 @@ tcInjectivity tcbs (Just (L loc (InjectivityAnn _ lInjNames)))
 tcTySynRhs :: RolesInfo -> Name
            -> LHsType GhcRn -> TcM TyCon
 tcTySynRhs roles_info tc_name hs_ty
-  = bindTyClTyVars tc_name $ \ binders res_kind ->
+  = bindTyClTyVars tc_name $ \ _ binders res_kind ->
     do { env <- getLclEnv
        ; traceTc "tc-syn" (ppr tc_name $$ ppr (tcl_env env))
        ; rhs_ty <- pushTcLevelM_   $
@@ -2456,7 +2456,10 @@ tcDataDefn err_ctxt roles_info tc_name
                                                -- via inferInitialKinds
                        , dd_cons = cons
                        , dd_derivs = derivs })
-  = bindTyClTyVars tc_name $ \ tycon_binders res_kind ->
+  = bindTyClTyVars tc_name $ \ tctc tycon_binders res_kind ->
+       -- 'tctc' is a 'TcTyCon' and has the 'tcTyConScopedTyVars' that we need
+       -- unlike the finalized 'tycon' defined above which is an 'AlgTyCon'
+       --
        -- The TyCon tyvars must scope over
        --    - the stupid theta (dd_ctxt)
        --    - for H98 constructors only, the ConDecl
@@ -2499,9 +2502,6 @@ tcDataDefn err_ctxt roles_info tc_name
                                   stupid_theta tc_rhs
                                   (VanillaAlgTyCon tc_rep_nm)
                                   gadt_syntax) }
-       ; tctc <- tcLookupTcTyCon tc_name
-            -- 'tctc' is a 'TcTyCon' and has the 'tcTyConScopedTyVars' that we need
-            -- unlike the finalized 'tycon' defined above which is an 'AlgTyCon'
        ; let deriv_info = DerivInfo { di_rep_tc = tycon
                                     , di_scoped_tvs = tcTyConScopedTyVars tctc
                                     , di_clauses = unLoc derivs