Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1be30772 by Teo Camarasu at 2025-10-14T12:58:30-04:00 Add submodules for template-haskell-lift and template-haskell-quasiquoter These two new boot libraries expose stable subsets of the template-haskell interface. This is an implemenation of the GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/696 Work towards #25262 - - - - - 79e88cd9 by Sven Tennie at 2025-10-14T12:58:30-04:00 T22859: Increase threadDelay for small machines The previously used thread delay led to failures on my RISC-V test setups. - - - - - f923c64f by Hai / @BestYeen at 2025-10-14T12:58:37-04:00 Change Alex and Happy m4 scripts to display which version was found in the system, adapt small formatting details in Happy script to be more like the Alex script again. - - - - - 9c13d7f9 by Hai / @BestYeen at 2025-10-14T12:58:43-04:00 Update occurrences of return to pure and add a sample for redefining :m to mean :main - - - - - f4aa6bc1 by Cheng Shao at 2025-10-14T12:58:44-04:00 testsuite: fix T3586 for non-SSE3 platforms `T3586.hs` contains `-fvia-C -optc-msse3` which I think is a best-effort basis to harvest the C compiler's auto vectorization optimizations via the C backend back when the test was added. The `-fvia-C` part is now a deprecated no-op because GHC can't fall back to the C backend on a non-unregisterised build, and `-optc-msse3` might actually cause the test to fail on non x86/x64 platforms, e.g. recent builds of wasi-sdk would report `wasm32-wasi-clang: error: unsupported option '-msse3' for target 'wasm32-unknown-wasi'`. So this patch cleans up this historical cruft. `-fvia-C` is removed, and `-optc-msse3` is only passed when cpuid contains `pni` (which indicates support of SSE3). - - - - - 14 changed files: - .gitmodules - docs/users_guide/ghci.rst - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs - libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs - + libraries/template-haskell-lift - + libraries/template-haskell-quasiquoter - m4/fptools_alex.m4 - m4/fptools_happy.m4 - testsuite/driver/cpu_features.py - testsuite/tests/perf/should_run/T3586.hs - testsuite/tests/perf/should_run/all.T - testsuite/tests/rts/T22859.hs Changes: ===================================== .gitmodules ===================================== @@ -118,3 +118,9 @@ [submodule "libraries/file-io"] path = libraries/file-io url = https://gitlab.haskell.org/ghc/packages/file-io.git +[submodule "libraries/template-haskell-lift"] + path = libraries/template-haskell-lift + url = https://gitlab.haskell.org/ghc/template-haskell-lift.git +[submodule "libraries/template-haskell-quasiquoter"] + path = libraries/template-haskell-quasiquoter + url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git ===================================== docs/users_guide/ghci.rst ===================================== @@ -403,7 +403,7 @@ it can be *instantiated* to ``IO a``. For example .. code-block:: none - ghci> return True + ghci> pure True True Furthermore, GHCi will print the result of the I/O action if (and only @@ -419,7 +419,7 @@ For example, remembering that ``putStrLn :: String -> IO ()``: ghci> putStrLn "hello" hello - ghci> do { putStrLn "hello"; return "yes" } + ghci> do { putStrLn "hello"; pure "yes" } hello "yes" @@ -443,12 +443,12 @@ prompt must be in the ``IO`` monad. .. code-block:: none - ghci> x <- return 42 + ghci> x <- pure 42 ghci> print x 42 ghci> -The statement ``x <- return 42`` means “execute ``return 42`` in the +The statement ``x <- pure 42`` means “execute ``pure 42`` in the ``IO`` monad, and bind the result to ``x``\ ”. We can then use ``x`` in future statements, for example to print it as we did above. @@ -2389,7 +2389,7 @@ commonly used commands. .. code-block:: none - ghci> let date _ = Data.Time.getZonedTime >>= print >> return "" + ghci> let date _ = Data.Time.getZonedTime >>= print >> pure "" ghci> :def date date ghci> :date 2017-04-10 12:34:56.93213581 UTC @@ -2399,16 +2399,16 @@ commonly used commands. .. code-block:: none - ghci> let mycd d = System.Directory.setCurrentDirectory d >> return "" + ghci> let mycd d = System.Directory.setCurrentDirectory d >> pure "" ghci> :def mycd mycd ghci> :mycd .. - Or I could define a simple way to invoke "``ghc --make Main``" + Or we could define a simple way to invoke "``ghc --make Main``" in the current directory: .. code-block:: none - ghci> :def make (\_ -> return ":! ghc --make Main") + ghci> :def make (\_ -> pure ":! ghc --make Main") We can define a command that reads GHCi input from a file. This might be useful for creating a set of bindings that we want to @@ -2430,6 +2430,15 @@ commonly used commands. a double colon (eg ``::load``). It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. + For historical reasons, ``:m`` in ghci is shorthand for ``:module``. + If we want to override that to mean ``:main``, in a way that also + works when the implicit Prelude is deactivated, we can do it like + this using ``:def!``: + + .. code-block:: none + + ghci> :def! m \_ -> Prelude.pure ":main" + .. ghci-cmd:: :delete; * | ⟨num⟩ ... Delete one or more breakpoints by number (use :ghci-cmd:`:show breaks` to @@ -2912,7 +2921,7 @@ commonly used commands. .. code-block:: none - *ghci> :def cond \expr -> return (":cmd if (" ++ expr ++ ") then return \"\" else return \":continue\"") + *ghci> :def cond \expr -> pure (":cmd if (" ++ expr ++ ") then pure \"\" else pure \":continue\"") *ghci> :set stop 0 :cond (x < 3) To ignore breakpoints for a specified number of iterations use ===================================== hadrian/src/Packages.hs ===================================== @@ -9,7 +9,7 @@ module Packages ( ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , 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 + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, thLift, thQuasiquoter , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count 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, - osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, + osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -124,6 +124,8 @@ runGhc = util "runghc" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" +thLift = lib "template-haskell-lift" +thQuasiquoter = lib "template-haskell-quasiquoter" terminfo = lib "terminfo" text = lib "text" time = lib "time" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -106,6 +106,8 @@ stage0Packages = do , runGhc , semaphoreCompat -- depends on , time -- depends on win32 + , thLift -- new library not yet present for boot compilers + , thQuasiquoter -- new library not yet present for boot compilers , unlit , if windowsHost then win32 else unix -- We must use the in-tree `Win32` as the version ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs ===================================== @@ -20,7 +20,7 @@ -- | This module gives the definition of the 'Lift' class. -- -- This is an internal module. --- Please import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead! +-- Please import "Language.Haskell.TH.Lift", "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead! module GHC.Internal.TH.Lift ( Lift(..) @@ -71,6 +71,9 @@ import GHC.Internal.ForeignPtr -- > deriving Lift -- -- Representation-polymorphic since /template-haskell-2.16.0.0/. +-- +-- This is exposed both from the @template-haskell-lift@ and @template-haskell@ packages. +-- Consider importing it from the more stable @template-haskell-lift@ if you don't need the full breadth of the @template-haskell@ interface. class Lift (t :: TYPE r) where -- | Turn a value into a Template Haskell expression, suitable for use in -- a splice. ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs ===================================== @@ -31,6 +31,9 @@ import GHC.Internal.Base hiding (Type) -- @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'. +-- +-- This is exposed both from the @template-haskell-quasiquoter@ and @template-haskell@ packages. +-- Consider importing it from the more stable @template-haskell-quasiquoter@ if you don't need the full breadth of the @template-haskell@ interface. data QuasiQuoter = QuasiQuoter { -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@ quoteExp :: String -> Q Exp, ===================================== libraries/template-haskell-lift ===================================== @@ -0,0 +1 @@ +Subproject commit e0b2a7eefcd1b7247af63ab4a691d3161eada284 ===================================== libraries/template-haskell-quasiquoter ===================================== @@ -0,0 +1 @@ +Subproject commit a47506eca032b139d9779fb8210d408c81d3fbd6 ===================================== m4/fptools_alex.m4 ===================================== @@ -23,10 +23,16 @@ changequote([, ])dnl ]) if test ! -f compiler/GHC/Parser/Lexer.hs || test ! -f compiler/GHC/Cmm/Lexer.hs then + if test x"$fptools_cv_alex_version" != x; then + fptools_cv_alex_version_display="version $fptools_cv_alex_version"; + else + fptools_cv_alex_version_display="none"; + fi; + failure_msg="Alex version >= 3.2.6 && < 4 is required to compile GHC. (Found: $fptools_cv_alex_version_display)" FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[3.2.6], - [AC_MSG_ERROR([Alex >= 3.2.6 && < 4 is required to compile GHC.])])[] + [AC_MSG_ERROR([$failure_msg])])[] FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-ge],[4.0.0], - [AC_MSG_ERROR([Alex >= 3.2.6 && < 4 is required to compile GHC.])])[] + [AC_MSG_ERROR([$failure_msg])])[] fi AlexVersion=$fptools_cv_alex_version; AC_SUBST(AlexVersion) ===================================== m4/fptools_happy.m4 ===================================== @@ -13,8 +13,7 @@ AC_DEFUN([FPTOOLS_HAPPY], AC_SUBST(HappyCmd,$HAPPY) AC_CACHE_CHECK([for version of happy], fptools_cv_happy_version, changequote(, )dnl -[ -if test x"$HappyCmd" != x; then +[if test x"$HappyCmd" != x; then fptools_cv_happy_version=`"$HappyCmd" -v | grep 'Happy Version' | sed -e 's/Happy Version \([^ ]*\).*/\1/g'` ; else @@ -24,7 +23,12 @@ changequote([, ])dnl ]) if test ! -f compiler/GHC/Parser.hs || test ! -f compiler/GHC/Cmm/Parser.hs then - failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.2 is required to compile GHC" + if test x"$fptools_cv_happy_version" != x; then + fptools_cv_happy_version_display="version $fptools_cv_happy_version"; + else + fptools_cv_happy_version_display="none"; + fi; + failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.2 is required to compile GHC. (Found: $fptools_cv_happy_version_display)" FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.20.0], [AC_MSG_ERROR([$failure_msg])])[] FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[1.21.0], @@ -32,7 +36,6 @@ then [AC_MSG_ERROR([$failure_msg])])[])[] FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[2.2.0], [AC_MSG_ERROR([$failure_msg])])[] - fi HappyVersion=$fptools_cv_happy_version; AC_SUBST(HappyVersion) ===================================== testsuite/driver/cpu_features.py ===================================== @@ -8,7 +8,7 @@ SUPPORTED_CPU_FEATURES = { # These aren't comprehensive; they are only CPU features that we care about # x86: - 'sse', 'sse2', 'sse3', 'ssse3', 'sse4_1', 'sse4_2', + 'sse', 'sse2', 'sse3', 'pni', 'ssse3', 'sse4_1', 'sse4_2', 'avx', 'avx2', 'avx512f', 'fma', 'popcnt', 'bmi1', 'bmi2' ===================================== testsuite/tests/perf/should_run/T3586.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-} -{-# OPTIONS -fvia-C -optc-O3 -fexcess-precision -optc-msse3 #-} +{-# OPTIONS -optc-O3 -fexcess-precision #-} import Control.Monad.ST import Data.Array.ST ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -43,6 +43,7 @@ test('T3586', [collect_runtime_residency(2), collect_stats('bytes allocated', 5), only_ways(['normal']), + when(have_cpu_feature('pni') or have_cpu_feature('sse3'), extra_hc_opts('-optc-msse3')), ], compile_and_run, ['-O']) ===================================== testsuite/tests/rts/T22859.hs ===================================== @@ -42,7 +42,7 @@ main = do takeMVar started readMVar done hFlush stderr - threadDelay 1000 + threadDelay 50000 -- default behaviour: -- kill it after the limit is exceeded hPutStrLn stderr "default behaviour" @@ -68,5 +68,5 @@ main = do hPutStrLn stderr "kill and log" setGlobalAllocationLimitHandler KillOnAllocationLimit (Just $ \_ -> hPutStrLn stderr "allocation limit triggered 3") runWorker - threadDelay 1000 + threadDelay 50000 hPutStrLn stderr "done" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90cde9c3c2627343034742cdab070d4... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90cde9c3c2627343034742cdab070d4... You're receiving this email because of your account on gitlab.haskell.org.