June 2025 - ghc-commits

[Git][ghc/ghc][wip/az/ghc-cpp] More GHC_CPP diagnostic results
by Alan Zimmerman (＠alanz) 08 Jun '25

08 Jun '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: e4bb059f by Alan Zimmerman at 2025-06-08T17:25:24+02:00 More GHC_CPP diagnostic results - - - - - 5 changed files: - compiler/GHC/Parser/PreProcess.hs - compiler/GHC/Parser/PreProcess/Macro.hs - compiler/GHC/Parser/PreProcess/State.hs - testsuite/tests/ghc-cpp/GhcCpp02.hs - testsuite/tests/ghc-cpp/GhcCpp02.stderr Changes: ===================================== compiler/GHC/Parser/PreProcess.hs ===================================== @@ -270,7 +270,7 @@ processCpp loc s = do Right (CppUndef name) -> do ppUndef name Right (CppIf cond) -> do - val <- cppCond cond + val <- cppCond loc cond ar <- pushAccepting val acceptStateChange ar Right (CppIfdef name) -> do @@ -286,7 +286,7 @@ processCpp loc s = do ar <- setAccepting loc (text "#else") (not accepting) acceptStateChange ar Right (CppElIf cond) -> do - val <- cppCond cond + val <- cppCond loc cond ar <- setAccepting loc (text "#elif") val acceptStateChange ar Right CppEndif -> do ===================================== compiler/GHC/Parser/PreProcess/Macro.hs ===================================== @@ -32,29 +32,35 @@ details -- TODO: Parse tokens with original locations in them. -import qualified Data.Map as Map +import Data.Map qualified as Map import Data.Maybe +import Data.Semigroup qualified as S import GHC.Parser.PreProcess.Eval import GHC.Parser.PreProcess.ParsePP import GHC.Parser.PreProcess.Parser qualified as Parser import GHC.Parser.PreProcess.ParserM import GHC.Parser.PreProcess.State -import qualified Data.Semigroup as S import GHC.Prelude +import GHC.Types.SrcLoc +import GHC.Utils.Outputable -- --------------------------------------------------------------------- -- We evaluate to an Int, which we convert to a bool -cppCond :: String -> PP Bool -cppCond str = do - s <- getPpState - let - expanded = expand (pp_defines s) str - v = case Parser.parseExpr expanded of - Left err -> error $ "parseExpr:" ++ show (err, expanded) - Right tree -> eval tree - return (toBool v) +cppCond :: SrcSpan -> String -> PP Bool +cppCond loc str = do + s <- getPpState + let + expanded = expand (pp_defines s) str + v <- case Parser.parseExpr expanded of + Left err -> do + addGhcCPPError loc + (hang (text "Error evaluating CPP condition:") 2 + (text err <+> text "of" $+$ text expanded)) + return 0 + Right tree -> return (eval tree) + return (toBool v) -- --------------------------------------------------------------------- @@ -75,31 +81,32 @@ expandToks 0 _ ts = error $ "macro_expansion limit (" ++ show maxExpansions ++ " expandToks cnt s ts = let (!expansionDone, !r) = doExpandToks False s ts - in + in if expansionDone - then expandToks (cnt -1) s r + then expandToks (cnt - 1) s r else r doExpandToks :: Bool -> MacroDefines -> [Token] -> (Bool, [Token]) doExpandToks ed _ [] = (ed, []) -doExpandToks ed s (TIdentifierLParen n: ts) = - -- TIdentifierLParen has no meaning here (only in a #define), so - -- restore it to its constituent tokens - doExpandToks ed s (TIdentifier (init n):TOpenParen "(":ts) -doExpandToks _ s (TIdentifier "defined" : ts) = (True, rest) - -- See Note: [defined unary operator] below +doExpandToks ed s (TIdentifierLParen n : ts) = + -- TIdentifierLParen has no meaning here (only in a #define), so + -- restore it to its constituent tokens + doExpandToks ed s (TIdentifier (init n) : TOpenParen "(" : ts) +doExpandToks _ s (TIdentifier "defined" : ts) = (True, rest) where + -- See Note: [defined unary operator] below + rest = case getExpandArgs ts of - (Just [[TIdentifier macro_name]], rest0) -> - case Map.lookup macro_name s of - Nothing -> TInteger "0" : rest0 - Just _ ->TInteger "1" : rest0 - (Nothing, TIdentifier macro_name:ts0) -> - case Map.lookup macro_name s of - Nothing -> TInteger "0" : ts0 - Just _ ->TInteger "1" : ts0 - (Nothing,_) -> error $ "defined: expected an identifier, got:" ++ show ts - (Just args,_) -> error $ "defined: expected a single arg, got:" ++ show args + (Just [[TIdentifier macro_name]], rest0) -> + case Map.lookup macro_name s of + Nothing -> TInteger "0" : rest0 + Just _ -> TInteger "1" : rest0 + (Nothing, TIdentifier macro_name : ts0) -> + case Map.lookup macro_name s of + Nothing -> TInteger "0" : ts0 + Just _ -> TInteger "1" : ts0 + (Nothing, _) -> error $ "defined: expected an identifier, got:" ++ show ts + (Just args, _) -> error $ "defined: expected a single arg, got:" ++ show args doExpandToks ed s (TIdentifier n : ts) = (ed'', expanded ++ rest) where (ed', expanded, ts') = case Map.lookup n s of ===================================== compiler/GHC/Parser/PreProcess/State.hs ===================================== @@ -238,18 +238,6 @@ acceptingStateChange old new = -- Exit a scope group popAccepting :: SrcSpan -> PP AcceptingResult --- popAccepting = --- P $ \s -> --- let --- current = scopeValue $ pp_scope (pp s) --- new_scope = case pp_scope (pp s) of --- c :| [] -> c :| [] --- -- c :| [] -> (trace ("popAccepting:keeping old:" ++ show c) c) :| [] --- _ :| (h : t) -> h :| t --- in --- POk --- s{pp = (pp s){pp_scope = new_scope}} --- (acceptingStateChange current (scopeValue new_scope)) popAccepting loc = do scopes <- getScopes new_scope <- case scopes of ===================================== testsuite/tests/ghc-cpp/GhcCpp02.hs ===================================== @@ -5,3 +5,10 @@ foo = #else 13 #endif + +#define EXISTENT_MACRO(X) 2 + NONEXISTENT_MACRO(X) + +-- Note the evaluation error is reported on the *expanded* macro +#if EXISTENT_MACRO(4) +bar = 3 +#endif ===================================== testsuite/tests/ghc-cpp/GhcCpp02.stderr ===================================== @@ -2,3 +2,8 @@ GhcCpp02.hs:5:1: error: [GHC-93098] #else without #if GhcCpp02.hs:7:1: error: [GHC-93098] #endif without #if +GhcCpp02.hs:12:1: error: [GHC-93098] + Error evaluating CPP condition: + Parse error at line 1, column 23 of + 2 + NONEXISTENT_MACRO ( 4 ) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4bb059f18a7d11e494875fe7bbc78e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4bb059f18a7d11e494875fe7bbc78e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/amg/castz] WIP: switch from CastZ to Cast + CastCoercion
by Adam Gundry (＠adamgundry) 08 Jun '25

