diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-05-27 11:02:47 -0400 |
---|---|---|
committer | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-05-27 11:03:02 -0400 |
commit | 3a00ff92a3ee66c096b85b180d247d1a471a6b6e (patch) | |
tree | 223955d8ea1f96a46fbbb8217f5dd77731eb181f /compiler | |
parent | 59250dce325a6115c8419cb8578025f0d76184d2 (diff) | |
download | haskell-3a00ff92a3ee66c096b85b180d247d1a471a6b6e.tar.gz |
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
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/basicTypes/Id.hs | 7 | ||||
-rw-r--r-- | compiler/deSugar/Desugar.hs | 5 | ||||
-rw-r--r-- | 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 b589809ded..6045937173 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 75f6a3491b..c7a869d5cd 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 2d6637ea29..8c91b4897d 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 |