- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/ci-make-install-j
by Cheng Shao (＠TerrorJack) 14 Mar '26

14 Mar '26

Cheng Shao pushed new branch wip/ci-make-install-j at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ci-make-install-j You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: configure: make $LLVMAS default to $CC when $CcLlvmBackend is YES
by Marge Bot (＠marge-bot) 14 Mar '26

14 Mar '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8833e7d9 by Cheng Shao at 2026-03-14T00:11:41-04:00 configure: make $LLVMAS default to $CC when $CcLlvmBackend is YES This patch changes the $LLVMAS detection logic in configure so that when it's not manually specified by the user, it defaults to $CC if $CcLlvmBackend is YES. It's a more sensible default than auto-detected clang from the environment, especially when cross-compiling, $CC as the cross target's LLVM assembler is more compatible with the use case than the system-wide clang. Fixes #26769. - - - - - 53ae233d by Matthew Pickering at 2026-03-14T00:11:41-04:00 exceptions: annotate onException continuation with WhileHandling Before this patch, an exception thrown in the `onException` handler would loose track of where the original exception was thrown. ``` import Control.Exception main :: IO () main = failingAction `onException` failingCleanup where failingAction = throwIO (ErrorCall "outer failure") failingCleanup = throwIO (ErrorCall "cleanup failure") ``` would report ``` T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: cleanup failure HasCallStack backtrace: throwIO, called at T28399.hs:<line>:<column> in <package-id>:Main ``` notice that the "outer failure" exception is not present in the error message. With this patch, any exception thrown is in the handler is annotated with WhileHandling. The resulting message looks like ``` T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: cleanup failure While handling outer failure HasCallStack backtrace: throwIO, called at T28399.hs:7:22 in main:Main ``` CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/397 Fixes #26759 - - - - - a3ac9e2a by Andreas Klebinger at 2026-03-14T00:11:42-04:00 Fix missing profiling header for origin_thunk frame. Fixes #27007 - - - - - e1118b76 by Cheng Shao at 2026-03-14T00:11:43-04:00 ci: fix ci-images revision The current ci-images revision was a commit on the WIP branch of https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/183, and it's not on the current ci-images master branch. This patch fixes the image revision to use the current tip of ci-images master. - - - - - 6a4c0dcc by Andreas Klebinger at 2026-03-14T00:11:44-04:00 Revert "hadrian/build-cabal: Better respect and utilize -j" This reverts commit eab3dbba79650e6046efca79133b4c0a5257613d. While it's neat this currently isn't well supported on all platforms. It's time will come, but for now I'm reverting this to avoid issues for users on slightly unconvential platforms. This will be tracked at #26977. - - - - - 14 changed files: - .gitlab-ci.yml - configure.ac - distrib/configure.ac.in - hadrian/build-cabal - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs - libraries/ghc-internal/src/GHC/Internal/IO.hs - rts/StgMiscClosures.cmm - + testsuite/tests/exceptions/T26759.hs - + testsuite/tests/exceptions/T26759.stderr - + testsuite/tests/exceptions/T26759a.hs - + testsuite/tests/exceptions/T26759a.stderr - + testsuite/tests/exceptions/T26759a.stdout - testsuite/tests/exceptions/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -11,7 +11,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 4c3454a524436623df71b5faabd24e30b0f816d5 + DOCKER_REV: 5df428b97c501f61f57587048d4bd15eba53e364 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== configure.ac ===================================== @@ -542,9 +542,17 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) +dnl ** look to see if we have a C compiler using an llvm back end. +dnl +FP_CC_LLVM_BACKEND +AC_SUBST(CcLlvmBackend) + dnl ** Which LLVM assembler to use? dnl -------------------------------------------------------------- AC_ARG_VAR(LLVMAS,[Use as the path to LLVM's assembler (typically clang) [default=autodetect]]) +if test "x$CcLlvmBackend" = "xYES" && test -z "$LLVMAS"; then + LLVMAS="$CC" +fi FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion]) LlvmAsCmd="$LLVMAS" AC_SUBST([LlvmAsCmd]) @@ -622,11 +630,6 @@ else AC_SUBST([NeedLibatomic],[NO]) fi -dnl ** look to see if we have a C compiler using an llvm back end. -dnl -FP_CC_LLVM_BACKEND -AC_SUBST(CcLlvmBackend) - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== distrib/configure.ac.in ===================================== @@ -203,9 +203,17 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) +dnl ** look to see if we have a C compiler using an llvm back end. +dnl +FP_CC_LLVM_BACKEND +AC_SUBST(CcLlvmBackend) + dnl ** Which LLVM assembler to use? dnl -------------------------------------------------------------- AC_ARG_VAR(LLVMAS,[Use as the path to LLVM's assembler (typically clang) [default=autodetect]]) +if test "x$CcLlvmBackend" = "xYES" && test -z "$LLVMAS"; then + LLVMAS="$CC" +fi FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion]) LlvmAsCmd="$LLVMAS" AC_SUBST([LlvmAsCmd]) ===================================== hadrian/build-cabal ===================================== @@ -23,52 +23,9 @@ fi CABVERSTR=$("$CABAL" --numeric-version) CABVER=( ${CABVERSTR//./ } ) -THREADS="-j1" -GC_THREADS="" -SEMAPHORE="" - -echo "$@" - -# Try building hadrian in parallel. We check for -j<n>. -# If threads > 1 we pass --semaphore to allow ghc to build more than one module in parallel -# If threads > 4 we pass -qn as higher parallel gc thread counts can lead to slow downs -# We only do any of thise for cabal >= 3.14, because I don't trust older versions to handle --semaphore right -if [ "${CABVER[0]}" -gt 3 ] || [ "${CABVER[0]}" -eq 3 -a "${CABVER[1]}" -ge 14 ]; -then - - for arg in "$@"; do - case "$arg" in - -j) - GC_THREADS="-qn4" - SEMAPHORE="--semaphore" - THREADS="-j" - ;; - -j[0-9]*) - threads="${arg#-j}" - if [[ "$threads" =~ ^[0-9]+$ ]] && [ "$threads" -ne 0 ]; then - THREADS="-j${threads}" - if [ $threads -ge 4 ]; then - GC_THREADS="-qn4" - fi - if [ $threads -gt 1 ]; then - SEMAPHORE="--semaphore" - fi - fi - ;; - esac - - done - -fi - -if [ "$(uname -s)" = "FreeBSD" ]; then - # Can't rely on posix semaphore support in free bsd. - SEMAPHORE="" -fi - if [ "${CABVER[0]}" -gt 2 -o "${CABVER[0]}" -eq 2 -a "${CABVER[1]}" -ge 2 ]; then - "$CABAL" --project-file="$PROJ" new-build "${CABFLAGS[@]}" ${THREADS} ${SEMAPHORE} --ghc-options="+RTS ${GC_THREADS} -RTS" exe:hadrian + "$CABAL" --project-file="$PROJ" new-build "${CABFLAGS[@]}" -j exe:hadrian # use new-exec instead of new-run to make sure that the build-tools (alex & happy) are in PATH "$CABAL" --project-file="$PROJ" new-exec "${CABFLAGS[@]}" hadrian -- \ --directory "$PWD" \ ===================================== libraries/base/changelog.md ===================================== @@ -27,6 +27,7 @@ * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371)) + * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs ===================================== @@ -203,7 +203,7 @@ tryJust p a = catchJust p (Right `fmap` a) (return . Left) -- exception raised by the computation. onException :: IO a -> IO b -> IO a onException io what = io `catchNoPropagate` \e -> do - _ <- what + _ <- annotateIO (whileHandling e) what rethrowIO (e :: ExceptionWithContext SomeException) ----------------------------------------------------------------------------- ===================================== libraries/ghc-internal/src/GHC/Internal/IO.hs ===================================== @@ -52,7 +52,7 @@ module GHC.Internal.IO ( import GHC.Internal.Base import GHC.Internal.ST import GHC.Internal.Exception -import GHC.Internal.Exception.Type (NoBacktrace(..), WhileHandling(..), HasExceptionContext, ExceptionWithContext(..)) +import GHC.Internal.Exception.Type (NoBacktrace(..), whileHandling, WhileHandling(..), HasExceptionContext, ExceptionWithContext(..)) import GHC.Internal.Show import GHC.Internal.IO.Unsafe import GHC.Internal.Unsafe.Coerce ( unsafeCoerce ) @@ -363,7 +363,7 @@ getMaskingState = IO $ \s -> onException :: IO a -> IO b -> IO a onException io what = io `catchExceptionNoPropagate` \e -> do - _ <- what + _ <- annotateIO (whileHandling e) what rethrowIO (e :: ExceptionWithContext SomeException) -- | Executes an IO computation with asynchronous ===================================== rts/StgMiscClosures.cmm ===================================== @@ -47,6 +47,7 @@ import CLOSURE stg_ret_v_info; /* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, W_ info_ptr, + PROF_HDR_FIELDS(W_, p1, p2) W_ thunk_info_ptr) /* no args => explicit stack */ { ===================================== testsuite/tests/exceptions/T26759.hs ===================================== @@ -0,0 +1,10 @@ +import Control.Exception + +run :: IO () +run = failingAction `onException` failingCleanup + where + failingAction = throwIO (ErrorCall "outer failure") + failingCleanup = throwIO (ErrorCall "cleanup failure") + +main :: IO () +main = run ===================================== testsuite/tests/exceptions/T26759.stderr ===================================== @@ -0,0 +1,9 @@ +T26759: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +cleanup failure + +While handling outer failure + +HasCallStack backtrace: + throwIO, called at T26759.hs:7:22 in main:Main + ===================================== testsuite/tests/exceptions/T26759a.hs ===================================== @@ -0,0 +1,10 @@ +import Control.Exception + +run :: IO () +run = failingAction `onException` cleanup + where + failingAction = throwIO (ErrorCall "outer failure") + cleanup = putStrLn "cleanup" + +main :: IO () +main = run ===================================== testsuite/tests/exceptions/T26759a.stderr ===================================== @@ -0,0 +1,7 @@ +T26759a: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +outer failure + +HasCallStack backtrace: + throwIO, called at T26759a.hs:6:21 in main:Main + ===================================== testsuite/tests/exceptions/T26759a.stdout ===================================== @@ -0,0 +1 @@ +cleanup ===================================== testsuite/tests/exceptions/all.T ===================================== @@ -1,2 +1,3 @@ test('T25052', normal, compile_and_run, ['']) - +test('T26759', exit_code(1), compile_and_run, ['']) +test('T26759a', exit_code(1), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dedb4fec9b374c4f422f04d10b9395… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dedb4fec9b374c4f422f04d10b9395… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/abstract-q] 2 commits: wip: Abstract Q
by Teo Camarasu (＠teo) 14 Mar '26

14 Mar '26

