- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/interpolated-strings] 10 commits: ci: Actually pass --ignore-perf-failures to the testsuite driver
by Brandon Chinn (＠brandonchinn178) 12 Sep '26

12 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings at Glasgow Haskell Compiler / GHC Commits: 4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00 ci: Actually pass --ignore-perf-failures to the testsuite driver 684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to RUNTEST_ARGS with bash array syntax, but the three use sites still expand RUNTEST_ARGS as a scalar, which yields only the first array element. The appended flag was therefore dropped in every job, so perf improvements kept failing Marge Bot batches and master pipelines, contrary to #19562. Append as a string instead, matching the existing --force-colors append in test_hadrian. Fixes #27563. Assisted-by: Claude Fable 5.1 - - - - - 4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00 testsuite: Give T26537 a 1.5x compile timeout Its -fregs-graph compile step tends to time out in unoptimized builds (#27188, #27776). Assisted-by: Claude Fable 5.1 - - - - - 130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00 EPA: Remove ListBanana / ListParens from AnnListBrackets This is a step towards making AnnList only represent lists of items which can have either braces or layout. - - - - - a9827d13 by Simon Jakobi at 2026-09-11T18:53:32-04:00 Reject ~, UNPACK and multiplicity annotations on type data fields Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations were silently accepted. None of them make sense at the type level, so restriction (R3) of Note [Type data declarations] now covers all of them. Fixes #27732. Assisted-by: Claude Fable 5.1 - - - - - c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00 EPA: Add a Note for the exact print main loop - - - - - 2f525215 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Reorganize processChars functions Move functions around, no code changes - - - - - 74fadf63 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Always use processCharsSingle to get StringLexError - - - - - 3783dc88 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - d8b024b3 by Brandon Chinn at 2026-09-11T23:52:58-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 2b7c00fc by Brandon Chinn at 2026-09-11T23:53:09-07:00 Implement interpolated strings (#27592) - - - - - 112 changed files: - .gitlab/ci.sh - + changelog.d/27732 - + changelog.d/string-interpolation - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/Lexer/String.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - + compiler/GHC/Rename/String.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - docs/users_guide/exts/qualified_strings.rst - + docs/users_guide/exts/string_interpolation.rst - docs/users_guide/exts/type_data.rst - libraries/base/src/GHC/Essentials.hs - libraries/base/src/GHC/Show.hs - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/Data/String/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Builder/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Class/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Default/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/ShowS/Experimental.hs - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Data/String/Interpolate.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/T25121_status.stdout - 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/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.hs - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.hs - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.hs - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInPat.hs - + testsuite/tests/parser/should_fail/StringInterpolationInPat.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInType.hs - + testsuite/tests/parser/should_fail/StringInterpolationInType.stderr - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.hs - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.hs - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_run/StringInterpolation.hs - + testsuite/tests/parser/should_run/StringInterpolation.stdout - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.hs - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.stdout - testsuite/tests/parser/should_run/all.T - + testsuite/tests/qualified-strings/should_run/Example/SQL.hs - testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.hs - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.stdout - + testsuite/tests/type-data/should_fail/T27732a.hs - + testsuite/tests/type-data/should_fail/T27732a.stderr - + testsuite/tests/type-data/should_fail/T27732b.hs - + testsuite/tests/type-data/should_fail/T27732b.stderr - + testsuite/tests/type-data/should_fail/T27732c.hs - + testsuite/tests/type-data/should_fail/T27732c.stderr - + testsuite/tests/type-data/should_fail/T27732d.hs - + testsuite/tests/type-data/should_fail/T27732d.stderr - + testsuite/tests/type-data/should_fail/T27732e.hs - + testsuite/tests/type-data/should_fail/T27732e.stderr - + testsuite/tests/type-data/should_fail/T27732f.hs - + testsuite/tests/type-data/should_fail/T27732f.stderr - testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr - testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr - testsuite/tests/type-data/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/186f496c183f8c3443a242d16d75a4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/186f496c183f8c3443a242d16d75a4… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/interpolated-strings] 3 commits: Add pprHsStringMulti, unify string ppr functions
by Brandon Chinn (＠brandonchinn178) 12 Sep '26

