- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/sol/remove-ddump-json] 10 commits: Refactoring: Don't misuse `MCDiagnostic` for lint messages
by Simon Hengel (＠sol) 09 Aug '25

09 Aug '25

Simon Hengel pushed to branch wip/sol/remove-ddump-json at Glasgow Haskell Compiler / GHC Commits: f99e4bae by Simon Hengel at 2025-08-09T16:50:20+07:00 Refactoring: Don't misuse `MCDiagnostic` for lint messages `MCDiagnostic` is meant to be used for compiler diagnostics. Any code that creates `MCDiagnostic` directly, without going through `GHC.Driver.Errors.printMessage`, side steps `-fdiagnostics-as-json` (see e.g. !14475, !14492 !14548). To avoid this in the future I want to control more narrowly who creates `MCDiagnostic` (see #24113). Some parts of the compiler use `MCDiagnostic` purely for formatting purposes, without creating any real compiler diagnostics. This change introduces a helper function, `formatDiagnostic`, that can be used in such cases instead of constructing `MCDiagnostic`. - - - - - a5393c7b by Simon Hengel at 2025-08-09T16:50:40+07:00 Rename MCDiagnostic to UnsafeMCDiagnostic - - - - - 3b67a005 by Simon Hengel at 2025-08-09T16:50:40+07:00 Remove -ddump-json (fixes #24113) - - - - - e06295d3 by Simon Hengel at 2025-08-09T16:50:40+07:00 Add SrcSpan to MCDiagnostic - - - - - 8c0d0320 by Simon Hengel at 2025-08-09T16:50:40+07:00 Refactoring: More consistently use logOutput, logInfo, fatalErrorMsg - - - - - e61d74f4 by Simon Hengel at 2025-08-09T16:50:40+07:00 Get rid of mkLocMessage - - - - - 26fe025d by Simon Hengel at 2025-08-09T16:50:40+07:00 Add Message data type - - - - - 0fe6bd7f by Simon Hengel at 2025-08-09T16:50:40+07:00 Get rid of MessageClass - - - - - 8e45d9f3 by Simon Hengel at 2025-08-09T16:50:40+07:00 Rename DiagnosticMessage to GenericDiagnosticMessage - - - - - 42b5dedb by Simon Hengel at 2025-08-09T16:50:40+07:00 Remove JSON logging - - - - - 36 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Monad.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Debugger.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/SourceError.hs - compiler/GHC/Utils/Error.hs - compiler/GHC/Utils/Logger.hs - docs/users_guide/debugging.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/T16167.stderr - − testsuite/tests/driver/T16167.stdout - testsuite/tests/driver/all.T - testsuite/tests/driver/json2.stderr - − testsuite/tests/driver/json_dump.hs - − testsuite/tests/driver/json_dump.stderr - utils/check-exact/Main.hs - utils/check-exact/Preprocess.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/f3a82a3d650fe6703cf0369ecf31e5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3a82a3d650fe6703cf0369ecf31e5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sol/lint-messages] Refactoring: Don't misuse `MCDiagnostic` for lint messages
by Simon Hengel (＠sol) 09 Aug '25

09 Aug '25

Simon Hengel pushed to branch wip/sol/lint-messages at Glasgow Haskell Compiler / GHC Commits: f99e4bae by Simon Hengel at 2025-08-09T16:50:20+07:00 Refactoring: Don't misuse `MCDiagnostic` for lint messages `MCDiagnostic` is meant to be used for compiler diagnostics. Any code that creates `MCDiagnostic` directly, without going through `GHC.Driver.Errors.printMessage`, side steps `-fdiagnostics-as-json` (see e.g. !14475, !14492 !14548). To avoid this in the future I want to control more narrowly who creates `MCDiagnostic` (see #24113). Some parts of the compiler use `MCDiagnostic` purely for formatting purposes, without creating any real compiler diagnostics. This change introduces a helper function, `formatDiagnostic`, that can be used in such cases instead of constructing `MCDiagnostic`. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3418,7 +3418,7 @@ addMsg show_context env msgs msg [] -> noSrcSpan (s:_) -> s !diag_opts = le_diagOpts env - mk_msg msg = mkLocMessage (mkMCDiagnostic diag_opts WarningWithoutFlag Nothing) msg_span + mk_msg msg = mkLintWarning diag_opts msg_span (msg $$ context) addLoc :: LintLocInfo -> LintM a -> LintM a ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -107,7 +107,6 @@ import GHC.Core.Type import GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isMarkedCbv ) import GHC.Types.CostCentre ( isCurrentCCS ) -import GHC.Types.Error ( DiagnosticReason(WarningWithoutFlag) ) import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom ) @@ -116,7 +115,7 @@ import GHC.Types.SrcLoc import GHC.Utils.Logger import GHC.Utils.Outputable -import GHC.Utils.Error ( mkLocMessage, DiagOpts ) +import GHC.Utils.Error ( DiagOpts ) import qualified GHC.Utils.Error as Err import GHC.Unit.Module ( Module ) @@ -540,7 +539,7 @@ addErr diag_opts errs_so_far msg locs = errs_so_far `snocBag` mk_msg locs where mk_msg (loc:_) = let (l,hdr) = dumpLoc loc - in mkLocMessage (Err.mkMCDiagnostic diag_opts WarningWithoutFlag Nothing) + in Err.mkLintWarning diag_opts l (hdr $$ msg) mk_msg [] = msg ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -72,6 +72,7 @@ module GHC.Types.Error , pprMessageBag , mkLocMessage , mkLocMessageWarningGroups + , formatDiagnostic , getCaretDiagnostic , jsonDiagnostic @@ -495,11 +496,11 @@ data MessageClass -- ^ Diagnostics from the compiler. This constructor is very powerful as -- it allows the construction of a 'MessageClass' with a completely -- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such, - -- users are encouraged to use the 'mkMCDiagnostic' smart constructor + -- users are encouraged to use higher level primitives -- instead. Use this constructor directly only if you need to construct -- and manipulate diagnostic messages directly, for example inside -- 'GHC.Utils.Error'. In all the other circumstances, /especially/ when - -- emitting compiler diagnostics, use the smart constructor. + -- emitting compiler diagnostics, use higher level primitives. -- -- The @Maybe 'DiagnosticCode'@ field carries a code (if available) for -- this diagnostic. If you are creating a message not tied to any @@ -656,32 +657,51 @@ mkLocMessageWarningGroups -> SrcSpan -- ^ location -> SDoc -- ^ message -> SDoc - -- Always print the location, even if it is unhelpful. Error messages - -- are supposed to be in a standard format, and one without a location - -- would look strange. Better to say explicitly "<no location info>". mkLocMessageWarningGroups show_warn_groups msg_class locn msg - = sdocOption sdocColScheme $ \col_scheme -> - let locn' = sdocOption sdocErrorSpans $ \case - True -> ppr locn - False -> ppr (srcSpanStart locn) - + = case msg_class of + MCDiagnostic severity reason code -> formatDiagnostic show_warn_groups locn severity reason code msg + _ -> sdocOption sdocColScheme $ \col_scheme -> + let msg_colour = getMessageClassColour msg_class col_scheme - col = coloured msg_colour . text msg_title = coloured msg_colour $ case msg_class of - MCDiagnostic SevError _ _ -> text "error" - MCDiagnostic SevWarning _ _ -> text "warning" MCFatal -> text "fatal" _ -> empty + in formatLocMessageWarningGroups locn msg_title empty empty msg + +formatDiagnostic + :: Bool -- ^ Print warning groups? + -> SrcSpan -- ^ location + -> Severity + -> ResolvedDiagnosticReason + -> Maybe DiagnosticCode + -> SDoc -- ^ message + -> SDoc +formatDiagnostic show_warn_groups locn severity reason code msg + = sdocOption sdocColScheme $ \col_scheme -> + let + msg_colour :: Col.PprColour + msg_colour = getSeverityColour severity col_scheme + + col :: String -> SDoc + col = coloured msg_colour . text + + msg_title :: SDoc + msg_title = coloured msg_colour $ + case severity of + SevError -> text "error" + SevWarning -> text "warning" + SevIgnore -> empty + + warning_flag_doc :: SDoc warning_flag_doc = - case msg_class of - MCDiagnostic sev reason _code - | Just msg <- flag_msg sev (resolvedDiagnosticReason reason) - -> brackets msg - _ -> empty + case flag_msg severity (resolvedDiagnosticReason reason) of + Nothing -> empty + Just msg -> brackets msg + ppr_with_hyperlink :: DiagnosticCode -> SDoc ppr_with_hyperlink code = -- this is a bit hacky, but we assume that if the terminal supports colors -- then it should also support links @@ -691,10 +711,11 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg then ppr $ LinkedDiagCode code else ppr code + code_doc :: SDoc code_doc = - case msg_class of - MCDiagnostic _ _ (Just code) -> brackets (ppr_with_hyperlink code) - _ -> empty + case code of + Just code -> brackets (ppr_with_hyperlink code) + Nothing -> empty flag_msg :: Severity -> DiagnosticReason -> Maybe SDoc flag_msg SevIgnore _ = Nothing @@ -725,13 +746,35 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg vcat [ text "locn:" <+> ppr locn , text "msg:" <+> ppr msg ] + warn_flag_grp :: [WarningGroup] -> SDoc warn_flag_grp groups | show_warn_groups, not (null groups) = text $ "(in " ++ intercalate ", " (map (("-W"++) . warningGroupName) groups) ++ ")" | otherwise = empty + in formatLocMessageWarningGroups locn msg_title code_doc warning_flag_doc msg + +formatLocMessageWarningGroups + :: SrcSpan -- ^ location + -> SDoc -- ^ title + -> SDoc -- ^ diagnostic code + -> SDoc -- ^ warning groups + -> SDoc -- ^ message + -> SDoc +formatLocMessageWarningGroups locn msg_title code_doc warning_flag_doc msg + = sdocOption sdocColScheme $ \col_scheme -> + let + -- Always print the location, even if it is unhelpful. Error messages + -- are supposed to be in a standard format, and one without a location + -- would look strange. Better to say explicitly "<no location info>". + locn' :: SDoc + locn' = sdocOption sdocErrorSpans $ \case + True -> ppr locn + False -> ppr (srcSpanStart locn) + -- Add prefixes, like Foo.hs:34: warning: -- <the warning message> + header :: SDoc header = locn' <> colon <+> msg_title <> colon <+> code_doc <+> warning_flag_doc @@ -741,11 +784,16 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg msg) getMessageClassColour :: MessageClass -> Col.Scheme -> Col.PprColour -getMessageClassColour (MCDiagnostic SevError _reason _code) = Col.sError -getMessageClassColour (MCDiagnostic SevWarning _reason _code) = Col.sWarning +getMessageClassColour (MCDiagnostic severity _reason _code) = getSeverityColour severity getMessageClassColour MCFatal = Col.sFatal getMessageClassColour _ = const mempty +getSeverityColour :: Severity -> Col.Scheme -> Col.PprColour +getSeverityColour severity = case severity of + SevError -> Col.sError + SevWarning -> Col.sWarning + SevIgnore -> const mempty + getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty getCaretDiagnostic msg_class (RealSrcSpan span _) = ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Utils.Error ( emptyMessages, mkDecorated, mkLocMessage, mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope, mkErrorMsgEnvelope, - mkMCDiagnostic, diagReasonSeverity, + mkLintWarning, diagReasonSeverity, mkPlainError, mkPlainDiagnostic, @@ -160,12 +160,10 @@ diag_reason_severity opts reason = fmap ResolvedDiagnosticReason $ case reason o ErrorWithoutFlag -> (SevError, reason) --- | Make a 'MessageClass' for a given 'DiagnosticReason', consulting the --- 'DiagOpts'. -mkMCDiagnostic :: DiagOpts -> DiagnosticReason -> Maybe DiagnosticCode -> MessageClass -mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code +mkLintWarning :: DiagOpts -> SrcSpan -> SDoc -> SDoc +mkLintWarning opts span = formatDiagnostic True span severity reason Nothing where - (sev, reason') = diag_reason_severity opts reason + (severity, reason) = diag_reason_severity opts WarningWithoutFlag -- -- Creating MsgEnvelope(s) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f99e4baee82989bf2fd49cdae241d55… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f99e4baee82989bf2fd49cdae241d55… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/warning-for-last-and-init] 2 commits: Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial
by Bodigrim (＠Bodigrim) 08 Aug '25