Teo Camarasu pushed to branch wip/abstract-q at Glasgow Haskell Compiler / GHC Commits: 81baed9d by Teo Camarasu at 2026-03-14T01:09:55+00:00 wip: Abstract Q - - - - - 3fd2d50d by Teo Camarasu at 2026-03-14T01:09:55+00:00 wip - - - - - 4 changed files: - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghci/GHCi/TH.hs Changes: ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -29,7 +29,7 @@ module GHC.Data.IOEnv ( -- I/O operations IORef, newMutVar, readMutVar, writeMutVar, updMutVar, - atomicUpdMutVar, atomicUpdMutVar' + atomicUpdMutVar, atomicUpdMutVar', unliftIOEnv ) where import GHC.Prelude @@ -258,3 +258,10 @@ updEnv upd (IOEnv m) = IOEnv (\ env -> m (upd env)) updEnvIO :: (env -> IO env') -> IOEnv env' a -> IOEnv env a {-# INLINE updEnvIO #-} updEnvIO upd (IOEnv m) = IOEnv (\ env -> m =<< upd env) + +unliftIOEnv :: forall env b. ((forall a. IOEnv env a -> IO a) -> IO b) -> IOEnv env b +unliftIOEnv k = IOEnv $ \env -> + let + unlift :: forall a. IOEnv env a -> IO a + unlift (IOEnv m) = m env + in k unlift ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -138,6 +138,7 @@ import qualified GHC.LanguageExtensions as LangExt -- THSyntax gives access to internal functions and data types import qualified GHC.Boot.TH.Syntax as TH import qualified GHC.Boot.TH.Monad as TH +import GHC.Boot.TH.Monad (MetaHandlers(..)) import qualified GHC.Boot.TH.Ppr as TH #if defined(HAVE_INTERNAL_INTERPRETER) @@ -1139,7 +1140,7 @@ convertAnnotationWrapper fhv = do -} runQuasi :: TH.Q a -> TcM a -runQuasi act = TH.runQ act +runQuasi (TH.Q act) = unliftIOEnv $ \runInIO -> liftIO $ act runInIO metaHandlersTcM runRemoteModFinalizers :: ThModFinalizers -> TcM () runRemoteModFinalizers (ThModFinalizers finRefs) = do @@ -1466,68 +1467,12 @@ when showing an error message. To call runQ in the Tc monad, we need to make TcM an instance of Quasi: -} -instance TH.Quasi TcM where - qNewName s = do { u <- newUnique - ; let i = toInteger (getKey u) - ; return (TH.mkNameU s i) } - - -- 'msg' is forced to ensure exceptions don't escape, - -- see Note [Exceptions in TH] - qReport True msg = seqList msg $ addErr $ TcRnTHError $ ReportCustomQuasiError True msg - qReport False msg = seqList msg $ addDiagnostic $ TcRnTHError $ ReportCustomQuasiError False msg - - qLocation :: TcM TH.Loc - qLocation = do { m <- getModule - ; l <- getSrcSpanM - ; r <- case l of - UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location" - (ppr l) - RealSrcSpan s _ -> return s - ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r) - , TH.loc_module = moduleNameString (moduleName m) - , TH.loc_package = unitString (moduleUnit m) - , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r) - , TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) } - - qLookupName = lookupName - qReify = reify - qReifyFixity nm = lookupThName nm >>= reifyFixity - qReifyType = reifyTypeOfThing - qReifyInstances = reifyInstances - qReifyRoles = reifyRoles - qReifyAnnotations = reifyAnnotations - qReifyModule = reifyModule - qReifyConStrictness nm = do { nm' <- lookupThName nm - ; dc <- tcLookupDataCon nm' - ; let bangs = dataConImplBangs dc - ; return (map reifyDecidedStrictness bangs) } - - -- For qRecover, discard error messages if - -- the recovery action is chosen. Otherwise - -- we'll only fail higher up. - qRecover recover main = tryTcDiscardingErrs recover main - - qGetPackageRoot = do - dflags <- getDynFlags - return $ fromMaybe "." (workingDirectory dflags) - - qAddDependentFile fp = do - ref <- fmap tcg_dependent_files getGblEnv - dep_files <- readTcRef ref - writeTcRef ref (fp:dep_files) - - qAddDependentDirectory dp = do - ref <- fmap tcg_dependent_dirs getGblEnv - dep_dirs <- readTcRef ref - writeTcRef ref (dp:dep_dirs) - - qAddTempFile suffix = do - dflags <- getDynFlags - logger <- getLogger - tmpfs <- hsc_tmpfs <$> getTopEnv - liftIO $ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession suffix - - qAddTopDecls thds = do +report :: Bool -> [Char] -> TcM () +report True msg = seqList msg $ addErr $ TcRnTHError $ ReportCustomQuasiError True msg +report False msg = seqList msg $ addDiagnostic $ TcRnTHError $ ReportCustomQuasiError False msg + +addTopDecls :: [TH.Dec] -> TcM () +addTopDecls thds = do exts <- fmap extensionFlags getDynFlags l <- getSrcSpanM th_origin <- getThSpliceOrigin @@ -1555,52 +1500,13 @@ instance TH.Quasi TcM where bindName :: RdrName -> TcM () bindName (Exact n) = do { th_topnames_var <- fmap tcg_th_topnames getGblEnv - ; updTcRef th_topnames_var (\ns -> extendNameSet ns n) - } + ; updTcRef th_topnames_var (\ns -> extendNameSet ns n) + } bindName name = addErr $ TcRnTHError $ THNameError $ NonExactName name - qAddForeignFilePath lang fp = do - var <- fmap tcg_th_foreign_files getGblEnv - updTcRef var ((lang, fp) :) - - qAddModFinalizer fin = do - r <- liftIO $ mkRemoteRef fin - fref <- liftIO $ mkForeignRef r (freeRemoteRef r) - addModFinalizerRef fref - - qAddCorePlugin plugin = do - hsc_env <- getTopEnv - let fc = hsc_FC hsc_env - let home_unit = hsc_home_unit hsc_env - let dflags = hsc_dflags hsc_env - let fopts = initFinderOpts dflags - r <- liftIO $ findHomeModule fc fopts home_unit (mkModuleName plugin) - let err = TcRnTHError $ AddInvalidCorePlugin plugin - case r of - Found {} -> addErr err - FoundMultiple {} -> addErr err - _ -> return () - th_coreplugins_var <- tcg_th_coreplugins <$> getGblEnv - updTcRef th_coreplugins_var (plugin:) - - qGetQ :: forall a. Typeable a => TcM (Maybe a) - qGetQ = do - th_state_var <- fmap tcg_th_state getGblEnv - th_state <- readTcRef th_state_var - -- See #10596 for why we use a scoped type variable here. - return (Map.lookup (typeRep (Proxy :: Proxy a)) th_state >>= fromDynamic) - - qPutQ x = do - th_state_var <- fmap tcg_th_state getGblEnv - updTcRef th_state_var (\m -> Map.insert (typeOf x) (toDyn x) m) - - qIsExtEnabled = xoptM - - qExtsEnabled = - EnumSet.toList . extensionFlags . hsc_dflags <$> getTopEnv - - qPutDoc doc_loc s = do +putDoc :: TH.DocLoc -> String -> TcM () +putDoc doc_loc s = do th_doc_var <- tcg_th_docs <$> getGblEnv resolved_doc_loc <- resolve_loc doc_loc is_local <- checkLocalName resolved_doc_loc @@ -1622,15 +1528,129 @@ instance TH.Quasi TcM where checkLocalName (InstDoc n) = nameIsLocalOrFrom <$> getModule <*> pure n checkLocalName ModuleDoc = pure True - - qGetDoc (TH.DeclDoc n) = lookupThName n >>= lookupDeclDoc - qGetDoc (TH.InstDoc t) = lookupThInstName t >>= lookupDeclDoc - qGetDoc (TH.ArgDoc n i) = lookupThName n >>= lookupArgDoc i - qGetDoc TH.ModuleDoc = do +getDoc :: TH.DocLoc -> TcM (Maybe String) +getDoc (TH.DeclDoc n) = lookupThName n >>= lookupDeclDoc +getDoc (TH.InstDoc t) = lookupThInstName t >>= lookupDeclDoc +getDoc (TH.ArgDoc n i) = lookupThName n >>= lookupArgDoc i +getDoc TH.ModuleDoc = do df <- getDynFlags docs <- getGblEnv >>= extractDocs df return (renderHsDocString . hsDocString <$> (docs_mod_hdr =<< docs)) +getQ :: forall a. Typeable a => TcM (Maybe a) +getQ = do + th_state_var <- fmap tcg_th_state getGblEnv + th_state <- readTcRef th_state_var + -- See #10596 for why we use a scoped type variable here. + return (Map.lookup (typeRep (Proxy :: Proxy a)) th_state >>= fromDynamic) + +location :: TcM TH.Loc +location = do { m <- getModule + ; l <- getSrcSpanM + ; r <- case l of + UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location" + (ppr l) + RealSrcSpan s _ -> return s + ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r) + , TH.loc_module = moduleNameString (moduleName m) + , TH.loc_package = unitString (moduleUnit m) + , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r) + , TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) } + +metaHandlersTcM :: TH.MetaHandlers TcM +metaHandlersTcM = TH.MetaHandlers { + mNewName = \s -> do { u <- newUnique + ; let i = toInteger (getKey u) + ; return (TH.mkNameU s i) } + + -- 'msg' is forced to ensure exceptions don't escape, + -- see Note [Exceptions in TH] + , mReport = report + + , mLocation = location + + , mLookupName = lookupName + , mReify = reify + , mReifyFixity = \nm -> lookupThName nm >>= reifyFixity + , mReifyType = reifyTypeOfThing + , mReifyInstances = reifyInstances + , mReifyRoles = reifyRoles + , mReifyAnnotations = reifyAnnotations + , mReifyModule = reifyModule + , mReifyConStrictness = \nm -> do { nm' <- lookupThName nm + ; dc <- tcLookupDataCon nm' + ; let bangs = dataConImplBangs dc + ; return (map reifyDecidedStrictness bangs) } + + -- For qRecover, discard error messages if + -- the recovery action is chosen. Otherwise + -- we'll only fail higher up. + -- NB: extremely subtle!!! TODO: write up note + -- tryTcDiscardingErrs manipulates the reader env so we need to be careful we don't sneak in the outside env + , mRecover = \recover main -> tryTcDiscardingErrs (runQuasi recover) (runQuasi main) + + , mGetPackageRoot = do + dflags <- getDynFlags + return $ fromMaybe "." (workingDirectory dflags) + + , mAddDependentFile = \fp -> do + ref <- fmap tcg_dependent_files getGblEnv + dep_files <- readTcRef ref + writeTcRef ref (fp:dep_files) + + , mAddDependentDirectory = \dp -> do + ref <- fmap tcg_dependent_dirs getGblEnv + dep_dirs <- readTcRef ref + writeTcRef ref (dp:dep_dirs) + + , mAddTempFile = \suffix -> do + dflags <- getDynFlags + logger <- getLogger + tmpfs <- hsc_tmpfs <$> getTopEnv + liftIO $ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession suffix + + , mAddTopDecls = addTopDecls + + , mAddForeignFilePath = \lang fp -> do + var <- fmap tcg_th_foreign_files getGblEnv + updTcRef var ((lang, fp) :) + + , mAddModFinalizer = \fin -> do + r <- liftIO $ mkRemoteRef fin + fref <- liftIO $ mkForeignRef r (freeRemoteRef r) + addModFinalizerRef fref + + , mAddCorePlugin = \plugin -> do + hsc_env <- getTopEnv + let fc = hsc_FC hsc_env + let home_unit = hsc_home_unit hsc_env + let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags + r <- liftIO $ findHomeModule fc fopts home_unit (mkModuleName plugin) + let err = TcRnTHError $ AddInvalidCorePlugin plugin + case r of + Found {} -> addErr err + FoundMultiple {} -> addErr err + _ -> return () + th_coreplugins_var <- tcg_th_coreplugins <$> getGblEnv + updTcRef th_coreplugins_var (plugin:) + + , mGetQ = getQ + + , mPutQ = \x -> do + th_state_var <- fmap tcg_th_state getGblEnv + updTcRef th_state_var (\m -> Map.insert (typeOf x) (toDyn x) m) + + , mIsExtEnabled = xoptM + + , mExtsEnabled = + EnumSet.toList . extensionFlags . hsc_dflags <$> getTopEnv + + , mPutDoc = putDoc + + , mGetDoc = getDoc + } + -- | Looks up documentation for a declaration in first the current module, -- otherwise tries to find it in another module via 'hscGetModuleInterface'. lookupDeclDoc :: Name -> TcM (Maybe String) @@ -1795,7 +1815,7 @@ runTH ty fhv = do -- Remote GHCi, see Note [Remote Template Haskell] in -- libraries/ghci/GHCi/TH.hs. rstate <- getTHState inst - loc <- TH.qLocation + loc <- location -- run a remote TH request r <- liftIO $ withForeignRef rstate $ \state_hv -> @@ -1911,32 +1931,32 @@ wrapTHResult tcm = do handleTHMessage :: THMessage a -> TcM a handleTHMessage msg = case msg of - NewName a -> wrapTHResult $ TH.qNewName a - Report b str -> wrapTHResult $ TH.qReport b str - LookupName b str -> wrapTHResult $ TH.qLookupName b str - Reify n -> wrapTHResult $ TH.qReify n - ReifyFixity n -> wrapTHResult $ TH.qReifyFixity n - ReifyType n -> wrapTHResult $ TH.qReifyType n - ReifyInstances n ts -> wrapTHResult $ TH.qReifyInstances n ts - ReifyRoles n -> wrapTHResult $ TH.qReifyRoles n + NewName a -> wrapTHResult $ runQuasi $ TH.newName a + Report b str -> wrapTHResult $ runQuasi $ TH.report b str + LookupName b str -> wrapTHResult $ runQuasi $ TH.lookupName b str + Reify n -> wrapTHResult $ runQuasi $ TH.reify n + ReifyFixity n -> wrapTHResult $ runQuasi $ TH.reifyFixity n + ReifyType n -> wrapTHResult $ runQuasi $ TH.reifyType n + ReifyInstances n ts -> wrapTHResult $ runQuasi $ TH.reifyInstances n ts + ReifyRoles n -> wrapTHResult $ runQuasi $ TH.reifyRoles n ReifyAnnotations lookup tyrep -> wrapTHResult $ (map B.pack <$> getAnnotationsByTypeRep lookup tyrep) - ReifyModule m -> wrapTHResult $ TH.qReifyModule m - ReifyConStrictness nm -> wrapTHResult $ TH.qReifyConStrictness nm - GetPackageRoot -> wrapTHResult $ TH.qGetPackageRoot - AddDependentFile f -> wrapTHResult $ TH.qAddDependentFile f - AddDependentDirectory d -> wrapTHResult $ TH.qAddDependentDirectory d - AddTempFile s -> wrapTHResult $ TH.qAddTempFile s + ReifyModule m -> wrapTHResult $ runQuasi $ TH.reifyModule m + ReifyConStrictness nm -> wrapTHResult $ runQuasi $ TH.reifyConStrictness nm + GetPackageRoot -> wrapTHResult $ runQuasi $ TH.getPackageRoot + AddDependentFile f -> wrapTHResult $ runQuasi $ TH.addDependentFile f + AddDependentDirectory d -> wrapTHResult $ runQuasi $ TH.addDependentDirectory d + AddTempFile s -> wrapTHResult $ runQuasi $ TH.addTempFile s AddModFinalizer r -> do interp <- hscInterp <$> getTopEnv wrapTHResult $ liftIO (mkFinalizedHValue interp r) >>= addModFinalizerRef - AddCorePlugin str -> wrapTHResult $ TH.qAddCorePlugin str - AddTopDecls decs -> wrapTHResult $ TH.qAddTopDecls decs - AddForeignFilePath lang str -> wrapTHResult $ TH.qAddForeignFilePath lang str - IsExtEnabled ext -> wrapTHResult $ TH.qIsExtEnabled ext - ExtsEnabled -> wrapTHResult $ TH.qExtsEnabled - PutDoc l s -> wrapTHResult $ TH.qPutDoc l s - GetDoc l -> wrapTHResult $ TH.qGetDoc l + AddCorePlugin str -> wrapTHResult $ runQuasi $ TH.addCorePlugin str + AddTopDecls decs -> wrapTHResult $ runQuasi $ TH.addTopDecls decs + AddForeignFilePath lang str -> wrapTHResult $ runQuasi $ TH.addForeignFilePath lang str + IsExtEnabled ext -> wrapTHResult $ runQuasi $ TH.isExtEnabled ext + ExtsEnabled -> wrapTHResult $ runQuasi $ TH.extsEnabled + PutDoc l s -> wrapTHResult $ runQuasi $ TH.putDoc l s + GetDoc l -> wrapTHResult $ runQuasi $ TH.getDoc l FailIfErrs -> wrapTHResult failIfErrsM _ -> panic ("handleTHMessage: unexpected message " ++ show msg) ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Internal.TH.Syntax ----------------------------------------------------- class (MonadIO m, MonadFail m) => Quasi m where + qRunQ :: Q a -> m a -- | Fresh names. See 'newName'. qNewName :: String -> m Name @@ -149,6 +150,7 @@ class (MonadIO m, MonadFail m) => Quasi m where -- type environment, so reification isn't going to -- work. instance Quasi IO where + qRunQ (Q m) = m id metaHandlersIO qNewName = newNameIO qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) @@ -180,9 +182,124 @@ instance Quasi IO where qGetDoc _ = badIO "getDoc" qAddDependentDirectory _ = badIO "AddDependentDirectory" +metaHandlersIO :: MetaHandlers IO +metaHandlersIO = MetaHandlers { + mNewName = newNameIO + , mReport = \b msg -> + if b then + hPutStrLn stderr ("Template Haskell error: " ++ msg) + else + hPutStrLn stderr ("Template Haskell error: " ++ msg) -- TODO: should this be different from above? + , mLookupName = \ _ _ -> badIO "lookupName" + , mReify = \_ -> badIO "reify" + , mReifyFixity = \_ -> badIO "reifyFixity" + , mReifyType = \_ -> badIO "reifyFixity" + , mReifyInstances = \_ _ -> badIO "reifyInstances" + , mReifyRoles = \_ -> badIO "reifyRoles" + , mReifyAnnotations = \_ -> badIO "reifyAnnotations" + , mReifyModule = \_ -> badIO "reifyModule" + , mReifyConStrictness = \_ -> badIO "reifyConStrictness" + , mLocation = badIO "currentLocation" + , mRecover = \_ _ -> badIO "recover" -- Maybe we could fix this? + , mGetPackageRoot = badIO "getProjectRoot" + , mAddDependentFile = \_ -> badIO "addDependentFile" + , mAddTempFile = \_ -> badIO "addTempFile" + , mAddTopDecls = \_ -> badIO "addTopDecls" + , mAddForeignFilePath = \_ _ -> badIO "addForeignFilePath" + , mAddModFinalizer = \_ -> badIO "addModFinalizer" + , mAddCorePlugin = \_ -> badIO "addCorePlugin" + , mGetQ = badIO "getQ" + , mPutQ = \_ -> badIO "putQ" + , mIsExtEnabled = \_ -> badIO "isExtEnabled" + , mExtsEnabled = badIO "extsEnabled" + , mPutDoc = \_ _ -> badIO "putDoc" + , mGetDoc = \_ -> badIO "getDoc" + , mAddDependentDirectory = \_ -> badIO "AddDependentDirectory" + } + instance Quote IO where newName = newNameIO +data MetaHandlers m = MetaHandlers { + -- | Fresh names. See 'newName'. + mNewName :: String -> m Name + + ------- Error reporting and recovery ------- + -- | Report an error (True) or warning (False) + -- ...but carry on; use 'fail' to stop. See 'report'. + , mReport :: Bool -> String -> m () + + -- | See 'recover'. + , mRecover :: forall a. Q a -- ^ the error handler + -> Q a -- ^ action which may fail + -> m a -- ^ Recover from the monadic 'fail' + + ------- Inspect the type-checker's environment ------- + -- | True <=> type namespace, False <=> value namespace. See 'lookupName'. + , mLookupName :: Bool -> String -> m (Maybe Name) + -- | See 'reify'. + , mReify :: Name -> m Info + -- | See 'reifyFixity'. + , mReifyFixity :: Name -> m (Maybe Fixity) + -- | See 'reifyType'. + , mReifyType :: Name -> m Type + -- | Is (n tys) an instance? Returns list of matching instance Decs (with + -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'. + , mReifyInstances :: Name -> [Type] -> m [Dec] + -- | See 'reifyRoles'. + , mReifyRoles :: Name -> m [Role] + -- | See 'reifyAnnotations'. + , mReifyAnnotations :: forall a. Data a => AnnLookup -> m [a] + -- | See 'reifyModule'. + , mReifyModule :: Module -> m ModuleInfo + -- | See 'reifyConStrictness'. + , mReifyConStrictness :: Name -> m [DecidedStrictness] + + -- | See 'location'. + , mLocation :: m Loc + + -- | See 'getPackageRoot'. + , mGetPackageRoot :: m FilePath + + -- | See 'addDependentFile'. + , mAddDependentFile :: FilePath -> m () + + -- | See 'addDependentDirectory'. + , mAddDependentDirectory :: FilePath -> m () + + -- | See 'addTempFile'. + , mAddTempFile :: String -> m FilePath + + -- | See 'addTopDecls'. + , mAddTopDecls :: [Dec] -> m () + + -- | See 'addForeignFilePath'. + , mAddForeignFilePath :: ForeignSrcLang -> String -> m () + + -- | See 'addModFinalizer'. + , mAddModFinalizer :: Q () -> m () + + -- | See 'addCorePlugin'. + , mAddCorePlugin :: String -> m () + + -- | See 'getQ'. + , mGetQ :: forall a. Typeable a => m (Maybe a) + + -- | See 'putQ'. + , mPutQ :: forall a. Typeable a => a -> m () + + -- | See 'isExtEnabled'. + , mIsExtEnabled :: Extension -> m Bool + -- | See 'extsEnabled'. + , mExtsEnabled :: m [Extension] + + -- | See 'putDoc'. + , mPutDoc :: DocLoc -> String -> m () + -- | See 'getDoc'. + , mGetDoc :: DocLoc -> m (Maybe String) + } + + newNameIO :: String -> IO Name newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x)) ; pure (mkNameU s n) } @@ -213,7 +330,7 @@ counter = unsafePerformIO (newIORef 0) -- inversion](https://en.wikipedia.org/wiki/Dependency_inversion_principle), -- providing an abstract interface for the user which is later concretely -- fufilled by an concrete 'Quasi' instance, internal to GHC. -newtype Q a = Q { unQ :: forall m. Quasi m => m a } +newtype Q a = Q { unQ :: forall m. (forall x. m x -> IO x) -> MetaHandlers m -> IO a } -- | \"Runs\" the 'Q' monad. Normal users of Template Haskell -- should not need this function, as the splice brackets @$( ... )@ @@ -227,22 +344,22 @@ newtype Q a = Q { unQ :: forall m. Quasi m => m a } -- simply fail at runtime. Indeed, the only operations guaranteed to succeed -- are 'newName', 'runIO', 'reportError' and 'reportWarning'. runQ :: Quasi m => Q a -> m a -runQ (Q m) = m +runQ = qRunQ instance Monad Q where - Q m >>= k = Q (m >>= \x -> unQ (k x)) + Q m >>= k = Q $ \r h -> (m r h >>= \x -> unQ (k x) r h) (>>) = (*>) instance MonadFail Q where - fail s = report True s >> Q (fail "Q monad failure") + fail s = report True s >> Q (\_ _ -> fail "Q monad failure") instance Functor Q where - fmap f (Q x) = Q (fmap f x) + fmap f (Q x) = Q $ \r h -> fmap f (x r h) instance Applicative Q where - pure x = Q (pure x) - Q f <*> Q x = Q (f <*> x) - Q m *> Q n = Q (m *> n) + pure x = Q $ \_ _ -> pure x + Q f <*> Q x = Q $ \r h -> (f r h <*> x r h) + Q m *> Q n = Q $ \r h -> (m r h *> n r h) -- | @since 2.17.0.0 instance Semigroup a => Semigroup (Q a) where @@ -311,8 +428,17 @@ class Monad m => Quote m where -} newName :: String -> m Name +runHandler :: (forall m. MetaHandlers m -> m a) -> Q a +runHandler op = Q $ \r h -> r (op h) + +runHandler1 :: (forall m. MetaHandlers m -> a -> m b) -> a -> Q b +runHandler1 op = \x -> Q $ \r h -> r (op h x) + +runHandler2 :: (forall m. MetaHandlers m -> a -> b -> m c) -> a -> b -> Q c +runHandler2 op = \x y -> Q $ \r h -> r (op h x y) + instance Quote Q where - newName s = Q (qNewName s) + newName = runHandler1 mNewName ----------------------------------------------------- -- @@ -510,7 +636,7 @@ joinCode = flip bindCode id -- | Report an error (True) or warning (False), -- but carry on; use 'fail' to stop. report :: Bool -> String -> Q () -report b s = Q (qReport b s) +report b s = runHandler2 mReport b s {-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6 -- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'. @@ -525,20 +651,20 @@ reportWarning = report False recover :: Q a -- ^ handler to invoke on failure -> Q a -- ^ computation to run -> Q a -recover (Q r) (Q m) = Q (qRecover r m) +recover rec main = Q $ \r h -> r $ mRecover h rec main -- We don't export lookupName; the Bool isn't a great API -- Instead we export lookupTypeName, lookupValueName lookupName :: Bool -> String -> Q (Maybe Name) -lookupName ns s = Q (qLookupName ns s) +lookupName ns s = runHandler2 mLookupName ns s -- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details. lookupTypeName :: String -> Q (Maybe Name) -lookupTypeName s = Q (qLookupName True s) +lookupTypeName s = runHandler2 mLookupName True s -- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details. lookupValueName :: String -> Q (Maybe Name) -lookupValueName s = Q (qLookupName False s) +lookupValueName s = runHandler2 mLookupName False s {- Note [Name lookup] @@ -613,7 +739,7 @@ To ensure we get information about @D@-the-value, use 'lookupValueName': and to get information about @D@-the-type, use 'lookupTypeName'. -} reify :: Name -> Q Info -reify v = Q (qReify v) +reify v = runHandler1 mReify v {- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then @@ -622,7 +748,7 @@ example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then 'Nothing', so you may assume @bar@ has 'defaultFixity'. -} reifyFixity :: Name -> Q (Maybe Fixity) -reifyFixity nm = Q (qReifyFixity nm) +reifyFixity nm = runHandler1 mReifyFixity nm {- | @reifyType nm@ attempts to find the type or kind of @nm@. For example, @reifyType 'not@ returns @Bool -> Bool@, and @@ -630,7 +756,7 @@ reifyFixity nm = Q (qReifyFixity nm) This works even if there's no explicit signature and the type or kind is inferred. -} reifyType :: Name -> Q Type -reifyType nm = Q (qReifyType nm) +reifyType nm = runHandler1 mReifyType nm {- | Template Haskell is capable of reifying information about types and terms defined in previous declaration groups. Top-level declaration splices break up @@ -722,7 +848,7 @@ has some discussion around this. -} reifyInstances :: Name -> [Type] -> Q [InstanceDec] -reifyInstances cls tys = Q (qReifyInstances cls tys) +reifyInstances cls tys = runHandler2 mReifyInstances cls tys {- | @reifyRoles nm@ returns the list of roles associated with the parameters (both visible and invisible) of @@ -741,20 +867,20 @@ and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' i the role of the invisible @k@ parameter. Kind parameters are always nominal. -} reifyRoles :: Name -> Q [Role] -reifyRoles nm = Q (qReifyRoles nm) +reifyRoles nm = runHandler1 mReifyRoles nm -- | @reifyAnnotations target@ returns the list of annotations -- associated with @target@. Only the annotations that are -- appropriately typed is returned. So if you have @Int@ and @String@ -- annotations for the same target, you have to call this function twice. reifyAnnotations :: Data a => AnnLookup -> Q [a] -reifyAnnotations an = Q (qReifyAnnotations an) +reifyAnnotations an = runHandler1 mReifyAnnotations an -- | @reifyModule mod@ looks up information about module @mod@. To -- look up the current module, call this function with the return -- value of 'Language.Haskell.TH.Lib.thisModule'. reifyModule :: Module -> Q ModuleInfo -reifyModule m = Q (qReifyModule m) +reifyModule m = runHandler1 mReifyModule m -- | @reifyConStrictness nm@ looks up the strictness information for the fields -- of the constructor with the name @nm@. Note that the strictness information @@ -769,7 +895,7 @@ reifyModule m = Q (qReifyModule m) -- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the -- @-XStrictData@ language extension was enabled. reifyConStrictness :: Name -> Q [DecidedStrictness] -reifyConStrictness n = Q (qReifyConStrictness n) +reifyConStrictness n = runHandler1 mReifyConStrictness n -- | Is the list of instances returned by 'reifyInstances' nonempty? -- @@ -782,7 +908,7 @@ isInstance nm tys = do { decs <- reifyInstances nm tys -- | The location at which this computation is spliced. location :: Q Loc -location = Q qLocation +location = runHandler mLocation -- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad. -- Take care: you are guaranteed the ordering of calls to 'runIO' within @@ -792,7 +918,7 @@ location = Q qLocation -- necessarily flushed when the compiler finishes running, so you should -- flush them yourself. runIO :: IO a -> Q a -runIO m = Q (qRunIO m) +runIO m = Q $ \_ _ -> m -- | Get the package root for the current package which is being compiled. -- This can be set explicitly with the -package-root flag but is normally @@ -804,7 +930,7 @@ runIO m = Q (qRunIO m) -- change directory when compiling files but instead set the -package-root flag -- appropriately. getPackageRoot :: Q FilePath -getPackageRoot = Q qGetPackageRoot +getPackageRoot = runHandler mGetPackageRoot -- | Record external directories that runIO is using (dependent upon). -- The compiler can then recognize that it should re-compile the Haskell file @@ -823,7 +949,7 @@ getPackageRoot = Q qGetPackageRoot -- * The state of the directory is read at the interface generation time, -- not at the time of the function call. addDependentDirectory :: FilePath -> Q () -addDependentDirectory dp = Q (qAddDependentDirectory dp) +addDependentDirectory dp = runHandler1 mAddDependentDirectory dp -- | Record external files that runIO is using (dependent upon). -- The compiler can then recognize that it should re-compile the Haskell file @@ -837,17 +963,17 @@ addDependentDirectory dp = Q (qAddDependentDirectory dp) -- -- * The dependency is based on file content, not a modification time addDependentFile :: FilePath -> Q () -addDependentFile fp = Q (qAddDependentFile fp) +addDependentFile fp = runHandler1 mAddDependentFile fp -- | Obtain a temporary file path with the given suffix. The compiler will -- delete this file after compilation. addTempFile :: String -> Q FilePath -addTempFile suffix = Q (qAddTempFile suffix) +addTempFile suffix = runHandler1 mAddTempFile suffix -- | Add additional top-level declarations. The added declarations will be type -- checked along with the current declaration group. addTopDecls :: [Dec] -> Q () -addTopDecls ds = Q (qAddTopDecls ds) +addTopDecls ds = runHandler1 mAddTopDecls ds -- | Same as 'addForeignSource', but expects to receive a path pointing to the -- foreign file instead of a 'String' of its contents. Consider using this in @@ -856,7 +982,7 @@ addTopDecls ds = Q (qAddTopDecls ds) -- This is a good alternative to 'addForeignSource' when you are trying to -- directly link in an object file. addForeignFilePath :: ForeignSrcLang -> FilePath -> Q () -addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp) +addForeignFilePath lang fp = runHandler2 mAddForeignFilePath lang fp -- | Add a finalizer that will run in the Q monad after the current module has -- been type checked. This only makes sense when run within a top-level splice. @@ -865,7 +991,7 @@ addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp) -- 'reify' is able to find the local definitions when executed inside the -- finalizer. addModFinalizer :: Q () -> Q () -addModFinalizer act = Q (qAddModFinalizer (unQ act)) +addModFinalizer act = runHandler1 mAddModFinalizer act -- | Adds a core plugin to the compilation pipeline. -- @@ -875,7 +1001,7 @@ addModFinalizer act = Q (qAddModFinalizer (unQ act)) -- to tell the compiler that we needed to compile first a plugin module in the -- current package. addCorePlugin :: String -> Q () -addCorePlugin plugin = Q (qAddCorePlugin plugin) +addCorePlugin plugin = runHandler1 mAddCorePlugin plugin -- | Get state from the 'Q' monad. The state maintained by 'Q' is isomorphic to -- a type-indexed finite map. That is, @@ -889,20 +1015,20 @@ addCorePlugin plugin = Q (qAddCorePlugin plugin) -- Note that the state is local to the Haskell module in which the Template -- Haskell expression is executed. getQ :: Typeable a => Q (Maybe a) -getQ = Q qGetQ +getQ = runHandler mGetQ -- | Replace the state in the 'Q' monad. Note that the state is local to the -- Haskell module in which the Template Haskell expression is executed. putQ :: Typeable a => a -> Q () -putQ x = Q (qPutQ x) +putQ x = runHandler1 mPutQ x -- | Determine whether the given language extension is enabled in the 'Q' monad. isExtEnabled :: Extension -> Q Bool -isExtEnabled ext = Q (qIsExtEnabled ext) +isExtEnabled ext = runHandler1 mIsExtEnabled ext -- | List all enabled language extensions. extsEnabled :: Q [Extension] -extsEnabled = Q qExtsEnabled +extsEnabled = runHandler mExtsEnabled -- | Add Haddock documentation to the specified location. This will overwrite -- any documentation at the location if it already exists. This will reify the @@ -921,19 +1047,20 @@ extsEnabled = Q qExtsEnabled -- Adding documentation to anything outside of the current module will cause an -- error. putDoc :: DocLoc -> String -> Q () -putDoc t s = Q (qPutDoc t s) +putDoc t s = runHandler2 mPutDoc t s -- | Retrieves the Haddock documentation at the specified location, if one -- exists. -- It can be used to read documentation on things defined outside of the current -- module, provided that those modules were compiled with the @-haddock@ flag. getDoc :: DocLoc -> Q (Maybe String) -getDoc n = Q (qGetDoc n) +getDoc n = runHandler1 mGetDoc n instance MonadIO Q where liftIO = runIO instance Quasi Q where + qRunQ = id qNewName = newName qReport = report qRecover = recover ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -163,56 +163,67 @@ ghcCmd m = GHCiQ $ \s -> do instance MonadIO GHCiQ where liftIO m = GHCiQ $ \s -> fmap (,s) m -instance TH.Quasi GHCiQ where - qNewName str = ghcCmd (NewName str) - qReport isError msg = ghcCmd (Report isError msg) - - -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice - qRecover (GHCiQ h) a = GHCiQ $ \s -> mask $ \unmask -> do - remoteTHCall (qsPipe s) StartRecover - e <- try $ unmask $ runGHCiQ (a <* ghcCmd FailIfErrs) s - remoteTHCall (qsPipe s) (EndRecover (isLeft e)) - case e of - Left GHCiQException{} -> h s - Right r -> return r - qLookupName isType occ = ghcCmd (LookupName isType occ) - qReify name = ghcCmd (Reify name) - qReifyFixity name = ghcCmd (ReifyFixity name) - qReifyType name = ghcCmd (ReifyType name) - qReifyInstances name tys = ghcCmd (ReifyInstances name tys) - qReifyRoles name = ghcCmd (ReifyRoles name) - -- To reify annotations, we send GHC the AnnLookup and also the -- TypeRep of the thing we're looking for, to avoid needing to -- serialize irrelevant annotations. - qReifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a] - qReifyAnnotations lookup = +reifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a] +reifyAnnotations lookup = map (deserializeWithData . B.unpack) <$> ghcCmd (ReifyAnnotations lookup typerep) where typerep = typeOf (undefined :: a) - qReifyModule m = ghcCmd (ReifyModule m) - qReifyConStrictness name = ghcCmd (ReifyConStrictness name) - qLocation = fromMaybe noLoc . qsLocation <$> getState - qGetPackageRoot = ghcCmd GetPackageRoot - qAddDependentFile file = ghcCmd (AddDependentFile file) - qAddDependentDirectory dir = ghcCmd (AddDependentDirectory dir) - qAddTempFile suffix = ghcCmd (AddTempFile suffix) - qAddTopDecls decls = ghcCmd (AddTopDecls decls) - qAddForeignFilePath lang fp = ghcCmd (AddForeignFilePath lang fp) - qAddModFinalizer fin = GHCiQ (\s -> mkRemoteRef fin >>= return . (, s)) >>= +-- TODO: !!! +-- This is wrong because it will discard any updates to the state. +-- What I should do instead is refactor GHCiQ first (!) to use an IORef for state, and then save/restore that. +runQinGHCiQ :: TH.Q a -> GHCiQ a +runQinGHCiQ (TH.Q m) = GHCiQ $ \s -> (,s) <$> m (runInIO s) metaHandlersGHCiQ + where + runInIO :: QState -> GHCiQ a -> IO a + runInIO s (GHCiQ m) = fst <$> m s + +metaHandlersGHCiQ = TH.MetaHandlers { + mNewName = \str -> ghcCmd (NewName str) + , mReport = \isError msg -> ghcCmd (Report isError msg) + + -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice + , mRecover = \h a -> GHCiQ $ \s -> mask $ \unmask -> do + remoteTHCall (qsPipe s) StartRecover + e <- try $ unmask $ runGHCiQ (runQinGHCiQ a <* ghcCmd FailIfErrs) s -- TODO: simplify + remoteTHCall (qsPipe s) (EndRecover (isLeft e)) + case e of + Left GHCiQException{} -> runGHCiQ (runQinGHCiQ h) s -- TODO: simplify + Right r -> return r + , mLookupName = \isType occ -> ghcCmd (LookupName isType occ) + , mReify = \name -> ghcCmd (Reify name) + , mReifyFixity = \name -> ghcCmd (ReifyFixity name) + , mReifyType = \name -> ghcCmd (ReifyType name) + , mReifyInstances = \name tys -> ghcCmd (ReifyInstances name tys) + , mReifyRoles = \name -> ghcCmd (ReifyRoles name) + + , mReifyAnnotations = reifyAnnotations + , mReifyModule = \m -> ghcCmd (ReifyModule m) + , mReifyConStrictness = \name -> ghcCmd (ReifyConStrictness name) + , mLocation = fromMaybe noLoc . qsLocation <$> getState + , mGetPackageRoot = ghcCmd GetPackageRoot + , mAddDependentFile = \file -> ghcCmd (AddDependentFile file) + , mAddDependentDirectory = \dir -> ghcCmd (AddDependentDirectory dir) + , mAddTempFile = \suffix -> ghcCmd (AddTempFile suffix) + , mAddTopDecls = \decls -> ghcCmd (AddTopDecls decls) + , mAddForeignFilePath = \lang fp -> ghcCmd (AddForeignFilePath lang fp) + , mAddModFinalizer = \fin -> GHCiQ (\s -> mkRemoteRef fin >>= return . (, s)) >>= ghcCmd . AddModFinalizer - qAddCorePlugin str = ghcCmd (AddCorePlugin str) - qGetQ = GHCiQ $ \s -> + , mAddCorePlugin = \str -> ghcCmd (AddCorePlugin str) + , mGetQ = GHCiQ $ \s -> let lookup :: forall a. Typeable a => Map TypeRep Dynamic -> Maybe a lookup m = fromDynamic =<< M.lookup (typeOf (undefined::a)) m in return (lookup (qsMap s), s) - qPutQ k = GHCiQ $ \s -> + , mPutQ = \k -> GHCiQ $ \s -> return ((), s { qsMap = M.insert (typeOf k) (toDyn k) (qsMap s) }) - qIsExtEnabled x = ghcCmd (IsExtEnabled x) - qExtsEnabled = ghcCmd ExtsEnabled - qPutDoc l s = ghcCmd (PutDoc l s) - qGetDoc l = ghcCmd (GetDoc l) + , mIsExtEnabled = \x -> ghcCmd (IsExtEnabled x) + , mExtsEnabled = ghcCmd ExtsEnabled + , mPutDoc = \l s -> ghcCmd (PutDoc l s) + , mGetDoc = \l -> ghcCmd (GetDoc l) +} -- | The implementation of the 'StartTH' message: create -- a new IORef QState, and return a RemoteRef to it. @@ -231,7 +242,7 @@ runModFinalizerRefs pipe rstate qrefs = do qs <- mapM localRef qrefs qstateref <- localRef rstate qstate <- readIORef qstateref - _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate { qsPipe = pipe } + _ <- runGHCiQ (runQinGHCiQ $ sequence_ qs) qstate { qsPipe = pipe } return () -- | The implementation of the 'RunTH' message @@ -269,6 +280,6 @@ runTHQ pipe rstate mb_loc ghciq = do qstateref <- localRef rstate qstate <- readIORef qstateref let st = qstate { qsLocation = mb_loc, qsPipe = pipe } - (r,new_state) <- runGHCiQ (TH.runQ ghciq) st + (r,new_state) <- runGHCiQ (runQinGHCiQ ghciq) st writeIORef qstateref new_state return $! LB.toStrict (runPut (put r)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/857149f67c75bf2a4fd2b59f377526… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/857149f67c75bf2a4fd2b59f377526… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ani/tc-expand] wibbles
by Apoorv Ingle (＠ani) 14 Mar '26

14 Mar '26

Apoorv Ingle pushed to branch wip/ani/tc-expand at Glasgow Haskell Compiler / GHC Commits: 3b036900 by Apoorv Ingle at 2026-03-13T18:34:40-05:00 wibbles - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs-boot Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -14,7 +14,7 @@ module GHC.Tc.Gen.App , tcExprSigma , tcExprPrag ) where -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyLExprNC ) import GHC.Hs @@ -570,7 +570,7 @@ tcValArg do_ql _ _ (EWrap (EHsWrap w)) = do { whenQL do_ql $ qlMonoHsWrapper w tcValArg _ _ _ (EWrap ew) = return (EWrap ew) tcValArg do_ql pos (fun, fun_lspan) (EValArg { ea_loc_span = lspan - , ea_arg = larg@(L arg_loc arg) + , ea_arg = larg@(L arg_loc _) , ea_arg_ty = sc_arg_ty }) = addArgCtxt pos (fun, fun_lspan) larg $ do { -- Crucial step: expose QL results before checking exp_arg_ty @@ -596,11 +596,11 @@ tcValArg do_ql pos (fun, fun_lspan) (EValArg { ea_loc_span = lspan -- Now check the argument ; arg' <- tcScalingUsage mult $ - tcPolyExpr arg (mkCheckExpType exp_arg_ty) + tcPolyLExprNC larg (mkCheckExpType exp_arg_ty) ; traceTc "tcValArg" $ vcat [ ppr arg' , text "}" ] ; return (EValArg { ea_loc_span = lspan - , ea_arg = L arg_loc arg' + , ea_arg = arg' , ea_arg_ty = noExtField }) } tcValArg _ pos (fun, fun_lspan) (EValArgQL { ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -123,30 +123,11 @@ tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType tcPolyLExpr (L loc expr) res_ty = addLExprCtxt (locA loc) expr $ -- Note [Error contexts in generated code] - do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty - ; e <- - mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $ - case mb_ret_ty of - Nothing -> tcPolyExpr expanded_expr res_ty - Just ds_res_ty -> do expr' <- tcPolyExpr expanded_expr (Check ds_res_ty) - tcWrapResult expr expr' ds_res_ty res_ty - ; return (L loc' e) - } - where - mb_add_ctxt :: Maybe HsCtxt -> SrcSpan -> HsExpr GhcRn -> TcM a -> TcM a - mb_add_ctxt Nothing _ _ thing_inside - = thing_inside - mb_add_ctxt (Just ctxt) loc expanded_expr thing_inside - = addExpansionErrCtxt ctxt $ - addLExprCtxt loc expanded_expr $ - thing_inside - - mb_add_xexpr_wrap :: HsCtxt -> Bool -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc) - mb_add_xexpr_wrap hs_ctxt True thing_inside = mkExpandedTc hs_ctxt <$> setInGeneratedCode thing_inside - mb_add_xexpr_wrap _ False thing_inside = thing_inside + tcPolyLExprNC (L loc expr) res_ty tcPolyLExprNC (L loc expr) res_ty - = do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty + = setSrcSpanA loc $ + do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty ; e <- mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $ case mb_ret_ty of @@ -313,30 +294,11 @@ tcMonoLExpr, tcMonoLExprNC tcMonoLExpr (L loc expr) res_ty = addLExprCtxt (locA loc) expr $ -- Note [Error contexts in generated code] - do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty - ; e <- - mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $ - case mb_ret_ty of - Nothing -> tcExpr expanded_expr res_ty - Just ds_res_ty -> do expr' <- tcExpr expanded_expr (Check ds_res_ty) - tcWrapResultMono expr expr' ds_res_ty res_ty - ; return (L loc' e) - } - where - mb_add_ctxt :: Maybe HsCtxt -> SrcSpan -> HsExpr GhcRn -> TcM a -> TcM a - mb_add_ctxt Nothing _ _ thing_inside - = thing_inside - mb_add_ctxt (Just ctxt) loc expanded_expr thing_inside - = addExpansionErrCtxt ctxt $ - addLExprCtxt loc expanded_expr $ - thing_inside - - mb_add_xexpr_wrap :: HsCtxt -> Bool -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc) - mb_add_xexpr_wrap hs_ctxt True thing_inside = mkExpandedTc hs_ctxt <$> setInGeneratedCode thing_inside - mb_add_xexpr_wrap _ False thing_inside = thing_inside + tcMonoLExprNC (L loc expr) res_ty tcMonoLExprNC (L loc expr) res_ty - = do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty + = setSrcSpanA loc $ + do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty ; e <- mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $ case mb_ret_ty of ===================================== compiler/GHC/Tc/Gen/Expr.hs-boot ===================================== @@ -24,7 +24,7 @@ tcCheckMonoExpr, tcCheckMonoExprNC :: -> TcRhoType -> TcM (LHsExpr GhcTc) -tcPolyLExpr :: LHsExpr GhcRn -> ExpSigmaType -> TcM (LHsExpr GhcTc) +tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType -> TcM (LHsExpr GhcTc) tcPolyLExprSig :: LHsExpr GhcRn -> TcCompleteSig -> TcM (LHsExpr GhcTc) tcPolyExpr :: HsExpr GhcRn -> ExpSigmaType -> TcM (HsExpr GhcTc) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b036900b32dfa9aab96a2da22ac7ee… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b036900b32dfa9aab96a2da22ac7ee… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/ani/tc-expand
by Apoorv Ingle (＠ani) 14 Mar '26

14 Mar '26

Apoorv Ingle pushed new branch wip/ani/tc-expand at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ani/tc-expand You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23246] 52 commits: wasm: add /assets endpoint to serve user-specified assets
by Peter Trommler (＠trommler) 13 Mar '26

13 Mar '26

Peter Trommler pushed to branch wip/T23246 at Glasgow Haskell Compiler / GHC Commits: c951fef1 by Cheng Shao at 2026-02-25T20:58:28+00:00 wasm: add /assets endpoint to serve user-specified assets This patch adds an `/assets` endpoint to the wasm dyld http server, so that users can also fetch assets from the same host with sensible default MIME types, without needing a separate http server for assets that also introduces CORS headaches: - A `-fghci-browser-assets-dir` driver flag is added to specify the assets root directory (defaults to `$PWD`) - The dyld http server fetches `mime-db` on demand and uses it as source of truth for mime types. Closes #26951. - - - - - dde22f97 by Sylvain Henry at 2026-02-26T13:14:03-05:00 Fix -fcheck-prim-bounds for non constant args (#26958) Previously we were only checking bounds for constant (literal) arguments! I've refactored the code to simplify the generation of out-of-line Cmm code for the primop composed of some inline code + some call to an external Cmm function. - - - - - bd3eba86 by Vladislav Zavialov at 2026-02-27T05:48:01-05:00 Check for negative type literals in the type checker (#26861) GHC disallows negative type literals (e.g., -1), as tested by T8306 and T8412. This check is currently performed in the renamer: rnHsTyLit tyLit@(HsNumTy x i) = do when (i < 0) $ addErr $ TcRnNegativeNumTypeLiteral tyLit However, this check can be bypassed using RequiredTypeArguments (see the new test case T26861). Prior to this patch, such programs caused the compiler to hang instead of reporting a proper error. This patch addresses the issue by adding an equivalent check in the type checker, namely in tcHsType. The diff is deliberately minimal to facilitate backporting. A more comprehensive rework of HsTyLit is planned for a separate commit. - - - - - faf14e0c by Vladislav Zavialov at 2026-02-27T05:48:45-05:00 Consistent pretty-printing of HsString, HsIsString, HsStrTy Factor out a helper to pretty-print string literals, thus fixing newline handling for overloaded string literals and type literals. Test cases: T26860ppr T26860ppr_overloaded T26860ppr_tylit Follow up to ddf1434ff9bb08cfef3c93f23de6b83ec698aa27 - - - - - f108a972 by Arnaud Spiwack at 2026-02-27T12:53:01-05:00 Make list comprehension completely non-linear Fixes #25081 From the note: The usefulness of list comprehension in conjunction with linear types is dubious. After all, statements are made to be run many times, for instance in ```haskell [u | y <- [0,1], stmts] ``` both `u` and `stmts` are going to be run several times. In principle, though, there are some position in a monad comprehension expression which could be considered linear. We could try and make it so that these positions are considered linear by the typechecker, but in practice the desugarer doesn't take enough care to ensure that these are indeed desugared to linear sites. We tried in the past, and it turned out that we'd miss a desugaring corner case (#25772). Until there's a demand for this very specific improvement, let's instead be conservative, and consider list comprehension to be completely non-linear. - - - - - ae799cab by Simon Jakobi at 2026-02-27T12:53:54-05:00 PmAltConSet: Use Data.Set instead of Data.Map ...to store `PmLit`s. The Map was only used to map keys to themselves. Changing the Map to a Set saves a Word of memory per entry. Resolves #26756. - - - - - dcd7819c by Vladislav Zavialov at 2026-02-27T18:46:03-05:00 Drop HsTyLit in favor of HsLit (#26862, #25121) This patch is a small step towards unification of HsExpr and HsType, taking care of literals (HsLit) and type literals (HsTyLit). Additionally, it improves error messages for unsupported type literals, such as unboxed or fractional literals (test cases: T26862, T26862_th). Changes to the AST: * Use HsLit where HsTyLit was previously used * Use HsChar where HsCharTy was previously used * Use HsString where HsStrTy was previously used * Use HsNatural (NEW) where HsNumTy was previously used * Use HsDouble (NEW) to represent unsupported fractional type literals Changes to logic: * Parse unboxed and fractional type literals (to be rejected later) * Drop the check for negative literals in the renamer (rnHsTyLit) in favor of checking in the type checker (tc_hs_lit_ty) * Check for invalid type literals in TH (repTyLit) and report unrepresentable literals with ThUnsupportedTyLit * Allow negative type literals in TH (numTyLit). This is fine as these will be taken care of at splice time (test case: T8306_th) - - - - - c927954f by Vladislav Zavialov at 2026-02-27T18:46:50-05:00 Increase test coverage of diagnostics Add test cases for the previously untested diagnostics: [GHC-01239] PsErrIfInFunAppExpr [GHC-04807] PsErrProcInFunAppExpr [GHC-08195] PsErrInvalidRecordCon [GHC-16863] PsErrUnsupportedBoxedSumPat [GHC-18910] PsErrSemiColonsInCondCmd [GHC-24737] PsErrInvalidWhereBindInPatSynDecl [GHC-25037] PsErrCaseInFunAppExpr [GHC-25078] PsErrPrecedenceOutOfRange [GHC-28021] PsErrRecordSyntaxInPatSynDecl [GHC-35827] TcRnNonOverloadedSpecialisePragma [GHC-40845] PsErrUnpackDataCon [GHC-45106] PsErrInvalidInfixHole [GHC-50396] PsErrInvalidRuleActivationMarker [GHC-63930] MultiWayIfWithoutAlts [GHC-65536] PsErrNoSingleWhereBindInPatSynDecl [GHC-67630] PsErrMDoInFunAppExpr [GHC-70526] PsErrLetCmdInFunAppCmd [GHC-77808] PsErrDoCmdInFunAppCmd [GHC-86934] ClassPE [GHC-90355] PsErrLetInFunAppExpr [GHC-91745] CasesExprWithoutAlts [GHC-92971] PsErrCaseCmdInFunAppCmd [GHC-95644] PsErrBangPatWithoutSpace [GHC-97005] PsErrIfCmdInFunAppCmd Remove unused error constructors: [GHC-44524] PsErrExpectedHyphen [GHC-91382] TcRnIllegalKindSignature - - - - - 3a9470fd by Torsten Schmits at 2026-02-27T18:47:34-05:00 Avoid expensive computation for debug logging in `mergeDatabases` when log level is low This computed and traversed a set intersection for every single dependency unconditionally. - - - - - ea4c2cbd by Brandon Chinn at 2026-02-27T16:22:38-08:00 Implement QualifiedStrings (#26503) See Note [Implementation of QualifiedStrings] - - - - - 08bc245b by sheaf at 2026-03-01T11:11:54-05:00 Clean up join points, casts & ticks This commit shores up the logic dealing with casts and ticks occurring in between a join point binding and a jump. Fixes #26642 #26929 #26693 Makes progress on #14610 #26157 #26422 Changes: - Remove 'GHC.Types.Tickish.TickishScoping' in favour of simpler predicates 'tickishHasNoScope'/'tickishHasSoftScope', as things were before commit 993975d3. This makes the code easier to read and document (fewer indirections). - Introduce 'canCollectArgsThroughTick' for consistent handling of ticks around PrimOps and other 'Id's that cannot be eta-reduced. See overhauled Note [Ticks and mandatory eta expansion]. - New Note [JoinId vs TailCallInfo] in GHC.Core.SimpleOpt that explains robustness of JoinId vs fragility of TailCallInfo. - Allow casts/non-soft-scoped ticks to occur in between a join point binder and a jump, but only in Core Prep. See Note [Join points, casts, and ticks] and Note [Join points, casts, and ticks... in Core Prep] in GHC.Core.Opt.Simplify.Iteration. Also update Core Lint to account for this. See Note [Linting join points with casts or ticks] in GHC.Core.Lint. - Update 'GHC.Core.Utils.mergeCaseAlts' to avoid pushing a cast in between a join point binding and its jumps. This fixes #26642. See the new (MC5) and (MC6) in Note [Merge Nested Cases]. - Update float out to properly handle source note ticks. They are now properly floated out instead of being discarded. This increases the number of ticks in certain tests with -g. Test cases: T26642 and TrickyJoins. Metric increase due to more source note ticks with -g: ------------------------- Metric Increase: libdir size_hello_artifact size_hello_unicode ------------------------- - - - - - 476c4cdf by Sean D. Gillespie at 2026-03-02T10:14:37-05:00 Add SIMD absolute value on x86 and LLVM On x86, absolute value of 32 bits or less is implemented with PABSB/PABSW/PABSD if SSSE3 is available. Otherwise, there is a fallback for SSE2. For 64 bit integers it uses VPABSQ, required by AVX-512VL, with fallbacks for SSE4.2 and SSE2. There is no dedicated instruction for floating point absolute value on x86, so it is simulated using bitwise AND. Absolute value for signed integers and floats are implemented by the "llvm.abs/llvm.fabs" standard library intrinsics. This implementation uses MachOps constructors, unlike non-vector floating point absolute value, which uses CallishMachOps. - - - - - 709448c0 by Sean D. Gillespie at 2026-03-02T10:14:46-05:00 Add SIMD floating point square root On x86, this is implemented with the SQRTPS and SQRTPD instructions. On LLVM, it uses the sqrt library intrinstic. - - - - - 0deadf66 by Sean D. Gillespie at 2026-03-02T10:14:47-05:00 Improve error message for SIMD on aarch64 When encountering vector literals on aarch64, previously it would throw: <no location info>: error: panic! (the 'impossible' happened) GHC version 9.15.20251219: getRegister' (CmmLit:CmmVec): Now it is more consistent with the other vector operations: <no location info>: error: sorry! (unimplemented feature or known bug) GHC version 9.15.20251219: SIMD operations on AArch64 currently require the LLVM backend - - - - - 7d64031b by Vladislav Zavialov at 2026-03-03T11:09:28-05:00 Replace maybeAddSpace with spaceIfSingleQuote Simplify pretty-printing of HsTypes by using spaceIfSingleQuote. This allows us to drop the unwieldy lhsTypeHasLeadingPromotionQuote helper function. Follow-up to 178c1fd830c78377ef5d338406a41e1d8eb5f0da - - - - - 598db847 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00 Correct `hIsReadable` and `hIsWritable` for duplex handles This contribution implements CLC proposal #371. It changes `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. - - - - - b90201e5 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00 Document `SemiClosedHandle` - - - - - c9df72b5 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00 Tell users what “semi-closed” means for duplex handles - - - - - a8aa1868 by Ilias Tsitsimpis at 2026-03-06T06:26:29-05:00 Fix determinism of linker arguments The switch from Data.Map to UniqMap in 3b5be05ac29 introduced non-determinism in the order of packages passed to the linker. This resulted in non-reproducible builds where the DT_NEEDED entries in dynamic libraries were ordered differently across builds. Fix the regression by explicitly sorting the package list derived from UniqMap. Fixes #26838 - - - - - 9b64ad3a by Matthew Pickering at 2026-03-06T06:27:16-05:00 determinism: Use a deterministic renaming when writing bytecode files Now when writing the bytecode file, a counter and substitution are used to provide deterministic keys to local variables (rather than relying on uniques). This change ensures that `.gbc` are produced deterministically. Fixes #26499 - - - - - d29800e0 by Teo Camarasu at 2026-03-06T06:28:46-05:00 ghc-internal: delete Version hs-boot loop Version has a Read instance which needs Unicode but part of the Unicode interface is the unicode version. This is easy to resolve. We simply don't re-export the version from the Unicode module. Resolves #26940 - - - - - ad25af90 by Sylvain Henry at 2026-03-06T06:30:33-05:00 Linker: implement support for COMMON symbols (#6107) Add some support for COMMON symbols. We don't support common symbols having different sizes where the larger one is allocated after the smaller one. The linker will fail with an appropriate error message if it happens. - - - - - 3b59f158 by Cheng Shao at 2026-03-06T06:31:16-05:00 compiler: fix redundant import of GHC.Hs.Lit This patch removes a redundant import of `GHC.Hs.Lit` which causes a ghc build failure with validate flavours when bootstrapping from 9.14. Fixes #26972. - - - - - 148d36f3 by Cheng Shao at 2026-03-06T06:32:01-05:00 compiler: avoid unneeded traversals in GHC.Unit.State Following !15591, this patch avoids unneeded traversals in `reportCycles`/`reportUnusable` when log verbosity is below given threshold. Also applies `logVerbAtLeast` when appropriate. Co-authored-by: Codex <codex(a)openai.com> - - - - - 7e31367c by Cheng Shao at 2026-03-06T06:32:46-05:00 ghc-internal: fix redundant import in GHC.Internal.Event.Windows.ManagedThreadPool This patch fixes redundant import in `GHC.Internal.Event.Windows.ManagedThreadPool` that causes a compilation error when building windows target with validate flavours and bootstrapping from 9.14. Fixes #26976. - - - - - fc8b8e27 by sheaf at 2026-03-06T06:33:28-05:00 System.Info.fullCompilerVersion: add 'since' annot Fixes #26973 - - - - - c8238375 by Sylvain Henry at 2026-03-06T06:34:23-05:00 Hadrian: deprecate --bignum and automatically enable +native_bignum for JS Deprecate --bignum=... to select the bignum backend. It's only used to select the native backend, and this can be done with the +native_bignum flavour transformer. Additionally, we automatically enable +native_bignum for the JS target because the GMP backend isn't supported. - - - - - a3ac7074 by Sylvain Henry at 2026-03-06T06:35:17-05:00 JS: fix putEnum/fromEnum (#24593) Don't go through Word16 when serializing Enums. - - - - - 0b36e96c by Andreas Klebinger at 2026-03-06T06:35:58-05:00 Docs: Document -fworker-wrapper-cbv default setting. Fixes #26841 - - - - - eca445e7 by mangoiv at 2026-03-07T05:02:36-05:00 drop deb9/10 from CI, add deb13 debian 9 and 10 are end of life, hence we drop them from our CI, but we do add debian 13. Jobs that were previously run on 9 and 10 run on 13, too, jobs that were run on 10, are run on 11 now. Jobs that were previously run on debian 12 are run on debian 13 now. This MR also updates hadrian's bootstrap plans for that reason. Metric Decrease: T9872d - - - - - 12f8b829 by Luite Stegeman at 2026-03-07T05:03:33-05:00 Fix GHC.Internal.Prim haddock Haddock used to parse Haskell source to generate documentation, but switched to using interface files instead. This broke documentation of the GHC.Internal.Prim module, since it's a wired-in interface that didn't provide a document structure. This patch adds the missing document structure and updates genprimopcode to make the section headers and descriptions available. fixes #26954 - - - - - f87e5e57 by Luite Stegeman at 2026-03-07T05:03:33-05:00 Remove obsolete --make-haskell-source from genprimopcode Now that haddock uses the wired-in interface for GHC.Internal.Prim, the generated Haskell source file is no longer needed. Remove the --make-haskell-source code generator from genprimopcode and replace the generated GHC/Internal/Prim.hs with a minimal static source file. - - - - - 4a7ddc7b by Sylvain Henry at 2026-03-07T05:04:59-05:00 JS: fix linking of exposed but non-preload units (#24886) Units exposed in the unit database but not explicitly passed on the command-line were not considered by the JS linker. This isn't an issue for cabal which passes every unit explicitly but it is an issue when using GHC directly (cf T24886 test). - - - - - 689aafcd by mangoiv at 2026-03-07T05:05:52-05:00 testsuite: double foundation timeout multiplier The runtime timeout in the foundation test was regularly hit by code generated by the wasm backend - we increase the timout since the high runtime is expected on the wasm backend for this rather complex test. Resolves #26938 - - - - - d1a3686b by Peter Trommler at 2026-03-08T17:05:36+01:00 Fix conditional branch in atomicRMW ops - - - - - 496e2945 by Peter Trommler at 2026-03-08T17:05:36+01:00 Add ORC instruction - - - - - 0ebe8e2f by Peter Trommler at 2026-03-08T17:05:36+01:00 Draft of atomic RMW at smaller sizes - - - - - 60fd1585 by Peter Trommler at 2026-03-08T17:05:36+01:00 Fix W32 and W64 case, move to dst register - - - - - 39556ad0 by Peter Trommler at 2026-03-08T17:05:36+01:00 Fix masked_other - - - - - 3d1599f2 by Peter Trommler at 2026-03-08T17:05:36+01:00 Fix build_result - - - - - 4f647863 by Peter Trommler at 2026-03-08T17:05:36+01:00 testsuite: mark T9015 `req_interp` The test does not require the RTS linker (req_rts_linker), support for GHCi (req_interp) is sufficient. - - - - - 5e88e151 by Peter Trommler at 2026-03-08T17:05:36+01:00 Fix shift amount on big endian (sic!) - - - - - f184ef98 by Peter Trommler at 2026-03-08T17:05:36+01:00 Fix build result - - - - - 6c16604d by Peter Trommler at 2026-03-08T17:05:36+01:00 PPC NCG: print tab after clr(l|r)i instr - - - - - 285f04e4 by Peter Trommler at 2026-03-08T17:05:36+01:00 Refactor and implement small constants for W32/W64 - - - - - b29b790c by Peter Trommler at 2026-03-08T17:05:36+01:00 Optimize AMO_And - - - - - 683b9ae8 by Peter Trommler at 2026-03-08T17:05:36+01:00 Refactor mask inversion - - - - - f3aa8d10 by Peter Trommler at 2026-03-08T17:05:36+01:00 Optimize OR and XOR and more refactoring - - - - - 2ffc6e84 by Peter Trommler at 2026-03-08T17:05:36+01:00 Some more refactoring - - - - - 5f25f2d5 by Peter Trommler at 2026-03-08T17:05:36+01:00 Untangle atomic MOs - - - - - d02e9b4d by Peter Trommler at 2026-03-08T17:05:36+01:00 And yet more refactoring - - - - - 982ca8a0 by Peter Trommler at 2026-03-13T20:59:50+01:00 Refactor small sizes - - - - - 297 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - + compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Interpreter/Init.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/Runtime/Interpreter/Wasm.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Error.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - + docs/users_guide/exts/qualified_strings.rst - docs/users_guide/using-optimisation.rst - docs/users_guide/wasm.rst - hadrian/README.md - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_10_1.json - hadrian/bootstrap/plan-9_10_2.json - + hadrian/bootstrap/plan-9_10_3.json - hadrian/bootstrap/plan-bootstrap-9_10_1.json - hadrian/bootstrap/plan-bootstrap-9_10_2.json - + hadrian/bootstrap/plan-bootstrap-9_10_3.json - hadrian/src/CommandLine.hs - hadrian/src/Main.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/GenPrimopCode.hs - libraries/base/changelog.md - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/base/src/GHC/Unicode.hs - libraries/base/src/System/Info.hs - libraries/ghc-experimental/CHANGELOG.md - libraries/ghc-internal/ghc-internal.cabal.in - − libraries/ghc-internal/src/GHC/Internal/Data/Version.hs-boot - libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - + libraries/ghc-internal/src/GHC/Internal/Prim.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/Unicode.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs - libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/MachO.c - rts/linker/PEi386.c - testsuite/driver/perf_notes.py - testsuite/tests/codeGen/should_compile/debug.stdout - + testsuite/tests/codeGen/should_fail/T26958.hs - testsuite/tests/codeGen/should_fail/all.T - + testsuite/tests/dependent/should_fail/SelfDepCls.hs - + testsuite/tests/dependent/should_fail/SelfDepCls.stderr - testsuite/tests/dependent/should_fail/all.T - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/ghc-api/annotations-literals/parsed.hs - testsuite/tests/ghci/should_run/all.T - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/javascript/T24886.hs - + testsuite/tests/javascript/T24886.stderr - + testsuite/tests/javascript/T24886.stdout - testsuite/tests/javascript/all.T - − testsuite/tests/linear/should_compile/LinearListComprehension.hs - testsuite/tests/linear/should_compile/all.T - testsuite/tests/linear/should_fail/T25081.hs - testsuite/tests/linear/should_fail/T25081.stderr - testsuite/tests/module/all.T - + testsuite/tests/module/mod70b.hs - + testsuite/tests/module/mod70b.stderr - testsuite/tests/numeric/should_run/all.T - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/overloadedrecflds/should_run/all.T - + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.hs - + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.stderr - testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.hs - testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.stderr - + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.hs - + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.stderr - + testsuite/tests/parser/should_fail/T26860ppr_overloaded.hs - + testsuite/tests/parser/should_fail/T26860ppr_overloaded.stderr - + testsuite/tests/parser/should_fail/T26860ppr_tylit.hs - + testsuite/tests/parser/should_fail/T26860ppr_tylit.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_fail/badRuleMarker.hs - + testsuite/tests/parser/should_fail/badRuleMarker.stderr - + testsuite/tests/parser/should_fail/patFail010.hs - + testsuite/tests/parser/should_fail/patFail010.stderr - + testsuite/tests/parser/should_fail/patFail011.hs - + testsuite/tests/parser/should_fail/patFail011.stderr - + testsuite/tests/parser/should_fail/precOutOfRange.hs - + testsuite/tests/parser/should_fail/precOutOfRange.stderr - + testsuite/tests/parser/should_fail/unpack_data_con.hs - + testsuite/tests/parser/should_fail/unpack_data_con.stderr - testsuite/tests/patsyn/should_fail/T10426.stderr - testsuite/tests/patsyn/should_fail/all.T - + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.stderr - + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.stderr - + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.stderr - + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.stderr - testsuite/tests/pmcheck/should_compile/T11303.hs - + testsuite/tests/qualified-strings/Makefile - + testsuite/tests/qualified-strings/should_compile/Example/Length.hs - + testsuite/tests/qualified-strings/should_compile/all.T - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.hs - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.stderr - + testsuite/tests/qualified-strings/should_fail/Example/Length.hs - + testsuite/tests/qualified-strings/should_fail/Makefile - + testsuite/tests/qualified-strings/should_fail/all.T - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.stderr - + testsuite/tests/qualified-strings/should_run/Example/ByteStringAscii.hs - + testsuite/tests/qualified-strings/should_run/Example/ByteStringUtf8.hs - + testsuite/tests/qualified-strings/should_run/Example/Text.hs - + testsuite/tests/qualified-strings/should_run/Makefile - + testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_expr.hs - + testsuite/tests/qualified-strings/should_run/qstrings_expr.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_pat.hs - + testsuite/tests/qualified-strings/should_run/qstrings_pat.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_th.hs - + testsuite/tests/qualified-strings/should_run/qstrings_th.stdout - testsuite/tests/quasiquotation/qq005/test.T - testsuite/tests/quasiquotation/qq006/test.T - testsuite/tests/rts/linker/Makefile - + testsuite/tests/rts/linker/T6107.hs - + testsuite/tests/rts/linker/T6107.stdout - + testsuite/tests/rts/linker/T6107_sym1.s - + testsuite/tests/rts/linker/T6107_sym2.s - testsuite/tests/rts/linker/all.T - testsuite/tests/saks/should_compile/all.T - testsuite/tests/showIface/all.T - testsuite/tests/simd/should_run/doublex2_arith.hs - testsuite/tests/simd/should_run/doublex2_arith.stdout - testsuite/tests/simd/should_run/doublex2_arith_baseline.hs - testsuite/tests/simd/should_run/doublex2_arith_baseline.stdout - testsuite/tests/simd/should_run/floatx4_arith.hs - testsuite/tests/simd/should_run/floatx4_arith.stdout - testsuite/tests/simd/should_run/floatx4_arith_baseline.hs - testsuite/tests/simd/should_run/floatx4_arith_baseline.stdout - testsuite/tests/simd/should_run/int16x8_arith.hs - testsuite/tests/simd/should_run/int16x8_arith.stdout - testsuite/tests/simd/should_run/int16x8_arith_baseline.hs - testsuite/tests/simd/should_run/int16x8_arith_baseline.stdout - testsuite/tests/simd/should_run/int32x4_arith.hs - testsuite/tests/simd/should_run/int32x4_arith.stdout - testsuite/tests/simd/should_run/int32x4_arith_baseline.hs - testsuite/tests/simd/should_run/int32x4_arith_baseline.stdout - testsuite/tests/simd/should_run/int64x2_arith.hs - testsuite/tests/simd/should_run/int64x2_arith.stdout - testsuite/tests/simd/should_run/int64x2_arith_baseline.hs - testsuite/tests/simd/should_run/int64x2_arith_baseline.stdout - testsuite/tests/simd/should_run/int8x16_arith.hs - testsuite/tests/simd/should_run/int8x16_arith.stdout - testsuite/tests/simd/should_run/int8x16_arith_baseline.hs - testsuite/tests/simd/should_run/int8x16_arith_baseline.stdout - + testsuite/tests/simplCore/should_compile/T26642.hs - + testsuite/tests/simplCore/should_compile/TrickyJoins.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/th/T26862_th.script - + testsuite/tests/th/T26862_th.stderr - + testsuite/tests/th/T8306_th.script - + testsuite/tests/th/T8306_th.stderr - + testsuite/tests/th/T8306_th.stdout - testsuite/tests/th/T8412.stderr - + testsuite/tests/th/TH_EmptyLamCases.hs - + testsuite/tests/th/TH_EmptyLamCases.stderr - + testsuite/tests/th/TH_EmptyMultiIf.hs - + testsuite/tests/th/TH_EmptyMultiIf.stderr - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_fail/T26861.hs - + testsuite/tests/typecheck/should_fail/T26861.stderr - + testsuite/tests/typecheck/should_fail/T26862.hs - + testsuite/tests/typecheck/should_fail/T26862.stderr - testsuite/tests/typecheck/should_fail/T8306.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/unboxedsums/all.T - + testsuite/tests/unboxedsums/unboxedsums4p.hs - + testsuite/tests/unboxedsums/unboxedsums4p.stderr - testsuite/tests/vdq-rta/should_compile/all.T - + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.hs - + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.stderr - testsuite/tests/warnings/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/genprimopcode/Main.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - utils/jsffi/dyld.mjs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cca0826144f3a3b0dfc226610fc81… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cca0826144f3a3b0dfc226610fc81… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/text-read-uncovering] 6 commits: Move the `System.IO` implementation into `base`
by Wolfgang Jeltsch (＠jeltsch) 13 Mar '26

13 Mar '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC Commits: a662500a by Wolfgang Jeltsch at 2026-03-13T21:54:17+02:00 Move the `System.IO` implementation into `base` - - - - - aef95363 by Wolfgang Jeltsch at 2026-03-13T21:54:59+02:00 Move I/O-related `Read` instances into `base` - - - - - 9c4f1965 by Wolfgang Jeltsch at 2026-03-13T21:54:59+02:00 Move most of the `Numeric` implementation into `base` The `showHex` operation and the `showIntAtBase` operation, which underlies it, are kept in `GHC.Internal.Numeric`, because `showHex` is used in a few places in `ghc-internal`; everything else is moved. - - - - - da270ba5 by Wolfgang Jeltsch at 2026-03-13T21:54:59+02:00 Move the instance `Read ByteOrder` into `base` - - - - - 9d648f5a by Wolfgang Jeltsch at 2026-03-13T21:54:59+02:00 Move the implementation of version parsing into `base` - - - - - c72dc2f4 by Wolfgang Jeltsch at 2026-03-13T21:54:59+02:00 Move the implementation of `readConstr` into `base` - - - - - 32 changed files: - libraries/base/src/Data/Data.hs - libraries/base/src/Data/Version.hs - libraries/base/src/GHC/ByteOrder.hs - libraries/base/src/GHC/IO/Handle.hs - libraries/base/src/Numeric.hs - libraries/base/src/Prelude.hs - libraries/base/src/System/IO.hs - libraries/base/src/Text/Printf.hs - libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - libraries/ghc-internal/src/GHC/Internal/Data/Version.hs - libraries/ghc-internal/src/GHC/Internal/IO/Device.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs - libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs - libraries/ghc-internal/src/GHC/Internal/Numeric.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/typecheck/should_compile/T9497a.stderr - testsuite/tests/typecheck/should_compile/holes.stderr - testsuite/tests/typecheck/should_compile/holes3.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/T9497d.stderr - testsuite/tests/typecheck/should_run/T9497a-run.stderr - testsuite/tests/typecheck/should_run/T9497b-run.stderr - testsuite/tests/typecheck/should_run/T9497c-run.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96892ac7d618ed6dc2ecf0631b3f22… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96892ac7d618ed6dc2ecf0631b3f22… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fix-base-redundant-imports
by Cheng Shao (＠TerrorJack) 13 Mar '26

13 Mar '26

Cheng Shao pushed new branch wip/fix-base-redundant-imports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-base-redundant-imports You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/system-io-implementation-into-base] Move the `System.IO` implementation into `base`
by Wolfgang Jeltsch (＠jeltsch) 13 Mar '26

