summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-09-12 15:29:20 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-10-11 12:50:40 -0400
commit7f0decd5063a853fc8f38a8944b2c91995cd5e48 (patch)
tree01c5fa5c5d8d0f3f7cf1e2ba0a24bb19c7feec5a
parent66af1399963a1872e520d1dbd1c94fd43e65082d (diff)
downloadhaskell-7f0decd5063a853fc8f38a8944b2c91995cd5e48.tar.gz
Don't include BufPos in interface files
Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162
-rw-r--r--compiler/GHC/Iface/Ext/Types.hs4
-rw-r--r--compiler/GHC/Types/SrcLoc.hs5
-rw-r--r--compiler/GHC/Utils/Binary.hs21
3 files changed, 11 insertions, 19 deletions
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index 08412349d2..4aefc4d23c 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -781,5 +781,5 @@ toHieName name
| isKnownKeyName name = KnownKeyName (nameUnique name)
| isExternalName name = ExternalName (nameModule name)
(nameOccName name)
- (nameSrcSpan name)
- | otherwise = LocalName (nameOccName name) (nameSrcSpan name)
+ (removeBufSpan $ nameSrcSpan name)
+ | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs
index bcf47dcaff..1f6d285b38 100644
--- a/compiler/GHC/Types/SrcLoc.hs
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -68,6 +68,7 @@ module GHC.Types.SrcLoc (
getBufPos,
BufSpan(..),
getBufSpan,
+ removeBufSpan,
-- * Located
Located,
@@ -392,6 +393,10 @@ data UnhelpfulSpanReason
| UnhelpfulOther !FastString
deriving (Eq, Show)
+removeBufSpan :: SrcSpan -> SrcSpan
+removeBufSpan (RealSrcSpan s _) = RealSrcSpan s Strict.Nothing
+removeBufSpan s = s
+
{- Note [Why Maybe BufPos]
~~~~~~~~~~~~~~~~~~~~~~~~~~
In SrcLoc we store (Maybe BufPos); in SrcSpan we store (Maybe BufSpan).
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index 5005fd4a73..f224589ee0 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -1312,19 +1312,6 @@ instance Binary RealSrcSpan where
return (mkRealSrcSpan (mkRealSrcLoc f sl sc)
(mkRealSrcLoc f el ec))
-instance Binary BufPos where
- put_ bh (BufPos i) = put_ bh i
- get bh = BufPos <$> get bh
-
-instance Binary BufSpan where
- put_ bh (BufSpan start end) = do
- put_ bh start
- put_ bh end
- get bh = do
- start <- get bh
- end <- get bh
- return (BufSpan start end)
-
instance Binary UnhelpfulSpanReason where
put_ bh r = case r of
UnhelpfulNoLocationInfo -> putByte bh 0
@@ -1343,10 +1330,11 @@ instance Binary UnhelpfulSpanReason where
_ -> UnhelpfulOther <$> get bh
instance Binary SrcSpan where
- put_ bh (RealSrcSpan ss sb) = do
+ put_ bh (RealSrcSpan ss _sb) = do
putByte bh 0
+ -- BufSpan doesn't ever get serialised because the positions depend
+ -- on build location.
put_ bh ss
- put_ bh sb
put_ bh (UnhelpfulSpan s) = do
putByte bh 1
@@ -1356,8 +1344,7 @@ instance Binary SrcSpan where
h <- getByte bh
case h of
0 -> do ss <- get bh
- sb <- get bh
- return (RealSrcSpan ss sb)
+ return (RealSrcSpan ss Strict.Nothing)
_ -> do s <- get bh
return (UnhelpfulSpan s)