Wolfgang Jeltsch pushed to branch wip/jeltsch/base-buildable-with-ghc-9-14 at Glasgow Haskell Compiler / GHC

Commits:

18 changed files:

Changes:

  • libraries/base/src/Control/Applicative.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Trustworthy #-}
    2 3 
     {-# LANGUAGE DeriveGeneric #-}
    3 4 
     {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    ... ... @@ -64,8 +65,13 @@ import GHC.Internal.Data.Data (Data)
    64 65
    65 66 
     import GHC.Internal.Base (
    66 67 
         Alternative(..), Applicative(..), Functor(..), Monad(..), MonadPlus(..),
    67 
    -    ap, const, liftA, liftA3, liftM, liftM2, thenA, (.), (<**>),
    68 
    +    ap, const, liftA, liftA3, liftM, liftM2, (.), (<**>),
    68 69 
       )
    70 
    +#if __GLASGOW_HASKELL__ < 1000
    71 
    +import GHC.Internal.Base (id)
    72 
    +#else
    73 
    +import GHC.Internal.Base (thenA)
    74 
    +#endif
    69 75 
     import GHC.Internal.Functor.ZipList (ZipList(..))
    70 76 
     import GHC.Internal.Types
    71 77 
     import GHC.Generics
    ... ... @@ -148,3 +154,19 @@ deriving instance (Typeable (a :: Type -> Type -> Type), Typeable b, Typeable c,
    148 154
    149 155 
     optional :: Alternative f => f a -> f (Maybe a)
    150 156 
     optional v = Just <$> v <|> pure Nothing
    157 
    +
    158 
    +#if __GLASGOW_HASKELL__ < 1000
    159 
    +
    160 
    +-- | Sequence two `Applicative` actions, discarding the result of the first one.
    161 
    +--
    162 
    +-- Defined as `thenA fa fb = (id <$ fa) <*> fb`.
    163 
    +--
    164 
    +-- This can be used to explicitly define `(*>) = thenA`, which is the default
    165 
    +-- definition.
    166 
    +--
    167 
    +-- @since 4.23.0.0
    168 
    +thenA :: Applicative f => f a -> f b -> f b
    169 
    +thenA fa fb = (id <$ fa) <*> fb
    170 
    +{-# INLINEABLE thenA #-}
    171 
    +
    172 
    +#endif

  • libraries/base/src/Control/Arrow.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3
    3 4 
     -- |
    ... ... @@ -50,4 +51,6 @@ module Control.Arrow
    50 51 
          ) where
    51 52
    52 53 
     import GHC.Internal.Control.Arrow
    54 
    +#if __GLASGOW_HASKELL__ >= 1000
    53 55 
     import GHC.Internal.Control.Monad.Fix (ArrowLoop(..))
    56 
    +#endif

  • libraries/base/src/Control/Monad.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3
    3 4 
     -- |
    ... ... @@ -63,6 +64,9 @@ module Control.Monad
    63 64 
          ) where
    64 65
    65 66 
     import GHC.Internal.Control.Monad
    67 
    +#if __GLASGOW_HASKELL__ < 1000
    68 
    +import Data.Function (const)
    69 
    +#endif
    66 70
    67 71 
     {- $naming
    68 72
    ... ... @@ -88,3 +92,18 @@ The functions in this module use the following naming conventions:
    88 92 
     > mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a
    89 93
    90 94 
     -}
    95 
    +
    96 
    +#if __GLASGOW_HASKELL__ < 1000
    97 
    +
    98 
    +-- | Sequence two monadic actions, discarding the result of the first one.
    99 
    +--
    100 
    +-- Defined as `thenM ma mb = ma >>= const mb`.
    101 
    +--
    102 
    +-- This can be used to define `(*>) = thenM`.
    103 
    +--
    104 
    +-- @since 4.23.0.0
    105 
    +thenM :: (Monad m) => m a -> m b -> m b
    106 
    +thenM ma mb = ma >>= const mb
    107 
    +{-# INLINEABLE thenM #-}
    108 
    +
    109 
    +#endif

  • libraries/base/src/Data/Array/Byte.hs
    ... ... @@ -8,6 +8,7 @@
    8 8 
     --
    9 9 
     -- Derived from @primitive@ package.
    10 10
    11 
    +{-# LANGUAGE CPP #-}
    11 12 
     {-# LANGUAGE BangPatterns #-}
    12 13 
     {-# LANGUAGE MagicHash #-}
    13 14 
     {-# LANGUAGE TypeFamilies #-}
    ... ... @@ -32,7 +33,9 @@ import GHC.Internal.Show (intToDigit)
    32 33 
     import GHC.Internal.ST (ST(..), runST)
    33 34 
     import GHC.Internal.Word (Word8(..))
    34 35 
     import GHC.Internal.TH.Syntax
    35 
    -import GHC.Internal.TH.Monad
    36 
    +#if __GLASGOW_HASKELL__ >= 1000
    37 
    +import GHC.Internal.TH.Monad (unsafeCodeCoerce)
    38 
    +#endif
    36 39 
     import GHC.Internal.TH.Lift
    37 40 
     import GHC.Internal.ForeignPtr
    38 41 
     import Prelude

  • libraries/base/src/Data/Fixed.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3 
     {-# LANGUAGE ScopedTypeVariables #-}
    3 4 
     {-# LANGUAGE PolyKinds #-}
    ... ... @@ -91,7 +92,11 @@ import GHC.Internal.TypeLits (KnownNat, natVal)
    91 92 
     import GHC.Internal.Read
    92 93 
     import GHC.Internal.Text.ParserCombinators.ReadPrec
    93 94 
     import GHC.Internal.Text.Read.Lex
    94 
    -import qualified GHC.Internal.TH.Monad as TH
    95 
    +#if __GLASGOW_HASKELL__ < 1000
    96 
    +import GHC.Internal.TH.Syntax (unsafeCodeCoerce)
    97 
    +#else
    98 
    +import GHC.Internal.TH.Monad (unsafeCodeCoerce)
    99 
    +#endif
    95 100 
     import qualified GHC.Internal.TH.Lift as TH
    96 101 
     import Data.Typeable
    97 102 
     import Prelude
    ... ... @@ -147,7 +152,7 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where
    147 152 
     -- @since template-haskell-2.19.0.0
    148 153 
     -- @since base-4.21.0.0
    149 154 
     instance TH.Lift (Fixed a) where
    150 
    -  liftTyped x = TH.unsafeCodeCoerce (TH.lift x)
    155 
    +  liftTyped x = unsafeCodeCoerce (TH.lift x)
    151 156 
       lift (MkFixed x) = [| MkFixed x |]
    152 157
    153 158 
     -- | 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 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE MagicHash #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -139,10 +140,12 @@ module GHC.Base
    139 140 
         ) where
    140 141
    141 142 
     import GHC.Internal.Base hiding ( NonEmpty(..) )
    143 
    +import GHC.Internal.Data.NonEmpty ( NonEmpty(..) )
    144 
    +#if __GLASGOW_HASKELL__ >= 1000
    142 145 
     import GHC.Internal.Classes
    143 146 
     import GHC.Internal.CString
    144 
    -import GHC.Internal.Data.NonEmpty ( NonEmpty(..) )
    145 147 
     import GHC.Internal.Magic.Dict ( WithDict(..) )
    148 
    +#endif
    146 149 
     import GHC.Prim hiding
    147 150 
       (
    148 151 
       -- Hide dataToTag# ops because they are expected to break for
    ... ... @@ -273,6 +276,7 @@ import GHC.Prim hiding
    273 276 
       , minWord8X16#
    274 277 
       , minWord8X32#
    275 278 
       , minWord8X64#
    279 
    +#if __GLASGOW_HASKELL__ >= 1000
    276 280 
       -- Don't re-export vector logical primops
    277 281 
       , andDoubleX2#
    278 282 
       , andDoubleX4#
    ... ... @@ -389,13 +393,16 @@ import GHC.Prim hiding
    389 393 
       , sqrtDoubleX4#
    390 394 
       , sqrtFloatX16#
    391 395 
       , sqrtDoubleX8#
    396 
    +#endif
    392 397 
       )
    393 398
    394 399 
     import GHC.Prim.Ext
    395 400 
     import GHC.Prim.PtrEq
    396 401 
     import GHC.Internal.Err
    397 402 
     import GHC.Internal.IO (seq#)
    403 
    +#if __GLASGOW_HASKELL__ >= 1000
    398 404 
     import GHC.Internal.Magic
    405 
    +#endif
    399 406 
     import GHC.Internal.Maybe
    400 407 
     import GHC.Types hiding (
    401 408 
       Unit#,

  • libraries/base/src/GHC/Conc.hs
    ... ... @@ -119,7 +119,9 @@ module GHC.Conc
    119 119
    120 120 
     import GHC.Internal.Conc.IO
    121 121 
     import GHC.Internal.Conc.Sync
    122 
    +#if __GLASGOW_HASKELL__ >= 1000
    122 123 
     import GHC.Internal.STM
    124 
    +#endif
    123 125
    124 126 
     #if !defined(mingw32_HOST_OS)
    125 127 
     import GHC.Internal.Conc.Signal

  • libraries/base/src/GHC/Conc/Sync.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE MagicHash #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -89,4 +90,6 @@ module GHC.Conc.Sync
    89 90 
             ) where
    90 91
    91 92 
     import GHC.Internal.Conc.Sync
    93 
    +#if __GLASGOW_HASKELL__ >= 1000
    92 94 
     import GHC.Internal.STM
    95 
    +#endif

  • libraries/base/src/GHC/Exts.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE MagicHash #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -246,6 +247,7 @@ import GHC.Prim hiding
    246 247 
       , minWord8X16#
    247 248 
       , minWord8X32#
    248 249 
       , minWord8X64#
    250 
    +#if __GLASGOW_HASKELL__ >= 1000
    249 251 
       -- Don't re-export vector logical primops
    250 252 
       , andDoubleX2#
    251 253 
       , andDoubleX4#
    ... ... @@ -362,6 +364,7 @@ import GHC.Prim hiding
    362 364 
       , sqrtDoubleX4#
    363 365 
       , sqrtFloatX16#
    364 366 
       , sqrtDoubleX8#
    367 
    +#endif
    365 368 
       )
    366 369
    367 370 
     import GHC.Prim.Ext

  • libraries/base/src/GHC/Fingerprint.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3
    3 4 
     module GHC.Fingerprint (
    ... ... @@ -10,6 +11,8 @@ module GHC.Fingerprint (
    10 11
    11 12 
     import GHC.Internal.Fingerprint
    12 13
    14 
    +#if __GLASGOW_HASKELL__ >= 1000
    15 
    +
    13 16 
     import Data.Function (($))
    14 17 
     import Control.Monad (return, when)
    15 18 
     import Data.Bool (not, (&&))
    ... ... @@ -51,3 +54,5 @@ getFileHash path = withBinaryFile path ReadMode $ \ hdl ->
    51 54 
                      )
    52 55 
                 return (if isFinished then Just chunkSize else Nothing)
    53 56 
         in fingerprintBufferedStream readChunk
    57 
    +
    58 
    +#endif

  • libraries/base/src/GHC/IO/Handle.hs
    1 
    +{-# LANGUAGE CPP #-}
    2 
    +#if __GLASGOW_HASKELL__ < 1000
    3 
    +{-# LANGUAGE Trustworthy #-}
    4 
    +#else
    1 5 
     {-# LANGUAGE Safe #-}
    6 
    +#endif
    7 
    +{-# LANGUAGE RecordWildCards #-}
    2 8
    3 9 
     -- |
    4 10 
     --
    ... ... @@ -75,3 +81,19 @@ module GHC.IO.Handle
    75 81 
          ) where
    76 82
    77 83 
     import GHC.Internal.IO.Handle
    84 
    +
    85 
    +#if __GLASGOW_HASKELL__ < 1000
    86 
    +
    87 
    +import GHC.Internal.Base (($), IO, return)
    88 
    +import GHC.Internal.IO.Handle.Types (Handle__ (..))
    89 
    +import GHC.Internal.IO.Handle.Internals (withHandle_)
    90 
    +
    91 
    +-- | Return the current 'NewlineMode' for the specified 'Handle'.
    92 
    +--
    93 
    +-- @since 4.23.0.0
    94 
    +hGetNewlineMode :: Handle -> IO NewlineMode
    95 
    +hGetNewlineMode hdl =
    96 
    +  withHandle_ "hGetNewlineMode" hdl $ \Handle__{..} ->
    97 
    +    return NewlineMode{ inputNL = haInputNL, outputNL = haOutputNL }
    98 
    +
    99 
    +#endif

  • libraries/base/src/GHC/RTS/Flags.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE RecordWildCards #-}
    2 3 
     {-# LANGUAGE DeriveGeneric #-}
    3 4
    ... ... @@ -388,11 +389,13 @@ internal_to_base_MiscFlags i@Internal.MiscFlags{..} =
    388 389 
         internal_to_base_ioManager :: Internal.IoManagerFlag -> IoManagerFlag
    389 390 
         internal_to_base_ioManager Internal.IoManagerFlagAuto        = IoManagerFlagAuto
    390 391 
         internal_to_base_ioManager Internal.IoManagerFlagSelect      = IoManagerFlagSelect
    392 
    +#if __GLASGOW_HASKELL__ >= 1000
    391 393 
         internal_to_base_ioManager Internal.IoManagerFlagPoll        = IoManagerFlagAuto
    392 394 
           -- This is a lie, we cannot translate poll. We cannot translate
    393 395 
           -- accurately because want to freeze the API of the the compat RTS flags
    394 396 
           -- here. Using "auto" is the least bad translation.
    395 397 
           -- https://github.com/haskell/core-libraries-committee/issues/362
    398 
    +#endif
    396 399 
         internal_to_base_ioManager Internal.IoManagerFlagMIO         = IoManagerFlagMIO
    397 400 
         internal_to_base_ioManager Internal.IoManagerFlagWinIO       = IoManagerFlagWinIO
    398 401 
         internal_to_base_ioManager Internal.IoManagerFlagWin32Legacy = IoManagerFlagWin32Legacy

  • libraries/base/src/GHC/Unicode.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -44,4 +45,6 @@ module GHC.Unicode
    44 45 
          ) where
    45 46
    46 47 
     import GHC.Internal.Unicode
    48 
    +#if __GLASGOW_HASKELL__ >= 1000
    47 49 
     import GHC.Internal.Unicode.Version
    50 
    +#endif

  • libraries/base/src/GHC/Weak.hs
    ... ... @@ -25,9 +25,8 @@ module GHC.Weak
    25 25 
          -- this handler will be ignored.
    26 26 
          setFinalizerExceptionHandler,
    27 27 
          getFinalizerExceptionHandler,
    28 
    -     printToHandleFinalizerExceptionHandler
    28 
    +     GHC.Weak.Finalize.printToHandleFinalizerExceptionHandler
    29 29 
          ) where
    30 30
    31 31 
     import GHC.Internal.Weak
    32 
    -import GHC.Internal.Weak.Finalize
    33 32 
     import GHC.Weak.Finalize

  • libraries/base/src/GHC/Weak/Finalize.hs
    ... ... @@ -7,7 +7,7 @@ module GHC.Weak.Finalize
    7 7 
           -- this handler will be ignored.
    8 8 
           setFinalizerExceptionHandler
    9 9 
         , getFinalizerExceptionHandler
    10 
    -    , printToHandleFinalizerExceptionHandler
    10 
    +    , GHC.Weak.Finalize.printToHandleFinalizerExceptionHandler
    11 11 
           -- * Internal
    12 12 
         , GHC.Weak.Finalize.runFinalizerBatch
    13 13 
         ) where

  • libraries/base/src/Prelude.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Trustworthy #-}
    2 3 
     {-# LANGUAGE NoImplicitPrelude #-}
    3 4 
     {-# LANGUAGE ExplicitNamespaces #-}
    ... ... @@ -176,14 +177,16 @@ import GHC.Internal.Data.Maybe
    176 177 
     import GHC.Internal.Data.Traversable ( Traversable(..) )
    177 178 
     import GHC.Internal.Data.Tuple
    178 179
    179 
    -import GHC.Internal.Base hiding ( foldr, mapM, sequence )
    180 
    +#if __GLASGOW_HASKELL__ >= 1000
    180 181 
     import GHC.Internal.Classes
    181 182 
     import GHC.Internal.Err
    183 
    +import GHC.Internal.Prim (seq)
    184 
    +import GHC.Internal.Types
    185 
    +#endif
    186 
    +import GHC.Internal.Base hiding ( foldr, mapM, sequence )
    182 187 
     import Text.Read
    183 188 
     import GHC.Internal.Enum
    184 189 
     import GHC.Internal.Num
    185 
    -import GHC.Internal.Prim (seq)
    186 190 
     import GHC.Internal.Real
    187 191 
     import GHC.Internal.Float
    188 192 
     import GHC.Internal.Show
    189 
    -import GHC.Internal.Types

  • libraries/base/src/System/IO.hs
    ... ... @@ -279,7 +279,11 @@ import GHC.IO.StdHandles
    279 279 
                stdout,
    280 280 
                stderr
    281 281 
            )
    282 
    +#if __GLASGOW_HASKELL__ < 1000
    283 
    +import GHC.Internal.System.IO (fixIO)
    284 
    +#else
    282 285 
     import GHC.Internal.Control.Monad.Fix (fixIO)
    286 
    +#endif
    283 287 
     import Control.Monad (return, (>>=))
    284 288 
     import Control.Exception (ioError)
    285 289 
     import Data.Eq ((==))

  • libraries/base/src/System/Mem/Weak.hs
    ... ... @@ -78,7 +78,7 @@ module System.Mem.Weak (
    78 78 
             -- this handler will be ignored.
    79 79 
             setFinalizerExceptionHandler,
    80 80 
             getFinalizerExceptionHandler,
    81 
    -        printToHandleFinalizerExceptionHandler,
    81 
    +        GHC.Weak.printToHandleFinalizerExceptionHandler,
    82 82
    83 83 
             -- * A precise semantics
    84 84

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help