08 Aug '25

Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC Commits: b85020f5 by Mike Pilgrem at 2025-08-08T23:24:01+01:00 Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`). In module `Settings.Warnings`, applies `-Wno-unrecognised-warning-flags` `-Wno-x-partial` to the `Cabal`, `filepath`, `hsc2hs`, `hpc`, `parsec`, `text` and `time` packages (outside GHC's repository). Also bumps submodules. - - - - - b0bc00e3 by Andrew Lelechenko at 2025-08-08T23:28:52+01:00 Wibble - - - - - 25 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Prelude/Basic.hs - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/src/Settings/Warnings.hs - libraries/Cabal - libraries/filepath - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs - testsuite/tests/driver/j-space/jspace.hs - testsuite/tests/rts/KeepCafsBase.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs - utils/ghc-pkg/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/hpc - utils/hsc2hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -112,8 +112,7 @@ import GHC.Utils.Misc import Data.ByteString ( ByteString ) import Data.Function ( on ) -import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) -import qualified Data.List as Partial ( init, last ) +import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL, unsnoc ) import Data.Ord ( comparing ) import Control.Monad ( guard ) import qualified Data.Set as Set @@ -1871,10 +1870,10 @@ app_ok fun_ok primop_ok fun args PrimOpId op _ | primOpIsDiv op - , Lit divisor <- Partial.last args + , Just (initArgs, Lit divisor) <- unsnoc args -- there can be 2 args (most div primops) or 3 args -- (WordQuotRem2Op), hence the use of last/init - -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (Partial.init args) + -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) initArgs -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation -- (which primop_ok will catch), but they ARE OK ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE TupleSections #-} +{-# OPTIONS_GHC -Wno-x-partial #-} + module GHC.Driver.Session.Units (initMake, initMulti) where -- The official GHC API ===================================== compiler/GHC/Prelude/Basic.hs ===================================== @@ -2,8 +2,8 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -O2 #-} -- See Note [-O2 Prelude] --- See Note [Proxies for head and tail] -{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-x-partial #-} +-- See Note [Proxies for partial list functions] +{-# OPTIONS_GHC -Wno-x-partial #-} -- | Custom minimal GHC "Prelude" -- @@ -24,7 +24,7 @@ module GHC.Prelude.Basic , bit , shiftL, shiftR , setBit, clearBit - , head, tail, unzip + , head, tail, init, last, unzip , strictGenericLength ) where @@ -59,7 +59,7 @@ NoImplicitPrelude. There are two motivations for this: -} import qualified Prelude -import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, unzip) +import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, init, last, unzip) import Control.Applicative (Applicative(..)) import Data.Foldable as X (Foldable (elem, foldMap, foldl, foldl', foldr, length, null, product, sum)) import Data.Foldable1 as X hiding (head, last) @@ -118,24 +118,35 @@ setBit = \ x i -> x Bits..|. bit i clearBit :: (Num a, Bits.Bits a) => a -> Int -> a clearBit = \ x i -> x Bits..&. Bits.complement (bit i) -{- Note [Proxies for head and tail] +{- Note [Proxies for partial list functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Prelude.head and Prelude.tail have recently acquired {-# WARNING in "x-partial" #-}, +Prelude.head, Prelude.tail, Prelude.init and Prelude.last +have recently acquired {-# WARNING in "x-partial" #-}, but the GHC codebase uses them fairly extensively and insists on building warning-free. Thus, instead of adding {-# OPTIONS_GHC -Wno-x-partial #-} to every module which employs them, we define warning-less proxies and export them from GHC.Prelude. -} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] head :: HasCallStack => [a] -> a head = Prelude.head {-# INLINE head #-} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] tail :: HasCallStack => [a] -> [a] tail = Prelude.tail {-# INLINE tail #-} +-- See Note [Proxies for partial list functions] +init :: HasCallStack => [a] -> [a] +init = Prelude.init +{-# INLINE init #-} + +-- See Note [Proxies for partial list functions] +last :: HasCallStack => [a] -> a +last = Prelude.last +{-# INLINE last #-} + {- | The 'genericLength' function defined in base can't be specialised due to the NOINLINE pragma. ===================================== ghc/GHCi/UI.hs ===================================== @@ -133,7 +133,7 @@ import Data.Char import Data.Function import qualified Data.Foldable as Foldable import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) -import Data.List ( find, intercalate, intersperse, +import Data.List ( find, intercalate, intersperse, unsnoc, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) import qualified Data.List.NonEmpty as NE import qualified Data.Set as S @@ -2402,9 +2402,9 @@ setContextAfterLoad keep_ctxt (Just graph) = do [] -> let graph' = flattenSCCs $ filterToposortToModules $ GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing - in case graph' of - [] -> setContextKeepingPackageModules keep_ctxt [] - xs -> load_this (last xs) + in case unsnoc graph' of + Nothing -> setContextKeepingPackageModules keep_ctxt [] + Just (_, lst) -> load_this lst (m:_) -> load_this m where ===================================== ghc/Main.hs ===================================== @@ -88,7 +88,7 @@ import System.Exit import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Except (throwE, runExceptT) -import Data.List ( isPrefixOf, partition, intercalate ) +import Data.List ( isPrefixOf, partition, intercalate, unsnoc ) import Prelude import qualified Data.List.NonEmpty as NE @@ -115,8 +115,7 @@ main = do argv0 <- getArgs let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0 - mbMinusB | null minusB_args = Nothing - | otherwise = Just (drop 2 (last minusB_args)) + mbMinusB = drop 2 . snd <$> unsnoc minusB_args let argv2 = map (mkGeneralLocated "on the commandline") argv1 ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -72,7 +72,10 @@ ghcWarningsArgs = do , package terminfo ? pure [ "-Wno-unused-imports", "-Wno-deriving-typeable" ] , package stm ? pure [ "-Wno-deriving-typeable" ] , package osString ? pure [ "-Wno-deriving-typeable", "-Wno-unused-imports" ] - , package parsec ? pure [ "-Wno-deriving-typeable" ] + , package parsec ? pure [ "-Wno-deriving-typeable" + , "-Wno-x-partial" + -- https://github.com/haskell/parsec/issues/194 + ] , package cabal ? pure [ "-Wno-deriving-typeable", "-Wno-incomplete-record-selectors" ] -- The -Wno-incomplete-record-selectors is due to @@ -80,7 +83,9 @@ ghcWarningsArgs = do -- If that ticket is fixed, bwe can remove the flag again , package cabalSyntax ? pure [ "-Wno-deriving-typeable" ] - , package time ? pure [ "-Wno-deriving-typeable" ] + , package time ? pure [ "-Wno-deriving-typeable" + , "-Wno-x-partial" -- Awaiting time-1.15 release + ] , package transformers ? pure [ "-Wno-unused-matches" , "-Wno-unused-imports" , "-Wno-redundant-constraints" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 703582f80f6d7f0c914ef4b885affcfc7b7b6ec8 +Subproject commit 9a343d137bcc5ae97a8d6e7a670dd4fb67ea7294 ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit cbcd0ccf92f47e6c10fb9cc513a7b26facfc19fe +Subproject commit 62e71a8f512a0f2a477d8004751ccf2420b8ac28 ===================================== libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Boot.TH.PprLib import GHC.Boot.TH.Syntax import Data.Word ( Word8 ) import Data.Char ( toLower, chr ) -import Data.List ( intersperse ) +import Data.List ( intersperse, unsnoc ) import GHC.Show ( showMultiLineString ) import GHC.Lexeme( isVarSymChar ) import Data.Ratio ( numerator, denominator ) @@ -214,9 +214,10 @@ pprExp i (MDoE m ss_) = parensIf (i > noPrec) $ pprStms [s] = ppr s pprStms ss = braces (semiSep ss) -pprExp _ (CompE []) = text "<<Empty CompExp>>" -- This will probably break with fixity declarations - would need a ';' -pprExp _ (CompE ss) = +pprExp _ (CompE ss) = case unsnoc ss of + Nothing -> text "<<Empty CompExp>>" + Just (ss', s) -> if null ss' -- If there are no statements in a list comprehension besides the last -- one, we simply treat it like a normal list. @@ -225,8 +226,6 @@ pprExp _ (CompE ss) = <+> bar <+> commaSep ss' <> text "]" - where s = last ss - ss' = init ss pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -13,6 +13,9 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +-- For init in formatRealFloatAlt +{-# OPTIONS_GHC -Wno-x-partial #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Internal.Float ===================================== libraries/ghc-internal/src/GHC/Internal/List.hs ===================================== @@ -190,12 +190,18 @@ tail :: HasCallStack => [a] -> [a] tail (_:xs) = xs tail [] = errorEmptyList "tail" -{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'GHC.Internal.Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} +{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} -- | $\mathcal{O}(n)$. Extract the last element of a list, which must be -- finite and non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -218,10 +224,18 @@ last xs = foldl (\_ x -> x) lastError xs lastError :: HasCallStack => a lastError = errorEmptyList "last" +{-# WARNING in "x-partial" last "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(n)$. Return all the elements of a list except the last one. -- The list must be non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -240,6 +254,8 @@ init (x:xs) = init' x xs where init' _ [] = [] init' y (z:zs) = y : init' z zs +{-# WARNING in "x-partial" init "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(1)$. Test whether a list is empty. -- -- >>> null [] ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -840,11 +840,12 @@ output_flags = std_flags where -- XXX bits copied from System.FilePath, since that's not available here - combine a b - | null b = a - | null a = b - | pathSeparator [last a] = a ++ b - | otherwise = a ++ [pathSeparatorChar] ++ b + combine a [] = a + combine a b = case unsnoc a of + Nothing -> b + Just (_, lastA) + | pathSeparator [lastA] -> a ++ b + | otherwise -> a ++ [pathSeparatorChar] ++ b tempCounter :: IORef Int tempCounter = unsafePerformIO $ newIORef 0 ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -54,6 +54,7 @@ import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence) import GHC.Internal.Data.Data hiding (Fixity(..)) import GHC.Internal.Data.NonEmpty (NonEmpty(..)) import GHC.Internal.Data.Traversable +import GHC.Internal.List (unsnoc) import GHC.Internal.Word import GHC.Internal.Generics (Generic) import GHC.Internal.IORef @@ -73,7 +74,7 @@ import GHC.Internal.Control.Monad.Fix import GHC.Internal.Control.Exception import GHC.Internal.Num import GHC.Internal.IO.Unsafe -import GHC.Internal.List (dropWhile, break, replicate, reverse, last) +import GHC.Internal.List (dropWhile, break, replicate, reverse) import GHC.Internal.MVar import GHC.Internal.IO.Exception import GHC.Internal.Unicode @@ -82,6 +83,16 @@ import qualified GHC.Internal.Types as Kind (Type) import GHC.Internal.ForeignSrcLang import GHC.Internal.LanguageExtensions +#ifdef BOOTSTRAP_TH +#if MIN_VERSION_base(4,19,0) +import Data.List (unsnoc) +#else +import Data.Maybe (maybe) +unsnoc :: [a] -> Maybe ([a], a) +unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing +#endif +#endif + ----------------------------------------------------- -- -- The Quasi class @@ -1296,7 +1307,7 @@ mkName str -- (i.e. non-empty, starts with capital, all alpha) is_rev_mod_name rev_mod_str | (compt, rest) <- break (== '.') rev_mod_str - , not (null compt), isUpper (last compt), all is_mod_char compt + , Just (_, lastCompt) <- unsnoc compt, isUpper lastCompt, all is_mod_char compt = case rest of [] -> True (_dot : rest') -> is_rev_mod_name rest' ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -104,7 +104,7 @@ module System.FilePath.Posix import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) -import Data.List(stripPrefix, isSuffixOf) +import Data.List(stripPrefix, isSuffixOf, uncons, unsnoc) import System.Environment(getEnv) @@ -203,14 +203,20 @@ isExtSeparator = (== extSeparator) splitSearchPath :: String -> [FilePath] splitSearchPath = f where - f xs = case break isSearchPathSeparator xs of - (pre, [] ) -> g pre - (pre, _:post) -> g pre ++ f post - - g "" = ["." | isPosix] - g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x] - g x = [x] - + f xs = let (pre, post) = break isSearchPathSeparator xs + in case uncons post of + Nothing -> g pre + Just (_, t) -> g pre ++ f t + + g x = case uncons x of + Nothing -> ["." | isPosix] + Just (h, t) + | h == '"' + , Just{} <- uncons t -- >= 2 + , isWindows + , Just (i, l) <- unsnoc t + , l == '"' -> [i] + | otherwise -> [x] -- | Get a list of 'FilePath's in the $PATH variable. getSearchPath :: IO [FilePath] @@ -233,12 +239,17 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH") -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") -- > splitExtension "file/path.txt/" == ("file/path.txt/","") splitExtension :: FilePath -> (String, String) -splitExtension x = case nameDot of - "" -> (x,"") - _ -> (dir ++ init nameDot, extSeparator : ext) - where - (dir,file) = splitFileName_ x - (nameDot,ext) = breakEnd isExtSeparator file +splitExtension x = case unsnoc nameDot of + -- Imagine x = "no-dots", then nameDot = "" + Nothing -> (x, mempty) + Just (initNameDot, _) + -- Imagine x = "\\shared.with.dots\no-dots" + | isWindows && null (dropDrive nameDot) -> (x, mempty) + -- Imagine x = "dir.with.dots/no-dots" + | any isPathSeparator ext -> (x, mempty) + | otherwise -> (initNameDot, extSeparator : ext) + where + (nameDot, ext) = breakEnd isExtSeparator x -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. -- @@ -594,9 +605,13 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext) -- > hasTrailingPathSeparator "test" == False -- > hasTrailingPathSeparator "test/" == True hasTrailingPathSeparator :: FilePath -> Bool -hasTrailingPathSeparator "" = False -hasTrailingPathSeparator x = isPathSeparator (last x) +hasTrailingPathSeparator = isJust . getTrailingPathSeparator +getTrailingPathSeparator :: FilePath -> Maybe Char +getTrailingPathSeparator x = case unsnoc x of + Just (_, lastX) + | isPathSeparator lastX -> Just lastX + _ -> Nothing hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False @@ -619,12 +634,12 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat -- > Windows: dropTrailingPathSeparator "\\" == "\\" -- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x dropTrailingPathSeparator :: FilePath -> FilePath -dropTrailingPathSeparator x = - if hasTrailingPathSeparator x && not (isDrive x) - then let x' = dropWhileEnd isPathSeparator x - in if null x' then [last x] else x' - else x - +dropTrailingPathSeparator x = case getTrailingPathSeparator x of + Just lastX + | not (isDrive x) + -> let x' = dropWhileEnd isPathSeparator x + in if null x' then [lastX] else x' + _ -> x -- | Get the directory name, move up one level. -- @@ -863,28 +878,37 @@ makeRelative root path -- > Posix: normalise "bob/fred/." == "bob/fred/" -- > Posix: normalise "//home" == "/home" normalise :: FilePath -> FilePath -normalise path = result ++ [pathSeparator | addPathSeparator] - where - (drv,pth) = splitDrive path - result = joinDrive' (normaliseDrive drv) (f pth) +normalise filepath = + result <> + (if addPathSeparator + then [pathSeparator] + else mempty) + where + (drv,pth) = splitDrive filepath + + result = joinDrive' (normaliseDrive drv) (f pth) - joinDrive' "" "" = "." - joinDrive' d p = joinDrive d p + joinDrive' d p + = if null d && null p + then "." + else joinDrive d p - addPathSeparator = isDirPath pth - && not (hasTrailingPathSeparator result) - && not (isRelativeDrive drv) + addPathSeparator = isDirPath pth + && not (hasTrailingPathSeparator result) + && not (isRelativeDrive drv) - isDirPath xs = hasTrailingPathSeparator xs - || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs) + isDirPath xs = hasTrailingPathSeparator xs || case unsnoc xs of + Nothing -> False + Just (initXs, lastXs) -> lastXs == '.' && hasTrailingPathSeparator initXs - f = joinPath . dropDots . propSep . splitDirectories + f = joinPath . dropDots . propSep . splitDirectories - propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs - | otherwise = x : xs - propSep [] = [] + propSep (x:xs) + | all isPathSeparator x = [pathSeparator] : xs + | otherwise = x : xs + propSep [] = [] - dropDots = filter ("." /=) + dropDots = filter ("." /=) normaliseDrive :: FilePath -> FilePath normaliseDrive "" = "" ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -104,7 +104,7 @@ module System.FilePath.Windows import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) -import Data.List(stripPrefix, isSuffixOf) +import Data.List(stripPrefix, isSuffixOf, uncons, unsnoc) import System.Environment(getEnv) @@ -203,14 +203,20 @@ isExtSeparator = (== extSeparator) splitSearchPath :: String -> [FilePath] splitSearchPath = f where - f xs = case break isSearchPathSeparator xs of - (pre, [] ) -> g pre - (pre, _:post) -> g pre ++ f post - - g "" = ["." | isPosix] - g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x] - g x = [x] - + f xs = let (pre, post) = break isSearchPathSeparator xs + in case uncons post of + Nothing -> g pre + Just (_, t) -> g pre ++ f t + + g x = case uncons x of + Nothing -> ["." | isPosix] + Just (h, t) + | h == '"' + , Just{} <- uncons t -- >= 2 + , isWindows + , Just (i, l) <- unsnoc t + , l == '"' -> [i] + | otherwise -> [x] -- | Get a list of 'FilePath's in the $PATH variable. getSearchPath :: IO [FilePath] @@ -233,12 +239,17 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH") -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") -- > splitExtension "file/path.txt/" == ("file/path.txt/","") splitExtension :: FilePath -> (String, String) -splitExtension x = case nameDot of - "" -> (x,"") - _ -> (dir ++ init nameDot, extSeparator : ext) - where - (dir,file) = splitFileName_ x - (nameDot,ext) = breakEnd isExtSeparator file +splitExtension x = case unsnoc nameDot of + -- Imagine x = "no-dots", then nameDot = "" + Nothing -> (x, mempty) + Just (initNameDot, _) + -- Imagine x = "\\shared.with.dots\no-dots" + | isWindows && null (dropDrive nameDot) -> (x, mempty) + -- Imagine x = "dir.with.dots/no-dots" + | any isPathSeparator ext -> (x, mempty) + | otherwise -> (initNameDot, extSeparator : ext) + where + (nameDot, ext) = breakEnd isExtSeparator x -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. -- @@ -594,9 +605,13 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext) -- > hasTrailingPathSeparator "test" == False -- > hasTrailingPathSeparator "test/" == True hasTrailingPathSeparator :: FilePath -> Bool -hasTrailingPathSeparator "" = False -hasTrailingPathSeparator x = isPathSeparator (last x) +hasTrailingPathSeparator = isJust . getTrailingPathSeparator +getTrailingPathSeparator :: FilePath -> Maybe Char +getTrailingPathSeparator x = case unsnoc x of + Just (_, lastX) + | isPathSeparator lastX -> Just lastX + _ -> Nothing hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False @@ -619,12 +634,12 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat -- > Windows: dropTrailingPathSeparator "\\" == "\\" -- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x dropTrailingPathSeparator :: FilePath -> FilePath -dropTrailingPathSeparator x = - if hasTrailingPathSeparator x && not (isDrive x) - then let x' = dropWhileEnd isPathSeparator x - in if null x' then [last x] else x' - else x - +dropTrailingPathSeparator x = case getTrailingPathSeparator x of + Just lastX + | not (isDrive x) + -> let x' = dropWhileEnd isPathSeparator x + in if null x' then [lastX] else x' + _ -> x -- | Get the directory name, move up one level. -- @@ -863,28 +878,37 @@ makeRelative root path -- > Posix: normalise "bob/fred/." == "bob/fred/" -- > Posix: normalise "//home" == "/home" normalise :: FilePath -> FilePath -normalise path = result ++ [pathSeparator | addPathSeparator] - where - (drv,pth) = splitDrive path - result = joinDrive' (normaliseDrive drv) (f pth) +normalise filepath = + result <> + (if addPathSeparator + then [pathSeparator] + else mempty) + where + (drv,pth) = splitDrive filepath + + result = joinDrive' (normaliseDrive drv) (f pth) - joinDrive' "" "" = "." - joinDrive' d p = joinDrive d p + joinDrive' d p + = if null d && null p + then "." + else joinDrive d p - addPathSeparator = isDirPath pth - && not (hasTrailingPathSeparator result) - && not (isRelativeDrive drv) + addPathSeparator = isDirPath pth + && not (hasTrailingPathSeparator result) + && not (isRelativeDrive drv) - isDirPath xs = hasTrailingPathSeparator xs - || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs) + isDirPath xs = hasTrailingPathSeparator xs || case unsnoc xs of + Nothing -> False + Just (initXs, lastXs) -> lastXs == '.' && hasTrailingPathSeparator initXs - f = joinPath . dropDots . propSep . splitDirectories + f = joinPath . dropDots . propSep . splitDirectories - propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs - | otherwise = x : xs - propSep [] = [] + propSep (x:xs) + | all isPathSeparator x = [pathSeparator] : xs + | otherwise = x : xs + propSep [] = [] - dropDots = filter ("." /=) + dropDots = filter ("." /=) normaliseDrive :: FilePath -> FilePath normaliseDrive "" = "" ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -7,7 +7,7 @@ import System.Environment import GHC.Driver.Env.Types import GHC.Profiling import System.Mem -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, unsnoc) import Control.Monad import System.Exit import GHC.Platform @@ -41,7 +41,9 @@ initGhcM xs = do requestHeapCensus performGC [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" - let (n :: Int) = read (last (words ys)) + let (n :: Int) = case unsnoc (words ys) of + Nothing -> error "input is unexpectedly empty" + Just (_, lst) -> read lst -- The output should be 50 * 8 * word_size (i.e. 3600, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, -- and each ModDetails contains 1 (info table) + 8 word-sized fields. ===================================== testsuite/tests/rts/KeepCafsBase.hs ===================================== @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-x-partial #-} + module KeepCafsBase (x) where x :: Int ===================================== utils/check-exact/Transform.hs ===================================== @@ -96,6 +96,7 @@ import GHC.Data.FastString import GHC.Types.SrcLoc import Data.Data +import Data.List (unsnoc) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe @@ -212,8 +213,9 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (AnnSig (EpUniTok dca u) mp md) ns ( where -- we want DPs for the distance from the end of the ns to the -- AnnDColon, and to the start of the ty - rd = case last ns of - L (EpAnn anc' _ _) _ -> epaLocationRealSrcSpan anc' + rd = case unsnoc ns of + Nothing -> error "unexpected empty list in 'ns' variable" + Just (_, L (EpAnn anc' _ _) _) -> epaLocationRealSrcSpan anc' dca' = case dca of EpaSpan ss@(RealSrcSpan r _) -> (EpaDelta ss (ss2delta (ss2posEnd rd) r) []) _ -> dca @@ -294,7 +296,7 @@ setEntryDP (L (EpAnn (EpaSpan ss@(RealSrcSpan r _)) an cs) a) dp where cs'' = setPriorComments cs [] csd = L (EpaDelta ss dp NoComments) c:commentOrigDeltas cs' - lc = last $ (L ca c:cs') + lc = NE.last (L ca c :| cs') delta = case getLoc lc of EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r EpaSpan _ -> (SameLine 0) ===================================== utils/check-exact/Utils.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Base (NonEmpty(..)) import GHC.Parser.Lexer (allocateComments) import Data.Data hiding ( Fixity ) -import Data.List (sortBy, partition) +import Data.List (sortBy, partition, unsnoc) import qualified Data.Map.Strict as Map import Debug.Trace @@ -734,8 +734,9 @@ ghead info [] = error $ "ghead "++info++" []" ghead _info (h:_) = h glast :: String -> [a] -> a -glast info [] = error $ "glast " ++ info ++ " []" -glast _info h = last h +glast info xs = case unsnoc xs of + Nothing -> error $ "glast " ++ info ++ " []" + Just (_, lst) -> lst gtail :: String -> [a] -> [a] gtail info [] = error $ "gtail " ++ info ++ " []" ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -8,7 +8,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-x-partial #-} -- Fine if this comes from make/Hadrian or the pre-built base. #include <ghcplatform.h> ===================================== utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs ===================================== @@ -1,6 +1,6 @@ module GHC.Toolchain.CheckArm ( findArmIsa ) where -import Data.List (isInfixOf) +import Data.List (isInfixOf, unsnoc) import Data.Maybe (catMaybes) import Control.Monad.IO.Class import System.Process @@ -76,8 +76,7 @@ findArmIsa cc = do _ -> throwE $ "unexpected output from test program: " ++ out lastLine :: String -> String -lastLine "" = "" -lastLine s = last $ lines s +lastLine = maybe "" snd . unsnoc . lines -- | Raspbian unfortunately makes some extremely questionable packaging -- decisions, configuring gcc to compile for ARMv6 despite the fact that the ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs ===================================== @@ -755,7 +755,7 @@ ppHtmlIndex divAlphabet << unordList ( map (\str -> anchor ! [href (subIndexHtmlFile str)] << str) $ - [ [c] | c <- initialChars, any ((== c) . toUpper . head . fst) index + [ [c] | c <- initialChars, any (maybe False ((== c) . toUpper . fst) . List.uncons . fst) index ] ++ [merged_name] ) @@ -772,7 +772,7 @@ ppHtmlIndex writeUtf8File (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html) where html = indexPage True (Just c) index_part - index_part = [(n, stuff) | (n, stuff) <- this_ix, toUpper (head n) == c] + index_part = [(n, stuff) | (n@(headN : _), stuff) <- this_ix, toUpper headN == c] index :: [(String, Map GHC.Name [(Module, Bool)])] index = sortBy cmp (Map.toAscList full_index) ===================================== utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs ===================================== @@ -30,7 +30,7 @@ import Control.Arrow (first) import Control.Monad import Data.Char (chr, isAlpha, isSpace, isUpper) import Data.Functor (($>)) -import Data.List (elemIndex, intercalate, intersperse, unfoldr) +import Data.List (elemIndex, intercalate, intersperse, unfoldr, unsnoc) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import qualified Data.Set as Set @@ -870,10 +870,10 @@ codeblock = DocCodeBlock . parseParagraph . dropSpaces <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@") where - dropSpaces xs = - case splitByNl xs of - [] -> xs - ys -> case T.uncons (last ys) of + dropSpaces xs = let ys = splitByNl xs in + case unsnoc ys of + Nothing -> xs + Just (_, lastYs) -> case T.uncons lastYs of Just (' ', _) -> case mapM dropSpace ys of Nothing -> xs Just zs -> T.intercalate "\n" zs ===================================== utils/hpc ===================================== @@ -1 +1 @@ -Subproject commit 5923da3fe77993b7afc15b5163cffcaa7da6ecf5 +Subproject commit dd43f7e139d7a4f4908d1e8af35a75939f763ef1 ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit fe3990b9f35000427b016a79330d9f195587cad8 +Subproject commit 2059c961fc28bbfd0cafdbef96d5d21f1d911b53 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d61b626957312096a38acbfc50c69… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d61b626957312096a38acbfc50c69… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26109] Apply 1 suggestion(s) to 1 file(s)
by recursion-ninja (＠recursion-ninja) 08 Aug '25

08 Aug '25

recursion-ninja pushed to branch wip/fix-26109 at Glasgow Haskell Compiler / GHC Commits: 01be20d3 by recursion-ninja at 2025-08-08T21:44:56+00:00 Apply 1 suggestion(s) to 1 file(s) Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at> - - - - - 1 changed file: - compiler/GHC/CmmToLlvm/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -243,7 +243,7 @@ genCall (PrimTarget op@(MO_BSwap w)) [dst] args = genCallSimpleCast w op dst args -- Handle Pdep and Pext that (may) require using a type with a larger bit-width --- than the specified but width. This register width-extension is particualarly +-- than the specified bit width. This register width-extension is particualarly -- necessary for W8 and W16. genCall (PrimTarget op@(MO_Pdep w)) [dst] args = genCallCastWithMinWidthOf W32 w op dst args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01be20d3762af6fe8df718cb86788c2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01be20d3762af6fe8df718cb86788c2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26109] 7 commits: ipe: Place strings and metadata into specific .ipe section
by recursion-ninja (＠recursion-ninja) 08 Aug '25

08 Aug '25

recursion-ninja pushed to branch wip/fix-26109 at Glasgow Haskell Compiler / GHC Commits: 1903ae35 by Matthew Pickering at 2025-08-07T12:21:10+01:00 ipe: Place strings and metadata into specific .ipe section By placing the .ipe metadata into a specific section it can be stripped from the final binary if desired. ``` objcopy --remove-section .ipe <binary> upx <binary> ``` Towards #21766 - - - - - c80dd91c by Matthew Pickering at 2025-08-07T12:22:42+01:00 ipe: Place magic word at the start of entries in the .ipe section The magic word "IPE\nIPE\n" is placed at the start of .ipe sections, then if the section is stripped, we can check whether the section starts with the magic word or not to determine whether there is metadata present or not. Towards #21766 - - - - - cab42666 by Matthew Pickering at 2025-08-07T12:22:42+01:00 ipe: Use stable IDs for IPE entries IPEs have historically been indexed and reported by their address. This makes it impossible to compare profiles between runs, since the addresses may change (due to ASLR) and also makes it tricky to separate out the IPE map from the binary. This small patch adds a stable identifier for each IPE entry. The stable identifier is a single 64 bit word. The high-bits are a per-module identifier and the low bits identify which entry in each module. 1. When a node is added into the IPE buffer it is assigned a unique identifier from an incrementing global counter. 2. Each entry already has an index by it's position in the `IpeBufferListNode`. The two are combined together by the `IPE_ENTRY_KEY` macro. Info table profiling uses the stable identifier rather than the address of the info table. The benefits of this change are: * Profiles from different runs can be easily compared * The metadata can be extracted from the binary (via the eventlog for example) and then stripped from the executable. Fixes #21766 - - - - - 2860a9a5 by Simon Peyton Jones at 2025-08-07T20:29:18-04:00 In TcSShortCut, typechecker plugins should get empty Givens Solving in TcShortCut mode means /ignoring the Givens/. So we should not pass them to typechecker plugins! Fixes #26258. This is a fixup to the earlier MR: commit 1bd12371feacc52394a0e660ef9349f9e8ee1c06 Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Mon Jul 21 10:04:49 2025 +0100 Improve treatment of SPECIALISE pragmas -- again! - - - - - 2157db2d by sterni at 2025-08-08T15:32:39-04:00 hadrian: enable terminfo if --with-curses-* flags are given The GHC make build system used to support WITH_TERMINFO in ghc.mk which allowed controlling whether to build GHC with terminfo or not. hadrian has replaced this with a system where this is effectively controlled by the cross-compiling setting (the default WITH_TERMINFO value was bassed on CrossCompiling, iirc). This behavior is undesireable in some cases and there is not really a good way to work around it. Especially for downstream packagers, modifying this via UserSettings is not really feasible since such a source file has to be kept in sync with Settings/Default.hs manually since it can't import Settings.Default or any predefined Flavour definitions. To avoid having to add a new setting to cfg/system.config and/or a new configure flag (though I'm happy to implement both if required), I've chosen to take --with-curses-* being set explicitly as an indication that the user wants to have terminfo enabled. This would work for Nixpkgs which sets these flags [1] as well as haskell.nix [2] (which goes to some extreme measures [3] [4] to force terminfo in all scenarios). In general, I'm an advocate for making the GHC build be the same for native and cross insofar it is possible since it makes packaging GHC and Haskell related things while still supporting cross much less compilicated. A more minimal GHC with reduced dependencies should probably be a specific flavor, not the default. Partially addresses #26288 by forcing terminfo to be built if the user explicitly passes configure flags related to it. However, it isn't built by default when cross-compiling yet nor is there an explicit way to control the package being built. [1]: https://github.com/NixOS/nixpkgs/blob/3a7266fcefcb9ce353df49ba3f292d0644376… [2]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… [3]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… [4]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… - - - - - b3c31488 by David Feuer at 2025-08-08T15:33:21-04:00 Add default QuasiQuoters Add `defaultQuasiQuoter` and `namedDefaultQuasiQuoter` to make it easier to write `QuasiQuoters` that give helpful error messages when they're used in inappropriate contexts. Closes #24434. - - - - - 767d6516 by Recursion Ninja at 2025-08-08T17:38:37-04:00 Resolving issues #20645 and #26109 Correctly sign extending and casting smaller bit width types for LLVM operations: - bitReverse8# - bitReverse16# - bitReverse32# - byteSwap16# - byteSwap32# - pdep8# - pdep16# - pext8# - pext16# - - - - - 32 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - docs/users_guide/debug-info.rst - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs - libraries/template-haskell/Language/Haskell/TH/Quote.hs - libraries/template-haskell/changelog.md - rts/IPE.c - rts/ProfHeap.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/llvm/should_run/T20645.hs - + testsuite/tests/llvm/should_run/T20645.stdout - testsuite/tests/llvm/should_run/all.T - testsuite/tests/numeric/should_run/foundation.hs - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - utils/genprimopcode/Lexer.x - utils/genprimopcode/Main.hs - utils/genprimopcode/Parser.y - utils/genprimopcode/ParserM.hs - utils/genprimopcode/Syntax.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a9ec9d90a4228702fe995cd989769… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a9ec9d90a4228702fe995cd989769… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26109] 2 commits: Moving 'LowerBitsAreDefined' out of the autogenerated portion of the file
by recursion-ninja (＠recursion-ninja) 08 Aug '25

08 Aug '25

recursion-ninja pushed to branch wip/fix-26109 at Glasgow Haskell Compiler / GHC Commits: a522e725 by Recursion Ninja at 2025-08-08T13:33:17-04:00 Moving 'LowerBitsAreDefined' out of the autogenerated portion of the file - - - - - 3a9ec9d9 by Recursion Ninja at 2025-08-08T16:49:26-04:00 Partial extension of 'genprimopcode' to support 'LowerBitsAreDefined' - - - - - 7 changed files: - compiler/GHC/Builtin/primops.txt.pp - testsuite/tests/numeric/should_run/foundation.hs - utils/genprimopcode/Lexer.x - utils/genprimopcode/Main.hs - utils/genprimopcode/Parser.y - utils/genprimopcode/ParserM.hs - utils/genprimopcode/Syntax.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -148,6 +148,7 @@ defaults vector = [] deprecated_msg = {} -- A non-empty message indicates deprecation div_like = False -- Second argument expected to be non zero - used for tests + defined_bits = Nothing -- The number of bits the operation is defined for (if not all bits) -- Note [When do out-of-line primops go in primops.txt.pp] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1065,8 +1066,10 @@ primop CtzOp "ctz#" GenPrimOp Word# -> Word# primop BSwap16Op "byteSwap16#" GenPrimOp Word# -> Word# {Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. } + with defined_bits = 16 primop BSwap32Op "byteSwap32#" GenPrimOp Word# -> Word# {Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. } + with defined_bits = 32 primop BSwap64Op "byteSwap64#" GenPrimOp Word64# -> Word64# {Swap bytes in a 64 bits of a word.} primop BSwapOp "byteSwap#" GenPrimOp Word# -> Word# @@ -1074,10 +1077,13 @@ primop BSwapOp "byteSwap#" GenPrimOp Word# -> Word# primop BRev8Op "bitReverse8#" GenPrimOp Word# -> Word# {Reverse the order of the bits in a 8-bit word.} + with defined_bits = 8 primop BRev16Op "bitReverse16#" GenPrimOp Word# -> Word# {Reverse the order of the bits in a 16-bit word.} + with defined_bits = 16 primop BRev32Op "bitReverse32#" GenPrimOp Word# -> Word# {Reverse the order of the bits in a 32-bit word.} + with defined_bits = 32 primop BRev64Op "bitReverse64#" GenPrimOp Word64# -> Word64# {Reverse the order of the bits in a 64-bit word.} primop BRevOp "bitReverse#" GenPrimOp Word# -> Word# ===================================== testsuite/tests/numeric/should_run/foundation.hs ===================================== @@ -409,6 +409,33 @@ instance TestPrimop (Word# -> Int# -> Word#) where testPrimop s l r = Property s $ \(uWord -> a1) (uInt -> a2) -> (wWord (l a1 a2)) === wWord (r a1 a2) -} +-- | A special data-type for representing functions where, +-- since only some number of the lower bits are defined, +-- testing for strict equality in the undefined upper bits is not appropriate! +-- Without using this data-type, false-positive failures will be reported +-- when the undefined bit regions do not match, even though the equality of bits +-- in this undefined region has no bearing on correctness. +data LowerBitsAreDefined = + LowerBitsAreDefined + { definedLowerWidth :: Word + -- ^ The (strictly-non-negative) number of least-significant bits + -- for which the attached function is defined. + , undefinedBehavior :: (Word# -> Word#) + -- ^ Function with undefined behavior for some of its most significant bits. + } + +instance TestPrimop LowerBitsAreDefined where + testPrimop s l r = Property s $ \ (uWord#-> x0) -> + let -- Create a mask to unset all bits in the undefined area, + -- leaving set bits only in the area of defined behavior. + -- Since the upper bits are undefined, + -- if the function defines behavior for the lower N bits, + -- then /only/ the lower N bits are preserved, + -- and the upper WORDSIZE - N bits are discarded. + mask = bit (fromEnum (definedLowerWidth r)) - 1 + valL = wWord# (undefinedBehavior l x0) .&. mask + valR = wWord# (undefinedBehavior r x0) .&. mask + in valL === valR twoNonZero :: (a -> a -> b) -> a -> NonZero a -> b twoNonZero f x (NonZero y) = f x y @@ -673,34 +700,6 @@ testPrimops = Group "primop" , testPrimop "narrow32Word#" Primop.narrow32Word# Wrapper.narrow32Word# ] --- | A special data-type for representing functions where, --- since only some number of the lower bits are defined, --- testing for strict equality in the undefined upper bits is not appropriate! --- Without using this data-type, false-positive failures will be reported --- when the undefined bit regions do not match, even though the equality of bits --- in this undefined region has no bearing on correctness. -data LowerBitsAreDefined = - LowerBitsAreDefined - { definedLowerWidth :: Word - -- ^ The (strictly-non-negative) number of least-significant bits - -- for which the attached function is defined. - , undefinedBehavior :: (Word# -> Word#) - -- ^ Function with undefined behavior for some of its most significant bits. - } - -instance TestPrimop LowerBitsAreDefined where - testPrimop s l r = Property s $ \ (uWord#-> x0) -> - let -- Create a mask to unset all bits in the undefined area, - -- leaving set bits only in the area of defined behavior. - -- Since the upper bits are undefined, - -- if the function defines behavior for the lower N bits, - -- then /only/ the lower N bits are preserved, - -- and the upper WORDSIZE - N bits are discarded. - mask = bit (fromEnum (definedLowerWidth r)) - 1 - valL = wWord# (undefinedBehavior l x0) .&. mask - valR = wWord# (undefinedBehavior r x0) .&. mask - in valL === valR - instance TestPrimop (Char# -> Char# -> Int#) where testPrimop s l r = Property s $ \ (uChar#-> x0) (uChar#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) ===================================== utils/genprimopcode/Lexer.x ===================================== @@ -56,6 +56,7 @@ words :- <0> "CanFail" { mkT TCanFail } <0> "ThrowsException" { mkT TThrowsException } <0> "ReadWriteEffect" { mkT TReadWriteEffect } + <0> "defined_bits" { mkT TDefinedBits } <0> "can_fail_warning" { mkT TCanFailWarnFlag } <0> "DoNotWarnCanFail" { mkT TDoNotWarnCanFail } <0> "WarnIfEffectIsCanFail" { mkT TWarnIfEffectIsCanFail } ===================================== utils/genprimopcode/Main.hs ===================================== @@ -10,6 +10,7 @@ module Main where import Parser import Syntax +import Control.Applicative (asum) import Data.Char import Data.List (union, intersperse, intercalate, nub, sort) import Data.Maybe ( catMaybes, mapMaybe ) @@ -753,7 +754,14 @@ gen_foundation_tests (Info _ entries) = let testPrimOpHow = if is_divLikeOp po then "testPrimopDivLike" else "testPrimop" - in Just $ intercalate " " [testPrimOpHow, "\"" ++ poName ++ "\"", wrap "Primop" poName, wrap "Wrapper" poName] + withDefinedBits qName = case mb_defined_bits po of + Nothing -> qName + Just bs -> concat ["(", show bs, " `LowerBitsAreDefined` ", qName, ")"] + in Just $ intercalate " " + [ testPrimOpHow + , "\"" ++ poName ++ "\"" + , withDefinedBits $ wrap "Primop" poName + , withDefinedBits $ wrap "Wrapper" poName] | otherwise = Nothing @@ -771,6 +779,17 @@ gen_foundation_tests (Info _ entries) divableTyCons = ["Int#", "Word#", "Word8#", "Word16#", "Word32#", "Word64#" ,"Int8#", "Int16#", "Int32#", "Int64#"] + + mb_defined_bits :: Entry -> Maybe Word + mb_defined_bits op@(PrimOpSpec{}) = + let opOpts = opts op + getDefBits :: Option -> Maybe Word + getDefBits (OptionDefinedBits x) = x + getDefBits _ = Nothing + in asum $ getDefBits <$> opOpts + mb_defined_bits _ = Nothing + + ------------------------------------------------------------------ -- Create PrimOpInfo text from PrimOpSpecs ----------------------- ------------------------------------------------------------------ ===================================== utils/genprimopcode/Parser.y ===================================== @@ -50,6 +50,7 @@ import AccessOps CanFail { TCanFail } ThrowsException { TThrowsException } ReadWriteEffect { TReadWriteEffect } + defined_bits { TDefinedBits } can_fail_warning { TCanFailWarnFlag } DoNotWarnCanFail { TDoNotWarnCanFail } WarnIfEffectIsCanFail { TWarnIfEffectIsCanFail } @@ -81,13 +82,14 @@ pOptions : pOption pOptions { $1 : $2 } | {- empty -} { [] } pOption :: { Option } -pOption : lowerName '=' false { OptionFalse $1 } - | lowerName '=' true { OptionTrue $1 } - | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 } - | lowerName '=' integer { OptionInteger $1 $3 } - | vector '=' pVectorTemplate { OptionVector $3 } - | fixity '=' pInfix { OptionFixity $3 } - | effect '=' pEffect { OptionEffect $3 } +pOption : lowerName '=' false { OptionFalse $1 } + | lowerName '=' true { OptionTrue $1 } + | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 } + | lowerName '=' integer { OptionInteger $1 $3 } + | vector '=' pVectorTemplate { OptionVector $3 } + | fixity '=' pInfix { OptionFixity $3 } + | effect '=' pEffect { OptionEffect $3 } + | defined_bits '=' pGoodBits { OptionDefinedBits $3 } | can_fail_warning '=' pPrimOpCanFailWarnFlag { OptionCanFailWarnFlag $3 } pInfix :: { Maybe Fixity } @@ -102,6 +104,10 @@ pEffect : NoEffect { NoEffect } | ThrowsException { ThrowsException } | ReadWriteEffect { ReadWriteEffect } +pGoodBits :: { Maybe Word } +pGoodBits : integer { Just $ toEnum $1 } + | nothing { Nothing } + pPrimOpCanFailWarnFlag :: { PrimOpCanFailWarnFlag } pPrimOpCanFailWarnFlag : DoNotWarnCanFail { DoNotWarnCanFail } | WarnIfEffectIsCanFail { WarnIfEffectIsCanFail } ===================================== utils/genprimopcode/ParserM.hs ===================================== @@ -116,6 +116,7 @@ data Token = TEOF | TCanFail | TThrowsException | TReadWriteEffect + | TDefinedBits | TCanFailWarnFlag | TDoNotWarnCanFail | TWarnIfEffectIsCanFail ===================================== utils/genprimopcode/Syntax.hs ===================================== @@ -76,6 +76,7 @@ data Option | OptionFixity (Maybe Fixity) -- fixity = infix{,l,r} <int> | Nothing | OptionEffect PrimOpEffect -- effect = NoEffect | DoNotSpeculate | CanFail | ThrowsException | ReadWriteEffect | FallibleReadWriteEffect | OptionCanFailWarnFlag PrimOpCanFailWarnFlag -- can_fail_warning = DoNotWarnCanFail | WarnIfEffectIsCanFail | YesWarnCanFail + | OptionDefinedBits (Maybe Word) -- defined_bits = Just 16 | Nothing deriving Show -- categorises primops @@ -196,6 +197,7 @@ get_attrib_name (OptionVector _) = "vector" get_attrib_name (OptionFixity _) = "fixity" get_attrib_name (OptionEffect _) = "effect" get_attrib_name (OptionCanFailWarnFlag _) = "can_fail_warning" +get_attrib_name (OptionDefinedBits _) = "defined_bits" lookup_attrib :: String -> [Option] -> Maybe Option lookup_attrib _ [] = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/224fb5bd5e724226e1f9a2783cbf1c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/224fb5bd5e724226e1f9a2783cbf1c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/warning-for-last-and-init] 7 commits: ipe: Place strings and metadata into specific .ipe section
by Bodigrim (＠Bodigrim) 08 Aug '25

08 Aug '25

Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC Commits: 1903ae35 by Matthew Pickering at 2025-08-07T12:21:10+01:00 ipe: Place strings and metadata into specific .ipe section By placing the .ipe metadata into a specific section it can be stripped from the final binary if desired. ``` objcopy --remove-section .ipe <binary> upx <binary> ``` Towards #21766 - - - - - c80dd91c by Matthew Pickering at 2025-08-07T12:22:42+01:00 ipe: Place magic word at the start of entries in the .ipe section The magic word "IPE\nIPE\n" is placed at the start of .ipe sections, then if the section is stripped, we can check whether the section starts with the magic word or not to determine whether there is metadata present or not. Towards #21766 - - - - - cab42666 by Matthew Pickering at 2025-08-07T12:22:42+01:00 ipe: Use stable IDs for IPE entries IPEs have historically been indexed and reported by their address. This makes it impossible to compare profiles between runs, since the addresses may change (due to ASLR) and also makes it tricky to separate out the IPE map from the binary. This small patch adds a stable identifier for each IPE entry. The stable identifier is a single 64 bit word. The high-bits are a per-module identifier and the low bits identify which entry in each module. 1. When a node is added into the IPE buffer it is assigned a unique identifier from an incrementing global counter. 2. Each entry already has an index by it's position in the `IpeBufferListNode`. The two are combined together by the `IPE_ENTRY_KEY` macro. Info table profiling uses the stable identifier rather than the address of the info table. The benefits of this change are: * Profiles from different runs can be easily compared * The metadata can be extracted from the binary (via the eventlog for example) and then stripped from the executable. Fixes #21766 - - - - - 2860a9a5 by Simon Peyton Jones at 2025-08-07T20:29:18-04:00 In TcSShortCut, typechecker plugins should get empty Givens Solving in TcShortCut mode means /ignoring the Givens/. So we should not pass them to typechecker plugins! Fixes #26258. This is a fixup to the earlier MR: commit 1bd12371feacc52394a0e660ef9349f9e8ee1c06 Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Mon Jul 21 10:04:49 2025 +0100 Improve treatment of SPECIALISE pragmas -- again! - - - - - 2157db2d by sterni at 2025-08-08T15:32:39-04:00 hadrian: enable terminfo if --with-curses-* flags are given The GHC make build system used to support WITH_TERMINFO in ghc.mk which allowed controlling whether to build GHC with terminfo or not. hadrian has replaced this with a system where this is effectively controlled by the cross-compiling setting (the default WITH_TERMINFO value was bassed on CrossCompiling, iirc). This behavior is undesireable in some cases and there is not really a good way to work around it. Especially for downstream packagers, modifying this via UserSettings is not really feasible since such a source file has to be kept in sync with Settings/Default.hs manually since it can't import Settings.Default or any predefined Flavour definitions. To avoid having to add a new setting to cfg/system.config and/or a new configure flag (though I'm happy to implement both if required), I've chosen to take --with-curses-* being set explicitly as an indication that the user wants to have terminfo enabled. This would work for Nixpkgs which sets these flags [1] as well as haskell.nix [2] (which goes to some extreme measures [3] [4] to force terminfo in all scenarios). In general, I'm an advocate for making the GHC build be the same for native and cross insofar it is possible since it makes packaging GHC and Haskell related things while still supporting cross much less compilicated. A more minimal GHC with reduced dependencies should probably be a specific flavor, not the default. Partially addresses #26288 by forcing terminfo to be built if the user explicitly passes configure flags related to it. However, it isn't built by default when cross-compiling yet nor is there an explicit way to control the package being built. [1]: https://github.com/NixOS/nixpkgs/blob/3a7266fcefcb9ce353df49ba3f292d0644376… [2]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… [3]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… [4]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… - - - - - b3c31488 by David Feuer at 2025-08-08T15:33:21-04:00 Add default QuasiQuoters Add `defaultQuasiQuoter` and `namedDefaultQuasiQuoter` to make it easier to write `QuasiQuoters` that give helpful error messages when they're used in inappropriate contexts. Closes #24434. - - - - - 9d61b626 by Mike Pilgrem at 2025-08-08T21:32:40+01:00 Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`). In module `Settings.Warnings`, applies `-Wno-unrecognised-warning-flags` `-Wno-x-partial` to the `Cabal`, `filepath`, `hsc2hs`, `hpc`, `parsec`, `text` and `time` packages (outside GHC's repository). - - - - - 46 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Prelude/Basic.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - docs/users_guide/debug-info.rst - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Warnings.hs - libraries/Cabal - libraries/filepath - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/template-haskell/Language/Haskell/TH/Quote.hs - libraries/template-haskell/changelog.md - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs - rts/IPE.c - rts/ProfHeap.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - testsuite/tests/driver/j-space/jspace.hs - testsuite/tests/interface-stability/template-haskell-exports.stdout - testsuite/tests/rts/KeepCafsBase.hs - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs - utils/ghc-pkg/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/hpc - utils/hsc2hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f477db5713add8656ae37b3ef8023a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f477db5713add8656ae37b3ef8023a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add default QuasiQuoters
by Marge Bot (＠marge-bot) 08 Aug '25

08 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b3c31488 by David Feuer at 2025-08-08T15:33:21-04:00 Add default QuasiQuoters Add `defaultQuasiQuoter` and `namedDefaultQuasiQuoter` to make it easier to write `QuasiQuoters` that give helpful error messages when they're used in inappropriate contexts. Closes #24434. - - - - - 4 changed files: - libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs - libraries/template-haskell/Language/Haskell/TH/Quote.hs - libraries/template-haskell/changelog.md - testsuite/tests/interface-stability/template-haskell-exports.stdout Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs ===================================== @@ -26,10 +26,10 @@ import GHC.Internal.Base hiding (Type) -- | The 'QuasiQuoter' type, a value @q@ of this type can be used -- in the syntax @[q| ... string to parse ...|]@. In fact, for -- convenience, a 'QuasiQuoter' actually defines multiple quasiquoters --- to be used in different splice contexts; if you are only interested --- in defining a quasiquoter to be used for expressions, you would --- define a 'QuasiQuoter' with only 'quoteExp', and leave the other --- fields stubbed out with errors. +-- to be used in different splice contexts. In the usual case of a +-- @QuasiQuoter@ that is only intended to be used in certain splice +-- contexts, the unused fields should just 'fail'. This is most easily +-- accomplished using 'namedefaultQuasiQuoter' or 'defaultQuasiQuoter'. data QuasiQuoter = QuasiQuoter { -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@ quoteExp :: String -> Q Exp, ===================================== libraries/template-haskell/Language/Haskell/TH/Quote.hs ===================================== @@ -16,6 +16,8 @@ that is up to you. module Language.Haskell.TH.Quote ( QuasiQuoter(..) , quoteFile + , namedDefaultQuasiQuoter + , defaultQuasiQuoter -- * For backwards compatibility ,dataToQa, dataToExpQ, dataToPatQ ) where @@ -39,3 +41,54 @@ quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec get old_quoter file_name = do { file_cts <- runIO (readFile file_name) ; addDependentFile file_name ; old_quoter file_cts } + +-- | A 'QuasiQuoter' that fails with a helpful error message in every +-- context. It is intended to be modified to create a 'QuasiQuoter' that +-- fails in all inappropriate contexts. +-- +-- For example, you could write +-- +-- @ +-- myPatQQ = (namedDefaultQuasiQuoter "myPatQQ") +-- { quotePat = ... } +-- @ +-- +-- If 'myPatQQ' is used in an expression context, the compiler will report +-- that, naming 'myPatQQ'. +-- +-- See also 'defaultQuasiQuoter', which does not name the 'QuasiQuoter' in +-- the error message, and might therefore be more appropriate when +-- the users of a particular 'QuasiQuoter' tend to define local \"synonyms\" +-- for it. +namedDefaultQuasiQuoter :: String -> QuasiQuoter +namedDefaultQuasiQuoter name = QuasiQuoter + { quoteExp = f "use in expression contexts." + , quotePat = f "use in pattern contexts." + , quoteType = f "use in types." + , quoteDec = f "creating declarations." + } + where + f m _ = fail $ "The " ++ name ++ " quasiquoter is not for " ++ m + +-- | A 'QuasiQuoter' that fails with a helpful error message in every +-- context. It is intended to be modified to create a 'QuasiQuoter' that +-- fails in all inappropriate contexts. +-- +-- For example, you could write +-- +-- @ +-- myExpressionQQ = defaultQuasiQuoter +-- { quoteExp = ... } +-- @ +-- +-- See also 'namedDefaultQuasiQuoter', which names the 'QuasiQuoter' in the +-- error messages. +defaultQuasiQuoter :: QuasiQuoter +defaultQuasiQuoter = QuasiQuoter + { quoteExp = f "use in expression contexts." + , quotePat = f "use in pattern contexts." + , quoteType = f "use in types." + , quoteDec = f "creating declarations." + } + where + f m _ = fail $ "This quasiquoter is not for " ++ m ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,5 +1,8 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.25.0.0 + * Introduce `namedDefaultQuasiQuoter` and `defaultQuasiQuoter`, which fail with a helpful error when used in an inappropriate context. + ## 2.24.0.0 * Introduce `dataToCodeQ` and `liftDataTyped`, typed variants of `dataToExpQ` and `liftData` respectively. ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== @@ -1370,6 +1370,8 @@ module Language.Haskell.TH.Quote where dataToExpQ :: forall (m :: * -> *) a. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m GHC.Internal.TH.Syntax.Exp)) -> a -> m GHC.Internal.TH.Syntax.Exp dataToPatQ :: forall (m :: * -> *) a. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m GHC.Internal.TH.Syntax.Pat)) -> a -> m GHC.Internal.TH.Syntax.Pat dataToQa :: forall (m :: * -> *) a k q. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (GHC.Internal.TH.Syntax.Name -> k) -> (GHC.Internal.TH.Syntax.Lit -> m q) -> (k -> [m q] -> m q) -> (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m q)) -> a -> m q + defaultQuasiQuoter :: QuasiQuoter + namedDefaultQuasiQuoter :: GHC.Internal.Base.String -> QuasiQuoter quoteFile :: QuasiQuoter -> QuasiQuoter module Language.Haskell.TH.Syntax where @@ -1720,8 +1722,8 @@ module Language.Haskell.TH.Syntax where qAddForeignFilePath :: ForeignSrcLang -> GHC.Internal.Base.String -> m () qAddModFinalizer :: Q () -> m () qAddCorePlugin :: GHC.Internal.Base.String -> m () - qGetQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a) - qPutQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m () + qGetQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a) + qPutQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m () qIsExtEnabled :: Extension -> m GHC.Internal.Types.Bool qExtsEnabled :: m [Extension] qPutDoc :: DocLoc -> GHC.Internal.Base.String -> m () @@ -1802,7 +1804,7 @@ module Language.Haskell.TH.Syntax where falseName :: Name getDoc :: DocLoc -> Q (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String) getPackageRoot :: Q GHC.Internal.IO.FilePath - getQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a) + getQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a) get_cons_names :: Con -> [Name] hoistCode :: forall (m :: * -> *) (n :: * -> *) (r :: GHC.Internal.Types.RuntimeRep) (a :: TYPE r). GHC.Internal.Base.Monad m => (forall x. m x -> n x) -> Code m a -> Code n a isExtEnabled :: Extension -> Q GHC.Internal.Types.Bool @@ -1849,7 +1851,7 @@ module Language.Haskell.TH.Syntax where oneName :: Name pkgString :: PkgName -> GHC.Internal.Base.String putDoc :: DocLoc -> GHC.Internal.Base.String -> Q () - putQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q () + putQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q () recover :: forall a. Q a -> Q a -> Q a reify :: Name -> Q Info reifyAnnotations :: forall a. GHC.Internal.Data.Data.Data a => AnnLookup -> Q [a] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3c3148806014e3c36fc91b8710c46d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3c3148806014e3c36fc91b8710c46d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] hadrian: enable terminfo if --with-curses-* flags are given
by Marge Bot (＠marge-bot) 08 Aug '25

08 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2157db2d by sterni at 2025-08-08T15:32:39-04:00 hadrian: enable terminfo if --with-curses-* flags are given The GHC make build system used to support WITH_TERMINFO in ghc.mk which allowed controlling whether to build GHC with terminfo or not. hadrian has replaced this with a system where this is effectively controlled by the cross-compiling setting (the default WITH_TERMINFO value was bassed on CrossCompiling, iirc). This behavior is undesireable in some cases and there is not really a good way to work around it. Especially for downstream packagers, modifying this via UserSettings is not really feasible since such a source file has to be kept in sync with Settings/Default.hs manually since it can't import Settings.Default or any predefined Flavour definitions. To avoid having to add a new setting to cfg/system.config and/or a new configure flag (though I'm happy to implement both if required), I've chosen to take --with-curses-* being set explicitly as an indication that the user wants to have terminfo enabled. This would work for Nixpkgs which sets these flags [1] as well as haskell.nix [2] (which goes to some extreme measures [3] [4] to force terminfo in all scenarios). In general, I'm an advocate for making the GHC build be the same for native and cross insofar it is possible since it makes packaging GHC and Haskell related things while still supporting cross much less compilicated. A more minimal GHC with reduced dependencies should probably be a specific flavor, not the default. Partially addresses #26288 by forcing terminfo to be built if the user explicitly passes configure flags related to it. However, it isn't built by default when cross-compiling yet nor is there an explicit way to control the package being built. [1]: https://github.com/NixOS/nixpkgs/blob/3a7266fcefcb9ce353df49ba3f292d0644376… [2]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… [3]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… [4]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa… - - - - - 2 changed files: - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -80,6 +80,7 @@ stageBootPackages = return stage0Packages :: Action [Package] stage0Packages = do cross <- flag CrossCompiling + haveCurses <- any (/= "") <$> traverse setting [ CursesIncludeDir, CursesLibDir ] return $ [ cabalSyntax , cabal , compiler @@ -116,8 +117,8 @@ stage0Packages = do -- that confused Hadrian, so we must make those a stage0 package as well. -- Once we drop `Win32`/`unix` it should be possible to drop those too. ] - ++ [ terminfo | not windowsHost, not cross ] - ++ [ timeout | windowsHost ] + ++ [ terminfo | not windowsHost, (not cross || haveCurses) ] + ++ [ timeout | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -24,6 +24,7 @@ packageArgs = do -- immediately and may lead to cyclic dependencies. -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809. cross = flag CrossCompiling + haveCurses = any (/= "") <$> traverse setting [ CursesIncludeDir, CursesLibDir ] -- Check if the bootstrap compiler has the same version as the one we -- are building. This is used to build cross-compilers @@ -85,7 +86,7 @@ packageArgs = do -- backends at the moment, so we might as well disable it -- for cross GHC. [ andM [expr (ghcWithInterpreter stage), notCross] `cabalFlag` "internal-interpreter" - , notM cross `cabalFlag` "terminfo" + , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id @@ -120,7 +121,7 @@ packageArgs = do -------------------------------- ghcPkg -------------------------------- , package ghcPkg ? - builder (Cabal Flags) ? notM cross `cabalFlag` "terminfo" + builder (Cabal Flags) ? orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" -------------------------------- ghcBoot ------------------------------ , package ghcBoot ? @@ -202,10 +203,10 @@ packageArgs = do , package haskeline ? builder (Cabal Flags) ? arg "-examples" -- Don't depend upon terminfo when cross-compiling to avoid unnecessary - -- dependencies. - -- TODO: Perhaps the user should rather be responsible for this? + -- dependencies unless the user provided ncurses explicitly. + -- TODO: Perhaps the user should be able to explicitly enable/disable this. , package haskeline ? - builder (Cabal Flags) ? notM cross `cabalFlag` "terminfo" + builder (Cabal Flags) ? orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" -------------------------------- terminfo ------------------------------ , package terminfo ? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2157db2d5da391ca77eac156a6787e1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2157db2d5da391ca77eac156a6787e1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new tag ghc-9.10.3-rc3
by Zubin (＠wz1000) 08 Aug '25

08 Aug '25

Zubin pushed new tag ghc-9.10.3-rc3 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.10.3-rc3 You're receiving this email because of your account on gitlab.haskell.org.

1 0