12 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings at Glasgow Haskell Compiler / GHC Commits: b036fbe0 by Brandon Chinn at 2026-09-11T19:37:01-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - 2a221268 by Brandon Chinn at 2026-09-11T19:37:02-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 186f496c by Brandon Chinn at 2026-09-11T19:37:16-07:00 Implement interpolated strings (#27592) - - - - - 85 changed files: - + changelog.d/string-interpolation - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/Lexer/String.x - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Expr.hs - + compiler/GHC/Rename/String.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - docs/users_guide/exts/qualified_strings.rst - + docs/users_guide/exts/string_interpolation.rst - libraries/base/src/GHC/Essentials.hs - libraries/base/src/GHC/Show.hs - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/Data/String/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Builder/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Class/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Default/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/ShowS/Experimental.hs - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Data/String/Interpolate.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T4437.hs - 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/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.hs - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.hs - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.hs - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInPat.hs - + testsuite/tests/parser/should_fail/StringInterpolationInPat.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInType.hs - + testsuite/tests/parser/should_fail/StringInterpolationInType.stderr - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.hs - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.hs - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_run/StringInterpolation.hs - + testsuite/tests/parser/should_run/StringInterpolation.stdout - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.hs - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.stdout - testsuite/tests/parser/should_run/all.T - + testsuite/tests/qualified-strings/should_run/Example/SQL.hs - testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.hs - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.stdout - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d814690b133022ec94a2d0723a276f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d814690b133022ec94a2d0723a276f… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/interpolated-strings-refactor] 2 commits: Add pprHsStringMulti, unify string ppr functions
by Brandon Chinn (＠brandonchinn178) 12 Sep '26

12 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings-refactor at Glasgow Haskell Compiler / GHC Commits: b036fbe0 by Brandon Chinn at 2026-09-11T19:37:01-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - 2a221268 by Brandon Chinn at 2026-09-11T19:37:02-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 13 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/String.hs - compiler/GHC/Utils/Outputable.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - libraries/base/src/GHC/Show.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - 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 Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -87,7 +87,6 @@ import GHC.Parser.HaddockLex import GHC.Parser.Annotation import GHC.Parser.Errors.Types import GHC.Parser.Errors.Ppr () -import GHC.Parser.String import GHC.Builtin.WiredIn.Types ( unitTyCon, unitDataCon, sumTyCon, @@ -97,6 +96,7 @@ import GHC.Builtin.WiredIn.Types unrestrictedFunTyCon ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Language.Haskell.Syntax.StringMeta import Language.Haskell.Syntax.Text import qualified Data.Semigroup as Semi ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -141,6 +141,7 @@ import qualified GHC.Parser.Lexer.String as Lexer.String import GHC.Parser.String import Language.Haskell.Syntax.Module.Name (ModuleName(..)) +import Language.Haskell.Syntax.StringMeta import Language.Haskell.Syntax.Text } ===================================== compiler/GHC/Parser/String.hs ===================================== @@ -6,10 +6,6 @@ module GHC.Parser.String ( lexString, lexMultilineString, - -- * StringMeta - StringMeta (..), - defaultStrMeta, - -- * Unicode smart quote helpers isDoubleSmartQuote, isSingleSmartQuote, @@ -20,7 +16,6 @@ import GHC.Prelude hiding (getChar) import Control.Arrow ((>>>)) import Control.Monad (when) import Data.Char (chr, ord) -import Data.Data (Data) import qualified Data.Foldable1 as Foldable1 import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (listToMaybe, mapMaybe) @@ -37,7 +32,6 @@ import GHC.Parser.CharClass ( ) import GHC.Parser.Errors.Types (LexErr (..)) import GHC.Utils.Panic (panic) -import Language.Haskell.Syntax.Module.Name (ModuleName) type BufPos = Int data StringLexError = StringLexError LexErr BufPos @@ -288,20 +282,7 @@ isSingleSmartQuote = \case _ -> False -- ----------------------------------------------------------------------------- --- StringMeta - -data StringMeta = StringMeta - { strMetaMultiline :: Bool - , strMetaQualified :: Maybe ModuleName - } - deriving (Show, Data) - -defaultStrMeta :: StringMeta -defaultStrMeta = - StringMeta - { strMetaMultiline = False - , strMetaQualified = Nothing - } +-- QualifiedStrings {- Note [Implementation of QualifiedStrings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilyDependencies #-} @@ -61,7 +62,10 @@ module GHC.Utils.Outputable ( pprDebugAndThen, pprInfixVar, pprPrefixVar, - pprHsChar, pprHsString, pprHsBytes, + pprHsChar, + pprHsString, pprHsString', + pprHsStringMulti, pprHsStringMulti', + pprHsBytes, primFloatSuffix, primCharSuffix, primDoubleSuffix, primInt8Suffix, primWord8Suffix, @@ -165,7 +169,11 @@ import Data.Void import Control.DeepSeq (NFData(rnf)) import GHC.Fingerprint -import GHC.Show ( showMultiLineString ) +#if MIN_VERSION_base(4,23,0) +import GHC.Show (showMultiLineString') +#else +import GHC.Show (showLitString) +#endif import GHC.Utils.Exception import GHC.Exts (oneShot) @@ -1355,14 +1363,48 @@ pprHsChar :: Char -> SDoc pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32)) | otherwise = text (show c) --- | Special combinator for showing string literals. +-- | Special combinator for showing single-line string literals. pprHsString :: String -> SDoc -pprHsString fs = vcat (map text (showMultiLineString fs)) +pprHsString fs = char '"' <> pprHsString' fs <> char '"' + +-- | Like 'pprHsString' except without the outer quotes. +pprHsString' :: String -> SDoc +pprHsString' = vcat . map text . showMultiLineString' Nothing + +-- | Special combinator for showing multi-line string literals. +pprHsStringMulti :: FastString -> SDoc +pprHsStringMulti fs = text "\"\"\"" <> pprHsString' (unpackFS fs) <> text "\"\"\"" + +-- | Like 'pprHsStringMulti' except without the outer quotes. +pprHsStringMulti' :: String -> SDoc +pprHsStringMulti' = vcat . map text . showLitStringMultiline + where + showLitChars :: String -> ShowS + showLitChars [] s = s + showLitChars (c : cs) s = showLitChar c (showLitChars cs s) + + showLitStringMultiline :: String -> [String] + showLitStringMultiline = map (flip showLitChars "") . lines + +#if !MIN_VERSION_base(4,23,0) +-- Copied from GHC.Internal.Show +showMultiLineString' :: Maybe Char -> String -> [String] +showMultiLineString' delim = map ($ "") . go showDelim + where + showDelim = case delim of Just d -> showChar d; Nothing -> id + showNL = showString "\\n" + showBS = showChar '\\' + go pre s = + case break (== '\n') s of + (l, '\n':s'@(_:_)) -> (pre . showLitString l . showNL . showBS) : go showBS s' + (l, '\n':[]) -> (pre . showLitString l . showNL . showDelim) : [] + (l, _) -> (pre . showLitString l . showDelim) : [] +#endif -- | Special combinator for showing bytestring literals. pprHsBytes :: ByteString -> SDoc pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs - in vcat (map text (showMultiLineString escaped)) <> char '#' + in char '"' <> pprHsString' escaped <> text "\"#" where escape :: Word8 -> String escape w = let c = chr (fromIntegral w) in if isAscii c ===================================== compiler/Language/Haskell/Syntax/StringMeta.hs ===================================== @@ -0,0 +1,27 @@ +module Language.Haskell.Syntax.StringMeta ( + StringMeta (..), + defaultStrMeta, +) where + +import Prelude + +import Language.Haskell.Syntax.Module.Name (ModuleName) + +-- libraries: +import Data.Data (Data) + +-- ----------------------------------------------------------------------------- +-- StringMeta + +data StringMeta = StringMeta + { strMetaMultiline :: Bool + , strMetaQualified :: Maybe ModuleName + } + deriving (Show, Data) + +defaultStrMeta :: StringMeta +defaultStrMeta = + StringMeta + { strMetaMultiline = False + , strMetaQualified = Nothing + } ===================================== compiler/ghc.cabal.in ===================================== @@ -1062,6 +1062,7 @@ Library Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity + Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== libraries/base/src/GHC/Show.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Show Show(..), ShowS, -- * Show support code - shows, showChar, showString, showMultiLineString, + shows, showChar, showString, showMultiLineString, showMultiLineString', showParen, showList__, showCommaSpace, showSpace, showLitChar, showLitString, protectEsc, intToDigit, showSignedInt, ===================================== libraries/ghc-internal/src/GHC/Internal/Show.hs ===================================== @@ -42,7 +42,8 @@ module GHC.Internal.Show -- Instances for Show: (), [], Bool, Ordering, Int, Char -- Show support code - shows, showChar, showString, showMultiLineString, + shows, showChar, showString, + showMultiLineString, showMultiLineString', showParen, showList__, showCommaSpace, showSpace, showLitChar, showLitString, protectEsc, intToDigit, showSignedInt, @@ -421,13 +422,20 @@ showMultiLineString :: String -> [String] -- * wrap the entire thing in double quotes -- Example: @showMultiLineString "hello\ngoodbye\nblah"@ -- returns @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@ -showMultiLineString str - = go '\"' str +showMultiLineString = showMultiLineString' (Just '\"') + +-- | Like 'showMultiLineString' except using the given delimiter +showMultiLineString' :: Maybe Char -> String -> [String] +showMultiLineString' delim = map ($ "") . go showDelim where - go ch s = case break (== '\n') s of - (l, _:s'@(_:_)) -> (ch : showLitString l "\\n\\") : go '\\' s' - (l, "\n") -> [ch : showLitString l "\\n\""] - (l, _) -> [ch : showLitString l "\""] + showDelim = case delim of Just d -> showChar d; Nothing -> id + showNL = showString "\\n" + showBS = showChar '\\' + go pre s = + case break (== '\n') s of + (l, '\n':s'@(_:_)) -> (pre . showLitString l . showNL . showBS) : go showBS s' + (l, '\n':[]) -> (pre . showLitString l . showNL . showDelim) : [] + (l, _) -> (pre . showLitString l . showDelim) : [] isDec :: Char -> Bool isDec c = c >= '0' && c <= '9' ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -28,5 +28,6 @@ Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity +Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -303,5 +303,6 @@ Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity +Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -9022,6 +9022,7 @@ module GHC.Show where showLitChar :: GHC.Internal.Types.Char -> ShowS showLitString :: GHC.Internal.Base.String -> ShowS showMultiLineString :: GHC.Internal.Base.String -> [GHC.Internal.Base.String] + showMultiLineString' :: GHC.Internal.Maybe.Maybe GHC.Internal.Types.Char -> GHC.Internal.Base.String -> [GHC.Internal.Base.String] showParen :: GHC.Internal.Types.Bool -> ShowS -> ShowS showSignedInt :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> ShowS showSpace :: ShowS ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -9060,6 +9060,7 @@ module GHC.Show where showLitChar :: GHC.Internal.Types.Char -> ShowS showLitString :: GHC.Internal.Base.String -> ShowS showMultiLineString :: GHC.Internal.Base.String -> [GHC.Internal.Base.String] + showMultiLineString' :: GHC.Internal.Maybe.Maybe GHC.Internal.Types.Char -> GHC.Internal.Base.String -> [GHC.Internal.Base.String] showParen :: GHC.Internal.Types.Bool -> ShowS -> ShowS showSignedInt :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> ShowS showSpace :: ShowS ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -9240,6 +9240,7 @@ module GHC.Show where showLitChar :: GHC.Internal.Types.Char -> ShowS showLitString :: GHC.Internal.Base.String -> ShowS showMultiLineString :: GHC.Internal.Base.String -> [GHC.Internal.Base.String] + showMultiLineString' :: GHC.Internal.Maybe.Maybe GHC.Internal.Types.Char -> GHC.Internal.Base.String -> [GHC.Internal.Base.String] showParen :: GHC.Internal.Types.Bool -> ShowS -> ShowS showSignedInt :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> ShowS showSpace :: ShowS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51d85318eb6055a039efd1dda036da… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51d85318eb6055a039efd1dda036da… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] EPA: Add a Note for the exact print main loop
by Marge Bot (＠marge-bot) 12 Sep '26

12 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00 EPA: Add a Note for the exact print main loop - - - - - 1 changed file: - utils/check-exact/ExactPrint.hs Changes: ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -140,9 +140,9 @@ defaultEPState = EPState -- | The R part of RWS. The environment. Updated via 'local' as we -- enter a new AST element, having a different anchor point. -data EPOptions m a = EPOptions - { epTokenPrint :: String -> m a - , epWhitespacePrint :: String -> m a +data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w } -- | Helper to create a 'EPOptions' @@ -163,8 +163,7 @@ stringOptions = epOptions return return deltaOptions :: EPOptions Identity () deltaOptions = epOptions (\_ -> return ()) (\_ -> return ()) -data EPWriter a = EPWriter - { output :: !a } +data EPWriter w = EPWriter { output :: !w } instance Monoid w => Semigroup (EPWriter w) where (EPWriter a) <> (EPWriter b) = EPWriter (a <> b) @@ -239,7 +238,220 @@ setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = -- | Key entry point. Switches to an independent AST element with its -- own annotation, calculating new offsets, etc markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a -markAnnotated a = enterAnn (getAnnotationEntry a) a +markAnnotated a = enterAnn (getAnnotationEntry a) a -- See Note [Exact print main loop] + +{- +Note [Exact print main loop] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Exact printing is the process of taking the ParsedSource, or some +subtree from it, and rendering it to a string, which accurately +reflects the original source that was parsed, except detail of +whitespace (such as spaces vs tabs) is discarded. + +The ParsedSource or fragment from it must implement the ExactPrint +class, and this file does that, as well as supporting machinery to +drive the process. The ExactPrint class is described later in this +note. + +The entry point for exact printing is the exactPrint function, defined +as + + exactPrint :: ExactPrint ast => ast -> String + exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast)) + + type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a + + runEP :: (Monad m) => EPOptions m w -> EP w m a -> m (a, w) + runEP epReader action = do + (ast, w) <- evalRWST action epReader defaultEPState + return (ast, output w) + + data EPWriter w = EPWriter { output :: !w } + + data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w + } + +This offers some flexibility in how the output is produced, in that +the EpWriter and EPOptions work together, defining an output type and +a function to render whitespace and non-whitepace. + +In normal operation (via exactPrint) these are simply returning the +string unchanged and accumulating a larger string. But it has also been +used to render an HTML version of the source as it prints. + +The main reason exact print exists is to make it easier for tool +writers to manipulate the ParsedSource, and render this back to the +original source, except for the changed parts. One manipulation is to +simply take say a FunBind with its signature from one place in the +code to another. When doing this, the original parsed locations are no +longer useful when rendering the source back to a string. To enable +this, we have another entry point, for converting all absolute +locations to relative ones, using DeltaPos, which captures the line +and col offset relative to the prior output. + +The function to do this is + + makeDeltaAst :: ExactPrint ast => ast -> ast + makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast)) + +The implementation is practically identical for exactPrint and +makeDeltaAst, they simply return the second or first part of the same +calculation. + +This simplifies the implementation of the required ExactPrint +implmentations, in that we only need one per ast item, which encodes +how to print it, and this print process does bookkeeping to keep track +of what spacing it used when doing the print, so it can return the +updated item, with the original absolute SrcSpan's converted to +DeltaPos values instead. + +This information is captured in the XRec/Anno instances used in GHC +Hs, which are mostly LocatedA a, defined as + + GenLocated (EpAnn [TrailingAnn]) a + + data EpAnn ann + = EpAnn { entry :: !EpaLocation + , anns :: !ann + , comments :: !EpAnnComments + } + + data EpaLocation = EpaSpan !SrcSpan + | EpaDelta !SrcSpan !DeltaPos [LEpaComment] + +When parsed, the entry EpaLocation captures an EpaSpan with the parsed +absolute location. After makeDeltaAst, this instead uses EpaDelta, +including the original SrcSpan, the relative spaceing as a DeltaPos, +and any comments that may come before the item, e.g. comments before a +semicolon. + +Both exactPrint and makeDeltaAst call markAnnotated on the item to be +printed, inside the monad machinery. + + markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a + markAnnotated a = enterAnn (getAnnotationEntry a) a + +This makes use of the ExactPrint instance for the ParsedSource and +for every other part of the ParsedSource as a tree. + + class (Typeable a) => ExactPrint a where + getAnnotationEntry :: a -> Entry + exact :: (Monad m, Monoid w) => a -> EP w m a + setAnnotationAnchor :: a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a + +- getAnnotationEntry : returns the Entry information, normally derived + directly from the EpAnn in the LocatedA enclosing the item. + Entry contains + - The location of the first non-comment part of the item to be printed. + - Any [TrailingAnn] (semis, commas, etc) to follow the item. + - Any comments associated with the item, but not with enclosed items. + These comments may also precede or follow the entry location + - Some technical flags, relating to flushing remaining comments at the + last (topmost) item, and if the anchor can be updated (see below). + +- exact : Do the actual printing of the item, having been put in the right + place in terms of print location by the main loop, based on a call to + getAnnotationEntry for it. This printing normally comprises making nested + markAnnotated calls on the nested items in the current one, e.g. + + exact (HsApp an e1 e2) = do + e1' <- markAnnotated e1 + e2' <- markAnnotated e2 + return (HsApp an e1' e2') + +- setAnnotationAnchor : the main loop printing does two things: + - produce output, reflecting the items being printed + - convert all the locations in the item (each an EpaLocation) from its + EpaSpan version to an EpaDelta one, which is independent of absolute + location, being the spacing from the previous print output to this + entry point + To allow these updated locations to be captured, the item implements + the setAnnotationAnchor method, which updates the fields of the Entry + returned by getAnnotationEntry + +You will recall + + markAnnotated a = enterAnn (getAnnotationEntry a) a + enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a + +enterAnn is the part that is repeatedly called via markAnnotated, to +manage the bookkeeping around printing and calculating the updated +delta positions. + +It manages the printing state, adding the new comments from the Entry, +positioning the print head to the entry point, takes account of whether +it is an absolute span or a delta, and prints any comments that must come +before this location. + +At this print location, it calls the `exact` method on the item. This +is the only place `exact` can be called. Within `exact` implementations +the `markAnnotated` function should be used instead, to ensure the state +is managed properly for printing. + +Once the item is printed via its `exact` method, which normally +recurses via `markAnnotated` into any nested items inside it, the +`enterAnn` function prints any [TrailingAnn] from the entry and any +trailing comments. It then wraps up by calling +`setAnnotationAnchor`with the updated (now delta-based) values for the +Entry + +Printing Complicated Items +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes we need to print a sub-item which does not map cleanly onto the +ExactPrint class, usually because there are parts spread through the item +that need to be managed together while printing. + +An example is in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16321, where +ConDeclGADT needs to print its inner_bindings, but the these in turn +may have parens, e.g. + + data V a where + MkV4 :: forall a. ((forall b. (Show a => a -> (b -> V a)))) + +Here there are inner bindings for the first forall, the multiple +parens around the second forall, and the second forall, wrapping the +inner content within this. + +But the inner content `Show a => a -> (b -> V a)` had to be printed "inside" +the inner_bindings, to correctly close the nested parens. + +The approach in !16321 modified `enterAnn`, to pass in alternate versions +of the `exact` implementation. This works, but it makes an already +complicated function even more complicated. + +An ExactPrint-idiomatic approach is to create a helper data structure +to represent this nested organisation, and provide ExactPrint +instances for that. + +This is done in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16644, using + + data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +The key part of the ExactPrint instance for this is + + exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do + lp' <- markEpToken lp + xs' <- markAnnotated xs + rp' <- markEpToken rp + return (InnerMore (L l (HsGadtPar (lp',rp'))) xs') + +This first prints the opening paren, prints the balance of the cons list, then +prints the closing paren. + +Conversions to and from this structure populate the initial values from +the ConDeclGADT, and retrieve the updated delta-based values after +printing. + +Another use of this technique involves HsModuleImpDecls. + +-} -- | For HsModule, because we do not have a proper SrcSpan, we must -- indicate to flush trailing comments when done. @@ -377,6 +589,7 @@ cua NoCanUpdateAnchor _ = return [] -- This is combination of the ghc=exactprint Delta.withAST and -- Print.exactPC functions and effectively does the delta processing -- immediately followed by the print processing. JIT ghc-exactprint. +-- See Note [Exact print main loop] enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a enterAnn NoEntryVal a = do p <- getPosP View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c71d5e236943abb11a45742f397344f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c71d5e236943abb11a45742f397344f… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] Reject ~, UNPACK and multiplicity annotations on type data fields
by Marge Bot (＠marge-bot) 12 Sep '26

12 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a9827d13 by Simon Jakobi at 2026-09-11T18:53:32-04:00 Reject ~, UNPACK and multiplicity annotations on type data fields Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations were silently accepted. None of them make sense at the type level, so restriction (R3) of Note [Type data declarations] now covers all of them. Fixes #27732. Assisted-by: Claude Fable 5.1 - - - - - 19 changed files: - + changelog.d/27732 - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/exts/type_data.rst - + testsuite/tests/type-data/should_fail/T27732a.hs - + testsuite/tests/type-data/should_fail/T27732a.stderr - + testsuite/tests/type-data/should_fail/T27732b.hs - + testsuite/tests/type-data/should_fail/T27732b.stderr - + testsuite/tests/type-data/should_fail/T27732c.hs - + testsuite/tests/type-data/should_fail/T27732c.stderr - + testsuite/tests/type-data/should_fail/T27732d.hs - + testsuite/tests/type-data/should_fail/T27732d.stderr - + testsuite/tests/type-data/should_fail/T27732e.hs - + testsuite/tests/type-data/should_fail/T27732e.stderr - + testsuite/tests/type-data/should_fail/T27732f.hs - + testsuite/tests/type-data/should_fail/T27732f.stderr - testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr - testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr - testsuite/tests/type-data/should_fail/all.T Changes: ===================================== changelog.d/27732 ===================================== @@ -0,0 +1,8 @@ +section: language +synopsis: Reject ``~``, ``UNPACK`` and multiplicity annotations on ``type data`` fields +description: + ``type data`` declarations (:extension:`TypeData`) now reject any + strictness, unpackedness or multiplicity annotation on constructor + fields. Previously only ``!`` was rejected. +mrs: !16563 +issues: #27732 ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -71,7 +71,6 @@ import GHC.Data.Graph.Directed ( SCC, flattenSCC, Node(..) , stronglyConnCompFromEdgedVerticesUniq ) import GHC.Data.OrdList import qualified GHC.LanguageExtensions as LangExt -import GHC.Core.DataCon ( isSrcStrict ) import Control.Monad import Data.Bifunctor ( first ) @@ -2116,8 +2115,8 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond = do { ; when (has_labelled_fields condecl) $ failWith $ TcRnTypeDataForbids TypeDataForbidsLabelledFields - ; when (has_strictness_flags condecl) $ - failWith $ TcRnTypeDataForbids TypeDataForbidsStrictnessAnnotations + ; when (has_field_annotations condecl) $ + failWith $ TcRnTypeDataForbids TypeDataForbidsFieldAnnotations } has_labelled_fields (ConDeclGADT { con_g_args = RecConGADT _ _ }) = True @@ -2125,13 +2124,19 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond = not (null (unLoc flds)) has_labelled_fields _ = False - has_strictness_flags condecl - = any isSrcStrict (con_arg_bangs condecl) + has_field_annotations condecl + = not (all unannotated (con_arg_fields condecl)) + where + unannotated (CDF { cdf_bang = NoSrcStrict + , cdf_unpack = NoSrcUnpack + , cdf_multiplicity = HsModifiedFunArr _ [] (HsStandardArr _) }) + = True + unannotated _ = False - con_arg_bangs (ConDeclGADT { con_g_args = PrefixConGADT _ args }) = map cdf_bang args - con_arg_bangs (ConDeclH98 { con_args = PrefixCon _ args }) = map cdf_bang args - con_arg_bangs (ConDeclH98 { con_args = InfixCon _ arg1 arg2 }) = [cdf_bang arg1, cdf_bang arg2] - con_arg_bangs _ = [] + con_arg_fields (ConDeclGADT { con_g_args = PrefixConGADT _ args }) = args + con_arg_fields (ConDeclH98 { con_args = PrefixCon _ args }) = args + con_arg_fields (ConDeclH98 { con_args = InfixCon _ arg1 arg2 }) = [arg1, arg2] + con_arg_fields _ = [] {- Note [Type data declarations] @@ -2166,8 +2171,9 @@ preceded by `type`, with the following restrictions: (R2) There are no labelled fields. Perhaps these could be supported using type families, but they are omitted for now. -(R3) There are no strictness flags, because they don't make sense at - the type level. +(R3) There are no strictness, unpackedness or multiplicity annotations + (!, ~, {-# UNPACK #-}, {-# NOUNPACK #-}, %m ->, ⊸), because they + don't make sense at the type level. (R4) The types of the constructors contain no constraints. ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2866,6 +2866,12 @@ data TcRnMessage where type-data/should_fail/TDRecordsH98 type-data/should_fail/TDStrictnessGADT type-data/should_fail/TDStrictnessH98 + type-data/should_fail/T27732a + type-data/should_fail/T27732b + type-data/should_fail/T27732c + type-data/should_fail/T27732d + type-data/should_fail/T27732e + type-data/should_fail/T27732f -} TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage @@ -4541,15 +4547,15 @@ data ZonkerMessage where data TypeDataForbids = TypeDataForbidsDatatypeContexts | TypeDataForbidsLabelledFields - | TypeDataForbidsStrictnessAnnotations + | TypeDataForbidsFieldAnnotations | TypeDataForbidsDerivingClauses deriving Generic instance Outputable TypeDataForbids where - ppr TypeDataForbidsDatatypeContexts = text "Data type contexts" - ppr TypeDataForbidsLabelledFields = text "Labelled fields" - ppr TypeDataForbidsStrictnessAnnotations = text "Strictness flags" - ppr TypeDataForbidsDerivingClauses = text "Deriving clauses" + ppr TypeDataForbidsDatatypeContexts = text "Data type contexts" + ppr TypeDataForbidsLabelledFields = text "Labelled fields" + ppr TypeDataForbidsFieldAnnotations = text "Strictness, unpackedness or multiplicity annotations" + ppr TypeDataForbidsDerivingClauses = text "Deriving clauses" -- | Specifies which back ends can handle a requested foreign import or export type ExpectedBackends = [Backend] ===================================== docs/users_guide/exts/type_data.rst ===================================== @@ -33,7 +33,8 @@ either an ordinary algebraic data type or a GADT, prefixed with the keyword ``type``, except that it may not contain a datatype context (even with :extension:`DatatypeContexts`), labelled fields, -strictness flags, or +:ref:`strictness <strict-haskell>`, :ref:`unpackedness <unpack-pragma>` or +:ref:`multiplicity <linear-types>` annotations, or a ``deriving`` clause. The only constraints permitted in the types of constructors are ===================================== testsuite/tests/type-data/should_fail/T27732a.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeData, LazyFieldAnnotations #-} +module T27732a where + +type data T a = Cons ~a ===================================== testsuite/tests/type-data/should_fail/T27732a.stderr ===================================== @@ -0,0 +1,3 @@ +T27732a.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732b.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeData, LazyFieldAnnotations #-} +module T27732b where + +type data T a where + Cons :: ~a -> T a ===================================== testsuite/tests/type-data/should_fail/T27732b.stderr ===================================== @@ -0,0 +1,3 @@ +T27732b.hs:5:6: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732c.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeData #-} +module T27732c where + +type data T a = Cons {-# UNPACK #-} a ===================================== testsuite/tests/type-data/should_fail/T27732c.stderr ===================================== @@ -0,0 +1,3 @@ +T27732c.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732d.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeData #-} +module T27732d where + +type data T a = Cons {-# NOUNPACK #-} a ===================================== testsuite/tests/type-data/should_fail/T27732d.stderr ===================================== @@ -0,0 +1,3 @@ +T27732d.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732e.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeData, LinearTypes #-} +module T27732e where + +type data T where + MkT :: Int %1 -> T ===================================== testsuite/tests/type-data/should_fail/T27732e.stderr ===================================== @@ -0,0 +1,3 @@ +T27732e.hs:5:3: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732f.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeData, LinearTypes, UnicodeSyntax #-} +module T27732f where + +type data T where + MkT :: Int ⊸ T ===================================== testsuite/tests/type-data/should_fail/T27732f.stderr ===================================== @@ -0,0 +1,3 @@ +T27732f.hs:5:3: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr ===================================== @@ -1,3 +1,3 @@ +TDStrictnessGADT.hs:5:6: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. -TDStrictnessGADT.hs:5:6: [GHC-67297] - Strictness flags are not allowed in type data declarations. ===================================== testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr ===================================== @@ -1,3 +1,3 @@ +TDStrictnessH98.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. -TDStrictnessH98.hs:4:17: [GHC-67297] - Strictness flags are not allowed in type data declarations. ===================================== testsuite/tests/type-data/should_fail/all.T ===================================== @@ -13,3 +13,9 @@ test('TDStrictnessGADT', normal, compile_fail, ['']) test('TDStrictnessH98', normal, compile_fail, ['']) test('TDTagToEnum', normal, compile_fail, ['']) test('T22332b', normal, compile_fail, ['']) +test('T27732a', normal, compile_fail, ['']) +test('T27732b', normal, compile_fail, ['']) +test('T27732c', normal, compile_fail, ['']) +test('T27732d', normal, compile_fail, ['']) +test('T27732e', normal, compile_fail, ['']) +test('T27732f', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9827d1327adb955e9f6f1c2df256d4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9827d1327adb955e9f6f1c2df256d4… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/no-minimal-for-bitsize] Remove bitSize from MINIMAL pragma of class Bits
by Bodigrim (＠Bodigrim) 12 Sep '26

12 Sep '26

Bodigrim pushed to branch wip/no-minimal-for-bitsize at Glasgow Haskell Compiler / GHC Commits: e464d81b by Andrew Lelechenko at 2026-09-11T23:07:35+01:00 Remove bitSize from MINIMAL pragma of class Bits Cf. https://github.com/haskell/core-libraries-committee/issues/441 The function is deprecated for 12 years and has a default implementation, yet it was never removed from the MINIMAL pragma, putting library authors in a very awkward position. Let's finally remove bitSize from MINIMAL. - - - - - 5 changed files: - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Bits.hs - 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 Changes: ===================================== libraries/base/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `Data.List.NonEmpty.{zip{3..7},zipWith{3..7},unzip{3..7}}` ([CLC proposal #409)(https://github.com/haskell/core-libraries-committee/issues/409)) * 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)) * Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378)) + * Remove `bitSize` from `MINIMAL` pragma of `class Bits`. ([CLC proposal #440](https://github.com/haskell/core-libraries-committee/issues/440)) * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413)) * Add `withEmptyCallStack` to `GHC.Stack`. ([CLC proposal #428](https://github.com/haskell/core-libraries-committee/issues/428)) * Add new `Data.RealFloat` module re-exporting `RealFloat` from `GHC.Float` ([CLC proposal #394](https://github.com/haskell/core-libraries-committee/issues/394)) ===================================== libraries/ghc-internal/src/GHC/Internal/Bits.hs ===================================== @@ -90,7 +90,7 @@ class Eq a => Bits a where {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), - bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + bitSizeMaybe, isSigned, testBit, bit, popCount #-} -- | Bitwise \"and\" (.&.) :: a -> a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5080,7 +5080,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5080,7 +5080,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5083,7 +5083,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e464d81b25b8fd01f66acbf7d0a1b44… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e464d81b25b8fd01f66acbf7d0a1b44… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/add-bind-quadratic-append
by Simon Jakobi (＠sjakobi) 12 Sep '26

12 Sep '26

Simon Jakobi pushed new branch wip/sjakobi/add-bind-quadratic-append at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/add-bind-quadratic-ap… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ci: Actually pass --ignore-perf-failures to the testsuite driver
by Marge Bot (＠marge-bot) 12 Sep '26

12 Sep '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00 ci: Actually pass --ignore-perf-failures to the testsuite driver 684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to RUNTEST_ARGS with bash array syntax, but the three use sites still expand RUNTEST_ARGS as a scalar, which yields only the first array element. The appended flag was therefore dropped in every job, so perf improvements kept failing Marge Bot batches and master pipelines, contrary to #19562. Append as a string instead, matching the existing --force-colors append in test_hadrian. Fixes #27563. Assisted-by: Claude Fable 5.1 - - - - - 4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00 testsuite: Give T26537 a 1.5x compile timeout Its -fregs-graph compile step tends to time out in unoptimized builds (#27188, #27776). Assisted-by: Claude Fable 5.1 - - - - - 130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00 EPA: Remove ListBanana / ListParens from AnnListBrackets This is a step towards making AnnList only represent lists of items which can have either braces or layout. - - - - - cc447dac by Simon Jakobi at 2026-09-11T14:43:13-04:00 Reject ~, UNPACK and multiplicity annotations on type data fields Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations were silently accepted. None of them make sense at the type level, so restriction (R3) of Note [Type data declarations] now covers all of them. Fixes #27732. Assisted-by: Claude Fable 5.1 - - - - - da7bb249 by Alan Zimmerman at 2026-09-11T14:43:14-04:00 EPA: Add a Note for the exact print main loop - - - - - 29 changed files: - .gitlab/ci.sh - + changelog.d/27732 - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/exts/type_data.rst - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghc-api/T25121_status.stdout - + testsuite/tests/type-data/should_fail/T27732a.hs - + testsuite/tests/type-data/should_fail/T27732a.stderr - + testsuite/tests/type-data/should_fail/T27732b.hs - + testsuite/tests/type-data/should_fail/T27732b.stderr - + testsuite/tests/type-data/should_fail/T27732c.hs - + testsuite/tests/type-data/should_fail/T27732c.stderr - + testsuite/tests/type-data/should_fail/T27732d.hs - + testsuite/tests/type-data/should_fail/T27732d.stderr - + testsuite/tests/type-data/should_fail/T27732e.hs - + testsuite/tests/type-data/should_fail/T27732e.stderr - + testsuite/tests/type-data/should_fail/T27732f.hs - + testsuite/tests/type-data/should_fail/T27732f.stderr - testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr - testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr - testsuite/tests/type-data/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -1106,7 +1106,7 @@ if [ "${CI_COMMIT_BRANCH:-}" == "master" ] && [ "${CI_PROJECT_PATH:-}" == "ghc/ fi fi if [ -n "${IGNORE_PERF_FAILURES:-}" ]; then - RUNTEST_ARGS=( "${RUNTEST_ARGS[@]:-}" "--ignore-perf-failures=$IGNORE_PERF_FAILURES" ) + RUNTEST_ARGS="${RUNTEST_ARGS:-} --ignore-perf-failures=$IGNORE_PERF_FAILURES" fi if [[ -z ${BIGNUM_BACKEND:-} ]]; then BIGNUM_BACKEND=gmp; fi ===================================== changelog.d/27732 ===================================== @@ -0,0 +1,8 @@ +section: language +synopsis: Reject ``~``, ``UNPACK`` and multiplicity annotations on ``type data`` fields +description: + ``type data`` declarations (:extension:`TypeData`) now reject any + strictness, unpackedness or multiplicity annotation on constructor + fields. Previously only ``!`` was rejected. +mrs: !16563 +issues: #27732 ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -294,7 +294,7 @@ type instance XDo GhcPs = (AnnList, EpaLocation) type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type -type instance XExplicitList GhcPs = AnnList +type instance XExplicitList GhcPs = (EpToken "[", EpToken "]") type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type -- GhcPs: ExplicitList includes all source-level @@ -1440,7 +1440,7 @@ type instance XCmdArrApp GhcPs = (IsUnicodeSyntax, EpaLocation) type instance XCmdArrApp GhcRn = NoExtField type instance XCmdArrApp GhcTc = Type -type instance XCmdArrForm GhcPs = AnnList +type instance XCmdArrForm GhcPs = (EpUniToken "(|" "⦇", EpUniToken "|)" "⦈") -- | fixity (filled in by the renamer), for forms that were converted from -- OpApp's by the renamer type instance XCmdArrForm GhcRn = Maybe Fixity ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -104,7 +104,7 @@ type instance XBangPat GhcPs = EpToken "!" type instance XBangPat GhcRn = NoExtField type instance XBangPat GhcTc = NoExtField -type instance XListPat GhcPs = AnnList +type instance XListPat GhcPs = (EpToken "[", EpToken "]") -- After parsing, ListPat can refer to a built-in Haskell list pattern -- or an overloaded list pattern. type instance XListPat GhcRn = NoExtField ===================================== compiler/GHC/Parser.y ===================================== @@ -3282,7 +3282,7 @@ aexp2 :: { ECP } -- arrow notation extension | '(|' aexp cmdargs '|)' {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromCmd $ - amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (ListBanana (epUniTok $1) (epUniTok $4)) []) $2 Prefix + amsA' (sLL $1 $> $ HsCmdArrForm (epUniTok $1, epUniTok $4) $2 Prefix (reverse $3)) } projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } @@ -3414,9 +3414,9 @@ tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)] } -- Never empty. list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b) } : texp { \loc (ao,ac) -> unECP $1 >>= \ $1 -> - mkHsExplicitListPV loc [$1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) []) } + mkHsExplicitListPV loc [$1] (EpTok ao, EpTok ac) } | lexps { \loc (ao,ac) -> $1 >>= \ $1 -> - mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) []) } + mkHsExplicitListPV loc (reverse $1) (EpTok ao, EpTok ac) } | texp '..' { \loc (ao,ac) -> unECP $1 >>= \ $1 -> amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok $2) (EpTok ac)) Nothing (From $1)) >>= ecpFromExp' } ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -519,10 +519,8 @@ data AnnList } deriving (Data,Eq) data AnnListBrackets - = ListParens (EpToken "(") (EpToken ")") - | ListBraces (EpToken "{") (EpToken "}") + = ListBraces (EpToken "{") (EpToken "}") | ListSquare (EpToken "[") (EpToken "]") - | ListBanana (EpUniToken "(|" "⦇") (EpUniToken "|)" "⦈") | ListNone deriving (Data,Eq) @@ -1094,10 +1092,8 @@ instance Outputable AnnList where = text "AnnList" <+> ppr l <+> ppr p <+> ppr s instance Outputable AnnListBrackets where - ppr (ListParens o c) = text "ListParens" <+> ppr o <+> ppr c ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c ppr (ListSquare o c) = text "ListSquare" <+> ppr o <+> ppr c - ppr (ListBanana o c) = text "ListBanana" <+> ppr o <+> ppr c ppr ListNone = text "ListNone" instance Outputable AnnCType where ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1827,7 +1827,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where mkHsTySigPV :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> TokDcolon -> PV (LocatedA b) -- | Disambiguate "[a,b,c]" (list syntax) - mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b) + mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> (EpToken "[", EpToken "]") -> PV (LocatedA b) -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices) mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA b) -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -71,7 +71,6 @@ import GHC.Data.Graph.Directed ( SCC, flattenSCC, Node(..) , stronglyConnCompFromEdgedVerticesUniq ) import GHC.Data.OrdList import qualified GHC.LanguageExtensions as LangExt -import GHC.Core.DataCon ( isSrcStrict ) import Control.Monad import Data.Bifunctor ( first ) @@ -2116,8 +2115,8 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond = do { ; when (has_labelled_fields condecl) $ failWith $ TcRnTypeDataForbids TypeDataForbidsLabelledFields - ; when (has_strictness_flags condecl) $ - failWith $ TcRnTypeDataForbids TypeDataForbidsStrictnessAnnotations + ; when (has_field_annotations condecl) $ + failWith $ TcRnTypeDataForbids TypeDataForbidsFieldAnnotations } has_labelled_fields (ConDeclGADT { con_g_args = RecConGADT _ _ }) = True @@ -2125,13 +2124,19 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond = not (null (unLoc flds)) has_labelled_fields _ = False - has_strictness_flags condecl - = any isSrcStrict (con_arg_bangs condecl) + has_field_annotations condecl + = not (all unannotated (con_arg_fields condecl)) + where + unannotated (CDF { cdf_bang = NoSrcStrict + , cdf_unpack = NoSrcUnpack + , cdf_multiplicity = HsModifiedFunArr _ [] (HsStandardArr _) }) + = True + unannotated _ = False - con_arg_bangs (ConDeclGADT { con_g_args = PrefixConGADT _ args }) = map cdf_bang args - con_arg_bangs (ConDeclH98 { con_args = PrefixCon _ args }) = map cdf_bang args - con_arg_bangs (ConDeclH98 { con_args = InfixCon _ arg1 arg2 }) = [cdf_bang arg1, cdf_bang arg2] - con_arg_bangs _ = [] + con_arg_fields (ConDeclGADT { con_g_args = PrefixConGADT _ args }) = args + con_arg_fields (ConDeclH98 { con_args = PrefixCon _ args }) = args + con_arg_fields (ConDeclH98 { con_args = InfixCon _ arg1 arg2 }) = [arg1, arg2] + con_arg_fields _ = [] {- Note [Type data declarations] @@ -2166,8 +2171,9 @@ preceded by `type`, with the following restrictions: (R2) There are no labelled fields. Perhaps these could be supported using type families, but they are omitted for now. -(R3) There are no strictness flags, because they don't make sense at - the type level. +(R3) There are no strictness, unpackedness or multiplicity annotations + (!, ~, {-# UNPACK #-}, {-# NOUNPACK #-}, %m ->, ⊸), because they + don't make sense at the type level. (R4) The types of the constructors contain no constraints. ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2866,6 +2866,12 @@ data TcRnMessage where type-data/should_fail/TDRecordsH98 type-data/should_fail/TDStrictnessGADT type-data/should_fail/TDStrictnessH98 + type-data/should_fail/T27732a + type-data/should_fail/T27732b + type-data/should_fail/T27732c + type-data/should_fail/T27732d + type-data/should_fail/T27732e + type-data/should_fail/T27732f -} TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage @@ -4541,15 +4547,15 @@ data ZonkerMessage where data TypeDataForbids = TypeDataForbidsDatatypeContexts | TypeDataForbidsLabelledFields - | TypeDataForbidsStrictnessAnnotations + | TypeDataForbidsFieldAnnotations | TypeDataForbidsDerivingClauses deriving Generic instance Outputable TypeDataForbids where - ppr TypeDataForbidsDatatypeContexts = text "Data type contexts" - ppr TypeDataForbidsLabelledFields = text "Labelled fields" - ppr TypeDataForbidsStrictnessAnnotations = text "Strictness flags" - ppr TypeDataForbidsDerivingClauses = text "Deriving clauses" + ppr TypeDataForbidsDatatypeContexts = text "Data type contexts" + ppr TypeDataForbidsLabelledFields = text "Labelled fields" + ppr TypeDataForbidsFieldAnnotations = text "Strictness, unpackedness or multiplicity annotations" + ppr TypeDataForbidsDerivingClauses = text "Deriving clauses" -- | Specifies which back ends can handle a requested foreign import or export type ExpectedBackends = [Backend] ===================================== docs/users_guide/exts/type_data.rst ===================================== @@ -33,7 +33,8 @@ either an ordinary algebraic data type or a GADT, prefixed with the keyword ``type``, except that it may not contain a datatype context (even with :extension:`DatatypeContexts`), labelled fields, -strictness flags, or +:ref:`strictness <strict-haskell>`, :ref:`unpackedness <unpack-pragma>` or +:ref:`multiplicity <linear-types>` annotations, or a ``deriving`` clause. The only constraints permitted in the types of constructors are ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -258,7 +258,7 @@ test('T24893', normal, compile_and_run, ['-O']) test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c']) test('T25364', normal, compile_and_run, ['']) test('T26061', normal, compile_and_run, ['']) -test('T26537', normal, compile_and_run, ['-O2 -fregs-graph']) +test('T26537', compile_timeout_multiplier(1.5), compile_and_run, ['-O2 -fregs-graph']) test('T24016', normal, compile_and_run, ['-O1 -fPIC']) test('T27046', [ req_cmm ===================================== testsuite/tests/ghc-api/T25121_status.stdout ===================================== @@ -15,7 +15,7 @@ X(FunArr) match = NoExtField X(ExprWithTySig) match = EpUniToken "::" "\8759" X(UntypedSplice) match = NoExtField X(ExplicitList) mismatch - >>> AnnList + >>> ((EpToken "["),(EpToken "]")) <<< ((EpToken "'"),(EpToken "["),(EpToken "]")) X(ExplicitTuple) mismatch >>> AnnParen ===================================== testsuite/tests/type-data/should_fail/T27732a.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeData, LazyFieldAnnotations #-} +module T27732a where + +type data T a = Cons ~a ===================================== testsuite/tests/type-data/should_fail/T27732a.stderr ===================================== @@ -0,0 +1,3 @@ +T27732a.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732b.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeData, LazyFieldAnnotations #-} +module T27732b where + +type data T a where + Cons :: ~a -> T a ===================================== testsuite/tests/type-data/should_fail/T27732b.stderr ===================================== @@ -0,0 +1,3 @@ +T27732b.hs:5:6: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732c.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeData #-} +module T27732c where + +type data T a = Cons {-# UNPACK #-} a ===================================== testsuite/tests/type-data/should_fail/T27732c.stderr ===================================== @@ -0,0 +1,3 @@ +T27732c.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732d.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeData #-} +module T27732d where + +type data T a = Cons {-# NOUNPACK #-} a ===================================== testsuite/tests/type-data/should_fail/T27732d.stderr ===================================== @@ -0,0 +1,3 @@ +T27732d.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732e.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeData, LinearTypes #-} +module T27732e where + +type data T where + MkT :: Int %1 -> T ===================================== testsuite/tests/type-data/should_fail/T27732e.stderr ===================================== @@ -0,0 +1,3 @@ +T27732e.hs:5:3: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/T27732f.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeData, LinearTypes, UnicodeSyntax #-} +module T27732f where + +type data T where + MkT :: Int ⊸ T ===================================== testsuite/tests/type-data/should_fail/T27732f.stderr ===================================== @@ -0,0 +1,3 @@ +T27732f.hs:5:3: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. + ===================================== testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr ===================================== @@ -1,3 +1,3 @@ +TDStrictnessGADT.hs:5:6: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. -TDStrictnessGADT.hs:5:6: [GHC-67297] - Strictness flags are not allowed in type data declarations. ===================================== testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr ===================================== @@ -1,3 +1,3 @@ +TDStrictnessH98.hs:4:17: error: [GHC-67297] + Strictness, unpackedness or multiplicity annotations are not allowed in type data declarations. -TDStrictnessH98.hs:4:17: [GHC-67297] - Strictness flags are not allowed in type data declarations. ===================================== testsuite/tests/type-data/should_fail/all.T ===================================== @@ -13,3 +13,9 @@ test('TDStrictnessGADT', normal, compile_fail, ['']) test('TDStrictnessH98', normal, compile_fail, ['']) test('TDTagToEnum', normal, compile_fail, ['']) test('T22332b', normal, compile_fail, ['']) +test('T27732a', normal, compile_fail, ['']) +test('T27732b', normal, compile_fail, ['']) +test('T27732c', normal, compile_fail, ['']) +test('T27732d', normal, compile_fail, ['']) +test('T27732e', normal, compile_fail, ['']) +test('T27732f', normal, compile_fail, ['']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -140,9 +140,9 @@ defaultEPState = EPState -- | The R part of RWS. The environment. Updated via 'local' as we -- enter a new AST element, having a different anchor point. -data EPOptions m a = EPOptions - { epTokenPrint :: String -> m a - , epWhitespacePrint :: String -> m a +data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w } -- | Helper to create a 'EPOptions' @@ -163,8 +163,7 @@ stringOptions = epOptions return return deltaOptions :: EPOptions Identity () deltaOptions = epOptions (\_ -> return ()) (\_ -> return ()) -data EPWriter a = EPWriter - { output :: !a } +data EPWriter w = EPWriter { output :: !w } instance Monoid w => Semigroup (EPWriter w) where (EPWriter a) <> (EPWriter b) = EPWriter (a <> b) @@ -239,7 +238,220 @@ setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = -- | Key entry point. Switches to an independent AST element with its -- own annotation, calculating new offsets, etc markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a -markAnnotated a = enterAnn (getAnnotationEntry a) a +markAnnotated a = enterAnn (getAnnotationEntry a) a -- See Note [Exact print main loop] + +{- +Note [Exact print main loop] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Exact printing is the process of taking the ParsedSource, or some +subtree from it, and rendering it to a string, which accurately +reflects the original source that was parsed, except detail of +whitespace (such as spaces vs tabs) is discarded. + +The ParsedSource or fragment from it must implement the ExactPrint +class, and this file does that, as well as supporting machinery to +drive the process. The ExactPrint class is described later in this +note. + +The entry point for exact printing is the exactPrint function, defined +as + + exactPrint :: ExactPrint ast => ast -> String + exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast)) + + type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a + + runEP :: (Monad m) => EPOptions m w -> EP w m a -> m (a, w) + runEP epReader action = do + (ast, w) <- evalRWST action epReader defaultEPState + return (ast, output w) + + data EPWriter w = EPWriter { output :: !w } + + data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w + } + +This offers some flexibility in how the output is produced, in that +the EpWriter and EPOptions work together, defining an output type and +a function to render whitespace and non-whitepace. + +In normal operation (via exactPrint) these are simply returning the +string unchanged and accumulating a larger string. But it has also been +used to render an HTML version of the source as it prints. + +The main reason exact print exists is to make it easier for tool +writers to manipulate the ParsedSource, and render this back to the +original source, except for the changed parts. One manipulation is to +simply take say a FunBind with its signature from one place in the +code to another. When doing this, the original parsed locations are no +longer useful when rendering the source back to a string. To enable +this, we have another entry point, for converting all absolute +locations to relative ones, using DeltaPos, which captures the line +and col offset relative to the prior output. + +The function to do this is + + makeDeltaAst :: ExactPrint ast => ast -> ast + makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast)) + +The implementation is practically identical for exactPrint and +makeDeltaAst, they simply return the second or first part of the same +calculation. + +This simplifies the implementation of the required ExactPrint +implmentations, in that we only need one per ast item, which encodes +how to print it, and this print process does bookkeeping to keep track +of what spacing it used when doing the print, so it can return the +updated item, with the original absolute SrcSpan's converted to +DeltaPos values instead. + +This information is captured in the XRec/Anno instances used in GHC +Hs, which are mostly LocatedA a, defined as + + GenLocated (EpAnn [TrailingAnn]) a + + data EpAnn ann + = EpAnn { entry :: !EpaLocation + , anns :: !ann + , comments :: !EpAnnComments + } + + data EpaLocation = EpaSpan !SrcSpan + | EpaDelta !SrcSpan !DeltaPos [LEpaComment] + +When parsed, the entry EpaLocation captures an EpaSpan with the parsed +absolute location. After makeDeltaAst, this instead uses EpaDelta, +including the original SrcSpan, the relative spaceing as a DeltaPos, +and any comments that may come before the item, e.g. comments before a +semicolon. + +Both exactPrint and makeDeltaAst call markAnnotated on the item to be +printed, inside the monad machinery. + + markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a + markAnnotated a = enterAnn (getAnnotationEntry a) a + +This makes use of the ExactPrint instance for the ParsedSource and +for every other part of the ParsedSource as a tree. + + class (Typeable a) => ExactPrint a where + getAnnotationEntry :: a -> Entry + exact :: (Monad m, Monoid w) => a -> EP w m a + setAnnotationAnchor :: a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a + +- getAnnotationEntry : returns the Entry information, normally derived + directly from the EpAnn in the LocatedA enclosing the item. + Entry contains + - The location of the first non-comment part of the item to be printed. + - Any [TrailingAnn] (semis, commas, etc) to follow the item. + - Any comments associated with the item, but not with enclosed items. + These comments may also precede or follow the entry location + - Some technical flags, relating to flushing remaining comments at the + last (topmost) item, and if the anchor can be updated (see below). + +- exact : Do the actual printing of the item, having been put in the right + place in terms of print location by the main loop, based on a call to + getAnnotationEntry for it. This printing normally comprises making nested + markAnnotated calls on the nested items in the current one, e.g. + + exact (HsApp an e1 e2) = do + e1' <- markAnnotated e1 + e2' <- markAnnotated e2 + return (HsApp an e1' e2') + +- setAnnotationAnchor : the main loop printing does two things: + - produce output, reflecting the items being printed + - convert all the locations in the item (each an EpaLocation) from its + EpaSpan version to an EpaDelta one, which is independent of absolute + location, being the spacing from the previous print output to this + entry point + To allow these updated locations to be captured, the item implements + the setAnnotationAnchor method, which updates the fields of the Entry + returned by getAnnotationEntry + +You will recall + + markAnnotated a = enterAnn (getAnnotationEntry a) a + enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a + +enterAnn is the part that is repeatedly called via markAnnotated, to +manage the bookkeeping around printing and calculating the updated +delta positions. + +It manages the printing state, adding the new comments from the Entry, +positioning the print head to the entry point, takes account of whether +it is an absolute span or a delta, and prints any comments that must come +before this location. + +At this print location, it calls the `exact` method on the item. This +is the only place `exact` can be called. Within `exact` implementations +the `markAnnotated` function should be used instead, to ensure the state +is managed properly for printing. + +Once the item is printed via its `exact` method, which normally +recurses via `markAnnotated` into any nested items inside it, the +`enterAnn` function prints any [TrailingAnn] from the entry and any +trailing comments. It then wraps up by calling +`setAnnotationAnchor`with the updated (now delta-based) values for the +Entry + +Printing Complicated Items +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes we need to print a sub-item which does not map cleanly onto the +ExactPrint class, usually because there are parts spread through the item +that need to be managed together while printing. + +An example is in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16321, where +ConDeclGADT needs to print its inner_bindings, but the these in turn +may have parens, e.g. + + data V a where + MkV4 :: forall a. ((forall b. (Show a => a -> (b -> V a)))) + +Here there are inner bindings for the first forall, the multiple +parens around the second forall, and the second forall, wrapping the +inner content within this. + +But the inner content `Show a => a -> (b -> V a)` had to be printed "inside" +the inner_bindings, to correctly close the nested parens. + +The approach in !16321 modified `enterAnn`, to pass in alternate versions +of the `exact` implementation. This works, but it makes an already +complicated function even more complicated. + +An ExactPrint-idiomatic approach is to create a helper data structure +to represent this nested organisation, and provide ExactPrint +instances for that. + +This is done in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16644, using + + data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +The key part of the ExactPrint instance for this is + + exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do + lp' <- markEpToken lp + xs' <- markAnnotated xs + rp' <- markEpToken rp + return (InnerMore (L l (HsGadtPar (lp',rp'))) xs') + +This first prints the opening paren, prints the balance of the cons list, then +prints the closing paren. + +Conversions to and from this structure populate the initial values from +the ConDeclGADT, and retrieve the updated delta-based values after +printing. + +Another use of this technique involves HsModuleImpDecls. + +-} -- | For HsModule, because we do not have a proper SrcSpan, we must -- indicate to flush trailing comments when done. @@ -377,6 +589,7 @@ cua NoCanUpdateAnchor _ = return [] -- This is combination of the ghc=exactprint Delta.withAST and -- Print.exactPC functions and effectively does the delta processing -- immediately followed by the print processing. JIT ghc-exactprint. +-- See Note [Exact print main loop] enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a enterAnn NoEntryVal a = do p <- getPosP @@ -764,18 +977,12 @@ markLensBracketsO' :: (Monad m, Monoid w) => a -> Lens a AnnListBrackets -> EP w m a markLensBracketsO' a l = case view l a of - ListParens o c -> do - o' <- markEpToken o - return (set l (ListParens o' c) a) ListBraces o c -> do o' <- markEpToken o return (set l (ListBraces o' c) a) ListSquare o c -> do o' <- markEpToken o return (set l (ListSquare o' c) a) - ListBanana o c -> do - o' <- markEpUniToken o - return (set l (ListBanana o' c) a) ListNone -> return (set l ListNone a) markLensBracketsC :: (Monad m, Monoid w) @@ -786,18 +993,12 @@ markLensBracketsC' :: (Monad m, Monoid w) => a -> Lens a AnnListBrackets -> EP w m a markLensBracketsC' a l = case view l a of - ListParens o c -> do - c' <- markEpToken c - return (set l (ListParens o c') a) ListBraces o c -> do c' <- markEpToken c return (set l (ListBraces o c') a) ListSquare o c -> do c' <- markEpToken c return (set l (ListSquare o c') a) - ListBanana o c -> do - c' <- markEpUniToken c - return (set l (ListBanana o c') a) ListNone -> return (set l ListNone a) -- ------------------------------------- @@ -2919,13 +3120,13 @@ instance ExactPrint (HsExpr GhcPs) where (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts return (HsDo (an',l') do_or_list_comp stmts') - exact (ExplicitList an es) = do + exact (ExplicitList (o,c) es) = do debugM $ "ExplicitList start" - an0 <- markLensBracketsO' an lal_brackets + o' <- markEpToken o es' <- mapM markAnnotated es - an1 <- markLensBracketsC' an0 lal_brackets + c' <- markEpToken c debugM $ "ExplicitList end" - return (ExplicitList an1 es') + return (ExplicitList (o',c') es') exact (RecordCon x con_id binds) = do con_id' <- markAnnotated con_id binds' <- markAnnotated binds @@ -3335,8 +3536,8 @@ instance ExactPrint (HsCmd GhcPs) where arr' <- markAnnotated arr return (HsCmdArrApp (isU, l') arr' arg' HsHigherOrderApp False) - exact (HsCmdArrForm an e fixity cs) = do - an0 <- markLensBracketsO' an lal_brackets + exact (HsCmdArrForm (o,c) e fixity cs) = do + o' <- markEpUniToken o (e',cs') <- case (fixity, cs) of (Infix, (arg1:argrest)) -> do arg1' <- markAnnotated arg1 @@ -3348,8 +3549,8 @@ instance ExactPrint (HsCmd GhcPs) where cs' <- mapM markAnnotated cs return (e', cs') (Infix, []) -> error "Not possible" - an1 <- markLensBracketsC' an0 lal_brackets - return (HsCmdArrForm an1 e' fixity cs') + c' <- markEpUniToken c + return (HsCmdArrForm (o',c') e' fixity cs') exact (HsCmdApp an e1 e2) = do e1' <- markAnnotated e1 @@ -4671,9 +4872,11 @@ instance ExactPrint (Pat GhcPs) where pat' <- markAnnotated pat return (BangPat an0 pat') - exact (ListPat an pats) = do - (an', pats') <- markAnnList' an (mapM markAnnotated pats) - return (ListPat an' pats') + exact (ListPat (os,cs) pats) = do + os' <- markEpToken os + pats' <- mapM markAnnotated pats + cs' <- markEpToken cs + return (ListPat (os',cs') pats') exact (TuplePat an pats boxity) = do an0 <- markOpeningParen an ===================================== utils/check-exact/Utils.hs ===================================== @@ -342,10 +342,8 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports (xs',rest') = allocPreceding xs rest annListBracketsLocs :: AnnListBrackets -> (EpaLocation,EpaLocation) -annListBracketsLocs (ListParens o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBraces o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) -annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) data SplitWhere = Before | After View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dac5eca9e828f86c6390f0b1ad27fa… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dac5eca9e828f86c6390f0b1ad27fa… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/apk/unfold-dicts] Try discounting args applied to a result of a class op
by Andreas Klebinger (＠AndreasK) 12 Sep '26