08 Jun '25

Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC Commits: ab7a57fd by Adam Gundry at 2025-06-08T17:22:42+02:00 WIP: switch from CastZ to Cast + CastCoercion - - - - - 65 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - compiler/GHC/Core/LateCC/TopLevelBinds.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/CallArity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Stats.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Ppr.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Prim.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/EvTerm.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Id/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab7a57fd3ab3003ff3cfac12b675f05… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab7a57fd3ab3003ff3cfac12b675f05… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/coverage] Deleted 2 commits: hadrian: Add attoparsec and dependencies
by Ben Gamari (＠bgamari) 08 Jun '25

08 Jun '25

Ben Gamari pushed to branch wip/coverage at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: ad06343d by Ben Gamari at 2025-06-08T10:07:40-04:00 hadrian: Add attoparsec and dependencies - - - - - c871cf34 by Ben Gamari at 2025-06-08T10:09:24-04:00 WIP submodule bumps - - - - - 5 changed files: - .gitmodules - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/hpc - utils/hpc Changes: ===================================== .gitmodules ===================================== @@ -118,3 +118,12 @@ [submodule "libraries/file-io"] path = libraries/file-io url = https://gitlab.haskell.org/ghc/packages/file-io.git +[submodule "libraries/attoparsec"] + path = libraries/attoparsec + url = https://github.com/haskell/attoparsec +[submodule "libraries/scientific"] + path = libraries/scientific + url = https://github.com/basvandijk/scientific +[submodule "libraries/integer-logarithms"] + path = libraries/integer-logarithms + url = https://github.com/haskellari/integer-logarithms ===================================== hadrian/src/Packages.hs ===================================== @@ -1,15 +1,15 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Packages ( -- * GHC packages - array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, + attoparsec, array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, fileio, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, - hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, + hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, scientific, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -33,13 +33,13 @@ import Oracles.Setting -- packages and modify build default build conditions in "UserSettings". ghcPackages :: [Package] ghcPackages = - [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps + [ attoparsec, array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs - , hp2ps, hpc, hpcBin, integerGmp, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, libffi, mtl, osString + , parsec, pretty, process, rts, runGhc, scientific, stm, semaphoreCompat, templateHaskell , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon @@ -50,17 +50,18 @@ isGhcPackage :: Package -> Bool isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. -array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, +attoparsec, array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddockLibrary, haddockApi, haddock, haskeline, hsc2hs, - hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, remoteIserv, libffi, mtl, + hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, iservProxy, remoteIserv, libffi, mtl, osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package +attoparsec = lib "attoparsec" array = lib "array" base = lib "base" binary = lib "binary" @@ -109,6 +110,7 @@ hp2ps = util "hp2ps" hpc = lib "hpc" hpcBin = util "hpc-bin" `setPath` "utils/hpc" integerGmp = lib "integer-gmp" +integerLogarithms = lib "integer-logarithms" iserv = util "iserv" iservProxy = util "iserv-proxy" libffi = top "libffi" @@ -121,6 +123,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +scientific = lib "scientific" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -80,7 +80,8 @@ stageBootPackages = return stage0Packages :: Action [Package] stage0Packages = do cross <- flag CrossCompiling - return $ [ cabalSyntax + return $ [ attoparsec + , cabalSyntax , cabal , compiler , directory -- depends on filepath, fileIo @@ -102,9 +103,11 @@ stage0Packages = do , hpc , hpcBin , hsc2hs + , integerLogarithms , osString -- new library not yet present for boot compilers , process -- depends on filepath , runGhc + , scientific , semaphoreCompat -- depends on , time -- depends on win32 , unlit ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit 9e29abb785ab4f82c37c7a4e73ec999083955b09 +Subproject commit aa19d28b10bc35a675687d3f41e8924fe2c4cdf9 ===================================== utils/hpc ===================================== @@ -1 +1 @@ -Subproject commit d1780eb21c1e5a1227fff80c8d325d5142f04255 +Subproject commit 61ee79de0d50aef35a7fe8989d6fff5607774899 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cff01eec1bdbca4128a3d0cfa0505… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cff01eec1bdbca4128a3d0cfa0505… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/ghc-cpp] Starting to report GHC_CPP errors using GHC machinery
by Alan Zimmerman (＠alanz) 08 Jun '25

