- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/andreask/linker_fix] more debug wibbles
by Andreas Klebinger (＠AndreasK) 29 Jan '26

29 Jan '26

Andreas Klebinger pushed to branch wip/andreask/linker_fix at Glasgow Haskell Compiler / GHC Commits: d49cb21a by Andreas Klebinger at 2026-01-29T13:38:53+01:00 more debug wibbles - - - - - 2 changed files: - rts/linker/LoadArchive.c - rts/linker/MachO.c Changes: ===================================== rts/linker/LoadArchive.c ===================================== @@ -574,6 +574,7 @@ HsInt loadArchive_ (pathchar *path) #endif ) { + ASSERT(!isGnuIndex); DEBUG_LOG("Member might be an object file...loading...\n"); #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) if (RTS_LINKER_USE_MMAP) @@ -635,6 +636,7 @@ HsInt loadArchive_ (pathchar *path) if (0 == loadOc(oc)) { errorBelch("Failed to load OC %" PATH_FMT " , aborting.\n", path); stgFree(fileName); + freeObjectCode( oc ); fclose(f); return 0; } else { ===================================== rts/linker/MachO.c ===================================== @@ -1772,7 +1772,7 @@ machoGetMisalignment( FILE * f, int* misalignment_out ) fseek(f, -sizeof(header), SEEK_CUR); if(header.magic != MH_MAGIC_64) { - debugBelch("Bad magic. Expected: %08x, got: %08x.", + errorBelch("Bad magic. Expected: %08x, got: %08x.", MH_MAGIC_64, header.magic); return 0; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d49cb21aaebac390ddbcb686c9d801e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d49cb21aaebac390ddbcb686c9d801e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T26826
by Simon Peyton Jones (＠simonpj) 29 Jan '26

29 Jan '26

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

1 0

[Git][ghc/ghc][wip/andreask/linker_fix] debug wibbles
by Andreas Klebinger (＠AndreasK) 29 Jan '26

29 Jan '26

Andreas Klebinger pushed to branch wip/andreask/linker_fix at Glasgow Haskell Compiler / GHC Commits: 2c39a9a3 by Andreas Klebinger at 2026-01-29T13:32:00+01:00 debug wibbles - - - - - 4 changed files: - rts/Linker.c - rts/linker/LoadArchive.c - rts/linker/MachO.c - rts/linker/PEi386.c Changes: ===================================== rts/Linker.c ===================================== @@ -1415,7 +1415,7 @@ preloadObjectFile (pathchar *path) // We calculate the correct alignment from the header before // reading the file, and then we misalign image on purpose so // that the actual sections end up aligned again. - machoGetMisalignment(f, &misalignment); + int valid_macho = machoGetMisalignment(f, &misalignment); //machoGetMisalignment might fail to parse the header, but in that //case so will verifyAndInitOc so we leave cleanup to after verifyAndInitOc. image = stgMallocBytes(fileSize + misalignment, "loadObj(image)"); @@ -1504,7 +1504,7 @@ HsInt loadObj (pathchar *path) return r; } -// Call the relevant VeriffyImage_* and ocInit_* functions. +// Call the relevant VerifyImage_* and ocInit_* functions. // Return 1 on success. HsInt verifyAndInitOc (ObjectCode* oc) { ===================================== rts/linker/LoadArchive.c ===================================== @@ -26,6 +26,7 @@ #include <ctype.h> #include <sys/types.h> #include <fs_rts.h> +#include <stdio.h> #define FAIL(...) do {\ errorBelch("loadArchive: "__VA_ARGS__); \ @@ -33,6 +34,7 @@ } while (0) #define DEBUG_LOG(...) IF_DEBUG(linker, debugBelch("loadArchive: " __VA_ARGS__)) +#define DEBUG_LOG_ALWAYS(...) (fprintf(stderr, "loadArchive: " __VA_ARGS__)) #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) @@ -344,7 +346,7 @@ HsInt loadArchive_ (pathchar *path) Ignore requests to load multiple times */ if (isAlreadyLoaded(path)) { IF_DEBUG(linker, - debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); + DEBUG_LOG("ignoring repeated load of %" PATH_FMT "\n", path)); return 1; /* success */ } @@ -365,6 +367,7 @@ HsInt loadArchive_ (pathchar *path) bool isThin = archive_fmt == ThinArchive; if(isThin) { DEBUG_LOG("Found thin archive.\n"); + DEBUG_LOG_ALWAYS("Found thin archive.\n"); } DEBUG_LOG("loading archive contents\n"); @@ -630,6 +633,7 @@ HsInt loadArchive_ (pathchar *path) if (0 == loadOc(oc)) { + errorBelch("Failed to load OC %" PATH_FMT " , aborting.\n", path); stgFree(fileName); fclose(f); return 0; ===================================== rts/linker/MachO.c ===================================== @@ -175,7 +175,7 @@ resolveImports( int ocAllocateExtras_MachO(ObjectCode* oc) { - IF_DEBUG(linker, debugBelch("ocAllocateExtras_MachO: start\n")); + IF_DEBUG(linker, DEBUG_LOG_ALWAYS("ocAllocateExtras_MachO: start\n")); if (NULL != oc->info->symCmd) { IF_DEBUG(linker, @@ -200,6 +200,10 @@ int ocVerifyImage_MachO(ObjectCode * oc) { char *image = (char*) oc->image; + if (oc->fileSize < sizeof(MachOHeader)) { + errorBelch("Tried loading machO smaller than header size.\n"); + return 0; + } MachOHeader *header = (MachOHeader*) image; IF_DEBUG(linker, debugBelch("ocVerifyImage_MachO: start\n")); ===================================== rts/linker/PEi386.c ===================================== @@ -475,7 +475,7 @@ static void addDLLHandle( static bool verifyCOFFHeader( uint16_t machine, - IMAGE_FILE_HEADER *hdr + IMAGE_FILE_HEADER *hdr, pathchar *fileName); static bool checkIfDllLoaded( View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c39a9a3c98b958e0d4f2da917e1067… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c39a9a3c98b958e0d4f2da917e1067… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26834] 3 commits: ghc-internal: refine List imports
by Teo Camarasu (＠teo) 29 Jan '26

29 Jan '26

