- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/faster-linkBCO] ghci: use SmallArray directly in ResolvedBCO/UnlinkedBCO
by Cheng Shao (＠TerrorJack) 18 Mar '26

18 Mar '26

Cheng Shao pushed to branch wip/faster-linkBCO at Glasgow Haskell Compiler / GHC Commits: 14d690c8 by Cheng Shao at 2026-03-18T04:08:02+01:00 ghci: use SmallArray directly in ResolvedBCO/UnlinkedBCO This patch makes ghci use `SmallArray` directly in `ResolvedBCO` and `UnlinkedBCO` when applicable, making the memory representation more compact and reducing marshaling overhead. Closes #27058. - - - - - 5 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -87,9 +87,9 @@ bcoFreeNames bco where bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs) = unionManyUniqDSets ( - mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] : - mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] : - map bco_refs [ bco | BCOPtrBCO bco <- elemsFlatBag ptrs ] + mkUniqDSet [ n | BCOPtrName n <- smallArrayToList ptrs ] : + mkUniqDSet [ n | BCONPtrItbl n <- smallArrayToList nonptrs ] : + map bco_refs [ bco | BCOPtrBCO bco <- smallArrayToList ptrs ] ) -- ----------------------------------------------------------------------------- @@ -234,8 +234,8 @@ assembleBCO platform , unlinkedBCOArity = arity , unlinkedBCOInstrs = insns_arr , unlinkedBCOBitmap = bitmap_arr - , unlinkedBCOLits = fromSmallArray final_lit_array - , unlinkedBCOPtrs = fromSmallArray final_ptr_array + , unlinkedBCOLits = final_lit_array + , unlinkedBCOPtrs = final_ptr_array } -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -29,7 +29,7 @@ import GHC.Unit.Types import GHC.Data.FastString import GHC.Data.Maybe -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHC.Linker.Types @@ -43,7 +43,8 @@ import GHC.Types.Unique.DFM -- Standard libraries import Control.Concurrent -import Data.Array.Unboxed +import Data.Array.Base +import Data.Array.IO.Internals import Foreign.Ptr import GHC.Exts @@ -62,15 +63,16 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0) - let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits + litsMut <- unsafeNewArray_ (0, sizeofSmallArray lits0 - 1) + flip imapSmallArrayM_ lits0 $ \i lit -> unsafeWrite litsMut i =<< lookupLiteral interp pkgs_loaded bytecode_state lit + lits <- unsafeFreezeIOUArray litsMut + ptrs <- mapSmallArrayIO (resolvePtr interp pkgs_loaded bytecode_state bco_ix) ptrs0 return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian , resolvedBCOArity = arity , resolvedBCOInstrs = insns , resolvedBCOBitmap = bitmap - , resolvedBCOLits = mkBCOByteArray lits' - , resolvedBCOPtrs = addListToSS emptySS ptrs + , resolvedBCOLits = mkBCOByteArray lits + , resolvedBCOPtrs = ptrs } lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Data.FlatBag +import GHC.Data.SmallArray import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Binary @@ -250,14 +251,14 @@ data UnlinkedBCO unlinkedBCOArity :: {-# UNPACK #-} !Int, unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap - unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs + unlinkedBCOLits :: !(SmallArray BCONPtr), -- non-ptrs + unlinkedBCOPtrs :: !(SmallArray BCOPtr) -- ptrs } instance NFData UnlinkedBCO where rnf UnlinkedBCO{..} = - rnf unlinkedBCOLits `seq` - rnf unlinkedBCOPtrs + rnfSmallArray unlinkedBCOLits `seq` + rnfSmallArray unlinkedBCOPtrs data BCOPtr = BCOPtrName !Name @@ -293,11 +294,10 @@ instance NFData BCONPtr where instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", - ppr (sizeFlatBag lits), text "lits", - ppr (sizeFlatBag ptrs), text "ptrs" ] + ppr (sizeofSmallArray lits), text "lits", + ppr (sizeofSmallArray ptrs), text "ptrs" ] instance Binary FFIInfo where get bh = FFIInfo <$> get bh <*> get bh put_ bh FFIInfo {..} = put_ bh ffiInfoArgs *> put_ bh ffiInfoRet - ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -18,10 +18,9 @@ import Prelude -- See note [Why do we import Prelude here?] import GHCi.ResolvedBCO import GHCi.RemoteTypes import GHCi.BreakArray -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import System.IO (fixIO) -import Control.Monad import Data.Array.Base import Foreign hiding (newArray) import Unsafe.Coerce (unsafeCoerce) @@ -72,9 +71,6 @@ createBCO arr bco linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO linkBCO' arr ResolvedBCO{..} = do let - ptrs = ssElts resolvedBCOPtrs - n_ptrs = sizeSS resolvedBCOPtrs - !(I# arity#) = resolvedBCOArity !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array] @@ -83,7 +79,7 @@ linkBCO' arr ResolvedBCO{..} = do bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap) literals_barr = barr (getBCOByteArray resolvedBCOLits) - PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs + PtrsArr marr <- mkPtrsArray arr resolvedBCOPtrs IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> @@ -92,24 +88,25 @@ linkBCO' arr ResolvedBCO{..} = do -- we recursively link any sub-BCOs while making the ptrs array -mkPtrsArray :: Array Int HValue -> Word -> [ResolvedBCOPtr] -> IO PtrsArr -mkPtrsArray arr n_ptrs ptrs = do - marr <- newPtrsArray (fromIntegral n_ptrs) +mkPtrsArray :: Array Int HValue -> SmallArray ResolvedBCOPtr -> IO PtrsArr +mkPtrsArray arr ptrs = do + let n_ptrs = sizeofSmallArray ptrs + marr <- newPtrsArray n_ptrs let - fill (ResolvedBCORef n) i = + fill i (ResolvedBCORef n) = writePtrsArrayHValue i (arr ! n) marr -- must be lazy! - fill (ResolvedBCOPtr r) i = do + fill i (ResolvedBCOPtr r) = do hv <- localRef r writePtrsArrayHValue i hv marr - fill (ResolvedBCOStaticPtr r) i = do + fill i (ResolvedBCOStaticPtr r) = do writePtrsArrayPtr i (fromRemotePtr r) marr - fill (ResolvedBCOPtrBCO bco) i = do + fill i (ResolvedBCOPtrBCO bco) = do bco <- linkBCO' arr bco writePtrsArrayBCO i bco marr - fill (ResolvedBCOPtrBreakArray r) i = do + fill i (ResolvedBCOPtrBreakArray r) = do BA mba <- localRef r writePtrsArrayMBA i mba marr - zipWithM_ fill ptrs [0..] + flip imapSmallArrayM_ ptrs fill return marr data PtrsArr = PtrsArr (MutableArray# RealWorld HValue) ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -12,7 +12,7 @@ module GHCi.ResolvedBCO #include "MachDeps.h" import Prelude -- See note [Why do we import Prelude here?] -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHCi.RemoteTypes import GHCi.BreakArray @@ -51,13 +51,13 @@ isLittleEndian = True -- data ResolvedBCO = ResolvedBCO { - resolvedBCOIsLE :: Bool, + resolvedBCOIsLE :: !Bool, resolvedBCOArity :: {-# UNPACK #-} !Int, - resolvedBCOInstrs :: BCOByteArray Word16, -- ^ insns - resolvedBCOBitmap :: BCOByteArray Word, -- ^ bitmap - resolvedBCOLits :: BCOByteArray Word, + resolvedBCOInstrs :: !(BCOByteArray Word16), -- ^ insns + resolvedBCOBitmap :: !(BCOByteArray Word), -- ^ bitmap + resolvedBCOLits :: !(BCOByteArray Word), -- ^ non-ptrs - subword sized entries still take up a full (host) word - resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ^ ptrs + resolvedBCOPtrs :: !(SmallArray ResolvedBCOPtr) -- ^ ptrs } deriving (Generic, Show) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14d690c857ba8d7783c2e8f31c12127… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14d690c857ba8d7783c2e8f31c12127… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/faster-linkBCO] ghci: use SmallArray directly in ResolvedBCO/UnlinkedBCO
by Cheng Shao (＠TerrorJack) 18 Mar '26