08 Jun '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: b70fb2a2 by Alan Zimmerman at 2025-06-08T16:16:16+02:00 Starting to report GHC_CPP errors using GHC machinery - - - - - 10 changed files: - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PreProcess.hs - compiler/GHC/Parser/PreProcess/State.hs - compiler/GHC/Types/Error/Codes.hs - + testsuite/tests/ghc-cpp/GhcCpp02.stderr - testsuite/tests/ghc-cpp/all.T - utils/check-cpp/PreProcess.hs - utils/check-cpp/State.hs Changes: ===================================== compiler/GHC/Parser/Errors/Ppr.hs ===================================== @@ -573,6 +573,9 @@ instance Diagnostic PsMessage where -> mkSimpleDecorated $ text "The" <+> quotes (text "pattern") <+> "namespace specifier is deprecated." + PsErrGhcCpp content + -> mkSimpleDecorated content + diagnosticReason = \case PsUnknownMessage m -> diagnosticReason m PsHeaderMessage m -> psHeaderMessageReason m @@ -695,6 +698,7 @@ instance Diagnostic PsMessage where PsErrSpecExprMultipleTypeAscription{} -> ErrorWithoutFlag PsWarnSpecMultipleTypeAscription{} -> WarningWithFlag Opt_WarnDeprecatedPragmas PsWarnPatternNamespaceSpecifier{} -> WarningWithFlag Opt_WarnPatternNamespaceSpecifier + PsErrGhcCpp{} -> ErrorWithoutFlag -- AZ: Is this correct? diagnosticHints = \case PsUnknownMessage m -> diagnosticHints m @@ -873,6 +877,7 @@ instance Diagnostic PsMessage where let info = text "and replace" <+> quotes (text "pattern") <+> text "with" <+> quotes (text "data") <> "." in [useExtensionInOrderTo info LangExt.ExplicitNamespaces] + PsErrGhcCpp{} -> noHints diagnosticCode = constructorCode @GHC ===================================== compiler/GHC/Parser/Errors/Types.hs ===================================== @@ -515,6 +515,9 @@ data PsMessage | PsWarnPatternNamespaceSpecifier !Bool -- ^ Is ExplicitNamespaces on? + -- | An error originating from processing a GHC_CPP directive + | PsErrGhcCpp !SDoc + deriving Generic -- | Extra details about a parse error, which helps ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -335,9 +335,9 @@ $unigraphic / { isSmartQuote } { smart_quote_error } ^\# \ * $idchar+ .*\n / { ifExtensionGhcCppNotComment } { cppSkip } -- No leading space, otherwise clashes with OverloadedLabels - ^\# pragma .* \n / { ifExtensionGhcCppNotComment } { cppSkip } -- GCC 3.3 CPP generated, apparently - ^\# \! .* \n / { ifExtensionGhcCppNotComment } { cppSkip } -- #!, for scripts -- gcc - ^\ \# \! .* \n / { ifExtensionGhcCppNotComment } { cppSkip } -- #!, for scripts -- clang; See #6132 + ^\# pragma .* \n / { ifExtensionGhcCppNotComment } { cppSkip } -- GCC 3.3 CPP generated, apparently + ^\# \! .* \n / { ifExtensionGhcCppNotComment } { cppSkip } -- #!, for scripts -- gcc + ^\ \# \! .* \n / { ifExtensionGhcCppNotComment } { cppSkip } -- #!, for scripts -- clang; See #6132 ^\# pragma .* \n ; -- GCC 3.3 CPP generated, apparently ^\# \! .* \n ; -- #!, for scripts -- gcc @@ -351,7 +351,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error } <skipping> { -- Ghc CPP symbols ^\# \ * @cppkeyword .* \n { cppToken cpp_prag } - ^.*\n { cppSkip } + ^.*\n { cppSkip } } -- after a layout keyword (let, where, do, of), we begin a new layout ===================================== compiler/GHC/Parser/PreProcess.hs ===================================== @@ -14,6 +14,7 @@ module GHC.Parser.PreProcess ( ) where import Data.List (intercalate, sortBy) +import Data.Maybe (fromMaybe, listToMaybe) import Data.Map qualified as Map import Debug.Trace (trace) import GHC.Data.FastString @@ -30,8 +31,10 @@ import GHC.Parser.PreProcess.ParserM qualified as PM import GHC.Parser.PreProcess.State import GHC.Prelude import GHC.Types.SrcLoc -import GHC.Utils.Outputable (SDoc, text) +import GHC.Utils.Error +import GHC.Utils.Outputable (text) import GHC.Utils.Panic.Plain (panic) +import GHC.Parser.Errors.Types (PsMessage(PsErrGhcCpp)) -- --------------------------------------------------------------------- @@ -212,7 +215,7 @@ ppLexer queueComments cont = pushContinuation tk contIgnoreTok tk else do - mdump <- processCppToks s + mdump <- processCppToks tk case mdump of Just dump -> -- We have a dump of the state, put it into an ignored token @@ -241,25 +244,25 @@ ppLexer queueComments cont = -- --------------------------------------------------------------------- -processCppToks :: FastString -> PP (Maybe String) +processCppToks :: Located Lexer.Token -> PP (Maybe String) processCppToks fs = do let get (L _ (ITcpp False s _)) = unpackFS s get (L _ (ITcpp True s _)) = init $ unpackFS s - get _ = error "should not" + get _ = panic "Should be ITcpp" -- Combine any prior continuation tokens cs <- popContinuation - processCpp (reverse $ unpackFS fs : map get cs) + let loc = combineLocs fs (fromMaybe fs (listToMaybe cs)) + processCpp loc (concat $ reverse $ map get (fs:cs)) -processCpp :: [String] -> PP (Maybe String) -processCpp ss = do - let s = concat ss +processCpp :: SrcSpan -> String -> PP (Maybe String) +processCpp loc s = do let directive = parseDirective s if directive == Right CppDumpState then return (Just "\ndumped state\n") else do case directive of - Left err -> error $ show (err, s) + Left err -> Lexer.addError $ mkPlainErrorMsgEnvelope loc $ PsErrGhcCpp (text err) Right (CppInclude filename) -> do ppInclude filename Right (CppDefine name args def) -> do @@ -280,14 +283,14 @@ processCpp ss = do acceptStateChange ar Right CppElse -> do accepting <- getAccepting - ar <- setAccepting (not accepting) + ar <- setAccepting loc (text "#else") (not accepting) acceptStateChange ar Right (CppElIf cond) -> do val <- cppCond cond - ar <- setAccepting val + ar <- setAccepting loc (text "#elif") val acceptStateChange ar Right CppEndif -> do - ar <- popAccepting + ar <- popAccepting loc acceptStateChange ar Right CppDumpState -> do return () @@ -298,15 +301,8 @@ processCpp ss = do acceptStateChange :: AcceptingResult -> PP () acceptStateChange ArNoChange = return () acceptStateChange ArNowIgnoring = do - -- alr <- Lexer.getAlrState - -- s <- getPpState - -- let s = trace ("acceptStateChange:ArNowIgnoring") s' - -- setPpState (s { pp_alr_state = Just alr}) Lexer.startSkipping acceptStateChange ArNowAccepting = do - -- s <- getPpState - -- let s = trace ("acceptStateChange:ArNowAccepting") s' - -- mapM_ Lexer.setAlrState (pp_alr_state s) _ <- Lexer.stopSkipping return () ===================================== compiler/GHC/Parser/PreProcess/State.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Parser.PreProcess.State ( ghcCppEnabled, setInLinePragma, getInLinePragma, + addGhcCPPError, ) where import Data.List.NonEmpty ((<|)) @@ -41,12 +42,15 @@ import Data.Map.Strict qualified as Map import Data.Maybe (isJust) import GHC.Base import GHC.Data.StringBuffer +import GHC.Parser.Errors.Types (PsMessage (PsErrGhcCpp)) import GHC.Parser.Lexer (P (..), PState (..), ParseResult (..)) import GHC.Parser.Lexer qualified as Lexer import GHC.Parser.PreProcess.ParserM (Token (..)) import GHC.Types.SrcLoc +import GHC.Utils.Error import GHC.Prelude +import GHC.Utils.Outputable (text, (<+>)) -- --------------------------------------------------------------------- @@ -191,20 +195,22 @@ pushAccepting on = do -- Note: this is only ever called in the context of a pp group (i.e. -- after pushAccepting) from processing #else or #elif -setAccepting :: Bool -> PP AcceptingResult -setAccepting on = do +setAccepting :: SrcSpan -> SDoc -> Bool -> PP AcceptingResult +setAccepting loc ctx on = do current <- getAccepting parent_scope <- parentScope let parent_on = pp_accepting parent_scope current_scope <- getScope let group_state = pp_group_state current_scope let possible_accepting = parent_on && on - let (new_group_state, accepting) = - case (group_state, possible_accepting) of - (PpNoGroup, _) -> error "setAccepting for state PpNoGroup" -- AZ: Tested in GhcCpp02 - (PpInGroupStillInactive, True) -> (PpInGroupHasBeenActive, True) - (PpInGroupStillInactive, False) -> (PpInGroupStillInactive, False) - (PpInGroupHasBeenActive, _) -> (PpInGroupHasBeenActive, False) + (new_group_state, accepting) <- + case (group_state, possible_accepting) of + (PpNoGroup, _) -> do + addGhcCPPError loc (ctx <+> text "without #if") + return (PpNoGroup, True) + (PpInGroupStillInactive, True) -> return (PpInGroupHasBeenActive, True) + (PpInGroupStillInactive, False) -> return (PpInGroupStillInactive, False) + (PpInGroupHasBeenActive, _) -> return (PpInGroupHasBeenActive, False) -- let (new_group_state, accepting) -- = trace ("setAccepting:" ++ show ((group_state, possible_accepting), (new_group_state', accepting'))) (new_group_state', accepting') @@ -231,19 +237,29 @@ acceptingStateChange old new = _ -> ArNoChange -- Exit a scope group -popAccepting :: PP AcceptingResult -popAccepting = - P $ \s -> - let - current = scopeValue $ pp_scope (pp s) - new_scope = case pp_scope (pp s) of - c :| [] -> c :| [] - -- c :| [] -> (trace ("popAccepting:keeping old:" ++ show c) c) :| [] - _ :| (h : t) -> h :| t - in - POk - s{pp = (pp s){pp_scope = new_scope}} - (acceptingStateChange current (scopeValue new_scope)) +popAccepting :: SrcSpan -> PP AcceptingResult +-- popAccepting = +-- P $ \s -> +-- let +-- current = scopeValue $ pp_scope (pp s) +-- new_scope = case pp_scope (pp s) of +-- c :| [] -> c :| [] +-- -- c :| [] -> (trace ("popAccepting:keeping old:" ++ show c) c) :| [] +-- _ :| (h : t) -> h :| t +-- in +-- POk +-- s{pp = (pp s){pp_scope = new_scope}} +-- (acceptingStateChange current (scopeValue new_scope)) +popAccepting loc = do + scopes <- getScopes + new_scope <- case scopes of + c :| [] -> do + addGhcCPPError loc (text "#endif without #if") + return (c :| []) + _ :| (h : t) -> return (h :| t) + setScopes new_scope + let current = scopeValue scopes + return (acceptingStateChange current (scopeValue new_scope)) scopeValue :: NonEmpty PpScope -> Bool scopeValue s = pp_accepting $ NonEmpty.head s @@ -280,6 +296,13 @@ setScope scope = in POk s{pp = (pp s){pp_scope = new_scope}} () +getScopes :: PP (NonEmpty PpScope) +getScopes = P $ \s -> POk s (pp_scope (pp s)) + +setScopes :: (NonEmpty PpScope) -> PP () +setScopes new_scope = + P $ \s -> POk s{pp = (pp s){pp_scope = new_scope}} () + {- Note [PpScope stack] ~~~~~~~~~~~~~~~~~~~~ @@ -404,3 +427,7 @@ insertMacroDef (MacroName name args) def md = Just dm -> Map.insert name (Map.insert arity (args, def) dm) md -- --------------------------------------------------------------------- + +addGhcCPPError :: SrcSpan -> SDoc -> P p () +addGhcCPPError loc err = + Lexer.addError $ mkPlainErrorMsgEnvelope loc $ PsErrGhcCpp err ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -371,6 +371,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "PsErrSpecExprMultipleTypeAscription" = 62037 GhcDiagnosticCode "PsWarnSpecMultipleTypeAscription" = 73026 GhcDiagnosticCode "PsWarnPatternNamespaceSpecifier" = 68383 + GhcDiagnosticCode "PsErrGhcCpp" = 93098 -- Driver diagnostic codes GhcDiagnosticCode "DriverMissingHomeModules" = 32850 ===================================== testsuite/tests/ghc-cpp/GhcCpp02.stderr ===================================== @@ -0,0 +1,4 @@ +GhcCpp02.hs:5:1: error: [GHC-93098] #else without #if + +GhcCpp02.hs:7:1: error: [GHC-93098] #endif without #if + ===================================== testsuite/tests/ghc-cpp/all.T ===================================== @@ -20,4 +20,4 @@ test('GhcCpp01', compile, ['-ddump-ghc-cpp -dkeep-comments']) -test('GhcCpp02', normal, compile, ['']) \ No newline at end of file +test('GhcCpp02', normal, compile_fail, ['']) \ No newline at end of file ===================================== utils/check-cpp/PreProcess.hs ===================================== @@ -1,6 +1,7 @@ module PreProcess where import Data.List +import Data.Maybe (fromMaybe, listToMaybe) import qualified Data.Map as Map import Debug.Trace import GHC hiding (addSourceToTokens) @@ -20,6 +21,7 @@ import GHC.Types.SrcLoc import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Panic.Plain +import GHC.Parser.Errors.Types (PsMessage(PsErrGhcCpp)) import Macro import ParsePP @@ -241,7 +243,7 @@ ppLexer queueComments cont = pushContinuation tk contIgnoreTok tk else do - mdump <- processCppToks s + mdump <- processCppToks tk case mdump of Just dump -> -- We have a dump of the state, put it into an ignored token @@ -270,25 +272,25 @@ ppLexer queueComments cont = -- --------------------------------------------------------------------- -processCppToks :: FastString -> PP (Maybe String) +processCppToks :: Located Lexer.Token -> PP (Maybe String) processCppToks fs = do let get (L _ (ITcpp False s _)) = unpackFS s get (L _ (ITcpp True s _)) = init $ unpackFS s - get _ = error "should not" + get _ = panic "Should be ITcpp" -- Combine any prior continuation tokens cs <- popContinuation - processCpp (reverse $ unpackFS fs : map get cs) + let loc = combineLocs fs (fromMaybe fs (listToMaybe cs)) + processCpp loc (concat $ reverse $ map get (fs:cs)) -processCpp :: [String] -> PP (Maybe String) -processCpp ss = do - let s = concat ss +processCpp :: SrcSpan -> String -> PP (Maybe String) +processCpp loc s = do let directive = parseDirective s if directive == Right CppDumpState then return (Just "\ndumped state\n") else do case directive of - Left err -> error $ show (err, s) + Left err -> Lexer.addError $ mkPlainErrorMsgEnvelope loc $ PsErrGhcCpp (fsLit (show err)) Right (CppInclude filename) -> do ppInclude filename Right (CppDefine name args def) -> do @@ -309,11 +311,11 @@ processCpp ss = do acceptStateChange ar Right CppElse -> do accepting <- getAccepting - ar <- setAccepting (not accepting) + ar <- setAccepting loc (not accepting) acceptStateChange ar Right (CppElIf cond) -> do val <- cppCond cond - ar <- setAccepting val + ar <- setAccepting loc val acceptStateChange ar Right CppEndif -> do ar <- popAccepting ===================================== utils/check-cpp/State.hs ===================================== @@ -32,17 +32,22 @@ module State ( ghcCppEnabled, setInLinePragma, getInLinePragma, + addGhcCPPError, ) where import Data.List.NonEmpty ((<|)) -import qualified Data.List.NonEmpty as NonEmpty -import Data.Map (Map) -import qualified Data.Map as Map +import Data.List.NonEmpty qualified as NonEmpty +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map import Data.Maybe (isJust) import GHC.Base +import GHC.Data.FastString import GHC.Data.StringBuffer import GHC.Parser.Lexer (P (..), PState (..), ParseResult (..)) -import qualified GHC.Parser.Lexer as Lexer +import GHC.Parser.Lexer qualified as Lexer +import GHC.Parser.Errors.Types (PsMessage(PsErrGhcCpp)) +import GHC.Utils.Error +-- import GHC.Parser.PreProcess.ParserM (Token (..)) import GHC.Types.SrcLoc import ParserM (Token (..)) @@ -192,20 +197,22 @@ pushAccepting on = do -- Note: this is only ever called in the context of a pp group (i.e. -- after pushAccepting) from processing #else or #elif -setAccepting :: Bool -> PP AcceptingResult -setAccepting on = do +setAccepting :: SrcSpan -> Bool -> PP AcceptingResult +setAccepting loc on = do current <- getAccepting parent_scope <- parentScope let parent_on = pp_accepting parent_scope current_scope <- getScope let group_state = pp_group_state current_scope let possible_accepting = parent_on && on - let (new_group_state, accepting) = + (new_group_state, accepting) <- case (group_state, possible_accepting) of - (PpNoGroup, _) -> error "setAccepting for state PpNoGroup" - (PpInGroupStillInactive, True) -> (PpInGroupHasBeenActive, True) - (PpInGroupStillInactive, False) -> (PpInGroupStillInactive, False) - (PpInGroupHasBeenActive, _) -> (PpInGroupHasBeenActive, False) + (PpNoGroup, _) -> do + addGhcCPPError loc "setAccepting for state PpNoGroup" + return (PpNoGroup, True) + (PpInGroupStillInactive, True) -> return (PpInGroupHasBeenActive, True) + (PpInGroupStillInactive, False) -> return (PpInGroupStillInactive, False) + (PpInGroupHasBeenActive, _) -> return (PpInGroupHasBeenActive, False) -- let (new_group_state, accepting) -- = trace ("setAccepting:" ++ show ((group_state, possible_accepting), (new_group_state', accepting'))) (new_group_state', accepting') @@ -405,3 +412,7 @@ insertMacroDef (MacroName name args) def md = Just dm -> Map.insert name (Map.insert arity (args, def) dm) md -- --------------------------------------------------------------------- + +addGhcCPPError :: SrcSpan -> String -> P p () +addGhcCPPError loc err + = Lexer.addError $ mkPlainErrorMsgEnvelope loc $ PsErrGhcCpp (fsLit err) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b70fb2a29cee983c058502c29572e50… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b70fb2a29cee983c058502c29572e50… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/coverage] 2 commits: hadrian: Add attoparsec and dependencies
by Ben Gamari (＠bgamari) 08 Jun '25