Teo Camarasu pushed to branch wip/T26834 at Glasgow Haskell Compiler / GHC Commits: 1abfa580 by Teo Camarasu at 2026-01-29T11:14:21+00:00 ghc-internal: refine List imports - - - - - d2c0db71 by Teo Camarasu at 2026-01-29T11:14:21+00:00 Move MonadFix Identity into Monad.Fix - - - - - c7d4cf5e by Teo Camarasu at 2026-01-29T11:14:21+00:00 Split out GHC.Internal.Data.Ord.Down - - - - - 23 changed files: - libraries/base/src/Data/Ord.hs - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs - libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs - libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs - + libraries/ghc-internal/src/GHC/Internal/Data/Ord/Down.hs - libraries/ghc-internal/src/GHC/Internal/Data/String.hs - libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Version.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Generics.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs - libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc - libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc - libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs Changes: ===================================== libraries/base/src/Data/Ord.hs ===================================== @@ -21,4 +21,5 @@ module Data.Ord clamp ) where -import GHC.Internal.Data.Ord \ No newline at end of file +import GHC.Internal.Data.Ord +import GHC.Internal.Data.Ord.Down ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -160,6 +160,7 @@ Library GHC.Internal.Data.NonEmpty GHC.Internal.Data.OldList GHC.Internal.Data.Ord + GHC.Internal.Data.Ord.Down GHC.Internal.Data.Proxy GHC.Internal.Data.Semigroup.Internal GHC.Internal.Data.STRef @@ -576,4 +577,4 @@ Library ghc-options: -this-unit-id ghc-internal -- Make sure we don't accidentally regress into anti-patterns - ghc-options: -Wcompat -Wnoncanonical-monad-instances + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Werror=unused-imports ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs ===================================== @@ -33,13 +33,13 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Monoid ( Monoid, Dual(..), Sum(..), Product(..) , First(..), Last(..), Alt(..), Ap(..) ) import GHC.Internal.Data.NonEmpty ( NonEmpty(..) ) -import GHC.Internal.Data.Ord ( Down(..) ) import GHC.Internal.Data.Tuple ( Solo(..), snd ) import GHC.Internal.Base ( Monad, errorWithoutStackTrace, (.) ) import GHC.Internal.Generics import GHC.Internal.List ( head, drop ) import GHC.Internal.Control.Monad.ST.Imp import GHC.Internal.System.IO +import GHC.Internal.Data.Functor.Identity (Identity(..)) -- | Monads having fixed points with a \'knot-tying\' semantics. -- Instances of 'MonadFix' should satisfy the following laws: @@ -166,8 +166,6 @@ instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where fstP (a :*: _) = a sndP (_ :*: b) = b --- Instances for Data.Ord - --- | @since base-4.12.0.0 -instance MonadFix Down where - mfix f = Down (fix (getDown . f)) +-- | @since base-4.8.0.0 +instance MonadFix Identity where + mfix f = Identity (fix (runIdentity . f)) ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs ===================================== @@ -23,12 +23,11 @@ import GHC.Internal.Data.Functor.Identity import qualified GHC.Internal.Data.Functor import GHC.Internal.Data.Monoid import GHC.Internal.Data.NonEmpty ( NonEmpty(..) ) -import GHC.Internal.Data.Ord ( Down(..) ) import GHC.Internal.Data.Proxy --import qualified Data.List.NonEmpty as NE import GHC.Internal.Generics import qualified GHC.Internal.Data.List.NonEmpty as NE -import qualified GHC.Internal.Data.List as List +import qualified GHC.Internal.List as List import GHC.Internal.Data.Maybe import GHC.Internal.Data.Tuple --import Prelude @@ -136,9 +135,3 @@ instance MonadZip f => MonadZip (M1 i c f) where -- | @since 4.9.0.0 instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2 - --- instances for GHC.Internal.Data.Ord - --- | @since 4.12.0.0 -instance MonadZip Down where - mzipWith = liftM2 ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Data.hs ===================================== @@ -116,8 +116,8 @@ import GHC.Internal.Data.Eq import GHC.Internal.Data.Maybe import GHC.Internal.Data.Monoid import GHC.Internal.Data.NonEmpty ( NonEmpty(..) ) -import GHC.Internal.Data.Ord -import GHC.Internal.Data.List (findIndex) +import GHC.Internal.Data.Ord.Down +import GHC.Internal.Data.OldList (findIndex) import GHC.Internal.Data.Typeable import GHC.Internal.Data.Version( Version(..) ) import GHC.Internal.Base hiding (Any, IntRep, FloatRep, NonEmpty(..)) ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs ===================================== @@ -921,9 +921,6 @@ deriving instance Foldable UInt -- | @since base-4.9.0.0 deriving instance Foldable UWord --- Instances for Data.Ord --- | @since base-4.12.0.0 -deriving instance Foldable Down -- | Right-to-left monadic fold over the elements of a structure. -- ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Internal.Data.Functor.Identity ( Identity(..), ) where -import GHC.Internal.Control.Monad.Fix import GHC.Internal.Data.Bits (Bits, FiniteBits) import GHC.Internal.Data.Coerce import GHC.Internal.Data.Foldable @@ -143,7 +142,3 @@ instance Applicative Identity where -- | @since base-4.8.0.0 instance Monad Identity where m >>= k = k (runIdentity m) - --- | @since base-4.8.0.0 -instance MonadFix Identity where - mfix f = Identity (fix (runIdentity . f)) ===================================== libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs ===================================== @@ -8,7 +8,7 @@ module GHC.Internal.Data.List.NonEmpty ) where import GHC.Internal.Data.NonEmpty (NonEmpty (..), map) -import qualified GHC.Internal.Data.List as List +import qualified GHC.Internal.List as List -- | The 'zip' function takes two streams and returns a stream of -- corresponding pairs. ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs ===================================== @@ -19,21 +19,11 @@ module GHC.Internal.Data.Ord ( Ord(..), Ordering(..), - Down(..), comparing, clamp, ) where -import GHC.Internal.Data.Bits (Bits, FiniteBits, complement) -import GHC.Internal.Foreign.Storable (Storable) -import GHC.Internal.Ix (Ix) import GHC.Internal.Base -import GHC.Internal.Enum (Bounded(..), Enum(..)) -import GHC.Internal.Float (Floating, RealFloat) -import GHC.Internal.Num -import GHC.Internal.Read -import GHC.Internal.Real (Fractional, Real, RealFrac) -import GHC.Internal.Show -- $setup -- >>> import Prelude @@ -68,115 +58,3 @@ comparing p x y = compare (p x) (p y) -- @since base-4.16.0.0 clamp :: (Ord a) => (a, a) -> a -> a clamp (low, high) a = min high (max a low) - --- | The 'Down' type allows you to reverse sort order conveniently. A value of type --- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@). --- --- If @a@ has an @'Ord'@ instance associated with it then comparing two --- values thus wrapped will give you the opposite of their normal sort order. --- This is particularly useful when sorting in generalised list comprehensions, --- as in: @then sortWith by 'Down' x@. --- --- >>> compare True False --- GT --- --- >>> compare (Down True) (Down False) --- LT --- --- If @a@ has a @'Bounded'@ instance then the wrapped instance also respects --- the reversed ordering by exchanging the values of @'minBound'@ and --- @'maxBound'@. --- --- >>> minBound :: Int --- -9223372036854775808 --- --- >>> minBound :: Down Int --- Down 9223372036854775807 --- --- All other instances of @'Down' a@ behave as they do for @a@. --- --- @since base-4.6.0.0 -newtype Down a = Down - { getDown :: a -- ^ @since base-4.14.0.0 - } - deriving - ( Eq -- ^ @since base-4.6.0.0 - , Num -- ^ @since base-4.11.0.0 - , Semigroup -- ^ @since base-4.11.0.0 - , Monoid -- ^ @since base-4.11.0.0 - , Bits -- ^ @since base-4.14.0.0 - , FiniteBits -- ^ @since base-4.14.0.0 - , Floating -- ^ @since base-4.14.0.0 - , Fractional -- ^ @since base-4.14.0.0 - , Ix -- ^ @since base-4.14.0.0 - , Real -- ^ @since base-4.14.0.0 - , RealFrac -- ^ @since base-4.14.0.0 - , RealFloat -- ^ @since base-4.14.0.0 - , Storable -- ^ @since base-4.14.0.0 - ) - --- | This instance would be equivalent to the derived instances of the --- 'Down' newtype if the 'getDown' field were removed --- --- @since base-4.7.0.0 -instance (Read a) => Read (Down a) where - readsPrec d = readParen (d > 10) $ \ r -> - [(Down x,t) | ("Down",s) <- lex r, (x,t) <- readsPrec 11 s] - --- | This instance would be equivalent to the derived instances of the --- 'Down' newtype if the 'getDown' field were removed --- --- @since base-4.7.0.0 -instance (Show a) => Show (Down a) where - showsPrec d (Down x) = showParen (d > 10) $ - showString "Down " . showsPrec 11 x - --- | @since base-4.6.0.0 -instance Ord a => Ord (Down a) where - compare (Down x) (Down y) = y `compare` x - Down x < Down y = y < x - Down x > Down y = y > x - Down x <= Down y = y <= x - Down x >= Down y = y >= x - min (Down x) (Down y) = Down (max y x) - max (Down x) (Down y) = Down (min y x) - --- | Swaps @'minBound'@ and @'maxBound'@ of the underlying type. --- --- @since base-4.14.0.0 -instance Bounded a => Bounded (Down a) where - minBound = Down maxBound - maxBound = Down minBound - --- | Swaps @'succ'@ and @'pred'@ of the underlying type. --- --- @since base-4.18.0.0 -instance (Enum a, Bounded a, Eq a) => Enum (Down a) where - succ = fmap pred - pred = fmap succ - - -- Here we use the fact that 'comparing (complement @Int)' behaves - -- as an order-swapping `compare @Int`. - fromEnum = complement . fromEnum . getDown - toEnum = Down . toEnum . complement - - enumFrom (Down x) - | x == minBound - = [Down x] -- We can't rely on 'enumFromThen _ (pred @a minBound)` behaving nicely, - -- since 'enumFromThen _' might be strict and 'pred minBound' might throw - | otherwise - = coerce $ enumFromThen x (pred x) - enumFromThen (Down x) (Down y) = coerce $ enumFromThen x y - --- | @since base-4.11.0.0 -instance Functor Down where - fmap = coerce - --- | @since base-4.11.0.0 -instance Applicative Down where - pure = Down - (<*>) = coerce - --- | @since base-4.11.0.0 -instance Monad Down where - Down a >>= k = k a ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Ord/Down.hs ===================================== @@ -0,0 +1,169 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE StandaloneDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Internal.Data.Ord.Down +-- Copyright : (c) The University of Glasgow 2005 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries(a)haskell.org +-- Stability : stable +-- Portability : portable +-- +-- Orderings +-- +----------------------------------------------------------------------------- + +module GHC.Internal.Data.Ord.Down ( + Down(..), + ) where + +import GHC.Internal.Data.Bits (Bits, FiniteBits, complement) +import GHC.Internal.Ix (Ix) +import GHC.Internal.Foreign.Storable (Storable) +import GHC.Internal.Base +import GHC.Internal.Enum (Bounded(..), Enum(..)) +import GHC.Internal.Float (Floating, RealFloat) +import GHC.Internal.Num +import GHC.Internal.Read +import GHC.Internal.Real (Fractional, Real, RealFrac) +import GHC.Internal.Show +import GHC.Internal.Generics +import GHC.Internal.Data.Foldable +import GHC.Internal.Data.Traversable +import GHC.Internal.Control.Monad.Zip + +-- $setup +-- >>> import Prelude + +-- | The 'Down' type allows you to reverse sort order conveniently. A value of type +-- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@). +-- +-- If @a@ has an @'Ord'@ instance associated with it then comparing two +-- values thus wrapped will give you the opposite of their normal sort order. +-- This is particularly useful when sorting in generalised list comprehensions, +-- as in: @then sortWith by 'Down' x@. +-- +-- >>> compare True False +-- GT +-- +-- >>> compare (Down True) (Down False) +-- LT +-- +-- If @a@ has a @'Bounded'@ instance then the wrapped instance also respects +-- the reversed ordering by exchanging the values of @'minBound'@ and +-- @'maxBound'@. +-- +-- >>> minBound :: Int +-- -9223372036854775808 +-- +-- >>> minBound :: Down Int +-- Down 9223372036854775807 +-- +-- All other instances of @'Down' a@ behave as they do for @a@. +-- +-- @since base-4.6.0.0 +newtype Down a = Down + { getDown :: a -- ^ @since base-4.14.0.0 + } + deriving + ( Eq -- ^ @since base-4.6.0.0 + , Num -- ^ @since base-4.11.0.0 + , Semigroup -- ^ @since base-4.11.0.0 + , Monoid -- ^ @since base-4.11.0.0 + , Bits -- ^ @since base-4.14.0.0 + , FiniteBits -- ^ @since base-4.14.0.0 + , Floating -- ^ @since base-4.14.0.0 + , Fractional -- ^ @since base-4.14.0.0 + , Ix -- ^ @since base-4.14.0.0 + , Real -- ^ @since base-4.14.0.0 + , RealFrac -- ^ @since base-4.14.0.0 + , RealFloat -- ^ @since base-4.14.0.0 + , Storable -- ^ @since base-4.14.0.0 + , Generic -- ^ @since base-4.12.0.0 + ) + +-- | @since base-4.12.0.0 +deriving instance Generic1 Down + +-- | @since base-4.12.0.0 +deriving instance Foldable Down + +-- | @since base-4.12.0.0 +deriving instance Traversable Down + +-- | @since 4.12.0.0 +instance MonadZip Down where + mzipWith = liftM2 + +-- | This instance would be equivalent to the derived instances of the +-- 'Down' newtype if the 'getDown' field were removed +-- +-- @since base-4.7.0.0 +instance (Read a) => Read (Down a) where + readsPrec d = readParen (d > 10) $ \ r -> + [(Down x,t) | ("Down",s) <- lex r, (x,t) <- readsPrec 11 s] + +-- | This instance would be equivalent to the derived instances of the +-- 'Down' newtype if the 'getDown' field were removed +-- +-- @since base-4.7.0.0 +instance (Show a) => Show (Down a) where + showsPrec d (Down x) = showParen (d > 10) $ + showString "Down " . showsPrec 11 x + +-- | @since base-4.6.0.0 +instance Ord a => Ord (Down a) where + compare (Down x) (Down y) = y `compare` x + Down x < Down y = y < x + Down x > Down y = y > x + Down x <= Down y = y <= x + Down x >= Down y = y >= x + min (Down x) (Down y) = Down (max y x) + max (Down x) (Down y) = Down (min y x) + +-- | Swaps @'minBound'@ and @'maxBound'@ of the underlying type. +-- +-- @since base-4.14.0.0 +instance Bounded a => Bounded (Down a) where + minBound = Down maxBound + maxBound = Down minBound + +-- | Swaps @'succ'@ and @'pred'@ of the underlying type. +-- +-- @since base-4.18.0.0 +instance (Enum a, Bounded a, Eq a) => Enum (Down a) where + succ = fmap pred + pred = fmap succ + + -- Here we use the fact that 'comparing (complement @Int)' behaves + -- as an order-swapping `compare @Int`. + fromEnum = complement . fromEnum . getDown + toEnum = Down . toEnum . complement + + enumFrom (Down x) + | x == minBound + = [Down x] -- We can't rely on 'enumFromThen _ (pred @a minBound)` behaving nicely, + -- since 'enumFromThen _' might be strict and 'pred minBound' might throw + | otherwise + = coerce $ enumFromThen x (pred x) + enumFromThen (Down x) (Down y) = coerce $ enumFromThen x y + +-- | @since base-4.11.0.0 +instance Functor Down where + fmap = coerce + +-- | @since base-4.11.0.0 +instance Applicative Down where + pure = Down + (<*>) = coerce + +-- | @since base-4.11.0.0 +instance Monad Down where + Down a >>= k = k a ===================================== libraries/ghc-internal/src/GHC/Internal/Data/String.hs ===================================== @@ -35,7 +35,7 @@ module GHC.Internal.Data.String ( import GHC.Internal.Base import GHC.Internal.Data.Functor.Const (Const (Const)) import GHC.Internal.Data.Functor.Identity (Identity (Identity)) -import GHC.Internal.Data.List (lines, words, unlines, unwords) +import GHC.Internal.Data.OldList (lines, words, unlines, unwords) -- | `IsString` is used in combination with the @-XOverloadedStrings@ -- language extension to convert the literals to different string types. ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs ===================================== @@ -46,7 +46,6 @@ import GHC.Internal.Data.Functor.Identity ( Identity(..) ) import GHC.Internal.Data.Functor.Utils ( StateL(..), StateR(..), StateT(..), (#.) ) import GHC.Internal.Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..), Alt(..), Ap(..) ) -import GHC.Internal.Data.Ord ( Down(..) ) import GHC.Internal.Data.Proxy ( Proxy(..) ) import GHC.Internal.Arr @@ -364,10 +363,6 @@ deriving instance Traversable UInt -- | @since base-4.9.0.0 deriving instance Traversable UWord --- Instance for Data.Ord --- | @since base-4.12.0.0 -deriving instance Traversable Down - -- general functions -- | 'for' is 'traverse' with its arguments flipped. For a version ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Version.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Internal.Data.Functor ( Functor(..) ) import GHC.Internal.Data.Bool ( (&&) ) import GHC.Internal.Data.Eq import GHC.Internal.Int ( Int ) -import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) ) +import GHC.Internal.Data.OldList ( map, sort, concat, concatMap, intersperse, (++) ) import GHC.Internal.Data.Ord import GHC.Internal.Data.String ( String ) import GHC.Internal.Base ( Applicative(..) ) ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc ===================================== @@ -103,7 +103,7 @@ import GHC.Internal.IORef import GHC.Internal.Maybe import GHC.Internal.Ptr import GHC.Internal.Word -import GHC.Internal.Data.OldList (deleteBy) +import GHC.Internal.List (deleteBy) import qualified GHC.Internal.Event.Array as A import GHC.Internal.Base import GHC.Internal.Conc.Bound ===================================== libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc ===================================== @@ -39,7 +39,7 @@ module GHC.Internal.ExecutionStack.Internal ( import GHC.Internal.Data.Functor import GHC.Internal.Data.Maybe -import GHC.Internal.Data.List (reverse, null) +import GHC.Internal.List (reverse, null) import GHC.Internal.Word import GHC.Internal.Foreign.C.Types import GHC.Internal.Foreign.C.String (peekCString, CString) ===================================== libraries/ghc-internal/src/GHC/Internal/Exts.hs ===================================== @@ -318,7 +318,7 @@ import qualified GHC.Internal.Data.Coerce import GHC.Internal.Data.String import GHC.Internal.Data.OldList import GHC.Internal.Data.Data -import GHC.Internal.Data.Ord +import GHC.Internal.Data.Ord.Down import qualified GHC.Internal.Debug.Trace import GHC.Internal.Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export ===================================== libraries/ghc-internal/src/GHC/Internal/Generics.hs ===================================== @@ -732,7 +732,6 @@ module GHC.Internal.Generics ( -- We use some base types import GHC.Internal.Data.Either ( Either (..) ) import GHC.Internal.Data.Maybe ( Maybe(..), fromMaybe ) -import GHC.Internal.Data.Ord ( Down(..) ) import GHC.Internal.Bignum.Integer ( Integer, integerToInt ) import GHC.Internal.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# ) import GHC.Internal.Ptr ( Ptr(..) ) @@ -1629,9 +1628,6 @@ deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) -- | @since base-4.16.0.0 deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) --- | @since base-4.12.0.0 -deriving instance Generic (Down a) - -- | @since base-4.15.0.0 deriving instance Generic SrcLoc @@ -1701,9 +1697,6 @@ deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) -- | @since base-4.16.0.0 deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) --- | @since base-4.12.0.0 -deriving instance Generic1 Down - -------------------------------------------------------------------------------- -- Copied from the singletons package -------------------------------------------------------------------------------- ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs ===================================== @@ -30,7 +30,7 @@ import GHC.Internal.IO.Encoding.Types import GHC.Internal.IO.Buffer import GHC.Internal.Data.Bits import GHC.Internal.Data.Maybe -import GHC.Internal.Data.OldList (lookup) +import GHC.Internal.List (lookup) import qualified GHC.Internal.IO.Encoding.CodePage.API as API import GHC.Internal.IO.Encoding.CodePage.Table ===================================== libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Internal.Control.Exception import GHC.Internal.Data.Foldable (Foldable(..)) import GHC.Internal.Base import GHC.Internal.Unicode (isSpace) -import GHC.Internal.Data.List (filter, unlines, concat, reverse) +import GHC.Internal.Data.OldList (filter, unlines, concat, reverse) import GHC.Internal.Text.Show (show) import GHC.Internal.System.Environment (getArgs) import GHC.Internal.System.Exit (exitFailure) ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Internal.Num import GHC.Internal.Data.Bits import GHC.Internal.Data.Functor import GHC.Internal.Data.Maybe (catMaybes) -import GHC.Internal.Data.List +import GHC.Internal.List import GHC.Internal.Data.Tuple import GHC.Internal.Foreign.Ptr import GHC.Internal.Foreign.Storable ===================================== libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc ===================================== @@ -40,14 +40,14 @@ module GHC.Internal.System.Environment.Blank ) where import GHC.Internal.Data.Functor -import GHC.Internal.Data.List (elem, null, takeWhile) +import GHC.Internal.List (elem, null, takeWhile) import GHC.Internal.Foreign.C.String import GHC.Internal.Base #if defined(mingw32_HOST_OS) import GHC.Internal.Foreign.Ptr import GHC.Internal.Windows import GHC.Internal.Control.Monad -import GHC.Internal.Data.List (lookup) +import GHC.Internal.List (lookup) #else import GHC.Internal.Foreign.C.Error import GHC.Internal.Foreign.C.Types ===================================== libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc ===================================== @@ -53,7 +53,7 @@ import GHC.Internal.System.IO.Error (isDoesNotExistError) import GHC.Internal.System.Posix.Internals #elif defined(linux_HOST_OS) || defined(gnu_HOST_OS) import GHC.Internal.Data.Functor -import GHC.Internal.Data.List (isSuffixOf) +import GHC.Internal.Data.OldList (isSuffixOf) import GHC.Internal.Foreign.C.Types import GHC.Internal.Foreign.C.Error import GHC.Internal.Foreign.C.String @@ -85,7 +85,7 @@ import GHC.Internal.System.Posix.Internals import GHC.Internal.Control.Exception import GHC.Internal.Control.Monad.Fail import GHC.Internal.Data.Functor -import GHC.Internal.Data.List (isPrefixOf, drop) +import GHC.Internal.Data.OldList (isPrefixOf, drop) import GHC.Internal.Word import GHC.Internal.Foreign.C.String import GHC.Internal.Foreign.Marshal.Array ===================================== libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Internal.Foreign.Storable import qualified GHC.Internal.Foreign.C.String.Encoding as GHC #else import GHC.Internal.Int -import GHC.Internal.Data.OldList (elem) +import GHC.Internal.List (elem) #endif -- --------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7cab14210c2578d36933856b158f6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7cab14210c2578d36933856b158f6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-tylit-determ] determinism: Use deterministic map for Strings in TyLitMap
by Matthew Pickering (＠mpickering) 29 Jan '26

