Wolfgang Jeltsch pushed to branch wip/jeltsch/base-buildable-with-ghc-9-14 at Glasgow Haskell Compiler / GHC Commits: 15d27c82 by Wolfgang Jeltsch at 2026-05-20T12:54:44+03:00 Make the current `base` buildable with GHC 9.14 This comprises the following changes: * Disable some imports into `GHC.Base` for GHC 9.14 * Disable some imports into `Prelude` for GHC 9.14 * Disable separate `ArrowLoop` import for GHC 9.14 * Disable `GHC.Internal.STM` import for GHC 9.14 * Disable `GHC.Internal.Unicode.Version` import for GHC 9.14 * Disable `GHC.Internal.TH.Monad` import for GHC 9.14 * Add alternative `fixIO` import for GHC 9.14 * Add alternative `unsafeCodeCoerce` import for GHC 9.14 * Disable hiding of imported SIMD operations for GHC 9.14 * Disable use of GHC 9.14’s `printToHandleFinalizerExceptionHandler` * Enable use of `getFileHash` from `ghc-internal` for GHC 9.14 * Make `thenA` available for GHC 9.14 * Make `thenM` available for GHC 9.14 * Disable translation of `IoManagerFlagPoll` for GHC 9.14 * Add `hGetNewlineMode` for GHC 9.14 - - - - - 18 changed files: - libraries/base/src/Control/Applicative.hs - libraries/base/src/Control/Arrow.hs - libraries/base/src/Control/Monad.hs - libraries/base/src/Data/Array/Byte.hs - libraries/base/src/Data/Fixed.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Conc.hs - libraries/base/src/GHC/Conc/Sync.hs - libraries/base/src/GHC/Exts.hs - libraries/base/src/GHC/Fingerprint.hs - libraries/base/src/GHC/IO/Handle.hs - libraries/base/src/GHC/RTS/Flags.hs - libraries/base/src/GHC/Unicode.hs - libraries/base/src/GHC/Weak.hs - libraries/base/src/GHC/Weak/Finalize.hs - libraries/base/src/Prelude.hs - libraries/base/src/System/IO.hs - libraries/base/src/System/Mem/Weak.hs Changes: ===================================== libraries/base/src/Control/Applicative.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -64,8 +65,13 @@ import GHC.Internal.Data.Data (Data) import GHC.Internal.Base ( Alternative(..), Applicative(..), Functor(..), Monad(..), MonadPlus(..), - ap, const, liftA, liftA3, liftM, liftM2, thenA, (.), (<**>), + ap, const, liftA, liftA3, liftM, liftM2, (.), (<**>), ) +#if __GLASGOW_HASKELL__ < 1000 +import GHC.Internal.Base (id) +#else +import GHC.Internal.Base (thenA) +#endif import GHC.Internal.Functor.ZipList (ZipList(..)) import GHC.Internal.Types import GHC.Generics @@ -148,3 +154,19 @@ deriving instance (Typeable (a :: Type -> Type -> Type), Typeable b, Typeable c, optional :: Alternative f => f a -> f (Maybe a) optional v = Just <$> v <|> pure Nothing + +#if __GLASGOW_HASKELL__ < 1000 + +-- | Sequence two `Applicative` actions, discarding the result of the first one. +-- +-- Defined as `thenA fa fb = (id <$ fa) <*> fb`. +-- +-- This can be used to explicitly define `(*>) = thenA`, which is the default +-- definition. +-- +-- @since 4.23.0.0 +thenA :: Applicative f => f a -> f b -> f b +thenA fa fb = (id <$ fa) <*> fb +{-# INLINEABLE thenA #-} + +#endif ===================================== libraries/base/src/Control/Arrow.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | @@ -50,4 +51,6 @@ module Control.Arrow ) where import GHC.Internal.Control.Arrow +#if __GLASGOW_HASKELL__ >= 1000 import GHC.Internal.Control.Monad.Fix (ArrowLoop(..)) +#endif ===================================== libraries/base/src/Control/Monad.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | @@ -63,6 +64,9 @@ module Control.Monad ) where import GHC.Internal.Control.Monad +#if __GLASGOW_HASKELL__ < 1000 +import Data.Function (const) +#endif {- $naming @@ -88,3 +92,18 @@ The functions in this module use the following naming conventions:
mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a
-} + +#if __GLASGOW_HASKELL__ < 1000 + +-- | Sequence two monadic actions, discarding the result of the first one. +-- +-- Defined as `thenM ma mb = ma >>= const mb`. +-- +-- This can be used to define `(*>) = thenM`. +-- +-- @since 4.23.0.0 +thenM :: (Monad m) => m a -> m b -> m b +thenM ma mb = ma >>= const mb +{-# INLINEABLE thenM #-} + +#endif ===================================== libraries/base/src/Data/Array/Byte.hs ===================================== @@ -8,6 +8,7 @@ -- -- Derived from @primitive@ package. +{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} @@ -32,7 +33,9 @@ import GHC.Internal.Show (intToDigit) import GHC.Internal.ST (ST(..), runST) import GHC.Internal.Word (Word8(..)) import GHC.Internal.TH.Syntax -import GHC.Internal.TH.Monad +#if __GLASGOW_HASKELL__ >= 1000 +import GHC.Internal.TH.Monad (unsafeCodeCoerce) +#endif import GHC.Internal.TH.Lift import GHC.Internal.ForeignPtr import Prelude ===================================== libraries/base/src/Data/Fixed.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PolyKinds #-} @@ -91,7 +92,11 @@ import GHC.Internal.TypeLits (KnownNat, natVal) import GHC.Internal.Read import GHC.Internal.Text.ParserCombinators.ReadPrec import GHC.Internal.Text.Read.Lex -import qualified GHC.Internal.TH.Monad as TH +#if __GLASGOW_HASKELL__ < 1000 +import GHC.Internal.TH.Syntax (unsafeCodeCoerce) +#else +import GHC.Internal.TH.Monad (unsafeCodeCoerce) +#endif import qualified GHC.Internal.TH.Lift as TH import Data.Typeable import Prelude @@ -147,7 +152,7 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where -- @since template-haskell-2.19.0.0 -- @since base-4.21.0.0 instance TH.Lift (Fixed a) where - liftTyped x = TH.unsafeCodeCoerce (TH.lift x) + liftTyped x = unsafeCodeCoerce (TH.lift x) lift (MkFixed x) = [| MkFixed x |] -- | Types which can be used as a resolution argument to the 'Fixed' type constructor must implement the 'HasResolution' typeclass. ===================================== libraries/base/src/GHC/Base.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -139,10 +140,12 @@ module GHC.Base ) where import GHC.Internal.Base hiding ( NonEmpty(..) ) +import GHC.Internal.Data.NonEmpty ( NonEmpty(..) ) +#if __GLASGOW_HASKELL__ >= 1000 import GHC.Internal.Classes import GHC.Internal.CString -import GHC.Internal.Data.NonEmpty ( NonEmpty(..) ) import GHC.Internal.Magic.Dict ( WithDict(..) ) +#endif import GHC.Prim hiding ( -- Hide dataToTag# ops because they are expected to break for @@ -273,6 +276,7 @@ import GHC.Prim hiding , minWord8X16# , minWord8X32# , minWord8X64# +#if __GLASGOW_HASKELL__ >= 1000 -- Don't re-export vector logical primops , andDoubleX2# , andDoubleX4# @@ -389,13 +393,16 @@ import GHC.Prim hiding , sqrtDoubleX4# , sqrtFloatX16# , sqrtDoubleX8# +#endif ) import GHC.Prim.Ext import GHC.Prim.PtrEq import GHC.Internal.Err import GHC.Internal.IO (seq#) +#if __GLASGOW_HASKELL__ >= 1000 import GHC.Internal.Magic +#endif import GHC.Internal.Maybe import GHC.Types hiding ( Unit#, ===================================== libraries/base/src/GHC/Conc.hs ===================================== @@ -119,7 +119,9 @@ module GHC.Conc import GHC.Internal.Conc.IO import GHC.Internal.Conc.Sync +#if __GLASGOW_HASKELL__ >= 1000 import GHC.Internal.STM +#endif #if !defined(mingw32_HOST_OS) import GHC.Internal.Conc.Signal ===================================== libraries/base/src/GHC/Conc/Sync.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -89,4 +90,6 @@ module GHC.Conc.Sync ) where import GHC.Internal.Conc.Sync +#if __GLASGOW_HASKELL__ >= 1000 import GHC.Internal.STM +#endif ===================================== libraries/base/src/GHC/Exts.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -246,6 +247,7 @@ import GHC.Prim hiding , minWord8X16# , minWord8X32# , minWord8X64# +#if __GLASGOW_HASKELL__ >= 1000 -- Don't re-export vector logical primops , andDoubleX2# , andDoubleX4# @@ -362,6 +364,7 @@ import GHC.Prim hiding , sqrtDoubleX4# , sqrtFloatX16# , sqrtDoubleX8# +#endif ) import GHC.Prim.Ext ===================================== libraries/base/src/GHC/Fingerprint.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} module GHC.Fingerprint ( @@ -10,6 +11,8 @@ module GHC.Fingerprint ( import GHC.Internal.Fingerprint +#if __GLASGOW_HASKELL__ >= 1000 + import Data.Function (($)) import Control.Monad (return, when) import Data.Bool (not, (&&)) @@ -51,3 +54,5 @@ getFileHash path = withBinaryFile path ReadMode $ \ hdl -> ) return (if isFinished then Just chunkSize else Nothing) in fingerprintBufferedStream readChunk + +#endif ===================================== libraries/base/src/GHC/IO/Handle.hs ===================================== @@ -1,4 +1,10 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ < 1000 +{-# LANGUAGE Trustworthy #-} +#else {-# LANGUAGE Safe #-} +#endif +{-# LANGUAGE RecordWildCards #-} -- | -- @@ -75,3 +81,19 @@ module GHC.IO.Handle ) where import GHC.Internal.IO.Handle + +#if __GLASGOW_HASKELL__ < 1000 + +import GHC.Internal.Base (($), IO, return) +import GHC.Internal.IO.Handle.Types (Handle__ (..)) +import GHC.Internal.IO.Handle.Internals (withHandle_) + +-- | Return the current 'NewlineMode' for the specified 'Handle'. +-- +-- @since 4.23.0.0 +hGetNewlineMode :: Handle -> IO NewlineMode +hGetNewlineMode hdl = + withHandle_ "hGetNewlineMode" hdl $ \Handle__{..} -> + return NewlineMode{ inputNL = haInputNL, outputNL = haOutputNL } + +#endif ===================================== libraries/base/src/GHC/RTS/Flags.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveGeneric #-} @@ -388,11 +389,13 @@ internal_to_base_MiscFlags i@Internal.MiscFlags{..} = internal_to_base_ioManager :: Internal.IoManagerFlag -> IoManagerFlag internal_to_base_ioManager Internal.IoManagerFlagAuto = IoManagerFlagAuto internal_to_base_ioManager Internal.IoManagerFlagSelect = IoManagerFlagSelect +#if __GLASGOW_HASKELL__ >= 1000 internal_to_base_ioManager Internal.IoManagerFlagPoll = IoManagerFlagAuto -- This is a lie, we cannot translate poll. We cannot translate -- accurately because want to freeze the API of the the compat RTS flags -- here. Using "auto" is the least bad translation. -- https://github.com/haskell/core-libraries-committee/issues/362 +#endif internal_to_base_ioManager Internal.IoManagerFlagMIO = IoManagerFlagMIO internal_to_base_ioManager Internal.IoManagerFlagWinIO = IoManagerFlagWinIO internal_to_base_ioManager Internal.IoManagerFlagWin32Legacy = IoManagerFlagWin32Legacy ===================================== libraries/base/src/GHC/Unicode.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK not-home #-} @@ -44,4 +45,6 @@ module GHC.Unicode ) where import GHC.Internal.Unicode +#if __GLASGOW_HASKELL__ >= 1000 import GHC.Internal.Unicode.Version +#endif ===================================== libraries/base/src/GHC/Weak.hs ===================================== @@ -25,9 +25,8 @@ module GHC.Weak -- this handler will be ignored. setFinalizerExceptionHandler, getFinalizerExceptionHandler, - printToHandleFinalizerExceptionHandler + GHC.Weak.Finalize.printToHandleFinalizerExceptionHandler ) where import GHC.Internal.Weak -import GHC.Internal.Weak.Finalize import GHC.Weak.Finalize ===================================== libraries/base/src/GHC/Weak/Finalize.hs ===================================== @@ -7,7 +7,7 @@ module GHC.Weak.Finalize -- this handler will be ignored. setFinalizerExceptionHandler , getFinalizerExceptionHandler - , printToHandleFinalizerExceptionHandler + , GHC.Weak.Finalize.printToHandleFinalizerExceptionHandler -- * Internal , GHC.Weak.Finalize.runFinalizerBatch ) where ===================================== libraries/base/src/Prelude.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ExplicitNamespaces #-} @@ -176,14 +177,16 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Traversable ( Traversable(..) ) import GHC.Internal.Data.Tuple -import GHC.Internal.Base hiding ( foldr, mapM, sequence ) +#if __GLASGOW_HASKELL__ >= 1000 import GHC.Internal.Classes import GHC.Internal.Err +import GHC.Internal.Prim (seq) +import GHC.Internal.Types +#endif +import GHC.Internal.Base hiding ( foldr, mapM, sequence ) import Text.Read import GHC.Internal.Enum import GHC.Internal.Num -import GHC.Internal.Prim (seq) import GHC.Internal.Real import GHC.Internal.Float import GHC.Internal.Show -import GHC.Internal.Types ===================================== libraries/base/src/System/IO.hs ===================================== @@ -279,7 +279,11 @@ import GHC.IO.StdHandles stdout, stderr ) +#if __GLASGOW_HASKELL__ < 1000 +import GHC.Internal.System.IO (fixIO) +#else import GHC.Internal.Control.Monad.Fix (fixIO) +#endif import Control.Monad (return, (>>=)) import Control.Exception (ioError) import Data.Eq ((==)) ===================================== libraries/base/src/System/Mem/Weak.hs ===================================== @@ -78,7 +78,7 @@ module System.Mem.Weak ( -- this handler will be ignored. setFinalizerExceptionHandler, getFinalizerExceptionHandler, - printToHandleFinalizerExceptionHandler, + GHC.Weak.printToHandleFinalizerExceptionHandler, -- * A precise semantics View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15d27c8292e19e545263fd319884f6c9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15d27c8292e19e545263fd319884f6c9... You're receiving this email because of your account on gitlab.haskell.org.