08 Jun '25

Ben Gamari pushed to branch wip/coverage at Glasgow Haskell Compiler / GHC Commits: ad06343d by Ben Gamari at 2025-06-08T10:07:40-04:00 hadrian: Add attoparsec and dependencies - - - - - c871cf34 by Ben Gamari at 2025-06-08T10:09:24-04:00 WIP submodule bumps - - - - - 5 changed files: - .gitmodules - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/hpc - utils/hpc Changes: ===================================== .gitmodules ===================================== @@ -118,3 +118,12 @@ [submodule "libraries/file-io"] path = libraries/file-io url = https://gitlab.haskell.org/ghc/packages/file-io.git +[submodule "libraries/attoparsec"] + path = libraries/attoparsec + url = https://github.com/haskell/attoparsec +[submodule "libraries/scientific"] + path = libraries/scientific + url = https://github.com/basvandijk/scientific +[submodule "libraries/integer-logarithms"] + path = libraries/integer-logarithms + url = https://github.com/haskellari/integer-logarithms ===================================== hadrian/src/Packages.hs ===================================== @@ -1,15 +1,15 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Packages ( -- * GHC packages - array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, + attoparsec, array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, fileio, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, - hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, + hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, scientific, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -33,13 +33,13 @@ import Oracles.Setting -- packages and modify build default build conditions in "UserSettings". ghcPackages :: [Package] ghcPackages = - [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps + [ attoparsec, array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs - , hp2ps, hpc, hpcBin, integerGmp, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, libffi, mtl, osString + , parsec, pretty, process, rts, runGhc, scientific, stm, semaphoreCompat, templateHaskell , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon @@ -50,17 +50,18 @@ isGhcPackage :: Package -> Bool isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. -array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, +attoparsec, array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddockLibrary, haddockApi, haddock, haskeline, hsc2hs, - hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, remoteIserv, libffi, mtl, + hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, iservProxy, remoteIserv, libffi, mtl, osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package +attoparsec = lib "attoparsec" array = lib "array" base = lib "base" binary = lib "binary" @@ -109,6 +110,7 @@ hp2ps = util "hp2ps" hpc = lib "hpc" hpcBin = util "hpc-bin" `setPath` "utils/hpc" integerGmp = lib "integer-gmp" +integerLogarithms = lib "integer-logarithms" iserv = util "iserv" iservProxy = util "iserv-proxy" libffi = top "libffi" @@ -121,6 +123,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +scientific = lib "scientific" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -80,7 +80,8 @@ stageBootPackages = return stage0Packages :: Action [Package] stage0Packages = do cross <- flag CrossCompiling - return $ [ cabalSyntax + return $ [ attoparsec + , cabalSyntax , cabal , compiler , directory -- depends on filepath, fileIo @@ -102,9 +103,11 @@ stage0Packages = do , hpc , hpcBin , hsc2hs + , integerLogarithms , osString -- new library not yet present for boot compilers , process -- depends on filepath , runGhc + , scientific , semaphoreCompat -- depends on , time -- depends on win32 , unlit ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit 9e29abb785ab4f82c37c7a4e73ec999083955b09 +Subproject commit aa19d28b10bc35a675687d3f41e8924fe2c4cdf9 ===================================== utils/hpc ===================================== @@ -1 +1 @@ -Subproject commit d1780eb21c1e5a1227fff80c8d325d5142f04255 +Subproject commit 61ee79de0d50aef35a7fe8989d6fff5607774899 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e41547701472f8d1ca60e4234300cf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e41547701472f8d1ca60e4234300cf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/coverage] hadrian: Add attoparsec and dependencies
by Ben Gamari (＠bgamari) 08 Jun '25

