[commit: ghc] master: CLabel: Kill redundant UnitId argument from labelDynamic (5bf344b)
git at git.haskell.org
git at git.haskell.org
Fri Dec 16 17:11:38 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/5bf344b7f4e1538fbc019896ae07ae3ec2a18207/ghc
>---------------------------------------------------------------
commit 5bf344b7f4e1538fbc019896ae07ae3ec2a18207
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Fri Dec 16 11:59:49 2016 -0500
CLabel: Kill redundant UnitId argument from labelDynamic
It already has access to the current package's UnitId via the Module.
Edward Yang pointed out that there is one wrinkle, however: the
following invariant isn't true at all stages of compilation,
if I am compiling the module (this_mod :: Module), then
thisPackage dflags == moduleUnitId this_mod.
Specifically, this is only true after desugaring; it may be broken when
typechecking an indefinite signature.
However, it's safe to assume this in the native codegen. I've updated
Note to state this invariant more directly.
Test Plan: Validate
Reviewers: austin, ezyang, simonmar
Reviewed By: ezyang, simonmar
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2863
>---------------------------------------------------------------
5bf344b7f4e1538fbc019896ae07ae3ec2a18207
compiler/cmm/CLabel.hs | 8 +++++---
compiler/deSugar/Desugar.hs | 2 ++
compiler/nativeGen/PIC.hs | 16 ++++++++--------
compiler/typecheck/TcRnTypes.hs | 7 +++++++
4 files changed, 22 insertions(+), 11 deletions(-)
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 811d8e9..0f3410a 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -946,8 +946,8 @@ idInfoLabelType info =
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.
-labelDynamic :: DynFlags -> UnitId -> Module -> CLabel -> Bool
-labelDynamic dflags this_pkg this_mod lbl =
+labelDynamic :: DynFlags -> Module -> CLabel -> Bool
+labelDynamic dflags this_mod lbl =
case lbl of
-- is the RTS in a DLL or not?
RtsLabel _ -> (WayDyn `elem` ways dflags) && (this_pkg /= rtsUnitId)
@@ -989,7 +989,9 @@ labelDynamic dflags this_pkg this_mod lbl =
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
- where os = platformOS (targetPlatform dflags)
+ where
+ os = platformOS (targetPlatform dflags)
+ this_pkg = moduleUnitId this_mod
-----------------------------------------------------------------------------
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 28ec706..e73f12f 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -369,6 +369,8 @@ deSugar hsc_env
; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names dep_files merged
-- id_mod /= mod when we are processing an hsig, but hsigs
-- never desugared and compiled (there's no code!)
+ -- Consequently, this should hold for any ModGuts that make
+ -- past desugaring. See Note [Identity versus semantic module].
; MASSERT( id_mod == mod )
; let mod_guts = ModGuts {
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 2529f91..babceac 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -241,7 +241,7 @@ howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
-- If the target symbol is in another PE we need to access it via the
-- appropriate __imp_SYMBOL pointer.
- | labelDynamic dflags (thisPackage dflags) this_mod lbl
+ | labelDynamic dflags this_mod lbl
= AccessViaSymbolPtr
-- Target symbol is in the same PE as the caller, so just access it directly.
@@ -259,7 +259,7 @@ howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
--
howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
-- data access to a dynamic library goes via a symbol pointer
- | labelDynamic dflags (thisPackage dflags) this_mod lbl
+ | labelDynamic dflags this_mod lbl
= AccessViaSymbolPtr
-- when generating PIC code, all cross-module data references must
@@ -283,7 +283,7 @@ howToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl
-- stack alignment is only right for regular calls.
-- Therefore, we have to go via a symbol pointer:
| arch == ArchX86 || arch == ArchX86_64
- , labelDynamic dflags (thisPackage dflags) this_mod lbl
+ , labelDynamic dflags this_mod lbl
= AccessViaSymbolPtr
@@ -292,7 +292,7 @@ howToAccessLabel dflags arch OSDarwin this_mod _ lbl
-- not needed on x86_64 because Apple's new linker, ld64, generates
-- them automatically.
| arch /= ArchX86_64
- , labelDynamic dflags (thisPackage dflags) this_mod lbl
+ , labelDynamic dflags this_mod lbl
= AccessViaStub
| otherwise
@@ -344,7 +344,7 @@ howToAccessLabel dflags arch os this_mod DataReference lbl
| osElfTarget os
= case () of
-- A dynamic label needs to be accessed via a symbol pointer.
- _ | labelDynamic dflags (thisPackage dflags) this_mod lbl
+ _ | labelDynamic dflags this_mod lbl
-> AccessViaSymbolPtr
-- For PowerPC32 -fPIC, we have to access even static data
@@ -372,17 +372,17 @@ howToAccessLabel dflags arch os this_mod DataReference lbl
howToAccessLabel dflags arch os this_mod CallReference lbl
| osElfTarget os
- , labelDynamic dflags (thisPackage dflags) this_mod lbl && not (gopt Opt_PIC dflags)
+ , labelDynamic dflags this_mod lbl && not (gopt Opt_PIC dflags)
= AccessDirectly
| osElfTarget os
, arch /= ArchX86
- , labelDynamic dflags (thisPackage dflags) this_mod lbl && gopt Opt_PIC dflags
+ , labelDynamic dflags this_mod lbl && gopt Opt_PIC dflags
= AccessViaStub
howToAccessLabel dflags _ os this_mod _ lbl
| osElfTarget os
- = if labelDynamic dflags (thisPackage dflags) this_mod lbl
+ = if labelDynamic dflags this_mod lbl
then AccessViaSymbolPtr
else AccessDirectly
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 4833839..a79b1a0 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -439,6 +439,13 @@ data FrontendResult
-- signatures (we just generate blank object files for
-- hsig files.)
--
+-- A corrolary of this is that the following invariant holds at any point
+-- past desugaring,
+--
+-- if I have a Module, this_mod, in hand representing the module
+-- currently being compiled,
+-- then moduleUnitId this_mod == thisPackage dflags
+--
-- - For any code involving Names, we want semantic modules.
-- See lookupIfaceTop in IfaceEnv, mkIface and addFingerprints
-- in MkIface, and tcLookupGlobal in TcEnv
More information about the ghc-commits
mailing list