18 Mar '26

Cheng Shao pushed to branch wip/faster-linkBCO at Glasgow Haskell Compiler / GHC Commits: d27af92b by Cheng Shao at 2026-03-18T03:04:36+00:00 ghci: use SmallArray directly in ResolvedBCO/UnlinkedBCO This patch makes ghci use `SmallArray` directly in `ResolvedBCO` and `UnlinkedBCO` when applicable, making the memory representation more compact and reducing marshaling overhead. Closes #27058. - - - - - 5 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -87,9 +87,9 @@ bcoFreeNames bco where bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs) = unionManyUniqDSets ( - mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] : - mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] : - map bco_refs [ bco | BCOPtrBCO bco <- elemsFlatBag ptrs ] + mkUniqDSet [ n | BCOPtrName n <- smallArrayToList ptrs ] : + mkUniqDSet [ n | BCONPtrItbl n <- smallArrayToList nonptrs ] : + map bco_refs [ bco | BCOPtrBCO bco <- smallArrayToList ptrs ] ) -- ----------------------------------------------------------------------------- @@ -234,8 +234,8 @@ assembleBCO platform , unlinkedBCOArity = arity , unlinkedBCOInstrs = insns_arr , unlinkedBCOBitmap = bitmap_arr - , unlinkedBCOLits = fromSmallArray final_lit_array - , unlinkedBCOPtrs = fromSmallArray final_ptr_array + , unlinkedBCOLits = final_lit_array + , unlinkedBCOPtrs = final_ptr_array } -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -29,7 +29,7 @@ import GHC.Unit.Types import GHC.Data.FastString import GHC.Data.Maybe -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHC.Linker.Types @@ -43,7 +43,8 @@ import GHC.Types.Unique.DFM -- Standard libraries import Control.Concurrent -import Data.Array.Unboxed +import Data.Array.Base +import Data.Array.IO.Internals import Foreign.Ptr import GHC.Exts @@ -62,15 +63,16 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0) - let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits + litsMut <- unsafeNewArray_ (0, sizeofSmallArray lits0 - 1) + flip imapSmallArrayM_ lits0 $ \i lit -> unsafeWrite litsMut i =<< lookupLiteral interp pkgs_loaded bytecode_state lit + lits <- unsafeFreezeIOUArray litsMut + ptrs <- mapSmallArrayIO (resolvePtr interp pkgs_loaded bytecode_state bco_ix) ptrs0 return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian , resolvedBCOArity = arity , resolvedBCOInstrs = insns , resolvedBCOBitmap = bitmap - , resolvedBCOLits = mkBCOByteArray lits' - , resolvedBCOPtrs = addListToSS emptySS ptrs + , resolvedBCOLits = mkBCOByteArray lits + , resolvedBCOPtrs = ptrs } lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Data.FlatBag +import GHC.Data.SmallArray import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Binary @@ -250,14 +251,14 @@ data UnlinkedBCO unlinkedBCOArity :: {-# UNPACK #-} !Int, unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap - unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs + unlinkedBCOLits :: !(SmallArray BCONPtr), -- non-ptrs + unlinkedBCOPtrs :: !(SmallArray BCOPtr) -- ptrs } instance NFData UnlinkedBCO where rnf UnlinkedBCO{..} = - rnf unlinkedBCOLits `seq` - rnf unlinkedBCOPtrs + rnfSmallArray unlinkedBCOLits `seq` + rnfSmallArray unlinkedBCOPtrs data BCOPtr = BCOPtrName !Name @@ -293,11 +294,10 @@ instance NFData BCONPtr where instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", - ppr (sizeFlatBag lits), text "lits", - ppr (sizeFlatBag ptrs), text "ptrs" ] + ppr (sizeofSmallArray lits), text "lits", + ppr (sizeofSmallArray ptrs), text "ptrs" ] instance Binary FFIInfo where get bh = FFIInfo <$> get bh <*> get bh put_ bh FFIInfo {..} = put_ bh ffiInfoArgs *> put_ bh ffiInfoRet - ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -18,10 +18,9 @@ import Prelude -- See note [Why do we import Prelude here?] import GHCi.ResolvedBCO import GHCi.RemoteTypes import GHCi.BreakArray -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import System.IO (fixIO) -import Control.Monad import Data.Array.Base import Foreign hiding (newArray) import Unsafe.Coerce (unsafeCoerce) @@ -72,9 +71,6 @@ createBCO arr bco linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO linkBCO' arr ResolvedBCO{..} = do let - ptrs = ssElts resolvedBCOPtrs - n_ptrs = sizeSS resolvedBCOPtrs - !(I# arity#) = resolvedBCOArity !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array] @@ -83,7 +79,7 @@ linkBCO' arr ResolvedBCO{..} = do bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap) literals_barr = barr (getBCOByteArray resolvedBCOLits) - PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs + PtrsArr marr <- mkPtrsArray arr resolvedBCOPtrs IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> @@ -92,24 +88,25 @@ linkBCO' arr ResolvedBCO{..} = do -- we recursively link any sub-BCOs while making the ptrs array -mkPtrsArray :: Array Int HValue -> Word -> [ResolvedBCOPtr] -> IO PtrsArr -mkPtrsArray arr n_ptrs ptrs = do - marr <- newPtrsArray (fromIntegral n_ptrs) +mkPtrsArray :: Array Int HValue -> SmallArray ResolvedBCOPtr -> IO PtrsArr +mkPtrsArray arr ptrs = do + let n_ptrs = sizeofSmallArray ptrs + marr <- newPtrsArray n_ptrs let - fill (ResolvedBCORef n) i = + fill i (ResolvedBCORef n) = writePtrsArrayHValue i (arr ! n) marr -- must be lazy! - fill (ResolvedBCOPtr r) i = do + fill i (ResolvedBCOPtr r) = do hv <- localRef r writePtrsArrayHValue i hv marr - fill (ResolvedBCOStaticPtr r) i = do + fill i (ResolvedBCOStaticPtr r) = do writePtrsArrayPtr i (fromRemotePtr r) marr - fill (ResolvedBCOPtrBCO bco) i = do + fill i (ResolvedBCOPtrBCO bco) = do bco <- linkBCO' arr bco writePtrsArrayBCO i bco marr - fill (ResolvedBCOPtrBreakArray r) i = do + fill i (ResolvedBCOPtrBreakArray r) = do BA mba <- localRef r writePtrsArrayMBA i mba marr - zipWithM_ fill ptrs [0..] + flip imapSmallArrayM_ ptrs fill return marr data PtrsArr = PtrsArr (MutableArray# RealWorld HValue) ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -12,7 +12,7 @@ module GHCi.ResolvedBCO #include "MachDeps.h" import Prelude -- See note [Why do we import Prelude here?] -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHCi.RemoteTypes import GHCi.BreakArray @@ -51,13 +51,13 @@ isLittleEndian = True -- data ResolvedBCO = ResolvedBCO { - resolvedBCOIsLE :: Bool, + resolvedBCOIsLE :: !Bool, resolvedBCOArity :: {-# UNPACK #-} !Int, - resolvedBCOInstrs :: BCOByteArray Word16, -- ^ insns - resolvedBCOBitmap :: BCOByteArray Word, -- ^ bitmap - resolvedBCOLits :: BCOByteArray Word, + resolvedBCOInstrs :: !(BCOByteArray Word16), -- ^ insns + resolvedBCOBitmap :: !(BCOByteArray Word), -- ^ bitmap + resolvedBCOLits :: !(BCOByteArray Word), -- ^ non-ptrs - subword sized entries still take up a full (host) word - resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ^ ptrs + resolvedBCOPtrs :: !(SmallArray ResolvedBCOPtr) -- ^ ptrs } deriving (Generic, Show) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27af92baf3ae319e28fab9902516e7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27af92baf3ae319e28fab9902516e7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/rae/unconditional-optimizations] Force optimizations on where required for building
by Richard Eisenberg (＠rae) 18 Mar '26