08 Jun '25

Ben Gamari pushed to branch wip/coverage at Glasgow Haskell Compiler / GHC Commits: e4154770 by Ben Gamari at 2025-06-08T10:06:31-04:00 hadrian: Add attoparsec and dependencies - - - - - 3 changed files: - .gitmodules - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs Changes: ===================================== .gitmodules ===================================== @@ -118,3 +118,12 @@ [submodule "libraries/file-io"] path = libraries/file-io url = https://gitlab.haskell.org/ghc/packages/file-io.git +[submodule "libraries/attoparsec"] + path = libraries/attoparsec + url = https://github.com/haskell/attoparsec +[submodule "libraries/scientific"] + path = libraries/scientific + url = https://github.com/basvandijk/scientific +[submodule "libraries/integer-logarithms"] + path = libraries/integer-logarithms + url = https://github.com/haskellari/integer-logarithms ===================================== hadrian/src/Packages.hs ===================================== @@ -1,15 +1,15 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Packages ( -- * GHC packages - array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, + attoparsec, array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, fileio, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, - hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, + hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, scientific, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -33,13 +33,13 @@ import Oracles.Setting -- packages and modify build default build conditions in "UserSettings". ghcPackages :: [Package] ghcPackages = - [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps + [ attoparsec, array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs - , hp2ps, hpc, hpcBin, integerGmp, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, libffi, mtl, osString + , parsec, pretty, process, rts, runGhc, scientific, stm, semaphoreCompat, templateHaskell , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon @@ -50,17 +50,18 @@ isGhcPackage :: Package -> Bool isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. -array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, +attoparsec, array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddockLibrary, haddockApi, haddock, haskeline, hsc2hs, - hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, remoteIserv, libffi, mtl, + hp2ps, hpc, hpcBin, integerGmp, integerLogarithms, iserv, iservProxy, remoteIserv, libffi, mtl, osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package +attoparsec = lib "attoparsec" array = lib "array" base = lib "base" binary = lib "binary" @@ -109,6 +110,7 @@ hp2ps = util "hp2ps" hpc = lib "hpc" hpcBin = util "hpc-bin" `setPath` "utils/hpc" integerGmp = lib "integer-gmp" +integerLogarithms = lib "integer-logarithsm" iserv = util "iserv" iservProxy = util "iserv-proxy" libffi = top "libffi" @@ -121,6 +123,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +scientific = lib "scientific" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -80,7 +80,8 @@ stageBootPackages = return stage0Packages :: Action [Package] stage0Packages = do cross <- flag CrossCompiling - return $ [ cabalSyntax + return $ [ attoparsec + , cabalSyntax , cabal , compiler , directory -- depends on filepath, fileIo @@ -102,9 +103,11 @@ stage0Packages = do , hpc , hpcBin , hsc2hs + , integerLogarithms , osString -- new library not yet present for boot compilers , process -- depends on filepath , runGhc + , scientific , semaphoreCompat -- depends on , time -- depends on win32 , unlit View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e41547701472f8d1ca60e4234300cf3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e41547701472f8d1ca60e4234300cf3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ozkutuk/sprint-fun] Accept the new test outputs
by Berk Özkütük (＠ozkutuk) 08 Jun '25

