diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-09-12 15:29:20 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-10-11 12:50:40 -0400 |
commit | 7f0decd5063a853fc8f38a8944b2c91995cd5e48 (patch) | |
tree | 01c5fa5c5d8d0f3f7cf1e2ba0a24bb19c7feec5a /compiler/GHC | |
parent | 66af1399963a1872e520d1dbd1c94fd43e65082d (diff) | |
download | haskell-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
Diffstat (limited to 'compiler/GHC')
-rw-r--r-- | compiler/GHC/Iface/Ext/Types.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Types/SrcLoc.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Utils/Binary.hs | 21 |
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) |