18 Mar '26

Richard Eisenberg pushed to branch wip/rae/unconditional-optimizations at Glasgow Haskell Compiler / GHC Commits: cc9227b1 by Richard Eisenberg at 2026-03-17T22:33:15-04:00 Force optimizations on where required for building - - - - - 2 changed files: - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Tc/Solver/InertSet.hs Changes: ===================================== compiler/GHC/Data/TrieMap.hs ===================================== @@ -1,5 +1,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -O -fno-omit-interface-pragmas #-} + -- There are SPECIALIZE pragmas in GHC.Core.Map.Type that require + -- the ability to inline some functions here {- (c) The University of Glasgow 2006 ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -1,4 +1,7 @@ {-# LANGUAGE MultiWayIf #-} +{-# OPTIONS_GHC -O -fno-omit-interface-pragmas #-} + -- There is a SPECIALIZE pragma in GHC.Tc.Solver.Monad that requires + -- the ability to inline forAllCycleBreakerBindings_ some functions here module GHC.Tc.Solver.InertSet ( -- * The work list @@ -2174,4 +2177,3 @@ Wrong! The level-check ensures that the inner implicit parameter wins. (Actually I think that the order in which the work-list is processed means that this chain of events won't happen, but that's very fragile.) -} - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc9227b1c86063a9cbac67d9d297783… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc9227b1c86063a9cbac67d9d297783… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/rae/unconditional-optimizations
by Richard Eisenberg (＠rae) 18 Mar '26

18 Mar '26

Richard Eisenberg pushed new branch wip/rae/unconditional-optimizations at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/rae/unconditional-optimizatio… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/faster-linkBCO
by Cheng Shao (＠TerrorJack) 18 Mar '26

18 Mar '26

Cheng Shao pushed new branch wip/faster-linkBCO at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/faster-linkBCO You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/qstring-law
by Brandon Chinn (＠brandonchinn178) 17 Mar '26

17 Mar '26

Brandon Chinn pushed new branch wip/qstring-law at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/qstring-law You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/text-read-uncovering] 5 commits: Move I/O-related `Read` instances into `base`
by Wolfgang Jeltsch (＠jeltsch) 17 Mar '26

