From: Debian Haskell Group <pkg-haskell-maintainers@lists.alioth.debian.org>
Date: Mon, 31 Jul 2023 22:47:27 +0000 (+0100)
Subject: Don't include BufPos in interface files
X-Git-Tag: archive/raspbian/9.4.7-2+rpi1~3^2~14
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=a213c8619cffac9713178d2d52cd400ca3d346b3;p=ghc.git

Don't include BufPos in interface files

Origin: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8972
Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/22162

===================================================================

Gbp-Pq: Name buildpath-abi-stability-2.patch
---

diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index ce6b564b..57d636a6 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -746,5 +746,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 2ac2a13b..2a037d1c 100644
--- a/compiler/GHC/Types/SrcLoc.hs
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -72,6 +72,7 @@ module GHC.Types.SrcLoc (
         getBufPos,
         BufSpan(..),
         getBufSpan,
+        removeBufSpan,
 
         -- * Located
         Located,
@@ -397,6 +398,10 @@ data UnhelpfulSpanReason
   | UnhelpfulOther !FastString
   deriving (Eq, Show)
 
+removeBufSpan :: SrcSpan -> SrcSpan
+removeBufSpan (RealSrcSpan s _) = RealSrcSpan s 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 32d8608f..7495ed9b 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -1444,19 +1444,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
@@ -1475,10 +1462,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
@@ -1488,8 +1476,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 Nothing)
             _ -> do s <- get bh
                     return (UnhelpfulSpan s)