08 Jun '25

Berk Özkütük pushed to branch wip/ozkutuk/sprint-fun at Glasgow Haskell Compiler / GHC Commits: 73048fdf by Berk Özkütük at 2025-06-08T15:16:27+02:00 Accept the new test outputs - - - - - 12 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - testsuite/tests/ghci.debugger/scripts/T12449.stdout - testsuite/tests/ghci.debugger/scripts/T19157.stdout - testsuite/tests/ghci.debugger/scripts/T19355.stdout - testsuite/tests/ghci.debugger/scripts/T19394.stdout - testsuite/tests/ghci.debugger/scripts/break006.stdout - testsuite/tests/ghci.debugger/scripts/break026.stdout - testsuite/tests/ghci.debugger/scripts/hist001.stdout - testsuite/tests/ghci.debugger/scripts/hist002.stdout - testsuite/tests/ghci.debugger/scripts/print027.stdout - testsuite/tests/ghci/scripts/T23507.script - testsuite/tests/ghci/scripts/T23507.stdout Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -1,6 +1,4 @@ {-# LANGUAGE MagicHash #-} -{-# LANGUAGE ViewPatterns #-} - {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ > 912 @@ -388,9 +386,7 @@ cPprTermBase y = ifFunSuspension pred f prec t@Suspension{ctype = ctype} | ctype `elem` fun_ctype && pred t = f prec t where - -- TODO(ozkutuk): PAP _seems to be_ indicate a function closure, - -- I have no idea what AP is though - fun_ctype = [ FUN, FUN_1_0, FUN_0_1, FUN_2_0, FUN_1_1, FUN_0_2, FUN_STATIC, AP, PAP ] + fun_ctype = [ FUN, FUN_1_0, FUN_0_1, FUN_2_0, FUN_1_1, FUN_0_2, FUN_STATIC, PAP ] ifFunSuspension _ _ _ _ = return Nothing isFunTy :: Type -> Bool @@ -513,8 +509,8 @@ cPprTermBase y = ppr_list _ _ = panic "doList" ppr_fun :: Precedence -> Term -> m (Maybe SDoc) - ppr_fun _ (ty -> fun_ty) = return $ Just $ - angleBrackets (underscore <+> dcolon <+> pprType fun_ty) + ppr_fun _ t = return $ Just $ + angleBrackets (underscore <+> dcolon <+> pprType (ty t)) repPrim :: TyCon -> [Word] -> SDoc ===================================== testsuite/tests/ghci.debugger/scripts/T12449.stdout ===================================== @@ -1,26 +1,26 @@ -fmap = (_t1::forall (f :: * -> *) a b. +fmap = <_ :: forall (f :: * -> *) a b. Functor f => - (a -> b) -> f a -> f b) + (a -> b) -> f a -> f b> fmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b _t1 :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b -show = (_t2::forall a. Show a => a -> String) +show = <_ :: forall a. Show a => a -> String> show :: forall a. Show a => a -> String _t2 :: forall a. Show a => a -> String "\"foo\"" ["7","42"] -_t1 = (_t3::forall (f :: * -> *) a b. +_t1 = <_ :: forall (f :: * -> *) a b. Functor f => - (a -> b) -> f a -> f b) + (a -> b) -> f a -> f b> _t3 :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b -_t2 = (_t4::forall a. Show a => a -> String) +_t2 = <_ :: forall a. Show a => a -> String> _t4 :: forall a. Show a => a -> String ["7","42"] -id = (_t5::forall a. a -> a) +id = <_ :: forall a. a -> a> id :: forall a. a -> a _t5 :: forall a. a -> a -print = (_t6::forall a. Show a => a -> IO ()) +print = <_ :: forall a. Show a => a -> IO ()> print :: forall a. Show a => a -> IO () _t6 :: forall a. Show a => a -> IO () ===================================== testsuite/tests/ghci.debugger/scripts/T19157.stdout ===================================== @@ -3,19 +3,19 @@ Breakpoint 1 activated at T19157.hs:8:23-37 ---------------------- Test 1 Stopped in T19157.mySum.go, T19157.hs:8:23-37 _result :: Int = _ -go :: Int -> [Int] -> Int = _ +go :: Int -> [Int] -> Int = <_ :: Int -> [Int] -> Int> s :: Int = 1 ss :: [Int] = [2,3,4,5,6] sum :: Int = 0 Stopped in T19157.mySum.go, T19157.hs:8:23-37 _result :: Int = _ -go :: Int -> [Int] -> Int = _ +go :: Int -> [Int] -> Int = <_ :: Int -> [Int] -> Int> s :: Int = 4 ss :: [Int] = [5,6] sum :: Int = _ Stopped in T19157.mySum.go, T19157.hs:8:23-37 _result :: Int = _ -go :: Int -> [Int] -> Int = _ +go :: Int -> [Int] -> Int = <_ :: Int -> [Int] -> Int> s :: Int = 6 ss :: [Int] = [] sum :: Int = _ @@ -26,7 +26,7 @@ sum :: Int = _ ---------------------- Test 2 Stopped in T19157.mySum.go, T19157.hs:8:23-37 _result :: Int = _ -go :: Int -> [Int] -> Int = _ +go :: Int -> [Int] -> Int = <_ :: Int -> [Int] -> Int> s :: Int = 1001 ss :: [Int] = _ sum :: Int = _ ===================================== testsuite/tests/ghci.debugger/scripts/T19355.stdout ===================================== @@ -1,8 +1,12 @@ -fmap = (_t1::Functor f => (a -> b) -> f a -> f b) -fmap = (_t2::forall (f :: * -> *) a b. +fmap = <_ :: forall (f :: * -> *) a b. Functor f => - (a -> b) -> f a -> f b) -<*> = (_t3::forall (f :: * -> *) a b. + (a -> b) -> f a -> f b> +fmap = <_ :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b> +<*> = <_ :: forall (f :: * -> *) a b. + Applicative f => + f (a -> b) -> f a -> f b> +<*> = <_ :: forall (f :: * -> *) a b. Applicative f => - f (a -> b) -> f a -> f b) -<*> = (_t4::Applicative f => f (a -> b) -> f a -> f b) + f (a -> b) -> f a -> f b> ===================================== testsuite/tests/ghci.debugger/scripts/T19394.stdout ===================================== @@ -4,8 +4,10 @@ Identifier ‘realWorld#’ is not eligible for the :print, :sprint or :force co Type constructor ‘Word8#’ is not eligible for the :print, :sprint or :force commands. Type constructor ‘Int’ is not eligible for the :print, :sprint or :force commands. Identifier ‘void#’ is not eligible for the :print, :sprint or :force commands. -error = (_t1::GHC.Internal.Stack.Types.HasCallStack => [Char] -> a) -oneShot = (_t2::(a -> b) -> a -> b) -xor# = (_t3::Word# -> Word# -> Word#) -seq# = (_t4::a -> State# s -> (# State# s, a #)) -lazy = (_t5::a -> a) +error = <_ :: forall a. + GHC.Internal.Stack.Types.HasCallStack => + [Char] -> a> +oneShot = <_ :: forall a b. (a -> b) -> a -> b> +xor# = <_ :: Word# -> Word# -> Word#> +seq# = <_ :: forall a s. a -> State# s -> (# State# s, a #)> +lazy = <_ :: forall a. a -> a> ===================================== testsuite/tests/ghci.debugger/scripts/break006.stdout ===================================== @@ -1,16 +1,16 @@ Stopped in Main.mymap, Test3.hs:2:18-31 _result :: [a] = _ -f :: Int -> a = _ +f :: Int -> a = <_ :: Int -> a> x :: Int = 1 xs :: [Int] = [2,3] xs :: [Int] = [2,3] -f :: Int -> a = _ +f :: Int -> a = <_ :: Int -> a> x :: Int = 1 _result :: [a] = _ y = (_t1::a) y = 2 xs :: [Int] = [2,3] -f :: Int -> Int = _ +f :: Int -> Int = <_ :: Int -> Int> x :: Int = 1 _result :: [Int] = _ y :: Int = 2 ===================================== testsuite/tests/ghci.debugger/scripts/break026.stdout ===================================== @@ -1,7 +1,7 @@ Stopped in Test.foldl, break026.hs:5:16-22 _result :: Int = _ c :: Int = 0 -go :: Int -> [t1] -> Int = _ +go :: Int -> [t1] -> Int = <_ :: Int -> [t1] -> Int> xs :: [t1] = _ Stopped in Test.foldl.go, break026.hs:7:23-35 _result :: Int = _ @@ -19,7 +19,7 @@ c = 1 Stopped in Test.foldl, break026.hs:5:16-22 _result :: Int = _ c :: Int = 0 -go :: Int -> [t1] -> Int = _ +go :: Int -> [t1] -> Int = <_ :: Int -> [t1] -> Int> xs :: [t1] = _ Stopped in Test.foldl.go, break026.hs:7:23-35 _result :: Int = _ ===================================== testsuite/tests/ghci.debugger/scripts/hist001.stdout ===================================== @@ -13,14 +13,14 @@ _result :: [a] f :: t -> a xs :: [t] xs :: [t] = [] -f :: t -> a = _ +f :: t -> a = <_ :: t -> a> _result :: [a] = _ Logged breakpoint at Test3.hs:2:18-20 _result :: a f :: Integer -> a x :: Integer xs :: [t] = [] -f :: Integer -> a = _ +f :: Integer -> a = <_ :: Integer -> a> x :: Integer = 2 _result :: a = _ _result = 3 ===================================== testsuite/tests/ghci.debugger/scripts/hist002.stdout ===================================== @@ -13,14 +13,14 @@ _result :: [a] f :: t -> a xs :: [t] xs :: [t] = [] -f :: t -> a = _ +f :: t -> a = <_ :: t -> a> _result :: [a] = _ Logged breakpoint at Test3.hs:2:18-20 _result :: a f :: Integer -> a x :: Integer xs :: [t] = [] -f :: Integer -> a = _ +f :: Integer -> a = <_ :: Integer -> a> x :: Integer = 2 _result :: a = _ _result = 3 ===================================== testsuite/tests/ghci.debugger/scripts/print027.stdout ===================================== @@ -1,6 +1,10 @@ -+ = (_t1::Num a => a -> a -> a) -print = (_t2::Show a => a -> IO ()) -log = (_t3::Floating a => a -> a) -head = (_t4::GHC.Internal.Stack.Types.HasCallStack => [a] -> a) -tail = (_t5::GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]) -fst = (_t6::(a, b) -> a) ++ = <_ :: forall a. Num a => a -> a -> a> +print = <_ :: forall a. Show a => a -> IO ()> +log = <_ :: forall a. Floating a => a -> a> +head = <_ :: forall a. + GHC.Internal.Stack.Types.HasCallStack => + [a] -> a> +tail = <_ :: forall a. + GHC.Internal.Stack.Types.HasCallStack => + [a] -> [a]> +fst = <_ :: forall a b. (a, b) -> a> ===================================== testsuite/tests/ghci/scripts/T23507.script ===================================== @@ -1,4 +1,9 @@ let f () = () :sprint f +f () +:sprint f + let x = 3 :sprint x +x +:sprint x ===================================== testsuite/tests/ghci/scripts/T23507.stdout ===================================== @@ -1,2 +1,6 @@ +f = _ +() f = <_ :: () -> ()> +x = _ +3 x = <_ :: forall {a}. Num a => a> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73048fdfa048019a538eba811394e0c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73048fdfa048019a538eba811394e0c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/wasm-bytearray-marshall
by Matthew Pickering (＠mpickering) 08 Jun '25

08 Jun '25

Matthew Pickering pushed new branch wip/wasm-bytearray-marshall at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wasm-bytearray-marshall You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/amg/castz] WIP: introduce CastZ as an alternative to coercion zapping
by Adam Gundry (＠adamgundry) 08 Jun '25