29 Jan '26

Matthew Pickering pushed to branch wip/fix-tylit-determ at Glasgow Haskell Compiler / GHC Commits: 3f4a4296 by Matthew Pickering at 2026-01-29T10:59:05+00:00 determinism: Use deterministic map for Strings in TyLitMap When generating typeable evidence the types we need evidence for all cached in a TypeMap, the order terms are retrieved from a type map determines the order the bindings appear in the program. A TypeMap is quite diligent to use deterministic maps, apart from in the TyLitMap, which uses a UniqFM for storing strings, whose ordering depends on the Unique of the FastString. This can cause non-deterministic .hi and .o files. An unexpected side-effect is the error message but RecordDotSyntaxFail8 changing. I looked into this with Sam and this change caused the constraints to be solved in a different order which results in a slightly different error message. I have accepted the new test, since the output before was non-deterministic and the new output is consistent with the other messages in that file. Fixes #26846 - - - - - 4 changed files: - compiler/GHC/Core/Map/Type.hs - + testsuite/tests/ghc-api/TypeMapStringLiteral.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr Changes: ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -45,7 +45,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Var import GHC.Types.Var.Env -import GHC.Types.Unique.FM +import GHC.Types.Unique.DFM import GHC.Utils.Outputable import GHC.Utils.Panic @@ -365,14 +365,14 @@ filterT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon ------------------------ data TyLitMap a = TLM { tlm_number :: Map.Map Integer a - , tlm_string :: UniqFM FastString a + , tlm_string :: UniqDFM FastString a , tlm_char :: Map.Map Char a } -- TODO(22292): derive instance Functor TyLitMap where fmap f TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc } = TLM - { tlm_number = Map.map f tn, tlm_string = mapUFM f ts, tlm_char = Map.map f tc } + { tlm_number = Map.map f tn, tlm_string = mapUDFM f ts, tlm_char = Map.map f tc } instance TrieMap TyLitMap where type Key TyLitMap = TyLit @@ -384,34 +384,34 @@ instance TrieMap TyLitMap where mapMaybeTM = mpTyLit emptyTyLitMap :: TyLitMap a -emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM, tlm_char = Map.empty } +emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUDFM, tlm_char = Map.empty } lkTyLit :: TyLit -> TyLitMap a -> Maybe a lkTyLit l = case l of NumTyLit n -> tlm_number >.> Map.lookup n - StrTyLit n -> tlm_string >.> (`lookupUFM` n) + StrTyLit n -> tlm_string >.> (`lookupUDFM` n) CharTyLit n -> tlm_char >.> Map.lookup n xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a xtTyLit l f m = case l of NumTyLit n -> m { tlm_number = Map.alter f n (tlm_number m) } - StrTyLit n -> m { tlm_string = alterUFM f (tlm_string m) n } + StrTyLit n -> m { tlm_string = alterUDFM f (tlm_string m) n } CharTyLit n -> m { tlm_char = Map.alter f n (tlm_char m) } foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b -foldTyLit l m = flip (nonDetFoldUFM l) (tlm_string m) +foldTyLit l m = flip (foldUDFM l) (tlm_string m) . flip (Map.foldr l) (tlm_number m) . flip (Map.foldr l) (tlm_char m) filterTyLit :: (a -> Bool) -> TyLitMap a -> TyLitMap a filterTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) - = TLM { tlm_number = Map.filter f tn, tlm_string = filterUFM f ts, tlm_char = Map.filter f tc } + = TLM { tlm_number = Map.filter f tn, tlm_string = filterUDFM f ts, tlm_char = Map.filter f tc } mpTyLit :: (a -> Maybe b) -> TyLitMap a -> TyLitMap b mpTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) - = TLM { tlm_number = Map.mapMaybe f tn, tlm_string = mapMaybeUFM f ts, tlm_char = Map.mapMaybe f tc } + = TLM { tlm_number = Map.mapMaybe f tn, tlm_string = mapMaybeUDFM f ts, tlm_char = Map.mapMaybe f tc } ------------------------------------------------- -- | @TypeMap a@ is a map from 'Type' to @a@. If you are a client, this ===================================== testsuite/tests/ghc-api/TypeMapStringLiteral.hs ===================================== @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Control.Monad (unless) +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Short as SBS +import Data.Char (ord) +import Data.List (foldl') +import GHC.Core.Map.Type (TypeMap, emptyTypeMap, extendTypeMap, foldTypeMap) +import GHC.Core.Type (Type, mkStrLitTy) +import GHC.Data.FastString (FastString (..), FastZString (..)) +import GHC.Utils.Encoding (zEncodeString) + +main :: IO () +main = do + let logicalEntries = + [ ("alpha", "payload-alpha") + , ("beta", "payload-beta") + , ("gamma", "payload-gamma") + ] + uniquesOne = [1, 2, 3] + uniquesTwo = [200, 100, 500] + + tmOne = buildMap logicalEntries uniquesOne + tmTwo = buildMap logicalEntries uniquesTwo + + foldedOne = foldValues tmOne + foldedTwo = foldValues tmTwo + + assert "foldTypeMap order independent of FastString uniques" $ + foldedOne == foldedTwo + + +buildMap :: [(String, a)] -> [Int] -> TypeMap a +buildMap entries uniques = + foldl' insertEntry emptyTypeMap (zip uniques entries) + where + insertEntry :: TypeMap a -> (Int, (String, a)) -> TypeMap a + insertEntry tm (u, (txt, payload)) = + extendTypeMap tm (strLiteralWithUnique u txt) payload + +foldValues :: TypeMap a -> [a] +foldValues tm = foldTypeMap (:) [] tm + +strLiteralWithUnique :: Int -> String -> Type +strLiteralWithUnique u = mkStrLitTy . fakeFastString u + +fakeFastString :: Int -> String -> FastString +fakeFastString u s = FastString + { uniq = u + , n_chars = length s + , fs_sbs = SBS.pack (map (fromIntegral . ord) s) + , fs_zenc = error "unused" + } + +assert :: String -> Bool -> IO () +assert label condition = unless condition $ + error ("TypeMap string literal test failed: " ++ label) ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -74,3 +74,4 @@ test('T25577', [ extra_run_opts(f'"{config.libdir}"') test('T26120', [], compile_and_run, ['-package ghc']) test('T26264', normal, compile_and_run, ['-package ghc']) +test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc']) ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr ===================================== @@ -30,7 +30,13 @@ RecordDotSyntaxFail8.hs:53:17: error: [GHC-39999] • No instance for ‘HasField "quux3" Quux r0’ arising from selecting the field ‘quux3’ NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. - • In the expression: ....bar.baz.quux3 - In the second argument of ‘($)’, namely ‘....baz.quux3.wob’ + • In the second argument of ‘($)’, namely ‘....baz.quux3.wob’ In a stmt of a 'do' block: print @Bool $ ....quux3.wob + In the expression: + do let a = Foo {foo = ...} + print @Quux $ ....quux1 + let b = myQuux + print @Quux $ b.quux2 + let c = Foo {foo = ...} + ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4a42968540ae56a2ca8c5bed0d9dc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4a42968540ae56a2ca8c5bed0d9dc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/andreask/lint-rts-includes
by Andreas Klebinger (＠AndreasK) 29 Jan '26

