[commit: ghc] master: Do not init record accessors as exported (3a00ff9)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3a00ff92a3ee66c096b85b180d247d1a471a6b6e/ghc

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

commit 3a00ff92a3ee66c096b85b180d247d1a471a6b6e
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Fri May 27 11:02:47 2016 -0400

    Do not init record accessors as exported
    
    This was causing redundant code generation when accessors are not
    actually exported, as they were being marked as "exported" at
    initialization.
    
    Test Plan: validate
    
    Reviewers: simonpj, austin, bgamari
    
    Reviewed By: simonpj
    
    Subscribers: mpickering, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2270


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

3a00ff92a3ee66c096b85b180d247d1a471a6b6e
 compiler/basicTypes/Id.hs       | 7 +++++++
 compiler/deSugar/Desugar.hs     | 5 ++++-
 compiler/typecheck/TcTyDecls.hs | 7 ++++++-
 3 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index b589809..6045937 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -33,6 +33,7 @@ module Id (
         mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
         mkLocalIdOrCoVarWithInfo,
         mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
+        mkNonExportedLocalId,
         mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
         mkUserLocal, mkUserLocalOrCoVar,
         mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
@@ -287,6 +288,12 @@ mkExportedLocalId :: IdDetails -> Name -> Type -> Id
 mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
         -- Note [Free type variables]
 
+-- | Create a local 'Id' that is marked as not-exported.
+-- These may be removed as dead code.
+mkNonExportedLocalId :: IdDetails -> Name -> Type -> Id
+mkNonExportedLocalId details name ty =
+  Var.mkLocalVar details name ty vanillaIdInfo
+
 mkExportedVanillaId :: Name -> Type -> Id
 mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
         -- Note [Free type variables]
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 75f6a34..c7a869d 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -296,7 +296,10 @@ deSugar hsc_env
                      (text "Desugar"<+>brackets (ppr mod))
                      (const ()) $
      do { -- Desugar the program
-        ; let export_set = availsToNameSet exports
+        ; let export_set =
+                -- Used to be 'availsToNameSet', but we now export selectors
+                -- only when necessary. See #12125.
+                availsToNameSetWithSelectors exports
               target     = hscTarget dflags
               hpcInfo    = emptyHpcInfo other_hpc_info
 
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 2d6637e..8c91b48 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -941,7 +941,12 @@ mkOneRecordSelector all_cons idDetails fl
     lbl      = flLabel fl
     sel_name = flSelector fl
 
-    sel_id = mkExportedLocalId rec_details sel_name sel_ty
+    sel_id =
+      -- Do not mark record selectors as exported to avoid keeping these Ids
+      -- alive unnecessarily. See #12125. Selectors are now marked as exported
+      -- when necessary by desugarer ('Desugar.addExportFlagsAndRules', also see
+      -- uses of 'availsToNameSetWithSelectors' in 'Desugar.hs').
+      mkNonExportedLocalId rec_details sel_name sel_ty
     rec_details = RecSelId { sel_tycon = idDetails, sel_naughty = is_naughty }
 
     -- Find a representative constructor, con1