base 4.20.2.0 → 4.22.0.0
raw patch · 52 files changed
Files
- base.cabal +8/−19
- changelog.md +102/−33
- src/Control/Category.hs +18/−1
- src/Control/Concurrent.hs +19/−9
- src/Control/Exception.hs +10/−2
- src/Control/Monad/Fix.hs +100/−3
- src/Control/Monad/IO/Class.hs +4/−57
- src/Control/Monad/Zip.hs +2/−121
- src/Data/Array/Byte.hs +48/−0
- src/Data/Bifoldable.hs +20/−6
- src/Data/Bifunctor.hs +2/−2
- src/Data/Bitraversable.hs +58/−2
- src/Data/Bounded.hs +25/−0
- src/Data/Complex.hs +5/−1
- src/Data/Enum.hs +39/−6
- src/Data/Fixed.hs +13/−0
- src/Data/Foldable.hs +24/−18
- src/Data/Foldable1.hs +21/−4
- src/Data/Functor.hs +1/−24
- src/Data/Functor/Classes.hs +325/−4
- src/Data/Functor/Compose.hs +3/−0
- src/Data/Functor/Product.hs +3/−0
- src/Data/Functor/Sum.hs +3/−0
- src/Data/List.hs +105/−0
- src/Data/List/NonEmpty.hs +62/−50
- src/Data/Monoid.hs +2/−0
- src/Data/Semigroup.hs +40/−16
- src/Data/Traversable.hs +17/−8
- src/GHC/Base.hs +136/−8
- src/GHC/Desugar.hs +10/−5
- src/GHC/Exception.hs +1/−1
- src/GHC/ExecutionStack/Internal.hs +0/−31
- src/GHC/Exts.hs +131/−4
- src/GHC/IO/Encoding/Iconv.hs +0/−1
- src/GHC/IO/Handle.hs +0/−0
- src/GHC/IO/StdHandles.hs +0/−0
- src/GHC/IOPort.hs +0/−39
- src/GHC/JS/Prim/Internal/Build.hs +5/−5
- src/GHC/Num/BigNat.hs +6/−0
- src/GHC/Num/Integer.hs +6/−0
- src/GHC/Num/Natural.hs +6/−0
- src/GHC/Pack.hs +0/−37
- src/GHC/RTS/Flags.hs +424/−3
- src/GHC/Records.hs +4/−3
- src/GHC/Stack/CloneStack.hs +1/−0
- src/GHC/Stats.hs +177/−2
- src/GHC/TypeLits/Internal.hs +0/−35
- src/GHC/TypeNats/Internal.hs +0/−9
- src/GHC/Weak/Finalize.hs +25/−1
- src/System/CPUTime/Windows.hsc +1/−1
- src/System/IO.hs +19/−1
- src/System/Timeout.hs +8/−3
base.cabal view
@@ -4,7 +4,7 @@ -- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal name: base-version: 4.20.2.0+version: 4.22.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause@@ -23,14 +23,14 @@ [Set](https://hackage.haskell.org/package/containers/docs/Data-Set.html) are available in the [containers](https://hackage.haskell.org/package/containers) library. To work with textual data, use the [text](https://hackage.haskell.org/package/text/docs/Data-Text.html) library. -extra-source-files:+extra-doc-files: changelog.md Library default-language: Haskell2010 default-extensions: NoImplicitPrelude build-depends:- ghc-internal == 9.1003.*,+ ghc-internal == 9.1401.*, ghc-prim, exposed-modules:@@ -46,8 +46,10 @@ , Data.Bifoldable1 , Data.Bifunctor , Data.Bitraversable+ , Data.Bounded , Data.Char , Data.Complex+ , Data.Enum , Data.Fixed , Data.Foldable1 , Data.Functor.Classes@@ -95,7 +97,6 @@ , Data.Dynamic , Data.Either , Data.Eq- , Data.Enum , Data.Foldable , Data.Function , Data.Functor@@ -169,7 +170,6 @@ , GHC.Exception , GHC.Exception.Type , GHC.ExecutionStack- , GHC.ExecutionStack.Internal , GHC.Exts , GHC.Fingerprint , GHC.Fingerprint.Type@@ -219,9 +219,11 @@ , GHC.MVar , GHC.Natural , GHC.Num+ , GHC.Num.Integer+ , GHC.Num.Natural+ , GHC.Num.BigNat , GHC.OldList , GHC.OverloadedLabels- , GHC.Pack , GHC.Profiling , GHC.Ptr , GHC.Read@@ -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,14 +271,7 @@ , 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: GHC.IO.Encoding.CodePage.API@@ -323,9 +316,5 @@ System.CPUTime.Posix.ClockGetTime System.CPUTime.Posix.Times System.CPUTime.Posix.RUsage-- -- We need to set the unit id to base (without a version number)- -- as it's magic.- ghc-options: -this-unit-id base hs-source-dirs: src
changelog.md view
@@ -1,22 +1,87 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## 4.20.2 *July 2025*+## 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.20.1 *Jan 2025*- * Shipped with GHC 9.10.2+## 4.21.0.0 *December 2024*+ * Shipped with GHC 9.12.1+ * Change `SrcLoc` to be a strict and unboxed (finishing [CLC proposal #55](https://github.com/haskell/core-libraries-committee/issues/55))+ * Introduce `Data.Bounded` module exporting the `Bounded` typeclass (finishing [CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208))+ * Deprecate export of `Bounded` class from `Data.Enum` ([CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208))+ * `GHC.Desugar` has been deprecated and should be removed in GHC 9.14. ([CLC proposal #216](https://github.com/haskell/core-libraries-committee/issues/216))+ * Add a `readTixFile` field to the `HpcFlags` record in `GHC.RTS.Flags` ([CLC proposal #276](https://github.com/haskell/core-libraries-committee/issues/276))+ * Add `compareLength` to `Data.List` and `Data.List.NonEmpty` ([CLC proposal #257](https://github.com/haskell/core-libraries-committee/issues/257))+ * Add `INLINE[1]` to `compareInt` / `compareWord` ([CLC proposal #179](https://github.com/haskell/core-libraries-committee/issues/179))+ * Refactor `GHC.RTS.Flags` in preparation for new I/O managers: introduce `data IoManagerFlag` and use it in `MiscFlags`, remove `getIoManagerFlag`, deprecate re-export of `IoSubSystem` ([CLC proposal #263](https://github.com/haskell/core-libraries-committee/issues/263))+ * Add the `MonadFix` instance for `(,) a`, similar to the one for `Writer a` ([CLC proposal #238](https://github.com/haskell/core-libraries-committee/issues/238))+ * Improve `toInteger :: Word32 -> Integer` on 64-bit platforms ([CLC proposal #259](https://github.com/haskell/core-libraries-committee/issues/259))+ * Make `flip` representation polymorphic ([CLC proposal #245](https://github.com/haskell/core-libraries-committee/issues/245))+ * The `HasField` class now supports representation polymorphism ([CLC proposal #194](https://github.com/haskell/core-libraries-committee/issues/194))+ * Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177))+ * Improve the performance of `Data.List.sort` using an improved merging strategy. Instead of `compare`, `sort` now uses `(>)` which may break *malformed* `Ord` instances ([CLC proposal #236](https://github.com/haskell/core-libraries-committee/issues/236))+ * Add `inits1` and `tails1` to `Data.List`, factored from the corresponding functions in `Data.List.NonEmpty` ([CLC proposal #252](https://github.com/haskell/core-libraries-committee/issues/252))+ * Add `firstA` and `secondA` to `Data.Bitraversable`. ([CLC proposal #172](https://github.com/haskell/core-libraries-committee/issues/172))+ * Deprecate `GHC.TypeNats.Internal`, `GHC.TypeLits.Internal`, `GHC.ExecutionStack.Internal` ([CLC proposal #217](https://github.com/haskell/core-libraries-committee/issues/217))+ * `System.IO.Error.ioError` and `Control.Exception.ioError` now both carry `HasCallStack` constraints ([CLC proposal #275](https://github.com/haskell/core-libraries-committee/issues/275))+ * Define `Eq1`, `Ord1`, `Show1` and `Read1` instances for basic `Generic` representation types. ([CLC proposal #273](https://github.com/haskell/core-libraries-committee/issues/273)) * `setNonBlockingMode` will no longer throw an exception when called on a FD associated with a unknown device type. ([CLC proposal #282](https://github.com/haskell/core-libraries-committee/issues/282))+ * Add exception type metadata to default exception handler output.+ ([CLC proposal #231](https://github.com/haskell/core-libraries-committee/issues/231)+ and [CLC proposal #261](https://github.com/haskell/core-libraries-committee/issues/261))+ * The [deprecation process of GHC.Pack](https://gitlab.haskell.org/ghc/ghc/-/issues/21461) has come its term. The module has now been removed from `base`. * Propagate HasCallStack from `errorCallWithCallStackException` to exception backtraces, fixing a bug in the implementation of [CLC proposal #164](https://github.com/haskell/core-libraries-committee/issues/164).- * 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))--## 4.20.0.1 *May 2024*- * Not shipped with any GHC: This is a documentation only release to fix various issues with base-4.20.0.0 docs due to the GHC internal split- * For an accounting of the issues fixed, see [#24875](https://gitlab.haskell.org/ghc/ghc/-/issues/24875)+ * Annotate re-thrown exceptions with the backtrace as per [CLC proposal #202](https://github.com/haskell/core-libraries-committee/issues/202) (introduces `WhileHandling` and modifies such as `catch` and `onException` accordingly to propagate or rethrow exceptions)+ * Introduced `catchNoPropagate`, `rethrowIO` and `tryWithContext` as part of+ [CLC proposal #202](https://github.com/haskell/core-libraries-committee/issues/202) to+ facilitate *re*throwing exceptions without adding a `WhileHandling`+ context -- if *re*throwing `e`, you don't want to add `WhileHandling e` to+ the context since it will be redundant. These functions are mostly useful+ 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).+ * 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+ * Make `displayException (SomeException e) = displayException e`. The+ additional information that is printed when exceptions are surfaced to+ the top-level is added by `uncaughtExceptionHandler`.+ * Get rid of the HasCallStack mechanism manually propagated by `ErrorCall`+ in favour of the more general HasCallStack exception backtrace+ mechanism, to remove duplicate call stacks for uncaught exceptions.+ * Freeze the callstack of `error`, `undefined`, `throwIO`, `ioException`,+ `ioError` to prevent leaking the implementation of these error functions+ into the callstack. ## 4.20.0.0 *May 2024* * Shipped with GHC 9.10.1+ * Introduce `Data.Enum` module exporting both `Enum` and `Bounded`. Note that the export of `Bounded` will be deprecated in a future release ([CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208)) * Deprecate `GHC.Pack` ([#21461](https://gitlab.haskell.org/ghc/ghc/-/issues/21461)) * Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167)) * The top-level handler for uncaught exceptions now displays the output of `displayException` rather than `show` ([CLC proposal #198](https://github.com/haskell/core-libraries-committee/issues/198))@@ -28,11 +93,12 @@ * Implement `sconcat` for `instance Semigroup Data.Semigroup.First` and `instance Semigroup Data.Monoid.First` explicitly, increasing laziness ([CLC proposal #246](https://github.com/haskell/core-libraries-committee/issues/246)) * Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205)) * The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))- * Exceptions can now be decorated with user-defined annotations via `ExceptionContext`.+ * Exceptions can now be decorated with user-defined annotations via `ExceptionContext` ([CLC proposal #200](https://github.com/haskell/core-libraries-committee/issues/200)) * Exceptions now capture backtrace information via their `ExceptionContext`. GHC supports several mechanisms by which backtraces can be collected which can be individually enabled and disabled via- `GHC.Exception.Backtrace.setBacktraceMechanismState`.+ `GHC.Exception.Backtrace.setBacktraceMechanismState` ([CLC proposal #199](https://github.com/haskell/core-libraries-committee/issues/199))+ * Add `HasCallStack` constraint to `Control.Exception.throw{,IO}` ([CLC proposal #201](https://github.com/haskell/core-libraries-committee/issues/201)) * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/). * Fix `withFile`, `withFileBlocking`, and `withBinaryFile` to not incorrectly annotate exceptions raised in wrapped computation. ([CLC proposal #237](https://github.com/haskell/core-libraries-committee/issues/237)) * Fix `fdIsNonBlocking` to always be `0` for regular files and block devices on unix, regardless of `O_NONBLOCK`@@ -49,7 +115,6 @@ * Implement `many` and `some` methods of `instance Alternative (Compose f g)` explicitly. ([CLC proposal #181](https://github.com/haskell/core-libraries-committee/issues/181)) * Change the types of the `GHC.Stack.StackEntry.closureType` and `GHC.InfoProv.InfoProv.ipDesc` record fields to use `GHC.Exts.Heap.ClosureType` rather than an `Int`. To recover the old value use `fromEnum`. ([CLC proposal #210](https://github.com/haskell/core-libraries-committee/issues/210))- * The functions `GHC.Exts.dataToTag#` and `GHC.Base.getTag` have had their types changed to the following: @@ -64,22 +129,23 @@ matches a `data` or `data instance` declaration) with all of its constructors in scope and the levity of `t` is statically known, then the constraint `DataToTag t` can always be solved.+ ([CLC proposal #104](https://github.com/haskell/core-libraries-committee/issues/104)) * `GHC.Exts` no longer exports the GHC-internal `whereFrom#` primop ([CLC proposal #214](https://github.com/haskell/core-libraries-committee/issues/214)) * `GHC.InfoProv.InfoProv` now provides a `ipUnitId :: String` field encoding the unit ID of the unit defining the info table ([CLC proposal #214](https://github.com/haskell/core-libraries-committee/issues/214))-- ([CLC proposal #104](https://github.com/haskell/core-libraries-committee/issues/104)) * Add `sortOn` to `Data.List.NonEmpty` ([CLC proposal #227](https://github.com/haskell/core-libraries-committee/issues/227))- * Add more instances for `Compose`: `Fractional`, `RealFrac`, `Floating`, `RealFloat` ([CLC proposal #226](https://github.com/haskell/core-libraries-committee/issues/226))- * Treat all FDs as "nonblocking" on wasm32 ([CLC proposal #234](https://github.com/haskell/core-libraries-committee/issues/234))- * Add `HeapByEra`, `eraSelector` and `automaticEraIncrement` to `GHC.RTS.Flags` to reflect the new RTS flags: `-he` profiling mode, `-he` selector and `--automatic-era-increment`. ([CLC proposal #254](https://github.com/haskell/core-libraries-committee/issues/254))+ * Document that certain modules are unstable and not meant to be consumed by the general public ([CLC proposal #146](https://github.com/haskell/core-libraries-committee/issues/146))+ * Add unaligned `Addr#` primops ([CLC proposal #154](https://github.com/haskell/core-libraries-committee/issues/154))+ * Deprecate `stgDoubleToWord{32,64}` and `stgWord{32,64}ToDouble` in favor of new primops `castDoubleToWord{32,64}#` and `castWord{32,64}ToDouble#` ([CLC proposal #253](https://github.com/haskell/core-libraries-committee/issues/253))+ * Add `unsafeThawByteArray#`, opposite to the existing `unsafeFreezeByteArray#` ([CLC proposal #184](https://github.com/haskell/core-libraries-committee/issues/184)) ## 4.19.0.0 *October 2023*+ * Shipped with GHC 9.8.1 * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`. Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. ([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/87) and [#114](https://github.com/haskell/core-libraries-committee/issues/114))@@ -110,12 +176,15 @@ * Add more instances for `Compose`: `Enum`, `Bounded`, `Num`, `Real`, `Integral` ([CLC proposal #160](https://github.com/haskell/core-libraries-committee/issues/160)) * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139))- * Change `BufferCodec` to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134))+ * Change `BufferCodec` to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134) and [#178](https://github.com/haskell/core-libraries-committee/issues/178)) * Add nominal role annotations to `SNat` / `SSymbol` / `SChar` ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) * Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8)) * Implement `copyBytes`, `fillBytes`, `moveBytes` and `stimes` for `Data.Array.Byte.ByteArray` using primops ([CLC proposal #188](https://github.com/haskell/core-libraries-committee/issues/188)) * Add rewrite rules for conversion between `Int64` / `Word64` and `Float` / `Double` on 64-bit architectures ([CLC proposal #203](https://github.com/haskell/core-libraries-committee/issues/203)). * `Generic` instances for tuples now expose `Unit`, `Tuple2`, `Tuple3`, ..., `Tuple64` as the actual names for tuple type constructors ([GHC proposal #475](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst)).+ * Reject `FilePath`s containing interior `NUL`s ([CLC proposal #144](https://github.com/haskell/core-libraries-committee/issues/144))+ * Add `GHC.JS.Foreign.Callback` module for JavaScript backend ([CLC proposal #150](https://github.com/haskell/core-libraries-committee/issues/150))+ * Generalize the type of `keepAlive#` and `touch#` ([CLC proposal #152](https://github.com/haskell/core-libraries-committee/issues/152)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1@@ -247,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@@ -287,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* @@ -366,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`.
src/Control/Category.hs view
@@ -11,9 +11,26 @@ -- module Control.Category- ( Category(..)+ ( -- * Class+ Category(..)++ -- * Combinators , (<<<) , (>>>)++ -- $namingConflicts ) where import GHC.Internal.Control.Category++-- $namingConflicts+--+-- == A note on naming conflicts+--+-- The methods from 'Category' conflict with 'Prelude.id' and 'Prelude..' from the+-- prelude; you will likely want to either import this module qualified, or hide the+-- prelude functions:+--+-- @+-- import "Prelude" hiding (id, (.))+-- @
src/Control/Concurrent.hs view
@@ -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
src/Control/Exception.hs view
@@ -37,7 +37,10 @@ addExceptionContext, someExceptionContext, annotateIO,+ NoBacktrace(..), ExceptionWithContext(..),+ WhileHandling(..),+ -- * Concrete exception types IOException, ArithException(..),@@ -65,6 +68,7 @@ -- * Throwing exceptions throw, throwIO,+ rethrowIO, ioError, throwTo, -- * Catching Exceptions@@ -73,6 +77,7 @@ -- $catchall -- ** The @catch@ functions catch,+ catchNoPropagate, catches, Handler(..), catchJust,@@ -81,6 +86,7 @@ handleJust, -- ** The @try@ functions try,+ tryWithContext, tryJust, -- ** The @evaluate@ function evaluate,@@ -110,12 +116,14 @@ bracket_, bracketOnError, finally,- onException+ onException,+ -- ** Printing+ displayExceptionWithInfo+ ) where import GHC.Internal.Control.Exception import GHC.Internal.Exception.Type-import GHC.Internal.IO (annotateIO) {- $catching
src/Control/Monad/Fix.hs view
@@ -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, <https://wiki.haskell.org/MonadFix MonadFix>.+-- * Levent Erkök, <https://leventerkok.github.io/papers/erkok-thesis.pdf Value recursion in monadic computations>, Oregon Graduate Institute, 2002.+-- * Levent Erkök, John Launchbury, <https://leventerkok.github.io/papers/recdo.pdf A recursive do for Haskell>, Haskell '02, 29-37, 2002.+-- * Richard S. Bird, <https://doi.org/10.1007/BF00264249 Using circular programs to eliminate multiple traversals of data>, Acta Informatica 21, 239-250, 1984.+-- * Jasper Van der Jeugt, <https://jaspervdj.be/posts/2023-07-22-lazy-layout.html Lazy layout>, 2023. module Control.Monad.Fix (MonadFix(mfix),
src/Control/Monad/IO/Class.hs view
@@ -14,61 +14,8 @@ -- Class of monads based on @IO@. ----------------------------------------------------------------------------- -module Control.Monad.IO.Class (- MonadIO(..)- ) where--import GHC.Internal.Base---- | Monads in which 'IO' computations may be embedded.--- Any monad built by applying a sequence of monad transformers to the--- 'IO' monad will be an instance of this class.------ Instances should satisfy the following laws, which state that 'liftIO'--- is a transformer of monads:------ * @'liftIO' . 'return' = 'return'@------ * @'liftIO' (m >>= f) = 'liftIO' m >>= ('liftIO' . f)@--class (Monad m) => MonadIO m where- -- | Lift a computation from the 'IO' monad.- -- This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations- -- (i.e. 'IO' is the base monad for the stack).- --- -- === __Example__- --- --- -- > import Control.Monad.Trans.State -- from the "transformers" library- -- >- -- > printState :: Show s => StateT s IO ()- -- > printState = do- -- > state <- get- -- > liftIO $ print state- --- --- -- Had we omitted @'liftIO'@, we would have ended up with this error:- --- -- > • Couldn't match type ‘IO’ with ‘StateT s IO’- -- > Expected type: StateT s IO ()- -- > Actual type: IO ()- --- -- The important part here is the mismatch between @StateT s IO ()@ and @'IO' ()@.- --- -- Luckily, we know of a function that takes an @'IO' a@ and returns an @(m a)@: @'liftIO'@,- -- enabling us to run the program and see the expected results:- --- -- @- -- > evalStateT printState "hello"- -- "hello"- --- -- > evalStateT printState 3- -- 3- -- @- --- liftIO :: IO a -> m a---- | @since 4.9.0.0-instance MonadIO IO where- liftIO = id+module Control.Monad.IO.Class+ ( MonadIO(..) )+ where +import GHC.Internal.Control.Monad.IO.Class
src/Control/Monad/Zip.hs view
@@ -16,125 +16,6 @@ -- ----------------------------------------------------------------------------- -module Control.Monad.Zip where--import GHC.Internal.Control.Monad (liftM, liftM2)-import GHC.Internal.Data.Functor.Identity-import qualified GHC.Internal.Data.Functor-import GHC.Internal.Data.Monoid-import GHC.Internal.Data.Ord ( Down(..) )-import GHC.Internal.Data.Proxy-import qualified Data.List.NonEmpty as NE-import GHC.Generics-import GHC.Tuple (Solo (..))-import Prelude---- | Instances should satisfy the laws:------ [Naturality]------ @'liftM' (f 'Control.Arrow.***' g) ('mzip' ma mb)--- = 'mzip' ('liftM' f ma) ('liftM' g mb)@------ [Information Preservation]------ @'liftM' ('Prelude.const' ()) ma = 'liftM' ('Prelude.const' ()) mb@--- implies--- @'munzip' ('mzip' ma mb) = (ma, mb)@----class Monad m => MonadZip m where- {-# MINIMAL mzip | mzipWith #-}-- mzip :: m a -> m b -> m (a,b)- mzip = mzipWith (,)-- mzipWith :: (a -> b -> c) -> m a -> m b -> m c- mzipWith f ma mb = liftM (uncurry f) (mzip ma mb)-- munzip :: m (a,b) -> (m a, m b)- munzip mab = (liftM fst mab, liftM snd mab)- -- munzip is a member of the class because sometimes- -- you can implement it more efficiently than the- -- above default code. See #4370 comment by giorgidze---- | @since 4.3.1.0-instance MonadZip [] where- mzip = zip- mzipWith = zipWith- munzip = unzip---- | @since 4.9.0.0-instance MonadZip NE.NonEmpty where- mzip = NE.zip- mzipWith = NE.zipWith- munzip = GHC.Internal.Data.Functor.unzip---- | @since 4.8.0.0-instance MonadZip Identity where- mzipWith = liftM2- munzip (Identity (a, b)) = (Identity a, Identity b)---- | @since 4.15.0.0-instance MonadZip Solo where- mzipWith = liftM2- munzip (MkSolo (a, b)) = (MkSolo a, MkSolo b)---- | @since 4.8.0.0-instance MonadZip Dual where- -- Cannot use coerce, it's unsafe- mzipWith = liftM2---- | @since 4.8.0.0-instance MonadZip Sum where- mzipWith = liftM2---- | @since 4.8.0.0-instance MonadZip Product where- mzipWith = liftM2---- | @since 4.8.0.0-instance MonadZip Maybe where- mzipWith = liftM2---- | @since 4.8.0.0-instance MonadZip First where- mzipWith = liftM2---- | @since 4.8.0.0-instance MonadZip Last where- mzipWith = liftM2---- | @since 4.8.0.0-instance MonadZip f => MonadZip (Alt f) where- mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)---- | @since 4.9.0.0-instance MonadZip Proxy where- mzipWith _ _ _ = Proxy---- Instances for GHC.Generics--- | @since 4.9.0.0-instance MonadZip U1 where- mzipWith _ _ _ = U1---- | @since 4.9.0.0-instance MonadZip Par1 where- mzipWith = liftM2---- | @since 4.9.0.0-instance MonadZip f => MonadZip (Rec1 f) where- mzipWith f (Rec1 fa) (Rec1 fb) = Rec1 (mzipWith f fa fb)---- | @since 4.9.0.0-instance MonadZip f => MonadZip (M1 i c f) where- mzipWith f (M1 fa) (M1 fb) = M1 (mzipWith f fa fb)---- | @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+module Control.Monad.Zip ( MonadZip(..) ) where --- | @since 4.12.0.0-instance MonadZip Down where- mzipWith = liftM2+import GHC.Internal.Control.Monad.Zip(MonadZip(..))
src/Data/Array/Byte.hs view
@@ -13,6 +13,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE TemplateHaskellQuotes #-} module Data.Array.Byte ( ByteArray(..),@@ -30,6 +31,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.Lift+import GHC.Internal.ForeignPtr import Prelude -- | Lifted wrapper for 'ByteArray#'.@@ -41,6 +45,22 @@ -- but wrap and unwrap 'ByteArray' internally as they please -- and use functions from "GHC.Exts". --+-- The memory representation of a 'ByteArray' is:+--+-- > ╭─────────────┬───╮ ╭────────┬──────┬─────────╮+-- > │ Constructor │ * ┼─►│ Header │ Size │ Payload │+-- > ╰─────────────┴───╯ ╰────────┴──────┴─────────╯+--+-- And its overhead is the following:+--+-- * 'ByteArray' constructor: 1 word+-- * Pointer to 'ByteArray#': 1 word+-- * 'ByteArray#' Header: 1 word+-- * 'ByteArray#' Size: 1 word+--+-- Where a word is the unit of heap allocation,+-- measuring 8 bytes on 64-bit systems, and 4 bytes on 32-bit systems.+-- -- @since 4.17.0.0 data ByteArray = ByteArray ByteArray# @@ -179,6 +199,34 @@ where comma | i == 0 = id | otherwise = showString ", "++instance Lift ByteArray where+ liftTyped = unsafeCodeCoerce . lift+ lift (ByteArray b) =+ [| addrToByteArray $(lift len)+ $(pure . LitE . BytesPrimL $ Bytes ptr 0 (fromIntegral len))+ |]+ where+ len# = sizeofByteArray# b+ len = I# len#+ pb :: ByteArray#+ !(ByteArray pb)+ | isTrue# (isByteArrayPinned# b) = ByteArray b+ | otherwise = runST $ ST $+ \s -> case newPinnedByteArray# len# s of+ (# s', mb #) -> case copyByteArray# b 0# mb 0# len# s' of+ s'' -> case unsafeFreezeByteArray# mb s'' of+ (# s''', ret #) -> (# s''', ByteArray ret #)+ ptr :: ForeignPtr Word8+ ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))++{-# NOINLINE addrToByteArray #-}+addrToByteArray :: Int -> Addr# -> ByteArray+addrToByteArray (I# len) addr = runST $ ST $+ \s -> case newByteArray# len s of+ (# s', mb #) -> case copyAddrToByteArray# addr mb 0# len s' of+ s'' -> case unsafeFreezeByteArray# mb s'' of+ (# s''', ret #) -> (# s''', ByteArray ret #) -- | Compare prefixes of given length. compareByteArraysFromBeginning :: ByteArray -> ByteArray -> Int -> Ordering
src/Data/Bifoldable.hs view
@@ -238,8 +238,8 @@ -- -- >>> bifoldr (flip const) (:) [] (undefined :: (Int, Word)) `seq` () -- ()--- >>> foldr (:) [] (undefined :: (Int, Word)) `seq` ()--- *** Exception: Prelude.undefined+-- >>> foldr (:) [] (errorWithoutStackTrace "error!" :: (Int, Word)) `seq` ()+-- *** Exception: error! -- -- @since 4.10.0.0 instance Bifoldable (,) where@@ -640,7 +640,13 @@ biconcat :: Bifoldable t => t [a] [a] -> [a] biconcat = bifold --- | The largest element of a non-empty structure.+-- | The largest element of a non-empty structure. This function is equivalent+-- to @'bifoldr1' 'max'@, and its behavior on structures with multiple largest+-- elements depends on the relevant implementation of 'max'. For the default+-- implementation of 'max' (@max x y = if x <= y then y else x@), structure+-- order is used as a tie-breaker: if there are multiple largest elements, the+-- rightmost of them is chosen (this is equivalent to @'bimaximumBy'+-- 'compare'@). -- -- ==== __Examples__ --@@ -670,7 +676,13 @@ getMax . bifoldMap mj mj where mj = Max #. (Just :: a -> Maybe a) --- | The least element of a non-empty structure.+-- | The least element of a non-empty structure. This function is equivalent to+-- @'bifoldr1' 'min'@, and its behavior on structures with multiple least+-- elements depends on the relevant implementation of 'min'. For the default+-- implementation of 'min' (@min x y = if x <= y then x else y@), structure+-- order is used as a tie-breaker: if there are multiple least elements, the+-- leftmost of them is chosen (this is equivalent to @'biminimumBy'+-- 'compare'@). -- -- ==== __Examples__ --@@ -927,7 +939,8 @@ biall p q = getAll #. bifoldMap (All . p) (All . q) -- | The largest element of a non-empty structure with respect to the--- given comparison function.+-- given comparison function. Structure order is used as a tie-breaker: if+-- there are multiple largest elements, the rightmost of them is chosen. -- -- ==== __Examples__ --@@ -956,7 +969,8 @@ _ -> y -- | The least element of a non-empty structure with respect to the--- given comparison function.+-- given comparison function. Structure order is used as a tie-breaker: if+-- there are multiple least elements, the leftmost of them is chosen. -- -- ==== __Examples__ --
src/Data/Bifunctor.hs view
@@ -140,8 +140,8 @@ -- () -- >>> second id (undefined :: (Int, Word)) `seq` () -- ()--- >>> id (undefined :: (Int, Word)) `seq` ()--- *** Exception: Prelude.undefined+-- >>> id (errorWithoutStackTrace "error!" :: (Int, Word)) `seq` ()+-- *** Exception: error! -- -- @since 4.8.0.0 instance Bifunctor (,) where
src/Data/Bitraversable.hs view
@@ -18,6 +18,8 @@ , bisequenceA , bisequence , bimapM+ , firstA+ , secondA , bifor , biforM , bimapAccumL@@ -172,6 +174,60 @@ bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) bisequence = bitraverse id id +-- | Traverses only over the first argument.+--+-- @'firstA' f ≡ 'bitraverse' f 'pure'@++-- ==== __Examples__+--+-- Basic usage:+--+-- >>> firstA listToMaybe (Left [])+-- Nothing+--+-- >>> firstA listToMaybe (Left [1, 2, 3])+-- Just (Left 1)+--+-- >>> firstA listToMaybe (Right [4, 5])+-- Just (Right [4, 5])+--+-- >>> firstA listToMaybe ([1, 2, 3], [4, 5])+-- Just (1,[4, 5])+--+-- >>> firstA listToMaybe ([], [4, 5])+-- Nothing++-- @since 4.21.0.0+firstA :: Bitraversable t => Applicative f => (a -> f c) -> t a b -> f (t c b)+firstA f = bitraverse f pure++-- | Traverses only over the second argument.+--+-- @'secondA' f ≡ 'bitraverse' 'pure' f@+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> secondA (find odd) (Left [])+-- Just (Left [])+--+-- >>> secondA (find odd) (Left [1, 2, 3])+-- Just (Left [1,2,3])+--+-- >>> secondA (find odd) (Right [4, 5])+-- Just (Right 5)+--+-- >>> secondA (find odd) ([1, 2, 3], [4, 5])+-- Just ([1,2,3],5)+--+-- >>> secondA (find odd) ([1,2,3], [4])+-- Nothing+--+-- @since 4.21.0.0+secondA :: Bitraversable t => Applicative f => (b -> f c) -> t a b -> f (t a c)+secondA f = bitraverse pure f+ -- | Class laws for tuples hold only up to laziness. The -- Bitraversable methods are lazier than their Traversable counterparts. -- For example the law @'bitraverse' 'pure' ≡ 'traverse'@ does@@ -179,8 +235,8 @@ -- -- >>> (bitraverse pure pure undefined :: IO (Int, Word)) `seq` () -- ()--- >>> (traverse pure undefined :: IO (Int, Word)) `seq` ()--- *** Exception: Prelude.undefined+-- >>> (traverse pure (errorWithoutStackTrace "error!") :: IO (Int, Word)) `seq` ()+-- *** Exception: error! -- -- @since 4.10.0.0 instance Bitraversable (,) where
+ src/Data/Bounded.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Bounded+-- Copyright : (c) The University of Glasgow, 1992-2002+-- License : see libraries/base/LICENSE+--+-- Maintainer : cvs-ghc@haskell.org+-- Stability : stable+-- Portability : non-portable (GHC extensions)+--+-- The 'Bounded' class.+--+-- @since 4.21.0.0+--+-----------------------------------------------------------------------------++module Data.Bounded+ ( Bounded(..)+ ) where++import GHC.Enum+
src/Data/Complex.hs view
@@ -47,6 +47,9 @@ infix 6 :+ +-- $setup+-- >>> import Prelude+ -- ----------------------------------------------------------------------------- -- The Complex type @@ -62,7 +65,7 @@ -- it holds that @z == 'abs' z * 'signum' z@. -- -- Note that `Complex`'s instances inherit the deficiencies from the type--- parameter's. For example, @Complex Float@'s 'Ord' instance has similar+-- parameter's. For example, @Complex Float@'s 'Eq' instance has similar -- problems to `Float`'s. -- -- As can be seen in the examples, the 'Foldable'@@ -85,6 +88,7 @@ -- >>> mapM print (1 :+ 2) -- 1 -- 2+-- () :+ () data Complex a = !a :+ !a -- ^ forms a complex number from its real and imaginary -- rectangular components.
src/Data/Enum.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE Safe #-}+{-# LANGUAGE NoImplicitPrelude #-} +----------------------------------------------------------------------------- -- |--- -- Module : Data.Enum -- Copyright : (c) The University of Glasgow, 1992-2002 -- License : see libraries/base/LICENSE@@ -10,12 +11,44 @@ -- Stability : stable -- Portability : non-portable (GHC extensions) ----- The 'Enum' and 'Bounded' classes.+-- The 'Enum' class. --+-- @since 4.20.0.0+--+----------------------------------------------------------------------------- module Data.Enum- (Bounded(..),- Enum(..)- ) where+ ( Enum(..)+ , {-# DEPRECATED "Bounded should be imported from Data.Bounded" #-}+ Bounded(..)+ , enumerate+ ) where -import GHC.Internal.Data.Enum+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]
src/Data/Fixed.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskellQuotes #-} ----------------------------------------------------------------------------- -- |@@ -90,9 +91,14 @@ import GHC.Internal.Read import GHC.Internal.Text.ParserCombinators.ReadPrec import GHC.Internal.Text.Read.Lex+import qualified GHC.Internal.TH.Syntax as TH+import qualified GHC.Internal.TH.Lift as TH import Data.Typeable import Prelude +-- $setup+-- >>> import Prelude+ default () -- avoid any defaulting shenanigans -- | Generalisation of 'div' to any instance of 'Real'@@ -136,6 +142,13 @@ gunfold k z _ = k (z MkFixed) dataTypeOf _ = tyFixed toConstr _ = conMkFixed++-- |+-- @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)+ lift (MkFixed x) = [| MkFixed x |] -- | Types which can be used as a resolution argument to the 'Fixed' type constructor must implement the 'HasResolution' typeclass. class HasResolution (a :: k) where
src/Data/Foldable.hs view
@@ -98,6 +98,10 @@ import GHC.Internal.Data.Foldable +-- $setup+-- >>> import Prelude+-- >>> import qualified Data.List as List+ -- $overview -- -- #overview#@@ -141,7 +145,7 @@ -- -- >>> foldl' (+) 0 [1..100] -- 5050--- >>> foldr (&&) True (repeat False)+-- >>> foldr (&&) True (List.repeat False) -- False -- -- The first argument of both is an explicit /operator/ that merges the@@ -405,7 +409,7 @@ -- segment. -- -- >>> myconcat = foldr (\x z -> foldr (:) z x) []--- >>> take 15 $ myconcat $ map (\i -> [0..i]) [0..]+-- >>> List.take 15 $ myconcat $ List.map (\i -> [0..i]) [0..] -- [0,0,1,0,1,2,0,1,2,3,0,1,2,3,4] -- -- Of course in this case another way to achieve the same result is via a@@ -536,13 +540,13 @@ -- then the evaluated effects will be from an initial portion of the -- element sequence. ----- >>> :set -XBangPatterns--- >>> import Control.Monad--- >>> import Control.Monad.Trans.Class--- >>> import Control.Monad.Trans.Maybe--- >>> import Data.Foldable--- >>> let f !_ e = when (e > 3) mzero >> lift (print e)--- >>> runMaybeT $ foldlM f () [0..]+-- > :set -XBangPatterns+-- > import Control.Monad+-- > import Control.Monad.Trans.Class+-- > import Control.Monad.Trans.Maybe+-- > import Data.Foldable+-- > let f !_ e = when (e > 3) mzero >> lift (print e)+-- > runMaybeT $ foldlM f () [0..] -- 0 -- 1 -- 2@@ -553,16 +557,16 @@ -- to left, and therefore diverges when folding an unbounded input -- structure without ever having the opportunity to short-circuit. ----- >>> let f e _ = when (e > 3) mzero >> lift (print e)--- >>> runMaybeT $ foldrM f () [0..]+-- > let f e _ = when (e > 3) mzero >> lift (print e)+-- > runMaybeT $ foldrM f () [0..] -- ...hangs... -- -- When the structure is finite `foldrM` performs the monadic effects from -- right to left, possibly short-circuiting after processing a tail portion -- of the element sequence. ----- >>> let f e _ = when (e < 3) mzero >> lift (print e)--- >>> runMaybeT $ foldrM f () [0..5]+-- > let f e _ = when (e < 3) mzero >> lift (print e)+-- > runMaybeT $ foldrM f () [0..5] -- 5 -- 4 -- 3@@ -614,14 +618,16 @@ -- Below we construct a @Foldable@ instance for a data type representing a -- (finite) binary tree with depth-first traversal. ----- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+-- >>> data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) -- -- a suitable instance would be: ----- > instance Foldable Tree where--- > foldr f z Empty = z--- > foldr f z (Leaf x) = f x z--- > foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l+-- >>> :{+-- instance Foldable Tree where+-- foldr f z Empty = z+-- foldr f z (Leaf x) = f x z+-- foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l+-- :} -- -- The 'Node' case is a right fold of the left subtree whose initial -- value is a right fold of the rest of the tree.
src/Data/Foldable1.hs view
@@ -61,6 +61,9 @@ -- $setup -- >>> import Prelude hiding (foldr1, foldl1, head, last, minimum, maximum)+-- >>> import Data.List.NonEmpty (NonEmpty(..))+-- >>> import Data.Monoid (Sum(..))+-- >>> import Data.Functor.Identity ------------------------------------------------------------------------------- -- Foldable1 type class@@ -127,7 +130,13 @@ toNonEmpty :: t a -> NonEmpty a toNonEmpty = runNonEmptyDList . foldMap1 singleton - -- | The largest element of a non-empty structure.+ -- | The largest element of a non-empty structure. This function is+ -- equivalent to @'foldr1' 'Data.Ord.max'@, and its behavior on structures+ -- with multiple largest elements depends on the relevant implementation of+ -- 'Data.Ord.max'. For the default implementation of 'Data.Ord.max' (@max x+ -- y = if x <= y then y else x@), structure order is used as a tie-breaker:+ -- if there are multiple largest elements, the rightmost of them is chosen+ -- (this is equivalent to @'maximumBy' 'Data.Ord.compare'@). -- -- >>> maximum (32 :| [64, 8, 128, 16]) -- 128@@ -136,7 +145,13 @@ maximum :: Ord a => t a -> a maximum = getMax #. foldMap1' Max - -- | The least element of a non-empty structure.+ -- | The least element of a non-empty structure. This function is+ -- equivalent to @'foldr1' 'Data.Ord.min'@, and its behavior on structures+ -- with multiple largest elements depends on the relevant implementation of+ -- 'Data.Ord.min'. For the default implementation of 'Data.Ord.min' (@min x+ -- y = if x <= y then x else y@), structure order is used as a tie-breaker:+ -- if there are multiple least elements, the leftmost of them is chosen+ -- (this is equivalent to @'minimumBy' 'Data.Ord.compare'@). -- -- >>> minimum (32 :| [64, 8, 128, 16]) -- 8@@ -359,7 +374,8 @@ where x:|xs = toNonEmpty t -- | The largest element of a non-empty structure with respect to the--- given comparison function.+-- given comparison function. Structure order is used as a tie-breaker: if+-- there are multiple largest elements, the rightmost of them is chosen. -- -- @since 4.18.0.0 maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a@@ -369,7 +385,8 @@ _ -> y -- | The least element of a non-empty structure with respect to the--- given comparison function.+-- given comparison function. Structure order is used as a tie-breaker: if+-- there are multiple least elements, the leftmost of them is chosen. -- -- @since 4.18.0.0 minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
src/Data/Functor.hs view
@@ -11,32 +11,9 @@ -- Portability : portable -- ----- A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@,+-- A type @f@ is a Functor if it provides a function 'fmap' which, given any types @a@ and @b@, -- lets you apply any function of type @(a -> b)@ to turn an @f a@ into an @f b@, preserving the -- structure of @f@.------ ==== __Examples__------ >>> fmap show (Just 1) -- (a -> b) -> f a -> f b--- Just "1" -- (Int -> String) -> Maybe Int -> Maybe String------ >>> fmap show Nothing -- (a -> b) -> f a -> f b--- Nothing -- (Int -> String) -> Maybe Int -> Maybe String------ >>> fmap show [1,2,3] -- (a -> b) -> f a -> f b--- ["1","2","3"] -- (Int -> String) -> [Int] -> [String]------ >>> fmap show [] -- (a -> b) -> f a -> f b--- [] -- (Int -> String) -> [Int] -> [String]------ The 'fmap' function is also available as the infix operator '<$>':------ >>> fmap show (Just 1) -- (Int -> String) -> Maybe Int -> Maybe String--- Just "1"------ >>> show <$> (Just 1) -- (Int -> String) -> Maybe Int -> Maybe String--- Just "1"- module Data.Functor (Functor(..), ($>),
src/Data/Functor/Classes.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE Safe #-}@@ -78,12 +79,13 @@ import GHC.Internal.Data.Ord (Down(Down)) import Data.Complex (Complex((:+))) -import GHC.Generics (Generic1(..), Generically1(..))+import GHC.Generics (Generic1(..), Generically1(..), V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..) , (:+:)(..), (:*:)(..), (:.:)(..), URec(..), UAddr, UChar, UDouble, UFloat, UInt, UWord) import GHC.Tuple (Solo (..))-import GHC.Internal.Read (expectP, list, paren)+import GHC.Internal.Read (expectP, list, paren, readField)+import GHC.Internal.Show (appPrec) -import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)-import GHC.Internal.Text.Read (Read(..), parens, prec, step)+import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec, pfail)+import GHC.Internal.Text.Read (Read(..), parens, prec, step, reset) import GHC.Internal.Text.Read.Lex (Lexeme(..)) import GHC.Internal.Text.Show (showListWith) import Prelude@@ -1123,3 +1125,322 @@ > showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y -}++-- | @since base-4.21.0.0+instance Eq1 V1 where+ liftEq _ = \_ _ -> True++-- | @since base-4.21.0.0+instance Ord1 V1 where+ liftCompare _ = \_ _ -> EQ++-- | @since base-4.21.0.0+instance Show1 V1 where+ liftShowsPrec _ _ _ = \_ -> showString "V1"++-- | @since base-4.21.0.0+instance Read1 V1 where+ liftReadsPrec _ _ = readPrec_to_S pfail+ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance Eq1 U1 where+ liftEq _ = \_ _ -> True++-- | @since base-4.21.0.0+instance Ord1 U1 where+ liftCompare _ = \_ _ -> EQ++-- | @since base-4.21.0.0+instance Show1 U1 where+ liftShowsPrec _ _ _ = \U1 -> showString "U1"++-- | @since base-4.21.0.0+instance Read1 U1 where+ liftReadPrec _ _ =+ parens (expectP (Ident "U1") *> pure U1)++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance Eq1 Par1 where+ liftEq eq = \(Par1 a) (Par1 a') -> eq a a'++-- | @since base-4.21.0.0+instance Ord1 Par1 where+ liftCompare cmp = \(Par1 a) (Par1 a') -> cmp a a'++-- | @since base-4.21.0.0+instance Show1 Par1 where+ liftShowsPrec sp _ d = \(Par1 { unPar1 = a }) ->+ showsSingleFieldRecordWith sp "Par1" "unPar1" d a++-- | @since base-4.21.0.0+instance Read1 Par1 where+ liftReadPrec rp _ =+ readsSingleFieldRecordWith rp "Par1" "unPar1" Par1++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance Eq1 f => Eq1 (Rec1 f) where+ liftEq eq = \(Rec1 a) (Rec1 a') -> liftEq eq a a'++-- | @since base-4.21.0.0+instance Ord1 f => Ord1 (Rec1 f) where+ liftCompare cmp = \(Rec1 a) (Rec1 a') -> liftCompare cmp a a'++-- | @since base-4.21.0.0+instance Show1 f => Show1 (Rec1 f) where+ liftShowsPrec sp sl d = \(Rec1 { unRec1 = a }) ->+ showsSingleFieldRecordWith (liftShowsPrec sp sl) "Rec1" "unRec1" d a++-- | @since base-4.21.0.0+instance Read1 f => Read1 (Rec1 f) where+ liftReadPrec rp rl =+ readsSingleFieldRecordWith (liftReadPrec rp rl) "Rec1" "unRec1" Rec1++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance Eq c => Eq1 (K1 i c) where+ liftEq _ = \(K1 a) (K1 a') -> a == a'++-- | @since base-4.21.0.0+instance Ord c => Ord1 (K1 i c) where+ liftCompare _ = \(K1 a) (K1 a') -> compare a a'++-- | @since base-4.21.0.0+instance Show c => Show1 (K1 i c) where+ liftShowsPrec _ _ d = \(K1 { unK1 = a }) ->+ showsSingleFieldRecordWith showsPrec "K1" "unK1" d a++-- | @since base-4.21.0.0+instance Read c => Read1 (K1 i c) where+ liftReadPrec _ _ = readData $+ readsSingleFieldRecordWith readPrec "K1" "unK1" K1++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance Eq1 f => Eq1 (M1 i c f) where+ liftEq eq = \(M1 a) (M1 a') -> liftEq eq a a'++-- | @since base-4.21.0.0+instance Ord1 f => Ord1 (M1 i c f) where+ liftCompare cmp = \(M1 a) (M1 a') -> liftCompare cmp a a'++-- | @since base-4.21.0.0+instance Show1 f => Show1 (M1 i c f) where+ liftShowsPrec sp sl d = \(M1 { unM1 = a }) ->+ showsSingleFieldRecordWith (liftShowsPrec sp sl) "M1" "unM1" d a++-- | @since base-4.21.0.0+instance Read1 f => Read1 (M1 i c f) where+ liftReadPrec rp rl = readData $+ readsSingleFieldRecordWith (liftReadPrec rp rl) "M1" "unM1" M1++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance (Eq1 f, Eq1 g) => Eq1 (f :+: g) where+ liftEq eq = \lhs rhs -> case (lhs, rhs) of+ (L1 a, L1 a') -> liftEq eq a a'+ (R1 b, R1 b') -> liftEq eq b b'+ _ -> False++-- | @since base-4.21.0.0+instance (Ord1 f, Ord1 g) => Ord1 (f :+: g) where+ liftCompare cmp = \lhs rhs -> case (lhs, rhs) of+ (L1 _, R1 _) -> LT+ (R1 _, L1 _) -> GT+ (L1 a, L1 a') -> liftCompare cmp a a'+ (R1 b, R1 b') -> liftCompare cmp b b'++-- | @since base-4.21.0.0+instance (Show1 f, Show1 g) => Show1 (f :+: g) where+ liftShowsPrec sp sl d = \x -> case x of+ L1 a -> showsUnaryWith (liftShowsPrec sp sl) "L1" d a+ R1 b -> showsUnaryWith (liftShowsPrec sp sl) "R1" d b++-- | @since base-4.21.0.0+instance (Read1 f, Read1 g) => Read1 (f :+: g) where+ liftReadPrec rp rl = readData $+ readUnaryWith (liftReadPrec rp rl) "L1" L1 <|>+ readUnaryWith (liftReadPrec rp rl) "R1" R1++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance (Eq1 f, Eq1 g) => Eq1 (f :*: g) where+ liftEq eq = \(f :*: g) (f' :*: g') -> liftEq eq f f' && liftEq eq g g'++-- | @since base-4.21.0.0+instance (Ord1 f, Ord1 g) => Ord1 (f :*: g) where+ liftCompare cmp = \(f :*: g) (f' :*: g') -> liftCompare cmp f f' <> liftCompare cmp g g'++-- | @since base-4.21.0.0+instance (Show1 f, Show1 g) => Show1 (f :*: g) where+ liftShowsPrec sp sl d = \(a :*: b) ->+ showsBinaryOpWith+ (liftShowsPrec sp sl)+ (liftShowsPrec sp sl)+ 7+ ":*:"+ d+ a+ b++-- | @since base-4.21.0.0+instance (Read1 f, Read1 g) => Read1 (f :*: g) where+ liftReadPrec rp rl = parens $ prec 6 $+ readBinaryOpWith (liftReadPrec rp rl) (liftReadPrec rp rl) ":*:" (:*:)++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance (Eq1 f, Eq1 g) => Eq1 (f :.: g) where+ liftEq eq = \(Comp1 a) (Comp1 a') -> liftEq (liftEq eq) a a'++-- | @since base-4.21.0.0+instance (Ord1 f, Ord1 g) => Ord1 (f :.: g) where+ liftCompare cmp = \(Comp1 a) (Comp1 a') -> liftCompare (liftCompare cmp) a a'++-- | @since base-4.21.0.0+instance (Show1 f, Show1 g) => Show1 (f :.: g) where+ liftShowsPrec sp sl d = \(Comp1 { unComp1 = a }) ->+ showsSingleFieldRecordWith+ (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl))+ "Comp1"+ "unComp1"+ d+ a++-- | @since base-4.21.0.0+instance (Read1 f, Read1 g) => Read1 (f :.: g) where+ liftReadPrec rp rl = readData $+ readsSingleFieldRecordWith+ (liftReadPrec (liftReadPrec rp rl) (liftReadListPrec rp rl))+ "Comp1"+ "unComp1"+ Comp1++ liftReadListPrec = liftReadListPrecDefault+ liftReadList = liftReadListDefault++-- | @since base-4.21.0.0+instance Eq1 UAddr where+ -- NB cannot use eqAddr# because its module isn't safe+ liftEq _ = \(UAddr a) (UAddr b) -> UAddr a == UAddr b++-- | @since base-4.21.0.0+instance Ord1 UAddr where+ liftCompare _ = \(UAddr a) (UAddr b) -> compare (UAddr a) (UAddr b)++-- | @since base-4.21.0.0+instance Show1 UAddr where+ liftShowsPrec _ _ = showsPrec++-- NB no Read1 for URec (Ptr ()) because there's no Read for Ptr.++-- | @since base-4.21.0.0+instance Eq1 UChar where+ liftEq _ = \(UChar a) (UChar b) -> UChar a == UChar b++-- | @since base-4.21.0.0+instance Ord1 UChar where+ liftCompare _ = \(UChar a) (UChar b) -> compare (UChar a) (UChar b)++-- | @since base-4.21.0.0+instance Show1 UChar where+ liftShowsPrec _ _ = showsPrec++-- | @since base-4.21.0.0+instance Eq1 UDouble where+ liftEq _ = \(UDouble a) (UDouble b) -> UDouble a == UDouble b++-- | @since base-4.21.0.0+instance Ord1 UDouble where+ liftCompare _ = \(UDouble a) (UDouble b) -> compare (UDouble a) (UDouble b)++-- | @since base-4.21.0.0+instance Show1 UDouble where+ liftShowsPrec _ _ = showsPrec++-- | @since base-4.21.0.0+instance Eq1 UFloat where+ liftEq _ = \(UFloat a) (UFloat b) -> UFloat a == UFloat b++-- | @since base-4.21.0.0+instance Ord1 UFloat where+ liftCompare _ = \(UFloat a) (UFloat b) -> compare (UFloat a) (UFloat b)++-- | @since base-4.21.0.0+instance Show1 UFloat where+ liftShowsPrec _ _ = showsPrec++-- | @since base-4.21.0.0+instance Eq1 UInt where+ liftEq _ = \(UInt a) (UInt b) -> UInt a == UInt b++-- | @since base-4.21.0.0+instance Ord1 UInt where+ liftCompare _ = \(UInt a) (UInt b) -> compare (UInt a) (UInt b)++-- | @since base-4.21.0.0+instance Show1 UInt where+ liftShowsPrec _ _ = showsPrec++-- | @since base-4.21.0.0+instance Eq1 UWord where+ liftEq _ = \(UWord a) (UWord b) -> UWord a == UWord b++-- | @since base-4.21.0.0+instance Ord1 UWord where+ liftCompare _ = \(UWord a) (UWord b) -> compare (UWord a) (UWord b)++-- | @since base-4.21.0.0+instance Show1 UWord where+ liftShowsPrec _ _ = showsPrec++showsSingleFieldRecordWith :: (Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS+showsSingleFieldRecordWith sp name field d x =+ showParen (d > appPrec) $+ showString name . showString " {" . showString field . showString " = " . sp 0 x . showChar '}'++readsSingleFieldRecordWith :: ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t+readsSingleFieldRecordWith rp name field cons = parens $ prec 11 $ do+ expectP $ Ident name+ expectP $ Punc "{"+ x <- readField field $ reset rp+ expectP $ Punc "}"+ pure $ cons x++showsBinaryOpWith+ :: (Int -> a -> ShowS)+ -> (Int -> b -> ShowS)+ -> Int+ -> String+ -> Int+ -> a+ -> b+ -> ShowS+showsBinaryOpWith sp1 sp2 opPrec name d x y = showParen (d >= opPrec) $+ sp1 opPrec x . showChar ' ' . showString name . showChar ' ' . sp2 opPrec y++readBinaryOpWith+ :: ReadPrec a+ -> ReadPrec b+ -> String+ -> (a -> b -> t)+ -> ReadPrec t+readBinaryOpWith rp1 rp2 name cons =+ cons <$> step rp1 <* expectP (Symbol name) <*> step rp2
src/Data/Functor/Compose.hs view
@@ -40,6 +40,9 @@ infixr 9 `Compose` +-- $setup+-- >>> import Prelude+ -- | Right-to-left composition of functors. -- The composition of applicative functors is always applicative, -- but the composition of monads is not always a monad.
src/Data/Functor/Product.hs view
@@ -31,6 +31,9 @@ import GHC.Generics (Generic, Generic1) import Prelude +-- $setup+-- >>> import Prelude+ -- | Lifted product of functors. -- -- ==== __Examples__
src/Data/Functor/Sum.hs view
@@ -28,6 +28,9 @@ import GHC.Generics (Generic, Generic1) import Prelude +-- $setup+-- >>> import Prelude+ -- | Lifted sum of functors. -- -- ==== __Examples__
src/Data/List.hs view
@@ -26,6 +26,7 @@ singleton, null, length,+ compareLength, -- * List transformations map, reverse,@@ -83,7 +84,9 @@ stripPrefix, group, inits,+ inits1, tails,+ tails1, -- ** Predicates isPrefixOf, isSuffixOf,@@ -176,4 +179,106 @@ genericReplicate ) where +import GHC.Internal.Data.Bool (otherwise) import GHC.Internal.Data.List+import GHC.Internal.Data.List.NonEmpty (NonEmpty(..))+import GHC.Internal.Data.Ord (Ordering(..), (<), (>))+import GHC.Internal.Int (Int)+import GHC.Internal.Num ((-))+import GHC.List (build)++inits1, tails1 :: [a] -> [NonEmpty a]++-- | The 'inits1' function returns all non-empty initial segments of the+-- argument, shortest first.+--+-- @since 4.21.0.0+--+-- ==== __Laziness__+--+-- Note that 'inits1' has the following strictness property:+-- @inits1 (xs ++ _|_) = inits1 xs ++ _|_@+--+-- In particular,+-- @inits1 _|_ = _|_@+--+-- ==== __Examples__+--+-- >>> inits1 "abc"+-- ['a' :| "",'a' :| "b",'a' :| "bc"]+--+-- >>> inits1 []+-- []+--+-- inits1 is productive on infinite lists:+--+-- >>> take 3 $ inits1 [1..]+-- [1 :| [],1 :| [2],1 :| [2,3]]+inits1 [] = []+inits1 (x : xs) = map (x :|) (inits xs)++-- | \(\mathcal{O}(n)\). The 'tails1' function returns all non-empty final+-- segments of the argument, longest first.+--+-- @since 4.21.0.0+--+-- ==== __Laziness__+--+-- Note that 'tails1' has the following strictness property:+-- @tails1 _|_ = _|_@+--+-- >>> tails1 undefined+-- *** Exception: Prelude.undefined+--+-- >>> drop 1 (tails1 [undefined, 1, 2])+-- [1 :| [2],2 :| []]+--+-- ==== __Examples__+--+-- >>> tails1 "abc"+-- ['a' :| "bc",'b' :| "c",'c' :| ""]+--+-- >>> tails1 [1, 2, 3]+-- [1 :| [2,3],2 :| [3],3 :| []]+--+-- >>> tails1 []+-- []+{-# INLINABLE tails1 #-}+tails1 lst = build (\c n ->+ let tails1Go [] = n+ tails1Go (x : xs) = (x :| xs) `c` tails1Go xs+ in tails1Go lst)++-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative+-- to 'compare' ('length' @xs@) @n@. Similarly, it's better+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10@.+--+-- While 'length' would force and traverse+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),+-- 'compareLength' traverses at most @n@ elements to determine its result.+--+-- >>> compareLength [] 0+-- EQ+-- >>> compareLength [] 1+-- LT+-- >>> compareLength ['a'] 1+-- EQ+-- >>> compareLength ['a', 'b'] 1+-- GT+-- >>> compareLength [0..] 100+-- GT+-- >>> compareLength undefined (-1)+-- GT+-- >>> compareLength ('a' : undefined) 0+-- GT+--+-- @since 4.21.0.0+--+compareLength :: [a] -> Int -> Ordering+compareLength xs n+ | n < 0 = GT+ | otherwise = foldr+ (\_ f m -> if m > 0 then f (m - 1) else GT)+ (\m -> if m > 0 then LT else EQ)+ xs+ n
src/Data/List/NonEmpty.hs view
@@ -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(..)@@ -36,6 +43,7 @@ , sortWith -- :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a -- * Basic functions , length -- :: NonEmpty a -> Int+ , compareLength -- :: NonEmpty a -> Int -> Ordering , head -- :: NonEmpty a -> a , tail -- :: NonEmpty a -> [a] , last -- :: NonEmpty a -> a@@ -109,23 +117,55 @@ import qualified Prelude import Control.Applicative (Applicative (..), Alternative (many))+import qualified Data.List as List import GHC.Internal.Data.Foldable hiding (length, toList) import qualified GHC.Internal.Data.Foldable as Foldable import GHC.Internal.Data.Function (on)-import qualified GHC.Internal.Data.List as List import GHC.Internal.Data.Ord (comparing)-import GHC.Internal.Base (NonEmpty(..)) import GHC.Internal.Stack.Types (HasCallStack)+import GHC.Internal.Data.List.NonEmpty (NonEmpty (..), map, zip, zipWith) infixr 5 <| -- $setup--- >>> import Prelude (negate)+-- >>> import Prelude+-- >>> import qualified Data.List as List+-- >>> import Data.Ord (comparing) -- | Number of elements in 'NonEmpty' list. length :: NonEmpty a -> Int length (_ :| xs) = 1 + Prelude.length xs +-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative+-- to 'compare' ('length' @xs@) @n@. Similarly, it's better+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10@.+--+-- While 'length' would force and traverse+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),+-- 'compareLength' traverses at most @n@ elements to determine its result.+--+-- >>> compareLength ('a' :| []) 1+-- EQ+-- >>> compareLength ('a' :| ['b']) 3+-- LT+-- >>> compareLength (0 :| [1..]) 100+-- GT+-- >>> compareLength undefined 0+-- GT+-- >>> compareLength ('a' :| 'b' : undefined) 1+-- GT+--+-- @since 4.21.0.0+--+compareLength :: NonEmpty a -> Int -> Ordering+compareLength xs n+ | n < 1 = GT+ | otherwise = foldr+ (\_ f m -> if m > 0 then f (m - 1) else GT)+ (\m -> if m > 0 then LT else EQ)+ xs+ n+ -- | Compute n-ary logic exclusive OR operation on 'NonEmpty' list. xor :: NonEmpty Bool -> Bool xor (x :| xs) = foldr xor' x xs@@ -152,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.@@ -173,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. --@@ -187,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@@ -205,7 +247,7 @@ -- >>> sortOn fst $ (2, "world") :| [(4, "!"), (1, "Hello")] -- (1,"Hello") :| [(2,"world"),(4,"!")] ----- >>> sortOn length $ "jim" :| ["creed", "pam", "michael", "dwight", "kevin"]+-- >>> sortOn List.length ("jim" :| ["creed", "pam", "michael", "dwight", "kevin"]) -- "jim" :| ["pam","creed","kevin","dwight","michael"] -- -- ==== __Performance notes__@@ -239,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. --@@ -248,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@@ -271,15 +309,7 @@ -- -- @since 4.18 inits1 :: NonEmpty a -> NonEmpty (NonEmpty a)-inits1 =- -- fromList is an unsafe function, but this usage should be safe, since:- -- * `inits xs = [[], ..., init (init xs), init xs, xs]`- -- * If `xs` is nonempty, it follows that `inits xs` contains at least one nonempty- -- list, since `last (inits xs) = xs`.- -- * The only empty element of `inits xs` is the first one (by the definition of `inits`)- -- * Therefore, if we take all but the first element of `inits xs` i.e.- -- `tail (inits xs)`, we have a nonempty list of nonempty lists- fromList . Prelude.map fromList . List.drop 1 . List.inits . Foldable.toList+inits1 = fromList . List.inits1 . Foldable.toList -- | The 'tails' function takes a stream @xs@ and returns all the -- suffixes of @xs@, starting with the longest. The result is 'NonEmpty'@@ -299,15 +329,7 @@ -- -- @since 4.18 tails1 :: NonEmpty a -> NonEmpty (NonEmpty a)-tails1 =- -- fromList is an unsafe function, but this usage should be safe, since:- -- * `tails xs = [xs, tail xs, tail (tail xs), ..., []]`- -- * If `xs` is nonempty, it follows that `tails xs` contains at least one nonempty- -- list, since `head (tails xs) = xs`.- -- * The only empty element of `tails xs` is the last one (by the definition of `tails`)- -- * Therefore, if we take all but the last element of `tails xs` i.e.- -- `init (tails xs)`, we have a nonempty list of nonempty lists- fromList . Prelude.map fromList . List.init . List.tails . 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@@ -341,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 @@ -437,7 +459,7 @@ -- For example, in list notation: -- -- >>> group "Mississippi"--- ["M", "i", "ss", "i", "ss", "i", "pp", "i"]+-- ['M' :| "",'i' :| "",'s' :| "s",'i' :| "",'s' :| "s",'i' :| "",'p' :| "p",'i' :| ""] group :: (Foldable f, Eq a) => f a -> [NonEmpty a] group = groupBy (==) @@ -514,27 +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 'zip' function takes two streams and returns a stream of--- corresponding pairs.-zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)-zip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys---- | The 'zipWith' function generalizes 'zip'. Rather than tupling--- the elements, the elements are combined using the function--- passed as the first argument.-zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c-zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys- -- | 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.
src/Data/Monoid.hs view
@@ -24,6 +24,7 @@ -- -- The 'Sum' monoid is defined by the numerical addition operator and `0` as neutral element: --+-- >>> import Data.Int -- >>> mempty :: Sum Int -- Sum {getSum = 0} -- >>> Sum 1 <> Sum 2 <> Sum 3 <> Sum 4 :: Sum Int@@ -73,3 +74,4 @@ ) where import GHC.Internal.Data.Monoid+
src/Data/Semigroup.hs view
@@ -38,11 +38,15 @@ -- can never be empty: -- -- >>> (1 :| [])--- 1 :| [] -- equivalent to [1] but guaranteed to be non-empty.+-- 1 :| [] --+-- -- equivalent to [1] but guaranteed to be non-empty.+-- -- >>> (1 :| [2, 3, 4])--- 1 :| [2,3,4] -- equivalent to [1,2,3,4] but guaranteed to be non-empty.+-- 1 :| [2,3,4] --+-- -- equivalent to [1,2,3,4] but guaranteed to be non-empty.+-- -- Equipped with this guaranteed to be non-empty data structure, we can combine -- values using 'sconcat' and a 'Semigroup' of our choosing. We can try the 'Min' -- and 'Max' instances of 'Int' which pick the smallest, or largest number@@ -101,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@@ -112,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@@ -122,6 +127,7 @@ -- $setup -- >>> import Prelude -- >>> import Data.List.NonEmpty (NonEmpty (..))+-- >>> import GHC.Internal.Data.Semigroup.Internal -- | A generalization of 'GHC.Internal.Data.List.cycle' to an arbitrary 'Semigroup'. -- May fail to terminate for some values in some semigroups.@@ -135,7 +141,7 @@ -- Right 1 -- -- >>> cycle1 (Left 1)--- * hangs forever *+-- * Hangs forever * cycle1 :: Semigroup m => m -> m cycle1 xs = xs' where xs' = xs <> xs' @@ -143,7 +149,7 @@ -- -- ==== __Examples__ ----- > let hello = diff "Hello, "+-- >>> let hello = diff "Hello, " -- -- >>> appEndo hello "World!" -- "Hello, World!"@@ -154,8 +160,8 @@ -- >>> appEndo (mempty <> hello) "World!" -- "Hello, World!" ----- > let world = diff "World"--- > let excl = diff "!"+-- >>> let world = diff "World"+-- >>> let excl = diff "!" -- -- >>> appEndo (hello <> (world <> excl)) mempty -- "Hello, World!"@@ -171,7 +177,7 @@ -- ==== __Examples__ -- -- >>> Min 42 <> Min 3--- Min 3+-- Min {getMin = 3} -- -- >>> sconcat $ Min 1 :| [ Min n | n <- [2 .. 100]] -- Min {getMin = 1}@@ -256,7 +262,7 @@ -- ==== __Examples__ -- -- >>> Max 42 <> Max 3--- Max 42+-- Max {getMax = 42} -- -- >>> sconcat $ Max 1 :| [ Max n | n <- [2 .. 100]] -- Max {getMax = 100}@@ -335,7 +341,11 @@ fromInteger = Max . fromInteger -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be--- placed inside 'Min' and 'Max' to compute an arg min or arg max.+-- placed inside 'Min' and 'Max' to compute an arg min or arg max. In+-- the event of ties, the leftmost qualifying 'Arg' is chosen; contrast+-- with the behavior of 'minimum' and 'maximum' for many other types,+-- where ties are broken by considering elements to the left in the+-- structure to be less than elements to the right. -- -- ==== __Examples__ --@@ -392,11 +402,25 @@ instance Traversable (Arg a) where traverse f (Arg x a) = Arg x `fmap` f a --- | @since 4.9.0.0+-- |+-- Note that `Arg`'s 'Eq' instance does not satisfy extensionality:+--+-- >>> Arg 0 0 == Arg 0 1+-- True+-- >>> let f (Arg _ x) = x in f (Arg 0 0) == f (Arg 0 1)+-- False+--+-- @since 4.9.0.0 instance Eq a => Eq (Arg a b) where Arg a _ == Arg b _ = a == b --- | @since 4.9.0.0+-- |+-- Note that `Arg`'s 'Ord' instance has 'min' and 'max' implementations that+-- differ from the tie-breaking conventions of the default implementation of+-- 'min' and 'max' in class 'Ord'; 'Arg' breaks ties by favoring the first+-- argument in both functions.+--+-- @since 4.9.0.0 instance Ord a => Ord (Arg a b) where Arg a _ `compare` Arg b _ = compare a b min x@(Arg a _) y@(Arg b _)@@ -428,10 +452,10 @@ -- ==== __Examples__ -- -- >>> First 0 <> First 10--- First 0+-- First {getFirst = 0} -- -- >>> sconcat $ First 1 :| [ First n | n <- [2 ..] ]--- First 1+-- First {getFirst = 1} newtype First a = First { getFirst :: a } deriving ( Bounded -- ^ @since 4.9.0.0 , Eq -- ^ @since 4.9.0.0@@ -502,7 +526,7 @@ -- Last {getLast = 10} -- -- >>> sconcat $ Last 1 :| [ Last n | n <- [2..]]--- Last {getLast = * hangs forever *+-- * Hangs forever * newtype Last a = Last { getLast :: a } deriving ( Bounded -- ^ @since 4.9.0.0 , Eq -- ^ @since 4.9.0.0@@ -629,7 +653,7 @@ -- ==== __Examples__ -- -- >>> mtimesDefault 0 "bark"--- []+-- "" -- -- >>> mtimesDefault 3 "meow" -- "meowmeowmeow"
src/Data/Traversable.hs view
@@ -86,6 +86,13 @@ import GHC.Internal.Data.Traversable +-- $setup+-- >>> import Prelude+-- >>> import Data.Maybe+-- >>> import Data.Either+-- >>> import qualified Data.List as List+-- >>> :set -XExplicitForAll+ -- $overview -- -- #overview#@@ -201,13 +208,13 @@ -- __@a@__), the result of __@mapM g ts@__ will contain multiple structures of -- the same shape as __@ts@__: ----- prop> length (mapM g ts) == product (fmap (length . g) ts)+-- prop> List.length (mapM g ts) == List.product (fmap (List.length . g) ts) -- -- For example: ----- >>> length $ mapM (\n -> [1..n]) [1..6]+-- >>> List.length $ mapM (\n -> [1..n]) [1..6] -- 720--- >>> product $ length . (\n -> [1..n]) <$> [1..6]+-- >>> List.product $ List.length . (\n -> [1..n]) <$> [1..6] -- 720 -- -- In other words, a traversal with a function __@g :: a -> [b]@__, over an@@ -1006,14 +1013,16 @@ -- used to implicitly wrap and unwrap the @ZipList@ @newtype@ as needed, giving -- a function that operates on a list of lists: ----- >>> {-# LANGUAGE ScopedTypeVariables #-}+-- >>> :set -XScopedTypeVariables -- >>> import Control.Applicative (ZipList(..)) -- >>> import Data.Coerce (coerce) -- >>>--- >>> transpose :: forall a. [[a]] -> [[a]]--- >>> transpose = coerce (sequenceA :: [ZipList a] -> ZipList [a])--- >>>--- >>> transpose [[1,2,3],[4..],[7..]]+-- >>> :{+-- >>> let+-- >>> transpose :: forall a. [[a]] -> [[a]]+-- >>> transpose = coerce (sequenceA :: [ZipList a] -> ZipList [a])+-- >>> in transpose [[1,2,3],[4..],[7..]]+-- >>> :} -- [[1,4,7],[2,5,8],[3,6,9]] -- -- The use of [coercion](#coercion) avoids the need to explicitly wrap and
src/GHC/Base.hs view
@@ -47,7 +47,7 @@ , unpackNBytes# -- * Magic combinators- , inline, noinline, lazy, oneShot, runRW#, DataToTag(..)+ , inline, noinline, lazy, oneShot, runRW#, seq#, DataToTag(..) , WithDict(withDict) -- * Functions over 'Bool'@@ -138,20 +138,148 @@ , divModInt#, divModInt8#, divModInt16#, divModInt32# ) where -import GHC.Internal.Base-import GHC.Prim hiding (dataToTagLarge#, dataToTagSmall#, whereFrom#)- -- Hide dataToTagLarge# because it is expected to break for- -- GHC-internal reasons in the near future, and shouldn't- -- be exposed from base (not even GHC.Exts)- -- whereFrom# is similarly internal.+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+ -- GHC-internal reasons in the near future, and shouldn't+ -- be exposed from base+ dataToTagSmall#, dataToTagLarge#+ -- whereFrom# is similarly internal.+ , whereFrom#+ , isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#+ -- Don't re-export vector FMA instructions+ , fmaddFloatX4#+ , fmsubFloatX4#+ , fnmaddFloatX4#+ , fnmsubFloatX4#+ , fmaddFloatX8#+ , fmsubFloatX8#+ , fnmaddFloatX8#+ , fnmsubFloatX8#+ , fmaddFloatX16#+ , fmsubFloatX16#+ , fnmaddFloatX16#+ , fnmsubFloatX16#+ , fmaddDoubleX2#+ , fmsubDoubleX2#+ , fnmaddDoubleX2#+ , fnmsubDoubleX2#+ , fmaddDoubleX4#+ , fmsubDoubleX4#+ , fnmaddDoubleX4#+ , fnmsubDoubleX4#+ , fmaddDoubleX8#+ , fmsubDoubleX8#+ , fnmaddDoubleX8#+ , fnmsubDoubleX8#+ -- Don't re-export SIMD shuffle primops+ , shuffleDoubleX2#+ , shuffleDoubleX4#+ , shuffleDoubleX8#+ , shuffleFloatX16#+ , shuffleFloatX4#+ , shuffleFloatX8#+ , shuffleInt16X16#+ , shuffleInt16X32#+ , shuffleInt16X8#+ , shuffleInt32X16#+ , shuffleInt32X4#+ , shuffleInt32X8#+ , shuffleInt64X2#+ , shuffleInt64X4#+ , shuffleInt64X8#+ , shuffleInt8X16#+ , shuffleInt8X32#+ , shuffleInt8X64#+ , shuffleWord16X16#+ , shuffleWord16X32#+ , shuffleWord16X8#+ , shuffleWord32X16#+ , shuffleWord32X4#+ , shuffleWord32X8#+ , shuffleWord64X2#+ , shuffleWord64X4#+ , shuffleWord64X8#+ , shuffleWord8X16#+ , shuffleWord8X32#+ , shuffleWord8X64#+ -- Don't re-export min/max primops+ , maxDouble#+ , maxDoubleX2#+ , maxDoubleX4#+ , maxDoubleX8#+ , maxFloat#+ , maxFloatX16#+ , maxFloatX4#+ , maxFloatX8#+ , maxInt16X16#+ , maxInt16X32#+ , maxInt16X8#+ , maxInt32X16#+ , maxInt32X4#+ , maxInt32X8#+ , maxInt64X2#+ , maxInt64X4#+ , maxInt64X8#+ , maxInt8X16#+ , maxInt8X32#+ , maxInt8X64#+ , maxWord16X16#+ , maxWord16X32#+ , maxWord16X8#+ , maxWord32X16#+ , maxWord32X4#+ , maxWord32X8#+ , maxWord64X2#+ , maxWord64X4#+ , maxWord64X8#+ , maxWord8X16#+ , maxWord8X32#+ , maxWord8X64#+ , minDouble#+ , minDoubleX2#+ , minDoubleX4#+ , minDoubleX8#+ , minFloat#+ , minFloatX16#+ , minFloatX4#+ , minFloatX8#+ , minInt16X16#+ , minInt16X32#+ , minInt16X8#+ , minInt32X16#+ , minInt32X4#+ , minInt32X8#+ , minInt64X2#+ , minInt64X4#+ , minInt64X8#+ , minInt8X16#+ , minInt8X32#+ , minInt8X64#+ , minWord16X16#+ , minWord16X32#+ , minWord16X8#+ , minWord32X16#+ , minWord32X4#+ , minWord32X8#+ , minWord64X2#+ , minWord64X4#+ , minWord64X8#+ , minWord8X16#+ , minWord8X32#+ , minWord8X64#+ ) import GHC.Prim.Ext import GHC.Prim.PtrEq import GHC.Internal.Err+import GHC.Internal.IO (seq#) import GHC.Internal.Maybe import GHC.Types hiding ( Unit#,- Solo#,+ Solo#(..), Tuple0#, Tuple1#, Tuple2#,
src/GHC/Desugar.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK not-home #-} +----------------------------------------------------------------------------- -- | -- -- Module : GHC.Desugar@@ -8,7 +10,7 @@ -- License : see libraries/base/LICENSE -- -- Maintainer : ghc-devs@haskell.org--- Stability : internal+-- Stability : deprecated (<https://github.com/haskell/core-libraries-committee/issues/216>) -- Portability : non-portable (GHC extensions) -- -- Support code for desugaring in GHC@@ -18,11 +20,14 @@ -- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can -- change rapidly without much warning. --+----------------------------------------------------------------------------- +#if __GLASGOW_HASKELL >= 914+#error "GHC.Desugar should be removed in GHC 9.14"+#endif+ module GHC.Desugar- ((>>>),- AnnotationWrapper(..),- toAnnotationWrapper- ) where+ {-# DEPRECATED ["GHC.Desugar is deprecated and will be removed in GHC 9.14.", "(>>>) should be imported from Control.Arrow.", "AnnotationWrapper is internal to GHC and should not be used externally."] #-}+ ((>>>), AnnotationWrapper(..), toAnnotationWrapper) where import GHC.Internal.Desugar
src/GHC/Exception.hs view
@@ -44,7 +44,7 @@ -- * Reexports -- Re-export CallStack and SrcLoc from GHC.Types , CallStack, fromCallSiteList, getCallStack, prettyCallStack- , prettyCallStackLines, showCCSStack+ , prettyCallStackLines , SrcLoc(..), prettySrcLoc ) where
− src/GHC/ExecutionStack/Internal.hs
@@ -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 (- -- * Internal- Location (..)- , SrcLoc (..)- , StackTrace- , stackFrames- , stackDepth- , collectStackTrace- , showStackFrames- , invalidateDebugCache- ) where--import GHC.Internal.ExecutionStack.Internal
src/GHC/Exts.hs view
@@ -49,7 +49,6 @@ sameMVar#, sameMutVar#, sameTVar#,- sameIOPort#, samePromptTag#, -- ** Compat wrapper atomicModifyMutVar#,@@ -93,6 +92,7 @@ lazy, oneShot, considerAccessible,+ seq#, -- * SpecConstr annotations SpecConstrAnnotation(..), SPEC(..),@@ -114,12 +114,139 @@ import GHC.Internal.Exts import GHC.Internal.ArrayArray-import GHC.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# )+import GHC.Prim hiding+ ( coerce -- Hide dataToTag# ops because they are expected to break for -- GHC-internal reasons in the near future, and shouldn't -- be exposed from base (not even GHC.Exts)- -- whereFrom# is similarly internal.+ , dataToTagSmall#, dataToTagLarge#+ -- whereFrom# is similarly internal.+ , whereFrom#+ , isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned# + -- Don't re-export vector FMA instructions+ , fmaddFloatX4#+ , fmsubFloatX4#+ , fnmaddFloatX4#+ , fnmsubFloatX4#+ , fmaddFloatX8#+ , fmsubFloatX8#+ , fnmaddFloatX8#+ , fnmsubFloatX8#+ , fmaddFloatX16#+ , fmsubFloatX16#+ , fnmaddFloatX16#+ , fnmsubFloatX16#+ , fmaddDoubleX2#+ , fmsubDoubleX2#+ , fnmaddDoubleX2#+ , fnmsubDoubleX2#+ , fmaddDoubleX4#+ , fmsubDoubleX4#+ , fnmaddDoubleX4#+ , fnmsubDoubleX4#+ , fmaddDoubleX8#+ , fmsubDoubleX8#+ , fnmaddDoubleX8#+ , fnmsubDoubleX8#+ -- Don't re-export SIMD shuffle primops+ , shuffleDoubleX2#+ , shuffleDoubleX4#+ , shuffleDoubleX8#+ , shuffleFloatX16#+ , shuffleFloatX4#+ , shuffleFloatX8#+ , shuffleInt16X16#+ , shuffleInt16X32#+ , shuffleInt16X8#+ , shuffleInt32X16#+ , shuffleInt32X4#+ , shuffleInt32X8#+ , shuffleInt64X2#+ , shuffleInt64X4#+ , shuffleInt64X8#+ , shuffleInt8X16#+ , shuffleInt8X32#+ , shuffleInt8X64#+ , shuffleWord16X16#+ , shuffleWord16X32#+ , shuffleWord16X8#+ , shuffleWord32X16#+ , shuffleWord32X4#+ , shuffleWord32X8#+ , shuffleWord64X2#+ , shuffleWord64X4#+ , shuffleWord64X8#+ , shuffleWord8X16#+ , shuffleWord8X32#+ , shuffleWord8X64#+ -- Don't re-export min/max primops+ , maxDouble#+ , maxDoubleX2#+ , maxDoubleX4#+ , maxDoubleX8#+ , maxFloat#+ , maxFloatX16#+ , maxFloatX4#+ , maxFloatX8#+ , maxInt16X16#+ , maxInt16X32#+ , maxInt16X8#+ , maxInt32X16#+ , maxInt32X4#+ , maxInt32X8#+ , maxInt64X2#+ , maxInt64X4#+ , maxInt64X8#+ , maxInt8X16#+ , maxInt8X32#+ , maxInt8X64#+ , maxWord16X16#+ , maxWord16X32#+ , maxWord16X8#+ , maxWord32X16#+ , maxWord32X4#+ , maxWord32X8#+ , maxWord64X2#+ , maxWord64X4#+ , maxWord64X8#+ , maxWord8X16#+ , maxWord8X32#+ , maxWord8X64#+ , minDouble#+ , minDoubleX2#+ , minDoubleX4#+ , minDoubleX8#+ , minFloat#+ , minFloatX16#+ , minFloatX4#+ , minFloatX8#+ , minInt16X16#+ , minInt16X32#+ , minInt16X8#+ , minInt32X16#+ , minInt32X4#+ , minInt32X8#+ , minInt64X2#+ , minInt64X4#+ , minInt64X8#+ , minInt8X16#+ , minInt8X32#+ , minInt8X64#+ , minWord16X16#+ , minWord16X32#+ , minWord16X8#+ , minWord32X16#+ , minWord32X4#+ , minWord32X8#+ , minWord64X2#+ , minWord64X4#+ , minWord64X8#+ , minWord8X16#+ , minWord8X32#+ , minWord8X64#+ )+ import GHC.Prim.Ext import GHC.Types hiding (@@ -128,7 +255,7 @@ -- GHC's internal representation of 'TyCon's, for 'Typeable' Module, TrName, TyCon, TypeLitSort, KindRep, KindBndr, Unit#,- Solo#,+ Solo#(..), Tuple0#, Tuple1#, Tuple2#,
src/GHC/IO/Encoding/Iconv.hs view
@@ -27,5 +27,4 @@ #else ( ) where -import Prelude () -- for build ordering (#23942) #endif
src/GHC/IO/Handle.hs view
src/GHC/IO/StdHandles.hs view
− src/GHC/IOPort.hs
@@ -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
src/GHC/JS/Prim/Internal/Build.hs view
@@ -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
+ src/GHC/Num/BigNat.hs view
@@ -0,0 +1,6 @@+module GHC.Num.BigNat+ ( module GHC.Internal.Bignum.BigNat+ )+where++import GHC.Internal.Bignum.BigNat
+ src/GHC/Num/Integer.hs view
@@ -0,0 +1,6 @@+module GHC.Num.Integer+ ( module GHC.Internal.Bignum.Integer+ )+where++import GHC.Internal.Bignum.Integer
+ src/GHC/Num/Natural.hs view
@@ -0,0 +1,6 @@+module GHC.Num.Natural+ ( module GHC.Internal.Bignum.Natural+ )+where++import GHC.Internal.Bignum.Natural
− src/GHC/Pack.hs
@@ -1,37 +0,0 @@-{-# LANGUAGE MagicHash #-}-{-# OPTIONS_HADDOCK not-home #-}---- |------ Module : GHC.Pack--- Copyright : (c) The University of Glasgow 1997-2002--- License : see libraries/base/LICENSE------ Maintainer : ghc-devs@haskell.org--- Stability : internal--- Portability : non-portable (GHC Extensions)------ ⚠ Warning: Starting @base-4.18@, this module is being deprecated.--- See https://gitlab.haskell.org/ghc/ghc/-/issues/21461 for more information.------------ This module provides a small set of low-level functions for packing--- and unpacking a chunk of bytes. Used by code emitted by the compiler--- plus the prelude libraries.------ The programmer level view of packed strings is provided by a GHC--- system library PackedString.-----module GHC.Pack- {-# DEPRECATED "The exports of this module should be instead imported from GHC.Exts" #-}- (packCString#,- unpackCString,- unpackCString#,- unpackNBytes#,- unpackFoldrCString#,- unpackAppendCString#- ) where--import GHC.Internal.Pack
src/GHC/RTS/Flags.hs view
@@ -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@@ -25,6 +29,7 @@ , GCFlags (..) , ConcFlags (..) , MiscFlags (..)+ , IoManagerFlag (..) , DebugFlags (..) , DoCostCentres (..) , CCFlags (..)@@ -35,12 +40,12 @@ , TickyFlags (..) , ParFlags (..) , HpcFlags (..)- , IoSubSystem (..)+ , {-# DEPRECATED "import GHC.IO.SubSystem (IoSubSystem (..))" #-}+ IoSubSystem (..) , getRTSFlags , getGCFlags , getConcFlags , getMiscFlags- , getIoManagerFlag , getDebugFlags , getCCFlags , getProfFlags@@ -50,4 +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 @<program>.tix@ file is read at+ -- the start of execution to initialize the RTS internal+ -- HPC datastructures.+ , writeTixFile :: Bool+ -- ^ Controls whether the @<program>.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
src/GHC/Records.hs view
@@ -11,10 +11,11 @@ -- Portability : non-portable (GHC extensions) -- -- This module defines the 'HasField' class used by the--- @OverloadedRecordFields@ extension. See the--- <https://gitlab.haskell.org/ghc/ghc/wikis/records/overloaded-record-fields--- wiki page> 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(..)
src/GHC/Stack/CloneStack.hs view
@@ -17,3 +17,4 @@ ) where import GHC.Internal.Stack.CloneStack+import GHC.Internal.Stack.Decode
src/GHC/Stats.hs view
@@ -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
− src/GHC/TypeLits/Internal.hs
@@ -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- (Symbol,- CmpSymbol,- CmpChar- ) where--import GHC.Internal.TypeLits.Internal
− src/GHC/TypeNats/Internal.hs
@@ -1,9 +0,0 @@-{-# LANGUAGE Safe #-}-{-# OPTIONS_HADDOCK not-home #-}--module GHC.TypeNats.Internal- (Natural,- CmpNat- ) where--import GHC.Internal.TypeNats.Internal
src/GHC/Weak/Finalize.hs view
@@ -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 <https://github.com/haskell/core-libraries-committee/issues/342>+--+runFinalizerBatch :: Int+ -> Array# (State# RealWorld -> State# RealWorld)+ -> IO ()+runFinalizerBatch = GHC.Internal.Weak.Finalize.runFinalizerBatch
src/System/CPUTime/Windows.hsc view
@@ -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
src/System/IO.hs view
@@ -14,7 +14,10 @@ -- module System.IO- (-- * The IO monad+ (-- * Examples+ -- $stdio_examples++ -- * The IO monad IO, fixIO, -- * Files and handles@@ -199,3 +202,18 @@ -- It follows that an attempt to write to a file (using 'writeFile', for -- example) that was earlier opened by 'readFile' will usually result in -- failure with 'GHC.Internal.System.IO.Error.isAlreadyInUseError'.++-- $stdio_examples+-- Note: Some of the examples in this module do not work "as is" in ghci.+-- This is because using 'stdin' in combination with lazy IO+-- does not work well in interactive mode.+--+-- Lines starting with @>@ indicate 'stdin' and @^D@ signales EOF.+--+-- ==== __Example__+--+-- ghci> foo+-- > input+-- output+-- > input^D+-- output
src/System/Timeout.hs view
@@ -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))