29 Jan '26

Andreas Klebinger pushed new branch wip/andreask/lint-rts-includes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/lint-rts-includes You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-tylit-determ] determinism: Use deterministic map for Strings in TyLitMap
by Matthew Pickering (＠mpickering) 29 Jan '26

29 Jan '26

Matthew Pickering pushed to branch wip/fix-tylit-determ at Glasgow Haskell Compiler / GHC Commits: 5da85351 by Matthew Pickering at 2026-01-29T09:38:59+00:00 determinism: Use deterministic map for Strings in TyLitMap When generating typeable evidence the types we need evidence for all cached in a TypeMap, the order terms are retrieved from a type map determines the order the bindings appear in the program. A TypeMap is quite diligent to use deterministic maps, apart from in the TyLitMap, which uses a UniqFM for storing strings, whose ordering depends on the Unique of the FastString. This can cause non-deterministic .hi and .o files. Fixes #26846 - - - - - 3 changed files: - compiler/GHC/Core/Map/Type.hs - + testsuite/tests/ghc-api/TypeMapStringLiteral.hs - testsuite/tests/ghc-api/all.T Changes: ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -45,7 +45,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Var import GHC.Types.Var.Env -import GHC.Types.Unique.FM +import GHC.Types.Unique.DFM import GHC.Utils.Outputable import GHC.Utils.Panic @@ -365,14 +365,14 @@ filterT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon ------------------------ data TyLitMap a = TLM { tlm_number :: Map.Map Integer a - , tlm_string :: UniqFM FastString a + , tlm_string :: UniqDFM FastString a , tlm_char :: Map.Map Char a } -- TODO(22292): derive instance Functor TyLitMap where fmap f TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc } = TLM - { tlm_number = Map.map f tn, tlm_string = mapUFM f ts, tlm_char = Map.map f tc } + { tlm_number = Map.map f tn, tlm_string = mapUDFM f ts, tlm_char = Map.map f tc } instance TrieMap TyLitMap where type Key TyLitMap = TyLit @@ -384,34 +384,34 @@ instance TrieMap TyLitMap where mapMaybeTM = mpTyLit emptyTyLitMap :: TyLitMap a -emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM, tlm_char = Map.empty } +emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUDFM, tlm_char = Map.empty } lkTyLit :: TyLit -> TyLitMap a -> Maybe a lkTyLit l = case l of NumTyLit n -> tlm_number >.> Map.lookup n - StrTyLit n -> tlm_string >.> (`lookupUFM` n) + StrTyLit n -> tlm_string >.> (`lookupUDFM` n) CharTyLit n -> tlm_char >.> Map.lookup n xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a xtTyLit l f m = case l of NumTyLit n -> m { tlm_number = Map.alter f n (tlm_number m) } - StrTyLit n -> m { tlm_string = alterUFM f (tlm_string m) n } + StrTyLit n -> m { tlm_string = alterUDFM f (tlm_string m) n } CharTyLit n -> m { tlm_char = Map.alter f n (tlm_char m) } foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b -foldTyLit l m = flip (nonDetFoldUFM l) (tlm_string m) +foldTyLit l m = flip (foldUDFM l) (tlm_string m) . flip (Map.foldr l) (tlm_number m) . flip (Map.foldr l) (tlm_char m) filterTyLit :: (a -> Bool) -> TyLitMap a -> TyLitMap a filterTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) - = TLM { tlm_number = Map.filter f tn, tlm_string = filterUFM f ts, tlm_char = Map.filter f tc } + = TLM { tlm_number = Map.filter f tn, tlm_string = filterUDFM f ts, tlm_char = Map.filter f tc } mpTyLit :: (a -> Maybe b) -> TyLitMap a -> TyLitMap b mpTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) - = TLM { tlm_number = Map.mapMaybe f tn, tlm_string = mapMaybeUFM f ts, tlm_char = Map.mapMaybe f tc } + = TLM { tlm_number = Map.mapMaybe f tn, tlm_string = mapMaybeUDFM f ts, tlm_char = Map.mapMaybe f tc } ------------------------------------------------- -- | @TypeMap a@ is a map from 'Type' to @a@. If you are a client, this ===================================== testsuite/tests/ghc-api/TypeMapStringLiteral.hs ===================================== @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Control.Monad (unless) +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Short as SBS +import Data.Char (ord) +import Data.List (foldl') +import GHC.Core.Map.Type (TypeMap, emptyTypeMap, extendTypeMap, foldTypeMap) +import GHC.Core.Type (Type, mkStrLitTy) +import GHC.Data.FastString (FastString (..), FastZString (..)) +import GHC.Utils.Encoding (zEncodeString) + +main :: IO () +main = do + let logicalEntries = + [ ("alpha", "payload-alpha") + , ("beta", "payload-beta") + , ("gamma", "payload-gamma") + ] + uniquesOne = [1, 2, 3] + uniquesTwo = [200, 100, 500] + + tmOne = buildMap logicalEntries uniquesOne + tmTwo = buildMap logicalEntries uniquesTwo + + foldedOne = foldValues tmOne + foldedTwo = foldValues tmTwo + + assert "foldTypeMap order independent of FastString uniques" $ + foldedOne == foldedTwo + + +buildMap :: [(String, a)] -> [Int] -> TypeMap a +buildMap entries uniques = + foldl' insertEntry emptyTypeMap (zip uniques entries) + where + insertEntry :: TypeMap a -> (Int, (String, a)) -> TypeMap a + insertEntry tm (u, (txt, payload)) = + extendTypeMap tm (strLiteralWithUnique u txt) payload + +foldValues :: TypeMap a -> [a] +foldValues tm = foldTypeMap (:) [] tm + +strLiteralWithUnique :: Int -> String -> Type +strLiteralWithUnique u = mkStrLitTy . fakeFastString u + +fakeFastString :: Int -> String -> FastString +fakeFastString u s = FastString + { uniq = u + , n_chars = length s + , fs_sbs = SBS.pack (map (fromIntegral . ord) s) + , fs_zenc = error "unused" + } + +assert :: String -> Bool -> IO () +assert label condition = unless condition $ + error ("TypeMap string literal test failed: " ++ label) ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -74,3 +74,4 @@ test('T25577', [ extra_run_opts(f'"{config.libdir}"') test('T26120', [], compile_and_run, ['-package ghc']) test('T26264', normal, compile_and_run, ['-package ghc']) +test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5da853519aff1ea937f98ff879bb2b7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5da853519aff1ea937f98ff879bb2b7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T24464] Fix buglet
by Simon Peyton Jones (＠simonpj) 29 Jan '26

