[commit: ghc] wip/orf-reboot: Get rid of extendRecordFieldEnv, do it in getLocalNonValBinders instead (74835a4)

[git at git.haskell.org]

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

On branch  : wip/orf-reboot
Link       : http://ghc.haskell.org/trac/ghc/changeset/74835a498bc4c782956d2ed2623e961b24eab000/ghc

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

commit 74835a498bc4c782956d2ed2623e961b24eab000
Author: Adam Gundry <adam at well-typed.com>
Date:   Wed Jul 1 14:59:19 2015 +0100

    Get rid of extendRecordFieldEnv, do it in getLocalNonValBinders instead


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

74835a498bc4c782956d2ed2623e961b24eab000
 compiler/rename/RnNames.hs  | 11 ++++++++---
 compiler/rename/RnSource.hs | 28 ++--------------------------
 2 files changed, 10 insertions(+), 29 deletions(-)

diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 96ebfd0..b3fa348 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -516,7 +516,7 @@ extendGlobalRdrEnvRn avails new_fixities
 ********************************************************************* -}
 
 getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName
-    -> RnM ((TcGblEnv, TcLclEnv), NameSet, [(Name, [FieldLabel])])
+    -> RnM ((TcGblEnv, TcLclEnv), NameSet)
 -- Get all the top-level binders bound the group *except*
 -- for value bindings, which are treated separately
 -- Specifically we return AvailInfo for
@@ -559,9 +559,14 @@ getLocalNonValBinders fixity_env
                           availsToNameSet tc_avails
               flds      = concat nti_fldss ++ concat tc_fldss
         ; traceRn (text "getLocalNonValBinders 2" <+> ppr avails)
-        ; envs <- extendGlobalRdrEnvRn avails fixity_env
+        ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env
 
-        ; return (envs, new_bndrs, flds) } }
+        -- Extend tcg_field_env with new fields (this used to be the
+        -- work of extendRecordFieldEnv)
+        ; let field_env = extendNameEnvList (tcg_field_env tcg_env) flds
+              envs      = (tcg_env { tcg_field_env = field_env }, tcl_env)
+
+        ; return (envs, new_bndrs) } }
   where
     ValBindsIn _val_binds val_sigs = binds
 
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 38162a9..95b14bb 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -111,18 +111,12 @@ rnSrcDecls extra_deps group0@(HsGroup { hs_valds   = val_decls,
    --        * For hs-boot files, include the value signatures
    --          Again, they have no value declarations
    --
-   (tc_envs, tc_bndrs, flds) <- getLocalNonValBinders local_fix_env group ;
+   (tc_envs, tc_bndrs) <- getLocalNonValBinders local_fix_env group ;
 
    setEnvs tc_envs $ do {
 
    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
 
-   -- (C) Extract the mapping from data constructors to field names and
-   --     extend the record field env.
-   --     This depends on the data constructors and field names being in
-   --     scope from (B) above
-   inNewEnv (extendRecordFieldEnv flds) $ \ _ -> do {
-
    -- (D1) Bring pattern synonyms into scope.
    --      Need to do this before (D2) because rnTopBindsLHS
    --      looks up those pattern synonyms (Trac #9889)
@@ -227,7 +221,7 @@ rnSrcDecls extra_deps group0@(HsGroup { hs_valds   = val_decls,
    traceRn (text "finish rnSrc" <+> ppr rn_group) ;
    traceRn (text "finish Dus" <+> ppr src_dus ) ;
    return (final_tcg_env, rn_group)
-                    }}}}}
+                    }}}}
 
 -- some utils because we do this a bunch above
 -- compute and install the new env
@@ -1494,24 +1488,6 @@ badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
 {-
 *********************************************************
 *                                                      *
-\subsection{Support code for type/data declarations}
-*                                                      *
-*********************************************************
-
-Get the mapping from constructors to fields for this module.
-This used to be complicated, but now all the work is done by
-RnNames.getLocalNonValBinders.
--}
-
-extendRecordFieldEnv :: [(Name, [FieldLabel])] -> TcM TcGblEnv
-extendRecordFieldEnv flds
-  = do  { tcg_env <- getGblEnv
-        ; let field_env' = extendNameEnvList (tcg_field_env tcg_env) flds
-        ; return (tcg_env { tcg_field_env = field_env' }) }
-
-{-
-*********************************************************
-*                                                      *
 \subsection{Support code to rename types}
 *                                                      *
 *********************************************************