13 Mar '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-implementation-into-base at Glasgow Haskell Compiler / GHC Commits: a662500a by Wolfgang Jeltsch at 2026-03-13T21:54:17+02:00 Move the `System.IO` implementation into `base` - - - - - 21 changed files: - libraries/base/src/GHC/IO/Handle.hs - libraries/base/src/Prelude.hs - libraries/base/src/System/IO.hs - libraries/base/src/Text/Printf.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/plugins/plugins09.stdout - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/plugins11.stdout - testsuite/tests/plugins/static-plugins.stdout - testsuite/tests/typecheck/should_compile/T9497a.stderr - testsuite/tests/typecheck/should_compile/holes.stderr - testsuite/tests/typecheck/should_compile/holes3.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/T9497d.stderr - testsuite/tests/typecheck/should_run/T9497a-run.stderr - testsuite/tests/typecheck/should_run/T9497b-run.stderr - testsuite/tests/typecheck/should_run/T9497c-run.stderr Changes: ===================================== libraries/base/src/GHC/IO/Handle.hs ===================================== @@ -53,6 +53,7 @@ module GHC.IO.Handle hGetEcho, hIsTerminalDevice, hSetNewlineMode, + hGetNewlineMode, Newline(..), NewlineMode(..), nativeNewline, ===================================== libraries/base/src/Prelude.hs ===================================== @@ -165,7 +165,7 @@ module Prelude ( ) where import GHC.Internal.Control.Monad -import GHC.Internal.System.IO +import System.IO import GHC.Internal.System.IO.Error import qualified GHC.Internal.Data.List as List import GHC.Internal.Data.Either ===================================== libraries/base/src/System/IO.hs ===================================== @@ -1,4 +1,5 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP #-} -- | -- @@ -184,8 +185,666 @@ module System.IO nativeNewlineMode ) where -import GHC.Internal.System.IO +import GHC.Internal.System.IO (putStrLn, print) + +import GHC.Base (Bool (False, True), otherwise, failIO) +import GHC.Err (errorWithoutStackTrace) +import GHC.List (null, elem, last, (++), reverse, break) +import GHC.Num ((+)) +import GHC.IO (IO, FilePath) +import GHC.IO.IOMode (IOMode (ReadMode, WriteMode, ReadWriteMode, AppendMode)) +import qualified GHC.Internal.IO.FD as FD +import GHC.IO.Encoding + ( + TextEncoding, + mkTextEncoding, + getLocaleEncoding, + initLocaleEncoding, + utf8, + utf8_bom, + utf16, + utf16be, + utf16le, + utf32, + utf32be, + utf32le, + latin1, + char8 + ) +import GHC.IO.Handle + ( + Handle, + hLookAhead, + hFlush, + hClose, + hSetBinaryMode, + hSetEncoding, + hSetNewlineMode, + hSetEcho, + hSetFileSize, + hGetEncoding, + hGetNewlineMode, + hGetEcho, + hFileSize, + hIsOpen, + hIsReadable, + hIsSeekable, + hIsWritable, + hIsTerminalDevice, + hIsEOF, + hIsClosed, + hShow, + BufferMode (NoBuffering, LineBuffering, BlockBuffering), + hSetBuffering, + hGetBuffering, + HandlePosn, + hSetPosn, + hGetPosn, + SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd), + hSeek, + hTell, + Newline (LF, CRLF), + nativeNewline, + NewlineMode (NewlineMode, inputNL, outputNL), + noNewlineTranslation, + nativeNewlineMode, + universalNewlineMode, + isEOF + ) +import GHC.IO.Handle.Text + ( + hPutChar, + hPutStr, + hPutStrLn, + hPutBuf, + hPutBufNonBlocking, + hGetChar, + hGetContents, + hGetContents', + hGetLine, + hGetBuf, + hGetBufNonBlocking, + hGetBufSome, + hWaitForInput + ) +import qualified GHC.Internal.IO.Handle.FD as POSIX +import GHC.IO.StdHandles + ( + openBinaryFile, + withBinaryFile, + openFile, + withFile, + stdin, + stdout, + stderr + ) +import GHC.IORef (atomicModifyIORef'_) import GHC.Internal.Control.Monad.Fix (fixIO) +import Control.Monad (return, (>>=)) +import Control.Exception (ioError) +import Data.Eq ((==)) +import Data.Ord ((<)) +import Data.Bits ((.|.)) +import Data.Function (($), (.)) +import Data.Maybe (Maybe (Nothing, Just)) +import Data.Char (Char) +import Data.String (String) +import Data.Int (Int) +import Data.IORef (IORef, newIORef) +import System.IO.Error (userError) +import System.IO.Unsafe (unsafePerformIO) +import System.Posix.Internals + ( + c_getpid, + c_open, + o_CREAT, + o_EXCL, + o_BINARY, + o_NONBLOCK, + o_RDWR, + o_NOCTTY, + withFilePath + ) +import System.Posix.Types (CMode) +import Text.Read (lex, Read, reads) +import Text.Show (Show, show) +import Foreign.C.Types (CInt) +import Foreign.C.Error (Errno, eEXIST, getErrno, errnoToIOError) + +#if defined(mingw32_HOST_OS) +import GHC.IO.SubSystem +import GHC.IO.Windows.Handle (openFileAsTemp) +import GHC.IO.Handle.Windows (mkHandleFromHANDLE) +import GHC.IO.Device as IODevice +import GHC.Internal.Real (fromIntegral) +import Foreign.C.String +import Foreign.Ptr +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils (with) +import Foreign.Storable +#endif + +----------------------------------------------------------------------------- +-- Standard IO + +-- | Write a character to the standard output device +-- +-- 'putChar' is implemented as @'hPutChar' 'stdout'@. +-- +-- This operation may fail with the same errors as 'hPutChar'. +-- +-- ==== __Examples__ +-- +-- Note that the following do not put a newline. +-- +-- >>> putChar 'x' +-- x +-- +-- >>> putChar '\0042' +-- * +putChar :: Char -> IO () +putChar c = hPutChar stdout c + +-- | Write a string to the standard output device +-- +-- 'putStr' is implemented as @'hPutStr' 'stdout'@. +-- +-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'! +-- +-- ==== __Examples__ +-- +-- Note that the following do not put a newline. +-- +-- >>> putStr "Hello, World!" +-- Hello, World! +-- +-- >>> putStr "\0052\0042\0050" +-- 4*2 +-- +putStr :: String -> IO () +putStr s = hPutStr stdout s + +-- | Read a single character from the standard input device. +-- +-- 'getChar' is implemented as @'hGetChar' 'stdin'@. +-- +-- This operation may fail with the same errors as 'hGetChar'. +-- +-- ==== __Examples__ +-- +-- >>> getChar +-- a'a' +-- +-- >>> getChar +-- > +-- '\n' +getChar :: IO Char +getChar = hGetChar stdin + +-- | Read a line from the standard input device. +-- +-- 'getLine' is implemented as @'hGetLine' 'stdin'@. +-- +-- This operation may fail with the same errors as 'hGetLine'. +-- +-- ==== __Examples__ +-- +-- >>> getLine +-- > Hello World! +-- "Hello World!" +-- +-- >>> getLine +-- > +-- "" +getLine :: IO String +getLine = hGetLine stdin + +-- | The 'getContents' operation returns all user input as a single string, +-- which is read lazily as it is needed. +-- +-- 'getContents' is implemented as @'hGetContents' 'stdin'@. +-- +-- This operation may fail with the same errors as 'hGetContents'. +-- +-- ==== __Examples__ +-- +-- >>> getContents >>= putStr +-- > aaabbbccc :D +-- aaabbbccc :D +-- > I hope you have a great day +-- I hope you have a great day +-- > ^D +-- +-- >>> getContents >>= print . length +-- > abc +-- > <3 +-- > def ^D +-- 11 +getContents :: IO String +getContents = hGetContents stdin + +-- | The 'getContents'' operation returns all user input as a single string, +-- which is fully read before being returned +-- +-- 'getContents'' is implemented as @'hGetContents'' 'stdin'@. +-- +-- This operation may fail with the same errors as 'hGetContents''. +-- +-- ==== __Examples__ +-- +-- >>> getContents' >>= putStr +-- > aaabbbccc :D +-- > I hope you have a great day +-- aaabbbccc :D +-- I hope you have a great day +-- +-- >>> getContents' >>= print . length +-- > abc +-- > <3 +-- > def ^D +-- 11 +-- +-- @since base-4.15.0.0 +getContents' :: IO String +getContents' = hGetContents' stdin + +-- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it. +-- The resulting string is written to the 'stdout' device. +-- +-- Note that this operation is lazy, which allows to produce output +-- even before all input has been consumed. +-- +-- This operation may fail with the same errors as 'getContents' and 'putStr'. +-- +-- If it doesn't produce output the buffering settings may not be +-- correct, use ^D (ctrl+D) to close stdin which forces +-- the buffer to be consumed. +-- +-- You may wish to set the buffering style appropriate to your program's +-- needs before using this function, for example: +-- +-- @ +-- main :: IO () +-- main = do +-- hSetBuffering stdin LineBuffering +-- hSetBuffering stdout NoBuffering +-- interact (concatMap (\str -> str ++ str) . L.lines) +-- @ +-- +-- ==== __Examples__ +-- +-- >>> interact (\str -> str ++ str) +-- > hi :) +-- hi :) +-- > ^D +-- hi :) +-- +-- >>> interact (const ":D") +-- :D +-- +-- >>> interact (show . words) +-- > hello world! +-- > I hope you have a great day +-- > ^D +-- ["hello","world!","I","hope","you","have","a","great","day"] +interact :: (String -> String) -> IO () +interact f = do s <- getContents + putStr (f s) + +-- | The 'readFile' function reads a file and +-- returns the contents of the file as a string. +-- +-- The file is read lazily, on demand, as with 'getContents'. +-- +-- This operation may fail with the same errors as 'hGetContents' and 'openFile'. +-- +-- ==== __Examples__ +-- +-- >>> readFile "~/hello_world" +-- "Greetings!" +-- +-- >>> take 5 <$> readFile "/dev/zero" +-- "\NUL\NUL\NUL\NUL\NUL" +readFile :: FilePath -> IO String +readFile name = openFile name ReadMode >>= hGetContents + +-- | The 'readFile'' function reads a file and +-- returns the contents of the file as a string. +-- +-- This is identical to 'readFile', but the file is fully read before being returned, +-- as with 'getContents''. +-- +-- @since base-4.15.0.0 +readFile' :: FilePath -> IO String +-- There's a bit of overkill here—both withFile and +-- hGetContents' will close the file in the end. +readFile' name = withFile name ReadMode hGetContents' + +-- | The computation @'writeFile' file str@ function writes the string @str@, +-- to the file @file@. +-- +-- This operation may fail with the same errors as 'hPutStr' and 'withFile'. +-- +-- ==== __Examples__ +-- +-- >>> writeFile "hello" "world" >> readFile "hello" +-- "world" +-- +-- >>> writeFile "~/" "D:" +-- *** Exception: ~/: withFile: inappropriate type (Is a directory) +writeFile :: FilePath -> String -> IO () +writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt) + +-- | The computation @'appendFile' file str@ function appends the string @str@, +-- to the file @file@. +-- +-- Note that 'writeFile' and 'appendFile' write a literal string +-- to a file. To write a value of any printable type, as with 'print', +-- use the 'show' function to convert the value to a string first. +-- +-- This operation may fail with the same errors as 'hPutStr' and 'withFile'. +-- +-- ==== __Examples__ +-- +-- The following example could be more efficently written by acquiring a handle +-- instead with 'openFile' and using the computations capable of writing to handles +-- such as 'hPutStr'. +-- +-- >>> let fn = "hello_world" +-- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn) +-- "hello world!" +-- +-- >>> let fn = "foo"; output = readFile' fn >>= putStrLn +-- >>> in output >> appendFile fn (show [1,2,3]) >> output +-- this is what's in the file +-- this is what's in the file[1,2,3] +appendFile :: FilePath -> String -> IO () +appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt) + +-- | The 'readLn' function combines 'getLine' and 'readIO'. +-- +-- This operation may fail with the same errors as 'getLine' and 'readIO'. +-- +-- ==== __Examples__ +-- +-- >>> fmap (+ 5) readLn +-- > 25 +-- 30 +-- +-- >>> readLn :: IO String +-- > this is not a string literal +-- *** Exception: user error (Prelude.readIO: no parse) +readLn :: Read a => IO a +readLn = getLine >>= readIO + +-- | The 'readIO' function is similar to 'read' except that it signals +-- parse failure to the 'IO' monad instead of terminating the program. +-- +-- This operation may fail with: +-- +-- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse. +-- +-- ==== __Examples__ +-- +-- >>> fmap (+ 1) (readIO "1") +-- 2 +-- +-- >>> readIO "not quite ()" :: IO () +-- *** Exception: user error (Prelude.readIO: no parse) +readIO :: Read a => String -> IO a +readIO s = case (do { (x,t) <- reads s ; + ("","") <- lex t ; + return x }) of + [x] -> return x + [] -> ioError (userError "Prelude.readIO: no parse") + _ -> ioError (userError "Prelude.readIO: ambiguous parse") + +-- | The encoding of the current locale. +-- +-- This is the initial locale encoding: if it has been subsequently changed by +-- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change. +localeEncoding :: TextEncoding +localeEncoding = initLocaleEncoding + +-- | Computation 'hReady' @hdl@ indicates whether at least one item is +-- available for input from handle @hdl@. +-- +-- This operation may fail with: +-- +-- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached. +hReady :: Handle -> IO Bool +hReady h = hWaitForInput h 0 + +-- | Computation 'hPrint' @hdl t@ writes the string representation of @t@ +-- given by the 'show' function to the file or channel managed by @hdl@ +-- and appends a newline. +-- +-- This operation may fail with the same errors as 'hPutStrLn' +-- +-- ==== __Examples__ +-- +-- >>> hPrint stdout [1,2,3] +-- [1,2,3] +-- +-- >>> hPrint stdin [4,5,6] +-- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing) +hPrint :: Show a => Handle -> a -> IO () +hPrint hdl = hPutStrLn hdl . show + +-- | The function creates a temporary file in ReadWrite mode. +-- The created file isn\'t deleted automatically, so you need to delete it manually. +-- +-- The file is created with permissions such that only the current +-- user can read\/write it. +-- +-- With some exceptions (see below), the file will be created securely +-- in the sense that an attacker should not be able to cause +-- openTempFile to overwrite another file on the filesystem using your +-- credentials, by putting symbolic links (on Unix) in the place where +-- the temporary file is to be created. On Unix the @O_CREAT@ and +-- @O_EXCL@ flags are used to prevent this attack, but note that +-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you +-- rely on this behaviour it is best to use local filesystems only. +openTempFile :: FilePath -- ^ Directory in which to create the file + -> String -- ^ File name template. If the template is \"foo.ext\" then + -- the created file will be \"fooXXX.ext\" where XXX is some + -- random number. Note that this should not contain any path + -- separator characters. On Windows, the template prefix may + -- be truncated to 3 chars, e.g. \"foobar.ext\" will be + -- \"fooXXX.ext\". + -> IO (FilePath, Handle) +openTempFile tmp_dir template + = openTempFile' "openTempFile" tmp_dir template False 0o600 + +-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments. +openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle) +openBinaryTempFile tmp_dir template + = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600 + +-- | Like 'openTempFile', but uses the default file permissions +openTempFileWithDefaultPermissions :: FilePath -> String + -> IO (FilePath, Handle) +openTempFileWithDefaultPermissions tmp_dir template + = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666 + +-- | Like 'openBinaryTempFile', but uses the default file permissions +openBinaryTempFileWithDefaultPermissions :: FilePath -> String + -> IO (FilePath, Handle) +openBinaryTempFileWithDefaultPermissions tmp_dir template + = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666 + +openTempFile' :: String -> FilePath -> String -> Bool -> CMode + -> IO (FilePath, Handle) +openTempFile' loc tmp_dir template binary mode + | pathSeparator template + = failIO $ "openTempFile': Template string must not contain path separator characters: "++template + | otherwise = findTempName + where + -- We split off the last extension, so we can use .foo.ext files + -- for temporary files (hidden on Unix OSes). Unfortunately we're + -- below filepath in the hierarchy here. + (prefix, suffix) = + case break (== '.') $ reverse template of + -- First case: template contains no '.'s. Just re-reverse it. + (rev_suffix, "") -> (reverse rev_suffix, "") + -- Second case: template contains at least one '.'. Strip the + -- dot from the prefix and prepend it to the suffix (if we don't + -- do this, the unique number will get added after the '.' and + -- thus be part of the extension, which is wrong.) + (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix) + -- Otherwise, something is wrong, because (break (== '.')) should + -- always return a pair with either the empty string or a string + -- beginning with '.' as the second component. + _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile" +#if defined(mingw32_HOST_OS) + findTempName = findTempNamePosix <!> findTempNameWinIO + + findTempNameWinIO = do + let label = if null prefix then "ghc" else prefix + withCWString tmp_dir $ \c_tmp_dir -> + withCWString label $ \c_template -> + withCWString suffix $ \c_suffix -> + with nullPtr $ \c_ptr -> do + res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr + if not res + then do errno <- getErrno + ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) + else do c_p <- peek c_ptr + filename <- peekCWString c_p + free c_p + let flags = fromIntegral mode .&. o_EXCL + handleResultsWinIO filename (flags == o_EXCL) + + findTempNamePosix = do + let label = if null prefix then "ghc" else prefix + withCWString tmp_dir $ \c_tmp_dir -> + withCWString label $ \c_template -> + withCWString suffix $ \c_suffix -> + allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do + res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0 + c_str + if not res + then do errno <- getErrno + ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) + else do filename <- peekCWString c_str + handleResultsPosix filename + + handleResultsPosix filename = do + let oflags1 = rw_flags .|. o_EXCL + binary_flags + | binary = o_BINARY + | otherwise = 0 + oflags = oflags1 .|. binary_flags + fd <- withFilePath filename $ \ f -> c_open f oflags mode + case fd < 0 of + True -> do errno <- getErrno + ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) + False -> + do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-} + False{-is_socket-} + True{-is_nonblock-} + + enc <- getLocaleEncoding + h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode + False{-set non-block-} (Just enc) + + return (filename, h) + + handleResultsWinIO filename excl = do + (hwnd, hwnd_type) <- openFileAsTemp filename True excl + mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding + + -- then use it to make a Handle + h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec + `onException` IODevice.close hwnd + return (filename, h) + +foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo + :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool + +foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo + :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool + +pathSeparator :: String -> Bool +pathSeparator template = any (\x-> x == '/' || x == '\\') template + +output_flags = std_flags +#else /* else mingw32_HOST_OS */ + findTempName = do + rs <- rand_string + let filename = prefix ++ rs ++ suffix + filepath = tmp_dir `combine` filename + r <- openNewFile filepath binary mode + case r of + FileExists -> findTempName + OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) + NewFileCreated fd -> do + (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-} + False{-is_socket-} + True{-is_nonblock-} + + enc <- getLocaleEncoding + h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc) + + return (filepath, h) + + 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 + +tempCounter :: IORef Int +tempCounter = unsafePerformIO $ newIORef 0 +{-# NOINLINE tempCounter #-} + +-- build large digit-alike number +rand_string :: IO String +rand_string = do + r1 <- c_getpid + (r2, _) <- atomicModifyIORef'_ tempCounter (+1) + return $ show r1 ++ "-" ++ show r2 + +data OpenNewFileResult + = NewFileCreated CInt + | FileExists + | OpenNewError Errno + +openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult +openNewFile filepath binary mode = do + let oflags1 = rw_flags .|. o_EXCL + + binary_flags + | binary = o_BINARY + | otherwise = 0 + + oflags = oflags1 .|. binary_flags + fd <- withFilePath filepath $ \ f -> + c_open f oflags mode + if fd < 0 + then do + errno <- getErrno + case errno of + _ | errno == eEXIST -> return FileExists + _ -> return (OpenNewError errno) + else return (NewFileCreated fd) + +-- XXX Should use filepath library +pathSeparatorChar :: Char +pathSeparatorChar = '/' + +pathSeparator :: String -> Bool +pathSeparator template = pathSeparatorChar `elem` template + +output_flags = std_flags .|. o_CREAT +#endif /* mingw32_HOST_OS */ + +-- XXX Copied from GHC.Handle +std_flags, output_flags, rw_flags :: CInt +std_flags = o_NONBLOCK .|. o_NOCTTY +rw_flags = output_flags .|. o_RDWR -- $locking -- Implementations should enforce as far as possible, at least locally to the ===================================== libraries/base/src/Text/Printf.hs ===================================== @@ -99,7 +99,7 @@ import GHC.Internal.Data.List (stripPrefix) import GHC.Internal.Word import GHC.Internal.Numeric import GHC.Internal.Numeric.Natural -import GHC.Internal.System.IO +import System.IO -- $setup -- >>> import Prelude ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -1,6 +1,4 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-} -{-# OPTIONS_GHC -Wno-x-partial #-} ----------------------------------------------------------------------------- -- | @@ -16,286 +14,13 @@ -- ----------------------------------------------------------------------------- -module GHC.Internal.System.IO ( - -- * The IO monad +module GHC.Internal.System.IO (putStrLn, print) where - IO, - - -- * Files and handles - - FilePath, - - Handle, -- abstract, instance of: Eq, Show. - - -- | GHC note: a 'Handle' will be automatically closed when the garbage - -- collector detects that it has become unreferenced by the program. - -- However, relying on this behaviour is not generally recommended: - -- the garbage collector is unpredictable. If possible, use - -- an explicit 'hClose' to close 'Handle's when they are no longer - -- required. GHC does not currently attempt to free up file - -- descriptors when they have run out, it is your responsibility to - -- ensure that this doesn't happen. - - -- ** Standard handles - - -- | Three handles are allocated during program initialisation, - -- and are initially open. - - stdin, stdout, stderr, - - -- * Opening and closing files - - -- ** Opening files - - withFile, - openFile, - IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), - - -- ** Closing files - - hClose, - - -- ** Special cases - - -- | These functions are also exported by the "Prelude". - - readFile, - readFile', - writeFile, - appendFile, - - -- * Operations on handles - - -- ** Determining and changing the size of a file - - hFileSize, - hSetFileSize, - - -- ** Detecting the end of input - - hIsEOF, - isEOF, - - -- ** Buffering operations - - BufferMode(NoBuffering,LineBuffering,BlockBuffering), - hSetBuffering, - hGetBuffering, - hFlush, - - -- ** Repositioning handles - - hGetPosn, - hSetPosn, - HandlePosn, -- abstract, instance of: Eq, Show. - - hSeek, - SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd), - hTell, - - -- ** Handle properties - - hIsOpen, hIsClosed, - hIsReadable, hIsWritable, - hIsSeekable, - - -- ** Terminal operations (not portable: GHC only) - - hIsTerminalDevice, - - hSetEcho, - hGetEcho, - - -- ** Showing handle state (not portable: GHC only) - - hShow, - - -- * Text input and output - - -- ** Text input - - hWaitForInput, - hReady, - hGetChar, - hGetLine, - hLookAhead, - hGetContents, - hGetContents', - - -- ** Text output - - hPutChar, - hPutStr, - hPutStrLn, - hPrint, - - -- ** Special cases for standard input and output - - -- | These functions are also exported by the "Prelude". - - interact, - putChar, - putStr, - putStrLn, - print, - getChar, - getLine, - getContents, - getContents', - readIO, - readLn, - - -- * Binary input and output - - withBinaryFile, - openBinaryFile, - hSetBinaryMode, - hPutBuf, - hGetBuf, - hGetBufSome, - hPutBufNonBlocking, - hGetBufNonBlocking, - - -- * Temporary files - - openTempFile, - openBinaryTempFile, - openTempFileWithDefaultPermissions, - openBinaryTempFileWithDefaultPermissions, - - -- * Unicode encoding\/decoding - - -- | A text-mode 'Handle' has an associated 'TextEncoding', which - -- is used to decode bytes into Unicode characters when reading, - -- and encode Unicode characters into bytes when writing. - -- - -- The default 'TextEncoding' is the same as the default encoding - -- on your system, which is also available as 'localeEncoding'. - -- (GHC note: on Windows, we currently do not support double-byte - -- encodings; if the console\'s code page is unsupported, then - -- 'localeEncoding' will be 'latin1'.) - -- - -- Encoding and decoding errors are always detected and reported, - -- except during lazy I/O ('hGetContents', 'getContents', and - -- 'readFile'), where a decoding error merely results in - -- termination of the character stream, as with other I/O errors. - - hSetEncoding, - hGetEncoding, - - -- ** Unicode encodings - TextEncoding, - latin1, - utf8, utf8_bom, - utf16, utf16le, utf16be, - utf32, utf32le, utf32be, - localeEncoding, - char8, - mkTextEncoding, - - -- * Newline conversion - - -- | In Haskell, a newline is always represented by the character - -- @\'\\n\'@. However, in files and external character streams, a - -- newline may be represented by another character sequence, such - -- as @\'\\r\\n\'@. - -- - -- A text-mode 'Handle' has an associated 'NewlineMode' that - -- specifies how to translate newline characters. The - -- 'NewlineMode' specifies the input and output translation - -- separately, so that for instance you can translate @\'\\r\\n\'@ - -- to @\'\\n\'@ on input, but leave newlines as @\'\\n\'@ on output. - -- - -- The default 'NewlineMode' for a 'Handle' is - -- 'nativeNewlineMode', which does no translation on Unix systems, - -- but translates @\'\\r\\n\'@ to @\'\\n\'@ and back on Windows. - -- - -- Binary-mode 'Handle's do no newline translation at all. - -- - hSetNewlineMode, - hGetNewlineMode, - Newline(..), nativeNewline, - NewlineMode(..), - noNewlineTranslation, universalNewlineMode, nativeNewlineMode, - ) where - -import GHC.Internal.Control.Exception.Base - -import GHC.Internal.Data.Bits -import GHC.Internal.Data.Maybe -import GHC.Internal.Foreign.C.Error -#if defined(mingw32_HOST_OS) -import GHC.Internal.Foreign.C.String -import GHC.Internal.Foreign.Ptr -import GHC.Internal.Foreign.Marshal.Alloc -import GHC.Internal.Foreign.Marshal.Utils (with) -import GHC.Internal.Foreign.Storable -import GHC.Internal.IO.SubSystem -import GHC.Internal.IO.Windows.Handle (openFileAsTemp) -import GHC.Internal.IO.Handle.Windows (mkHandleFromHANDLE) -import GHC.Internal.IO.Device as IODevice -import GHC.Internal.Real (fromIntegral) -#endif -import GHC.Internal.Foreign.C.Types -import GHC.Internal.System.Posix.Internals -import GHC.Internal.System.Posix.Types - -import GHC.Internal.Base -import GHC.Internal.List -#if !defined(mingw32_HOST_OS) -import GHC.Internal.IORef -#endif -import GHC.Internal.Num -import GHC.Internal.IO hiding ( bracket, onException ) -import GHC.Internal.IO.IOMode -import qualified GHC.Internal.IO.FD as FD -import GHC.Internal.IO.Handle -import qualified GHC.Internal.IO.Handle.FD as POSIX -import GHC.Internal.IO.Handle.Text ( hGetBufSome, hPutStrLn ) -import GHC.Internal.IO.Exception ( userError ) -import GHC.Internal.IO.Encoding -import GHC.Internal.Text.Read -import GHC.Internal.IO.StdHandles -import GHC.Internal.Show ------------------------------------------------------------------------------ --- Standard IO - --- | Write a character to the standard output device --- --- 'putChar' is implemented as @'hPutChar' 'stdout'@. --- --- This operation may fail with the same errors as 'hPutChar'. --- --- ==== __Examples__ --- --- Note that the following do not put a newline. --- --- >>> putChar 'x' --- x --- --- >>> putChar '\0042' --- * -putChar :: Char -> IO () -putChar c = hPutChar stdout c - --- | Write a string to the standard output device --- --- 'putStr' is implemented as @'hPutStr' 'stdout'@. --- --- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'! --- --- ==== __Examples__ --- --- Note that the following do not put a newline. --- --- >>> putStr "Hello, World!" --- Hello, World! --- --- >>> putStr "\0052\0042\0050" --- 4*2 --- -putStr :: String -> IO () -putStr s = hPutStr stdout s +import GHC.Internal.Base (String) +import GHC.Internal.IO (IO) +import GHC.Internal.IO.Handle.Text (hPutStrLn) +import GHC.Internal.IO.StdHandles (stdout) +import GHC.Internal.Show (Show, show) -- | The same as 'putStr', but adds a newline character. -- @@ -332,485 +57,3 @@ putStrLn s = hPutStrLn stdout s -- [(0,1),(1,2),(2,4),(3,8),(4,16),(5,32),(6,64),(7,128),(8,256)] print :: Show a => a -> IO () print x = putStrLn (show x) - --- | Read a single character from the standard input device. --- --- 'getChar' is implemented as @'hGetChar' 'stdin'@. --- --- This operation may fail with the same errors as 'hGetChar'. --- --- ==== __Examples__ --- --- >>> getChar --- a'a' --- --- >>> getChar --- > --- '\n' -getChar :: IO Char -getChar = hGetChar stdin - --- | Read a line from the standard input device. --- --- 'getLine' is implemented as @'hGetLine' 'stdin'@. --- --- This operation may fail with the same errors as 'hGetLine'. --- --- ==== __Examples__ --- --- >>> getLine --- > Hello World! --- "Hello World!" --- --- >>> getLine --- > --- "" -getLine :: IO String -getLine = hGetLine stdin - --- | The 'getContents' operation returns all user input as a single string, --- which is read lazily as it is needed. --- --- 'getContents' is implemented as @'hGetContents' 'stdin'@. --- --- This operation may fail with the same errors as 'hGetContents'. --- --- ==== __Examples__ --- --- >>> getContents >>= putStr --- > aaabbbccc :D --- aaabbbccc :D --- > I hope you have a great day --- I hope you have a great day --- > ^D --- --- >>> getContents >>= print . length --- > abc --- > <3 --- > def ^D --- 11 -getContents :: IO String -getContents = hGetContents stdin - --- | The 'getContents'' operation returns all user input as a single string, --- which is fully read before being returned --- --- 'getContents'' is implemented as @'hGetContents'' 'stdin'@. --- --- This operation may fail with the same errors as 'hGetContents''. --- --- ==== __Examples__ --- --- >>> getContents' >>= putStr --- > aaabbbccc :D --- > I hope you have a great day --- aaabbbccc :D --- I hope you have a great day --- --- >>> getContents' >>= print . length --- > abc --- > <3 --- > def ^D --- 11 --- --- @since base-4.15.0.0 -getContents' :: IO String -getContents' = hGetContents' stdin - --- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it. --- The resulting string is written to the 'stdout' device. --- --- Note that this operation is lazy, which allows to produce output --- even before all input has been consumed. --- --- This operation may fail with the same errors as 'getContents' and 'putStr'. --- --- If it doesn't produce output the buffering settings may not be --- correct, use ^D (ctrl+D) to close stdin which forces --- the buffer to be consumed. --- --- You may wish to set the buffering style appropriate to your program's --- needs before using this function, for example: --- --- @ --- main :: IO () --- main = do --- hSetBuffering stdin LineBuffering --- hSetBuffering stdout NoBuffering --- interact (concatMap (\str -> str ++ str) . L.lines) --- @ --- --- ==== __Examples__ --- --- >>> interact (\str -> str ++ str) --- > hi :) --- hi :) --- > ^D --- hi :) --- --- >>> interact (const ":D") --- :D --- --- >>> interact (show . words) --- > hello world! --- > I hope you have a great day --- > ^D --- ["hello","world!","I","hope","you","have","a","great","day"] -interact :: (String -> String) -> IO () -interact f = do s <- getContents - putStr (f s) - --- | The 'readFile' function reads a file and --- returns the contents of the file as a string. --- --- The file is read lazily, on demand, as with 'getContents'. --- --- This operation may fail with the same errors as 'hGetContents' and 'openFile'. --- --- ==== __Examples__ --- --- >>> readFile "~/hello_world" --- "Greetings!" --- --- >>> take 5 <$> readFile "/dev/zero" --- "\NUL\NUL\NUL\NUL\NUL" -readFile :: FilePath -> IO String -readFile name = openFile name ReadMode >>= hGetContents - --- | The 'readFile'' function reads a file and --- returns the contents of the file as a string. --- --- This is identical to 'readFile', but the file is fully read before being returned, --- as with 'getContents''. --- --- @since base-4.15.0.0 -readFile' :: FilePath -> IO String --- There's a bit of overkill here—both withFile and --- hGetContents' will close the file in the end. -readFile' name = withFile name ReadMode hGetContents' - --- | The computation @'writeFile' file str@ function writes the string @str@, --- to the file @file@. --- --- This operation may fail with the same errors as 'hPutStr' and 'withFile'. --- --- ==== __Examples__ --- --- >>> writeFile "hello" "world" >> readFile "hello" --- "world" --- --- >>> writeFile "~/" "D:" --- *** Exception: ~/: withFile: inappropriate type (Is a directory) -writeFile :: FilePath -> String -> IO () -writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt) - --- | The computation @'appendFile' file str@ function appends the string @str@, --- to the file @file@. --- --- Note that 'writeFile' and 'appendFile' write a literal string --- to a file. To write a value of any printable type, as with 'print', --- use the 'show' function to convert the value to a string first. --- --- This operation may fail with the same errors as 'hPutStr' and 'withFile'. --- --- ==== __Examples__ --- --- The following example could be more efficently written by acquiring a handle --- instead with 'openFile' and using the computations capable of writing to handles --- such as 'hPutStr'. --- --- >>> let fn = "hello_world" --- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn) --- "hello world!" --- --- >>> let fn = "foo"; output = readFile' fn >>= putStrLn --- >>> in output >> appendFile fn (show [1,2,3]) >> output --- this is what's in the file --- this is what's in the file[1,2,3] -appendFile :: FilePath -> String -> IO () -appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt) - --- | The 'readLn' function combines 'getLine' and 'readIO'. --- --- This operation may fail with the same errors as 'getLine' and 'readIO'. --- --- ==== __Examples__ --- --- >>> fmap (+ 5) readLn --- > 25 --- 30 --- --- >>> readLn :: IO String --- > this is not a string literal --- *** Exception: user error (Prelude.readIO: no parse) -readLn :: Read a => IO a -readLn = getLine >>= readIO - --- | The 'readIO' function is similar to 'read' except that it signals --- parse failure to the 'IO' monad instead of terminating the program. --- --- This operation may fail with: --- --- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse. --- --- ==== __Examples__ --- --- >>> fmap (+ 1) (readIO "1") --- 2 --- --- >>> readIO "not quite ()" :: IO () --- *** Exception: user error (Prelude.readIO: no parse) -readIO :: Read a => String -> IO a -readIO s = case (do { (x,t) <- reads s ; - ("","") <- lex t ; - return x }) of - [x] -> return x - [] -> ioError (userError "Prelude.readIO: no parse") - _ -> ioError (userError "Prelude.readIO: ambiguous parse") - --- | The encoding of the current locale. --- --- This is the initial locale encoding: if it has been subsequently changed by --- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change. -localeEncoding :: TextEncoding -localeEncoding = initLocaleEncoding - --- | Computation 'hReady' @hdl@ indicates whether at least one item is --- available for input from handle @hdl@. --- --- This operation may fail with: --- --- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached. -hReady :: Handle -> IO Bool -hReady h = hWaitForInput h 0 - --- | Computation 'hPrint' @hdl t@ writes the string representation of @t@ --- given by the 'show' function to the file or channel managed by @hdl@ --- and appends a newline. --- --- This operation may fail with the same errors as 'hPutStrLn' --- --- ==== __Examples__ --- --- >>> hPrint stdout [1,2,3] --- [1,2,3] --- --- >>> hPrint stdin [4,5,6] --- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing) -hPrint :: Show a => Handle -> a -> IO () -hPrint hdl = hPutStrLn hdl . show - --- | The function creates a temporary file in ReadWrite mode. --- The created file isn\'t deleted automatically, so you need to delete it manually. --- --- The file is created with permissions such that only the current --- user can read\/write it. --- --- With some exceptions (see below), the file will be created securely --- in the sense that an attacker should not be able to cause --- openTempFile to overwrite another file on the filesystem using your --- credentials, by putting symbolic links (on Unix) in the place where --- the temporary file is to be created. On Unix the @O_CREAT@ and --- @O_EXCL@ flags are used to prevent this attack, but note that --- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you --- rely on this behaviour it is best to use local filesystems only. -openTempFile :: FilePath -- ^ Directory in which to create the file - -> String -- ^ File name template. If the template is \"foo.ext\" then - -- the created file will be \"fooXXX.ext\" where XXX is some - -- random number. Note that this should not contain any path - -- separator characters. On Windows, the template prefix may - -- be truncated to 3 chars, e.g. \"foobar.ext\" will be - -- \"fooXXX.ext\". - -> IO (FilePath, Handle) -openTempFile tmp_dir template - = openTempFile' "openTempFile" tmp_dir template False 0o600 - --- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments. -openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle) -openBinaryTempFile tmp_dir template - = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600 - --- | Like 'openTempFile', but uses the default file permissions -openTempFileWithDefaultPermissions :: FilePath -> String - -> IO (FilePath, Handle) -openTempFileWithDefaultPermissions tmp_dir template - = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666 - --- | Like 'openBinaryTempFile', but uses the default file permissions -openBinaryTempFileWithDefaultPermissions :: FilePath -> String - -> IO (FilePath, Handle) -openBinaryTempFileWithDefaultPermissions tmp_dir template - = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666 - -openTempFile' :: String -> FilePath -> String -> Bool -> CMode - -> IO (FilePath, Handle) -openTempFile' loc tmp_dir template binary mode - | pathSeparator template - = failIO $ "openTempFile': Template string must not contain path separator characters: "++template - | otherwise = findTempName - where - -- We split off the last extension, so we can use .foo.ext files - -- for temporary files (hidden on Unix OSes). Unfortunately we're - -- below filepath in the hierarchy here. - (prefix, suffix) = - case break (== '.') $ reverse template of - -- First case: template contains no '.'s. Just re-reverse it. - (rev_suffix, "") -> (reverse rev_suffix, "") - -- Second case: template contains at least one '.'. Strip the - -- dot from the prefix and prepend it to the suffix (if we don't - -- do this, the unique number will get added after the '.' and - -- thus be part of the extension, which is wrong.) - (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix) - -- Otherwise, something is wrong, because (break (== '.')) should - -- always return a pair with either the empty string or a string - -- beginning with '.' as the second component. - _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile" -#if defined(mingw32_HOST_OS) - findTempName = findTempNamePosix <!> findTempNameWinIO - - findTempNameWinIO = do - let label = if null prefix then "ghc" else prefix - withCWString tmp_dir $ \c_tmp_dir -> - withCWString label $ \c_template -> - withCWString suffix $ \c_suffix -> - with nullPtr $ \c_ptr -> do - res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr - if not res - then do errno <- getErrno - ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) - else do c_p <- peek c_ptr - filename <- peekCWString c_p - free c_p - let flags = fromIntegral mode .&. o_EXCL - handleResultsWinIO filename (flags == o_EXCL) - - findTempNamePosix = do - let label = if null prefix then "ghc" else prefix - withCWString tmp_dir $ \c_tmp_dir -> - withCWString label $ \c_template -> - withCWString suffix $ \c_suffix -> - allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do - res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0 - c_str - if not res - then do errno <- getErrno - ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) - else do filename <- peekCWString c_str - handleResultsPosix filename - - handleResultsPosix filename = do - let oflags1 = rw_flags .|. o_EXCL - binary_flags - | binary = o_BINARY - | otherwise = 0 - oflags = oflags1 .|. binary_flags - fd <- withFilePath filename $ \ f -> c_open f oflags mode - case fd < 0 of - True -> do errno <- getErrno - ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) - False -> - do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-} - False{-is_socket-} - True{-is_nonblock-} - - enc <- getLocaleEncoding - h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode - False{-set non-block-} (Just enc) - - return (filename, h) - - handleResultsWinIO filename excl = do - (hwnd, hwnd_type) <- openFileAsTemp filename True excl - mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding - - -- then use it to make a Handle - h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec - `onException` IODevice.close hwnd - return (filename, h) - -foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo - :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool - -foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo - :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool - -pathSeparator :: String -> Bool -pathSeparator template = any (\x-> x == '/' || x == '\\') template - -output_flags = std_flags -#else /* else mingw32_HOST_OS */ - findTempName = do - rs <- rand_string - let filename = prefix ++ rs ++ suffix - filepath = tmp_dir `combine` filename - r <- openNewFile filepath binary mode - case r of - FileExists -> findTempName - OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) - NewFileCreated fd -> do - (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-} - False{-is_socket-} - True{-is_nonblock-} - - enc <- getLocaleEncoding - h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc) - - return (filepath, h) - - 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 - -tempCounter :: IORef Int -tempCounter = unsafePerformIO $ newIORef 0 -{-# NOINLINE tempCounter #-} - --- build large digit-alike number -rand_string :: IO String -rand_string = do - r1 <- c_getpid - (r2, _) <- atomicModifyIORef'_ tempCounter (+1) - return $ show r1 ++ "-" ++ show r2 - -data OpenNewFileResult - = NewFileCreated CInt - | FileExists - | OpenNewError Errno - -openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult -openNewFile filepath binary mode = do - let oflags1 = rw_flags .|. o_EXCL - - binary_flags - | binary = o_BINARY - | otherwise = 0 - - oflags = oflags1 .|. binary_flags - fd <- withFilePath filepath $ \ f -> - c_open f oflags mode - if fd < 0 - then do - errno <- getErrno - case errno of - _ | errno == eEXIST -> return FileExists - _ -> return (OpenNewError errno) - else return (NewFileCreated fd) - --- XXX Should use filepath library -pathSeparatorChar :: Char -pathSeparatorChar = '/' - -pathSeparator :: String -> Bool -pathSeparator template = pathSeparatorChar `elem` template - -output_flags = std_flags .|. o_CREAT -#endif /* mingw32_HOST_OS */ - --- XXX Copied from GHC.Handle -std_flags, output_flags, rw_flags :: CInt -std_flags = o_NONBLOCK .|. o_NOCTTY -rw_flags = output_flags .|. o_RDWR ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -7848,6 +7848,7 @@ module GHC.IO.Handle where hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding) hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool @@ -9883,7 +9884,7 @@ module System.Exit where exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a module System.IO where - -- Safety: Safe + -- Safety: Trustworthy type BufferMode :: * data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int) type FilePath :: * ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -7820,6 +7820,7 @@ module GHC.IO.Handle where hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding) hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool @@ -9921,7 +9922,7 @@ module System.Exit where exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a module System.IO where - -- Safety: Safe + -- Safety: Trustworthy type BufferMode :: * data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int) type FilePath :: * ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -8012,6 +8012,7 @@ module GHC.IO.Handle where hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding) hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool @@ -10163,7 +10164,7 @@ module System.Exit where exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a module System.IO where - -- Safety: Safe + -- Safety: Trustworthy type BufferMode :: * data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int) type FilePath :: * ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -7848,6 +7848,7 @@ module GHC.IO.Handle where hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding) hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool @@ -9883,7 +9884,7 @@ module System.Exit where exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a module System.IO where - -- Safety: Safe + -- Safety: Trustworthy type BufferMode :: * data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int) type FilePath :: * ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -1,5 +1,6 @@ parsePlugin(a,b) interfacePlugin: Prelude +interfacePlugin: System.IO interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -2,6 +2,7 @@ parsePlugin() interfacePlugin: Prelude interfacePlugin: Language.Haskell.TH interfacePlugin: Language.Haskell.TH.Quote +interfacePlugin: System.IO interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -1,5 +1,6 @@ parsePlugin() interfacePlugin: Prelude +interfacePlugin: System.IO interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -5,9 +5,9 @@ interfacePlugin: GHC.Internal.Base interfacePlugin: GHC.Internal.Data.NonEmpty interfacePlugin: GHC.Internal.Float interfacePlugin: GHC.Internal.Prim.Ext -interfacePlugin: GHC.Internal.System.IO interfacePlugin: GHC.Internal.Types interfacePlugin: GHC.Internal.Show +interfacePlugin: System.IO typeCheckPlugin (rn) interfacePlugin: GHC.Internal.Stack.Types interfacePlugin: GHC.Internal.Exception.Context ===================================== testsuite/tests/typecheck/should_compile/T9497a.stderr ===================================== @@ -1,4 +1,3 @@ - T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _main :: IO () Or perhaps ‘_main’ is mis-spelled, or not in scope @@ -8,8 +7,7 @@ T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] main :: IO () (bound at T9497a.hs:2:1) readLn :: forall a. Read a => IO a with readLn @() - (imported from ‘Prelude’ - (and originally defined in ‘GHC.Internal.System.IO’)) + (imported from ‘Prelude’ (and originally defined in ‘System.IO’)) mempty :: forall a. Monoid a => a with mempty @(IO ()) (imported from ‘Prelude’ ===================================== testsuite/tests/typecheck/should_compile/holes.stderr ===================================== @@ -45,6 +45,15 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] y :: [a] z :: [a] -> [a] f :: forall {p}. p + appendFile :: FilePath -> String -> IO () + getChar :: IO Char + getContents :: IO String + getLine :: IO String + interact :: (String -> String) -> IO () + putChar :: Char -> IO () + putStr :: String -> IO () + readFile :: FilePath -> IO String + writeFile :: FilePath -> String -> IO () otherwise :: Bool (&&) :: Bool -> Bool -> Bool not :: Bool -> Bool @@ -58,16 +67,7 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] showChar :: Char -> ShowS showParen :: Bool -> ShowS -> ShowS showString :: String -> ShowS - appendFile :: FilePath -> String -> IO () - getChar :: IO Char - getContents :: IO String - getLine :: IO String - interact :: (String -> String) -> IO () - putChar :: Char -> IO () - putStr :: String -> IO () putStrLn :: String -> IO () - readFile :: FilePath -> IO String - writeFile :: FilePath -> String -> IO () EQ :: Ordering GT :: Ordering LT :: Ordering ===================================== testsuite/tests/typecheck/should_compile/holes3.stderr ===================================== @@ -48,6 +48,15 @@ holes3.hs:11:15: error: [GHC-88464] y :: [a] z :: [a] -> [a] f :: forall {p}. p + appendFile :: FilePath -> String -> IO () + getChar :: IO Char + getContents :: IO String + getLine :: IO String + interact :: (String -> String) -> IO () + putChar :: Char -> IO () + putStr :: String -> IO () + readFile :: FilePath -> IO String + writeFile :: FilePath -> String -> IO () otherwise :: Bool (&&) :: Bool -> Bool -> Bool not :: Bool -> Bool @@ -61,16 +70,7 @@ holes3.hs:11:15: error: [GHC-88464] showChar :: Char -> ShowS showParen :: Bool -> ShowS -> ShowS showString :: String -> ShowS - appendFile :: FilePath -> String -> IO () - getChar :: IO Char - getContents :: IO String - getLine :: IO String - interact :: (String -> String) -> IO () - putChar :: Char -> IO () - putStr :: String -> IO () putStrLn :: String -> IO () - readFile :: FilePath -> IO String - writeFile :: FilePath -> String -> IO () EQ :: Ordering GT :: Ordering LT :: Ordering ===================================== testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr ===================================== @@ -234,15 +234,14 @@ valid_hole_fits.hs:41:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] Valid hole fits include ps :: String -> IO () (defined at valid_hole_fits.hs:9:1) System.IO.putStr :: String -> IO () - (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34 - (and originally defined in ‘GHC.Internal.System.IO’)) + (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34) System.IO.putStrLn :: String -> IO () (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:37-44 (and originally defined in ‘GHC.Internal.System.IO’)) readIO :: forall a. Read a => String -> IO a with readIO @() (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 - (and originally defined in ‘GHC.Internal.System.IO’)) + (and originally defined in ‘System.IO’)) fail :: forall (m :: * -> *) a. (MonadFail m, GHC.Internal.Stack.Types.HasCallStack) => String -> m a ===================================== testsuite/tests/typecheck/should_fail/T9497d.stderr ===================================== @@ -8,8 +8,7 @@ T9497d.hs:2:8: error: [GHC-88464] main :: IO () (bound at T9497d.hs:2:1) readLn :: forall a. Read a => IO a with readLn @() - (imported from ‘Prelude’ - (and originally defined in ‘GHC.Internal.System.IO’)) + (imported from ‘Prelude’ (and originally defined in ‘System.IO’)) mempty :: forall a. Monoid a => a with mempty @(IO ()) (imported from ‘Prelude’ ===================================== testsuite/tests/typecheck/should_run/T9497a-run.stderr ===================================== @@ -10,8 +10,7 @@ T9497a-run.hs:2:8: error: [GHC-88464] main :: IO () (bound at T9497a-run.hs:2:1) readLn :: forall a. Read a => IO a with readLn @() - (imported from ‘Prelude’ - (and originally defined in ‘GHC.Internal.System.IO’)) + (imported from ‘Prelude’ (and originally defined in ‘System.IO’)) mempty :: forall a. Monoid a => a with mempty @(IO ()) (imported from ‘Prelude’ ===================================== testsuite/tests/typecheck/should_run/T9497b-run.stderr ===================================== @@ -10,8 +10,7 @@ T9497b-run.hs:2:8: error: [GHC-88464] main :: IO () (bound at T9497b-run.hs:2:1) readLn :: forall a. Read a => IO a with readLn @() - (imported from ‘Prelude’ - (and originally defined in ‘GHC.Internal.System.IO’)) + (imported from ‘Prelude’ (and originally defined in ‘System.IO’)) mempty :: forall a. Monoid a => a with mempty @(IO ()) (imported from ‘Prelude’ ===================================== testsuite/tests/typecheck/should_run/T9497c-run.stderr ===================================== @@ -10,8 +10,7 @@ T9497c-run.hs:2:8: error: [GHC-88464] main :: IO () (bound at T9497c-run.hs:2:1) readLn :: forall a. Read a => IO a with readLn @() - (imported from ‘Prelude’ - (and originally defined in ‘GHC.Internal.System.IO’)) + (imported from ‘Prelude’ (and originally defined in ‘System.IO’)) mempty :: forall a. Monoid a => a with mempty @(IO ()) (imported from ‘Prelude’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a662500af11d46f435ff7b4f25cb7aa… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a662500af11d46f435ff7b4f25cb7aa… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: hadrian: remove redundant library/rts ways definitions from stock flavours
by Marge Bot (＠marge-bot) 13 Mar '26

13 Mar '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 669d09f9 by Cheng Shao at 2026-03-13T15:06:07-04:00 hadrian: remove redundant library/rts ways definitions from stock flavours This patch removes redundant library/rts ways definitions from stock flavours in hadrian; they can be replaced by applying appropriate filters on `defaultFlavour`. - - - - - a27dc081 by Teo Camarasu at 2026-03-13T15:06:51-04:00 ghc-internal: move bits Weak of finalizer interface to base We move parts of the Weak finalizer interface to `base` only the parts that the RTS needs to know about are kept in `ghc-internal`. This lets us then prune our imports somewhat and get rid of some SOURCE imports. Resolves #26985 - - - - - 6eef855b by Sylvain Henry at 2026-03-13T15:08:18-04:00 Stg/Unarise: constant-folding during unarisation (#25650) When building an unboxed sum from a literal argument, mkUbxSum previously emitted a runtime cast via `case primop [lit] of var -> ...`. This wrapper prevented GHC from recognising the result as a static StgRhsCon, causing top-level closures to be allocated as thunks instead of being statically allocated. Fix: try to perform the numeric literal cast at compile time using mkLitNumberWrap (wrapping semantics). If successful, return the cast literal directly with an identity wrapper (no case expression). The runtime cast path is kept as fallback for non-literal arguments. Test: codeGen/should_compile/T25650 - - - - - 905f8723 by Simon Jakobi at 2026-03-13T15:09:09-04:00 Add regression test for #2057 Test that GHC stops after an interface-file error instead of continuing into the linker. The test constructs a stale package dependency on purpose. `pkgB` is compiled against one version of package `A`, then the same unit id is replaced by an incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`, finds an unfolding that still mentions the old `A`, and should fail while loading interfaces. Closes #2057. Assisted-by: Codex - - - - - a13245a9 by Sylvain Henry at 2026-03-13T15:10:06-04:00 JS: fix recompilation avoidance (#23013) - we were checking the mtime of the *.jsexe directory, not of a file - we were not computing the PkgsLoaded at all - - - - - 07442653 by Cheng Shao at 2026-03-13T15:10:51-04:00 hadrian: bump index state & bootstrap plans This patch bumps hadrian index state & bootstrap plans: - The updated index state allows bootstrapping from 9.14 without cabal allow-newer hacks - The updated bootstrap plans all contain shake-0.19.9 containing important bugfix, allowing a subsequent patch to bump shake bound to ensure the bugfix is included - ghc 9.14.1 bootstrap plan is added - - - - - fdc1dbad by Cheng Shao at 2026-03-13T15:10:51-04:00 ci: add ghc 9.14.1 to bootstrap matrix This patch adds ghc 9.14.1 to bootstrap matrix, so that we test bootstrapping from ghc 9.14.1. - - - - - 91916079 by Sylvain Henry at 2026-03-13T15:11:43-04:00 T17912: wait for opener thread to block before killing it (#24739) Instead of a fixed 1000ms delay, poll threadStatus until the opener thread is in BlockedOnForeignCall, ensuring killThread only fires once the thread is provably inside the blocking open() syscall. This prevents the test from accidentally passing on Windows due to scheduling races. - - - - - baa4ebb4 by Cheng Shao at 2026-03-13T15:12:26-04:00 template-haskell: fix redundant import in Language.Haskell.TH.Quote This patch fixes a redundant import in `Language.Haskell.TH.Quote` that causes a ghc build failure when bootstrapping from 9.14 with validate flavours. Fixes #27014. - - - - - 02e68a86 by Brandon Simmons at 2026-03-13T15:13:19-04:00 Add a cumulative gc_sync_elapsed_ns counter to GHC.Internal.Stats This makes it possible to get an accurate view of time spent in sync phase when using prometheus-style sampling. Previously this was only available for the most recent GC. This intentionally leaves GHC.Stats API unchanged since it is marked as deprecated, and API changes there require CLC approval. Fixes #26944 - - - - - c0ba51fc by Matthew Pickering at 2026-03-13T15:46:40-04:00 exceptions: annotate onException continuation with WhileHandling Before this patch, an exception thrown in the `onException` handler would loose track of where the original exception was thrown. ``` import Control.Exception main :: IO () main = failingAction `onException` failingCleanup where failingAction = throwIO (ErrorCall "outer failure") failingCleanup = throwIO (ErrorCall "cleanup failure") ``` would report ``` T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: cleanup failure HasCallStack backtrace: throwIO, called at T28399.hs:<line>:<column> in <package-id>:Main ``` notice that the "outer failure" exception is not present in the error message. With this patch, any exception thrown is in the handler is annotated with WhileHandling. The resulting message looks like ``` T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: cleanup failure While handling outer failure HasCallStack backtrace: throwIO, called at T28399.hs:7:22 in main:Main ``` CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/397 Fixes #26759 - - - - - ab418a11 by Andreas Klebinger at 2026-03-13T15:46:41-04:00 Fix missing profiling header for origin_thunk frame. Fixes #27007 - - - - - a180327f by Matthew Pickering at 2026-03-13T15:46:42-04:00 rts: forward clone-stack messages after TSO migration MSG_CLONE_STACK assumed that the target TSO was still owned by the capability that received the message. This is not always true: the TSO can migrate before the inbox entry is handled. When that happened, handleCloneStackMessage could clone a live stack from the wrong capability and use the wrong capability for allocation and performTryPutMVar, leading to stack sanity failures such as checkStackFrame: weird activation record found on stack. Fix this by passing the current capability into handleCloneStackMessage, rechecking msg->tso->cap at handling time, and forwarding the message if the TSO has migrated. Once ownership matches, use the executing capability consistently for cloneStack, rts_apply, and performTryPutMVar. Fixes #27008 - - - - - 0e32fbb7 by Cheng Shao at 2026-03-13T15:46:43-04:00 ci: fix ci-images revision The current ci-images revision was a commit on the WIP branch of https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/183, and it's not on the current ci-images master branch. This patch fixes the image revision to use the current tip of ci-images master. - - - - - dedb4fec by Andreas Klebinger at 2026-03-13T15:46:44-04:00 Revert "hadrian/build-cabal: Better respect and utilize -j" This reverts commit eab3dbba79650e6046efca79133b4c0a5257613d. While it's neat this currently isn't well supported on all platforms. It's time will come, but for now I'm reverting this to avoid issues for users on slightly unconvential platforms. This will be tracked at #26977. - - - - - 89 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Stg/Unarise.hs - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_10_1.json - hadrian/bootstrap/plan-9_10_2.json - hadrian/bootstrap/plan-9_10_3.json - hadrian/bootstrap/plan-9_12_1.json - hadrian/bootstrap/plan-9_12_2.json - + hadrian/bootstrap/plan-9_14_1.json - hadrian/bootstrap/plan-bootstrap-9_10_1.json - hadrian/bootstrap/plan-bootstrap-9_10_2.json - hadrian/bootstrap/plan-bootstrap-9_10_3.json - hadrian/bootstrap/plan-bootstrap-9_12_1.json - hadrian/bootstrap/plan-bootstrap-9_12_2.json - + hadrian/bootstrap/plan-bootstrap-9_14_1.json - hadrian/build-cabal - hadrian/cabal.project - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/GhcInGhci.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Flavours/QuickCross.hs - hadrian/src/Settings/Flavours/Quickest.hs - libraries/base/changelog.md - libraries/base/src/GHC/Stats.hs - libraries/base/src/GHC/Weak.hs - libraries/base/src/GHC/Weak/Finalize.hs - − libraries/base/src/GHC/Weak/Finalizehs - libraries/base/src/System/Mem/Weak.hs - libraries/base/tests/IO/T17912.hs - libraries/base/tests/IO/all.T - libraries/ghc-internal/CHANGELOG.md - − libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot - libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs - libraries/ghc-internal/src/GHC/Internal/IO.hs - − libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs-boot - libraries/ghc-internal/src/GHC/Internal/Stats.hsc - libraries/ghc-internal/src/GHC/Internal/TopHandler.hs - libraries/ghc-internal/src/GHC/Internal/Weak.hs - libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs - libraries/template-haskell/Language/Haskell/TH/Quote.hs - rts/CloneStack.c - rts/CloneStack.h - rts/Messages.c - rts/Stats.c - rts/StgMiscClosures.cmm - rts/include/RtsAPI.h - testsuite/.gitignore - testsuite/tests/annotations/should_run/all.T - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/T25650.hs - + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-32 - + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-64 - testsuite/tests/codeGen/should_compile/all.T - − testsuite/tests/driver/OneShotTH.stdout-javascript-unknown-ghcjs - + testsuite/tests/driver/T2057/Makefile - + testsuite/tests/driver/T2057/README.md - + testsuite/tests/driver/T2057/T2057.stderr - + testsuite/tests/driver/T2057/all.T - + testsuite/tests/driver/T2057/app/Main.hs - + testsuite/tests/driver/T2057/pkgA1/A.hs - + testsuite/tests/driver/T2057/pkgA1/pkg.conf - + testsuite/tests/driver/T2057/pkgA2/A.hs - + testsuite/tests/driver/T2057/pkgA2/pkg.conf - + testsuite/tests/driver/T2057/pkgB/B.hs - + testsuite/tests/driver/T2057/pkgB/pkg.conf - + testsuite/tests/driver/T20604/T20604.stdout-javascript-unknown-ghcjs - testsuite/tests/driver/T20604/all.T - testsuite/tests/driver/all.T - testsuite/tests/driver/fat-iface/fat010.stdout-javascript-unknown-ghcjs - testsuite/tests/driver/recomp011/all.T - testsuite/tests/driver/recompHash/recompHash.stdout-javascript-unknown-ghcjs - testsuite/tests/driver/recompNoTH/recompNoTH.stdout-javascript-unknown-ghcjs - − testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs - + testsuite/tests/exceptions/T26759.hs - + testsuite/tests/exceptions/T26759.stderr - + testsuite/tests/exceptions/T26759a.hs - + testsuite/tests/exceptions/T26759a.stderr - + testsuite/tests/exceptions/T26759a.stdout - testsuite/tests/exceptions/all.T - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/rts/all.T - + testsuite/tests/rts/cloneThreadStackMigrating.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01ab93dec36cf26bf771a08f064fdb… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01ab93dec36cf26bf771a08f064fdb… You're receiving this email because of your account on gitlab.haskell.org.

1 0