12 Sep '26

Andreas Klebinger pushed to branch wip/apk/unfold-dicts at Glasgow Haskell Compiler / GHC Commits: 6a40d4b6 by Andreas Klebinger at 2026-09-11T20:24:24+02:00 Try discounting args applied to a result of a class op - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Core.Utils import GHC.Core.DataCon import GHC.Core.Type import GHC.Core.Class( Class ) -import GHC.Core.Predicate( isUnaryClass ) +import GHC.Core.Predicate( isUnaryClass, isDictId ) import GHC.Types.Id import GHC.Types.Literal @@ -782,7 +782,7 @@ classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize classOpSize _opts _cls _top_args [] = sizeZero -- A non-applied classop classOpSize opts cls top_args (dict_arg:other_val_args) - = SizeIs size (dict_arg_discount dict_arg) 0 + = SizeIs size dict_arg_discount 0 where -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon op_app_size = if isUnaryClass cls then 0 else 20 @@ -797,8 +797,8 @@ classOpSize opts cls top_args (dict_arg:other_val_args) -- give it a discount, to encourage the inlining of this function dict_arg_discount = case getIdFromTrivialExpr_maybe dict_arg of Nothing -> emptyBag - Just var - | var `elem` top_args = unitBag (dict, dict_discount) + Just dict + | dict `elem` top_args -> unitBag (dict, dict_discount) | otherwise -> emptyBag -- If we have (class-op d arg1 .. argn) then it's super-good to inline @@ -808,7 +808,15 @@ classOpSize opts cls top_args (dict_arg:other_val_args) -- See the discussion on #26831, esp "Delicate inlining". dict_discount | null other_val_args = unfoldingDictDiscount opts - | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts + | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts + + -- Just trying things. + 5 * numTopDictArgs + numTopDictArgs = (count (isTopArgDict) other_val_args) + isTopArgDict expr + | Just v <- getIdFromTrivialExpr_maybe expr + , v `elem` top_args + = isDictId v + | otherwise = False -- | The size of a function call callSize View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a40d4b68d3bdfd7c5d3f9f1627ed32… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a40d4b68d3bdfd7c5d3f9f1627ed32… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/apk/unfold-dicts
by Andreas Klebinger (＠AndreasK) 12 Sep '26

12 Sep '26

Andreas Klebinger pushed new branch wip/apk/unfold-dicts at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/apk/unfold-dicts You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0