08 Jun '25

Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC Commits: eb7082c4 by Adam Gundry at 2025-06-08T09:38:47+02:00 WIP: introduce CastZ as an alternative to coercion zapping - - - - - 50 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - compiler/GHC/Core/LateCC/TopLevelBinds.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/CallArity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Stats.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Zonk/Type.hs - docs/core-spec/CoreLint.ott - docs/core-spec/CoreSyn.ott - docs/core-spec/OpSem.ott The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb7082c40fa82e30b3d46ce972804d0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb7082c40fa82e30b3d46ce972804d0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/amg/castz] 2 commits: WIP: hack out hadrian-ghc-in-ghci
by Adam Gundry (＠adamgundry) 08 Jun '25

08 Jun '25

Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC Commits: 4945de0e by Adam Gundry at 2025-06-08T08:43:44+02:00 WIP: hack out hadrian-ghc-in-ghci - - - - - 9fa4812e by Adam Gundry at 2025-06-08T08:43:44+02:00 WIP: introduce CastZ as an alternative to coercion zapping - - - - - 51 changed files: - .gitlab-ci.yml - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - compiler/GHC/Core/LateCC/TopLevelBinds.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/CallArity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Stats.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Zonk/Type.hs - docs/core-spec/CoreLint.ott - docs/core-spec/CoreSyn.ott - docs/core-spec/OpSem.ott The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c2538907976dfb87fb6a532a81777… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c2538907976dfb87fb6a532a81777… You're receiving this email because of your account on gitlab.haskell.org.

1 0