17 Mar '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC Commits: 4d8a1ed2 by Wolfgang Jeltsch at 2026-03-18T00:02:44+02:00 Move I/O-related `Read` instances into `base` Metric Increase: T12425 T13035 - - - - - b15b4400 by Wolfgang Jeltsch at 2026-03-18T00:04:07+02:00 Move most of the `Numeric` implementation into `base` The `showHex` operation and the `showIntAtBase` operation, which underlies it, are kept in `GHC.Internal.Numeric`, because `showHex` is used in a few places in `ghc-internal`; everything else is moved. - - - - - f36608c0 by Wolfgang Jeltsch at 2026-03-18T00:04:08+02:00 Move the instance `Read ByteOrder` into `base` - - - - - e1d23ae5 by Wolfgang Jeltsch at 2026-03-18T00:04:08+02:00 Move the implementation of version parsing into `base` - - - - - 4dd987ff by Wolfgang Jeltsch at 2026-03-18T00:04:08+02:00 Move the implementation of `readConstr` into `base` - - - - - 21 changed files: - libraries/base/src/Data/Data.hs - libraries/base/src/Data/Version.hs - libraries/base/src/GHC/ByteOrder.hs - libraries/base/src/Numeric.hs - libraries/base/src/System/IO.hs - libraries/base/src/Text/Printf.hs - libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - libraries/ghc-internal/src/GHC/Internal/Data/Version.hs - libraries/ghc-internal/src/GHC/Internal/IO/Device.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs - libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs - libraries/ghc-internal/src/GHC/Internal/Numeric.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout Changes: ===================================== libraries/base/src/Data/Data.hs ===================================== @@ -99,3 +99,38 @@ module Data.Data ( import GHC.Internal.Data.Data import Data.Typeable + +import GHC.Real (toRational) +import GHC.Float (Double) +import Data.Eq ((==)) +import Data.Function ((.)) +import Data.Maybe (Maybe (Nothing, Just)) +import Data.List (filter) +import Data.String (String) +import Text.Read (Read, reads) + +-- | Lookup a constructor via a string +readConstr :: DataType -> String -> Maybe Constr +readConstr dt str = + case dataTypeRep dt of + AlgRep cons -> idx cons + IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i))) + FloatRep -> mkReadCon ffloat + CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c))) + NoRep -> Nothing + where + + -- Read a value and build a constructor + mkReadCon :: Read t => (t -> Constr) -> Maybe Constr + mkReadCon f = case (reads str) of + [(t,"")] -> Just (f t) + _ -> Nothing + + -- Traverse list of algebraic datatype constructors + idx :: [Constr] -> Maybe Constr + idx cons = case filter ((==) str . showConstr) cons of + [] -> Nothing + hd : _ -> Just hd + + ffloat :: Double -> Constr + ffloat = mkPrimCon dt str . FloatConstr . toRational ===================================== libraries/base/src/Data/Version.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} + -- | -- Module : Data.Version -- Copyright : (c) The University of Glasgow 2004 @@ -33,3 +35,25 @@ module Data.Version ( ) where import GHC.Internal.Data.Version + +import Control.Applicative (pure, (*>)) +import Data.Functor (fmap) +import Data.Char (isDigit, isAlphaNum) +import Text.ParserCombinators.ReadP (ReadP, char, munch1, sepBy1, many) +import Text.Read (Read, read) + +{-NOTE: + The following instance is technically an orphan, but practically it is not, + since ordinary users should not use @ghc-internal@ directly and thus get + 'Version' only through this module. +-} + +-- | @since base-2.01 +deriving instance Read Version + +-- | A parser for versions in the format produced by 'showVersion'. +-- +parseVersion :: ReadP Version +parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.') + tags <- many (char '-' *> munch1 isAlphaNum) + pure Version{versionBranch=branch, versionTags=tags} ===================================== libraries/base/src/GHC/ByteOrder.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} + -- | -- -- Module : GHC.ByteOrder @@ -19,4 +21,15 @@ module GHC.ByteOrder targetByteOrder ) where -import GHC.Internal.ByteOrder \ No newline at end of file +import GHC.Internal.ByteOrder + +import Text.Read + +{-NOTE: + The following instance is technically an orphan, but practically it is not, + since ordinary users should not use @ghc-internal@ directly and thus get + 'ByteOrder' only through this module. +-} + +-- | @since base-4.11.0.0 +deriving instance Read ByteOrder ===================================== libraries/base/src/Numeric.hs ===================================== @@ -1,4 +1,6 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ImportQualifiedPost #-} -- | -- @@ -48,3 +50,279 @@ module Numeric ) where import GHC.Internal.Numeric + +import GHC.Types (Char (C#)) +import GHC.Err (error, errorWithoutStackTrace) +import GHC.Base (unsafeChr) +import GHC.Num (Num, (+), (-), (*)) +import GHC.Real + ( + Integral, + Real, + RealFrac, + fromIntegral, + fromRational, + quotRem, + showSigned + ) +import GHC.Float + ( + Floating (..), + RealFloat, + Float, + Double, + isNegativeZero, + isInfinite, + isNaN, + fromRat, + floatToDigits, + FFFormat (FFExponent, FFFixed, FFGeneric), + formatRealFloat, + formatRealFloatAlt, + showFloat + ) +import GHC.Read (lexDigits) +import Control.Monad (return) +import Data.Eq (Eq, (==)) +import Data.Ord ((<)) +import Data.Function (($), (.)) +import Data.Bool (Bool (False, True), otherwise, (||), (&&)) +import Data.Maybe (Maybe) +import Data.List ((++)) +import Data.Char (ord, intToDigit) +import Data.Int (Int) +import Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S) +import Text.Read (ReadS, readParen, lex) +import Text.Read.Lex qualified as L + ( + Lexeme (Number), + lex, + numberToRational, + readIntP, + readBinP, + readOctP, + readDecP, + readHexP + ) +import Text.Show (ShowS, show, showString) + +-- $setup +-- >>> import Prelude + +-- ----------------------------------------------------------------------------- +-- Reading + +-- | Reads an /unsigned/ integral value in an arbitrary base. +readInt :: Num a + => a -- ^ the base + -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base + -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int' + -> ReadS a +readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit) + +-- | Read an unsigned number in binary notation. +-- +-- >>> readBin "10011" +-- [(19,"")] +readBin :: (Eq a, Num a) => ReadS a +readBin = readP_to_S L.readBinP + +-- | Read an unsigned number in octal notation. +-- +-- >>> readOct "0644" +-- [(420,"")] +readOct :: (Eq a, Num a) => ReadS a +readOct = readP_to_S L.readOctP + +-- | Read an unsigned number in decimal notation. +-- +-- >>> readDec "0644" +-- [(644,"")] +readDec :: (Eq a, Num a) => ReadS a +readDec = readP_to_S L.readDecP + +-- | Read an unsigned number in hexadecimal notation. +-- Both upper or lower case letters are allowed. +-- +-- >>> readHex "deadbeef" +-- [(3735928559,"")] +readHex :: (Eq a, Num a) => ReadS a +readHex = readP_to_S L.readHexP + +-- | Reads an /unsigned/ 'RealFrac' value, +-- expressed in decimal scientific notation. +-- +-- Note that this function takes time linear in the magnitude of its input +-- which can scale exponentially with input size (e.g. @"1e100000000"@ is a +-- very large number while having a very small textual form). +-- For this reason, users should take care to avoid using this function on +-- untrusted input. Users needing to parse floating point values +-- (e.g. 'Float') are encouraged to instead use 'read', which does +-- not suffer from this issue. +readFloat :: RealFrac a => ReadS a +readFloat = readP_to_S readFloatP + +readFloatP :: RealFrac a => ReadP a +readFloatP = + do tok <- L.lex + case tok of + L.Number n -> return $ fromRational $ L.numberToRational n + _ -> pfail + +-- It's turgid to have readSigned work using list comprehensions, +-- but it's specified as a ReadS to ReadS transformer +-- With a bit of luck no one will use it. + +-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value. +readSigned :: (Real a) => ReadS a -> ReadS a +readSigned readPos = readParen False read' + where read' r = read'' r ++ + (do + ("-",s) <- lex r + (x,t) <- read'' s + return (-x,t)) + read'' r = do + (str,s) <- lex r + (n,"") <- readPos str + return (n,s) + +-- ----------------------------------------------------------------------------- +-- Showing + +-- | Show /non-negative/ 'Integral' numbers in base 10. +showInt :: Integral a => a -> ShowS +showInt n0 cs0 + | n0 < 0 = errorWithoutStackTrace "GHC.Internal.Numeric.showInt: can't show negative numbers" + | otherwise = go n0 cs0 + where + go n cs + | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of + c@(C# _) -> c:cs + | otherwise = case unsafeChr (ord '0' + fromIntegral r) of + c@(C# _) -> go q (c:cs) + where + (q,r) = n `quotRem` 10 + +-- Controlling the format and precision of floats. The code that +-- implements the formatting itself is in @PrelNum@ to avoid +-- mutual module deps. + +{-# SPECIALIZE showEFloat :: + Maybe Int -> Float -> ShowS #-} +{-# SPECIALIZE showEFloat :: + Maybe Int -> Double -> ShowS #-} +{-# SPECIALIZE showFFloat :: + Maybe Int -> Float -> ShowS #-} +{-# SPECIALIZE showFFloat :: + Maybe Int -> Double -> ShowS #-} +{-# SPECIALIZE showGFloat :: + Maybe Int -> Float -> ShowS #-} +{-# SPECIALIZE showGFloat :: + Maybe Int -> Double -> ShowS #-} + +-- | Show a signed 'RealFloat' value +-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@). +-- +-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing', +-- the value is shown to full precision; if @digs@ is @'Just' d@, +-- then at most @d@ digits after the decimal point are shown. +showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation (e.g. @245000@, @0.0015@). +-- +-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing', +-- the value is shown to full precision; if @digs@ is @'Just' d@, +-- then at most @d@ digits after the decimal point are shown. +showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation for arguments whose absolute value lies +-- between @0.1@ and @9,999,999@, and scientific notation otherwise. +-- +-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing', +-- the value is shown to full precision; if @digs@ is @'Just' d@, +-- then at most @d@ digits after the decimal point are shown. +showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS + +showEFloat d x = showString (formatRealFloat FFExponent d x) +showFFloat d x = showString (formatRealFloat FFFixed d x) +showGFloat d x = showString (formatRealFloat FFGeneric d x) + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation (e.g. @245000@, @0.0015@). +-- +-- This behaves as 'showFFloat', except that a decimal point +-- is always guaranteed, even if not needed. +-- +-- @since base-4.7.0.0 +showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation for arguments whose absolute value lies +-- between @0.1@ and @9,999,999@, and scientific notation otherwise. +-- +-- This behaves as 'showFFloat', except that a decimal point +-- is always guaranteed, even if not needed. +-- +-- @since base-4.7.0.0 +showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS + +showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x) +showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x) + +{- | Show a floating-point value in the hexadecimal format, +similar to the @%a@ specifier in C's printf. + + >>> showHFloat (212.21 :: Double) "" + "0x1.a86b851eb851fp7" + >>> showHFloat (-12.76 :: Float) "" + "-0x1.9851ecp3" + >>> showHFloat (-0 :: Double) "" + "-0x0p+0" + +@since base-4.11.0.0 +-} +showHFloat :: RealFloat a => a -> ShowS +showHFloat = showString . fmt + where + fmt x + | isNaN x = "NaN" + | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity" + | x < 0 || isNegativeZero x = '-' : cvt (-x) + | otherwise = cvt x + + cvt x + | x == 0 = "0x0p+0" + | otherwise = + case floatToDigits 2 x of + r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r + (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1) + + -- Given binary digits, convert them to hex in blocks of 4 + -- Special case: If all 0's, just drop it. + frac digits + | allZ digits = "" + | otherwise = "." ++ hex digits + where + hex ds = + case ds of + [] -> "" + [a] -> hexDigit a 0 0 0 "" + [a,b] -> hexDigit a b 0 0 "" + [a,b,c] -> hexDigit a b c 0 "" + a : b : c : d : r -> hexDigit a b c d (hex r) + + hexDigit a b c d = showHex (8*a + 4*b + 2*c + d) + + allZ xs = case xs of + x : more -> x == 0 && allZ more + [] -> True + +-- | Show /non-negative/ 'Integral' numbers in base 8. +showOct :: Integral a => a -> ShowS +showOct = showIntAtBase 8 intToDigit + +-- | Show /non-negative/ 'Integral' numbers in base 2. +showBin :: Integral a => a -> ShowS +showBin = showIntAtBase 2 intToDigit ===================================== libraries/base/src/System/IO.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} -- | -- @@ -878,3 +879,24 @@ rw_flags = output_flags .|. o_RDWR -- output -- > input^D -- output + +{-NOTE: + The following instances are technically orphans, but practically they are + not, since ordinary users should not use @ghc-internal@ directly and thus + get the instantiated types only through this module. +-} + +-- | @since base-4.2.0.0 +deriving instance Read IOMode + +-- | @since base-4.2.0.0 +deriving instance Read BufferMode + +-- | @since base-4.2.0.0 +deriving instance Read SeekMode + +-- | @since base-4.3.0.0 +deriving instance Read Newline + +-- | @since base-4.3.0.0 +deriving instance Read NewlineMode ===================================== libraries/base/src/Text/Printf.hs ===================================== @@ -97,8 +97,8 @@ import Data.Char import GHC.Internal.Int import GHC.Internal.Data.List (stripPrefix) import GHC.Internal.Word -import GHC.Internal.Numeric import GHC.Internal.Numeric.Natural +import Numeric import System.IO -- $setup ===================================== libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs ===================================== @@ -28,7 +28,6 @@ module GHC.Internal.ByteOrder import GHC.Internal.Base import GHC.Internal.Enum import GHC.Internal.Generics (Generic) -import GHC.Internal.Text.Read import GHC.Internal.Text.Show -- | Byte ordering. @@ -39,7 +38,6 @@ data ByteOrder , Ord -- ^ @since base-4.11.0.0 , Bounded -- ^ @since base-4.11.0.0 , Enum -- ^ @since base-4.11.0.0 - , Read -- ^ @since base-4.11.0.0 , Show -- ^ @since base-4.11.0.0 , Generic -- ^ @since base-4.15.0.0 ) ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Data.hs ===================================== @@ -61,6 +61,7 @@ module GHC.Internal.Data.Data ( mkIntType, mkFloatType, mkCharType, + mkPrimCon, mkNoRepType, -- ** Observers dataTypeName, @@ -94,7 +95,6 @@ module GHC.Internal.Data.Data ( constrIndex, -- ** From strings to constructors and vice versa: all data types showConstr, - readConstr, -- * Convenience functions: take type constructors apart tyconUQname, @@ -123,10 +123,8 @@ import GHC.Internal.Data.Version( Version(..) ) import GHC.Internal.Base hiding (Any, IntRep, FloatRep, NonEmpty(..)) import GHC.Internal.List import GHC.Internal.Num -import GHC.Internal.Read import GHC.Internal.Show import GHC.Internal.Tuple (Solo (..)) -import GHC.Internal.Text.Read( reads ) -- Imports for the instances import GHC.Internal.Data.Functor.Identity -- So we can give Data instance for Identity @@ -682,32 +680,6 @@ showConstr :: Constr -> String showConstr = constring --- | Lookup a constructor via a string -readConstr :: DataType -> String -> Maybe Constr -readConstr dt str = - case dataTypeRep dt of - AlgRep cons -> idx cons - IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i))) - FloatRep -> mkReadCon ffloat - CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c))) - NoRep -> Nothing - where - - -- Read a value and build a constructor - mkReadCon :: Read t => (t -> Constr) -> Maybe Constr - mkReadCon f = case (reads str) of - [(t,"")] -> Just (f t) - _ -> Nothing - - -- Traverse list of algebraic datatype constructors - idx :: [Constr] -> Maybe Constr - idx cons = case filter ((==) str . showConstr) cons of - [] -> Nothing - hd : _ -> Just hd - - ffloat :: Double -> Constr - ffloat = mkPrimCon dt str . FloatConstr . toRational - ------------------------------------------------------------------------------ -- -- Convenience functions: algebraic data types ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Version.hs ===================================== @@ -10,7 +10,7 @@ -- -- Maintainer : libraries(a)haskell.org -- Stability : stable --- Portability : non-portable (local universal quantification in ReadP) +-- Portability : non-portable -- -- A general library for representation and manipulation of versions. -- @@ -31,23 +31,18 @@ module GHC.Internal.Data.Version ( -- * The @Version@ type Version(..), -- * A concrete representation of @Version@ - showVersion, parseVersion, + showVersion, -- * Constructor function makeVersion ) where -import GHC.Internal.Data.Functor ( Functor(..) ) import GHC.Internal.Data.Eq import GHC.Internal.Int ( Int ) import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) ) import GHC.Internal.Data.Ord -import GHC.Internal.Base ( Applicative(..), (&&), String ) +import GHC.Internal.Base ( (&&), String ) import GHC.Internal.Generics -import GHC.Internal.Unicode ( isDigit, isAlphaNum ) -import GHC.Internal.Read import GHC.Internal.Show -import GHC.Internal.Text.ParserCombinators.ReadP -import GHC.Internal.Text.Read ( read ) {- | A 'Version' represents the version of a software entity. @@ -69,8 +64,8 @@ operations are the right thing for every 'Version'. Similarly, concrete representations of versions may differ. One possible concrete representation is provided (see 'showVersion' and -'parseVersion'), but depending on the application a different concrete -representation may be more appropriate. +'Data.Version.parseVersion'), but depending on the application a +different concrete representation may be more appropriate. -} data Version = Version { versionBranch :: [Int], @@ -92,8 +87,7 @@ data Version = -- The interpretation of the list of tags is entirely dependent -- on the entity that this version applies to. } - deriving ( Read -- ^ @since base-2.01 - , Show -- ^ @since base-2.01 + deriving ( Show -- ^ @since base-2.01 , Generic -- ^ @since base-4.9.0.0 ) {-# DEPRECATED versionTags "See GHC ticket #2496" #-} @@ -121,13 +115,6 @@ showVersion (Version branch tags) = concat (intersperse "." (map show branch)) ++ concatMap ('-':) tags --- | A parser for versions in the format produced by 'showVersion'. --- -parseVersion :: ReadP Version -parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.') - tags <- many (char '-' *> munch1 isAlphaNum) - pure Version{versionBranch=branch, versionTags=tags} - -- | Construct tag-less 'Version' -- -- @since base-4.8.0.0 ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Device.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Internal.Base import GHC.Internal.Word import GHC.Internal.Arr import GHC.Internal.Enum -import GHC.Internal.Read import GHC.Internal.Show import GHC.Internal.Ptr import GHC.Internal.Num @@ -179,7 +178,6 @@ data SeekMode , Ord -- ^ @since base-4.2.0.0 , Ix -- ^ @since base-4.2.0.0 , Enum -- ^ @since base-4.2.0.0 - , Read -- ^ @since base-4.2.0.0 , Show -- ^ @since base-4.2.0.0 ) ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs ===================================== @@ -48,7 +48,6 @@ import GHC.Internal.IO.BufferedIO import GHC.Internal.IO.Encoding.Types import GHC.Internal.IORef import GHC.Internal.Show -import GHC.Internal.Read import GHC.Internal.Word import GHC.Internal.IO.Device import GHC.Internal.Data.Typeable @@ -270,7 +269,6 @@ data BufferMode -- is 'Just' @n@ and is otherwise implementation-dependent. deriving ( Eq -- ^ @since base-4.2.0.0 , Ord -- ^ @since base-4.2.0.0 - , Read -- ^ @since base-4.2.0.0 , Show -- ^ @since base-4.2.0.0 ) @@ -376,7 +374,6 @@ data Newline = LF -- ^ @\'\\n\'@ | CRLF -- ^ @\'\\r\\n\'@ deriving ( Eq -- ^ @since base-4.2.0.0 , Ord -- ^ @since base-4.3.0.0 - , Read -- ^ @since base-4.3.0.0 , Show -- ^ @since base-4.3.0.0 ) @@ -393,7 +390,6 @@ data NewlineMode } deriving ( Eq -- ^ @since base-4.2.0.0 , Ord -- ^ @since base-4.3.0.0 - , Read -- ^ @since base-4.3.0.0 , Show -- ^ @since base-4.3.0.0 ) ===================================== libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs ===================================== @@ -20,7 +20,6 @@ module GHC.Internal.IO.IOMode (IOMode(..)) where import GHC.Internal.Base import GHC.Internal.Show -import GHC.Internal.Read import GHC.Internal.Arr import GHC.Internal.Enum @@ -30,7 +29,6 @@ data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode , Ord -- ^ @since base-4.2.0.0 , Ix -- ^ @since base-4.2.0.0 , Enum -- ^ @since base-4.2.0.0 - , Read -- ^ @since base-4.2.0.0 , Show -- ^ @since base-4.2.0.0 ) ===================================== libraries/ghc-internal/src/GHC/Internal/Numeric.hs ===================================== @@ -1,5 +1,4 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude, MagicHash #-} ----------------------------------------------------------------------------- -- | @@ -16,274 +15,22 @@ -- ----------------------------------------------------------------------------- -module GHC.Internal.Numeric ( - - -- * Showing - - showSigned, - - showIntAtBase, - showInt, - showBin, - showHex, - showOct, - - showEFloat, - showFFloat, - showGFloat, - showFFloatAlt, - showGFloatAlt, - showFloat, - showHFloat, - - floatToDigits, - - -- * Reading - - -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase', - -- and 'readDec' is the \`dual\' of 'showInt'. - -- The inconsistent naming is a historical accident. - - readSigned, - - readInt, - readBin, - readDec, - readOct, - readHex, - - readFloat, - - lexDigits, - - -- * Miscellaneous - - fromRat, - Floating(..) - - ) where +module GHC.Internal.Numeric (showIntAtBase, showHex) where import GHC.Internal.Base -import GHC.Internal.Read -import GHC.Internal.Real -import GHC.Internal.Float -import GHC.Internal.Num -import GHC.Internal.Show -import GHC.Internal.Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail ) -import qualified GHC.Internal.Text.Read.Lex as L - --- $setup --- >>> import Prelude - --- ----------------------------------------------------------------------------- --- Reading - --- | Reads an /unsigned/ integral value in an arbitrary base. -readInt :: Num a - => a -- ^ the base - -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base - -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int' - -> ReadS a -readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit) - --- | Read an unsigned number in binary notation. --- --- >>> readBin "10011" --- [(19,"")] -readBin :: (Eq a, Num a) => ReadS a -readBin = readP_to_S L.readBinP - --- | Read an unsigned number in octal notation. --- --- >>> readOct "0644" --- [(420,"")] -readOct :: (Eq a, Num a) => ReadS a -readOct = readP_to_S L.readOctP - --- | Read an unsigned number in decimal notation. --- --- >>> readDec "0644" --- [(644,"")] -readDec :: (Eq a, Num a) => ReadS a -readDec = readP_to_S L.readDecP - --- | Read an unsigned number in hexadecimal notation. --- Both upper or lower case letters are allowed. --- --- >>> readHex "deadbeef" --- [(3735928559,"")] -readHex :: (Eq a, Num a) => ReadS a -readHex = readP_to_S L.readHexP - --- | Reads an /unsigned/ 'RealFrac' value, --- expressed in decimal scientific notation. --- --- Note that this function takes time linear in the magnitude of its input --- which can scale exponentially with input size (e.g. @"1e100000000"@ is a --- very large number while having a very small textual form). --- For this reason, users should take care to avoid using this function on --- untrusted input. Users needing to parse floating point values --- (e.g. 'Float') are encouraged to instead use 'read', which does --- not suffer from this issue. -readFloat :: RealFrac a => ReadS a -readFloat = readP_to_S readFloatP - -readFloatP :: RealFrac a => ReadP a -readFloatP = - do tok <- L.lex - case tok of - L.Number n -> return $ fromRational $ L.numberToRational n - _ -> pfail - --- It's turgid to have readSigned work using list comprehensions, --- but it's specified as a ReadS to ReadS transformer --- With a bit of luck no one will use it. - --- | Reads a /signed/ 'Real' value, given a reader for an unsigned value. -readSigned :: (Real a) => ReadS a -> ReadS a -readSigned readPos = readParen False read' - where read' r = read'' r ++ - (do - ("-",s) <- lex r - (x,t) <- read'' s - return (-x,t)) - read'' r = do - (str,s) <- lex r - (n,"") <- readPos str - return (n,s) - --- ----------------------------------------------------------------------------- --- Showing - --- | Show /non-negative/ 'Integral' numbers in base 10. -showInt :: Integral a => a -> ShowS -showInt n0 cs0 - | n0 < 0 = errorWithoutStackTrace "GHC.Internal.Numeric.showInt: can't show negative numbers" - | otherwise = go n0 cs0 - where - go n cs - | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of - c@(C# _) -> c:cs - | otherwise = case unsafeChr (ord '0' + fromIntegral r) of - c@(C# _) -> go q (c:cs) - where - (q,r) = n `quotRem` 10 - --- Controlling the format and precision of floats. The code that --- implements the formatting itself is in @PrelNum@ to avoid --- mutual module deps. - -{-# SPECIALIZE showEFloat :: - Maybe Int -> Float -> ShowS #-} -{-# SPECIALIZE showEFloat :: - Maybe Int -> Double -> ShowS #-} -{-# SPECIALIZE showFFloat :: - Maybe Int -> Float -> ShowS #-} -{-# SPECIALIZE showFFloat :: - Maybe Int -> Double -> ShowS #-} -{-# SPECIALIZE showGFloat :: - Maybe Int -> Float -> ShowS #-} -{-# SPECIALIZE showGFloat :: - Maybe Int -> Double -> ShowS #-} - --- | Show a signed 'RealFloat' value --- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@). --- --- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing', --- the value is shown to full precision; if @digs@ is @'Just' d@, --- then at most @d@ digits after the decimal point are shown. -showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS - --- | Show a signed 'RealFloat' value --- using standard decimal notation (e.g. @245000@, @0.0015@). --- --- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing', --- the value is shown to full precision; if @digs@ is @'Just' d@, --- then at most @d@ digits after the decimal point are shown. -showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS - --- | Show a signed 'RealFloat' value --- using standard decimal notation for arguments whose absolute value lies --- between @0.1@ and @9,999,999@, and scientific notation otherwise. --- --- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing', --- the value is shown to full precision; if @digs@ is @'Just' d@, --- then at most @d@ digits after the decimal point are shown. -showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS - -showEFloat d x = showString (formatRealFloat FFExponent d x) -showFFloat d x = showString (formatRealFloat FFFixed d x) -showGFloat d x = showString (formatRealFloat FFGeneric d x) - --- | Show a signed 'RealFloat' value --- using standard decimal notation (e.g. @245000@, @0.0015@). --- --- This behaves as 'showFFloat', except that a decimal point --- is always guaranteed, even if not needed. --- --- @since base-4.7.0.0 -showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS - --- | Show a signed 'RealFloat' value --- using standard decimal notation for arguments whose absolute value lies --- between @0.1@ and @9,999,999@, and scientific notation otherwise. --- --- This behaves as 'showFFloat', except that a decimal point --- is always guaranteed, even if not needed. --- --- @since base-4.7.0.0 -showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS - -showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x) -showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x) - -{- | Show a floating-point value in the hexadecimal format, -similar to the @%a@ specifier in C's printf. - - >>> showHFloat (212.21 :: Double) "" - "0x1.a86b851eb851fp7" - >>> showHFloat (-12.76 :: Float) "" - "-0x1.9851ecp3" - >>> showHFloat (-0 :: Double) "" - "-0x0p+0" - -@since base-4.11.0.0 --} -showHFloat :: RealFloat a => a -> ShowS -showHFloat = showString . fmt - where - fmt x - | isNaN x = "NaN" - | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity" - | x < 0 || isNegativeZero x = '-' : cvt (-x) - | otherwise = cvt x - - cvt x - | x == 0 = "0x0p+0" - | otherwise = - case floatToDigits 2 x of - r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r - (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1) - - -- Given binary digits, convert them to hex in blocks of 4 - -- Special case: If all 0's, just drop it. - frac digits - | allZ digits = "" - | otherwise = "." ++ hex digits - where - hex ds = - case ds of - [] -> "" - [a] -> hexDigit a 0 0 0 "" - [a,b] -> hexDigit a b 0 0 "" - [a,b,c] -> hexDigit a b c 0 "" - a : b : c : d : r -> hexDigit a b c d (hex r) - - hexDigit a b c d = showHex (8*a + 4*b + 2*c + d) - - allZ xs = case xs of - x : more -> x == 0 && allZ more - [] -> True + ( + seq, + ($), + otherwise, + Char, + Int, + (<), + (<=), + errorWithoutStackTrace + ) +import GHC.Internal.List ((++)) +import GHC.Internal.Real (Integral, toInteger, fromIntegral, quotRem) +import GHC.Internal.Show (ShowS, show, intToDigit) -- --------------------------------------------------------------------------- -- Integer printing functions @@ -307,11 +54,3 @@ showIntAtBase base toChr n0 r0 -- | Show /non-negative/ 'Integral' numbers in base 16. showHex :: Integral a => a -> ShowS showHex = showIntAtBase 16 intToDigit - --- | Show /non-negative/ 'Integral' numbers in base 8. -showOct :: Integral a => a -> ShowS -showOct = showIntAtBase 8 intToDigit - --- | Show /non-negative/ 'Integral' numbers in base 2. -showBin :: Integral a => a -> ShowS -showBin = showIntAtBase 2 intToDigit ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -9453,7 +9453,7 @@ module GHC.Word where uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64# module Numeric where - -- Safety: Safe + -- Safety: Trustworthy type Floating :: * -> Constraint class GHC.Internal.Real.Fractional a => Floating a where pi :: a @@ -12496,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’ -instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’ @@ -12525,7 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’ -instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ @@ -12540,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’ instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -9491,7 +9491,7 @@ module GHC.Word where uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64# module Numeric where - -- Safety: Safe + -- Safety: Trustworthy type Floating :: * -> Constraint class GHC.Internal.Real.Fractional a => Floating a where pi :: a @@ -12525,7 +12525,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’ -instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’ @@ -12554,7 +12554,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’ -instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ @@ -12569,16 +12569,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’ instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -9733,7 +9733,7 @@ module GHC.Word where uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64# module Numeric where - -- Safety: Safe + -- Safety: Trustworthy type Floating :: * -> Constraint class GHC.Internal.Real.Fractional a => Floating a where pi :: a @@ -12767,7 +12767,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’ -instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’ @@ -12796,7 +12796,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’ -instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ instance GHC.Internal.Read.Read GHC.Internal.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Internal.Event.Windows.ConsoleEvent’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’ @@ -12812,16 +12812,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’ instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -9453,7 +9453,7 @@ module GHC.Word where uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64# module Numeric where - -- Safety: Safe + -- Safety: Trustworthy type Floating :: * -> Constraint class GHC.Internal.Real.Fractional a => Floating a where pi :: a @@ -12496,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’ -instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’ @@ -12525,7 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’ -instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’ +instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ @@ -12540,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’ -instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’ +instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’ instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -1,5 +1,6 @@ parsePlugin(a,b) interfacePlugin: Prelude +interfacePlugin: System.IO interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -2,6 +2,8 @@ parsePlugin() interfacePlugin: Prelude interfacePlugin: Language.Haskell.TH interfacePlugin: Language.Haskell.TH.Quote +interfacePlugin: Data.Version +interfacePlugin: System.IO interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -1,5 +1,6 @@ parsePlugin() interfacePlugin: Prelude +interfacePlugin: System.IO interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -1,6 +1,7 @@ ==pure.0 parsePlugin() interfacePlugin: Prelude +interfacePlugin: System.IO interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e048aefa77c2e42df58c2a026b7004… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e048aefa77c2e42df58c2a026b7004… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/bump-submodules-2603] 4 commits: hadrian: fix ghc-in-ghci flavour stage0 shared libraries
by Cheng Shao (＠TerrorJack) 17 Mar '26