29 Jan '26

Simon Peyton Jones pushed to branch wip/T24464 at Glasgow Haskell Compiler / GHC Commits: 2dd48b99 by Simon Peyton Jones at 2026-01-29T09:37:04+00:00 Fix buglet - - - - - 1 changed file: - compiler/GHC/HsToCore/Pmc.hs Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -97,7 +97,7 @@ dontDoPmc thing_inside = updPmNablas NoPmc thing_inside whenDoingPmc :: a -> (Nablas -> DsM a) -> DsM a whenDoingPmc no_pmc thing_inside - = do { ldi_nablas <- getPmNablas + = do { ldi_nablas <- getLdiNablas ; case ldi_nablas of NoPmc -> return no_pmc Ldi nablas -> thing_inside nablas } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dd48b9987f1dc2c0adde50adc2f8b1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dd48b9987f1dc2c0adde50adc2f8b1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/linker_fix] Add debug messages to debug via CI
by Andreas Klebinger (＠AndreasK) 29 Jan '26

29 Jan '26

Andreas Klebinger pushed to branch wip/andreask/linker_fix at Glasgow Haskell Compiler / GHC Commits: 0f2cf29e by Andreas Klebinger at 2026-01-29T10:25:49+01:00 Add debug messages to debug via CI - - - - - 4 changed files: - rts/Linker.c - rts/linker/LoadArchive.c - rts/linker/MachO.c - rts/linker/PEi386.c Changes: ===================================== rts/Linker.c ===================================== @@ -1530,6 +1530,7 @@ HsInt verifyAndInitOc (ObjectCode* oc) #endif if (!r) { IF_DEBUG(linker, ocDebugBelch(oc, "ocVerifyImage_* failed\n")); + ocDebugBelch(oc, "ocVerifyImage_* failed\n"); return r; } return 1; @@ -1565,6 +1566,7 @@ HsInt loadOc (ObjectCode* oc) if (!r) { IF_DEBUG(linker, ocDebugBelch(oc, "ocAllocateExtras_MachO failed\n")); + ocDebugBelch(oc, "ocAllocateExtras_MachO failed\n"); return r; } # elif defined(OBJFORMAT_ELF) @@ -1589,6 +1591,7 @@ HsInt loadOc (ObjectCode* oc) # endif if (!r) { IF_DEBUG(linker, ocDebugBelch(oc, "ocGetNames_* failed\n")); + ocDebugBelch(oc, "ocGetNames_* failed\n"); return r; } ===================================== rts/linker/LoadArchive.c ===================================== @@ -579,6 +579,7 @@ HsInt loadArchive_ (pathchar *path) /* See loadObj() */ if(!machoGetMisalignment(f, &misalignment)) { DEBUG_LOG("Failed to load member as mach-o file. Skipping.\n"); + debugBelch("Failed to load member as mach-o file. Skipping.\n"); continue; } image = stgMallocBytes(memberSize + misalignment, ===================================== rts/linker/MachO.c ===================================== @@ -1764,6 +1764,7 @@ machoGetMisalignment( FILE * f, int* misalignment_out ) return 0; } } + //This seems wrong, but likely only matters for broken archives anyway. fseek(f, -sizeof(header), SEEK_CUR); if(header.magic != MH_MAGIC_64) { ===================================== rts/linker/PEi386.c ===================================== @@ -475,7 +475,7 @@ static void addDLLHandle( static bool verifyCOFFHeader( uint16_t machine, - IMAGE_FILE_HEADER *hdr, + IMAGE_FILE_HEADER *hdr pathchar *fileName); static bool checkIfDllLoaded( View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f2cf29ea631ba0f9035902524654df… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f2cf29ea631ba0f9035902524654df… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/detecting-os-handle-types] Add OS handle type detection to `base`
by Wolfgang Jeltsch (＠jeltsch) 29 Jan '26

