Teo Camarasu pushed to branch wip/T24782 at Glasgow Haskell Compiler / GHC
Commits:
-
01318925
by Teo Camarasu at 2025-04-15T15:28:31+01:00
3 changed files:
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- testsuite/tests/interface-stability/template-haskell-exports.stdout
Changes:
... | ... | @@ -190,16 +190,11 @@ module Language.Haskell.TH.Syntax ( |
190 | 190 | nothingName,
|
191 | 191 | rightName,
|
192 | 192 | trueName,
|
193 | - addrToByteArrayName,
|
|
194 | - addrToByteArray,
|
|
195 | 193 | )
|
196 | 194 | where
|
197 | 195 | |
198 | -import Data.Array.Byte
|
|
199 | 196 | import GHC.Boot.TH.Lift
|
200 | 197 | import GHC.Boot.TH.Syntax
|
201 | -import GHC.Exts
|
|
202 | -import GHC.ST
|
|
203 | 198 | import System.FilePath
|
204 | 199 | |
205 | 200 | -- This module completely re-exports 'GHC.Boot.TH.Syntax',
|
... | ... | @@ -211,17 +206,3 @@ makeRelativeToProject fp | isRelative fp = do |
211 | 206 | root <- getPackageRoot
|
212 | 207 | return (root </> fp)
|
213 | 208 | makeRelativeToProject fp = return fp |
214 | - |
|
215 | --- The following two defintions are copied from 'Data.Byte.Array'
|
|
216 | --- in order to preserve the old export list of 'TH.Syntax'.
|
|
217 | --- They will soon be removed as part of #24782.
|
|
218 | - |
|
219 | -addrToByteArrayName :: Name
|
|
220 | -addrToByteArrayName = 'addrToByteArray
|
|
221 | - |
|
222 | -addrToByteArray :: Int -> Addr# -> ByteArray
|
|
223 | -addrToByteArray (I# len) addr = runST $ ST $
|
|
224 | - \s -> case newByteArray# len s of
|
|
225 | - (# s', mb #) -> case copyAddrToByteArray# addr mb 0# len s' of
|
|
226 | - s'' -> case unsafeFreezeByteArray# mb s'' of
|
|
227 | - (# s''', ret #) -> (# s''', ByteArray ret #) |
... | ... | @@ -13,6 +13,8 @@ |
13 | 13 |
|
14 | 14 | * Remove the `Language.Haskell.TH.Lib.Internal` module. This module has long been deprecated, and exposes compiler internals.
|
15 | 15 | Users should use `Language.Haskell.TH.Lib` instead, which exposes a stable version of this API.
|
16 | +
|
|
17 | + * Remove `addrToByteArrayName` and `addrToByteArray` from `Language.Haskell.TH.Syntax`. These were part of the implementation of the `Lift ByteArray` instance and were errornously exported because this module lacked an explicit export list. They have no usages on Hackage.
|
|
16 | 18 | |
17 | 19 | ## 2.23.0.0
|
18 | 20 |
... | ... | @@ -1780,8 +1780,6 @@ module Language.Haskell.TH.Syntax where |
1780 | 1780 | addModFinalizer :: Q () -> Q ()
|
1781 | 1781 | addTempFile :: GHC.Internal.Base.String -> Q GHC.Internal.IO.FilePath
|
1782 | 1782 | addTopDecls :: [Dec] -> Q ()
|
1783 | - addrToByteArray :: GHC.Internal.Types.Int -> GHC.Internal.Prim.Addr# -> Data.Array.Byte.ByteArray
|
|
1784 | - addrToByteArrayName :: Name
|
|
1785 | 1783 | badIO :: forall a. GHC.Internal.Base.String -> GHC.Internal.Types.IO a
|
1786 | 1784 | bindCode :: forall (m :: * -> *) a (r :: GHC.Internal.Types.RuntimeRep) (b :: TYPE r). GHC.Internal.Base.Monad m => m a -> (a -> Code m b) -> Code m b
|
1787 | 1785 | bindCode_ :: forall (m :: * -> *) a (r :: GHC.Internal.Types.RuntimeRep) (b :: TYPE r). GHC.Internal.Base.Monad m => m a -> Code m b -> Code m b
|