diff --git a/base.cabal b/base.cabal --- a/base.cabal +++ b/base.cabal @@ -4,7 +4,7 @@ -- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal name: base -version: 4.21.2.0 +version: 4.22.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause @@ -30,7 +30,7 @@ default-language: Haskell2010 default-extensions: NoImplicitPrelude build-depends: - ghc-internal == 9.1204.*, + ghc-internal == 9.1401.*, ghc-prim, exposed-modules: @@ -170,7 +170,6 @@ , GHC.Exception , GHC.Exception.Type , GHC.ExecutionStack - , GHC.ExecutionStack.Internal , GHC.Exts , GHC.Fingerprint , GHC.Fingerprint.Type @@ -220,6 +219,9 @@ , GHC.MVar , GHC.Natural , GHC.Num + , GHC.Num.Integer + , GHC.Num.Natural + , GHC.Num.BigNat , GHC.OldList , GHC.OverloadedLabels , GHC.Profiling @@ -244,9 +246,7 @@ , GHC.TopHandler , GHC.TypeError , GHC.TypeLits - , GHC.TypeLits.Internal , GHC.TypeNats - , GHC.TypeNats.Internal , GHC.Unicode , GHC.Weak , GHC.Weak.Finalize @@ -271,13 +271,6 @@ , Type.Reflection , Type.Reflection.Unsafe , Unsafe.Coerce - -- TODO: remove - , GHC.IOPort - - reexported-modules: - GHC.Num.Integer - , GHC.Num.Natural - , GHC.Num.BigNat if os(windows) exposed-modules: diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,13 +1,34 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## 4.21.2.0 *March 2026* - * Expose `Backtraces` constructor and fields ([CLC proposal #199](https://github.com/haskell/core-libraries-committee/issues/199), [#26049](https://gitlab.haskell.org/ghc/ghc/-/issues/26049)) - * Store `StackTrace` and `StackSnapshot` in `Backtraces`, deferring decoding until display - * Evaluate backtraces for "error" exceptions at the moment they are thrown ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383), [#26751](https://gitlab.haskell.org/ghc/ghc/-/issues/26751)) - -## 4.21.1.0 *Sept 2024* +## 4.22.0.0 *December 2025* + * Shipped with GHC 9.14.1 + * The internal `GHC.Weak.Finalize.runFinalizerBatch` function has been deprecated ([CLC proposal #342](https://github.com/haskell/core-libraries-committee/issues/342)) + * Define `displayException` of `SomeAsyncException` to unwrap the exception. + ([CLC proposal #309](https://github.com/haskell/core-libraries-committee/issues/309)) + * Restrict `Data.List.NonEmpty.unzip` to `NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)`. ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) + * Modify the implementation of `Control.Exception.throw` to avoid call-sites being inferred as diverging via precise exception. + ([GHC #25066](https://gitlab.haskell.org/ghc/ghc/-/issues/25066), [CLC proposal #290](https://github.com/haskell/core-libraries-committee/issues/290)) + * `Data.List.NonEmpty.{init,last,tails1}` are now defined using only total functions (rather than partial ones). ([CLC proposal #293](https://github.com/haskell/core-libraries-committee/issues/293)) + * `Data.List.NonEmpty` functions now have the same laziness as their `Data.List` counterparts (i.e. make them more strict than they currently are) ([CLC proposal #107](https://github.com/haskell/core-libraries-committee/issues/107)) + * `instance Functor NonEmpty` is now specified using `map` (rather than duplicating code). ([CLC proposal #300](https://github.com/haskell/core-libraries-committee/issues/300)) + * `fail` from `MonadFail` now carries `HasCallStack` constraint. ([CLC proposal #327](https://github.com/haskell/core-libraries-committee/issues/327)) + * The `Data.Enum.enumerate` function was introduced ([CLC #306](https://github.com/haskell/core-libraries-committee/issues/306)) + * Worker threads used by various `base` facilities are now labelled with descriptive thread labels ([CLC proposal #305](https://github.com/haskell/core-libraries-committee/issues/305), [GHC #25452](https://gitlab.haskell.org/ghc/ghc/-/issues/25452)). Specifically, these include: + * `Control.Concurrent.threadWaitRead` + * `Control.Concurrent.threadWaitWrite` + * `Control.Concurrent.threadWaitReadSTM` + * `Control.Concurrent.threadWaitWriteSTM` + * `System.Timeout.timeout` + * `GHC.Conc.Signal.runHandlers` + * The following internal modules have been removed from `base`, as per [CLC #217](https://github.com/haskell/core-libraries-committee/issues/217): + * `GHC.TypeLits.Internal` + * `GHC.TypeNats.Internal` + * `GHC.ExecutionStack.Internal`. + * Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)). - * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350)) + * Fix the rewrite rule for `scanl'` not being strict in the first element of the output list ([#26143](https://gitlab.haskell.org/ghc/ghc/-/issues/26143)). + * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213)) + * Remove deprecated, unstable heap representation details from `GHC.Exts` ([CLC proposal #212](https://github.com/haskell/core-libraries-committee/issues/212)) ## 4.21.0.0 *December 2024* * Shipped with GHC 9.12.1 @@ -45,8 +66,6 @@ for libraries that define exception-handling combinators like `catch` and `onException`, such as `base`, or the `exceptions` package. * Move `Lift ByteArray` and `Lift Fixed` instances into `base` from `template-haskell`. See [CLC proposal #287](https://github.com/haskell/core-libraries-committee/issues/287). - * Modify the implementation of `Control.Exception.throw` to avoid call-sites being inferred as diverging via precise exception. - ([GHC #25066](https://gitlab.haskell.org/ghc/ghc/-/issues/25066), [CLC proposal #290](https://github.com/haskell/core-libraries-committee/issues/290)) * Make `Debug.Trace.{traceEventIO,traceMarkerIO}` faster when tracing is disabled. See [CLC proposal #291](https://github.com/haskell/core-libraries-committee/issues/291). * The exception messages were improved according to [CLC proposal #285](https://github.com/haskell/core-libraries-committee/issues/285). In particular: * Improve the message of the uncaught exception handler @@ -297,29 +316,29 @@ * Re-export the `IsList` typeclass from the new `GHC.IsList` module. - * There's a new special function ``withDict`` in ``GHC.Exts``: :: + * There's a new special function `withDict` in `GHC.Exts`: :: withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r - where ``cls`` must be a class containing exactly one method, whose type - must be ``meth``. + where `cls` must be a class containing exactly one method, whose type + must be `meth`. - This function converts ``meth`` to a type class dictionary. - It removes the need for ``unsafeCoerce`` in implementation of reflection + This function converts `meth` to a type class dictionary. + It removes the need for `unsafeCoerce` in implementation of reflection libraries. It should be used with care, because it can introduce incoherent instances. - For example, the ``withTypeable`` function from the - ``Type.Reflection`` module can now be defined as: :: + For example, the `withTypeable` function from the + `Type.Reflection` module can now be defined as: :: withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () => TypeRep a -> (Typeable a => r) -> r withTypeable rep k = withDict @(Typeable a) rep k Note that the explicit type application is required, as the call to - ``withDict`` would be ambiguous otherwise. + `withDict` would be ambiguous otherwise. - This replaces the old ``GHC.Exts.magicDict``, which required + This replaces the old `GHC.Exts.magicDict`, which required an intermediate data type and was less reliable. * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by @@ -337,17 +356,17 @@ * Shipped with GHC 9.2.4 - * winio: make consoleReadNonBlocking not wait for any events at all. + * winio: make `consoleReadNonBlocking` not wait for any events at all. - * winio: Add support to console handles to handleToHANDLE + * winio: Add support to console handles to `handleToHANDLE` ## 4.16.2.0 *May 2022* * Shipped with GHC 9.2.2 - * Export GHC.Event.Internal on Windows (#21245) + * Export `GHC.Event.Internal` on Windows (#21245) - # Documentation Fixes + * Documentation Fixes ## 4.16.1.0 *Feb 2022* @@ -416,7 +435,7 @@ - Newtypes `And`, `Ior`, `Xor` and `Iff` which wrap their argument, and whose `Semigroup` instances are defined using `(.&.)`, `(.|.)`, `xor` - and ```\x y -> complement (x `xor` y)```, respectively. + and `\x y -> complement (x `xor` y)`, respectively. - `oneBits :: FiniteBits a => a`, `oneBits = complement zeroBits`. diff --git a/src/Control/Concurrent.hs b/src/Control/Concurrent.hs --- a/src/Control/Concurrent.hs +++ b/src/Control/Concurrent.hs @@ -265,7 +265,7 @@ -- fdReady does the right thing, but we have to call it in a -- separate thread, otherwise threadWaitRead won't be interruptible, -- and this only works with -threaded. - | threaded = withThread (waitFd fd False) + | threaded = withThread "threadWaitRead worker" (waitFd fd False) | otherwise = case fd of 0 -> do _ <- hWaitForInput stdin (-1) return () @@ -286,7 +286,7 @@ threadWaitWrite :: Fd -> IO () threadWaitWrite fd #if defined(mingw32_HOST_OS) - | threaded = withThread (waitFd fd True) + | threaded = withThread "threadWaitWrite worker" (waitFd fd True) | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows" #else = Conc.threadWaitWrite fd @@ -302,8 +302,11 @@ threadWaitReadSTM fd #if defined(mingw32_HOST_OS) | threaded = do v <- newTVarIO Nothing - mask_ $ void $ forkIO $ do result <- try (waitFd fd False) - atomically (writeTVar v $ Just result) + mask_ $ void $ forkIO $ do + tid <- myThreadId + labelThread tid "threadWaitReadSTM worker" + result <- try (waitFd fd False) + atomically (writeTVar v $ Just result) let waitAction = do result <- readTVar v case result of Nothing -> retry @@ -326,8 +329,11 @@ threadWaitWriteSTM fd #if defined(mingw32_HOST_OS) | threaded = do v <- newTVarIO Nothing - mask_ $ void $ forkIO $ do result <- try (waitFd fd True) - atomically (writeTVar v $ Just result) + mask_ $ void $ forkIO $ do + tid <- myThreadId + labelThread tid "threadWaitWriteSTM worker" + result <- try (waitFd fd True) + atomically (writeTVar v $ Just result) let waitAction = do result <- readTVar v case result of Nothing -> retry @@ -343,10 +349,14 @@ #if defined(mingw32_HOST_OS) foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool -withThread :: IO a -> IO a -withThread io = do +withThread :: String -> IO a -> IO a +withThread label io = do m <- newEmptyMVar - _ <- mask_ $ forkIO $ try io >>= putMVar m + _ <- mask_ $ forkIO $ do + tid <- myThreadId + labelThread tid label + result <- try io + putMVar m result x <- takeMVar m case x of Right a -> return a diff --git a/src/Control/Exception.hs b/src/Control/Exception.hs --- a/src/Control/Exception.hs +++ b/src/Control/Exception.hs @@ -116,7 +116,9 @@ bracket_, bracketOnError, finally, - onException + onException, + -- ** Printing + displayExceptionWithInfo ) where diff --git a/src/Control/Exception/Backtrace.hs b/src/Control/Exception/Backtrace.hs --- a/src/Control/Exception/Backtrace.hs +++ b/src/Control/Exception/Backtrace.hs @@ -51,7 +51,7 @@ , getBacktraceMechanismState , setBacktraceMechanismState -- * Collecting backtraces - , Backtraces(..) + , Backtraces , displayBacktraces , collectBacktraces ) where diff --git a/src/Control/Monad/Fix.hs b/src/Control/Monad/Fix.hs --- a/src/Control/Monad/Fix.hs +++ b/src/Control/Monad/Fix.hs @@ -10,11 +10,108 @@ -- Stability : stable -- Portability : portable -- --- Monadic fixpoints. +-- Monadic fixpoints, used for desugaring of @{-# LANGUAGE RecursiveDo #-}@. -- --- For a detailed discussion, see Levent Erkok's thesis, --- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002. +-- Consider the generalized version of so-called @repmin@ +-- (/replace with minimum/) problem: +-- accumulate elements of a container into a 'Monoid' +-- and modify each element using the final accumulator. -- +-- @ +-- repmin +-- :: (Functor t, Foldable t, Monoid b) +-- => (a -> b) -> (a -> b -> c) -> t a -> t c +-- repmin f g as = fmap (\`g\` foldMap f as) as +-- @ +-- +-- The naive implementation as above makes two traversals. Can we do better +-- and achieve the goal in a single pass? It's seemingly impossible, because we would +-- have to know the future, +-- but lazy evaluation comes to the rescue: +-- +-- @ +-- import Data.Traversable (mapAccumR) +-- +-- repmin +-- :: (Traversable t, Monoid b) +-- => (a -> b) -> (a -> b -> c) -> t a -> t c +-- repmin f g as = +-- let (b, cs) = mapAccumR (\\acc a -> (f a <> acc, g a b)) mempty as in cs +-- @ +-- +-- How can we check that @repmin@ indeed traverses only once? +-- Let's run it on an infinite input: +-- +-- >>> import Data.Monoid (All(..)) +-- >>> take 3 $ repmin All (const id) ([True, True, False] ++ undefined) +-- [All {getAll = False},All {getAll = False},All {getAll = False}] +-- +-- So far so good, but can we generalise @g@ to return a monadic value @a -> b -> m c@? +-- The following does not work, complaining that @b@ is not in scope: +-- +-- @ +-- import Data.Traversable (mapAccumM) +-- +-- repminM +-- :: (Traversable t, Monoid b, Monad m) +-- => (a -> b) -> (a -> b -> m c) -> t a -> m (t c) +-- repminM f g as = do +-- (b, cs) \<- mapAccumM (\\acc a -> (f a <> acc,) \<$\> g a b) mempty as +-- pure cs +-- @ +-- +-- To solve the riddle, let's rewrite @repmin@ via 'fix': +-- +-- @ +-- repmin +-- :: (Traversable t, Monoid b) +-- => (a -> b) -> (a -> b -> c) -> t a -> t c +-- repmin f g as = snd $ fix $ +-- \\(b, cs) -> mapAccumR (\\acc a -> (f a <> acc, g a b)) mempty as +-- @ +-- +-- Now we can replace 'fix' with 'mfix' to obtain the solution: +-- +-- @ +-- repminM +-- :: (Traversable t, Monoid b, MonadFix m) +-- => (a -> b) -> (a -> b -> m c) -> t a -> m (t c) +-- repminM f g as = fmap snd $ mfix $ +-- \\(~(b, cs)) -> mapAccumM (\\acc a -> (f a <> acc,) \<$\> g a b) mempty as +-- @ +-- +-- For example, +-- +-- >>> import Data.Monoid (Sum(..)) +-- >>> repminM Sum (\a b -> print a >> pure (a + getSum b)) [3, 5, 2] +-- 3 +-- 5 +-- 2 +-- [13,15,12] +-- +-- Incredibly, GHC is capable to do this transformation automatically, +-- when @{-# LANGUAGE RecursiveDo #-}@ is enabled. Namely, the following +-- implementation of @repminM@ works (note @mdo@ instead of @do@): +-- +-- @ +-- {-# LANGUAGE RecursiveDo #-} +-- +-- repminM +-- :: (Traversable t, Monoid b, MonadFix m) +-- => (a -> b) -> (a -> b -> m c) -> t a -> m (t c) +-- repminM f g as = mdo +-- (b, cs) \<- mapAccumM (\\acc a -> (f a <> acc,) \<$\> g a b) mempty as +-- pure cs +-- @ +-- +-- Further reading: +-- +-- * GHC User’s Guide, The recursive do-notation. +-- * Haskell Wiki, . +-- * Levent Erkök, , Oregon Graduate Institute, 2002. +-- * Levent Erkök, John Launchbury, , Haskell '02, 29-37, 2002. +-- * Richard S. Bird, , Acta Informatica 21, 239-250, 1984. +-- * Jasper Van der Jeugt, , 2023. module Control.Monad.Fix (MonadFix(mfix), diff --git a/src/Data/Bounded.hs b/src/Data/Bounded.hs --- a/src/Data/Bounded.hs +++ b/src/Data/Bounded.hs @@ -13,7 +13,7 @@ -- -- The 'Bounded' class. -- --- @since 4.22.0.0 +-- @since 4.21.0.0 -- ----------------------------------------------------------------------------- diff --git a/src/Data/Enum.hs b/src/Data/Enum.hs --- a/src/Data/Enum.hs +++ b/src/Data/Enum.hs @@ -21,6 +21,34 @@ ( Enum(..) , {-# DEPRECATED "Bounded should be imported from Data.Bounded" #-} Bounded(..) + , enumerate ) where import GHC.Internal.Enum + +-- | Returns a list of all values of an enum type +-- +-- 'enumerate' is often used to list all values of a custom enum data structure, such as a custom Color enum below: +-- +-- @ +-- data Color = Yellow | Red | Blue +-- deriving (Enum, Bounded, Show) +-- +-- allColors :: [Color] +-- allColors = enumerate +-- -- Result: [Yellow, Red, Blue] +-- @ +-- +-- Note that you need to derive the 'Bounded' type class as well, only 'Enum' is not enough. +-- 'Enum' allows for sequential enumeration, while 'Bounded' provides the 'minBound' and 'maxBound' values. +-- +-- 'enumerate' is commonly used together with the TypeApplications syntax. Here is an example of using 'enumerate' to retrieve all values of the 'Ordering' type: +-- +-- >> enumerate @Ordering +-- [LT, EQ, GT] +-- +-- The '@' symbol here is provided by the TypeApplications language extension. +-- +-- @since base-4.22.0.0 +enumerate :: (Enum a, Bounded a) => [a] +enumerate = [minBound .. maxBound] diff --git a/src/Data/List/NonEmpty.hs b/src/Data/List/NonEmpty.hs --- a/src/Data/List/NonEmpty.hs +++ b/src/Data/List/NonEmpty.hs @@ -20,6 +20,13 @@ -- @since 4.9.0.0 ---------------------------------------------------------------------------- +-- Function implementations in this module adhere to the following principle: +-- +-- For every NonEmpty function that is different from a corresponding +-- List function only in the presence of NonEmpty in its type, both +-- the List and NonEmpty functions should have the same strictness +-- properties. Same applies to the class instances. + module Data.List.NonEmpty ( -- * The type of non-empty streams NonEmpty(..) @@ -116,7 +123,7 @@ import GHC.Internal.Data.Function (on) import GHC.Internal.Data.Ord (comparing) import GHC.Internal.Stack.Types (HasCallStack) -import GHC.Internal.Data.List.NonEmpty +import GHC.Internal.Data.List.NonEmpty (NonEmpty (..), map, zip, zipWith) infixr 5 <| @@ -185,7 +192,7 @@ -- | 'uncons' produces the first element of the stream, and a stream of the -- remaining elements, if any. uncons :: NonEmpty a -> (a, Maybe (NonEmpty a)) -uncons ~(a :| as) = (a, nonEmpty as) +uncons (a :| as) = (a, nonEmpty as) -- | The 'unfoldr' function is analogous to "Data.List"'s -- 'GHC.Internal.Data.List.unfoldr' operation. @@ -206,11 +213,13 @@ -- | Extract the last element of the stream. last :: NonEmpty a -> a -last ~(a :| as) = List.last (a : as) +last (a :| []) = a +last (_ :| (a : as)) = last (a :| as) -- | Extract everything except the last element of the stream. init :: NonEmpty a -> [a] -init ~(a :| as) = List.init (a : as) +init (_ :| []) = [] +init (a1 :| (a2 : as)) = a1 : init (a2 :| as) -- | Construct a 'NonEmpty' list from a single element. -- @@ -220,7 +229,7 @@ -- | Prepend an element to the stream. (<|) :: a -> NonEmpty a -> NonEmpty a -a <| ~(b :| bs) = a :| b : bs +a <| bs = a :| toList bs -- | Synonym for '<|'. cons :: a -> NonEmpty a -> NonEmpty a @@ -272,7 +281,7 @@ -- | Convert a stream to a normal list efficiently. toList :: NonEmpty a -> [a] -toList ~(a :| as) = a : as +toList (a :| as) = a : as -- | Lift list operations to work on a 'NonEmpty' stream. -- @@ -281,10 +290,6 @@ lift :: Foldable f => ([a] -> [b]) -> f a -> NonEmpty b lift f = fromList . f . Foldable.toList --- | Map a function over a 'NonEmpty' stream. -map :: (a -> b) -> NonEmpty a -> NonEmpty b -map f ~(a :| as) = f a :| fmap f as - -- | The 'inits' function takes a stream @xs@ and returns all the -- finite prefixes of @xs@, starting with the shortest. The result is -- 'NonEmpty' because the result always contains the empty list as the first @@ -324,7 +329,7 @@ -- -- @since 4.18 tails1 :: NonEmpty a -> NonEmpty (NonEmpty a) -tails1 = fromList . List.tails1 . Foldable.toList +tails1 xs = xs :| List.tails1 (tail xs) -- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it -- is still less than or equal to the next element. In particular, if the @@ -358,17 +363,17 @@ -- -- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...] scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a -scanl1 f ~(a :| as) = fromList (List.scanl f a as) +scanl1 f (a :| as) = fromList (List.scanl f a as) -- | 'scanr1' is a variant of 'scanr' that has no starting value argument. scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a -scanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as)) +scanr1 f (a :| as) = fromList (List.scanr1 f (a:as)) -- | 'intersperse x xs' alternates elements of the list with copies of @x@. -- -- > intersperse 0 (1 :| [2,3]) == 1 :| [0,2,0,3] intersperse :: a -> NonEmpty a -> NonEmpty a -intersperse a ~(b :| bs) = b :| case bs of +intersperse a (b :| bs) = b :| case bs of [] -> [] _ -> a : List.intersperse a bs @@ -531,17 +536,17 @@ -- -- /Beware/: a negative or out-of-bounds index will cause an error. (!!) :: HasCallStack => NonEmpty a -> Int -> a -(!!) ~(x :| xs) n +(!!) (x :| xs) n | n == 0 = x | n > 0 = xs List.!! (n - 1) | otherwise = error "NonEmpty.!! negative index" infixl 9 !! - -- | The 'unzip' function is the inverse of the 'zip' function. -unzip :: Functor f => f (a,b) -> (f a, f b) -unzip xs = (fst <$> xs, snd <$> xs) -{-# WARNING in "x-data-list-nonempty-unzip" unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} +unzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b) +unzip ((a, b) :| asbs) = (a :| as, b :| bs) + where + (as, bs) = List.unzip asbs -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. diff --git a/src/Data/Semigroup.hs b/src/Data/Semigroup.hs --- a/src/Data/Semigroup.hs +++ b/src/Data/Semigroup.hs @@ -105,7 +105,7 @@ , ArgMax ) where -import GHC.Internal.Base hiding (Any) +import GHC.Internal.Base hiding (Any, NonEmpty(..)) import GHC.Internal.Enum import GHC.Internal.Show import GHC.Internal.Read @@ -116,6 +116,7 @@ import Data.Bifunctor import Data.Bitraversable import GHC.Internal.Data.Foldable +import GHC.Internal.Data.NonEmpty (NonEmpty(..)) import GHC.Internal.Data.Traversable import GHC.Internal.Data.Semigroup.Internal import GHC.Internal.Control.Monad.Fix diff --git a/src/GHC/Base.hs b/src/GHC/Base.hs --- a/src/GHC/Base.hs +++ b/src/GHC/Base.hs @@ -138,7 +138,8 @@ , divModInt#, divModInt8#, divModInt16#, divModInt32# ) where -import GHC.Internal.Base +import GHC.Internal.Base hiding ( NonEmpty(..) ) +import GHC.Internal.Data.NonEmpty ( NonEmpty(..) ) import GHC.Prim hiding ( -- Hide dataToTag# ops because they are expected to break for diff --git a/src/GHC/ExecutionStack/Internal.hs b/src/GHC/ExecutionStack/Internal.hs deleted file mode 100644 --- a/src/GHC/ExecutionStack/Internal.hs +++ /dev/null @@ -1,31 +0,0 @@ --- | --- Module : GHC.Internal.ExecutionStack.Internal --- Copyright : (c) The University of Glasgow 2013-2015 --- License : see libraries/base/LICENSE --- --- Maintainer : ghc-devs@haskell.org --- Stability : internal --- Portability : non-portable (GHC Extensions) --- --- Internals of the "GHC.ExecutionStack" module. --- --- /The API of this module is unstable and not meant to be consumed by the general public./ --- If you absolutely must depend on it, make sure to use a tight upper --- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can --- change rapidly without much warning. --- --- @since 4.9.0.0 - -module GHC.ExecutionStack.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-} ( - -- * Internal - Location (..) - , SrcLoc (..) - , StackTrace - , stackFrames - , stackDepth - , collectStackTrace - , showStackFrames - , invalidateDebugCache - ) where - -import GHC.Internal.ExecutionStack.Internal diff --git a/src/GHC/Exts.hs b/src/GHC/Exts.hs --- a/src/GHC/Exts.hs +++ b/src/GHC/Exts.hs @@ -26,12 +26,6 @@ -- ** Legacy interface for arrays of arrays module GHC.Internal.ArrayArray, -- * Primitive operations - {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} - Prim.BCO, - {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} - Prim.mkApUpd0#, - {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} - Prim.newBCO#, module GHC.Prim, module GHC.Prim.Ext, -- ** Running 'RealWorld' state thread @@ -55,7 +49,6 @@ sameMVar#, sameMutVar#, sameTVar#, - sameIOPort#, samePromptTag#, -- ** Compat wrapper atomicModifyMutVar#, @@ -131,9 +124,6 @@ , whereFrom# , isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned# - -- deprecated - , BCO, mkApUpd0#, newBCO# - -- Don't re-export vector FMA instructions , fmaddFloatX4# , fmsubFloatX4# @@ -256,8 +246,6 @@ , minWord8X32# , minWord8X64# ) -import qualified GHC.Prim as Prim - ( BCO, mkApUpd0#, newBCO# ) import GHC.Prim.Ext diff --git a/src/GHC/IOPort.hs b/src/GHC/IOPort.hs deleted file mode 100644 --- a/src/GHC/IOPort.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | --- --- Module : GHC.IOPort --- Copyright : (c) Tamar Christina 2019 --- License : see libraries/base/LICENSE --- --- Maintainer : ghc-devs@haskell.org --- Stability : internal --- Portability : non-portable (GHC Extensions) --- --- The 'IOPort' type. This is a facility used by the Windows IO subsystem. --- --- /The API of this module is unstable and not meant to be consumed by the general public./ --- If you absolutely must depend on it, make sure to use a tight upper --- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can --- change rapidly without much warning. --- --- We have strict rules with an I/O Port: --- * writing more than once is an error --- * reading more than once is an error --- --- It gives us the ability to have one thread to block, wait for a result from --- another thread and then being woken up. *Nothing* more. --- --- This type is very much GHC internal. It might be changed or removed without --- notice in future releases. --- - -module GHC.IOPort - (-- * IOPorts - IOPort(..), - newIOPort, - newEmptyIOPort, - readIOPort, - writeIOPort, - doubleReadException - ) where - -import GHC.Internal.IOPort diff --git a/src/GHC/JS/Prim/Internal/Build.hs b/src/GHC/JS/Prim/Internal/Build.hs --- a/src/GHC/JS/Prim/Internal/Build.hs +++ b/src/GHC/JS/Prim/Internal/Build.hs @@ -1,12 +1,12 @@ {-# LANGUAGE CPP #-} +module GHC.JS.Prim.Internal.Build + {-# DEPRECATED "Use ghc-internal:GHC.Internal.JS.Prim.Internal.Build instead" #-} + -- deprecated for now. To be fully removed in GHC 9.16 + -- see https://github.com/haskell/core-libraries-committee/issues/329 and #23432 #if !defined(javascript_HOST_ARCH) - -module GHC.JS.Prim.Internal.Build () where - + () where #else - -module GHC.JS.Prim.Internal.Build ( buildArrayI , buildArrayM , buildObjectI diff --git a/src/GHC/Num/BigNat.hs b/src/GHC/Num/BigNat.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/BigNat.hs @@ -0,0 +1,6 @@ +module GHC.Num.BigNat + ( module GHC.Internal.Bignum.BigNat + ) +where + +import GHC.Internal.Bignum.BigNat diff --git a/src/GHC/Num/Integer.hs b/src/GHC/Num/Integer.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Integer.hs @@ -0,0 +1,6 @@ +module GHC.Num.Integer + ( module GHC.Internal.Bignum.Integer + ) +where + +import GHC.Internal.Bignum.Integer diff --git a/src/GHC/Num/Natural.hs b/src/GHC/Num/Natural.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Natural.hs @@ -0,0 +1,6 @@ +module GHC.Num.Natural + ( module GHC.Internal.Bignum.Natural + ) +where + +import GHC.Internal.Bignum.Natural diff --git a/src/GHC/RTS/Flags.hs b/src/GHC/RTS/Flags.hs --- a/src/GHC/RTS/Flags.hs +++ b/src/GHC/RTS/Flags.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveGeneric #-} + -- | -- Module : GHC.RTS.Flags -- Copyright : (c) The University of Glasgow, 1994-2000 @@ -17,6 +20,7 @@ -- -- @since 4.8.0.0 -- +-- This module is a compatibility layer. It is meant to be temporary to allow for the eventual deprecation of these declarations as described in [CLC proposal #289](https://github.com/haskell/core-libraries-committee/issues/289). These declarations are now instead available from the @ghc-experimental@ package. module GHC.RTS.Flags ( RtsTime @@ -51,5 +55,420 @@ , getHpcFlags ) where -import GHC.Internal.RTS.Flags +import Prelude (Show,IO,Bool,Maybe,String,Int,Enum,FilePath,Double,Eq,(<$>)) + +import GHC.Generics (Generic) +import qualified GHC.Internal.RTS.Flags as Internal import GHC.Internal.IO.SubSystem (IoSubSystem(..)) + +import Data.Word (Word32,Word64,Word) + +-- | 'RtsTime' is defined as a @StgWord64@ in @stg/Types.h@ +-- +-- @since base-4.8.2.0 +type RtsTime = Word64 + +-- | Should we produce a summary of the garbage collector statistics after the +-- program has exited? +-- +-- @since base-4.8.2.0 +data GiveGCStats + = NoGCStats + | CollectGCStats + | OneLineGCStats + | SummaryGCStats + | VerboseGCStats + deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters of the garbage collector. +-- +-- @since base-4.8.0.0 +data GCFlags = GCFlags + { statsFile :: Maybe FilePath + , giveStats :: GiveGCStats + , maxStkSize :: Word32 + , initialStkSize :: Word32 + , stkChunkSize :: Word32 + , stkChunkBufferSize :: Word32 + , maxHeapSize :: Word32 + , minAllocAreaSize :: Word32 + , largeAllocLim :: Word32 + , nurseryChunkSize :: Word32 + , minOldGenSize :: Word32 + , heapSizeSuggestion :: Word32 + , heapSizeSuggestionAuto :: Bool + , oldGenFactor :: Double + , returnDecayFactor :: Double + , pcFreeHeap :: Double + , generations :: Word32 + , squeezeUpdFrames :: Bool + , compact :: Bool -- ^ True <=> "compact all the time" + , compactThreshold :: Double + , sweep :: Bool + -- ^ use "mostly mark-sweep" instead of copying for the oldest generation + , ringBell :: Bool + , idleGCDelayTime :: RtsTime + , doIdleGC :: Bool + , heapBase :: Word -- ^ address to ask the OS for memory + , allocLimitGrace :: Word + , numa :: Bool + , numaMask :: Word + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters concerning context switching +-- +-- @since base-4.8.0.0 +data ConcFlags = ConcFlags + { ctxtSwitchTime :: RtsTime + , ctxtSwitchTicks :: Int + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Miscellaneous parameters +-- +-- @since base-4.8.0.0 +data MiscFlags = MiscFlags + { tickInterval :: RtsTime + , installSignalHandlers :: Bool + , installSEHHandlers :: Bool + , generateCrashDumpFile :: Bool + , generateStackTrace :: Bool + , machineReadable :: Bool + , disableDelayedOsMemoryReturn :: Bool + , internalCounters :: Bool + , linkerAlwaysPic :: Bool + , linkerMemBase :: Word + -- ^ address to ask the OS for memory for the linker, 0 ==> off + , ioManager :: IoManagerFlag + , numIoWorkerThreads :: Word32 + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | +-- +-- @since base-4.21.0.0 +data IoManagerFlag = + IoManagerFlagAuto + | IoManagerFlagSelect -- ^ Unix only, non-threaded RTS only + | IoManagerFlagMIO -- ^ cross-platform, threaded RTS only + | IoManagerFlagWinIO -- ^ Windows only + | IoManagerFlagWin32Legacy -- ^ Windows only, non-threaded RTS only + deriving (Eq, Enum, Show) + +-- | Flags to control debugging output & extra checking in various +-- subsystems. +-- +-- @since base-4.8.0.0 +data DebugFlags = DebugFlags + { scheduler :: Bool -- ^ @s@ + , interpreter :: Bool -- ^ @i@ + , weak :: Bool -- ^ @w@ + , gccafs :: Bool -- ^ @G@ + , gc :: Bool -- ^ @g@ + , nonmoving_gc :: Bool -- ^ @n@ + , block_alloc :: Bool -- ^ @b@ + , sanity :: Bool -- ^ @S@ + , stable :: Bool -- ^ @t@ + , prof :: Bool -- ^ @p@ + , linker :: Bool -- ^ @l@ the object linker + , apply :: Bool -- ^ @a@ + , stm :: Bool -- ^ @m@ + , squeeze :: Bool -- ^ @z@ stack squeezing & lazy blackholing + , hpc :: Bool -- ^ @c@ coverage + , sparks :: Bool -- ^ @r@ + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Should the RTS produce a cost-center summary? +-- +-- @since base-4.8.2.0 +data DoCostCentres + = CostCentresNone + | CostCentresSummary + | CostCentresVerbose + | CostCentresAll + | CostCentresJSON + deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters pertaining to the cost-center profiler. +-- +-- @since base-4.8.0.0 +data CCFlags = CCFlags + { doCostCentres :: DoCostCentres + , profilerTicks :: Int + , msecsPerTick :: Int + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | What sort of heap profile are we collecting? +-- +-- @since base-4.8.2.0 +data DoHeapProfile + = NoHeapProfiling + | HeapByCCS + | HeapByMod + | HeapByDescr + | HeapByType + | HeapByRetainer + | HeapByLDV + | HeapByClosureType + | HeapByInfoTable + | HeapByEra -- ^ @since base-4.20.0.0 + deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters of the cost-center profiler +-- +-- @since base-4.8.0.0 +data ProfFlags = ProfFlags + { doHeapProfile :: DoHeapProfile + , heapProfileInterval :: RtsTime -- ^ time between samples + , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) + , startHeapProfileAtStartup :: Bool + , startTimeProfileAtStartup :: Bool -- ^ @since base-4.20.0.0 + , showCCSOnException :: Bool + , automaticEraIncrement :: Bool -- ^ @since 4.20.0.0 + , maxRetainerSetSize :: Word + , ccsLength :: Word + , modSelector :: Maybe String + , descrSelector :: Maybe String + , typeSelector :: Maybe String + , ccSelector :: Maybe String + , ccsSelector :: Maybe String + , retainerSelector :: Maybe String + , bioSelector :: Maybe String + , eraSelector :: Word -- ^ @since base-4.20.0.0 + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Is event tracing enabled? +-- +-- @since base-4.8.2.0 +data DoTrace + = TraceNone -- ^ no tracing + | TraceEventLog -- ^ send tracing events to the event log + | TraceStderr -- ^ send tracing events to @stderr@ + deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters pertaining to event tracing +-- +-- @since base-4.8.0.0 +data TraceFlags = TraceFlags + { tracing :: DoTrace + , timestamp :: Bool -- ^ show timestamp in stderr output + , traceScheduler :: Bool -- ^ trace scheduler events + , traceGc :: Bool -- ^ trace GC events + , traceNonmovingGc + :: Bool -- ^ trace nonmoving GC heap census samples + , sparksSampled :: Bool -- ^ trace spark events by a sampled method + , sparksFull :: Bool -- ^ trace spark events 100% accurately + , user :: Bool -- ^ trace user events (emitted from Haskell code) + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters pertaining to ticky-ticky profiler +-- +-- @since base-4.8.0.0 +data TickyFlags = TickyFlags + { showTickyStats :: Bool + , tickyFile :: Maybe FilePath + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters pertaining to parallelism +-- +-- @since base-4.8.0.0 +data ParFlags = ParFlags + { nCapabilities :: Word32 + , migrate :: Bool + , maxLocalSparks :: Word32 + , parGcEnabled :: Bool + , parGcGen :: Word32 + , parGcLoadBalancingEnabled :: Bool + , parGcLoadBalancingGen :: Word32 + , parGcNoSyncWithIdle :: Word32 + , parGcThreads :: Word32 + , setAffinity :: Bool + } + deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- | Parameters pertaining to Haskell program coverage (HPC) +-- +-- @since base-4.20.0.0 +data HpcFlags = HpcFlags + { readTixFile :: Bool + -- ^ Controls whether a @.tix@ file is read at + -- the start of execution to initialize the RTS internal + -- HPC datastructures. + , writeTixFile :: Bool + -- ^ Controls whether the @.tix@ file should be + -- written after the execution of the program. + } + deriving (Show -- ^ @since base-4.20.0.0 + , Generic -- ^ @since base-4.20.0.0 + ) +-- | Parameters of the runtime system +-- +-- @since base-4.8.0.0 +data RTSFlags = RTSFlags + { gcFlags :: GCFlags + , concurrentFlags :: ConcFlags + , miscFlags :: MiscFlags + , debugFlags :: DebugFlags + , costCentreFlags :: CCFlags + , profilingFlags :: ProfFlags + , traceFlags :: TraceFlags + , tickyFlags :: TickyFlags + , parFlags :: ParFlags + , hpcFlags :: HpcFlags + } deriving ( Show -- ^ @since base-4.8.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-------------------------------- compat ---------------------------------------- + +internal_to_base_RTSFlags :: Internal.RTSFlags -> RTSFlags +internal_to_base_RTSFlags Internal.RTSFlags{..} = + RTSFlags{ gcFlags = internal_to_base_GCFlags gcFlags + , concurrentFlags = internal_to_base_ConcFlags concurrentFlags + , miscFlags = internal_to_base_MiscFlags miscFlags + , debugFlags = internal_to_base_DebugFlags debugFlags + , costCentreFlags = internal_to_base_CCFlags costCentreFlags + , profilingFlags = internal_to_base_ProfFlags profilingFlags + , traceFlags = internal_to_base_TraceFlags traceFlags + , tickyFlags = internal_to_base_TickyFlags tickyFlags + , parFlags = internal_to_base_ParFlags parFlags + , hpcFlags = internal_to_base_HpcFlags hpcFlags + } + +internal_to_base_GCFlags :: Internal.GCFlags -> GCFlags +internal_to_base_GCFlags i@Internal.GCFlags{..} = + let give_stats = internal_to_base_giveStats (Internal.giveStats i) + in GCFlags{ giveStats = give_stats, .. } + where + internal_to_base_giveStats :: Internal.GiveGCStats -> GiveGCStats + internal_to_base_giveStats Internal.NoGCStats = NoGCStats + internal_to_base_giveStats Internal.CollectGCStats = CollectGCStats + internal_to_base_giveStats Internal.OneLineGCStats = OneLineGCStats + internal_to_base_giveStats Internal.SummaryGCStats = SummaryGCStats + internal_to_base_giveStats Internal.VerboseGCStats = VerboseGCStats + +internal_to_base_ParFlags :: Internal.ParFlags -> ParFlags +internal_to_base_ParFlags Internal.ParFlags{..} = ParFlags{..} + +internal_to_base_HpcFlags :: Internal.HpcFlags -> HpcFlags +internal_to_base_HpcFlags Internal.HpcFlags{..} = HpcFlags{..} + +internal_to_base_ConcFlags :: Internal.ConcFlags -> ConcFlags +internal_to_base_ConcFlags Internal.ConcFlags{..} = ConcFlags{..} + +internal_to_base_MiscFlags :: Internal.MiscFlags -> MiscFlags +internal_to_base_MiscFlags i@Internal.MiscFlags{..} = + let io_manager = internal_to_base_ioManager (Internal.ioManager i) + in MiscFlags{ ioManager = io_manager, ..} + where + internal_to_base_ioManager :: Internal.IoManagerFlag -> IoManagerFlag + internal_to_base_ioManager Internal.IoManagerFlagAuto = IoManagerFlagAuto + internal_to_base_ioManager Internal.IoManagerFlagSelect = IoManagerFlagSelect + internal_to_base_ioManager Internal.IoManagerFlagMIO = IoManagerFlagMIO + internal_to_base_ioManager Internal.IoManagerFlagWinIO = IoManagerFlagWinIO + internal_to_base_ioManager Internal.IoManagerFlagWin32Legacy = IoManagerFlagWin32Legacy + +internal_to_base_DebugFlags :: Internal.DebugFlags -> DebugFlags +internal_to_base_DebugFlags Internal.DebugFlags{..} = DebugFlags{..} + +internal_to_base_CCFlags :: Internal.CCFlags -> CCFlags +internal_to_base_CCFlags i@Internal.CCFlags{..} = + let do_cost_centres = internal_to_base_costCentres (Internal.doCostCentres i) + in CCFlags{ doCostCentres = do_cost_centres, ..} + where + internal_to_base_costCentres :: Internal.DoCostCentres -> DoCostCentres + internal_to_base_costCentres Internal.CostCentresNone = CostCentresNone + internal_to_base_costCentres Internal.CostCentresSummary = CostCentresSummary + internal_to_base_costCentres Internal.CostCentresVerbose = CostCentresVerbose + internal_to_base_costCentres Internal.CostCentresAll = CostCentresAll + internal_to_base_costCentres Internal.CostCentresJSON = CostCentresJSON + +internal_to_base_ProfFlags :: Internal.ProfFlags -> ProfFlags +internal_to_base_ProfFlags i@Internal.ProfFlags{..} = + let do_heap_profile = internal_to_base_doHeapProfile (Internal.doHeapProfile i) + in ProfFlags{ doHeapProfile = do_heap_profile,..} + where + internal_to_base_doHeapProfile :: Internal.DoHeapProfile -> DoHeapProfile + internal_to_base_doHeapProfile Internal.NoHeapProfiling = NoHeapProfiling + internal_to_base_doHeapProfile Internal.HeapByCCS = HeapByCCS + internal_to_base_doHeapProfile Internal.HeapByMod = HeapByMod + internal_to_base_doHeapProfile Internal.HeapByDescr = HeapByDescr + internal_to_base_doHeapProfile Internal.HeapByType = HeapByType + internal_to_base_doHeapProfile Internal.HeapByRetainer = HeapByRetainer + internal_to_base_doHeapProfile Internal.HeapByLDV = HeapByLDV + internal_to_base_doHeapProfile Internal.HeapByClosureType = HeapByClosureType + internal_to_base_doHeapProfile Internal.HeapByInfoTable = HeapByInfoTable + internal_to_base_doHeapProfile Internal.HeapByEra = HeapByEra + +internal_to_base_TraceFlags :: Internal.TraceFlags -> TraceFlags +internal_to_base_TraceFlags i@Internal.TraceFlags{..} = + let do_trace = internal_to_base_doTrace (Internal.tracing i) + in TraceFlags{ tracing = do_trace,..} + where + internal_to_base_doTrace :: Internal.DoTrace -> DoTrace + internal_to_base_doTrace Internal.TraceNone = TraceNone + internal_to_base_doTrace Internal.TraceEventLog = TraceEventLog + internal_to_base_doTrace Internal.TraceStderr = TraceStderr + +internal_to_base_TickyFlags :: Internal.TickyFlags -> TickyFlags +internal_to_base_TickyFlags Internal.TickyFlags{..} = TickyFlags{..} + +-------------------------------- shims ----------------------------------------- + +getRTSFlags :: IO RTSFlags +getRTSFlags = internal_to_base_RTSFlags <$> Internal.getRTSFlags + +getGCFlags :: IO GCFlags +getGCFlags = internal_to_base_GCFlags <$> Internal.getGCFlags + +getParFlags :: IO ParFlags +getParFlags = internal_to_base_ParFlags <$> Internal.getParFlags + +getHpcFlags :: IO HpcFlags +getHpcFlags = internal_to_base_HpcFlags <$> Internal.getHpcFlags + +getConcFlags :: IO ConcFlags +getConcFlags = internal_to_base_ConcFlags <$> Internal.getConcFlags + +{-# INLINEABLE getMiscFlags #-} +getMiscFlags :: IO MiscFlags +getMiscFlags = internal_to_base_MiscFlags <$> Internal.getMiscFlags + +getDebugFlags :: IO DebugFlags +getDebugFlags = internal_to_base_DebugFlags <$> Internal.getDebugFlags + +getCCFlags :: IO CCFlags +getCCFlags = internal_to_base_CCFlags <$> Internal.getCCFlags + +getProfFlags :: IO ProfFlags +getProfFlags = internal_to_base_ProfFlags <$> Internal.getProfFlags + +getTraceFlags :: IO TraceFlags +getTraceFlags = internal_to_base_TraceFlags <$> Internal.getTraceFlags + +getTickyFlags :: IO TickyFlags +getTickyFlags = internal_to_base_TickyFlags <$> Internal.getTickyFlags diff --git a/src/GHC/Records.hs b/src/GHC/Records.hs --- a/src/GHC/Records.hs +++ b/src/GHC/Records.hs @@ -11,10 +11,11 @@ -- Portability : non-portable (GHC extensions) -- -- This module defines the 'HasField' class used by the --- @OverloadedRecordFields@ extension. See the --- for more details. +-- @OverloadedRecordDot@ extension. See the +-- [wiki page](https://gitlab.haskell.org/ghc/ghc/wikis/records/overloaded-record-fields) +-- for more details. -- +-- @since 4.10.0.0 module GHC.Records (HasField(..) diff --git a/src/GHC/Stack/CloneStack.hs b/src/GHC/Stack/CloneStack.hs --- a/src/GHC/Stack/CloneStack.hs +++ b/src/GHC/Stack/CloneStack.hs @@ -17,3 +17,4 @@ ) where import GHC.Internal.Stack.CloneStack +import GHC.Internal.Stack.Decode diff --git a/src/GHC/Stats.hs b/src/GHC/Stats.hs --- a/src/GHC/Stats.hs +++ b/src/GHC/Stats.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE Safe #-} -- | -- Module : RTS.Stats @@ -18,6 +20,12 @@ -- than @base < 5@, because the interface can change rapidly without much warning. -- -- @since 4.5.0.0 +-- +-- This module is a compatibility layer. It is meant to be temporary to allow +-- for the eventual deprecation of these declarations as described in [CLC +-- proposal +-- #289](https://github.com/haskell/core-libraries-committee/issues/289). These +-- declarations are now instead available from the @ghc-experimental@ package. module GHC.Stats ( -- * Runtime statistics @@ -26,5 +34,172 @@ , getRTSStatsEnabled ) where -import GHC.Internal.Stats +import Prelude (Bool,IO,Read,Show,(<$>)) + +import qualified GHC.Internal.Stats as Internal +import GHC.Generics (Generic) +import Data.Word (Word64,Word32) +import Data.Int (Int64) + +-- | Time values from the RTS, using a fixed resolution of nanoseconds. +type RtsTime = Int64 + +-- +-- | Statistics about runtime activity since the start of the +-- program. This is a mirror of the C @struct RTSStats@ in @RtsAPI.h@ +-- +-- @since base-4.10.0.0 +-- +data RTSStats = RTSStats { + -- ----------------------------------- + -- Cumulative stats about memory use + + -- | Total number of GCs + gcs :: Word32 + -- | Total number of major (oldest generation) GCs + , major_gcs :: Word32 + -- | Total bytes allocated + , allocated_bytes :: Word64 + -- | Maximum live data (including large objects + compact regions) in the + -- heap. Updated after a major GC. + , max_live_bytes :: Word64 + -- | Maximum live data in large objects + , max_large_objects_bytes :: Word64 + -- | Maximum live data in compact regions + , max_compact_bytes :: Word64 + -- | Maximum slop + , max_slop_bytes :: Word64 + -- | Maximum memory in use by the RTS + , max_mem_in_use_bytes :: Word64 + -- | Sum of live bytes across all major GCs. Divided by major_gcs + -- gives the average live data over the lifetime of the program. + , cumulative_live_bytes :: Word64 + -- | Sum of copied_bytes across all GCs + , copied_bytes :: Word64 + -- | Sum of copied_bytes across all parallel GCs + , par_copied_bytes :: Word64 + -- | Sum of par_max_copied_bytes across all parallel GCs. Deprecated. + , cumulative_par_max_copied_bytes :: Word64 + -- | Sum of par_balanced_copied bytes across all parallel GCs + , cumulative_par_balanced_copied_bytes :: Word64 + + -- ----------------------------------- + -- Cumulative stats about time use + -- (we use signed values here because due to inaccuracies in timers + -- the values can occasionally go slightly negative) + + -- | Total CPU time used by the init phase + -- @since base-4.12.0.0 + , init_cpu_ns :: RtsTime + -- | Total elapsed time used by the init phase + -- @since base-4.12.0.0 + , init_elapsed_ns :: RtsTime + -- | Total CPU time used by the mutator + , mutator_cpu_ns :: RtsTime + -- | Total elapsed time used by the mutator + , mutator_elapsed_ns :: RtsTime + -- | Total CPU time used by the GC + , gc_cpu_ns :: RtsTime + -- | Total elapsed time used by the GC + , gc_elapsed_ns :: RtsTime + -- | Total CPU time (at the previous GC) + , cpu_ns :: RtsTime + -- | Total elapsed time (at the previous GC) + , elapsed_ns :: RtsTime + + -- | The total CPU time used during the post-mark pause phase of the + -- concurrent nonmoving GC. + , nonmoving_gc_sync_cpu_ns :: RtsTime + -- | The total time elapsed during the post-mark pause phase of the + -- concurrent nonmoving GC. + , nonmoving_gc_sync_elapsed_ns :: RtsTime + -- | The maximum elapsed length of any post-mark pause phase of the + -- concurrent nonmoving GC. + , nonmoving_gc_sync_max_elapsed_ns :: RtsTime + -- | The total CPU time used by the nonmoving GC. + , nonmoving_gc_cpu_ns :: RtsTime + -- | The total time elapsed during which there is a nonmoving GC active. + , nonmoving_gc_elapsed_ns :: RtsTime + -- | The maximum time elapsed during any nonmoving GC cycle. + , nonmoving_gc_max_elapsed_ns :: RtsTime + + -- | Details about the most recent GC + , gc :: GCDetails + } deriving ( Read -- ^ @since base-4.10.0.0 + , Show -- ^ @since base-4.10.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-- +-- | Statistics about a single GC. This is a mirror of the C @struct +-- GCDetails@ in @RtsAPI.h@, with the field prefixed with @gc_@ to +-- avoid collisions with 'RTSStats'. +-- +data GCDetails = GCDetails { + -- | The generation number of this GC + gcdetails_gen :: Word32 + -- | Number of threads used in this GC + , gcdetails_threads :: Word32 + -- | Number of bytes allocated since the previous GC + , gcdetails_allocated_bytes :: Word64 + -- | Total amount of live data in the heap (includes large + compact data). + -- Updated after every GC. Data in uncollected generations (in minor GCs) + -- are considered live. + , gcdetails_live_bytes :: Word64 + -- | Total amount of live data in large objects + , gcdetails_large_objects_bytes :: Word64 + -- | Total amount of live data in compact regions + , gcdetails_compact_bytes :: Word64 + -- | Total amount of slop (wasted memory) + , gcdetails_slop_bytes :: Word64 + -- | Total amount of memory in use by the RTS + , gcdetails_mem_in_use_bytes :: Word64 + -- | Total amount of data copied during this GC + , gcdetails_copied_bytes :: Word64 + -- | In parallel GC, the max amount of data copied by any one thread. + -- Deprecated. + , gcdetails_par_max_copied_bytes :: Word64 + -- | In parallel GC, the amount of balanced data copied by all threads + , gcdetails_par_balanced_copied_bytes :: Word64 + -- | The amount of memory lost due to block fragmentation in bytes. + -- Block fragmentation is the difference between the amount of blocks retained by the RTS and the blocks that are in use. + -- This occurs when megablocks are only sparsely used, eg, when data that cannot be moved retains a megablock. + -- + -- @since base-4.18.0.0 + , gcdetails_block_fragmentation_bytes :: Word64 + -- | The time elapsed during synchronisation before GC + , gcdetails_sync_elapsed_ns :: RtsTime + -- | The CPU time used during GC itself + , gcdetails_cpu_ns :: RtsTime + -- | The time elapsed during GC itself + , gcdetails_elapsed_ns :: RtsTime + + -- | The CPU time used during the post-mark pause phase of the concurrent + -- nonmoving GC. + , gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime + -- | The time elapsed during the post-mark pause phase of the concurrent + -- nonmoving GC. + , gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime + } deriving ( Read -- ^ @since base-4.10.0.0 + , Show -- ^ @since base-4.10.0.0 + , Generic -- ^ @since base-4.15.0.0 + ) + +-------------------------------- compat ---------------------------------------- + +internal_to_base_RTSStats :: Internal.RTSStats -> RTSStats +internal_to_base_RTSStats i@Internal.RTSStats{..} = + let gc_details = internal_to_base_GCDetails (Internal.gc i) + in RTSStats{gc = gc_details,..} + +internal_to_base_GCDetails :: Internal.GCDetails -> GCDetails +internal_to_base_GCDetails Internal.GCDetails{..} = GCDetails{..} + +-------------------------------- shims ----------------------------------------- + +getRTSStats :: IO RTSStats +getRTSStats = internal_to_base_RTSStats <$> Internal.getRTSStats + +getRTSStatsEnabled :: IO Bool +getRTSStatsEnabled = Internal.getRTSStatsEnabled diff --git a/src/GHC/TypeLits/Internal.hs b/src/GHC/TypeLits/Internal.hs deleted file mode 100644 --- a/src/GHC/TypeLits/Internal.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# OPTIONS_HADDOCK not-home #-} - --- | --- --- Module : GHC.TypeLits.Internal --- Copyright : (c) The University of Glasgow, 1994-2000 --- License : see libraries/base/LICENSE --- --- Maintainer : ghc-devs@haskell.org --- Stability : internal --- Portability : non-portable (GHC extensions) --- --- __Do not use this module.__ Use "GHC.TypeLits" instead. --- --- This module is internal-only and was exposed by accident. It may be --- removed without warning in a future version. --- --- /The API of this module is unstable and is tightly coupled to GHC's internals./ --- If depend on it, make sure to use a tight upper bound, e.g., @base < 4.X@ rather --- than @base < 5@, because the interface can change rapidly without much warning. --- --- The technical reason for this module's existence is that it is needed --- to prevent module cycles while still allowing these identifiers to be --- imported in "Data.Type.Ord". --- --- @since 4.16.0.0 - -module GHC.TypeLits.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-} - (Symbol, - CmpSymbol, - CmpChar - ) where - -import GHC.Internal.TypeLits.Internal diff --git a/src/GHC/TypeNats/Internal.hs b/src/GHC/TypeNats/Internal.hs deleted file mode 100644 --- a/src/GHC/TypeNats/Internal.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# OPTIONS_HADDOCK not-home #-} - -module GHC.TypeNats.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-} - (Natural, - CmpNat - ) where - -import GHC.Internal.TypeNats.Internal diff --git a/src/GHC/Weak/Finalize.hs b/src/GHC/Weak/Finalize.hs --- a/src/GHC/Weak/Finalize.hs +++ b/src/GHC/Weak/Finalize.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MagicHash #-} module GHC.Weak.Finalize ( -- * Handling exceptions -- | When an exception is thrown by a finalizer called by the @@ -8,7 +9,30 @@ , getFinalizerExceptionHandler , printToHandleFinalizerExceptionHandler -- * Internal - , runFinalizerBatch + , GHC.Weak.Finalize.runFinalizerBatch ) where import GHC.Internal.Weak.Finalize + +-- These imports can be removed once runFinalizerBatch is removed, +-- as can MagicHash above. +import GHC.Internal.Base (Int, Array#, IO, State#, RealWorld) + + +{-# DEPRECATED runFinalizerBatch + "This function is internal to GHC. It will not be exported in future." #-} +-- | Run a batch of finalizers from the garbage collector. Given an +-- array of finalizers and the length of the array, just call each one +-- in turn. +-- +-- This is an internal detail of the GHC RTS weak pointer finaliser +-- mechanism. It should no longer be exported from base. There is no +-- good reason to use it. It will be removed in the next major version +-- of base (4.23.*). +-- +-- See +-- +runFinalizerBatch :: Int + -> Array# (State# RealWorld -> State# RealWorld) + -> IO () +runFinalizerBatch = GHC.Internal.Weak.Finalize.runFinalizerBatch diff --git a/src/System/CPUTime/Windows.hsc b/src/System/CPUTime/Windows.hsc --- a/src/System/CPUTime/Windows.hsc +++ b/src/System/CPUTime/Windows.hsc @@ -60,7 +60,7 @@ #if defined(i386_HOST_ARCH) foreign import stdcall unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE) foreign import stdcall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt -#elif defined(x86_64_HOST_ARCH) +#elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) foreign import ccall unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE) foreign import ccall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt #else diff --git a/src/System/Info.hs b/src/System/Info.hs --- a/src/System/Info.hs +++ b/src/System/Info.hs @@ -42,8 +42,6 @@ -- | The full version of 'compilerName' with which the program was compiled -- or is being interpreted. It includes the major, minor, revision and an additional -- identifier, generally in the form "". --- --- @since 4.15.0.0 fullCompilerVersion :: Version fullCompilerVersion = Version version [] where diff --git a/src/System/Timeout.hs b/src/System/Timeout.hs --- a/src/System/Timeout.hs +++ b/src/System/Timeout.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} ------------------------------------------------------------------------------- -- | @@ -29,6 +29,7 @@ asyncExceptionToException, asyncExceptionFromException) import GHC.Internal.Data.Unique (Unique, newUnique) +import GHC.Conc (labelThread) import Prelude -- $setup @@ -119,7 +120,9 @@ let handleTimeout = do v <- isEmptyMVar lock when v $ void $ forkIOWithUnmask $ \unmask -> unmask $ do - v2 <- tryPutMVar lock =<< myThreadId + tid <- myThreadId + labelThread tid "timeout worker" + v2 <- tryPutMVar lock tid when v2 $ throwTo pid ex cleanupTimeout key = uninterruptibleMask_ $ do v <- tryPutMVar lock undefined @@ -136,7 +139,9 @@ ex <- fmap Timeout newUnique handleJust (\e -> if e == ex then Just () else Nothing) (\_ -> return Nothing) - (bracket (forkIOWithUnmask $ \unmask -> + (bracket (forkIOWithUnmask $ \unmask -> do + tid <- myThreadId + labelThread tid "timeout worker" unmask $ threadDelay n >> throwTo pid ex) (uninterruptibleMask_ . killThread) (\_ -> fmap Just f))