[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add firstA and secondA to Data.Bitraversable
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jun 6 11:59:29 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
7c173310 by Georgi Lyubenov at 2024-06-05T15:17:22-04:00
Add firstA and secondA to Data.Bitraversable
Please see https://github.com/haskell/core-libraries-committee/issues/172
for related discussion
- - - - -
3b6f9fd1 by Ben Gamari at 2024-06-05T15:17:59-04:00
base: Fix name of changelog
Fixes #24899. Also place it under `extra-doc-files` to better reflect
its nature and avoid triggering unnecessary recompilation if it
changes.
- - - - -
1f4d2ef7 by Sebastian Graf at 2024-06-05T15:18:34-04:00
Announce Or-patterns in the release notes for GHC 9.12 (#22596)
Leftover from !9229.
- - - - -
3d8ecd2e by Jan Hrček at 2024-06-06T07:59:16-04:00
Improve haddocks of Language.Haskell.Syntax.Pat.Pat
- - - - -
058a7c77 by Cheng Shao at 2024-06-06T07:59:16-04:00
testsuite: bump T7653 timeout for wasm
- - - - -
10 changed files:
- compiler/Language/Haskell/Syntax/Pat.hs
- docs/users_guide/9.12.1-notes.rst
- libraries/base/base.cabal
- libraries/base/changelog.md
- libraries/base/src/Data/Bitraversable.hs
- libraries/base/tests/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
Changes:
=====================================
compiler/Language/Haskell/Syntax/Pat.hs
=====================================
@@ -57,62 +57,73 @@ import Data.List.NonEmpty (NonEmpty)
type LPat p = XRec p (Pat p)
-- | Pattern
---
--- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'
-
--- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data Pat p
= ------------ Simple patterns ---------------
- WildPat (XWildPat p) -- ^ Wildcard Pattern
- -- The sole reason for a type on a WildPat is to
- -- support hsPatType :: Pat Id -> Type
-
- -- AZ:TODO above comment needs to be updated
+ WildPat (XWildPat p)
+ -- ^ Wildcard Pattern (@_@)
| VarPat (XVarPat p)
- (LIdP p) -- ^ Variable Pattern
+ (LIdP p)
+ -- ^ Variable Pattern, e.g. @x@
- -- See Note [Located RdrNames] in GHC.Hs.Expr
+ -- See Note [Located RdrNames] in GHC.Hs.Expr
| LazyPat (XLazyPat p)
- (LPat p) -- ^ Lazy Pattern
- -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde'
+ (LPat p)
+ -- ^ Lazy Pattern, e.g. @~x@
+ --
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde'
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| AsPat (XAsPat p)
(LIdP p)
- (LPat p) -- ^ As pattern
- -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt'
+ (LPat p)
+ -- ^ As pattern, e.g. @x\@pat@
+ --
+ -- - Location of '@' is captured by 'GHC.Parser.Annotation.EpToken' @"\@"@
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ParPat (XParPat p)
- (LPat p) -- ^ Parenthesised pattern
- -- See Note [Parens in HsSyn] in GHC.Hs.Expr
- -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
- -- 'GHC.Parser.Annotation.AnnClose' @')'@
+ (LPat p)
+ -- ^ Parenthesised pattern, e.g. @(x)@
+ --
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen' @'('@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
+
+ -- See Note [Parens in HsSyn] in GHC.Hs.Expr
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| BangPat (XBangPat p)
- (LPat p) -- ^ Bang pattern
- -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'
+ (LPat p)
+ -- ^ Bang pattern, e.g. @!x@
+ --
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
------------ Lists, tuples, arrays ---------------
| ListPat (XListPat p)
[LPat p]
+ -- ^ Syntactic List, e.g. @[x]@ or @[x,y]@ (but not @[]@ nor @(x:xs)@ which are represented using 'ConPat')
+ --
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen' @'['@,
+ -- 'GHC.Parser.Annotation.AnnClose' @']'@
- -- ^ Syntactic List
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
+
+ | -- | Tuple pattern, e.g. @(x, y)@
--
- -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
- -- 'GHC.Parser.Annotation.AnnClose' @']'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen' @'('@ or @'(#'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@ or @'#)'@
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
+ TuplePat (XTuplePat p) -- ^ After typechecking, holds the types of the tuple components
+ [LPat p] -- ^ Tuple sub-patterns
+ Boxity -- ^ UnitPat is TuplePat []
- | TuplePat (XTuplePat p)
- -- after typechecking, holds the types of the tuple components
- [LPat p] -- Tuple sub-patterns
- Boxity -- UnitPat is TuplePat []
-- You might think that the post typechecking Type was redundant,
-- because we can get the pattern type by getting the types of the
-- sub-patterns.
@@ -129,11 +140,6 @@ data Pat p
-- of the tuple is of type 'a' not Int. See selectMatchVar
-- (June 14: I'm not sure this comment is right; the sub-patterns
-- will be wrapped in CoPats, no?)
- -- ^ Tuple sub-patterns
- --
- -- - 'GHC.Parser.Annotation.AnnKeywordId' :
- -- 'GHC.Parser.Annotation.AnnOpen' @'('@ or @'(#'@,
- -- 'GHC.Parser.Annotation.AnnClose' @')'@ or @'#)'@
| OrPat (XOrPat p)
(NonEmpty (LPat p))
@@ -143,7 +149,8 @@ data Pat p
(LPat p) -- Sum sub-pattern
ConTag -- Alternative (one-based)
SumWidth -- Arity (INVARIANT: ≥ 2)
- -- ^ Anonymous sum pattern
+
+ -- ^ Anonymous sum pattern, e.g. @(# x | #)@. Used by @-XUnboxedSums@
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' :
-- 'GHC.Parser.Annotation.AnnOpen' @'(#'@,
@@ -157,35 +164,40 @@ data Pat p
pat_con :: XRec p (ConLikeP p),
pat_args :: HsConPatDetails p
}
- -- ^ Constructor Pattern
+ -- ^ Constructor Pattern, e.g. @[]@ or @Nothing@
------------ View patterns ---------------
- -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'
- -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ViewPat (XViewPat p)
(LHsExpr p)
(LPat p)
- -- ^ View Pattern
+ -- ^ View Pattern, e.g. @someFun -> pat at . Used by @-XViewPatterns@
+ --
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'
+
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
------------ Pattern splices ---------------
- -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@
- -- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| SplicePat (XSplicePat p)
- (HsUntypedSplice p) -- ^ Splice Pattern (Includes quasi-quotes)
+ (HsUntypedSplice p)
+ -- ^ Splice Pattern (Includes quasi-quotes @$(...)@)
+ --
+ -- - 'GHC.Parser.Annotation.AnnKeywordId':
+ -- 'GHC.Parser.Annotation.AnnOpen' @'$('@
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
+
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
------------ Literal and n+k patterns ---------------
| LitPat (XLitPat p)
- (HsLit p) -- ^ Literal Pattern
- -- Used for *non-overloaded* literal patterns:
- -- Int#, Char#, Int, Char, String, etc.
-
- | NPat -- Natural Pattern
- -- Used for all overloaded literals,
- -- including overloaded strings with -XOverloadedStrings
- (XNPat p) -- Overall type of pattern. Might be
+ (HsLit p)
+ -- ^ Literal Pattern
+ --
+ -- Used for __non-overloaded__ literal patterns:
+ -- Int#, Char#, Int, Char, String, etc.
+
+ | NPat (XNPat p) -- Overall type of pattern. Might be
-- different than the literal's type
-- if (==) or negate changes the type
(XRec p (HsOverLit p)) -- ALWAYS positive
@@ -194,7 +206,8 @@ data Pat p
-- otherwise
(SyntaxExpr p) -- Equality checker, of type t->t->Bool
- -- ^ Natural Pattern
+ -- ^ Natural Pattern, used for all overloaded literals, including overloaded Strings
+ -- with @-XOverloadedStrings@
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVal' @'+'@
@@ -208,30 +221,35 @@ data Pat p
(SyntaxExpr p) -- (>=) function, of type t1->t2->Bool
(SyntaxExpr p) -- Name of '-' (see GHC.Rename.Env.lookupSyntax)
- -- ^ n+k pattern
+ -- ^ n+k pattern, e.g. @n+1@, enabled by @-XNPlusKPatterns@ extension
------------ Pattern type signatures ---------------
- -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| SigPat (XSigPat p) -- After typechecker: Type
(LPat p) -- Pattern with a type signature
(HsPatSigType (NoGhcTc p)) -- Signature can bind both
-- kind and type vars
- -- ^ Pattern with a type signature
+ -- ^ Pattern with a type signature, e.g. @x :: Int@
+ --
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
+
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
- -- Embed the syntax of types into patterns.
- -- Used with RequiredTypeArguments, e.g. fn (type t) = rhs
- | EmbTyPat (XEmbTyPat p)
+ | -- | Embed the syntax of types into patterns.
+ -- Used with @-XRequiredTypeArguments@, e.g. @fn (type t) = rhs@
+ EmbTyPat (XEmbTyPat p)
(HsTyPat (NoGhcTc p))
- -- See Note [Invisible binders in functions] in GHC.Hs.Pat
| InvisPat (XInvisPat p) (HsTyPat (NoGhcTc p))
+ -- ^ Type abstraction which brings into scope type variables associated with invisible forall. Used by @-XTypeAbstractions at .
+ --
+ -- The location of @\@@ is captured by 'GHC.Parser.Annotation.EpToken' @"\@"@
+
+ -- See Note [Invisible binders in functions] in GHC.Hs.Pat
- -- Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension
- | XPat
- !(XXPat p)
+ | -- | TTG Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension
+ XPat !(XXPat p)
type family ConLikeP x
@@ -311,7 +329,7 @@ type HsRecUpdField p q = HsFieldBind (LAmbiguousFieldOcc p) (LHsExpr q)
-- | Haskell Field Binding
--
--- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual',
+-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'
--
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data HsFieldBind lhs rhs = HsFieldBind {
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -11,6 +11,8 @@ for specific guidance on migrating programs to this release.
Language
~~~~~~~~
+- New language extension: :extension:`OrPatterns` implements `GHC Proposal #522
+ <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0522-or-patterns.rst>`_).
- The ordering of variables used for visible type application has been changed in two cases.
It is supposed to be left-to-right, but due to an oversight, it was wrong:
=====================================
libraries/base/base.cabal
=====================================
@@ -19,8 +19,8 @@ description: Haskell's base library provides, among other things, core types
[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:
- CHANGELOG.md
+extra-doc-files:
+ changelog.md
Library
default-language: Haskell2010
=====================================
libraries/base/changelog.md
=====================================
@@ -6,6 +6,7 @@
* 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 `firstA` and `secondA` to `Data.Bitraversable`. ([CLC proposal #172](https://github.com/haskell/core-libraries-committee/issues/172))
## 4.20.0.0 *TBA*
* Deprecate `GHC.Pack` ([#21461](https://gitlab.haskell.org/ghc/ghc/-/issues/21461))
=====================================
libraries/base/src/Data/Bitraversable.hs
=====================================
@@ -18,6 +18,8 @@ module Data.Bitraversable
, bisequenceA
, bisequence
, bimapM
+ , firstA
+ , secondA
, bifor
, biforM
, bimapAccumL
@@ -172,6 +174,60 @@ bimapM = bitraverse
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
=====================================
libraries/base/tests/all.T
=====================================
@@ -189,6 +189,7 @@ test('CatEntail', normal, compile, [''])
# When running with WAY=ghci and profiled ways, T7653 uses a lot of memory.
test('T7653', [when(opsys('mingw32'), skip),
+ when(arch('wasm32'), run_timeout_multiplier(5)),
omit_ways(prof_ways + ghci_ways)], compile_and_run, [''])
test('T7787', normal, compile_and_run, [''])
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -679,6 +679,8 @@ module Data.Bitraversable where
bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
+ firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b)
+ secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c)
module Data.Bits where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -679,6 +679,8 @@ module Data.Bitraversable where
bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
+ firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b)
+ secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c)
module Data.Bits where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -679,6 +679,8 @@ module Data.Bitraversable where
bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
+ firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b)
+ secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c)
module Data.Bits where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -679,6 +679,8 @@ module Data.Bitraversable where
bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b)
+ firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b)
+ secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c)
module Data.Bits where
-- Safety: Safe
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6940e46a2ee323966b66a9d01b53f6bddd59eb0...058a7c774aee9eb53563c110e88795d499874cf8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6940e46a2ee323966b66a9d01b53f6bddd59eb0...058a7c774aee9eb53563c110e88795d499874cf8
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240606/9ea45549/attachment-0001.html>
More information about the ghc-commits
mailing list