summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Cmm/CLabel.hs1
-rw-r--r--compiler/GHC/Stg/Syntax.hs2
-rw-r--r--compiler/GHC/Types/Name.hs36
-rw-r--r--compiler/GHC/Unit/State.hs35
4 files changed, 36 insertions, 38 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 90e401d942..eaf73b475b 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -119,7 +119,6 @@ import GHC.Prelude
import GHC.Types.Id.Info
import GHC.Types.Basic
import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
-import GHC.Unit.State
import GHC.Unit
import GHC.Types.Name
import GHC.Types.Unique
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index c37a15b4c1..ec8e30e689 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -72,11 +72,11 @@ import GHC.Core.DataCon
import GHC.Driver.Session
import GHC.Types.ForeignCall ( ForeignCall )
import GHC.Types.Id
+import GHC.Types.Name ( isDynLinkName )
import GHC.Types.Var.Set
import GHC.Types.Literal ( Literal, literalType )
import GHC.Unit.Module ( Module )
import GHC.Utils.Outputable
-import GHC.Unit.State ( isDynLinkName )
import GHC.Platform
import GHC.Core.Ppr( {- instances -} )
import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
index e587b08d0a..41a65dc3b3 100644
--- a/compiler/GHC/Types/Name.hs
+++ b/compiler/GHC/Types/Name.hs
@@ -60,7 +60,7 @@ module GHC.Types.Name (
-- ** Predicates on 'Name's
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isDataConName,
- isValName, isVarName,
+ isValName, isVarName, isDynLinkName,
isWiredInName, isWiredIn, isBuiltInSyntax,
isHoleName,
wiredInNameTyThing_maybe,
@@ -83,6 +83,7 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Core.TyCo.Rep( TyThing )
+import GHC.Platform
import GHC.Types.Name.Occurrence
import GHC.Unit.Module
import GHC.Types.SrcLoc
@@ -242,6 +243,39 @@ isInternalName name = not (isExternalName name)
isHoleName :: Name -> Bool
isHoleName = isHoleModule . nameModule
+-- | Will the 'Name' come from a dynamically linked package?
+isDynLinkName :: Platform -> Module -> Name -> Bool
+isDynLinkName platform this_mod name
+ | Just mod <- nameModule_maybe name
+ -- Issue #8696 - when GHC is dynamically linked, it will attempt
+ -- to load the dynamic dependencies of object files at compile
+ -- time for things like QuasiQuotes or
+ -- TemplateHaskell. Unfortunately, this interacts badly with
+ -- intra-package linking, because we don't generate indirect
+ -- (dynamic) symbols for intra-package calls. This means that if a
+ -- module with an intra-package call is loaded without its
+ -- dependencies, then GHC fails to link.
+ --
+ -- In the mean time, always force dynamic indirections to be
+ -- generated: when the module name isn't the module being
+ -- compiled, references are dynamic.
+ = case platformOS platform of
+ -- On Windows the hack for #8696 makes it unlinkable.
+ -- As the entire setup of the code from Cmm down to the RTS expects
+ -- the use of trampolines for the imported functions only when
+ -- doing intra-package linking, e.g. referring to a symbol defined in the same
+ -- package should not use a trampoline.
+ -- I much rather have dynamic TH not supported than the entire Dynamic linking
+ -- not due to a hack.
+ -- Also not sure this would break on Windows anyway.
+ OSMinGW32 -> moduleUnit mod /= moduleUnit this_mod
+
+ -- For the other platforms, still perform the hack
+ _ -> mod /= this_mod
+
+ | otherwise = False -- no, it is not even an external name
+
+
nameModule name =
nameModule_maybe name `orElse`
pprPanic "nameModule" (ppr (n_sort name) <+> ppr name)
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 50fd72f651..be2abca983 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -60,7 +60,6 @@ module GHC.Unit.State (
pprPackagesSimple,
pprModuleMap,
isIndefinite,
- isDynLinkName
)
where
@@ -75,13 +74,11 @@ import GHC.Unit.Module
import GHC.Unit.Subst
import GHC.Driver.Session
import GHC.Driver.Ways
-import GHC.Types.Name ( Name, nameModule_maybe )
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique.Set
import GHC.Utils.Misc
import GHC.Utils.Panic
-import GHC.Platform
import GHC.Utils.Outputable as Outputable
import GHC.Data.Maybe
@@ -2088,38 +2085,6 @@ displayUnitId :: PackageState -> UnitId -> Maybe String
displayUnitId pkgstate uid =
fmap unitPackageIdString (lookupInstalledPackage pkgstate uid)
--- | Will the 'Name' come from a dynamically linked package?
-isDynLinkName :: Platform -> Module -> Name -> Bool
-isDynLinkName platform this_mod name
- | Just mod <- nameModule_maybe name
- -- Issue #8696 - when GHC is dynamically linked, it will attempt
- -- to load the dynamic dependencies of object files at compile
- -- time for things like QuasiQuotes or
- -- TemplateHaskell. Unfortunately, this interacts badly with
- -- intra-package linking, because we don't generate indirect
- -- (dynamic) symbols for intra-package calls. This means that if a
- -- module with an intra-package call is loaded without its
- -- dependencies, then GHC fails to link.
- --
- -- In the mean time, always force dynamic indirections to be
- -- generated: when the module name isn't the module being
- -- compiled, references are dynamic.
- = case platformOS platform of
- -- On Windows the hack for #8696 makes it unlinkable.
- -- As the entire setup of the code from Cmm down to the RTS expects
- -- the use of trampolines for the imported functions only when
- -- doing intra-package linking, e.g. referring to a symbol defined in the same
- -- package should not use a trampoline.
- -- I much rather have dynamic TH not supported than the entire Dynamic linking
- -- not due to a hack.
- -- Also not sure this would break on Windows anyway.
- OSMinGW32 -> moduleUnit mod /= moduleUnit this_mod
-
- -- For the other platforms, still perform the hack
- _ -> mod /= this_mod
-
- | otherwise = False -- no, it is not even an external name
-
-- -----------------------------------------------------------------------------
-- Displaying packages