12 Mar '26
Cheng Shao pushed new branch wip/wasm-iserv-fast-binary at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wasm-iserv-fast-binary
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/kill-CodeSrcFlag] make addExpansionErrCtxt also sets tcl_in_gen_code
by Apoorv Ingle (＠ani) 12 Mar '26
by Apoorv Ingle (＠ani) 12 Mar '26
12 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-CodeSrcFlag at Glasgow Haskell Compiler / GHC
Commits:
575ad32e by Apoorv Ingle at 2026-03-12T16:24:04-05:00
make addExpansionErrCtxt also sets tcl_in_gen_code
- - - - -
1 changed file:
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1376,7 +1376,7 @@ addErrCtxt msg = addErrCtxtM msg
-- See Note [ErrCtxtStack Manipulation]
addExpansionErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a
{-# INLINE addExpansionErrCtxt #-} -- Note [Inlining addErrCtxt]
-addExpansionErrCtxt msg = addExpansionErrCtxtM msg
+addExpansionErrCtxt msg thing_inside = setInGeneratedCode $ addExpansionErrCtxtM msg thing_inside
-- | Add a message to the error context. This message may do tidying.
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/575ad32e32d76d6c4be7f1d695a4e18…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/575ad32e32d76d6c4be7f1d695a4e18…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/text-read-uncovering] 6 commits: Move the `System.IO` implementation into `base`
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
12 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
26582cd6 by Wolfgang Jeltsch at 2026-03-12T22:02:56+02:00
Move the `System.IO` implementation into `base`
- - - - -
ae99e2f0 by Wolfgang Jeltsch at 2026-03-12T22:21:48+02:00
Move I/O-related `Read` instances into `base`
- - - - -
f396ccd1 by Wolfgang Jeltsch at 2026-03-12T22:22:23+02:00
Move most of the `Numeric` implementation into `base`
The `showHex` operation and the `showIntAtBase` operation, which
underlies it, are kept in `GHC.Internal.Numeric`, because `showHex` is
used in a few places in `ghc-internal`; everything else is moved.
- - - - -
6e76f29d by Wolfgang Jeltsch at 2026-03-12T22:22:23+02:00
Move the instance `Read ByteOrder` into `base`
- - - - -
d5747a5d by Wolfgang Jeltsch at 2026-03-12T22:22:23+02:00
Move the implementation of version parsing into `base`
- - - - -
2543e91b by Wolfgang Jeltsch at 2026-03-12T22:22:23+02:00
Move the implementation of `readConstr` into `base`
- - - - -
21 changed files:
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Version.hs
- libraries/base/src/GHC/ByteOrder.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/Numeric.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- − 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
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/GHC/IO/Handle.hs
=====================================
@@ -53,6 +53,7 @@ module GHC.IO.Handle
hGetEcho,
hIsTerminalDevice,
hSetNewlineMode,
+ hGetNewlineMode,
Newline(..),
NewlineMode(..),
nativeNewline,
=====================================
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
=====================================
@@ -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,6 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
-- |
--
@@ -184,9 +186,701 @@ module System.IO
nativeNewlineMode
) where
-import GHC.Internal.System.IO
+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 Data.Int (Int)
+import Data.IORef (IORef, newIORef)
+import System.IO.Error (userError)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Internals
+ (
+ c_getpid,
+ c_open,
+ o_CREAT,
+ 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 (Errno, eEXIST, getErrno, errnoToIOError)
+import GHC.Base (Bool (False, True), otherwise, failIO)
+import GHC.Err (errorWithoutStackTrace)
+import GHC.List (null, elem, last, (++), reverse, break)
+import GHC.Num ((+))
+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,
+ SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd),
+ 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.IORef (atomicModifyIORef'_)
import GHC.Internal.Control.Monad.Fix (fixIO)
+#if defined(mingw32_HOST_OS)
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils (with)
+import Foreign.Storable
+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)
+#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
+
+-- | The same as 'putStr', but adds a newline character.
+--
+-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
+putStrLn :: String -> IO ()
+putStrLn s = hPutStrLn stdout s
+
+-- | The 'print' function outputs a value of any printable type to the
+-- standard output device.
+-- Printable types are those that are instances of class 'Show'; 'print'
+-- converts values to strings for output using the 'show' operation and
+-- adds a newline.
+--
+-- 'print' is implemented as @'putStrLn' '.' 'show'@
+--
+-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
+--
+-- ==== __Examples__
+--
+-- >>> print [1, 2, 3]
+-- [1,2,3]
+--
+-- Be careful when using 'print' for outputting strings,
+-- as this will invoke 'show' and cause strings to be printed
+-- with quotation marks and non-ascii symbols escaped.
+--
+-- >>> print "λ :D"
+-- "\995 :D"
+--
+-- A program to print the first 8 integers and their
+-- powers of 2 could be written as:
+--
+-- >>> print [(n, 2^n) | n <- [0..8]]
+-- [(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
+
-- $locking
-- Implementations should enforce as far as possible, at least locally to the
-- Haskell process, multiple-reader single-writer locking on files.
@@ -219,3 +913,24 @@ import GHC.Internal.Control.Monad.Fix (fixIO)
-- 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,9 +97,9 @@ 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 GHC.Internal.System.IO
+import Numeric
+import System.IO
-- $setup
-- >>> import Prelude
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -323,7 +323,6 @@ Library
GHC.Internal.Numeric.Natural
GHC.Internal.System.Environment
GHC.Internal.System.Environment.Blank
- GHC.Internal.System.IO
GHC.Internal.System.IO.Error
GHC.Internal.System.Mem
GHC.Internal.System.Mem.StableName
=====================================
libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
=====================================
@@ -28,7 +28,6 @@ module GHC.Internal.ByteOrder
import GHC.Internal.Base
import GHC.Internal.Enum
import GHC.Internal.Generics (Generic)
-import GHC.Internal.Text.Read
import GHC.Internal.Text.Show
-- | Byte ordering.
@@ -39,7 +38,6 @@ data ByteOrder
, Ord -- ^ @since base-4.11.0.0
, Bounded -- ^ @since base-4.11.0.0
, Enum -- ^ @since base-4.11.0.0
- , Read -- ^ @since base-4.11.0.0
, Show -- ^ @since base-4.11.0.0
, Generic -- ^ @since base-4.15.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
=====================================
@@ -61,6 +61,7 @@ module GHC.Internal.Data.Data (
mkIntType,
mkFloatType,
mkCharType,
+ mkPrimCon,
mkNoRepType,
-- ** Observers
dataTypeName,
@@ -94,7 +95,6 @@ module GHC.Internal.Data.Data (
constrIndex,
-- ** From strings to constructors and vice versa: all data types
showConstr,
- readConstr,
-- * Convenience functions: take type constructors apart
tyconUQname,
@@ -123,10 +123,8 @@ import GHC.Internal.Data.Version( Version(..) )
import GHC.Internal.Base hiding (Any, IntRep, FloatRep, NonEmpty(..))
import GHC.Internal.List
import GHC.Internal.Num
-import GHC.Internal.Read
import GHC.Internal.Show
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.Text.Read( reads )
-- Imports for the instances
import GHC.Internal.Data.Functor.Identity -- So we can give Data instance for Identity
@@ -682,32 +680,6 @@ showConstr :: Constr -> String
showConstr = constring
--- | Lookup a constructor via a string
-readConstr :: DataType -> String -> Maybe Constr
-readConstr dt str =
- case dataTypeRep dt of
- AlgRep cons -> idx cons
- IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
- FloatRep -> mkReadCon ffloat
- CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
- NoRep -> Nothing
- where
-
- -- Read a value and build a constructor
- mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
- mkReadCon f = case (reads str) of
- [(t,"")] -> Just (f t)
- _ -> Nothing
-
- -- Traverse list of algebraic datatype constructors
- idx :: [Constr] -> Maybe Constr
- idx cons = case filter ((==) str . showConstr) cons of
- [] -> Nothing
- hd : _ -> Just hd
-
- ffloat :: Double -> Constr
- ffloat = mkPrimCon dt str . FloatConstr . toRational
-
------------------------------------------------------------------------------
--
-- Convenience functions: algebraic data types
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
=====================================
@@ -10,7 +10,7 @@
--
-- Maintainer : libraries(a)haskell.org
-- Stability : stable
--- Portability : non-portable (local universal quantification in ReadP)
+-- Portability : non-portable
--
-- A general library for representation and manipulation of versions.
--
@@ -31,23 +31,18 @@ module GHC.Internal.Data.Version (
-- * The @Version@ type
Version(..),
-- * A concrete representation of @Version@
- showVersion, parseVersion,
+ showVersion,
-- * Constructor function
makeVersion
) where
-import GHC.Internal.Data.Functor ( Functor(..) )
import GHC.Internal.Data.Eq
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
-import GHC.Internal.Base ( Applicative(..), (&&), String )
+import GHC.Internal.Base ( (&&), String )
import GHC.Internal.Generics
-import GHC.Internal.Unicode ( isDigit, isAlphaNum )
-import GHC.Internal.Read
import GHC.Internal.Show
-import GHC.Internal.Text.ParserCombinators.ReadP
-import GHC.Internal.Text.Read ( read )
{- |
A 'Version' represents the version of a software entity.
@@ -69,8 +64,8 @@ operations are the right thing for every 'Version'.
Similarly, concrete representations of versions may differ. One
possible concrete representation is provided (see 'showVersion' and
-'parseVersion'), but depending on the application a different concrete
-representation may be more appropriate.
+'Data.Version.parseVersion'), but depending on the application a
+different concrete representation may be more appropriate.
-}
data Version =
Version { versionBranch :: [Int],
@@ -92,8 +87,7 @@ data Version =
-- The interpretation of the list of tags is entirely dependent
-- on the entity that this version applies to.
}
- deriving ( Read -- ^ @since base-2.01
- , Show -- ^ @since base-2.01
+ deriving ( Show -- ^ @since base-2.01
, Generic -- ^ @since base-4.9.0.0
)
{-# DEPRECATED versionTags "See GHC ticket #2496" #-}
@@ -121,13 +115,6 @@ showVersion (Version branch tags)
= concat (intersperse "." (map show branch)) ++
concatMap ('-':) tags
--- | A parser for versions in the format produced by 'showVersion'.
---
-parseVersion :: ReadP Version
-parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
- tags <- many (char '-' *> munch1 isAlphaNum)
- pure Version{versionBranch=branch, versionTags=tags}
-
-- | Construct tag-less 'Version'
--
-- @since base-4.8.0.0
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Internal.Base
import GHC.Internal.Word
import GHC.Internal.Arr
import GHC.Internal.Enum
-import GHC.Internal.Read
import GHC.Internal.Show
import GHC.Internal.Ptr
import GHC.Internal.Num
@@ -179,7 +178,6 @@ data SeekMode
, Ord -- ^ @since base-4.2.0.0
, Ix -- ^ @since base-4.2.0.0
, Enum -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
=====================================
@@ -48,7 +48,6 @@ import GHC.Internal.IO.BufferedIO
import GHC.Internal.IO.Encoding.Types
import GHC.Internal.IORef
import GHC.Internal.Show
-import GHC.Internal.Read
import GHC.Internal.Word
import GHC.Internal.IO.Device
import GHC.Internal.Data.Typeable
@@ -270,7 +269,6 @@ data BufferMode
-- is 'Just' @n@ and is otherwise implementation-dependent.
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
@@ -376,7 +374,6 @@ data Newline = LF -- ^ @\'\\n\'@
| CRLF -- ^ @\'\\r\\n\'@
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.3.0.0
- , Read -- ^ @since base-4.3.0.0
, Show -- ^ @since base-4.3.0.0
)
@@ -393,7 +390,6 @@ data NewlineMode
}
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.3.0.0
- , Read -- ^ @since base-4.3.0.0
, Show -- ^ @since base-4.3.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
=====================================
@@ -20,7 +20,6 @@ module GHC.Internal.IO.IOMode (IOMode(..)) where
import GHC.Internal.Base
import GHC.Internal.Show
-import GHC.Internal.Read
import GHC.Internal.Arr
import GHC.Internal.Enum
@@ -30,7 +29,6 @@ data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
, Ord -- ^ @since base-4.2.0.0
, Ix -- ^ @since base-4.2.0.0
, Enum -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/Numeric.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
-----------------------------------------------------------------------------
-- |
@@ -16,274 +15,22 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.Numeric (
-
- -- * Showing
-
- showSigned,
-
- showIntAtBase,
- showInt,
- showBin,
- showHex,
- showOct,
-
- showEFloat,
- showFFloat,
- showGFloat,
- showFFloatAlt,
- showGFloatAlt,
- showFloat,
- showHFloat,
-
- floatToDigits,
-
- -- * Reading
-
- -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase',
- -- and 'readDec' is the \`dual\' of 'showInt'.
- -- The inconsistent naming is a historical accident.
-
- readSigned,
-
- readInt,
- readBin,
- readDec,
- readOct,
- readHex,
-
- readFloat,
-
- lexDigits,
-
- -- * Miscellaneous
-
- fromRat,
- Floating(..)
-
- ) where
+module GHC.Internal.Numeric (showIntAtBase, showHex) where
import GHC.Internal.Base
-import GHC.Internal.Read
-import GHC.Internal.Real
-import GHC.Internal.Float
-import GHC.Internal.Num
-import GHC.Internal.Show
-import GHC.Internal.Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
-import qualified GHC.Internal.Text.Read.Lex as L
-
--- $setup
--- >>> import Prelude
-
--- -----------------------------------------------------------------------------
--- Reading
-
--- | Reads an /unsigned/ integral value in an arbitrary base.
-readInt :: Num a
- => a -- ^ the base
- -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base
- -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int'
- -> ReadS a
-readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
-
--- | Read an unsigned number in binary notation.
---
--- >>> readBin "10011"
--- [(19,"")]
-readBin :: (Eq a, Num a) => ReadS a
-readBin = readP_to_S L.readBinP
-
--- | Read an unsigned number in octal notation.
---
--- >>> readOct "0644"
--- [(420,"")]
-readOct :: (Eq a, Num a) => ReadS a
-readOct = readP_to_S L.readOctP
-
--- | Read an unsigned number in decimal notation.
---
--- >>> readDec "0644"
--- [(644,"")]
-readDec :: (Eq a, Num a) => ReadS a
-readDec = readP_to_S L.readDecP
-
--- | Read an unsigned number in hexadecimal notation.
--- Both upper or lower case letters are allowed.
---
--- >>> readHex "deadbeef"
--- [(3735928559,"")]
-readHex :: (Eq a, Num a) => ReadS a
-readHex = readP_to_S L.readHexP
-
--- | Reads an /unsigned/ 'RealFrac' value,
--- expressed in decimal scientific notation.
---
--- Note that this function takes time linear in the magnitude of its input
--- which can scale exponentially with input size (e.g. @"1e100000000"@ is a
--- very large number while having a very small textual form).
--- For this reason, users should take care to avoid using this function on
--- untrusted input. Users needing to parse floating point values
--- (e.g. 'Float') are encouraged to instead use 'read', which does
--- not suffer from this issue.
-readFloat :: RealFrac a => ReadS a
-readFloat = readP_to_S readFloatP
-
-readFloatP :: RealFrac a => ReadP a
-readFloatP =
- do tok <- L.lex
- case tok of
- L.Number n -> return $ fromRational $ L.numberToRational n
- _ -> pfail
-
--- It's turgid to have readSigned work using list comprehensions,
--- but it's specified as a ReadS to ReadS transformer
--- With a bit of luck no one will use it.
-
--- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
-readSigned :: (Real a) => ReadS a -> ReadS a
-readSigned readPos = readParen False read'
- where read' r = read'' r ++
- (do
- ("-",s) <- lex r
- (x,t) <- read'' s
- return (-x,t))
- read'' r = do
- (str,s) <- lex r
- (n,"") <- readPos str
- return (n,s)
-
--- -----------------------------------------------------------------------------
--- Showing
-
--- | Show /non-negative/ 'Integral' numbers in base 10.
-showInt :: Integral a => a -> ShowS
-showInt n0 cs0
- | n0 < 0 = errorWithoutStackTrace "GHC.Internal.Numeric.showInt: can't show negative numbers"
- | otherwise = go n0 cs0
- where
- go n cs
- | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
- c@(C# _) -> c:cs
- | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
- c@(C# _) -> go q (c:cs)
- where
- (q,r) = n `quotRem` 10
-
--- Controlling the format and precision of floats. The code that
--- implements the formatting itself is in @PrelNum@ to avoid
--- mutual module deps.
-
-{-# SPECIALIZE showEFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showEFloat ::
- Maybe Int -> Double -> ShowS #-}
-{-# SPECIALIZE showFFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showFFloat ::
- Maybe Int -> Double -> ShowS #-}
-{-# SPECIALIZE showGFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showGFloat ::
- Maybe Int -> Double -> ShowS #-}
-
--- | Show a signed 'RealFloat' value
--- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
---
--- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation (e.g. @245000@, @0.0015@).
---
--- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
---
--- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
-showEFloat d x = showString (formatRealFloat FFExponent d x)
-showFFloat d x = showString (formatRealFloat FFFixed d x)
-showGFloat d x = showString (formatRealFloat FFGeneric d x)
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation (e.g. @245000@, @0.0015@).
---
--- This behaves as 'showFFloat', except that a decimal point
--- is always guaranteed, even if not needed.
---
--- @since base-4.7.0.0
-showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
---
--- This behaves as 'showFFloat', except that a decimal point
--- is always guaranteed, even if not needed.
---
--- @since base-4.7.0.0
-showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
-
-showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x)
-showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x)
-
-{- | Show a floating-point value in the hexadecimal format,
-similar to the @%a@ specifier in C's printf.
-
- >>> showHFloat (212.21 :: Double) ""
- "0x1.a86b851eb851fp7"
- >>> showHFloat (-12.76 :: Float) ""
- "-0x1.9851ecp3"
- >>> showHFloat (-0 :: Double) ""
- "-0x0p+0"
-
-@since base-4.11.0.0
--}
-showHFloat :: RealFloat a => a -> ShowS
-showHFloat = showString . fmt
- where
- fmt x
- | isNaN x = "NaN"
- | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity"
- | x < 0 || isNegativeZero x = '-' : cvt (-x)
- | otherwise = cvt x
-
- cvt x
- | x == 0 = "0x0p+0"
- | otherwise =
- case floatToDigits 2 x of
- r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r
- (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1)
-
- -- Given binary digits, convert them to hex in blocks of 4
- -- Special case: If all 0's, just drop it.
- frac digits
- | allZ digits = ""
- | otherwise = "." ++ hex digits
- where
- hex ds =
- case ds of
- [] -> ""
- [a] -> hexDigit a 0 0 0 ""
- [a,b] -> hexDigit a b 0 0 ""
- [a,b,c] -> hexDigit a b c 0 ""
- a : b : c : d : r -> hexDigit a b c d (hex r)
-
- hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)
-
- allZ xs = case xs of
- x : more -> x == 0 && allZ more
- [] -> True
+ (
+ seq,
+ ($),
+ otherwise,
+ Char,
+ Int,
+ (<),
+ (<=),
+ errorWithoutStackTrace
+ )
+import GHC.Internal.List ((++))
+import GHC.Internal.Real (Integral, toInteger, fromIntegral, quotRem)
+import GHC.Internal.Show (ShowS, show, intToDigit)
-- ---------------------------------------------------------------------------
-- Integer printing functions
@@ -307,11 +54,3 @@ showIntAtBase base toChr n0 r0
-- | Show /non-negative/ 'Integral' numbers in base 16.
showHex :: Integral a => a -> ShowS
showHex = showIntAtBase 16 intToDigit
-
--- | Show /non-negative/ 'Integral' numbers in base 8.
-showOct :: Integral a => a -> ShowS
-showOct = showIntAtBase 8 intToDigit
-
--- | Show /non-negative/ 'Integral' numbers in base 2.
-showBin :: Integral a => a -> ShowS
-showBin = showIntAtBase 2 intToDigit
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs deleted
=====================================
@@ -1,816 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
-{-# OPTIONS_GHC -Wno-x-partial #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.System.IO
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : stable
--- Portability : portable
---
--- The standard IO library.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.System.IO (
- -- * The IO monad
-
- 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.Data.Bits
-import GHC.Internal.Data.Maybe
-import GHC.Internal.Foreign.C.Error
-#if defined(mingw32_HOST_OS)
-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
-import GHC.Internal.List
-#if !defined(mingw32_HOST_OS)
-import GHC.Internal.IORef
-#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
------------------------------------------------------------------------------
--- 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
-
--- | The same as 'putStr', but adds a newline character.
---
--- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
-putStrLn :: String -> IO ()
-putStrLn s = hPutStrLn stdout s
-
--- | The 'print' function outputs a value of any printable type to the
--- standard output device.
--- Printable types are those that are instances of class 'Show'; 'print'
--- converts values to strings for output using the 'show' operation and
--- adds a newline.
---
--- 'print' is implemented as @'putStrLn' '.' 'show'@
---
--- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
---
--- ==== __Examples__
---
--- >>> print [1, 2, 3]
--- [1,2,3]
---
--- Be careful when using 'print' for outputting strings,
--- as this will invoke 'show' and cause strings to be printed
--- with quotation marks and non-ascii symbols escaped.
---
--- >>> print "λ :D"
--- "\995 :D"
---
--- A program to print the first 8 integers and their
--- powers of 2 could be written as:
---
--- >>> print [(n, 2^n) | n <- [0..8]]
--- [(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
@@ -9452,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
@@ -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 :: *
@@ -12495,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’
@@ -12524,7 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12539,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -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
@@ -9490,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
@@ -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 :: *
@@ -12524,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’
@@ -12553,7 +12554,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12568,16 +12569,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -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
@@ -9732,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
@@ -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 :: *
@@ -12766,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’
@@ -12795,7 +12796,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance GHC.Internal.Read.Read GHC.Internal.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Internal.Event.Windows.ConsoleEvent’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12811,16 +12812,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -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
@@ -9452,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
@@ -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 :: *
@@ -12495,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’
@@ -12524,7 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12539,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1316df54f95bca1f75b0b61f79da6a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1316df54f95bca1f75b0b61f79da6a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-implementation-into-base] Move the `System.IO` implementation into `base`
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
12 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-implementation-into-base at Glasgow Haskell Compiler / GHC
Commits:
26582cd6 by Wolfgang Jeltsch at 2026-03-12T22:02:56+02:00
Move the `System.IO` implementation into `base`
- - - - -
10 changed files:
- 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/ghc-internal.cabal.in
- − 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
Changes:
=====================================
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,9 +185,701 @@ module System.IO
nativeNewlineMode
) where
-import GHC.Internal.System.IO
+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 Data.Int (Int)
+import Data.IORef (IORef, newIORef)
+import System.IO.Error (userError)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Internals
+ (
+ c_getpid,
+ c_open,
+ o_CREAT,
+ 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 (Errno, eEXIST, getErrno, errnoToIOError)
+import GHC.Base (Bool (False, True), otherwise, failIO)
+import GHC.Err (errorWithoutStackTrace)
+import GHC.List (null, elem, last, (++), reverse, break)
+import GHC.Num ((+))
+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,
+ SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd),
+ 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.IORef (atomicModifyIORef'_)
import GHC.Internal.Control.Monad.Fix (fixIO)
+#if defined(mingw32_HOST_OS)
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils (with)
+import Foreign.Storable
+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)
+#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
+
+-- | The same as 'putStr', but adds a newline character.
+--
+-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
+putStrLn :: String -> IO ()
+putStrLn s = hPutStrLn stdout s
+
+-- | The 'print' function outputs a value of any printable type to the
+-- standard output device.
+-- Printable types are those that are instances of class 'Show'; 'print'
+-- converts values to strings for output using the 'show' operation and
+-- adds a newline.
+--
+-- 'print' is implemented as @'putStrLn' '.' 'show'@
+--
+-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
+--
+-- ==== __Examples__
+--
+-- >>> print [1, 2, 3]
+-- [1,2,3]
+--
+-- Be careful when using 'print' for outputting strings,
+-- as this will invoke 'show' and cause strings to be printed
+-- with quotation marks and non-ascii symbols escaped.
+--
+-- >>> print "λ :D"
+-- "\995 :D"
+--
+-- A program to print the first 8 integers and their
+-- powers of 2 could be written as:
+--
+-- >>> print [(n, 2^n) | n <- [0..8]]
+-- [(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
+
-- $locking
-- Implementations should enforce as far as possible, at least locally to the
-- Haskell process, multiple-reader single-writer locking on files.
=====================================
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/ghc-internal.cabal.in
=====================================
@@ -323,7 +323,6 @@ Library
GHC.Internal.Numeric.Natural
GHC.Internal.System.Environment
GHC.Internal.System.Environment.Blank
- GHC.Internal.System.IO
GHC.Internal.System.IO.Error
GHC.Internal.System.Mem
GHC.Internal.System.Mem.StableName
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs deleted
=====================================
@@ -1,816 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
-{-# OPTIONS_GHC -Wno-x-partial #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.System.IO
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : stable
--- Portability : portable
---
--- The standard IO library.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.System.IO (
- -- * The IO monad
-
- 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.Data.Bits
-import GHC.Internal.Data.Maybe
-import GHC.Internal.Foreign.C.Error
-#if defined(mingw32_HOST_OS)
-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
-import GHC.Internal.List
-#if !defined(mingw32_HOST_OS)
-import GHC.Internal.IORef
-#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
------------------------------------------------------------------------------
--- 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
-
--- | The same as 'putStr', but adds a newline character.
---
--- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
-putStrLn :: String -> IO ()
-putStrLn s = hPutStrLn stdout s
-
--- | The 'print' function outputs a value of any printable type to the
--- standard output device.
--- Printable types are those that are instances of class 'Show'; 'print'
--- converts values to strings for output using the 'show' operation and
--- adds a newline.
---
--- 'print' is implemented as @'putStrLn' '.' 'show'@
---
--- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
---
--- ==== __Examples__
---
--- >>> print [1, 2, 3]
--- [1,2,3]
---
--- Be careful when using 'print' for outputting strings,
--- as this will invoke 'show' and cause strings to be printed
--- with quotation marks and non-ascii symbols escaped.
---
--- >>> print "λ :D"
--- "\995 :D"
---
--- A program to print the first 8 integers and their
--- powers of 2 could be written as:
---
--- >>> print [(n, 2^n) | n <- [0..8]]
--- [(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 :: *
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26582cd66fd49ffeedd5a48eb06c6db…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26582cd66fd49ffeedd5a48eb06c6db…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/kill-CodeSrcFlag] 2 commits: make VDQWarningCtxt landmark
by Apoorv Ingle (＠ani) 12 Mar '26
by Apoorv Ingle (＠ani) 12 Mar '26
12 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-CodeSrcFlag at Glasgow Haskell Compiler / GHC
Commits:
3ea76063 by Apoorv Ingle at 2026-03-12T14:33:47-05:00
make VDQWarningCtxt landmark
- - - - -
875bb4a5 by Apoorv Ingle at 2026-03-12T14:33:47-05:00
make addExpansionErrCtxt also sets tcl_in_gen_code
- - - - -
2 changed files:
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Tc/Types/ErrCtxt.hs
=====================================
@@ -396,4 +396,5 @@ data ErrCtxtMsg
isErrCtxtMsgLandmark :: ErrCtxtMsg -> Bool
isErrCtxtMsgLandmark (DerivBindCtxt{}) = True
isErrCtxtMsgLandmark (FunResCtxt{}) = True
+isErrCtxtMsgLandmark (VDQWarningCtxt{}) = True
isErrCtxtMsgLandmark _ = False
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1376,7 +1376,7 @@ addErrCtxt msg = addErrCtxtM msg
-- See Note [ErrCtxtStack Manipulation]
addExpansionErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a
{-# INLINE addExpansionErrCtxt #-} -- Note [Inlining addErrCtxt]
-addExpansionErrCtxt msg = addExpansionErrCtxtM msg
+addExpansionErrCtxt msg = setInGeneratedCode $ addExpansionErrCtxtM msg
-- | Add a message to the error context. This message may do tidying.
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6f83aa401efeb7a28fdd5133b2906…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6f83aa401efeb7a28fdd5133b2906…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/kill-CodeSrcFlag] make addExpansionErrCtxt also sets tcl_in_gen_code
by Apoorv Ingle (＠ani) 12 Mar '26
by Apoorv Ingle (＠ani) 12 Mar '26
12 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-CodeSrcFlag at Glasgow Haskell Compiler / GHC
Commits:
c6f83aa4 by Apoorv Ingle at 2026-03-12T14:14:12-05:00
make addExpansionErrCtxt also sets tcl_in_gen_code
- - - - -
1 changed file:
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1376,7 +1376,7 @@ addErrCtxt msg = addErrCtxtM msg
-- See Note [ErrCtxtStack Manipulation]
addExpansionErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a
{-# INLINE addExpansionErrCtxt #-} -- Note [Inlining addErrCtxt]
-addExpansionErrCtxt msg = addExpansionErrCtxtM msg
+addExpansionErrCtxt msg = setInGeneratedCode $ addExpansionErrCtxtM msg
-- | Add a message to the error context. This message may do tidying.
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6f83aa401efeb7a28fdd5133b2906b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6f83aa401efeb7a28fdd5133b2906b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Teo Camarasu deleted branch wip/T26875-1 at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/jeltsch/system-io-implementation-into-base
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
12 Mar '26
Wolfgang Jeltsch pushed new branch wip/jeltsch/system-io-implementation-into-base at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/system-io-implementat…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/jeltsch/text-read-uncovering
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 12 Mar '26
12 Mar '26
Wolfgang Jeltsch pushed new branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/text-read-uncovering
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FINAL] 2 commits: Fix terminfo dependency
by Sven Tennie (＠supersven) 12 Mar '26
by Sven Tennie (＠supersven) 12 Mar '26
12 Mar '26
Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FINAL at Glasgow Haskell Compiler / GHC
Commits:
83309247 by Sven Tennie at 2026-03-12T18:08:28+00:00
Fix terminfo dependency
- - - - -
f434973e by Sven Tennie at 2026-03-12T18:08:48+00:00
Simplify terminfo flag logic
- - - - -
1 changed file:
- hadrian/src/Settings/Packages.hs
Changes:
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -92,7 +92,7 @@ packageArgs = do
-- target code, otherwise enable for stage2 since that runs on
-- the target and can use target's own ghci object linker
[ andM [expr (ghcWithInterpreter stage), orM [expr (notM cross), stage2]] `cabalFlag` "internal-interpreter"
- , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo"
+ , haveCurses `cabalFlag` "terminfo"
, arg "-build-tool-depends"
, staged (buildFlag UseLibzstd) `cabalFlag` "with-libzstd"
-- ROMES: While the boot compiler is not updated wrt -this-unit-id
@@ -128,7 +128,7 @@ packageArgs = do
-------------------------------- ghcPkg --------------------------------
, package ghcPkg ?
- builder (Cabal Flags) ? orM [ notM cross, haveCurses ] `cabalFlag` "terminfo"
+ builder (Cabal Flags) ? haveCurses `cabalFlag` "terminfo"
-------------------------------- ghcBoot ------------------------------
, package ghcBoot ?
@@ -196,11 +196,8 @@ packageArgs = do
-- and executables. This flag disables the latter.
, package haskeline ?
builder (Cabal Flags) ? arg "-examples"
- -- Don't depend upon terminfo when cross-compiling to avoid unnecessary
- -- dependencies unless the user provided ncurses explicitly.
- -- TODO: Perhaps the user should be able to explicitly enable/disable this.
, package haskeline ?
- builder (Cabal Flags) ? orM [ notM cross, haveCurses ] `cabalFlag` "terminfo"
+ builder (Cabal Flags) ? haveCurses `cabalFlag` "terminfo"
-------------------------------- terminfo ------------------------------
, package terminfo ?
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bcfd140909e9223ebaba055a5ebc6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bcfd140909e9223ebaba055a5ebc6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0