17 Mar '26

Cheng Shao pushed to branch wip/bump-submodules-2603 at Glasgow Haskell Compiler / GHC Commits: 59862d76 by Cheng Shao at 2026-03-17T20:03:07+00:00 hadrian: fix ghc-in-ghci flavour stage0 shared libraries This patch fixes missing stage0 shared libraries in hadrian ghc-in-ghci flavour, which was accidentally dropped in 669d09f950a6e88b903d9fd8a7571531774d4d5d and resulted in a regression in HLS support on linux/macos. Fixes #27057. - - - - - b5a35f77 by Cheng Shao at 2026-03-17T21:43:28+01:00 hadrian: add thLift/thQuasiquoter to toolTargets This commit adds missing `thLift`/`thQuasiquoter` to hadrian `toolTargets` to keep in sync with `stage0packages`. This is now required when os-string/filepath is updated to include them as dependencies. - - - - - 4d5b7f10 by Cheng Shao at 2026-03-17T21:43:28+01:00 libraries: bump os-string submodule to 2.0.10 - - - - - c078ff9f by Cheng Shao at 2026-03-17T21:43:28+01:00 libraries: bump filepath submodule to 1.5.5.0 - - - - - 4 changed files: - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Flavours/GhcInGhci.hs - libraries/filepath - libraries/os-string Changes: ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -153,6 +153,9 @@ toolTargets = [ cabalSyntax , filepath , fileio , osString + -- os-string/filepath now depend on them + , thLift + , thQuasiquoter -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot @@ -200,4 +203,3 @@ dirMap = do cd <- readContextData c ids <- liftIO $ mapM canonicalizePath [pkgPath p </> i | i <- srcDirs cd] return $ map (,(p, modules cd ++ otherModules cd)) ids - ===================================== hadrian/src/Settings/Flavours/GhcInGhci.hs ===================================== @@ -1,14 +1,22 @@ module Settings.Flavours.GhcInGhci (ghcInGhciFlavour) where +import qualified Data.Set as Set import Expression import Flavour +import Oracles.Flag import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. ghcInGhciFlavour :: Flavour ghcInGhciFlavour = disableProfiledLibs $ defaultFlavour { name = "ghc-in-ghci" - , extraArgs = ghciArgs + , extraArgs = ghciArgs + , libraryWays = + Set.fromList + <$> mconcat + [ pure [vanilla] + , platformSupportsSharedLibs ? pure [dynamic] + ] } ghciArgs :: Args ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit cbcd0ccf92f47e6c10fb9cc513a7b26facfc19fe +Subproject commit baac7d7e76449f76fc6785e77206edb5530b6bfb ===================================== libraries/os-string ===================================== @@ -1 +1 @@ -Subproject commit c08666bf7bf528e607fc1eacc20032ec59e69df3 +Subproject commit 71f66e1af2288867becaa567dfb10c1d791b0343 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff4407785d3537c63479fb5863238d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff4407785d3537c63479fb5863238d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/abstract-q] fix fail impl
by Teo Camarasu (＠teo) 17 Mar '26

