Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 31fa1412 by Simon Jakobi at 2026-05-23T16:01:06-04:00 Implement List.elem via foldr ...in order to allow specialization to Eq instances. The implementation of notElem is updated for consistency.` Corresponding CLC proposal: https://github.com/haskell/core-libraries-committee/issues/412 Addresses #27096. - - - - - 999f4b0c by Alan Zimmerman at 2026-05-23T16:01:07-04:00 EPA: Fix span for qualified multiline string Fix the span for a qualified multiline string like Text.""" I'm a multiline Text value ! """ to extend to the end of the entire string, not just the first line. Closes #27274 - - - - - e79ae377 by Alan Zimmerman at 2026-05-23T16:01:07-04:00 EPA: Fix exact printing namespace-specified wildcards Ensures correct printing of imports of the form import Data.Bool (data True(data ..)) import Data.Bool (data True(type ..)) Closes #27291 - - - - - d050864d by Mrjtjmn at 2026-05-23T16:01:14-04:00 Fix ambiguous syntax of BangPatterns in users guide Update documentation for the BangPatterns extension to specify how surrounding whitespace affects interpretation of `!`. * Only when there is whitespace before `!` and no whitespace after, it is recognized as a BangPattern. * Other cases `⟨varid⟩!⟨varid⟩`, `⟨varid⟩ ! ⟨varid⟩`, `⟨varid⟩! ⟨varid⟩` are treated as infix operators. - - - - - 12 changed files: - + changelog.d/elem-via-foldr-27096 - compiler/GHC/Parser/Lexer.x - docs/users_guide/exts/stolen_syntax.rst - libraries/base/changelog.md - libraries/base/tests/perf/ElemNoFusion_O1.stderr - libraries/base/tests/perf/ElemNoFusion_O2.stderr - libraries/ghc-internal/src/GHC/Internal/List.hs - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprQualifiedStrings.hs - + testsuite/tests/printer/Test27291.hs - testsuite/tests/printer/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== changelog.d/elem-via-foldr-27096 ===================================== @@ -0,0 +1,4 @@ +section: base +synopsis: Reimplement ``Data.List.elem`` and ``notElem`` using ``foldr`` to enable better specialization. +issues: #27096 +mrs: !15793 ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -2274,8 +2274,9 @@ tok_quoted_label span buf len _buf2 = do tok_qstrings :: Action -> Action tok_qstrings lex_str span0 buf0 len0 endBuf0 = do let modName = ModuleName $ lexemeToFastString buf0 modNameLen - (src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 - pure $ L span0 $ ITstring src meta{strMetaQualified = Just modName} s + (span1, src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 + let span2 = mkPsSpan (psSpanStart span0) (psSpanEnd span1) + pure $ L span2 $ ITstring src meta{strMetaQualified = Just modName} s where -- The buffer/span starting at the string literal (strBuf, strSpanStart) = @@ -2298,7 +2299,7 @@ tok_qstrings lex_str span0 buf0 len0 endBuf0 = do strSpan = mkPsSpan strSpanStart (psSpanEnd span0) unITstring = \case - L _ (ITstring src meta s) -> (src, meta, s) + L span1 (ITstring src meta s) -> (span1, src, meta, s) tok -> panic $ "tok_qstrings got unexpected token: " ++ show tok tok_char :: Action ===================================== docs/users_guide/exts/stolen_syntax.rst ===================================== @@ -50,7 +50,7 @@ The following syntax is stolen: Stolen by: :extension:`Arrows` -``?varid`` +``?⟨varid⟩`` .. index:: single: implicit parameters @@ -77,17 +77,20 @@ The following syntax is stolen: Stolen by: :extension:`QuasiQuotes` -⟨varid⟩``#``, ⟨char⟩``#``, ⟨string⟩``#``, ⟨integer⟩``#``, ⟨float⟩``#``, ⟨float⟩``##`` +``⟨varid⟩#``, ``⟨char⟩#``, ``⟨string⟩#``, ``⟨integer⟩#``, ``⟨float⟩#``, ``⟨float⟩##`` Stolen by: :extension:`MagicHash` -⟨integer⟩, ``#(Int|Word)(8|16|32|64)?`` +``⟨integer⟩#(Int|Word)(8|16|32|64)?`` Stolen by: :extension:`ExtendedLiterals` ``(#``, ``#)`` Stolen by: :extension:`UnboxedTuples` -⟨varid⟩, ``!``, ⟨varid⟩ - Stolen by: :extension:`BangPatterns` +``⟨varid⟩ !⟨varid⟩`` + Stolen by: :extension:`BangPatterns`. Only when there are whitespaces before + ``!`` and no whitespace after ``!``, it is interpreted as :extension:`BangPatterns`. Other + cases such as ``⟨varid⟩!⟨varid⟩``, ``⟨varid⟩ ! ⟨varid⟩``, and ``⟨varid⟩! ⟨varid⟩``, are + interpreted as infix operators. ``pattern`` Stolen by: :extension:`PatternSynonyms` ===================================== libraries/base/changelog.md ===================================== @@ -2,6 +2,7 @@ ## 4.24.0.0 *TBA* * Add `Bounded` instances for `Double`, `Float`, `CDouble` and `CFloat`. ([CLC proposal #402](https://github.com/haskell/core-libraries-committee/issues/402)) + * Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412)) ## 4.23.0.0 *TBA* * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370)) ===================================== libraries/base/tests/perf/ElemNoFusion_O1.stderr ===================================== @@ -1,5 +1,38 @@ -noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) +noFusionElemSort + = \ x x1 -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case x of { I# x2 -> + case y of { I# y1 -> + case ==# x2 y1 of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + } + }; } in + jump go1 (actualSort gtInt x1) noFusionElemNonEmptyToList - = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + = \ x x1 -> + case x1 of { :| a1 as -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case x of { I# x2 -> + case y of { I# y1 -> + case ==# x2 y1 of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + } + }; } in + jump go1 (: a1 as) + } ===================================== libraries/base/tests/perf/ElemNoFusion_O2.stderr ===================================== @@ -1,5 +1,54 @@ -noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) +noFusionElemSort + = \ x x1 -> + case actualSort gtInt x1 of { + [] -> False; + : y ys -> + case x of { I# x2 -> + case y of { I# y1 -> + case ==# x2 y1 of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y2 ys1 -> + case y2 of { I# y3 -> + case ==# x2 y3 of { + __DEFAULT -> jump go1 ys1; + 1# -> True + } + } + }; } in + jump go1 ys; + 1# -> True + } + } + } + } noFusionElemNonEmptyToList - = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + = \ x x1 -> + case x1 of { :| a1 as -> + case x of { I# x2 -> + case a1 of { I# y -> + case ==# x2 y of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y1 ys -> + case y1 of { I# y2 -> + case ==# x2 y2 of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + }; } in + jump go1 as; + 1# -> True + } + } + } + } ===================================== libraries/ghc-internal/src/GHC/Internal/List.hs ===================================== @@ -1517,14 +1517,9 @@ all p (x:xs) = p x && all p xs -- -- >>> 3 `elem` [4..] -- * Hangs forever * -elem :: (Eq a) => a -> [a] -> Bool -elem _ [] = False -elem x (y:ys) = x==y || elem x ys -{-# NOINLINE [1] elem #-} -{-# RULES -"elem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b) - . elem x (build g) = g (\ y r -> (x == y) || r) False - #-} +elem :: Eq a => a -> [a] -> Bool +elem x = foldr (\y r -> x == y || r) False +{-# INLINE elem #-} -- | 'notElem' is the negation of 'elem'. -- @@ -1544,14 +1539,9 @@ elem x (y:ys) = x==y || elem x ys -- -- >>> 3 `notElem` [4..] -- * Hangs forever * -notElem :: (Eq a) => a -> [a] -> Bool -notElem _ [] = True -notElem x (y:ys)= x /= y && notElem x ys -{-# NOINLINE [1] notElem #-} -{-# RULES -"notElem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b) - . notElem x (build g) = g (\ y r -> (x /= y) && r) True - #-} +notElem :: Eq a => a -> [a] -> Bool +notElem x = foldr (\y r -> x /= y && r) True +{-# INLINE notElem #-} -- | \(\mathcal{O}(n)\). 'lookup' @key assocs@ looks up a key in an association -- list. ===================================== testsuite/tests/printer/Makefile ===================================== @@ -907,6 +907,11 @@ Test25885: $(CHECK_PPR) $(LIBDIR) Test25885.hs $(CHECK_EXACT) $(LIBDIR) Test25885.hs +.PHONY: Test27291 +Test27291: + $(CHECK_PPR) $(LIBDIR) Test27291.hs + $(CHECK_EXACT) $(LIBDIR) Test27291.hs + .PHONY: TestLevelImports TestLevelImports: $(CHECK_PPR) $(LIBDIR) TestLevelImports.hs @@ -922,3 +927,8 @@ TestNamedDefaults: PprModifiers: $(CHECK_PPR) $(LIBDIR) PprModifiers.hs $(CHECK_EXACT) $(LIBDIR) PprModifiers.hs + +.PHONY: PprQualifiedStrings +PprQualifiedStrings: + $(CHECK_PPR) $(LIBDIR) PprQualifiedStrings.hs + $(CHECK_EXACT) $(LIBDIR) PprQualifiedStrings.hs ===================================== testsuite/tests/printer/PprQualifiedStrings.hs ===================================== @@ -0,0 +1,75 @@ +{-# LANGUAGE MultilineStrings #-} +{-# LANGUAGE QualifiedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- These are harvested from ../qualified-strings + +module PprQualifiedStrings where + +import Data.Typeable (Typeable, typeOf) +import qualified Example.ByteStringAscii as Ascii +import qualified Example.ByteStringUtf8 as Utf8 +import qualified Example.Text as Text + +exprs :: IO () +exprs = do + inspect "I'm a String" -- would be an ambiguous type error with OverloadedStrings + inspect Text."I'm a Text" + inspect Ascii."I'm an ASCII bytestring: 語" + inspect Utf8."I'm a UTF8 bytestring: 語" + + inspect """ + I'm a multiline + String value + ! + """ + + inspect Text.""" + I'm a multiline + Text value + ! + """ + + inspect Text . """ + I'm a multiline + Text value + """ + + inspect Text . + """ + I'm a multiline + Text value + """ + +pats :: IO () +pats = do + let text = Text."foo" :: Text + case text of + Text."foo" -> putStrLn "Text.\"foo\" matched" + _ -> putStrLn "Text.\"foo\" did not match" + + let ascii = Ascii."語" :: ByteString + case ascii of + Ascii."語" -> putStrLn "Ascii.\"語\" matched" + _ -> putStrLn "Ascii.\"語\" did not match" + + let utf = Utf8."語" :: ByteString + case utf of + Utf8."語" -> putStrLn "Utf8.\"語\" matched" + _ -> putStrLn "Utf8.\"語\" did not match" + +th :: IO () +th = + $(do + foldr (\stmt acc -> [| $stmt >> $acc |]) [| pure () |] $ + [ [| inspect Text."I'm a Text" |] + , [| inspect Ascii."I'm an ASCII bytestring: 語" |] + , [| inspect Utf8."I'm a Utf8 bytestring: 語" |] + , [| + inspect Text.""" + I'm a multiline + Text string + """ + |] + ] + ) ===================================== testsuite/tests/printer/Test27291.hs ===================================== @@ -0,0 +1,35 @@ +{-# LANGUAGE ExplicitNamespaces #-} + +module Test27291 + ( C(type ..) -- exports class C and data family D + , C(data ..) -- exports class C and method m + , D(type ..) -- exports data family D + , type T (..) -- exports type T and all its data constructors D, D2 + , type T (type ..) -- exports type T + , type K (type ..) -- exports type K and its constructor K1 + ) where + +import Control.Applicative qualified as A (type Applicative (data ..)) +import Data.Either qualified as E (type Either (data ..)) + +import Data.Bool (data True (..)) +import Data.Bool (data True( data .. ) ) +import Data.Bool (data True( type ..)) + +import DodgyImports03_helper (C( .. )) +import DodgyImports03_helper (C (data .. )) +import DodgyImports03_helper (C( type ..) ) + +import DodgyImports03_helper (T ( .. ) ) +import DodgyImports03_helper (T(data ..)) +import DodgyImports03_helper (T(type ..)) + +import Control.Applicative (type Applicative (type ..)) -- dodgy: no associated types +import Data.Either (type Either (type ..)) -- dodgy: not a class + +import Data.Proxy (type Proxy(data ..)) -- ok +import Data.Proxy (type Proxy(type ..)) -- dodgy: not a class + +import T25901_sub_g_helper qualified as T1 (T (data ..)) -- T and MkT +import T25901_sub_g_helper qualified as T2 (T (type ..)) -- T only +import T25901_sub_g_helper qualified as T3 (type T (..)) -- T and MkT ===================================== testsuite/tests/printer/all.T ===================================== @@ -217,7 +217,9 @@ test('T24237', normal, compile_fail, ['']) test('Test25454', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25454']) test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885']) +test('Test27291', [ignore_stderr, req_ppr_deps], makefile_test, ['Test27291']) test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports']) test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults']) test('PprModifiers', [ignore_stderr,req_ppr_deps], makefile_test, ['PprModifiers']) +test('PprQualifiedStrings', [ignore_stderr,req_ppr_deps], makefile_test, ['PprQualifiedStrings']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3145,6 +3145,12 @@ instance ExactPrint (HsExpr GhcPs) where body' <- markAnnotated body return (HsQual noExtField ctxt' body') + exact (HsQualLit _ (QualLit _ modu (HsQualString src fs))) = do + modu' <- markAnnotated modu + printStringAdvanceA "." + printSourceTextAA src (show (unpackFS fs)) + return (HsQualLit noExtField (QualLit noExtField modu' (HsQualString src fs))) + exact x = error $ "exact HsExpr for:" ++ showAst x -- --------------------------------------------------------------------- @@ -4581,9 +4587,9 @@ instance ExactPrint (IE GhcPs) where return (IEThingAbs depr' thing' doc') exact (IEThingAll x ns_spec thing doc) = do depr' <- markAnnotated (ieta_warning x) - ns_spec' <- markAnnotated ns_spec thing' <- markAnnotated thing op' <- markEpToken (ieta_tok_lpar x) + ns_spec' <- markAnnotated ns_spec dd' <- markEpToken (ieta_tok_wc x) cp' <- markEpToken (ieta_tok_rpar x) doc' <- markAnnotated doc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3dec45b2fd79897bf38434997dbe60... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3dec45b2fd79897bf38434997dbe60... You're receiving this email because of your account on gitlab.haskell.org.