[Git][ghc/ghc][wip/jeltsch/system-io-implementation-into-base] Move most of the `System.IO` implementation into `base`
by Wolfgang Jeltsch (@jeltsch) 14 Apr '26
by Wolfgang Jeltsch (@jeltsch) 14 Apr '26
14 Apr '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-implementation-into-base at Glasgow Haskell Compiler / GHC
Commits:
ad141b38 by Wolfgang Jeltsch at 2026-04-14T14:57:01+03:00
Move most of the `System.IO` implementation into `base`
This involves a rewrite of the `combine` helper function to avoid the
use of `last`, which would now be flagged as an error.
Metric Increase:
T12227
T12707
T5642
- - - - -
27 changed files:
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.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/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
Changes:
=====================================
libraries/base/src/Control/Concurrent.hs
=====================================
@@ -120,7 +120,7 @@ import GHC.Internal.System.Posix.Types ( Fd )
#if defined(mingw32_HOST_OS)
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
-import GHC.Internal.System.IO
+import System.IO
import GHC.Internal.Data.Functor ( void )
import GHC.Internal.Int ( Int64 )
#else
=====================================
libraries/base/src/GHC/IO/Handle.hs
=====================================
@@ -53,6 +53,7 @@ module GHC.IO.Handle
hGetEcho,
hIsTerminalDevice,
hSetNewlineMode,
+ hGetNewlineMode,
Newline(..),
NewlineMode(..),
nativeNewline,
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -165,7 +165,7 @@ module Prelude (
) where
import GHC.Internal.Control.Monad
-import GHC.Internal.System.IO
+import System.IO
import GHC.Internal.System.IO.Error
import qualified GHC.Internal.Data.List as List
import GHC.Internal.Data.Either
=====================================
libraries/base/src/System/IO.hs
=====================================
@@ -1,4 +1,5 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
-- |
--
@@ -184,8 +185,683 @@ module System.IO
nativeNewlineMode
) where
-import GHC.Internal.System.IO
+import GHC.Internal.System.IO (putStrLn, print)
+
+import GHC.Base (Bool (False, True), otherwise, failIO)
+import GHC.Err (errorWithoutStackTrace)
+import GHC.List ((++), reverse, break)
+import GHC.IO (IO, FilePath)
+import GHC.IO.IOMode (IOMode (ReadMode, WriteMode, ReadWriteMode, AppendMode))
+import qualified GHC.Internal.IO.FD as FD
+import GHC.IO.Encoding
+ (
+ TextEncoding,
+ mkTextEncoding,
+ getLocaleEncoding,
+ initLocaleEncoding,
+ utf8,
+ utf8_bom,
+ utf16,
+ utf16be,
+ utf16le,
+ utf32,
+ utf32be,
+ utf32le,
+ latin1,
+ char8
+ )
+import GHC.IO.Handle
+ (
+ Handle,
+ hLookAhead,
+ hFlush,
+ hClose,
+ hSetBinaryMode,
+ hSetEncoding,
+ hSetNewlineMode,
+ hSetEcho,
+ hSetFileSize,
+ hGetEncoding,
+ hGetNewlineMode,
+ hGetEcho,
+ hFileSize,
+ hIsOpen,
+ hIsReadable,
+ hIsSeekable,
+ hIsWritable,
+ hIsTerminalDevice,
+ hIsEOF,
+ hIsClosed,
+ hShow,
+ BufferMode (NoBuffering, LineBuffering, BlockBuffering),
+ hSetBuffering,
+ hGetBuffering,
+ HandlePosn,
+ hSetPosn,
+ hGetPosn,
+ hSeek,
+ hTell,
+ Newline (LF, CRLF),
+ nativeNewline,
+ NewlineMode (NewlineMode, inputNL, outputNL),
+ noNewlineTranslation,
+ nativeNewlineMode,
+ universalNewlineMode,
+ isEOF
+ )
+import GHC.IO.Handle.Text
+ (
+ hPutChar,
+ hPutStr,
+ hPutStrLn,
+ hPutBuf,
+ hPutBufNonBlocking,
+ hGetChar,
+ hGetContents,
+ hGetContents',
+ hGetLine,
+ hGetBuf,
+ hGetBufNonBlocking,
+ hGetBufSome,
+ hWaitForInput
+ )
+import qualified GHC.Internal.IO.Handle.FD as POSIX
+import GHC.IO.StdHandles
+ (
+ openBinaryFile,
+ withBinaryFile,
+ openFile,
+ withFile,
+ stdin,
+ stdout,
+ stderr
+ )
import GHC.Internal.Control.Monad.Fix (fixIO)
+import Control.Monad (return, (>>=))
+import Control.Exception (ioError)
+import Data.Eq ((==))
+import Data.Ord ((<))
+import Data.Bits ((.|.))
+import Data.Function (($), (.))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Char (Char)
+import Data.String (String)
+import System.IO.Error (userError)
+import System.Posix.Internals
+ (
+ c_open,
+ o_EXCL,
+ o_BINARY,
+ o_NONBLOCK,
+ o_RDWR,
+ o_NOCTTY,
+ withFilePath
+ )
+import System.Posix.Types (CMode)
+import Text.Read (lex, Read, reads)
+import Text.Show (Show, show)
+import Foreign.C.Types (CInt)
+import Foreign.C.Error (getErrno, errnoToIOError)
+
+#if defined(mingw32_HOST_OS)
+import GHC.Base (undefined, not, (||), fmap)
+import GHC.List (null, any)
+import GHC.Num ((*))
+import GHC.IO (onException)
+import GHC.IO.SubSystem
+import GHC.IO.Windows.Handle (openFileAsTemp)
+import GHC.IO.Handle.Windows (mkHandleFromHANDLE)
+import GHC.IO.Device as IODevice
+import GHC.Internal.Real (fromIntegral)
+import Data.Bits ((.&.))
+import Foreign.C.Types (CUInt (CUInt), CWchar)
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils (with)
+import Foreign.Storable
+#else
+import GHC.List (elem, unsnoc)
+import GHC.Num ((+))
+import GHC.IO.Handle (SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd))
+import GHC.IORef (atomicModifyIORef'_)
+import Data.Int (Int)
+import Data.IORef (IORef, newIORef)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Internals (c_getpid, o_CREAT)
+import Foreign.C.Error (Errno, eEXIST)
+#endif
+
+-----------------------------------------------------------------------------
+-- Standard IO
+
+-- | Write a character to the standard output device
+--
+-- 'putChar' is implemented as @'hPutChar' 'stdout'@.
+--
+-- This operation may fail with the same errors as 'hPutChar'.
+--
+-- ==== __Examples__
+--
+-- Note that the following do not put a newline.
+--
+-- >>> putChar 'x'
+-- x
+--
+-- >>> putChar '\0042'
+-- *
+putChar :: Char -> IO ()
+putChar c = hPutChar stdout c
+
+-- | Write a string to the standard output device
+--
+-- 'putStr' is implemented as @'hPutStr' 'stdout'@.
+--
+-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
+--
+-- ==== __Examples__
+--
+-- Note that the following do not put a newline.
+--
+-- >>> putStr "Hello, World!"
+-- Hello, World!
+--
+-- >>> putStr "\0052\0042\0050"
+-- 4*2
+--
+putStr :: String -> IO ()
+putStr s = hPutStr stdout s
+
+-- | Read a single character from the standard input device.
+--
+-- 'getChar' is implemented as @'hGetChar' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetChar'.
+--
+-- ==== __Examples__
+--
+-- >>> getChar
+-- a'a'
+--
+-- >>> getChar
+-- >
+-- '\n'
+getChar :: IO Char
+getChar = hGetChar stdin
+
+-- | Read a line from the standard input device.
+--
+-- 'getLine' is implemented as @'hGetLine' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetLine'.
+--
+-- ==== __Examples__
+--
+-- >>> getLine
+-- > Hello World!
+-- "Hello World!"
+--
+-- >>> getLine
+-- >
+-- ""
+getLine :: IO String
+getLine = hGetLine stdin
+
+-- | The 'getContents' operation returns all user input as a single string,
+-- which is read lazily as it is needed.
+--
+-- 'getContents' is implemented as @'hGetContents' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetContents'.
+--
+-- ==== __Examples__
+--
+-- >>> getContents >>= putStr
+-- > aaabbbccc :D
+-- aaabbbccc :D
+-- > I hope you have a great day
+-- I hope you have a great day
+-- > ^D
+--
+-- >>> getContents >>= print . length
+-- > abc
+-- > <3
+-- > def ^D
+-- 11
+getContents :: IO String
+getContents = hGetContents stdin
+
+-- | The 'getContents'' operation returns all user input as a single string,
+-- which is fully read before being returned
+--
+-- 'getContents'' is implemented as @'hGetContents'' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetContents''.
+--
+-- ==== __Examples__
+--
+-- >>> getContents' >>= putStr
+-- > aaabbbccc :D
+-- > I hope you have a great day
+-- aaabbbccc :D
+-- I hope you have a great day
+--
+-- >>> getContents' >>= print . length
+-- > abc
+-- > <3
+-- > def ^D
+-- 11
+--
+-- @since base-4.15.0.0
+getContents' :: IO String
+getContents' = hGetContents' stdin
+
+-- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it.
+-- The resulting string is written to the 'stdout' device.
+--
+-- Note that this operation is lazy, which allows to produce output
+-- even before all input has been consumed.
+--
+-- This operation may fail with the same errors as 'getContents' and 'putStr'.
+--
+-- If it doesn't produce output the buffering settings may not be
+-- correct, use ^D (ctrl+D) to close stdin which forces
+-- the buffer to be consumed.
+--
+-- You may wish to set the buffering style appropriate to your program's
+-- needs before using this function, for example:
+--
+-- @
+-- main :: IO ()
+-- main = do
+-- hSetBuffering stdin LineBuffering
+-- hSetBuffering stdout NoBuffering
+-- interact (concatMap (\str -> str ++ str) . L.lines)
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> interact (\str -> str ++ str)
+-- > hi :)
+-- hi :)
+-- > ^D
+-- hi :)
+--
+-- >>> interact (const ":D")
+-- :D
+--
+-- >>> interact (show . words)
+-- > hello world!
+-- > I hope you have a great day
+-- > ^D
+-- ["hello","world!","I","hope","you","have","a","great","day"]
+interact :: (String -> String) -> IO ()
+interact f = do s <- getContents
+ putStr (f s)
+
+-- | The 'readFile' function reads a file and
+-- returns the contents of the file as a string.
+--
+-- The file is read lazily, on demand, as with 'getContents'.
+--
+-- This operation may fail with the same errors as 'hGetContents' and 'openFile'.
+--
+-- ==== __Examples__
+--
+-- >>> readFile "~/hello_world"
+-- "Greetings!"
+--
+-- >>> take 5 <$> readFile "/dev/zero"
+-- "\NUL\NUL\NUL\NUL\NUL"
+readFile :: FilePath -> IO String
+readFile name = openFile name ReadMode >>= hGetContents
+
+-- | The 'readFile'' function reads a file and
+-- returns the contents of the file as a string.
+--
+-- This is identical to 'readFile', but the file is fully read before being returned,
+-- as with 'getContents''.
+--
+-- @since base-4.15.0.0
+readFile' :: FilePath -> IO String
+-- There's a bit of overkill here—both withFile and
+-- hGetContents' will close the file in the end.
+readFile' name = withFile name ReadMode hGetContents'
+
+-- | The computation @'writeFile' file str@ function writes the string @str@,
+-- to the file @file@.
+--
+-- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
+--
+-- ==== __Examples__
+--
+-- >>> writeFile "hello" "world" >> readFile "hello"
+-- "world"
+--
+-- >>> writeFile "~/" "D:"
+-- *** Exception: ~/: withFile: inappropriate type (Is a directory)
+writeFile :: FilePath -> String -> IO ()
+writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
+
+-- | The computation @'appendFile' file str@ function appends the string @str@,
+-- to the file @file@.
+--
+-- Note that 'writeFile' and 'appendFile' write a literal string
+-- to a file. To write a value of any printable type, as with 'print',
+-- use the 'show' function to convert the value to a string first.
+--
+-- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
+--
+-- ==== __Examples__
+--
+-- The following example could be more efficently written by acquiring a handle
+-- instead with 'openFile' and using the computations capable of writing to handles
+-- such as 'hPutStr'.
+--
+-- >>> let fn = "hello_world"
+-- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn)
+-- "hello world!"
+--
+-- >>> let fn = "foo"; output = readFile' fn >>= putStrLn
+-- >>> in output >> appendFile fn (show [1,2,3]) >> output
+-- this is what's in the file
+-- this is what's in the file[1,2,3]
+appendFile :: FilePath -> String -> IO ()
+appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
+
+-- | The 'readLn' function combines 'getLine' and 'readIO'.
+--
+-- This operation may fail with the same errors as 'getLine' and 'readIO'.
+--
+-- ==== __Examples__
+--
+-- >>> fmap (+ 5) readLn
+-- > 25
+-- 30
+--
+-- >>> readLn :: IO String
+-- > this is not a string literal
+-- *** Exception: user error (Prelude.readIO: no parse)
+readLn :: Read a => IO a
+readLn = getLine >>= readIO
+
+-- | The 'readIO' function is similar to 'read' except that it signals
+-- parse failure to the 'IO' monad instead of terminating the program.
+--
+-- This operation may fail with:
+--
+-- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse.
+--
+-- ==== __Examples__
+--
+-- >>> fmap (+ 1) (readIO "1")
+-- 2
+--
+-- >>> readIO "not quite ()" :: IO ()
+-- *** Exception: user error (Prelude.readIO: no parse)
+readIO :: Read a => String -> IO a
+readIO s = case (do { (x,t) <- reads s ;
+ ("","") <- lex t ;
+ return x }) of
+ [x] -> return x
+ [] -> ioError (userError "Prelude.readIO: no parse")
+ _ -> ioError (userError "Prelude.readIO: ambiguous parse")
+
+-- | The encoding of the current locale.
+--
+-- This is the initial locale encoding: if it has been subsequently changed by
+-- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
+localeEncoding :: TextEncoding
+localeEncoding = initLocaleEncoding
+
+-- | Computation 'hReady' @hdl@ indicates whether at least one item is
+-- available for input from handle @hdl@.
+--
+-- This operation may fail with:
+--
+-- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached.
+hReady :: Handle -> IO Bool
+hReady h = hWaitForInput h 0
+
+-- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
+-- given by the 'show' function to the file or channel managed by @hdl@
+-- and appends a newline.
+--
+-- This operation may fail with the same errors as 'hPutStrLn'
+--
+-- ==== __Examples__
+--
+-- >>> hPrint stdout [1,2,3]
+-- [1,2,3]
+--
+-- >>> hPrint stdin [4,5,6]
+-- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing)
+hPrint :: Show a => Handle -> a -> IO ()
+hPrint hdl = hPutStrLn hdl . show
+
+-- | The function creates a temporary file in ReadWrite mode.
+-- The created file isn\'t deleted automatically, so you need to delete it manually.
+--
+-- The file is created with permissions such that only the current
+-- user can read\/write it.
+--
+-- With some exceptions (see below), the file will be created securely
+-- in the sense that an attacker should not be able to cause
+-- openTempFile to overwrite another file on the filesystem using your
+-- credentials, by putting symbolic links (on Unix) in the place where
+-- the temporary file is to be created. On Unix the @O_CREAT@ and
+-- @O_EXCL@ flags are used to prevent this attack, but note that
+-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
+-- rely on this behaviour it is best to use local filesystems only.
+openTempFile :: FilePath -- ^ Directory in which to create the file
+ -> String -- ^ File name template. If the template is \"foo.ext\" then
+ -- the created file will be \"fooXXX.ext\" where XXX is some
+ -- random number. Note that this should not contain any path
+ -- separator characters. On Windows, the template prefix may
+ -- be truncated to 3 chars, e.g. \"foobar.ext\" will be
+ -- \"fooXXX.ext\".
+ -> IO (FilePath, Handle)
+openTempFile tmp_dir template
+ = openTempFile' "openTempFile" tmp_dir template False 0o600
+
+-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
+openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
+openBinaryTempFile tmp_dir template
+ = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
+
+-- | Like 'openTempFile', but uses the default file permissions
+openTempFileWithDefaultPermissions :: FilePath -> String
+ -> IO (FilePath, Handle)
+openTempFileWithDefaultPermissions tmp_dir template
+ = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666
+
+-- | Like 'openBinaryTempFile', but uses the default file permissions
+openBinaryTempFileWithDefaultPermissions :: FilePath -> String
+ -> IO (FilePath, Handle)
+openBinaryTempFileWithDefaultPermissions tmp_dir template
+ = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666
+
+openTempFile' :: String -> FilePath -> String -> Bool -> CMode
+ -> IO (FilePath, Handle)
+openTempFile' loc tmp_dir template binary mode
+ | pathSeparator template
+ = failIO $ "openTempFile': Template string must not contain path separator characters: "++template
+ | otherwise = findTempName
+ where
+ -- We split off the last extension, so we can use .foo.ext files
+ -- for temporary files (hidden on Unix OSes). Unfortunately we're
+ -- below filepath in the hierarchy here.
+ (prefix, suffix) =
+ case break (== '.') $ reverse template of
+ -- First case: template contains no '.'s. Just re-reverse it.
+ (rev_suffix, "") -> (reverse rev_suffix, "")
+ -- Second case: template contains at least one '.'. Strip the
+ -- dot from the prefix and prepend it to the suffix (if we don't
+ -- do this, the unique number will get added after the '.' and
+ -- thus be part of the extension, which is wrong.)
+ (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
+ -- Otherwise, something is wrong, because (break (== '.')) should
+ -- always return a pair with either the empty string or a string
+ -- beginning with '.' as the second component.
+ _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile"
+#if defined(mingw32_HOST_OS)
+ findTempName = findTempNamePosix <!> findTempNameWinIO
+
+ findTempNameWinIO = do
+ let label = if null prefix then "ghc" else prefix
+ withCWString tmp_dir $ \c_tmp_dir ->
+ withCWString label $ \c_template ->
+ withCWString suffix $ \c_suffix ->
+ with nullPtr $ \c_ptr -> do
+ res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
+ if not res
+ then do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ else do c_p <- peek c_ptr
+ filename <- peekCWString c_p
+ free c_p
+ let flags = fromIntegral mode .&. o_EXCL
+ handleResultsWinIO filename (flags == o_EXCL)
+
+ findTempNamePosix = do
+ let label = if null prefix then "ghc" else prefix
+ withCWString tmp_dir $ \c_tmp_dir ->
+ withCWString label $ \c_template ->
+ withCWString suffix $ \c_suffix ->
+ allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
+ res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
+ c_str
+ if not res
+ then do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ else do filename <- peekCWString c_str
+ handleResultsPosix filename
+
+ handleResultsPosix filename = do
+ let oflags1 = rw_flags .|. o_EXCL
+ binary_flags
+ | binary = o_BINARY
+ | otherwise = 0
+ oflags = oflags1 .|. binary_flags
+ fd <- withFilePath filename $ \ f -> c_open f oflags mode
+ case fd < 0 of
+ True -> do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ False ->
+ do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+ False{-is_socket-}
+ True{-is_nonblock-}
+
+ enc <- getLocaleEncoding
+ h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
+ False{-set non-block-} (Just enc)
+
+ return (filename, h)
+
+ handleResultsWinIO filename excl = do
+ (hwnd, hwnd_type) <- openFileAsTemp filename True excl
+ mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
+
+ -- then use it to make a Handle
+ h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec
+ `onException` IODevice.close hwnd
+ return (filename, h)
+
+foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
+ :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
+
+foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
+ :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
+
+pathSeparator :: String -> Bool
+pathSeparator template = any (\x-> x == '/' || x == '\\') template
+
+output_flags = std_flags
+#else /* else mingw32_HOST_OS */
+ findTempName = do
+ rs <- rand_string
+ let filename = prefix ++ rs ++ suffix
+ filepath = tmp_dir `combine` filename
+ r <- openNewFile filepath binary mode
+ case r of
+ FileExists -> findTempName
+ OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ NewFileCreated fd -> do
+ (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+ False{-is_socket-}
+ True{-is_nonblock-}
+
+ enc <- getLocaleEncoding
+ h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
+
+ return (filepath, h)
+
+ where
+ {-
+ The following code is inspired by code from 'System.FilePath', since
+ that code is not available here.
+ -}
+ combine path1 []
+ = path1
+ combine path1 path2
+ = case unsnoc path1 of
+ Nothing
+ -> path2
+ Just (_, path1Last)
+ | pathSeparator [path1Last]
+ -> path1 ++ path2
+ | otherwise
+ -> path1 ++ [pathSeparatorChar] ++ path2
+
+tempCounter :: IORef Int
+tempCounter = unsafePerformIO $ newIORef 0
+{-# NOINLINE tempCounter #-}
+
+-- build large digit-alike number
+rand_string :: IO String
+rand_string = do
+ r1 <- c_getpid
+ (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
+ return $ show r1 ++ "-" ++ show r2
+
+data OpenNewFileResult
+ = NewFileCreated CInt
+ | FileExists
+ | OpenNewError Errno
+
+openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
+openNewFile filepath binary mode = do
+ let oflags1 = rw_flags .|. o_EXCL
+
+ binary_flags
+ | binary = o_BINARY
+ | otherwise = 0
+
+ oflags = oflags1 .|. binary_flags
+ fd <- withFilePath filepath $ \ f ->
+ c_open f oflags mode
+ if fd < 0
+ then do
+ errno <- getErrno
+ case errno of
+ _ | errno == eEXIST -> return FileExists
+ _ -> return (OpenNewError errno)
+ else return (NewFileCreated fd)
+
+-- XXX Should use filepath library
+pathSeparatorChar :: Char
+pathSeparatorChar = '/'
+
+pathSeparator :: String -> Bool
+pathSeparator template = pathSeparatorChar `elem` template
+
+output_flags = std_flags .|. o_CREAT
+#endif /* mingw32_HOST_OS */
+
+-- XXX Copied from GHC.Handle
+std_flags, output_flags, rw_flags :: CInt
+std_flags = o_NONBLOCK .|. o_NOCTTY
+rw_flags = output_flags .|. o_RDWR
-- $locking
-- Implementations should enforce as far as possible, at least locally to the
=====================================
libraries/base/src/Text/Printf.hs
=====================================
@@ -99,7 +99,7 @@ import GHC.Internal.Data.List (stripPrefix)
import GHC.Internal.Word
import GHC.Internal.Numeric
import GHC.Internal.Numeric.Natural
-import GHC.Internal.System.IO
+import System.IO
-- $setup
-- >>> import Prelude
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs
=====================================
@@ -1,6 +1,4 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
-{-# OPTIONS_GHC -Wno-x-partial #-}
-----------------------------------------------------------------------------
-- |
@@ -16,293 +14,13 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.System.IO (
- -- * The IO monad
+module GHC.Internal.System.IO (putStrLn, print) where
- IO,
-
- -- * Files and handles
-
- FilePath,
-
- Handle, -- abstract, instance of: Eq, Show.
-
- -- | GHC note: a 'Handle' will be automatically closed when the garbage
- -- collector detects that it has become unreferenced by the program.
- -- However, relying on this behaviour is not generally recommended:
- -- the garbage collector is unpredictable. If possible, use
- -- an explicit 'hClose' to close 'Handle's when they are no longer
- -- required. GHC does not currently attempt to free up file
- -- descriptors when they have run out, it is your responsibility to
- -- ensure that this doesn't happen.
-
- -- ** Standard handles
-
- -- | Three handles are allocated during program initialisation,
- -- and are initially open.
-
- stdin, stdout, stderr,
-
- -- * Opening and closing files
-
- -- ** Opening files
-
- withFile,
- openFile,
- IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
-
- -- ** Closing files
-
- hClose,
-
- -- ** Special cases
-
- -- | These functions are also exported by the "Prelude".
-
- readFile,
- readFile',
- writeFile,
- appendFile,
-
- -- * Operations on handles
-
- -- ** Determining and changing the size of a file
-
- hFileSize,
- hSetFileSize,
-
- -- ** Detecting the end of input
-
- hIsEOF,
- isEOF,
-
- -- ** Buffering operations
-
- BufferMode(NoBuffering,LineBuffering,BlockBuffering),
- hSetBuffering,
- hGetBuffering,
- hFlush,
-
- -- ** Repositioning handles
-
- hGetPosn,
- hSetPosn,
- HandlePosn, -- abstract, instance of: Eq, Show.
-
- hSeek,
- SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
- hTell,
-
- -- ** Handle properties
-
- hIsOpen, hIsClosed,
- hIsReadable, hIsWritable,
- hIsSeekable,
-
- -- ** Terminal operations (not portable: GHC only)
-
- hIsTerminalDevice,
-
- hSetEcho,
- hGetEcho,
-
- -- ** Showing handle state (not portable: GHC only)
-
- hShow,
-
- -- * Text input and output
-
- -- ** Text input
-
- hWaitForInput,
- hReady,
- hGetChar,
- hGetLine,
- hLookAhead,
- hGetContents,
- hGetContents',
-
- -- ** Text output
-
- hPutChar,
- hPutStr,
- hPutStrLn,
- hPrint,
-
- -- ** Special cases for standard input and output
-
- -- | These functions are also exported by the "Prelude".
-
- interact,
- putChar,
- putStr,
- putStrLn,
- print,
- getChar,
- getLine,
- getContents,
- getContents',
- readIO,
- readLn,
-
- -- * Binary input and output
-
- withBinaryFile,
- openBinaryFile,
- hSetBinaryMode,
- hPutBuf,
- hGetBuf,
- hGetBufSome,
- hPutBufNonBlocking,
- hGetBufNonBlocking,
-
- -- * Temporary files
-
- openTempFile,
- openBinaryTempFile,
- openTempFileWithDefaultPermissions,
- openBinaryTempFileWithDefaultPermissions,
-
- -- * Unicode encoding\/decoding
-
- -- | A text-mode 'Handle' has an associated 'TextEncoding', which
- -- is used to decode bytes into Unicode characters when reading,
- -- and encode Unicode characters into bytes when writing.
- --
- -- The default 'TextEncoding' is the same as the default encoding
- -- on your system, which is also available as 'localeEncoding'.
- -- (GHC note: on Windows, we currently do not support double-byte
- -- encodings; if the console\'s code page is unsupported, then
- -- 'localeEncoding' will be 'latin1'.)
- --
- -- Encoding and decoding errors are always detected and reported,
- -- except during lazy I/O ('hGetContents', 'getContents', and
- -- 'readFile'), where a decoding error merely results in
- -- termination of the character stream, as with other I/O errors.
-
- hSetEncoding,
- hGetEncoding,
-
- -- ** Unicode encodings
- TextEncoding,
- latin1,
- utf8, utf8_bom,
- utf16, utf16le, utf16be,
- utf32, utf32le, utf32be,
- localeEncoding,
- char8,
- mkTextEncoding,
-
- -- * Newline conversion
-
- -- | In Haskell, a newline is always represented by the character
- -- @\'\\n\'@. However, in files and external character streams, a
- -- newline may be represented by another character sequence, such
- -- as @\'\\r\\n\'@.
- --
- -- A text-mode 'Handle' has an associated 'NewlineMode' that
- -- specifies how to translate newline characters. The
- -- 'NewlineMode' specifies the input and output translation
- -- separately, so that for instance you can translate @\'\\r\\n\'@
- -- to @\'\\n\'@ on input, but leave newlines as @\'\\n\'@ on output.
- --
- -- The default 'NewlineMode' for a 'Handle' is
- -- 'nativeNewlineMode', which does no translation on Unix systems,
- -- but translates @\'\\r\\n\'@ to @\'\\n\'@ and back on Windows.
- --
- -- Binary-mode 'Handle's do no newline translation at all.
- --
- hSetNewlineMode,
- hGetNewlineMode,
- Newline(..), nativeNewline,
- NewlineMode(..),
- noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
- ) where
-
-import GHC.Internal.Control.Exception.Base
-
-import GHC.Internal.Classes (Eq(..), Ord(..))
-import GHC.Internal.Data.Bits
-import GHC.Internal.Data.Maybe
-import GHC.Internal.Err (errorWithoutStackTrace)
-import GHC.Internal.Foreign.C.Error
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.Base (fmap)
-import GHC.Internal.Classes (not, (||))
-import GHC.Internal.Err (undefined)
-import GHC.Internal.Foreign.C.String
-import GHC.Internal.Foreign.Ptr
-import GHC.Internal.Foreign.Marshal.Alloc
-import GHC.Internal.Foreign.Marshal.Utils (with)
-import GHC.Internal.Foreign.Storable
-import GHC.Internal.IO.SubSystem
-import GHC.Internal.IO.Windows.Handle (openFileAsTemp)
-import GHC.Internal.IO.Handle.Windows (mkHandleFromHANDLE)
-import GHC.Internal.IO.Device as IODevice
-import GHC.Internal.Real (fromIntegral)
-#endif
-import GHC.Internal.Foreign.C.Types
-import GHC.Internal.System.Posix.Internals
-import GHC.Internal.System.Posix.Types
-
-import GHC.Internal.Base (String, failIO, otherwise, return, ($), (.), (>>=))
-import GHC.Internal.List
-#if !defined(mingw32_HOST_OS)
-import GHC.Internal.IORef
-import GHC.Internal.Types (Int)
-#endif
-import GHC.Internal.Num
-import GHC.Internal.IO hiding ( bracket, onException )
-import GHC.Internal.IO.IOMode
-import qualified GHC.Internal.IO.FD as FD
-import GHC.Internal.IO.Handle
-import qualified GHC.Internal.IO.Handle.FD as POSIX
-import GHC.Internal.IO.Handle.Text ( hGetBufSome, hPutStrLn )
-import GHC.Internal.IO.Exception ( userError )
-import GHC.Internal.IO.Encoding
-import GHC.Internal.Text.Read
-import GHC.Internal.IO.StdHandles
-import GHC.Internal.Show
-import GHC.Internal.Types (Bool(..), Char)
------------------------------------------------------------------------------
--- Standard IO
-
--- | Write a character to the standard output device
---
--- 'putChar' is implemented as @'hPutChar' 'stdout'@.
---
--- This operation may fail with the same errors as 'hPutChar'.
---
--- ==== __Examples__
---
--- Note that the following do not put a newline.
---
--- >>> putChar 'x'
--- x
---
--- >>> putChar '\0042'
--- *
-putChar :: Char -> IO ()
-putChar c = hPutChar stdout c
-
--- | Write a string to the standard output device
---
--- 'putStr' is implemented as @'hPutStr' 'stdout'@.
---
--- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
---
--- ==== __Examples__
---
--- Note that the following do not put a newline.
---
--- >>> putStr "Hello, World!"
--- Hello, World!
---
--- >>> putStr "\0052\0042\0050"
--- 4*2
---
-putStr :: String -> IO ()
-putStr s = hPutStr stdout s
+import GHC.Internal.Base (String)
+import GHC.Internal.IO (IO)
+import GHC.Internal.IO.Handle.Text (hPutStrLn)
+import GHC.Internal.IO.StdHandles (stdout)
+import GHC.Internal.Show (Show, show)
-- | The same as 'putStr', but adds a newline character.
--
@@ -339,485 +57,3 @@ putStrLn s = hPutStrLn stdout s
-- [(0,1),(1,2),(2,4),(3,8),(4,16),(5,32),(6,64),(7,128),(8,256)]
print :: Show a => a -> IO ()
print x = putStrLn (show x)
-
--- | Read a single character from the standard input device.
---
--- 'getChar' is implemented as @'hGetChar' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetChar'.
---
--- ==== __Examples__
---
--- >>> getChar
--- a'a'
---
--- >>> getChar
--- >
--- '\n'
-getChar :: IO Char
-getChar = hGetChar stdin
-
--- | Read a line from the standard input device.
---
--- 'getLine' is implemented as @'hGetLine' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetLine'.
---
--- ==== __Examples__
---
--- >>> getLine
--- > Hello World!
--- "Hello World!"
---
--- >>> getLine
--- >
--- ""
-getLine :: IO String
-getLine = hGetLine stdin
-
--- | The 'getContents' operation returns all user input as a single string,
--- which is read lazily as it is needed.
---
--- 'getContents' is implemented as @'hGetContents' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetContents'.
---
--- ==== __Examples__
---
--- >>> getContents >>= putStr
--- > aaabbbccc :D
--- aaabbbccc :D
--- > I hope you have a great day
--- I hope you have a great day
--- > ^D
---
--- >>> getContents >>= print . length
--- > abc
--- > <3
--- > def ^D
--- 11
-getContents :: IO String
-getContents = hGetContents stdin
-
--- | The 'getContents'' operation returns all user input as a single string,
--- which is fully read before being returned
---
--- 'getContents'' is implemented as @'hGetContents'' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetContents''.
---
--- ==== __Examples__
---
--- >>> getContents' >>= putStr
--- > aaabbbccc :D
--- > I hope you have a great day
--- aaabbbccc :D
--- I hope you have a great day
---
--- >>> getContents' >>= print . length
--- > abc
--- > <3
--- > def ^D
--- 11
---
--- @since base-4.15.0.0
-getContents' :: IO String
-getContents' = hGetContents' stdin
-
--- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it.
--- The resulting string is written to the 'stdout' device.
---
--- Note that this operation is lazy, which allows to produce output
--- even before all input has been consumed.
---
--- This operation may fail with the same errors as 'getContents' and 'putStr'.
---
--- If it doesn't produce output the buffering settings may not be
--- correct, use ^D (ctrl+D) to close stdin which forces
--- the buffer to be consumed.
---
--- You may wish to set the buffering style appropriate to your program's
--- needs before using this function, for example:
---
--- @
--- main :: IO ()
--- main = do
--- hSetBuffering stdin LineBuffering
--- hSetBuffering stdout NoBuffering
--- interact (concatMap (\str -> str ++ str) . L.lines)
--- @
---
--- ==== __Examples__
---
--- >>> interact (\str -> str ++ str)
--- > hi :)
--- hi :)
--- > ^D
--- hi :)
---
--- >>> interact (const ":D")
--- :D
---
--- >>> interact (show . words)
--- > hello world!
--- > I hope you have a great day
--- > ^D
--- ["hello","world!","I","hope","you","have","a","great","day"]
-interact :: (String -> String) -> IO ()
-interact f = do s <- getContents
- putStr (f s)
-
--- | The 'readFile' function reads a file and
--- returns the contents of the file as a string.
---
--- The file is read lazily, on demand, as with 'getContents'.
---
--- This operation may fail with the same errors as 'hGetContents' and 'openFile'.
---
--- ==== __Examples__
---
--- >>> readFile "~/hello_world"
--- "Greetings!"
---
--- >>> take 5 <$> readFile "/dev/zero"
--- "\NUL\NUL\NUL\NUL\NUL"
-readFile :: FilePath -> IO String
-readFile name = openFile name ReadMode >>= hGetContents
-
--- | The 'readFile'' function reads a file and
--- returns the contents of the file as a string.
---
--- This is identical to 'readFile', but the file is fully read before being returned,
--- as with 'getContents''.
---
--- @since base-4.15.0.0
-readFile' :: FilePath -> IO String
--- There's a bit of overkill here—both withFile and
--- hGetContents' will close the file in the end.
-readFile' name = withFile name ReadMode hGetContents'
-
--- | The computation @'writeFile' file str@ function writes the string @str@,
--- to the file @file@.
---
--- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
---
--- ==== __Examples__
---
--- >>> writeFile "hello" "world" >> readFile "hello"
--- "world"
---
--- >>> writeFile "~/" "D:"
--- *** Exception: ~/: withFile: inappropriate type (Is a directory)
-writeFile :: FilePath -> String -> IO ()
-writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
-
--- | The computation @'appendFile' file str@ function appends the string @str@,
--- to the file @file@.
---
--- Note that 'writeFile' and 'appendFile' write a literal string
--- to a file. To write a value of any printable type, as with 'print',
--- use the 'show' function to convert the value to a string first.
---
--- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
---
--- ==== __Examples__
---
--- The following example could be more efficently written by acquiring a handle
--- instead with 'openFile' and using the computations capable of writing to handles
--- such as 'hPutStr'.
---
--- >>> let fn = "hello_world"
--- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn)
--- "hello world!"
---
--- >>> let fn = "foo"; output = readFile' fn >>= putStrLn
--- >>> in output >> appendFile fn (show [1,2,3]) >> output
--- this is what's in the file
--- this is what's in the file[1,2,3]
-appendFile :: FilePath -> String -> IO ()
-appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
-
--- | The 'readLn' function combines 'getLine' and 'readIO'.
---
--- This operation may fail with the same errors as 'getLine' and 'readIO'.
---
--- ==== __Examples__
---
--- >>> fmap (+ 5) readLn
--- > 25
--- 30
---
--- >>> readLn :: IO String
--- > this is not a string literal
--- *** Exception: user error (Prelude.readIO: no parse)
-readLn :: Read a => IO a
-readLn = getLine >>= readIO
-
--- | The 'readIO' function is similar to 'read' except that it signals
--- parse failure to the 'IO' monad instead of terminating the program.
---
--- This operation may fail with:
---
--- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse.
---
--- ==== __Examples__
---
--- >>> fmap (+ 1) (readIO "1")
--- 2
---
--- >>> readIO "not quite ()" :: IO ()
--- *** Exception: user error (Prelude.readIO: no parse)
-readIO :: Read a => String -> IO a
-readIO s = case (do { (x,t) <- reads s ;
- ("","") <- lex t ;
- return x }) of
- [x] -> return x
- [] -> ioError (userError "Prelude.readIO: no parse")
- _ -> ioError (userError "Prelude.readIO: ambiguous parse")
-
--- | The encoding of the current locale.
---
--- This is the initial locale encoding: if it has been subsequently changed by
--- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
-localeEncoding :: TextEncoding
-localeEncoding = initLocaleEncoding
-
--- | Computation 'hReady' @hdl@ indicates whether at least one item is
--- available for input from handle @hdl@.
---
--- This operation may fail with:
---
--- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached.
-hReady :: Handle -> IO Bool
-hReady h = hWaitForInput h 0
-
--- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
--- given by the 'show' function to the file or channel managed by @hdl@
--- and appends a newline.
---
--- This operation may fail with the same errors as 'hPutStrLn'
---
--- ==== __Examples__
---
--- >>> hPrint stdout [1,2,3]
--- [1,2,3]
---
--- >>> hPrint stdin [4,5,6]
--- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing)
-hPrint :: Show a => Handle -> a -> IO ()
-hPrint hdl = hPutStrLn hdl . show
-
--- | The function creates a temporary file in ReadWrite mode.
--- The created file isn\'t deleted automatically, so you need to delete it manually.
---
--- The file is created with permissions such that only the current
--- user can read\/write it.
---
--- With some exceptions (see below), the file will be created securely
--- in the sense that an attacker should not be able to cause
--- openTempFile to overwrite another file on the filesystem using your
--- credentials, by putting symbolic links (on Unix) in the place where
--- the temporary file is to be created. On Unix the @O_CREAT@ and
--- @O_EXCL@ flags are used to prevent this attack, but note that
--- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
--- rely on this behaviour it is best to use local filesystems only.
-openTempFile :: FilePath -- ^ Directory in which to create the file
- -> String -- ^ File name template. If the template is \"foo.ext\" then
- -- the created file will be \"fooXXX.ext\" where XXX is some
- -- random number. Note that this should not contain any path
- -- separator characters. On Windows, the template prefix may
- -- be truncated to 3 chars, e.g. \"foobar.ext\" will be
- -- \"fooXXX.ext\".
- -> IO (FilePath, Handle)
-openTempFile tmp_dir template
- = openTempFile' "openTempFile" tmp_dir template False 0o600
-
--- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
-openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
-openBinaryTempFile tmp_dir template
- = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
-
--- | Like 'openTempFile', but uses the default file permissions
-openTempFileWithDefaultPermissions :: FilePath -> String
- -> IO (FilePath, Handle)
-openTempFileWithDefaultPermissions tmp_dir template
- = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666
-
--- | Like 'openBinaryTempFile', but uses the default file permissions
-openBinaryTempFileWithDefaultPermissions :: FilePath -> String
- -> IO (FilePath, Handle)
-openBinaryTempFileWithDefaultPermissions tmp_dir template
- = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666
-
-openTempFile' :: String -> FilePath -> String -> Bool -> CMode
- -> IO (FilePath, Handle)
-openTempFile' loc tmp_dir template binary mode
- | pathSeparator template
- = failIO $ "openTempFile': Template string must not contain path separator characters: "++template
- | otherwise = findTempName
- where
- -- We split off the last extension, so we can use .foo.ext files
- -- for temporary files (hidden on Unix OSes). Unfortunately we're
- -- below filepath in the hierarchy here.
- (prefix, suffix) =
- case break (== '.') $ reverse template of
- -- First case: template contains no '.'s. Just re-reverse it.
- (rev_suffix, "") -> (reverse rev_suffix, "")
- -- Second case: template contains at least one '.'. Strip the
- -- dot from the prefix and prepend it to the suffix (if we don't
- -- do this, the unique number will get added after the '.' and
- -- thus be part of the extension, which is wrong.)
- (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
- -- Otherwise, something is wrong, because (break (== '.')) should
- -- always return a pair with either the empty string or a string
- -- beginning with '.' as the second component.
- _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile"
-#if defined(mingw32_HOST_OS)
- findTempName = findTempNamePosix <!> findTempNameWinIO
-
- findTempNameWinIO = do
- let label = if null prefix then "ghc" else prefix
- withCWString tmp_dir $ \c_tmp_dir ->
- withCWString label $ \c_template ->
- withCWString suffix $ \c_suffix ->
- with nullPtr $ \c_ptr -> do
- res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
- if not res
- then do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- else do c_p <- peek c_ptr
- filename <- peekCWString c_p
- free c_p
- let flags = fromIntegral mode .&. o_EXCL
- handleResultsWinIO filename (flags == o_EXCL)
-
- findTempNamePosix = do
- let label = if null prefix then "ghc" else prefix
- withCWString tmp_dir $ \c_tmp_dir ->
- withCWString label $ \c_template ->
- withCWString suffix $ \c_suffix ->
- allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
- res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
- c_str
- if not res
- then do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- else do filename <- peekCWString c_str
- handleResultsPosix filename
-
- handleResultsPosix filename = do
- let oflags1 = rw_flags .|. o_EXCL
- binary_flags
- | binary = o_BINARY
- | otherwise = 0
- oflags = oflags1 .|. binary_flags
- fd <- withFilePath filename $ \ f -> c_open f oflags mode
- case fd < 0 of
- True -> do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- False ->
- do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
- False{-is_socket-}
- True{-is_nonblock-}
-
- enc <- getLocaleEncoding
- h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
- False{-set non-block-} (Just enc)
-
- return (filename, h)
-
- handleResultsWinIO filename excl = do
- (hwnd, hwnd_type) <- openFileAsTemp filename True excl
- mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
-
- -- then use it to make a Handle
- h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec
- `onException` IODevice.close hwnd
- return (filename, h)
-
-foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
- :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
-
-foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
- :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
-
-pathSeparator :: String -> Bool
-pathSeparator template = any (\x-> x == '/' || x == '\\') template
-
-output_flags = std_flags
-#else /* else mingw32_HOST_OS */
- findTempName = do
- rs <- rand_string
- let filename = prefix ++ rs ++ suffix
- filepath = tmp_dir `combine` filename
- r <- openNewFile filepath binary mode
- case r of
- FileExists -> findTempName
- OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- NewFileCreated fd -> do
- (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
- False{-is_socket-}
- True{-is_nonblock-}
-
- enc <- getLocaleEncoding
- h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
-
- return (filepath, h)
-
- where
- -- XXX bits copied from System.FilePath, since that's not available here
- combine a b
- | null b = a
- | null a = b
- | pathSeparator [last a] = a ++ b
- | otherwise = a ++ [pathSeparatorChar] ++ b
-
-tempCounter :: IORef Int
-tempCounter = unsafePerformIO $ newIORef 0
-{-# NOINLINE tempCounter #-}
-
--- build large digit-alike number
-rand_string :: IO String
-rand_string = do
- r1 <- c_getpid
- (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
- return $ show r1 ++ "-" ++ show r2
-
-data OpenNewFileResult
- = NewFileCreated CInt
- | FileExists
- | OpenNewError Errno
-
-openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
-openNewFile filepath binary mode = do
- let oflags1 = rw_flags .|. o_EXCL
-
- binary_flags
- | binary = o_BINARY
- | otherwise = 0
-
- oflags = oflags1 .|. binary_flags
- fd <- withFilePath filepath $ \ f ->
- c_open f oflags mode
- if fd < 0
- then do
- errno <- getErrno
- case errno of
- _ | errno == eEXIST -> return FileExists
- _ -> return (OpenNewError errno)
- else return (NewFileCreated fd)
-
--- XXX Should use filepath library
-pathSeparatorChar :: Char
-pathSeparatorChar = '/'
-
-pathSeparator :: String -> Bool
-pathSeparator template = pathSeparatorChar `elem` template
-
-output_flags = std_flags .|. o_CREAT
-#endif /* mingw32_HOST_OS */
-
--- XXX Copied from GHC.Handle
-std_flags, output_flags, rw_flags :: CInt
-std_flags = o_NONBLOCK .|. o_NOCTTY
-rw_flags = output_flags .|. o_RDWR
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -7848,6 +7848,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9883,7 +9884,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -7820,6 +7820,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9921,7 +9922,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -8012,6 +8012,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -10163,7 +10164,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -7848,6 +7848,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9883,7 +9884,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/typecheck/should_compile/T9497a.stderr
=====================================
@@ -1,4 +1,3 @@
-
T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _main :: IO ()
Or perhaps ‘_main’ is mis-spelled, or not in scope
@@ -8,8 +7,7 @@ T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
main :: IO () (bound at T9497a.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -45,6 +45,15 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
y :: [a]
z :: [a] -> [a]
f :: forall {p}. p
+ appendFile :: FilePath -> String -> IO ()
+ getChar :: IO Char
+ getContents :: IO String
+ getLine :: IO String
+ interact :: (String -> String) -> IO ()
+ putChar :: Char -> IO ()
+ putStr :: String -> IO ()
+ readFile :: FilePath -> IO String
+ writeFile :: FilePath -> String -> IO ()
otherwise :: Bool
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
@@ -58,16 +67,7 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
showChar :: Char -> ShowS
showParen :: Bool -> ShowS -> ShowS
showString :: String -> ShowS
- appendFile :: FilePath -> String -> IO ()
- getChar :: IO Char
- getContents :: IO String
- getLine :: IO String
- interact :: (String -> String) -> IO ()
- putChar :: Char -> IO ()
- putStr :: String -> IO ()
putStrLn :: String -> IO ()
- readFile :: FilePath -> IO String
- writeFile :: FilePath -> String -> IO ()
EQ :: Ordering
GT :: Ordering
LT :: Ordering
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -48,6 +48,15 @@ holes3.hs:11:15: error: [GHC-88464]
y :: [a]
z :: [a] -> [a]
f :: forall {p}. p
+ appendFile :: FilePath -> String -> IO ()
+ getChar :: IO Char
+ getContents :: IO String
+ getLine :: IO String
+ interact :: (String -> String) -> IO ()
+ putChar :: Char -> IO ()
+ putStr :: String -> IO ()
+ readFile :: FilePath -> IO String
+ writeFile :: FilePath -> String -> IO ()
otherwise :: Bool
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
@@ -61,16 +70,7 @@ holes3.hs:11:15: error: [GHC-88464]
showChar :: Char -> ShowS
showParen :: Bool -> ShowS -> ShowS
showString :: String -> ShowS
- appendFile :: FilePath -> String -> IO ()
- getChar :: IO Char
- getContents :: IO String
- getLine :: IO String
- interact :: (String -> String) -> IO ()
- putChar :: Char -> IO ()
- putStr :: String -> IO ()
putStrLn :: String -> IO ()
- readFile :: FilePath -> IO String
- writeFile :: FilePath -> String -> IO ()
EQ :: Ordering
GT :: Ordering
LT :: Ordering
=====================================
testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
=====================================
@@ -230,15 +230,14 @@ valid_hole_fits.hs:41:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
Valid hole fits include
ps :: String -> IO () (defined at valid_hole_fits.hs:9:1)
System.IO.putStr :: String -> IO ()
- (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34)
System.IO.putStrLn :: String -> IO ()
(imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:37-44
(and originally defined in ‘GHC.Internal.System.IO’))
readIO :: forall a. Read a => String -> IO a
with readIO @()
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (and originally defined in ‘System.IO’))
fail :: forall (m :: * -> *) a.
(MonadFail m, GHC.Internal.Stack.Types.HasCallStack) =>
String -> m a
=====================================
testsuite/tests/typecheck/should_fail/T9497d.stderr
=====================================
@@ -8,8 +8,7 @@ T9497d.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497d.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497a-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497a-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497a-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497b-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497b-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497b-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497c-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497c-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497c-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
utils/haddock/html-test/ref/Bug1004.html
=====================================
@@ -627,13 +627,13 @@
>liftReadsPrec</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > a) -> <a href="#" title="Prelude"
+ > a) -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [a] -> <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -645,11 +645,11 @@
>liftReadList</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > a) -> <a href="#" title="Prelude"
+ > a) -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > [a] -> <a href="#" title="Prelude"
+ > [a] -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [<a href="#" title="Bug1004"
>Product</a
@@ -735,15 +735,15 @@
>liftShowsPrec</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> a -> <a href="#" title="Prelude"
+ > -> a -> <a href="#" title="Text.Show"
>ShowS</a
- >) -> ([a] -> <a href="#" title="Prelude"
+ >) -> ([a] -> <a href="#" title="Text.Show"
>ShowS</a
>) -> <a href="#" title="Data.Int"
>Int</a
> -> <a href="#" title="Bug1004"
>Product</a
- > f g a -> <a href="#" title="Prelude"
+ > f g a -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -753,13 +753,13 @@
>liftShowList</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> a -> <a href="#" title="Prelude"
+ > -> a -> <a href="#" title="Text.Show"
>ShowS</a
- >) -> ([a] -> <a href="#" title="Prelude"
+ >) -> ([a] -> <a href="#" title="Text.Show"
>ShowS</a
>) -> [<a href="#" title="Bug1004"
>Product</a
- > f g a] -> <a href="#" title="Prelude"
+ > f g a] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -2563,15 +2563,15 @@
></span
> <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> (f a)</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> (g a)</span
>)</span
- > => <a href="#" title="Prelude"
+ > => <a href="#" title="Text.Read"
>Read</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2603,7 +2603,7 @@
>readsPrec</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2613,7 +2613,7 @@
><p class="src"
><a href="#"
>readList</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [<a href="#" title="Bug1004"
>Product</a
@@ -2651,15 +2651,15 @@
></span
> <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> (f a)</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> (g a)</span
>)</span
- > => <a href="#" title="Prelude"
+ > => <a href="#" title="Text.Show"
>Show</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2693,7 +2693,7 @@
>Int</a
> -> <a href="#" title="Bug1004"
>Product</a
- > f g a -> <a href="#" title="Prelude"
+ > f g a -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -2713,7 +2713,7 @@
>showList</a
> :: [<a href="#" title="Bug1004"
>Product</a
- > f g a] -> <a href="#" title="Prelude"
+ > f g a] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/Bug973.html
=====================================
@@ -58,11 +58,11 @@
>showRead</a
> :: <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -74,11 +74,11 @@
>forall</span
> b a. <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -104,11 +104,11 @@
><td class="src"
>:: <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -152,11 +152,11 @@
>forall</span
> b a. <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
=====================================
utils/haddock/html-test/ref/ConstructorPatternExport.html
=====================================
@@ -95,7 +95,7 @@
>pattern</span
> <a id="v:BlubCons" class="def"
>BlubCons</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> b => b -> Blub <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/DefaultSignatures.html
=====================================
@@ -133,7 +133,7 @@
>default</span
> <a id="v:bar" class="def"
>bar</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.Show"
>Show</a
> a => a -> <a href="#" title="Data.String"
>String</a
@@ -177,7 +177,7 @@
>default</span
> <a id="v:baz-39-" class="def"
>baz'</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.Read"
>Read</a
> a => <a href="#" title="Data.String"
>String</a
=====================================
utils/haddock/html-test/ref/Hash.html
=====================================
@@ -111,7 +111,7 @@
>)</span
> => <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Hash"
>HashTable</a
@@ -129,7 +129,7 @@
>Hash</a
> key</span
>)</span
- > => key -> val -> <a href="#" title="Prelude"
+ > => key -> val -> <a href="#" title="System.IO"
>IO</a
> ()</li
><li class="src short"
@@ -137,7 +137,7 @@
>lookup</a
> :: <a href="#" title="Hash"
>Hash</a
- > key => key -> <a href="#" title="Prelude"
+ > key => key -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Data.Maybe"
>Maybe</a
@@ -215,7 +215,7 @@
>)</span
> => <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Hash"
>HashTable</a
@@ -241,7 +241,7 @@
>Hash</a
> key</span
>)</span
- > => key -> val -> <a href="#" title="Prelude"
+ > => key -> val -> <a href="#" title="System.IO"
>IO</a
> () <a href="#" class="selflink"
>#</a
@@ -257,7 +257,7 @@
>lookup</a
> :: <a href="#" title="Hash"
>Hash</a
- > key => key -> <a href="#" title="Prelude"
+ > key => key -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Data.Maybe"
>Maybe</a
=====================================
utils/haddock/html-test/ref/PatternSyns.html
=====================================
@@ -104,7 +104,7 @@
>data</span
> <a href="#"
>BlubType</a
- > = <a href="#" title="Prelude"
+ > = <a href="#" title="Text.Show"
>Show</a
> x => <a href="#"
>BlubCtor</a
@@ -114,7 +114,7 @@
>pattern</span
> <a href="#"
>Blub</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> x => x -> <a href="#" title="PatternSyns"
>BlubType</a
@@ -266,7 +266,7 @@
><table
><tr
><td class="src"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> x => <a id="v:BlubCtor" class="def"
>BlubCtor</a
@@ -283,7 +283,7 @@
>pattern</span
> <a id="v:Blub" class="def"
>Blub</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> x => x -> <a href="#" title="PatternSyns"
>BlubType</a
=====================================
utils/haddock/html-test/ref/PatternSyns2.html
=====================================
@@ -145,7 +145,7 @@
>P</a
> :: () => <span class="keyword"
>forall</span
- > k (a :: k) b. <a href="#" title="Prelude"
+ > k (a :: k) b. <a href="#" title="Text.Show"
>Show</a
> b => <a href="#" title="Data.Proxy"
>Proxy</a
=====================================
utils/haddock/html-test/ref/QuasiExpr.html
=====================================
@@ -122,7 +122,7 @@
><span class="inst-left"
><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Expr:Show:1"
></span
- > <a href="#" title="Prelude"
+ > <a href="#" title="Text.Show"
>Show</a
> <a href="#" title="QuasiExpr"
>Expr</a
@@ -152,7 +152,7 @@
>Int</a
> -> <a href="#" title="QuasiExpr"
>Expr</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -172,7 +172,7 @@
>showList</a
> :: [<a href="#" title="QuasiExpr"
>Expr</a
- >] -> <a href="#" title="Prelude"
+ >] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -244,7 +244,7 @@
><span class="inst-left"
><span class="instance details-toggle-control details-toggle" data-details-id="i:id:BinOp:Show:1"
></span
- > <a href="#" title="Prelude"
+ > <a href="#" title="Text.Show"
>Show</a
> <a href="#" title="QuasiExpr"
>BinOp</a
@@ -274,7 +274,7 @@
>Int</a
> -> <a href="#" title="QuasiExpr"
>BinOp</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -294,7 +294,7 @@
>showList</a
> :: [<a href="#" title="QuasiExpr"
>BinOp</a
- >] -> <a href="#" title="Prelude"
+ >] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/Test.html
=====================================
@@ -521,7 +521,7 @@
><li
><a href="#"
>a</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="System.IO"
>IO</a
> a</li
><li
@@ -575,7 +575,7 @@
>a</a
> :: <a href="#" title="Test"
>C</a
- > a => <a href="#" title="Prelude"
+ > a => <a href="#" title="System.IO"
>IO</a
> a</li
><li class="src short"
@@ -591,7 +591,7 @@
>g</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> CInt</li
><li class="src short"
@@ -661,7 +661,7 @@
>Float</a
>) -> <a href="#" title="Test"
>T5</a
- > () () -> <a href="#" title="Prelude"
+ > () () -> <a href="#" title="System.IO"
>IO</a
> ()</li
><li class="src short"
@@ -683,7 +683,7 @@
>R</a
> -> <a href="#" title="Test"
>N1</a
- > () -> <a href="#" title="Prelude"
+ > () -> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Data.Int"
>Int</a
@@ -693,7 +693,7 @@
>o</a
> :: <a href="#" title="Prelude"
>Float</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Prelude"
>Float</a
@@ -1674,7 +1674,7 @@
><p class="src"
><a id="v:a" class="def"
>a</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="System.IO"
>IO</a
> a <a href="#" class="selflink"
>#</a
@@ -1903,7 +1903,7 @@
>a</a
> :: <a href="#" title="Test"
>C</a
- > a => <a href="#" title="Prelude"
+ > a => <a href="#" title="System.IO"
>IO</a
> a <a href="#" class="selflink"
>#</a
@@ -1991,7 +1991,7 @@ using double quotes: <a href="#"
>g</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> CInt <a href="#" class="selflink"
>#</a
@@ -2267,7 +2267,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> ()</td
><td class="doc"
@@ -2355,7 +2355,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Data.Int"
>Int</a
@@ -2395,7 +2395,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Prelude"
>Float</a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad141b389a6aa91ad68e656456768dc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad141b389a6aa91ad68e656456768dc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/text-read-implementation-into-base] 6 commits: Move I/O-related `Read` instances into `base`
by Wolfgang Jeltsch (@jeltsch) 14 Apr '26
by Wolfgang Jeltsch (@jeltsch) 14 Apr '26
14 Apr '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-implementation-into-base at Glasgow Haskell Compiler / GHC
Commits:
52e9a660 by Wolfgang Jeltsch at 2026-04-14T14:38:23+03:00
Move I/O-related `Read` instances into `base`
- - - - -
f8f410ce by Wolfgang Jeltsch at 2026-04-14T14:38:39+03: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.
- - - - -
eb44d418 by Wolfgang Jeltsch at 2026-04-14T14:40:02+03:00
Move the instance `Read ByteOrder` into `base`
- - - - -
50b5ffa3 by Wolfgang Jeltsch at 2026-04-14T14:41:16+03:00
Move the implementation of version parsing into `base`
- - - - -
b4b18ded by Wolfgang Jeltsch at 2026-04-14T14:41:34+03:00
Move the implementation of `readConstr` into `base`
- - - - -
d561f25a by Wolfgang Jeltsch at 2026-04-14T14:42:48+03:00
Move the `Text.Read` implementation into `base`
- - - - -
27 changed files:
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Functor/Classes.hs
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Data/Version.hs
- libraries/base/src/GHC/ByteOrder.hs
- libraries/base/src/Numeric.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/base/src/Text/Read.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- 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
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- − libraries/ghc-internal/src/GHC/Internal/Text/Read.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/Functor/Classes.hs
=====================================
@@ -85,7 +85,7 @@ import GHC.Internal.Read (expectP, list, paren, readField)
import GHC.Internal.Show (appPrec)
import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec, pfail)
-import GHC.Internal.Text.Read (Read(..), parens, prec, step, reset)
+import Text.Read (Read(..), parens, prec, step, reset)
import GHC.Internal.Text.Read.Lex (Lexeme(..))
import GHC.Internal.Text.Show (showListWith)
import Prelude
=====================================
libraries/base/src/Data/Functor/Compose.hs
=====================================
@@ -35,7 +35,7 @@ import GHC.Internal.Data.Foldable (Foldable(..))
import GHC.Internal.Data.Monoid (Sum(..), All(..), Any(..), Product(..))
import GHC.Internal.Data.Type.Equality (TestEquality(..), (:~:)(..))
import GHC.Generics (Generic, Generic1)
-import GHC.Internal.Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
+import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
import Prelude
infixr 9 `Compose`
=====================================
libraries/base/src/Data/Version.hs
=====================================
@@ -1,5 +1,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
-- Module : Data.Version
-- Copyright : (c) The University of Glasgow 2004
@@ -33,3 +37,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,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
--
-- Module : GHC.ByteOrder
@@ -19,4 +23,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/Prelude.hs
=====================================
@@ -179,7 +179,7 @@ import GHC.Internal.Data.Tuple
import GHC.Internal.Base hiding ( foldr, mapM, sequence )
import GHC.Internal.Classes
import GHC.Internal.Err
-import GHC.Internal.Text.Read
+import Text.Read
import GHC.Internal.Enum
import GHC.Internal.Num
import GHC.Internal.Prim (seq)
=====================================
libraries/base/src/System/IO.hs
=====================================
@@ -1,5 +1,8 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
-- |
--
@@ -895,3 +898,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/base/src/Text/Read.hs
=====================================
@@ -39,5 +39,84 @@ module Text.Read
readMaybe
) where
-import GHC.Internal.Text.Read
+import GHC.Err (errorWithoutStackTrace)
+import GHC.Read
+ (
+ ReadS,
+ Read (readsPrec, readList, readPrec, readListPrec),
+ lex,
+ readParen,
+ readListDefault,
+ lexP,
+ parens,
+ readListPrecDefault
+ )
+import Control.Monad (return)
+import Data.Function (id)
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Either (Either (Left, Right), either)
+import Data.String (String)
+import Text.Read.Lex (Lexeme (Char, String, Punc, Ident, Symbol, Number, EOF))
+import Text.ParserCombinators.ReadP (skipSpaces)
import Text.ParserCombinators.ReadPrec
+
+-- $setup
+-- >>> import Prelude
+
+------------------------------------------------------------------------
+-- utility functions
+
+-- | equivalent to 'readsPrec' with a precedence of 0.
+reads :: Read a => ReadS a
+reads = readsPrec minPrec
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+-- A 'Left' value indicates a parse error.
+--
+-- >>> readEither "123" :: Either String Int
+-- Right 123
+--
+-- >>> readEither "hello" :: Either String Int
+-- Left "Prelude.read: no parse"
+--
+-- @since base-4.6.0.0
+readEither :: Read a => String -> Either String a
+readEither s =
+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+ [x] -> Right x
+ [] -> Left "Prelude.read: no parse"
+ _ -> Left "Prelude.read: ambiguous parse"
+ where
+ read' =
+ do x <- readPrec
+ lift skipSpaces
+ return x
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+--
+-- >>> readMaybe "123" :: Maybe Int
+-- Just 123
+--
+-- >>> readMaybe "hello" :: Maybe Int
+-- Nothing
+--
+-- @since base-4.6.0.0
+readMaybe :: Read a => String -> Maybe a
+readMaybe s = case readEither s of
+ Left _ -> Nothing
+ Right a -> Just a
+
+-- | The 'read' function reads input from a string, which must be
+-- completely consumed by the input process. 'read' fails with an 'error' if the
+-- parse is unsuccessful, and it is therefore discouraged from being used in
+-- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
+--
+-- >>> read "123" :: Int
+-- 123
+--
+-- >>> read "hello" :: Int
+-- *** Exception: Prelude.read: no parse
+read :: Read a => String -> a
+read s = either errorWithoutStackTrace id (readEither s)
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -329,7 +329,6 @@ Library
GHC.Internal.System.Posix.Types
GHC.Internal.Text.ParserCombinators.ReadP
GHC.Internal.Text.ParserCombinators.ReadPrec
- GHC.Internal.Text.Read
GHC.Internal.Text.Read.Lex
GHC.Internal.Text.Show
GHC.Internal.Type.Reflection
=====================================
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,
@@ -126,10 +126,8 @@ import GHC.Internal.Base (
import GHC.Internal.Err (errorWithoutStackTrace)
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 )
import GHC.Internal.Types (
Bool(..), Char, Coercible, Float, Double, Type, type (~), type (~~),
)
@@ -688,32 +686,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,17 @@ module GHC.Internal.Data.Version (
-- * The @Version@ type
Version(..),
-- * A concrete representation of @Version@
- showVersion, parseVersion,
+ showVersion,
-- * Constructor function
makeVersion
) where
-import GHC.Internal.Classes ( Eq(..), (&&) )
-import GHC.Internal.Data.Functor ( Functor(..) )
+import GHC.Internal.Classes ( Eq ((==)), (&&) )
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
import GHC.Internal.Data.String ( String )
-import GHC.Internal.Base ( Applicative(..) )
-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 +63,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 +86,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
)
{-# DEPRECATED versionTags "See GHC ticket #2496" #-}
-- TODO. Remove all references to versionTags in GHC 8.0 release.
@@ -120,13 +113,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
=====================================
@@ -34,7 +34,6 @@ import GHC.Internal.Types ( Bool(..), Int )
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
@@ -182,7 +181,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
=====================================
@@ -50,7 +50,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.Types (Bool(..), Int)
import GHC.Internal.Word
import GHC.Internal.IO.Device
@@ -273,7 +272,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
)
@@ -379,7 +377,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
)
@@ -396,7 +393,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.Classes (Eq, Ord)
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,279 +15,16 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.Numeric (
+module GHC.Internal.Numeric (showIntAtBase, showHex) where
- -- * 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
-
-import GHC.Internal.Base (ord, otherwise, return, unsafeChr, ($), (.), (++))
-import GHC.Internal.Classes (Eq(..), Ord(..), (&&), (||))
-import GHC.Internal.Err (error, errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
import GHC.Internal.Prim (seq)
-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
-import GHC.Internal.Types (Bool(..), Char(..), Int)
-
--- $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
+import GHC.Internal.Types (Char, Int)
+import GHC.Internal.Classes ((<), (<=))
+import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Base (($), otherwise)
+import GHC.Internal.List ((++))
+import GHC.Internal.Real (Integral, toInteger, fromIntegral, quotRem)
+import GHC.Internal.Show (ShowS, show, intToDigit)
-- ---------------------------------------------------------------------------
-- Integer printing functions
@@ -312,11 +48,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
=====================================
libraries/ghc-internal/src/GHC/Internal/Read.hs
=====================================
@@ -80,7 +80,6 @@ import GHC.Internal.Types (Bool(..), Char, Int, Ordering(..))
import GHC.Internal.Word
import GHC.Internal.List (filter)
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.ByteOrder
-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
@@ -840,6 +839,3 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })
readListPrec = readListPrecDefault
readList = readListDefault
-
--- | @since base-4.11.0.0
-deriving instance Read ByteOrder
=====================================
libraries/ghc-internal/src/GHC/Internal/Text/Read.hs deleted
=====================================
@@ -1,115 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.Text.Read
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : provisional
--- Portability : non-portable (uses Text.ParserCombinators.ReadP)
---
--- Converting strings to values.
---
--- The "Text.Read" library is the canonical library to import for
--- 'Read'-class facilities. For GHC only, it offers an extended and much
--- improved 'Read' class, which constitutes a proposed alternative to the
--- Haskell 2010 'Read'. In particular, writing parsers is easier, and
--- the parsers are much more efficient.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.Text.Read (
- -- * The 'Read' class
- Read(..),
- ReadS,
-
- -- * Haskell 2010 functions
- reads,
- read,
- readParen,
- lex,
-
- -- * New parsing functions
- module GHC.Internal.Text.ParserCombinators.ReadPrec,
- L.Lexeme(..),
- lexP,
- parens,
- readListDefault,
- readListPrecDefault,
- readEither,
- readMaybe
-
- ) where
-
-import GHC.Internal.Base (String, id, return)
-import GHC.Internal.Err (errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
-import GHC.Internal.Read
-import GHC.Internal.Data.Either
-import GHC.Internal.Text.ParserCombinators.ReadP as P
-import GHC.Internal.Text.ParserCombinators.ReadPrec
-import qualified GHC.Internal.Text.Read.Lex as L
-
--- $setup
--- >>> import Prelude
-
-------------------------------------------------------------------------
--- utility functions
-
--- | equivalent to 'readsPrec' with a precedence of 0.
-reads :: Read a => ReadS a
-reads = readsPrec minPrec
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
--- A 'Left' value indicates a parse error.
---
--- >>> readEither "123" :: Either String Int
--- Right 123
---
--- >>> readEither "hello" :: Either String Int
--- Left "Prelude.read: no parse"
---
--- @since base-4.6.0.0
-readEither :: Read a => String -> Either String a
-readEither s =
- case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
- [x] -> Right x
- [] -> Left "Prelude.read: no parse"
- _ -> Left "Prelude.read: ambiguous parse"
- where
- read' =
- do x <- readPrec
- lift P.skipSpaces
- return x
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
---
--- >>> readMaybe "123" :: Maybe Int
--- Just 123
---
--- >>> readMaybe "hello" :: Maybe Int
--- Nothing
---
--- @since base-4.6.0.0
-readMaybe :: Read a => String -> Maybe a
-readMaybe s = case readEither s of
- Left _ -> Nothing
- Right a -> Just a
-
--- | The 'read' function reads input from a string, which must be
--- completely consumed by the input process. 'read' fails with an 'error' if the
--- parse is unsuccessful, and it is therefore discouraged from being used in
--- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
---
--- >>> read "123" :: Int
--- 123
---
--- >>> read "hello" :: Int
--- *** Exception: Prelude.read: no parse
-read :: Read a => String -> a
-read s = either errorWithoutStackTrace id (readEither s)
=====================================
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
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,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’
@@ -12526,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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
@@ -12459,7 +12459,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12526,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’
@@ -12555,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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
@@ -12701,7 +12701,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12768,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’
@@ -12797,6 +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 [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 k a (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
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,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’
@@ -12526,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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/f447db931c897f660aae83e89aebb8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f447db931c897f660aae83e89aebb8…
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) 14 Apr '26
by Wolfgang Jeltsch (@jeltsch) 14 Apr '26
14 Apr '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
52e9a660 by Wolfgang Jeltsch at 2026-04-14T14:38:23+03:00
Move I/O-related `Read` instances into `base`
- - - - -
f8f410ce by Wolfgang Jeltsch at 2026-04-14T14:38:39+03: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.
- - - - -
eb44d418 by Wolfgang Jeltsch at 2026-04-14T14:40:02+03:00
Move the instance `Read ByteOrder` into `base`
- - - - -
50b5ffa3 by Wolfgang Jeltsch at 2026-04-14T14:41:16+03:00
Move the implementation of version parsing into `base`
- - - - -
b4b18ded by Wolfgang Jeltsch at 2026-04-14T14:41:34+03: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/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
- libraries/ghc-internal/src/GHC/Internal/Read.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,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
-- Module : Data.Version
-- Copyright : (c) The University of Glasgow 2004
@@ -33,3 +37,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,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
--
-- Module : GHC.ByteOrder
@@ -19,4 +23,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,8 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
-- |
--
@@ -895,3 +898,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/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,
@@ -126,10 +126,8 @@ import GHC.Internal.Base (
import GHC.Internal.Err (errorWithoutStackTrace)
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 )
import GHC.Internal.Types (
Bool(..), Char, Coercible, Float, Double, Type, type (~), type (~~),
)
@@ -688,32 +686,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,17 @@ module GHC.Internal.Data.Version (
-- * The @Version@ type
Version(..),
-- * A concrete representation of @Version@
- showVersion, parseVersion,
+ showVersion,
-- * Constructor function
makeVersion
) where
-import GHC.Internal.Classes ( Eq(..), (&&) )
-import GHC.Internal.Data.Functor ( Functor(..) )
+import GHC.Internal.Classes ( Eq ((==)), (&&) )
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
import GHC.Internal.Data.String ( String )
-import GHC.Internal.Base ( Applicative(..) )
-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 +63,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 +86,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
)
{-# DEPRECATED versionTags "See GHC ticket #2496" #-}
-- TODO. Remove all references to versionTags in GHC 8.0 release.
@@ -120,13 +113,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
=====================================
@@ -34,7 +34,6 @@ import GHC.Internal.Types ( Bool(..), Int )
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
@@ -182,7 +181,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
=====================================
@@ -50,7 +50,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.Types (Bool(..), Int)
import GHC.Internal.Word
import GHC.Internal.IO.Device
@@ -273,7 +272,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
)
@@ -379,7 +377,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
)
@@ -396,7 +393,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.Classes (Eq, Ord)
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,279 +15,16 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.Numeric (
+module GHC.Internal.Numeric (showIntAtBase, showHex) where
- -- * 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
-
-import GHC.Internal.Base (ord, otherwise, return, unsafeChr, ($), (.), (++))
-import GHC.Internal.Classes (Eq(..), Ord(..), (&&), (||))
-import GHC.Internal.Err (error, errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
import GHC.Internal.Prim (seq)
-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
-import GHC.Internal.Types (Bool(..), Char(..), Int)
-
--- $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
+import GHC.Internal.Types (Char, Int)
+import GHC.Internal.Classes ((<), (<=))
+import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Base (($), otherwise)
+import GHC.Internal.List ((++))
+import GHC.Internal.Real (Integral, toInteger, fromIntegral, quotRem)
+import GHC.Internal.Show (ShowS, show, intToDigit)
-- ---------------------------------------------------------------------------
-- Integer printing functions
@@ -312,11 +48,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
=====================================
libraries/ghc-internal/src/GHC/Internal/Read.hs
=====================================
@@ -80,7 +80,6 @@ import GHC.Internal.Types (Bool(..), Char, Int, Ordering(..))
import GHC.Internal.Word
import GHC.Internal.List (filter)
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.ByteOrder
-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
@@ -840,6 +839,3 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })
readListPrec = readListPrecDefault
readList = readListDefault
-
--- | @since base-4.11.0.0
-deriving instance Read ByteOrder
=====================================
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
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,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’
@@ -12526,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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
@@ -12459,7 +12459,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12526,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’
@@ -12555,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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
@@ -12701,7 +12701,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12768,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’
@@ -12797,6 +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 [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 k a (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
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,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’
@@ -12526,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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/4f44d8ee3b3d8b950c21159062aa60…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f44d8ee3b3d8b950c21159062aa60…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
14 Apr '26
Simon Jakobi pushed new branch wip/sjakobi/cfg-perf-test at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/cfg-perf-test
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add test for #25636
by Marge Bot (@marge-bot) 14 Apr '26
by Marge Bot (@marge-bot) 14 Apr '26
14 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
db29aade by Rodrigo Mesquita at 2026-04-14T06:46:45-04:00
Add test for #25636
The existing test behaviour of "T23146_liftedeq" changed because the
simplifier now does a bit more inlining. We can restore the previous bad
behavior by using an OPAQUE pragma.
This test doubles as a test for #25636 when run in ghci, so we add it as
such.
- - - - -
f7d08342 by Rodrigo Mesquita at 2026-04-14T06:46:45-04:00
refactor: protoBCOName is always a Name
Simplifies the code by removing the unnecessary type argument to
ProtoBCO which was always 'Name'
- - - - -
311878fa by Rodrigo Mesquita at 2026-04-14T06:46:45-04:00
Allocate static constructors for bytecode
This commit adds support for static constructors when compiling and
linking ByteCode objects.
Top-level StgRhsCon get lowered to ProtoStaticCons rather than to
ProtoBCOs. A ProtoStaticCon gets allocated directly as a data con
application on the heap (using the new primop newConApp#).
Previously, we would allocate a ProtoBCO which, when evaluated, would
PACK and return the constructor.
A few more details are given in Note [Static constructors in Bytecode].
Secondly, this commit also fixes issue #25636 which was caused by
linking *unlifted* constructors in BCO instructions as
- (1) a thunk indexing the array of BCOs in a module
- (2) which evaluated to a BCO which still had to be evaluated to
return the unlifted constructor proper.
The (2) issue has been resolved by allocating the static constructors
directly. The (1) issue can be resolved by ensuring that we allocate all
unlifted top-level constructors eagerly, and leave the knot-tying for
the lifted BCOs and top-level constructors only.
The top-level unlifted constructors are never mutually recursive, so we
can allocate them all in one go as long as we do it in topological
order. Lifted fields of unlifted constructors can still be filled by the
knot-tied lifted variables since in those fields it is fine to keep
those thunks. See Note [Tying the knot in createBCOs] for more details.
Fixes #25636
-------------------------
Metric Decrease:
LinkableUsage01
-------------------------
- - - - -
d781e163 by Rodrigo Mesquita at 2026-04-14T06:46:45-04:00
Revert "StgToByteCode: Assert that PUSH_G'd values are lifted"
This reverts commit ec26c54d818e0cd328276196930313f66b780905.
Ever since f7a22c0f4e9ae0dc767115d4c53fddbd8372b777, we now do support
and will link top-level unlifted constructors into evaluated and
properly tagged values which we can reference with PUSH_G.
This assertion is no longer true and triggered a failure in T25636
- - - - -
ca9c1cdd by Rodrigo Mesquita at 2026-04-14T06:46:45-04:00
refactor: Tag more remote Ptrs as RemotePtr
Pure refactor which improves the API of
- GHC.ByteCode.Linker
- GHC.Runtime.Interpreter
- GHC.Runtime.Interpreter.Types.SymbolCache
by using `RemotePtr` for more functions which used to return `Ptr`s that
could potentially be in a foreign process. E.g. `lookupIE`,
`lookupStaticPtr`, etc...
- - - - -
24bd9bce by Rodrigo Mesquita at 2026-04-14T06:46:45-04:00
Add float# and subword tests for #25636
These tests cover that static constructors in bytecode work correctly
for Float# and subword values (Word8#, Word16#)
- - - - -
184bb0ff by Rodrigo Mesquita at 2026-04-14T06:46:45-04:00
test: Validate topoSort logic in createBCOs
This test validates that the topological sorting and ordering of the
unlifted constructors and lifted constructors in `createBCOs` is
correct.
See `Note [Tying the knot in createBCOs]` for why tying the knot for the
created BCOs is slightly difficult and why the topological sorting is
necessary.
This test fails when `let topoSortedObjs = topSortObjs objs` is
substituted by `let topoSortedObjs = zip [0..] objs`, thus witnessing
the toposort logic is correct and necessary.
The test calls the ghci `createBCOs` directly because it is currently
impossible to construct in Source Haskell a situation where a top-level
static unlifted constructor depends on another (we don't have top-level
unlifted constructors except for nullary constructors like `Leaf ::
(UTree :: UnliftedType)`).
This is another test for fix for #25636
- - - - -
eeff6c70 by Simon Jakobi at 2026-04-14T06:46:47-04:00
Improve tests for `elem`
...in order to simplify the work on #27096.
* Improve T17752 by including the Core output in golden files, checking
both -O1 and -O2.
* Add tests for fusion and no-fusion cases.
Fixes #27101.
- - - - -
68 changed files:
- + changelog.d/T25636
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/Liveness.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types/SymbolCache.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/DataCon.hs
- compiler/GHC/StgToCmm/Layout.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- + libraries/base/tests/perf/ElemFusionUnknownList.hs
- + libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr
- + libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr
- + libraries/base/tests/perf/ElemNoFusion.hs
- + libraries/base/tests/perf/ElemNoFusion_O1.stderr
- + libraries/base/tests/perf/ElemNoFusion_O2.stderr
- − libraries/base/tests/perf/Makefile
- libraries/base/tests/perf/T17752.hs
- − libraries/base/tests/perf/T17752.stdout
- + libraries/base/tests/perf/T17752_O1.stderr
- + libraries/base/tests/perf/T17752_O2.stderr
- libraries/base/tests/perf/all.T
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/include/Rts.h
- rts/include/rts/storage/ClosureMacros.h
- rts/include/stg/MiscClosures.h
- testsuite/tests/codeGen/should_run/T23146/T23146_liftedeq.hs
- + testsuite/tests/codeGen/should_run/T23146/T25636.script
- + testsuite/tests/codeGen/should_run/T23146/T25636.stdout
- testsuite/tests/codeGen/should_run/T23146/all.T
- + testsuite/tests/codeGen/should_run/T25636a/T25636a.script
- + testsuite/tests/codeGen/should_run/T25636a/T25636a.stdout
- + testsuite/tests/codeGen/should_run/T25636a/all.T
- + testsuite/tests/codeGen/should_run/T25636b/T25636b.script
- + testsuite/tests/codeGen/should_run/T25636b/T25636b.stdout
- + testsuite/tests/codeGen/should_run/T25636b/all.T
- + testsuite/tests/codeGen/should_run/T25636c/T25636c.script
- + testsuite/tests/codeGen/should_run/T25636c/T25636c.stdout
- + testsuite/tests/codeGen/should_run/T25636c/all.T
- + testsuite/tests/codeGen/should_run/T25636d/T25636d.script
- + testsuite/tests/codeGen/should_run/T25636d/T25636d.stdout
- + testsuite/tests/codeGen/should_run/T25636d/all.T
- + testsuite/tests/codeGen/should_run/T25636e/T25636e.script
- + testsuite/tests/codeGen/should_run/T25636e/T25636e.stdout
- + testsuite/tests/codeGen/should_run/T25636e/all.T
- testsuite/tests/ghci.debugger/scripts/print034.stdout
- + testsuite/tests/ghci/should_run/T25636f.hs
- + testsuite/tests/ghci/should_run/T25636f.stdout
- testsuite/tests/ghci/should_run/all.T
- 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/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a5b78454d64e18e8b201e1332ecab…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a5b78454d64e18e8b201e1332ecab…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Suppress desugaring warnings in the pattern match checker
by Marge Bot (@marge-bot) 14 Apr '26
by Marge Bot (@marge-bot) 14 Apr '26
14 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
d419e972 by Luite Stegeman at 2026-04-13T15:16:04-04:00
Suppress desugaring warnings in the pattern match checker
Avoid duplicating warnings from the actual desugaring pass.
fixes #25996
- - - - -
c5b80dd0 by Phil de Joux at 2026-04-13T15:16:51-04:00
Typo ~/ghc/arch-os-version/environments
- - - - -
71462fff by Luite Stegeman at 2026-04-13T15:17:38-04:00
add changelog entry for #26233
- - - - -
83fe8164 by Rodrigo Mesquita at 2026-04-14T04:15:39-04:00
Add test for #25636
The existing test behaviour of "T23146_liftedeq" changed because the
simplifier now does a bit more inlining. We can restore the previous bad
behavior by using an OPAQUE pragma.
This test doubles as a test for #25636 when run in ghci, so we add it as
such.
- - - - -
28e94ab3 by Rodrigo Mesquita at 2026-04-14T04:15:39-04:00
refactor: protoBCOName is always a Name
Simplifies the code by removing the unnecessary type argument to
ProtoBCO which was always 'Name'
- - - - -
337be959 by Rodrigo Mesquita at 2026-04-14T04:15:40-04:00
Allocate static constructors for bytecode
This commit adds support for static constructors when compiling and
linking ByteCode objects.
Top-level StgRhsCon get lowered to ProtoStaticCons rather than to
ProtoBCOs. A ProtoStaticCon gets allocated directly as a data con
application on the heap (using the new primop newConApp#).
Previously, we would allocate a ProtoBCO which, when evaluated, would
PACK and return the constructor.
A few more details are given in Note [Static constructors in Bytecode].
Secondly, this commit also fixes issue #25636 which was caused by
linking *unlifted* constructors in BCO instructions as
- (1) a thunk indexing the array of BCOs in a module
- (2) which evaluated to a BCO which still had to be evaluated to
return the unlifted constructor proper.
The (2) issue has been resolved by allocating the static constructors
directly. The (1) issue can be resolved by ensuring that we allocate all
unlifted top-level constructors eagerly, and leave the knot-tying for
the lifted BCOs and top-level constructors only.
The top-level unlifted constructors are never mutually recursive, so we
can allocate them all in one go as long as we do it in topological
order. Lifted fields of unlifted constructors can still be filled by the
knot-tied lifted variables since in those fields it is fine to keep
those thunks. See Note [Tying the knot in createBCOs] for more details.
Fixes #25636
-------------------------
Metric Decrease:
LinkableUsage01
-------------------------
- - - - -
ec5992e2 by Rodrigo Mesquita at 2026-04-14T04:15:40-04:00
Revert "StgToByteCode: Assert that PUSH_G'd values are lifted"
This reverts commit ec26c54d818e0cd328276196930313f66b780905.
Ever since f7a22c0f4e9ae0dc767115d4c53fddbd8372b777, we now do support
and will link top-level unlifted constructors into evaluated and
properly tagged values which we can reference with PUSH_G.
This assertion is no longer true and triggered a failure in T25636
- - - - -
cf42d508 by Rodrigo Mesquita at 2026-04-14T04:15:40-04:00
refactor: Tag more remote Ptrs as RemotePtr
Pure refactor which improves the API of
- GHC.ByteCode.Linker
- GHC.Runtime.Interpreter
- GHC.Runtime.Interpreter.Types.SymbolCache
by using `RemotePtr` for more functions which used to return `Ptr`s that
could potentially be in a foreign process. E.g. `lookupIE`,
`lookupStaticPtr`, etc...
- - - - -
a3c12da8 by Rodrigo Mesquita at 2026-04-14T04:15:40-04:00
Add float# and subword tests for #25636
These tests cover that static constructors in bytecode work correctly
for Float# and subword values (Word8#, Word16#)
- - - - -
b0c9fd22 by Rodrigo Mesquita at 2026-04-14T04:15:40-04:00
test: Validate topoSort logic in createBCOs
This test validates that the topological sorting and ordering of the
unlifted constructors and lifted constructors in `createBCOs` is
correct.
See `Note [Tying the knot in createBCOs]` for why tying the knot for the
created BCOs is slightly difficult and why the topological sorting is
necessary.
This test fails when `let topoSortedObjs = topSortObjs objs` is
substituted by `let topoSortedObjs = zip [0..] objs`, thus witnessing
the toposort logic is correct and necessary.
The test calls the ghci `createBCOs` directly because it is currently
impossible to construct in Source Haskell a situation where a top-level
static unlifted constructor depends on another (we don't have top-level
unlifted constructors except for nullary constructors like `Leaf ::
(UTree :: UnliftedType)`).
This is another test for fix for #25636
- - - - -
4a5b7845 by Simon Jakobi at 2026-04-14T04:15:41-04:00
Improve tests for `elem`
...in order to simplify the work on #27096.
* Improve T17752 by including the Core output in golden files, checking
both -O1 and -O2.
* Add tests for fusion and no-fusion cases.
Fixes #27101.
- - - - -
75 changed files:
- + changelog.d/T25636
- + changelog.d/fix-duplicate-pmc-warnings
- + changelog.d/fix-ghci-duplicate-warnings-26233
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/Liveness.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types/SymbolCache.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/DataCon.hs
- compiler/GHC/StgToCmm/Layout.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- docs/users_guide/packages.rst
- + libraries/base/tests/perf/ElemFusionUnknownList.hs
- + libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr
- + libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr
- + libraries/base/tests/perf/ElemNoFusion.hs
- + libraries/base/tests/perf/ElemNoFusion_O1.stderr
- + libraries/base/tests/perf/ElemNoFusion_O2.stderr
- − libraries/base/tests/perf/Makefile
- libraries/base/tests/perf/T17752.hs
- − libraries/base/tests/perf/T17752.stdout
- + libraries/base/tests/perf/T17752_O1.stderr
- + libraries/base/tests/perf/T17752_O2.stderr
- libraries/base/tests/perf/all.T
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/include/Rts.h
- rts/include/rts/storage/ClosureMacros.h
- rts/include/stg/MiscClosures.h
- testsuite/tests/codeGen/should_run/T23146/T23146_liftedeq.hs
- + testsuite/tests/codeGen/should_run/T23146/T25636.script
- + testsuite/tests/codeGen/should_run/T23146/T25636.stdout
- testsuite/tests/codeGen/should_run/T23146/all.T
- + testsuite/tests/codeGen/should_run/T25636a/T25636a.script
- + testsuite/tests/codeGen/should_run/T25636a/T25636a.stdout
- + testsuite/tests/codeGen/should_run/T25636a/all.T
- + testsuite/tests/codeGen/should_run/T25636b/T25636b.script
- + testsuite/tests/codeGen/should_run/T25636b/T25636b.stdout
- + testsuite/tests/codeGen/should_run/T25636b/all.T
- + testsuite/tests/codeGen/should_run/T25636c/T25636c.script
- + testsuite/tests/codeGen/should_run/T25636c/T25636c.stdout
- + testsuite/tests/codeGen/should_run/T25636c/all.T
- + testsuite/tests/codeGen/should_run/T25636d/T25636d.script
- + testsuite/tests/codeGen/should_run/T25636d/T25636d.stdout
- + testsuite/tests/codeGen/should_run/T25636d/all.T
- + testsuite/tests/codeGen/should_run/T25636e/T25636e.script
- + testsuite/tests/codeGen/should_run/T25636e/T25636e.stdout
- + testsuite/tests/codeGen/should_run/T25636e/all.T
- + testsuite/tests/deSugar/should_compile/T25996.hs
- + testsuite/tests/deSugar/should_compile/T25996.stderr
- testsuite/tests/deSugar/should_compile/all.T
- testsuite/tests/ghci.debugger/scripts/print034.stdout
- + testsuite/tests/ghci/should_run/T25636f.hs
- + testsuite/tests/ghci/should_run/T25636f.stdout
- testsuite/tests/ghci/should_run/all.T
- 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/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70a21718f27fe1b7dc62cd57273594…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70a21718f27fe1b7dc62cd57273594…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/libDir-setting] Add config setting for LibDir (#19174)
by Sven Tennie (@supersven) 14 Apr '26
by Sven Tennie (@supersven) 14 Apr '26
14 Apr '26
Sven Tennie pushed to branch wip/supersven/libDir-setting at Glasgow Haskell Compiler / GHC
Commits:
71af2f26 by Sven Tennie at 2026-04-14T07:50:00+02:00
Add config setting for LibDir (#19174)
Previously, the libDir was derived from topDir. This won't work for
inplace stage2 cross-compilers where binaries and libraries are in
different stage dirs (`_build/stage1/` for executables and
`_build/stage2` for libraries).
- - - - -
7 changed files:
- + changelog.d/libdir-setting
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- hadrian/src/Rules/Generate.hs
Changes:
=====================================
changelog.d/libdir-setting
=====================================
@@ -0,0 +1,15 @@
+section: packaging
+synopsis: Added a new configuration setting for ``LibDir`` to support inplace
+ stage2 cross-compilers where binaries and libraries are in different stage
+ directories.
+issues: #19174
+mrs: !15716
+
+description: {
+ Previously, the `libDir` was always derived from `topDir`, which won't work
+ for inplace stage2 cross-compilers where executables are in `_build/stage1/`
+ and libraries are in `_build/stage2/`. Now, `LibDir` can be set, but is by
+ default derived from `topDir`. This facilitates the mentioned behaviour
+ while leaving the binary distribution code untouched. This is a refactoring
+ step that does not change actual behaviour.
+}
=====================================
compiler/GHC/Driver/Config/Interpreter.hs
=====================================
@@ -17,8 +17,8 @@ import System.Directory
initInterpOpts :: DynFlags -> IO InterpOpts
initInterpOpts dflags = do
- wasm_dyld <- makeAbsolute $ topDir dflags </> "dyld.mjs"
- js_interp <- makeAbsolute $ topDir dflags </> "ghc-interp.js"
+ wasm_dyld <- makeAbsolute $ libDir dflags </> "dyld.mjs"
+ js_interp <- makeAbsolute $ libDir dflags </> "ghc-interp.js"
pure $ InterpOpts
{ interpExternal = gopt Opt_ExternalInterpreter dflags
, interpProg = pgm_i dflags
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -60,7 +60,7 @@ module GHC.Driver.DynFlags (
-- ** System tool settings and locations
programName, projectVersion,
- ghcUsagePath, ghciUsagePath, topDir, toolDir,
+ ghcUsagePath, ghciUsagePath, topDir, libDir, toolDir,
versionedAppDir, versionedFilePath,
extraGccViaCFlags, globalPackageDatabasePath,
@@ -1508,6 +1508,8 @@ ghciUsagePath :: DynFlags -> FilePath
ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
topDir :: DynFlags -> FilePath
topDir dflags = fileSettings_topDir $ fileSettings dflags
+libDir :: DynFlags -> FilePath
+libDir dflags = fileSettings_libDir $ fileSettings dflags
toolDir :: DynFlags -> Maybe FilePath
toolDir dflags = fileSettings_toolDir $ fileSettings dflags
extraGccViaCFlags :: DynFlags -> [String]
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3651,7 +3651,6 @@ compilerInfo dflags
-- Whether or not GHC was compiled using -prof
("GHC Profiled", showBool hostIsProfiled),
("Debug on", showBool debugIsOn),
- ("LibDir", topDir dflags),
-- This is always an absolute path, unlike "Relative Global Package DB" which is
-- in the settings file.
("Global Package DB", globalPackageDatabasePath dflags)
=====================================
compiler/GHC/Settings.hs
=====================================
@@ -184,6 +184,7 @@ data FileSettings = FileSettings
, fileSettings_toolDir :: Maybe FilePath -- ditto
, fileSettings_topDir :: FilePath -- ditto
, fileSettings_globalPackageDatabase :: FilePath
+ , fileSettings_libDir :: FilePath
}
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -28,6 +28,7 @@ import GHC.Toolchain.Program
import GHC.Toolchain
import GHC.Data.Maybe
import Data.Bifunctor (Bifunctor(second))
+import Data.Either (fromRight)
data SettingsError
= SettingsError_MissingData String
@@ -148,6 +149,13 @@ initSettings top_dir = do
baseUnitId <- getSetting_raw "base unit-id"
+ -- LibDir is optional. If not set, derive it from topDir. This allows
+ -- bindists to work without explicitly setting LibDir, but gives us the
+ -- option to override it for inplace test compilers (the "stage2
+ -- cross-compiler" scenario).
+ let lib_dir = fromRight top_dir $
+ getRawFilePathSetting top_dir settingsFile mySettings "LibDir"
+
return $ Settings
{ sGhcNameVersion = GhcNameVersion
{ ghcNameVersion_programName = "ghc"
@@ -159,6 +167,7 @@ initSettings top_dir = do
, fileSettings_ghciUsagePath = ghci_usage_msg_path
, fileSettings_toolDir = mtool_dir
, fileSettings_topDir = top_dir
+ , fileSettings_libDir = lib_dir
, fileSettings_globalPackageDatabase = globalpkgdb_path
}
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -25,6 +25,7 @@ import Utilities
import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp))
import GHC.Platform.ArchOS
import Settings.Program (ghcWithInterpreter)
+import Hadrian.Oracles.Path
-- | Track this file to rebuild generated files whenever it changes.
trackGenerateHs :: Expr ()
@@ -481,6 +482,16 @@ generateSettings settingsFile = do
Stage3 -> pkgUnitId Stage2 base
let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path
+ make_absolute rel_path = do
+ abs_path <- liftIO (makeAbsolute rel_path)
+ fixAbsolutePathOnWindows abs_path
+
+ -- E.g. the Stage2 compiler lives in _build/stage1
+ -- So, we need to decrement the stage to get the correct directory
+ stage_dir_stage = predStage stage
+
+ rel_lib_topDir :: FilePath <- expr $ stageLibPath stage_dir_stage
+ lib_topDir :: FilePath <- expr $ make_absolute rel_lib_topDir
settings <- traverse sequence $
[ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
@@ -488,6 +499,7 @@ generateSettings settingsFile = do
, ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
, ("Relative Global Package DB", pure rel_pkg_db)
, ("base unit-id", pure base_unit_id)
+ , ("LibDir", pure lib_topDir)
]
let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
pure $ case settings of
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71af2f264aa3682e140bd195755fbde…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71af2f264aa3682e140bd195755fbde…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
13 Apr '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC
Commits:
3dc8d56d by Simon Peyton Jones at 2026-04-14T00:35:11+01:00
Onward
This version bootstraps. And the documentation in GHC.Builtin is much
better
- - - - -
18 changed files:
- compiler/GHC/Builtin.hs
- compiler/GHC/Builtin/KnownKeys.hs
- compiler/GHC/Builtin/KnownOccs.hs
- compiler/GHC/HsToCore/ListComp.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Deriv/Functor.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Data/Fixed.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/GHC/KnownKeyNames.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
Changes:
=====================================
compiler/GHC/Builtin.hs
=====================================
@@ -93,6 +93,18 @@ import Data.Maybe
{- Note [Overview of known-key entities]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are three kinds of entities that GHC knows something about.
+ * known-occ entities
+ * known-key entities
+ * wired-in entities
+It is pretty easy, cheap, and robust to add a new known-occ entity; but GHC
+does not know much about it. In contrast, it is expensive and relatively
+fragile to add a new wired-in entity; but in exchange GHC knows a lot about
+it. Known-key entities are in the middle. Use the cheapest one that does
+what you need!
+
+Here are more details.
+
A "wired-in" entity:
* Its Unique, OccName
* Its defining module
@@ -103,7 +115,7 @@ A "wired-in" entity:
knowledge precisely reflects the code in the library.
A "known-key" entity:
- * Its Unique and OccName are baked into GHC
+ * Its Unique and OccName are baked into GHC. Its Unique is called a KnownKey.
* It is exported by base:GHC.KnownKeyNames
* But that's all that GHC knows about it
In particular, GHC does /not/ know in which module the entity is defined.
@@ -115,7 +127,7 @@ A "known-key" entity:
to GHC. It's not hard.
A "known-occ" entity:
- * Its OccName is baked into GHC
+ * Its OccName is baked into GHC -- we call it a KnownOcc
* It is exported by base:GHC.KnownKeyNames
* But that's all that GHC knows about it
In particular, GHC does /not/ know in which module the entity is defined,
@@ -127,13 +139,15 @@ A "known-occ" entity:
It is significantly easier to add a known-occ entity to GHC than a known-key
entity, so we use known-occ entities whenever we can.
+ Every known-key entity is also a known-occ entity, but not vice versa.
+
When do we use each of these?
-* We use a wired-in entity when we must. E.g. `boolTy` uses the wired-in TyCon
- `boolTyCon`. We want a static `boolTy` so we can use it in `mkIfThenElse`,
- which is a pure function with no monad in sight.
+* WIRED-IN. We use a wired-in entity when we want a statically-defined Type or TyCon.
+ E.g. `boolTy` uses the wired-in TyCon `boolTyCon`. We want a static `boolTy` so
+ we can use it in `mkIfThenElse`, which is a pure function with no monad in sight.
-* We use a known-key entity when we want a fast test to say, for example,
+* KNOWN-KEY. We use a known-key entity when we want a fast test to say, for example,
"are you /the/ Typeable class?", not some other class that happens to be called
"Typeable". It checks this using
cls `hasKnownKey` typeableClassKey
@@ -142,76 +156,73 @@ When do we use each of these?
where GHC.Builtin.KnownKeys.typeableClassKey is the statically chosen unique
for `Typeable`. See `GHC.Tc.Instance.Class.matchGlobalInst`
-* We use a known-occ entity when we just want to refer to the thing in, say,
- the code generated for a `deriving` clause.
-
-
-
-
-* Very similarly, see `GHC.Tc.Deriv.Utils.stockSideConditions`, which checks if a
+ Very similarly, see `GHC.Tc.Deriv.Utils.stockSideConditions`, which checks if a
class is suitable for stock deriving.
-Here is why GHC might want to refer to a known-occ entity:
-
-* When desugaring a Template Haskell quotation, in GHC.HsToCore.Quote, GHC
- must generate Core that mentions a myriad of functions defined in
- ghc-internal:GHC.Internal.TH.Lib, such as `varE`, `conE`, `funD`, etc etc.
- They don't need a fixed /unique/, but we still need to find them, so we use
- their /OccName/. They are "known-occ" entities.
-
- To do the lookup it uses
- dsLookupKnownOccId :: KnownOcc -> DsM TyThing
-
-* When dealing with `deriving` clauses, GHC generates (LHsBinds GhcPs) bindings,
- and then renames and typechecks them. These bindings refer to a myriad of
- identifiers, such as `(==)`, `(>)`, `inRange`, and so on. Again GHC does not
- need to know a statically-known unique for them, but it does need to find them
- so it uses known
-
-* When desugaring, the desugarer wants to refer to a particular
- class, type, or function. It does this via (e.g.)
- dsLookupKnownOccTyCon :: KnownOcc -> DsM TyCon
- or
- dsLookupKnownKeyTyCon :: KnownKey -> DsM TyCon
- It doesn't really matter which we use.
-
-* In a very similar way, for type-class defauting GHC has built-in defaulting behaviour
- for Num, IsString, etc. It gets hold of these classes via their known key, via
- tcLookupKnownKeyClass :: KnownKey -> TcM Class
- See GHC.Tc.Gen.Default.tcDefaultDecls
+ * For type-class defauting GHC has built-in defaulting behaviour
+ for Num, IsString, etc. It gets hold of these classes via their known key, via
+ tcLookupKnownKeyClass :: KnownKey -> TcM Class
+ See GHC.Tc.Gen.Default.tcDefaultDecls.
+
+* KNOWN_OCC. We use a known-occ entity when we just want to /refer/ to the thing in,
+ say, the code generated for a `deriving` clause. Here is why GHC might want to
+ refer to a known-occ entity:
+
+ * When desugaring a Template Haskell quotation, in GHC.HsToCore.Quote, GHC
+ must generate Core that mentions a myriad of functions defined in
+ ghc-internal:GHC.Internal.TH.Lib, such as `varE`, `conE`, `funD`, etc etc.
+ They don't need a fixed /unique/, but we still need to find them, so we use
+ their /OccName/. They are "known-occ" entities.
+
+ To do the lookup it uses
+ dsLookupKnownOccId :: KnownOcc -> DsM TyThing
+
+ * When dealing with `deriving` clauses, GHC generates (LHsBinds GhcPs) bindings,
+ and then renames and typechecks them. These bindings refer to a myriad of
+ identifiers, such as `(==)`, `(>)`, `inRange`, and so on. Again GHC does not
+ need to know a statically-known unique for them, but it does need to find them
+ so it uses known
+
+ * When desugaring, the desugarer wants to refer to a particular
+ class, type, or function. It does this via (e.g.)
+ dsLookupKnownOccTyCon :: KnownOcc -> DsM TyCon
+ or
+ dsLookupKnownKeyTyCon :: KnownKey -> DsM TyCon
+ It doesn't really matter which we use.
To implement all this, here are the moving parts:
+* INVARIANT (KnownEntityInvariant): It is a requirement that all known-key and known-occ
+ entities have distinct OccNames. We could have multiple name-spaces, but in practice
+ this is not an onerous restriction. But see Note [Tricky known-occ cases] in
+ GHC.Builtin.KnownOccs for some awkward cases.
+
* Each known-key name has a /statically-chosen/ unique, fixed in GHC.Builtin.KnownKeys.
e.g. eqClassKey :: KnownKey
eqClassKey = mkPreludeClassUnique 3
* All the known-key names are gathered in one table:
- knownKeyTable :: [(OccName, KnownKey)]
+ knownKeyTable :: [(KnownOcc, KnownKey)]
knownKeyTable
= [ (mkTcOcc "Rational", rationalTyConKey)
, (mkTcOcc "Eq", eqClassKey)
... etc ... ]
- INVARIANT (KnownKeyInvariant): It is a requirement that all known-key names
- have distinct OccNames. (We could have multiple name-spaces, but in practice
- this is not an onerous restriction.)
-
-* Because of (KnownKeyInvariant) we can turn that table into two mappings:
+* Because of (KnownEntityInvariant) we can turn that table into two mappings:
knownKeyOccMap :: OccEnv KnownKey
knownKeyOccMap = mkOccEnv knownKeyTable
- knownKeyUniqMap :: UniqFM KnownKey OccName
+ knownKeyUniqMap :: UniqFM KnownKey KnownOcc
-* A new module `base:GHC.KnownKeyNames` exports all the known-key names.
+* A special module `base:GHC.KnownKeyNames` exports all the known-key names.
There is nothing special about this module except that GHC knows its
name and can import it.
In effect, the `mi_exports` of `GHC/KnownKeyNames.hi` tells GHC where each
known-key name is defined.
- This is one reason for (KnownKeyInvariant): an export list cannot have two
+ This is a big reason for (KnownEntityInvaroiant): an export list cannot have two
entities with the same OccName.
* There are three flags that control the treatment of known-key names:
@@ -220,17 +231,25 @@ To implement all this, here are the moving parts:
-fexclude-known-key-define=wombat See wrinkle (KKN2)
Details in the following bullets.
-* Known-key name lookup (normal case: KKNS_FromModule)
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- In normal client code, suppose the desugarer calls `dsLookupKnownKeyTyCon`
- on `rationalTyConKey`. Then, in `loadKnownKeyOccMap`
+* Known-key or known-occ lookup (normal case: KKNS_FromModule)
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ In normal client code, suppose the desugarer calls
+ dsLookupKnownKeyTyCon rationalTyConKey
+ or
+ dsLookupKnownOccTyCon rationalTyConOcc
+
+ Then, in `loadKnownKeyOccMaps`
* GHC imports GHC.KnownKeyNames, i.e. looks for `GHC/KnownKeyNames.hi`
- * Assuming this is successful, GHC usees its `mi_exports` to builds a mapping
- `KnownKeyNameMap` from each known-key unique to the Name of the entity.
- * It stashes this map in the `eps_known_keys` field of the ExternalPackageState
+
+ * Assuming this is successful, GHC uses its `mi_exports` to build `KnownKeyNameMaps`,
+ which has (a) a map from the KnownKey of each known-key entity to its Name
+ (b) a map from the KnownOcc of each known-occ entity to its Name
+
+ * It stashes these maps in the `eps_known_keys` field of the ExternalPackageState
so that it doesn't need to repeat the exercise.
- Now it can simplhy look up `rationalTyConKey` in the `eps_known_keys`. Easy!
- See `dsLookupKnownKeyName`.
+
+ Now it can simply look up `rationalTyConKey` in the `eps_known_keys`. Easy!
+ See `GHC.Iface.Load.lookupKnownKeyThing` and `lookupKnownOccThing`.
* Known-key name lookup (base case: KKNS_InScope)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -238,14 +257,26 @@ To implement all this, here are the moving parts:
GHC.KnownKeyNames has not yet been compiled! Instead, we use whatever is in scope with
the desired `OccName`, rather like `-XRebindableSyntax`.
- See the `KnownKeyNameSource` argument to `lookupKnownKeyName`. When compiling modules
+ See the `KnownKeyNameSource` argument to `lookupKnownOccThing`. When compiling modules
in `ghc-internal` or `base`:
+
* We switch on -frebindable-known-key-names
- * That ensures that we pass `KKNS_InScope` to `lookupKnownKeyName`
- * The latter now looks in the GlobalRdrEnv it is passed.
- This does mean that in `base` and `ghc-internal` we occasionally need an extra import
- to bring into scope some entities that are needed by `dsLookupKnownKeyTyCon` etc.
+ * That ensures that we pass `KKNS_InScope gbl_rdr_env` to `lookupKnownKeyThing`
+
+ * Suppose we are looking up the known-occ entity `wombat`. The key function is
+ `lookupKnownGRE`:
+ * First we look in the `gbl_rdr_env` for the qualified name `Rebindable.wombat`.
+ If we find a unique hit, choose it.
+ * Otherwise we look in `gbl_rdr_env` for the /unqualified/ name `wombat`.
+ If we find a unique hit, choose it.
+
+ This plan means that we can have an unrelated local binding for `wombat` and still
+ not get confused provided we import Rebindable.wombat.
+
+ This does mean that in `base` and `ghc-internal` we need quite a few extra imports that
+ look like import GHC.InternalNum as Rebindable
+ or import qualified GHC.Internal.Num as Rebindable
See also wrinkle (KKN1)
* Defining known-key names
@@ -267,8 +298,13 @@ To implement all this, here are the moving parts:
Wrinkles
-(KKN1) We need some special treatment of unused-import warnings.
- See (UI1) in Note [Unused imports] in GHC.Rename.Names
+(KKN1) An import declaration may look entirely unused, if it is there solely to
+ bring a known-occ name into scope for the desugarer. Why? Becuase we only generate
+ usage information, to drive unused-import warnings, in the renamer and typechecker.
+ Not, currently, the desugarer.
+
+ So we simply suppress an unused-import-decl warning if it has a "as Rebindable"
+ qualifier. See (UI1) in Note [Unused imports] in GHC.Rename.Names
(KKN2) The flag `-fdefines-known-key-names` is module-wide. But what if that module
happens to define an entity that /isn't/ a known-key entity, but /does/ share the
@@ -284,7 +320,7 @@ Wrinkles
So we compile GHC.Internal.Data.Foldable with
-fexclude-known-key-define=toList
-(KKN3) You don't need need to export the wired-in entities from GHC.KnownKeyNames
+(KKN3) You don't need need to export wired-in entities from GHC.KnownKeyNames
because we (should) never look up a wired-in name via its key. That is,
`GHC.Iface.Load.lookupKnownKeyName` should never be called on the key of
a wired-in name.
@@ -292,8 +328,6 @@ Wrinkles
Alternative: export all wired-in entities from GHC.KnownKeyNames. But that
would simply bloat the interface for no good reason.
-(KKN4) Typeable binds early in tc
-
Note [Recipe for adding a known-occ name]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To make `wombat` into a known-occ name, you must ensure that:
@@ -302,12 +336,15 @@ To make `wombat` into a known-occ name, you must ensure that:
* In any module in `base` or `ghc-internal` (which are compiled with
-frebindable-known-key-names), in which `wombat` is needed, you must ensure
- that `wombat` is in scope by saying `import M( wombat )`.
+ that `wombat` is in scope by saying `import M( wombat )`, or
+ import qualified M as Rebindable( wombat )
+
+ Using the `as Rebindable` qualifier will suppress any unused-import-decl warnings.
- You do not need to import the module in which `wombat` is /defined/, although
- you may. It is enough simply to bring `wombat` in scope by importing a
- module that re-exports. You can even import `GHC.KnownKeyNames`, if that does
- not create a module loop!
+ You do not need to import the precise module in which `wombat` is /defined/,
+ although you may. It is enough simply to bring `wombat` in scope by importing a
+ module that re-exports it. You can even import `GHC.KnownKeyNames`, if doing so
+ does not create a module loop!
Note [Recipe for adding a known-key name]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -329,17 +366,9 @@ To make `wombat` into a known-key name, you must ensure that:
entry for `wombat`
(mkVarOcc "wombat", wombatKey)
-* In any module in `base` or `ghc-internal` (which are compiled with
- -frebindable-known-key-names), you must ensure that `wombat` is in scope
- by saying `import M( wombat )`.
-
- If you just say `import M` you may get a "unused import" warning; that
- warning is suppressed for known-key names if you import `wombat` by name.
-
- You do not need to import the module in which `wombat` is /defined/, although
- you may. It is enough simply to bring `wombat` in scope by importing a
- module that re-exports. You can even import `GHC.KnownKeyNames`, if that does
- not create a module loop!
+* Just like known-occ names, above in any module in `base` or `ghc-internal` (which
+ are compiled with -frebindable-known-key-names), you must ensure that `wombat` is
+ in scope by saying `import M( wombat )`.
-}
allKnownOccs :: OccSet
=====================================
compiler/GHC/Builtin/KnownKeys.hs
=====================================
@@ -219,7 +219,6 @@ knownKeyTable
-- Class Functor
, (mkTcOcc "Functor", functorClassKey)
, (mkVarOcc "fmap", fmapClassOpKey)
- , (mkVarOcc "map", mapIdKey)
-- Class Monad, MonadFix, MonadZip
, (mkTcOcc "Monad", monadClassKey)
@@ -254,7 +253,6 @@ knownKeyTable
, (mkVarOcc "dataToTag#", dataToTagClassOpKey)
-- Lists
- , (mkVarOcc "foldr", foldrIdKey)
, (mkVarOcc "build", buildIdKey)
-- Records
=====================================
compiler/GHC/Builtin/KnownOccs.hs
=====================================
@@ -43,6 +43,49 @@ mechanisms:
to make an ExactOcc RdrName for the thing. We use the latter for
known-key things, merely to avoid duplicating knowledge of the KnownOcc
+Note [Tricky known-occ cases]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A few known-occ entities are a bit tricky, because ghc-internal has distinct
+entities that share the same occ-name. For these, we must be careful to
+have the correct one in scope when looking up a known-occ name.
+
+* Data types involving Fixity. We have
+ module GHC.Internal.Data.Data where
+ data Fixity = Infix | Prefix
+ module GHC.Internal.Generics where
+ data Fixity = Prefix | Infix Associativity Int
+ module GHC.Internal.TH.Syntax where
+ data Fixity = Fixity Int FixityDirection
+
+ Of these, Fixity(Infix,Prefix) from GHC.Internal.Data.Data are the
+ known-occ entities, used in derived Data instances; the other are not.
+
+* `prec`: we have
+ module GHC.Internal.Text.ParserCombinators.ReadPrec where
+ prec :: Prec -> ReadPrec a -> ReadPrec a
+ module GHC.Internal.Generics where
+ prec :: Fixity -> Int
+
+ Of these, the former is the known-occ entity, used in the derived instances
+ for Read. The latter is not.
+
+* `foldr`: we have
+ module GHC.Internal.Data.Foldable where
+ class Foldable t where
+ foldr :: (a -> b -> b) -> b -> t a -> b
+ module GHC.Internal.Base where
+ foldr :: (a -> b -> b) -> b -> [a] -> b
+
+ This one is particularly annoying because
+ * We need the Foldable `foldr` to be known-occ so we can refer to it in
+ derived Foldable instances
+ * We need the list `foldr` to be known-occ so we can refer to it when
+ desugaring list comprehensions.
+
+ So we define an alias
+ module GHC.Internal.Base where
+ foldrList = foldr
+ make `foldrList` known-occ, and refer to that in desugaring list comprehensions.
-}
@@ -107,8 +150,10 @@ rightDataConOcc = mkDataOcc "Right"
voidTyConOcc = mkTcOcc "Void"
rationalTyConOcc = mkTcOcc "Rational"
-composeIdOcc :: KnownOcc
-composeIdOcc = mkVarOcc "."
+composeIdOcc, mapIdOcc, foldrListIdOcc :: KnownOcc
+composeIdOcc = mkVarOcc "."
+mapIdOcc = mkVarOcc "map"
+foldrListIdOcc = mkVarOcc "foldrList"
fromStaticPtrClassOpOcc :: KnownOcc
fromStaticPtrClassOpOcc = mkVarOcc "fromStaticPtr"
@@ -128,16 +173,9 @@ enumFromToClassOpOcc = mkVarOcc "enumFromTo"
enumFromThenToClassOpOcc = mkVarOcc "enumFromThenTo"
-- Class Typeable, and functions for constructing `Typeable` dictionaries
-someTypeRepTyConOcc
- , someTypeRepDataConOcc
- , mkTrConOcc
- , mkTrAppCheckedOcc
- , mkTrFunOcc
- , typeRepIdOcc
- , typeNatTypeRepOcc
- , typeSymbolTypeRepOcc
- , typeCharTypeRepOcc
- :: KnownOcc
+someTypeRepTyConOcc, someTypeRepDataConOcc, mkTrConOcc, mkTrAppCheckedOcc
+ , mkTrFunOcc, typeRepIdOcc, typeNatTypeRepOcc, typeSymbolTypeRepOcc
+ , typeCharTypeRepOcc :: KnownOcc
someTypeRepTyConOcc = mkTcOcc "SomeTypeRep"
someTypeRepDataConOcc = mkDataOcc "SomeTypeRep"
typeRepIdOcc = mkVarOcc "typeRep#"
@@ -148,21 +186,14 @@ typeNatTypeRepOcc = mkVarOcc "typeNatTypeRep"
typeSymbolTypeRepOcc = mkVarOcc "typeSymbolTypeRep"
typeCharTypeRepOcc = mkVarOcc "typeCharTypeRep"
-typeLitSymbolDataConOcc
- , typeLitNatDataConOcc
- , typeLitCharDataConOcc
- :: KnownOcc
+typeLitSymbolDataConOcc, typeLitNatDataConOcc, typeLitCharDataConOcc :: KnownOcc
typeLitSymbolDataConOcc = mkDataOcc "TypeLitSymbol"
typeLitNatDataConOcc = mkDataOcc "TypeLitNat"
typeLitCharDataConOcc = mkDataOcc "TypeLitChar"
-trModuleTyConOcc
- , trModuleDataConOcc
- , trNameSDataConOcc
- , trTyConTyConOcc
- , trTyConDataConOcc
- :: KnownOcc
+trModuleTyConOcc, trModuleDataConOcc, trNameSDataConOcc
+ , trTyConTyConOcc, trTyConDataConOcc :: KnownOcc
trModuleTyConOcc = mkTcOcc "Module"
trModuleDataConOcc = mkDataOcc "Module"
trNameSDataConOcc = mkDataOcc "TrNameS"
@@ -170,14 +201,8 @@ trTyConTyConOcc = mkTcOcc "TyCon"
trTyConDataConOcc = mkDataOcc "TyCon"
-- Typeable representation types
-kindRepTyConOcc
- , kindRepTyConAppDataConOcc
- , kindRepVarDataConOcc
- , kindRepAppDataConOcc
- , kindRepFunDataConOcc
- , kindRepTYPEDataConOcc
- , kindRepTypeLitSDataConOcc
- :: KnownOcc
+kindRepTyConOcc, kindRepTyConAppDataConOcc, kindRepVarDataConOcc, kindRepAppDataConOcc
+ , kindRepFunDataConOcc, kindRepTYPEDataConOcc, kindRepTypeLitSDataConOcc :: KnownOcc
kindRepTyConOcc = mkTcOcc "KindRep"
kindRepTyConAppDataConOcc = mkDataOcc "KindRepTyConApp"
kindRepVarDataConOcc = mkDataOcc "KindRepVar"
@@ -210,20 +235,20 @@ main_RDR_Unqual = mkUnqual varName (fsLit "main")
-- We definitely don't want an Orig RdrName, because
-- main might, in principle, be imported into module Main
-
error_RDR :: RdrName
error_RDR = knownVarOccRdrName "error"
toDyn_RDR :: RdrName
toDyn_RDR = knownVarOccRdrName "toDyn"
-compose_RDR :: RdrName
+compose_RDR, map_RDR :: RdrName
compose_RDR = knownOccRdrName composeIdOcc
+map_RDR = knownOccRdrName mapIdOcc
appE_RDR, lift_RDR, liftTyped_RDR :: RdrName
-appE_RDR = knownVarOccRdrName "appE"
-lift_RDR = knownVarOccRdrName "lift"
-liftTyped_RDR = knownVarOccRdrName "liftTyped"
+appE_RDR = knownVarOccRdrName "appE"
+lift_RDR = knownVarOccRdrName "lift"
+liftTyped_RDR = knownVarOccRdrName "liftTyped"
enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName
enumFrom_RDR = knownOccRdrName enumFromClassOpOcc
@@ -420,10 +445,9 @@ ltTag_RDR = nameRdrName ordLTDataConName
eqTag_RDR = nameRdrName ordEQDataConName
gtTag_RDR = nameRdrName ordGTDataConName
-map_RDR, fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR,
+fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR,
foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR,
mappend_RDR :: RdrName
-map_RDR = knownKeyRdrName mapIdKey
fmap_RDR = knownKeyRdrName fmapClassOpKey
pure_RDR = knownKeyRdrName pureAClassOpKey
ap_RDR = knownKeyRdrName apAClassOpKey
=====================================
compiler/GHC/HsToCore/ListComp.hs
=====================================
@@ -37,6 +37,7 @@ import GHC.Driver.DynFlags
import GHC.Tc.Utils.TcType
import GHC.Builtin.KnownKeys
+import GHC.Builtin.KnownOccs
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim( alphaTyVar )
@@ -129,7 +130,7 @@ dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderM
-- Create an unzip function for the appropriate arity and element types and find "map"
unzip_stuff' <- mkUnzipBind form from_bndrs_tys
- map_id <- dsLookupKnownKeyId mapIdKey
+ map_id <- dsLookupKnownOccId mapIdOcc
-- Generate the expressions to build the grouped list
let -- First we apply the grouping function to the inner list
@@ -682,7 +683,7 @@ mkFoldrExpr :: Type -- ^ Element type of the list
-> CoreExpr -- ^ List expression being folded acress
-> DsM CoreExpr
mkFoldrExpr elt_ty result_ty c n list = do
- foldr_id <- dsLookupKnownKeyId foldrIdKey
+ foldr_id <- dsLookupKnownOccId foldrListIdOcc
return (Var foldr_id `App` Type elt_ty
`App` Type result_ty
`App` c
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -116,7 +116,7 @@ import GHC.Types.SafeHaskell
import GHC.Types.TypeEnv
import GHC.Types.Unique.DSet
import GHC.Types.Unique.Map( listToUniqMap )
-import GHC.Types.Unique.FM( UniqFM, listToUFM, lookupUFM )
+import GHC.Types.Unique.FM( UniqFM, listToUFM, lookupUFM, elemUFM )
import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.PkgQual
@@ -284,9 +284,12 @@ loadKnownKeyOccMaps
cannotFindModule hsc_env kNOWN_KEY_NAMES fr }
; let kk_map :: UniqFM KnownKey Name
+ -- Domain is just the KnownKeys in the knownKeyTable
kk_map = listToUFM [ (getUnique nm, nm)
| avail <- mi_exports iface
- , nm <- availNames avail ]
+ , nm <- availNames avail
+ , let uniq = getUnique nm
+ , uniq `elemUFM` knownKeyUniqMap ]
occ_map :: OccEnv Name
occ_map = mkOccEnv [ (nameOccName nm, nm)
| avail <- mi_exports iface
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -2029,14 +2029,6 @@ findImportUsage imports used_gres
| used
= acc
-{- ToDo: delete this
- -- -frebindable-known-key-names is on, and `n` is a known-key name
- -- Then don't warn about an unused import.
- -- See (UI2) in Note [Unused imports]
- | rebindable_known_key_names
- , isKnownKeyName n || nameOccName n `elemOccSet` allKnownOccs
- = acc
--}
| otherwise
= UnusedNames (acc_ns `extendNameSet` n) acc_wcs acc_fs
where
@@ -2210,6 +2202,7 @@ warnUnusedImport :: GlobalRdrEnv -> ImportDeclUsage -> RnM ()
warnUnusedImport rdr_env (L loc decl, used, unused, unused_wcs)
-- Do not warn for 'import M()'
+ -- See (UI1) in Note [Unused imports]
| Just (Exactly, _) <- ideclImportList decl
, null unused
= return ()
@@ -2221,8 +2214,7 @@ warnUnusedImport rdr_env (L loc decl, used, unused, unused_wcs)
= return ()
-- Do not warn about import X as Rebindable
- -- See Note [Overview of known-key entities]
- -- ToDo: write wrinkle
+ -- See (UI2) in Note [Unused imports]
| Just (L _ mod) <- ideclAs decl
, mod == rEBINDABLE_MOD_NAME
= return ()
@@ -2405,21 +2397,13 @@ and neither `a` nor `b` is used, we report the entire import decl as unused. We
check this by looking at the names that it brings into scope scope; if there are
no ununused names, don't report.
-This neatly takes into account two things:
-
(UI1) We don't want to complain about `import M()`, because that is often used to bring
- M's /instances/ into scope.
-
-(UI2) In base:Data.Enum we see
- import GHC.Internal.Num( Num ) -- For -frebindable-known-key-names (defaulting)
- 'Num' is not mentioned explicity but the import is still required; see KKNS_InScope
- in Note [Overview of known-key entities] in GHC.Builtin
-
- We don't want this import reported at an unused. So `findImportUsage`, when looking
- at `import M( x )`, we do /not/ record `x` as "unused" (regardless of whether it is
- mentioned in M if
- (a) -frebindable-known-key-names is on, and
- (b) `x` is a known-key name
+ M's /instances/ into scope. That is neatly dealt with by the "no unused names"
+ criterion.
+
+(UI2) We don't report a decl as unused if it has an `as Rebindable` qualifier.
+ See (KKN1) in Note [Overview of known-key entities] in GHC.Builtin
+
Note [Printing minimal imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Tc/Deriv/Functor.hs
=====================================
@@ -1066,7 +1066,7 @@ gen_Traversable_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
where
data_cons = getPossibleDataCons tycon tycon_args
- traverse_name = L (noAnnSrcSpan loc) traverse_RDR
+ traverse_name = mkMethBinder loc traverse_RDR
-- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]
traverse_bind = mkRdrFunBindEC 2 (nlHsApp pure_Expr)
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -2152,14 +2152,11 @@ nlHsCompose :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
nlHsCompose x y = compose_RDR `nlHsApps` [x, y]
mkMethBinder :: SrcSpan -> RdrName -> LocatedN RdrName
--- The binder for a class method `op` in in an instance decl
--- can be /unqualified/, thus
--- instance C Int where
--- op = ... -- The "op" can be unqualied
--- because the renamer looks in the class to find it. Having it
--- unqualified reduces the need for it to be in scope
-mkMethBinder loc op_rdr
- = L (noAnnSrcSpan loc ) (mkRdrUnqual (rdrNameOcc op_rdr))
+-- The binder for a class method `op` in in an `derived` instance decl
+-- should be an Exact RdrName, so that the derived instance works even when
+-- that method name is not in scope in this module. (Usually, a method must
+-- be in scope for you to define it in an instance decl.)
+mkMethBinder loc op_rdr = L (noAnnSrcSpan loc ) op_rdr
-- | Make a function binding. If no equations are given, produce a function
-- with the given arity that produces a stock error.
=====================================
compiler/GHC/Tc/Deriv/Generics.hs
=====================================
@@ -352,14 +352,14 @@ gk2gkDC Gen1 dc tc_args = Gen1_DC $ assert (isTyVarTy last_dc_inst_univ)
mkBindsRep :: DynFlags -> GenericKind -> SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, [LSig GhcPs])
mkBindsRep dflags gk loc dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
where
- binds = [mkRdrFunBind (mkMethBinder loc' from01_RDR) [from_eqn]]
+ binds = [mkRdrFunBind from01_bndr [from_eqn]]
++
- [mkRdrFunBind (mkMethBinder loc' to01_RDR) [to_eqn]]
+ [mkRdrFunBind to01_bndr [to_eqn]]
-- See Note [Generics performance tricks]
sigs = if gopt Opt_InlineGenericsAggressively dflags
|| (gopt Opt_InlineGenerics dflags && inlining_useful)
- then [inline1 from01_RDR, inline1 to01_RDR]
+ then [inline1 from01_bndr, inline1 to01_bndr]
else []
where
inlining_useful
@@ -373,7 +373,7 @@ mkBindsRep dflags gk loc dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
cons = length datacons
max_fields = maximum $ 0 :| map dataConSourceArity datacons
- inline1 f = L loc'' . InlineSig noAnn (L loc' f)
+ inline1 f = L loc'' . InlineSig noAnn f
$ alwaysInlinePragma `setInlinePragmaActivation` activeAfter (Phase 1)
-- The topmost M1 (the datatype metadata) has the exact same type
@@ -386,10 +386,11 @@ mkBindsRep dflags gk loc dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
from_matches = [mkHsCaseAlt pat rhs | (pat,rhs) <- from_alts]
to_matches = [mkHsCaseAlt pat rhs | (pat,rhs) <- to_alts ]
- loc' = noAnnSrcSpan loc
loc'' = noAnnSrcSpan loc
datacons = tyConDataCons tycon
+ from01_bndr = mkMethBinder loc from01_RDR
+ to01_bndr = mkMethBinder loc to01_RDR
(from01_RDR, to01_RDR) = case gk of
Gen0 -> (from_RDR, to_RDR)
Gen1 -> (from1_RDR, to1_RDR)
=====================================
libraries/base/src/Control/Applicative.hs
=====================================
@@ -63,10 +63,13 @@ import GHC.Internal.Data.Functor ((<$>))
import GHC.Internal.Data.Functor.Const (Const(..))
import GHC.Internal.Data.Typeable (Typeable)
import GHC.Internal.Data.Data (Data)
-
+import GHC.Generics( Generic, Generic1 )
import GHC.Internal.Functor.ZipList (ZipList(..))
-import GHC.Generics
-import qualified GHC.KnownKeyNames as Rebindable
+
+import qualified GHC.Internal.Data.Data as Rebindable
+import qualified GHC.Internal.Data.Typeable.Internal as Rebindable
+import qualified GHC.Num as Rebindable
+import qualified GHC.Generics as Rebindable hiding( Fixity(..) )
-- $setup
-- >>> import Prelude
=====================================
libraries/base/src/Data/Fixed.hs
=====================================
@@ -93,7 +93,7 @@ import Prelude
import GHC.Internal.Data.Data
import GHC.Internal.TypeLits (KnownNat, natVal)
import GHC.Internal.Read
-import GHC.Internal.Text.ParserCombinators.ReadPrec( ReadPrec, pfail )
+import GHC.Internal.Text.ParserCombinators.ReadPrec( ReadPrec )
import GHC.Internal.Text.Read.Lex
import qualified GHC.Internal.TH.Monad as TH
import qualified GHC.Internal.TH.Lift as TH
=====================================
libraries/base/src/Data/Semigroup.hs
=====================================
@@ -121,7 +121,8 @@ import GHC.Internal.Data.Traversable
import GHC.Internal.Data.Semigroup.Internal
import GHC.Internal.Control.Monad.Fix
import GHC.Internal.Data.Data
-import GHC.Generics
+import GHC.Generics( Generic, Generic1 )
+import qualified GHC.Generics as Rebindable hiding( Fixity(..) )
import qualified GHC.Internal.List as List
import qualified GHC.KnownKeyNames as Rebindable
=====================================
libraries/base/src/GHC/KnownKeyNames.hs
=====================================
@@ -14,16 +14,16 @@ module GHC.KnownKeyNames
( Eq(..), Ord(..) -- With their methods
, Show, Read
- -- Foldable/Traversable with their methods
- , Foldable, foldMap, null, all
- , Traversable, traverse
+ -- Foldable/Traversable with those methods need for deriving
+ , Foldable(foldr, foldMap, null), all
+ , Traversable(traverse)
, Functor, fmap, (<$)
, Monad, (>>), (>>=), return, fail, guard, mfix, join
, Alternative
-- Misc
- , (.), (&&), not, map, foldr, build
+ , (.), (&&), not, foldrList, build, map
, seq#
-- Applicative
@@ -47,7 +47,7 @@ module GHC.KnownKeyNames
, Ix, range, inRange, index, unsafeIndex, unsafeRangeSize
-- Data
- , Data
+ , Data, Fixity(Prefix,Infix)
, gfoldl, gunfold, toConstr, dataTypeOf, dataCast1, dataCast2
, mkConstrTag, Constr, mkDataType, DataType, constrIndex
@@ -59,9 +59,8 @@ module GHC.KnownKeyNames
, Generic(..), Generic1(..)
, Datatype(..), Constructor(..), Selector(..)
, U1(..), Par1(..), Rec1(..), K1(..), M1(..)
- , (:+:)(L1, R1), (:*:)((:*:))
- , Comp1(..)
- , UAddr(..), UChar(..), UDouble(..), UFloat(..), UInt(..), UWord(..)
+ , (:+:)(L1, R1), (:*:)((:*:)), (:.:)(Comp1, unComp1)
+ , UAddr, UChar, UDouble, UFloat, UInt, UWord
-- DataToTag
, DataToTag
@@ -196,7 +195,7 @@ module GHC.KnownKeyNames
, Clause, clause
) where
-import GHC.Internal.Base
+import GHC.Internal.Base hiding( foldr )
import GHC.Internal.Show
import GHC.Internal.Read
import GHC.Internal.Num
@@ -209,7 +208,7 @@ import GHC.Internal.Data.Dynamic( toDyn )
import GHC.Internal.Data.Data
import GHC.Internal.Data.String( fromString )
import GHC.Internal.Data.Either( Either(..) )
-import GHC.Internal.Data.Foldable( Foldable, foldMap, null, all )
+import GHC.Internal.Data.Foldable( Foldable(..), null, all )
import GHC.Internal.Data.Traversable( Traversable, traverse )
import GHC.Internal.Float( RealFloat )
import GHC.Internal.IO( seq# )
@@ -226,8 +225,6 @@ import qualified GHC.Internal.IsList as IL
import GHC.Internal.Err( error )
import GHC.Internal.Int( Int8(I8#), Int16(I16#), Int32(I32#), Int64(I64#) )
import GHC.Internal.Word( Word8(W8#), Word16(W16#), Word32(W32#), Word64(W64#) )
-import GHC.Internal.Text.ParserCombinators.ReadPrec( step, reset, prec, pfail, (+++) )
-import GHC.Internal.Text.Read.Lex( Lexeme(Punc, Ident, Symbol) )
import GHC.Internal.Unsafe.Coerce( UnsafeEquality(..), unsafeEqualityProof )
@@ -236,11 +233,18 @@ import GHC.Internal.StaticPtr.Internal( makeStatic )
import GHC.Internal.Data.Typeable( gcast1, gcast2 )
import GHC.Internal.Data.Typeable.Internal as TR
-import GHC.Internal.Generics
+import GHC.Internal.Generics( Generic(..), Generic1(..), Datatype(..)
+ , Constructor(..), Selector(..)
+ , U1(..), Par1(..), Rec1(..), K1(..), M1(..)
+ , (:+:)(..), (:*:)(..), (:.:)(..)
+ , UAddr, UChar, UDouble
+ , UFloat, UInt, UWord
+ )
import GHC.Internal.Bignum.BigNat
-import GHC.Internal.TH.Syntax as TH
-import GHC.Internal.TH.Lib hiding( InjectivityAnn, Role )
+import GHC.Internal.TH.Syntax as TH hiding( Fixity(..) )
+ -- hiding(Fixity) see Note [Tricky known-occ cases] in GHC.Builtin.KnownOccs
+import GHC.Internal.TH.Lib
import GHC.Internal.TH.Lift
import GHC.Internal.TH.Monad
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -1819,6 +1819,12 @@ foldr k z = go
go [] = z
go (y:ys) = y `k` go ys
+
+foldrList :: (a -> b -> b) -> b -> [a] -> b
+-- An alias for `foldr`, used only internally
+-- See Note [Tricky known-occ cases] in GHC.Builtin.KnownOccs
+foldrList = foldr
+
-- | A list producer that can be fused with 'foldr'.
-- This function is merely
--
=====================================
libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
=====================================
@@ -83,7 +83,8 @@ import GHC.Internal.Numeric
import GHC.Internal.Ptr
import GHC.Internal.Unsafe.Coerce
import GHC.Internal.Stack (HasCallStack)
-import qualified GHC.Internal.Data.Foldable as Rebindable
+import qualified GHC.Internal.Data.Foldable as Rebindable
+import qualified GHC.Internal.Data.Traversable as Rebindable
------------------------------------------------------------------------
-- Boxes
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
=====================================
@@ -19,10 +19,8 @@
-- is safe to break things.
module GHC.Internal.TH.Lib where
-
-import GHC.Internal.TH.Syntax hiding (Role, InjectivityAnn)
+import GHC.Internal.TH.Syntax
import GHC.Internal.TH.Monad
-import qualified GHC.Internal.TH.Syntax as TH
#ifdef BOOTSTRAP_TH
import Control.Applicative(liftA, Applicative(..))
@@ -94,10 +92,6 @@ type PatSynArgsQ = Q PatSynArgs
type FamilyResultSigQ = Q FamilyResultSig
type DerivStrategyQ = Q DerivStrategy
--- must be defined here for DsMeta to find it
-type Role = TH.Role
-type InjectivityAnn = TH.InjectivityAnn
-
type TyVarBndrUnit = TyVarBndr ()
type TyVarBndrSpec = TyVarBndr Specificity
type TyVarBndrVis = TyVarBndr BndrVis
@@ -974,7 +968,7 @@ tyVarSig = fmap TyVarSig
-- * Injectivity annotation
injectivityAnn :: Name -> [Name] -> InjectivityAnn
-injectivityAnn = TH.InjectivityAnn
+injectivityAnn = InjectivityAnn
-------------------------------------------------------------------------------
-- * Role
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -33,7 +33,7 @@ import GHC.Internal.Base as Rebindable hiding( Type )
import GHC.Internal.TH.Syntax
import GHC.Internal.TH.Monad
import qualified GHC.Internal.TH.Lib as Lib (litE)
-import GHC.Internal.TH.Lib hiding( InjectivityAnn, Role )
+import GHC.Internal.TH.Lib
-- For known-key names
-- See wrinkle (W4) of Note [Tracking dependencies on primitives]
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
=====================================
@@ -42,7 +42,6 @@ import GHC.Ptr ( Ptr, plusPtr )
import GHC.Generics ( Generic )
#else
-- Compiling with stage1 compiler
-import qualified GHC.Internal.Base as Rebindable
import GHC.Internal.Base hiding( Type, Module )
import GHC.Internal.Data.Traversable
import GHC.Internal.Err (error)
@@ -61,7 +60,9 @@ import GHC.Internal.Num
import GHC.Internal.IO.Unsafe
import GHC.Internal.List (dropWhile, break, replicate, reverse, last)
import GHC.Internal.Unicode
-import qualified GHC.Internal.Generics as Rebindable hiding( prec )
+import qualified GHC.Internal.Base as Rebindable hiding( foldr )
+import qualified GHC.Internal.Data.Foldable as Rebindable
+import qualified GHC.Internal.Generics as Rebindable hiding( prec )
#endif
import GHC.Internal.ForeignSrcLang
import GHC.Internal.LanguageExtensions
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3dc8d56d948b146a847f15c8015bb8e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3dc8d56d948b146a847f15c8015bb8e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T27078 at Glasgow Haskell Compiler / GHC
Commits:
964394aa by Simon Peyton Jones at 2026-04-13T23:03:33+01:00
Wibbles
.. in response to RAE review
- - - - -
2 changed files:
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/SubstTypeLets.hs
Changes:
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -1311,7 +1311,7 @@ lambda-bound variables.
So our solution is this:
-* Use straightforward applicaion in the worker-wrapper pass, creating a eta-redex.
+* Use straightforward applicaion in the worker-wrapper pass, creating a beta-redex.
See the call to `mkApps` in GHC.Core.Opt.WorkWrap.Utils.mkWwBodies.
* Tell Lint not to complain about a join-point invocation hidden under a
@@ -1443,19 +1443,13 @@ lintValArg arg mult fun_ue
-----------------
lintAltBinders :: UsageEnv
- -> Var -- Case binder
+ -> Var -- Case binder
-> Type -- Scrutinee type
-> Type -- Constructor type
-> [(Mult, OutVar)] -- Binders
-> LintM UsageEnv
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
-{-
-lintAltBinders rhs_ue _case_bndr scrut_ty con_ty bndrs
- = do { (res_ty, rhs_ue') <- lintApp (text ".") lintTyBndr lintValBndr con_ty bndrs
- ; ensureEqTys res_ty scrut_ty (mkBadPatMsg con_ty scrut_ty)
- ; return rhs_ue }
--}
lintAltBinders rhs_ue _case_bndr scrut_ty con_ty []
= do { ensureEqTys con_ty scrut_ty (mkBadPatMsg con_ty scrut_ty)
; return rhs_ue }
@@ -2069,19 +2063,19 @@ lint_tyco_app msg fun_kind arg_tys
; return () }
----------------
-lintApp :: forall in_a acc. Outputable in_a =>
+lintApp :: forall a acc. Outputable a =>
SDoc
- -> (in_a -> LintM Type) -- Lint the thing and return its value
- -> (in_a -> Mult -> acc -> LintM (Kind, acc)) -- Lint the thing and return its type
+ -> (a -> LintM Type) -- Lint the thing and return its value
+ -> (a -> Mult -> acc -> LintM (Kind, acc)) -- Lint the thing and return its type
-> Type
- -> [in_a] -- The arguments, always "In" things
- -> acc -- Used (only) for UsageEnv in /term/ applications
+ -> [a] -- The arguments
+ -> acc -- Used (only) for UsageEnv in /term/ applications
-> LintM (Type,acc)
-- lintApp is a performance-critical function, which deals with multiple
-- applications such as (/\a./\b./\c. expr) @ta @tb @tc
-- When returning the type of this expression we want to avoid substituting a:=ta,
-- and /then/ substituting b:=tb, etc. That's quadratic, and can be a huge
--- perf hole. So we gather all the arguments [in_a], and then gather the
+-- perf hole. So we gather all the arguments [a], and then gather the
-- substitution incrementally in the `go` loop.
--
-- lintApp is used:
@@ -2101,7 +2095,7 @@ lintApp msg lint_forall_arg lint_arrow_arg !orig_fun_ty all_args acc
; let init_subst = mkEmptySubst in_scope
- go :: Subst -> Type -> acc -> [in_a] -> LintM (Type, acc)
+ go :: Subst -> Type -> acc -> [a] -> LintM (Type, acc)
-- The Subst applies (only) to the fun_ty
-- c.f. GHC.Core.Type.piResultTys, which has a similar loop
@@ -2908,10 +2902,11 @@ data LintEnv
, le_level :: LintLevel
, le_in_scope :: InScopeSet
- , le_in_vars :: VarEnv (Var, LintLevel)
- -- Maps an Var (i.e. its unique) to its binding Var and level
+ , le_vars :: VarEnv (Var, LintLevel)
+ -- Maps a Var (i.e. its unique) to its binding Var and level
-- /All/ in-scope variables are here (term variables,
-- type variables, and coercion variables)
+ -- So the domain is the same as the le_in_scope in-scope set
-- Used at an occurrence of the Var
, le_joins :: UniqMap Id JoinOcc
@@ -2922,7 +2917,6 @@ data LintEnv
-- See Note [Linting linearity]
-- Assigns usage environments to the alias-like binders,
-- as found in non-recursive lets.
- -- Domain is Ids
, le_platform :: Platform -- ^ Target platform
, le_diagOpts :: DiagOpts -- ^ Target platform
@@ -3267,7 +3261,7 @@ initL cfg m
init_level = 0
env = LE { le_flags = l_flags cfg
, le_level = init_level
- , le_in_vars = mkVarEnv [ (v,(v, init_level)) | v <- vars ]
+ , le_vars = mkVarEnv [ (v,(v, init_level)) | v <- vars ]
, le_in_scope = mkInScopeSetList vars
, le_joins = emptyUniqMap
, le_loc = []
@@ -3366,9 +3360,9 @@ addInScopeId id thing_inside
= LintM $ \ env errs ->
unLintM thing_inside (add env) errs
where
- add env@(LE { le_level = level, le_in_vars = id_vars, le_joins = valid_joins
+ add env@(LE { le_level = level, le_vars = id_vars, le_joins = valid_joins
, le_ue_aliases = aliases, le_in_scope = in_scope })
- = env { le_level = level1, le_in_vars = in_vars'
+ = env { le_level = level1, le_vars = in_vars'
, le_in_scope = in_scope `extendInScopeSet` id
, le_joins = valid_joins', le_ue_aliases = aliases' }
where
@@ -3388,16 +3382,16 @@ addInScopeId id thing_inside
addInScopeTyCoVar :: TyCoVar -> LintM a -> LintM a
-- This function clones to avoid shadowing of TyCoVars
addInScopeTyCoVar tcv thing_inside
- = LintM $ \ env@(LE { le_level = level, le_in_vars = in_vars
+ = LintM $ \ env@(LE { le_level = level, le_vars = in_vars
, le_in_scope = in_scope }) errs ->
let level' = level + 1
env' = env { le_level = level'
, le_in_scope = in_scope `extendInScopeSet` tcv
- , le_in_vars = extendVarEnv in_vars tcv (tcv, level') }
+ , le_vars = extendVarEnv in_vars tcv (tcv, level') }
in unLintM thing_inside env' errs
getInVarEnv :: LintM (VarEnv (Id, LintLevel))
-getInVarEnv = LintM (\env errs -> fromBoxedLResult (Just (le_in_vars env), errs))
+getInVarEnv = LintM (\env errs -> fromBoxedLResult (Just (le_vars env), errs))
markAllJoinsBad :: LintM a -> LintM a
markAllJoinsBad m
=====================================
compiler/GHC/Core/SubstTypeLets.hs
=====================================
@@ -94,7 +94,7 @@ stlExpr :: Subst -> CoreExpr -> CoreExpr
stlExpr subst (Let (NonRec tv (Type ty)) body)
= -- This equation is the main payload of the entire pass!
- stlExpr (extendTvSubst subst tv ty) body
+ stlExpr (extendTvSubst subst tv (substTy subst ty)) body
stlExpr subst (Let bind body)
= Let bind' (stlExpr subst' body)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/964394aa8a4daff4c22ff4b5b401d26…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/964394aa8a4daff4c22ff4b5b401d26…
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) 13 Apr '26
by Wolfgang Jeltsch (@jeltsch) 13 Apr '26
13 Apr '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
3b2f20b2 by Wolfgang Jeltsch at 2026-04-14T00:27:06+03:00
Move I/O-related `Read` instances into `base`
- - - - -
8c3476f5 by Wolfgang Jeltsch at 2026-04-14T00:27:19+03: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.
- - - - -
f0ffc4b4 by Wolfgang Jeltsch at 2026-04-14T00:27:19+03:00
Move the instance `Read ByteOrder` into `base`
- - - - -
edace2a9 by Wolfgang Jeltsch at 2026-04-14T00:27:19+03:00
Move the implementation of version parsing into `base`
- - - - -
4f44d8ee by Wolfgang Jeltsch at 2026-04-14T00:27:19+03: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/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
- libraries/ghc-internal/src/GHC/Internal/Read.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 #-}
-- |
--
@@ -895,3 +896,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/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,
@@ -126,10 +126,8 @@ import GHC.Internal.Base (
import GHC.Internal.Err (errorWithoutStackTrace)
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 )
import GHC.Internal.Types (
Bool(..), Char, Coercible, Float, Double, Type, type (~), type (~~),
)
@@ -688,32 +686,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,17 @@ module GHC.Internal.Data.Version (
-- * The @Version@ type
Version(..),
-- * A concrete representation of @Version@
- showVersion, parseVersion,
+ showVersion,
-- * Constructor function
makeVersion
) where
-import GHC.Internal.Classes ( Eq(..), (&&) )
-import GHC.Internal.Data.Functor ( Functor(..) )
+import GHC.Internal.Classes ( Eq ((==)), (&&) )
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
import GHC.Internal.Data.String ( String )
-import GHC.Internal.Base ( Applicative(..) )
-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 +63,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 +86,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
)
{-# DEPRECATED versionTags "See GHC ticket #2496" #-}
-- TODO. Remove all references to versionTags in GHC 8.0 release.
@@ -120,13 +113,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
=====================================
@@ -34,7 +34,6 @@ import GHC.Internal.Types ( Bool(..), Int )
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
@@ -182,7 +181,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
=====================================
@@ -50,7 +50,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.Types (Bool(..), Int)
import GHC.Internal.Word
import GHC.Internal.IO.Device
@@ -273,7 +272,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
)
@@ -379,7 +377,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
)
@@ -396,7 +393,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.Classes (Eq, Ord)
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,279 +15,16 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.Numeric (
+module GHC.Internal.Numeric (showIntAtBase, showHex) where
- -- * 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
-
-import GHC.Internal.Base (ord, otherwise, return, unsafeChr, ($), (.), (++))
-import GHC.Internal.Classes (Eq(..), Ord(..), (&&), (||))
-import GHC.Internal.Err (error, errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
import GHC.Internal.Prim (seq)
-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
-import GHC.Internal.Types (Bool(..), Char(..), Int)
-
--- $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
+import GHC.Internal.Types (Char, Int)
+import GHC.Internal.Classes ((<), (<=))
+import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Base (($), otherwise)
+import GHC.Internal.List ((++))
+import GHC.Internal.Real (Integral, toInteger, fromIntegral, quotRem)
+import GHC.Internal.Show (ShowS, show, intToDigit)
-- ---------------------------------------------------------------------------
-- Integer printing functions
@@ -312,11 +48,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
=====================================
libraries/ghc-internal/src/GHC/Internal/Read.hs
=====================================
@@ -80,7 +80,6 @@ import GHC.Internal.Types (Bool(..), Char, Int, Ordering(..))
import GHC.Internal.Word
import GHC.Internal.List (filter)
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.ByteOrder
-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
@@ -840,6 +839,3 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })
readListPrec = readListPrecDefault
readList = readListDefault
-
--- | @since base-4.11.0.0
-deriving instance Read ByteOrder
=====================================
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
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,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’
@@ -12526,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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
@@ -12459,7 +12459,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12526,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’
@@ -12555,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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
@@ -12701,7 +12701,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12768,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’
@@ -12797,6 +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 [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 k a (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
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,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’
@@ -12526,6 +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 [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 k1 (f :: k2 -> *) (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 k a (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/f336dac4cc4a43fc2c78b20e1303a7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f336dac4cc4a43fc2c78b20e1303a7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0