29 Jan '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/detecting-os-handle-types at Glasgow Haskell Compiler / GHC Commits: 7adf91a5 by Wolfgang Jeltsch at 2026-01-29T11:21:49+02:00 Add OS handle type detection to `base` It is deliberate that this addition to `base` does not simply reflect the `conditional`/`<!>` operation currently in `GHC.IO.SubSystem` but simply uses the value of a custom enumeration type to describe the type of OS handles currently in use. The reason for using this approach is that it is simpler and at the same type more future-proof: if a new OS handle type should be introduced in the future, it would only be necessary to add another value to `OSHandleType`, and user code that uses fallback branches in case distinctions regarding OS handle types would continue to be compilable at least; `conditional`, on the other hand, would have to have its argument count changed and `<!>` could not even be used as an infix operator anymore. Since Haskell has `case` expressions, there is no real need to have a case-distinguishing operation like `conditional`/`<!>`. - - - - - 25 changed files: - libraries/base/changelog.md - libraries/base/src/GHC/IO/SubSystem.hs - libraries/base/src/System/IO/OS.hs - libraries/base/tests/IO/all.T - libraries/base/tests/IO/osHandles001FileDescriptors.hs - libraries/base/tests/IO/osHandles001FileDescriptors.stdout - libraries/base/tests/IO/osHandles001WindowsHandles.hs - libraries/base/tests/IO/osHandles001WindowsHandles.stdout - libraries/base/tests/IO/osHandles002FileDescriptors.hs - libraries/base/tests/IO/osHandles002FileDescriptors.stdout - libraries/base/tests/IO/osHandles002WindowsHandles.hs - libraries/base/tests/IO/osHandles002WindowsHandles.stdout - + libraries/base/tests/IO/osHandles003FileDescriptors.hs - libraries/base/tests/IO/osHandles002FileDescriptors.stderr → libraries/base/tests/IO/osHandles003FileDescriptors.stderr - libraries/base/tests/IO/osHandles002FileDescriptors.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdin - libraries/base/tests/IO/osHandles002WindowsHandles.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdout - + libraries/base/tests/IO/osHandles003WindowsHandles.hs - libraries/base/tests/IO/osHandles002WindowsHandles.stderr → libraries/base/tests/IO/osHandles003WindowsHandles.stderr - + libraries/base/tests/IO/osHandles003WindowsHandles.stdin - + libraries/base/tests/IO/osHandles003WindowsHandles.stdout - libraries/ghc-internal/src/GHC/Internal/System/IO/OS.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/changelog.md ===================================== @@ -23,7 +23,7 @@ * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) - * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) + * Add a new module `System.IO.OS` with operations for detecting the type of operating-system handles in use (file descriptors, Windows handles) and obtaining such handles. (CLC proposals [#395](https://github.com/haskell/core-libraries-committee/issues/395) and [#369](https://github.com/haskell/core-libraries-committee/issues/369)) * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) ## 4.22.0.0 *TBA* ===================================== libraries/base/src/GHC/IO/SubSystem.hs ===================================== @@ -25,9 +25,9 @@ module GHC.IO.SubSystem whenIoSubSystem, ioSubSystem, IoSubSystem(..), - conditional, - (<!>), + {-# DEPRECATED "Please use System.IO.OS.osHandleType." #-} conditional, + {-# DEPRECATED "Please use System.IO.OS.osHandleType." #-} (<!>), isWindowsNativeIO ) where -import GHC.Internal.IO.SubSystem \ No newline at end of file +import GHC.Internal.IO.SubSystem ===================================== libraries/base/src/System/IO/OS.hs ===================================== @@ -6,6 +6,10 @@ -} module System.IO.OS ( + -- * OS handle type detection + OSHandleType (FileDescriptor, WindowsHandle), + osHandleType, + -- * Obtaining file descriptors and Windows handles withFileDescriptorReadingBiased, withFileDescriptorWritingBiased, @@ -23,6 +27,8 @@ where import GHC.Internal.System.IO.OS ( + OSHandleType (FileDescriptor, WindowsHandle), + osHandleType, withFileDescriptorReadingBiased, withFileDescriptorWritingBiased, withWindowsHandleReadingBiased, ===================================== libraries/base/tests/IO/all.T ===================================== @@ -189,9 +189,11 @@ test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compi test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, ['']) test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) -test('osHandles002FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, ['']) +test('osHandles002FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, ['']) test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) -# It would be good to let `osHandles002FileDescriptors` run also on +test('osHandles003FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, ['']) +test('osHandles003WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +# It would be good to let `osHandles003FileDescriptors` run also on # Windows with the file-descriptor-based I/O manager. However, this # test, as it is currently implemented, requires the `unix` package. # That said, `UCRT.DLL`, which is used by GHC-generated Windows ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.hs ===================================== @@ -1,23 +1,4 @@ -{-# LANGUAGE TypeApplications #-} - -import Control.Monad (mapM_) -import Control.Exception (SomeException, try) -import System.IO (stdin, stdout, stderr) -import System.IO.OS - ( - withFileDescriptorReadingBiasedRaw, - withFileDescriptorWritingBiasedRaw, - withWindowsHandleReadingBiasedRaw, - withWindowsHandleWritingBiasedRaw - ) +import System.IO.OS (osHandleType) main :: IO () -main = mapM_ ((>>= print) . try @SomeException) $ - [ - withFileDescriptorReadingBiasedRaw stdin (return . show), - withFileDescriptorWritingBiasedRaw stdout (return . show), - withFileDescriptorWritingBiasedRaw stderr (return . show), - withWindowsHandleReadingBiasedRaw stdin (return . const "_"), - withWindowsHandleWritingBiasedRaw stdout (return . const "_"), - withWindowsHandleWritingBiasedRaw stderr (return . const "_") - ] +main = print osHandleType ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.stdout ===================================== @@ -1,6 +1 @@ -Right "0" -Right "1" -Right "2" -Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles) -Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) -Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) +FileDescriptor ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.hs ===================================== @@ -1,23 +1,4 @@ -{-# LANGUAGE TypeApplications #-} - -import Control.Monad (mapM_) -import Control.Exception (SomeException, try) -import System.IO (stdin, stdout, stderr) -import System.IO.OS - ( - withFileDescriptorReadingBiasedRaw, - withFileDescriptorWritingBiasedRaw, - withWindowsHandleReadingBiasedRaw, - withWindowsHandleWritingBiasedRaw - ) +import System.IO.OS (osHandleType) main :: IO () -main = mapM_ ((>>= print) . try @SomeException) $ - [ - withFileDescriptorReadingBiasedRaw stdin (return . show), - withFileDescriptorWritingBiasedRaw stdout (return . show), - withFileDescriptorWritingBiasedRaw stderr (return . show), - withWindowsHandleReadingBiasedRaw stdin (return . const "_"), - withWindowsHandleWritingBiasedRaw stdout (return . const "_"), - withWindowsHandleWritingBiasedRaw stderr (return . const "_") - ] +main = print osHandleType ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.stdout ===================================== @@ -1,6 +1 @@ -Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors) -Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) -Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) -Right "_" -Right "_" -Right "_" +WindowsHandle ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.hs ===================================== @@ -1,28 +1,23 @@ -import Data.Functor (void) -import Data.ByteString.Char8 (pack) -import System.Posix.Types (Fd (Fd), ByteCount) -import System.Posix.IO.ByteString (fdRead, fdWrite) +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) import System.IO (stdin, stdout, stderr) import System.IO.OS ( - withFileDescriptorReadingBiased, - withFileDescriptorWritingBiased + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw ) main :: IO () -main = withFileDescriptorReadingBiased stdin $ \ stdinFD -> - withFileDescriptorWritingBiased stdout $ \ stdoutFD -> - withFileDescriptorWritingBiased stderr $ \ stderrFD -> - do - regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation - void $ fdWrite (Fd stdoutFD) regularMsg - void $ fdWrite (Fd stderrFD) (pack errorMsg) - where - - inputSizeApproximation :: ByteCount - inputSizeApproximation = 100 - - errorMsg :: String - errorMsg = "And every single door\n\ - \That I've walked through\n\ - \Brings me back, back here again\n" +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdout ===================================== @@ -1 +1,6 @@ -We've got to get in to get out +Right "0" +Right "1" +Right "2" +Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.hs ===================================== @@ -1,49 +1,23 @@ -import Control.Monad (zipWithM_) -import Data.Functor (void) -import Data.Char (ord) -import Foreign.Marshal.Alloc (allocaBytes) -import Foreign.Storable (pokeElemOff) +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) import System.IO (stdin, stdout, stderr) import System.IO.OS ( - withWindowsHandleReadingBiased, - withWindowsHandleWritingBiased + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw ) main :: IO () -main = withWindowsHandleReadingBiased stdin $ \ windowsStdin -> - withWindowsHandleWritingBiased stdout $ \ windowsStdout -> - withWindowsHandleWritingBiased stderr $ \ windowsStderr -> - do - withBuffer inputSizeApproximation $ \ bufferPtr -> do - inputSize <- win32_ReadFile windowsStdin - bufferPtr - inputSizeApproximation - Nothing - void $ win32_WriteFile windowsStdout - bufferPtr - inputSize - Nothing - withBuffer errorMsgSize $ \ bufferPtr -> do - zipWithM_ (pokeElemOff bufferPtr) - [0 ..] - (map (fromIntegral . ord) errorMsg) - void $ win32_WriteFile windowsStderr - bufferPtr - errorMsgSize - Nothing - where - - withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a - withBuffer = allocaBytes . fromIntegral - - inputSizeApproximation :: DWORD - inputSizeApproximation = 100 - - errorMsg :: String - errorMsg = "And every single door\n\ - \That I've walked through\n\ - \Brings me back, back here again\n" - - errorMsgSize :: DWORD - errorMsgSize = fromIntegral (length errorMsg) +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdout ===================================== @@ -1 +1,6 @@ -We've got to get in to get out +Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Right "_" +Right "_" +Right "_" ===================================== libraries/base/tests/IO/osHandles003FileDescriptors.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Functor (void) +import Data.ByteString.Char8 (pack) +import System.Posix.Types (Fd (Fd), ByteCount) +import System.Posix.IO.ByteString (fdRead, fdWrite) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased + ) + +main :: IO () +main = withFileDescriptorReadingBiased stdin $ \ stdinFD -> + withFileDescriptorWritingBiased stdout $ \ stdoutFD -> + withFileDescriptorWritingBiased stderr $ \ stderrFD -> + do + regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation + void $ fdWrite (Fd stdoutFD) regularMsg + void $ fdWrite (Fd stderrFD) (pack errorMsg) + where + + inputSizeApproximation :: ByteCount + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stderr → libraries/base/tests/IO/osHandles003FileDescriptors.stderr ===================================== ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdin ===================================== ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdout ===================================== ===================================== libraries/base/tests/IO/osHandles003WindowsHandles.hs ===================================== @@ -0,0 +1,49 @@ +import Control.Monad (zipWithM_) +import Data.Functor (void) +import Data.Char (ord) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Storable (pokeElemOff) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased + ) + +main :: IO () +main = withWindowsHandleReadingBiased stdin $ \ windowsStdin -> + withWindowsHandleWritingBiased stdout $ \ windowsStdout -> + withWindowsHandleWritingBiased stderr $ \ windowsStderr -> + do + withBuffer inputSizeApproximation $ \ bufferPtr -> do + inputSize <- win32_ReadFile windowsStdin + bufferPtr + inputSizeApproximation + Nothing + void $ win32_WriteFile windowsStdout + bufferPtr + inputSize + Nothing + withBuffer errorMsgSize $ \ bufferPtr -> do + zipWithM_ (pokeElemOff bufferPtr) + [0 ..] + (map (fromIntegral . ord) errorMsg) + void $ win32_WriteFile windowsStderr + bufferPtr + errorMsgSize + Nothing + where + + withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a + withBuffer = allocaBytes . fromIntegral + + inputSizeApproximation :: DWORD + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" + + errorMsgSize :: DWORD + errorMsgSize = fromIntegral (length errorMsg) ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stderr → libraries/base/tests/IO/osHandles003WindowsHandles.stderr ===================================== ===================================== libraries/base/tests/IO/osHandles003WindowsHandles.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles003WindowsHandles.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs ===================================== @@ -8,6 +8,10 @@ -} module GHC.Internal.System.IO.OS ( + -- * OS handle type detection + OSHandleType (FileDescriptor, WindowsHandle), + osHandleType, + -- * Obtaining file descriptors and Windows handles withFileDescriptorReadingBiased, withFileDescriptorWritingBiased, @@ -23,6 +27,10 @@ module GHC.Internal.System.IO.OS ) where +import GHC.Internal.Classes (Eq, Ord) +import GHC.Internal.Enum (Bounded, Enum) +import GHC.Internal.Show (Show) +import GHC.Internal.Read (Read) import GHC.Internal.Control.Monad (return) import GHC.Internal.Control.Concurrent.MVar (MVar) import GHC.Internal.Control.Exception (mask) @@ -39,6 +47,7 @@ import GHC.Internal.Data.List ((++)) import GHC.Internal.Data.String (String) import GHC.Internal.Data.Typeable (Typeable, cast) import GHC.Internal.System.IO (IO) +import GHC.Internal.IO.SubSystem (conditional) import GHC.Internal.IO.FD (fdFD) #if defined(mingw32_HOST_OS) import GHC.Internal.IO.Windows.Handle @@ -64,6 +73,19 @@ import GHC.Internal.IO.Exception import GHC.Internal.Foreign.Ptr (Ptr) import GHC.Internal.Foreign.C.Types (CInt) +-- * OS handle type detection + +-- | The type of operating-system handle types. +data OSHandleType = FileDescriptor | WindowsHandle + deriving (Eq, Ord, Bounded, Enum, Show, Read) + +{-| + The type of operating-system handles that underlie Haskell handles with the + I/O manager currently in use. +-} +osHandleType :: OSHandleType +osHandleType = conditional FileDescriptor WindowsHandle + -- * Obtaining POSIX file descriptors and Windows handles {-| ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -10050,6 +10050,9 @@ module System.IO.Error where module System.IO.OS where -- Safety: Safe + type OSHandleType :: * + data OSHandleType = FileDescriptor | WindowsHandle + osHandleType :: OSHandleType withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r @@ -11375,6 +11378,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Int instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Eq GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ @@ -11528,6 +11532,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Ord (GHC.In instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Ord (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Ord GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Control.Arrow.Arrow (->) -- Defined in ‘GHC.Internal.Control.Arrow’ instance forall (m :: * -> *). GHC.Internal.Base.Monad m => GHC.Internal.Control.Arrow.Arrow (GHC.Internal.Control.Arrow.Kleisli m) -- Defined in ‘GHC.Internal.Control.Arrow’ instance GHC.Internal.Control.Arrow.ArrowApply (->) -- Defined in ‘GHC.Internal.Control.Arrow’ @@ -11927,6 +11932,7 @@ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.Associativity -- Define instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.DecidedStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ +instance [safe] GHC.Internal.Enum.Bounded GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance forall a k (b :: k). GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’ @@ -12008,6 +12014,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ +instance [safe] GHC.Internal.Enum.Enum GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ @@ -12555,6 +12562,7 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S 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 [safe] GHC.Internal.Read.Read GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ 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’ @@ -12894,6 +12902,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Show.Show (GHC.Inte instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Show.Show GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -10088,6 +10088,9 @@ module System.IO.Error where module System.IO.OS where -- Safety: Safe + type OSHandleType :: * + data OSHandleType = FileDescriptor | WindowsHandle + osHandleType :: OSHandleType withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r @@ -11402,6 +11405,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Int instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Eq GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ @@ -11555,6 +11559,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Ord (GHC.In instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Ord (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Ord GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Control.Arrow.Arrow (->) -- Defined in ‘GHC.Internal.Control.Arrow’ instance forall (m :: * -> *). GHC.Internal.Base.Monad m => GHC.Internal.Control.Arrow.Arrow (GHC.Internal.Control.Arrow.Kleisli m) -- Defined in ‘GHC.Internal.Control.Arrow’ instance GHC.Internal.Control.Arrow.ArrowApply (->) -- Defined in ‘GHC.Internal.Control.Arrow’ @@ -11954,6 +11959,7 @@ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.Associativity -- Define instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.DecidedStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ +instance [safe] GHC.Internal.Enum.Bounded GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance forall a k (b :: k). GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’ @@ -12035,6 +12041,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ +instance [safe] GHC.Internal.Enum.Enum GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ @@ -12584,6 +12591,7 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S 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 [safe] GHC.Internal.Read.Read GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ 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’ @@ -12918,6 +12926,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Show.Show (GHC.Inte instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Show.Show GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -10330,6 +10330,9 @@ module System.IO.Error where module System.IO.OS where -- Safety: Safe + type OSHandleType :: * + data OSHandleType = FileDescriptor | WindowsHandle + osHandleType :: OSHandleType withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r @@ -11631,6 +11634,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Int instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Eq GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ @@ -11786,6 +11790,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Ord (GHC.In instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Ord (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Ord GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Control.Arrow.Arrow (->) -- Defined in ‘GHC.Internal.Control.Arrow’ instance forall (m :: * -> *). GHC.Internal.Base.Monad m => GHC.Internal.Control.Arrow.Arrow (GHC.Internal.Control.Arrow.Kleisli m) -- Defined in ‘GHC.Internal.Control.Arrow’ instance GHC.Internal.Control.Arrow.ArrowApply (->) -- Defined in ‘GHC.Internal.Control.Arrow’ @@ -12185,6 +12190,7 @@ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.Associativity -- Define instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.DecidedStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ +instance [safe] GHC.Internal.Enum.Bounded GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance forall a k (b :: k). GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’ @@ -12267,6 +12273,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ +instance [safe] GHC.Internal.Enum.Enum GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ @@ -12827,6 +12834,7 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S 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 [safe] GHC.Internal.Read.Read GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ 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’ @@ -13166,6 +13174,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Show.Show (GHC.Inte instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Show.Show GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -10050,6 +10050,9 @@ module System.IO.Error where module System.IO.OS where -- Safety: Safe + type OSHandleType :: * + data OSHandleType = FileDescriptor | WindowsHandle + osHandleType :: OSHandleType withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r @@ -11375,6 +11378,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Int instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Eq GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ @@ -11528,6 +11532,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Ord (GHC.In instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Classes.Ord (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Classes.Ord GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Classes.Ord GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Control.Arrow.Arrow (->) -- Defined in ‘GHC.Internal.Control.Arrow’ instance forall (m :: * -> *). GHC.Internal.Base.Monad m => GHC.Internal.Control.Arrow.Arrow (GHC.Internal.Control.Arrow.Kleisli m) -- Defined in ‘GHC.Internal.Control.Arrow’ instance GHC.Internal.Control.Arrow.ArrowApply (->) -- Defined in ‘GHC.Internal.Control.Arrow’ @@ -11927,6 +11932,7 @@ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.Associativity -- Define instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.DecidedStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Generics’ instance GHC.Internal.Enum.Bounded GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’ +instance [safe] GHC.Internal.Enum.Bounded GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance forall a k (b :: k). GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’ @@ -12008,6 +12014,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’ instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ +instance [safe] GHC.Internal.Enum.Enum GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ @@ -12555,6 +12562,7 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S 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 [safe] GHC.Internal.Read.Read GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ 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’ @@ -12894,6 +12902,7 @@ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Show.Show (GHC.Inte instance forall (s :: GHC.Internal.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’ instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’ +instance [safe] GHC.Internal.Show.Show GHC.Internal.System.IO.OS.OSHandleType -- Defined in ‘GHC.Internal.System.IO.OS’ instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’ instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7adf91a5802ded6fd333ce9a0c031ed… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7adf91a5802ded6fd333ce9a0c031ed… You're receiving this email because of your account on gitlab.haskell.org.

1 0