17 Mar '26

Teo Camarasu pushed to branch wip/abstract-q at Glasgow Haskell Compiler / GHC Commits: c48bda76 by Teo Camarasu at 2026-03-17T20:42:25+00:00 fix fail impl - - - - - 3 changed files: - compiler/GHC/Tc/Gen/Splice.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghci/GHCi/TH.hs Changes: ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1559,9 +1559,10 @@ location = do { m <- getModule metaHandlersTcM :: TH.MetaHandlers TcM metaHandlersTcM = TH.MetaHandlers { - mNewName = \s -> do { u <- newUnique - ; let i = toInteger (getKey u) - ; return (TH.mkNameU s i) } + mFail = fail + , mNewName = \s -> do { u <- newUnique + ; let i = toInteger (getKey u) + ; return (TH.mkNameU s i) } -- 'msg' is forced to ensure exceptions don't escape, -- see Note [Exceptions in TH] ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs ===================================== @@ -184,7 +184,8 @@ instance Quasi IO where metaHandlersIO :: MetaHandlers IO metaHandlersIO = MetaHandlers { - mNewName = newNameIO + mFail = fail + , mNewName = newNameIO , mReport = \b msg -> if b then hPutStrLn stderr ("Template Haskell error: " ++ msg) @@ -221,8 +222,9 @@ instance Quote IO where newName = newNameIO data MetaHandlers m = MetaHandlers { + mFail :: forall a. String -> m a -- | Fresh names. See 'newName'. - mNewName :: String -> m Name + , mNewName :: String -> m Name ------- Error reporting and recovery ------- -- | Report an error (True) or warning (False) @@ -351,7 +353,7 @@ instance Monad Q where (>>) = (*>) instance MonadFail Q where - fail s = report True s >> Q (\_ _ -> fail "Q monad failure") + fail s = report True s >> Q (\r h -> r $ mFail h "Q monad failure") instance Functor Q where fmap f (Q x) = Q $ \r h -> fmap f (x r h) ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -180,7 +180,8 @@ runQinGHCiQ (TH.Q m) = GHCiQ $ \sRef -> m (runInIO sRef) metaHandlersGHCiQ runInIO sRef (GHCiQ m) = m sRef metaHandlersGHCiQ = TH.MetaHandlers { - mNewName = \str -> ghcCmd (NewName str) + mFail = fail + , mNewName = \str -> ghcCmd (NewName str) , mReport = \isError msg -> ghcCmd (Report isError msg) -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c48bda767ed070c7aaf9230cc2af875… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c48bda767ed070c7aaf9230cc2af875… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/abstract-q] fix fail impl
by Teo Camarasu (＠teo) 17 Mar '26

17 Mar '26

Teo Camarasu pushed to branch wip/abstract-q at Glasgow Haskell Compiler / GHC Commits: d52a3009 by Teo Camarasu at 2026-03-17T20:38:56+00:00 fix fail impl - - - - - 3 changed files: - compiler/GHC/Tc/Gen/Splice.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghci/GHCi/TH.hs Changes: ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1559,9 +1559,10 @@ location = do { m <- getModule metaHandlersTcM :: TH.MetaHandlers TcM metaHandlersTcM = TH.MetaHandlers { - mNewName = \s -> do { u <- newUnique - ; let i = toInteger (getKey u) - ; return (TH.mkNameU s i) } + mFail = fail + , mNewName = \s -> do { u <- newUnique + ; let i = toInteger (getKey u) + ; return (TH.mkNameU s i) } -- 'msg' is forced to ensure exceptions don't escape, -- see Note [Exceptions in TH] ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs ===================================== @@ -184,7 +184,8 @@ instance Quasi IO where metaHandlersIO :: MetaHandlers IO metaHandlersIO = MetaHandlers { - mNewName = newNameIO + mFail = fail + , mNewName = newNameIO , mReport = \b msg -> if b then hPutStrLn stderr ("Template Haskell error: " ++ msg) @@ -221,8 +222,9 @@ instance Quote IO where newName = newNameIO data MetaHandlers m = MetaHandlers { + mFail :: String -> m a -- | Fresh names. See 'newName'. - mNewName :: String -> m Name + , mNewName :: String -> m Name ------- Error reporting and recovery ------- -- | Report an error (True) or warning (False) @@ -351,7 +353,7 @@ instance Monad Q where (>>) = (*>) instance MonadFail Q where - fail s = report True s >> Q (\_ _ -> fail "Q monad failure") + fail s = report True s >> Q (\r h -> r $ mFail m "Q monad failure") instance Functor Q where fmap f (Q x) = Q $ \r h -> fmap f (x r h) ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -180,7 +180,8 @@ runQinGHCiQ (TH.Q m) = GHCiQ $ \sRef -> m (runInIO sRef) metaHandlersGHCiQ runInIO sRef (GHCiQ m) = m sRef metaHandlersGHCiQ = TH.MetaHandlers { - mNewName = \str -> ghcCmd (NewName str) + mFail = fail + , mNewName = \str -> ghcCmd (NewName str) , mReport = \isError msg -> ghcCmd (Report isError msg) -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d52a300923f0533dadc4e96e14eb442… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d52a300923f0533dadc4e96e14eb442… You're receiving this email because of your account on gitlab.haskell.org.

1 0