[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: docs: Fix link to 051-ghc-base-libraries.rst
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Dec 18 19:31:32 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0b43a0c9 by Vladislav Zavialov at 2023-12-18T14:31:20-05:00
docs: Fix link to 051-ghc-base-libraries.rst
The proposal is no longer available at the previous URL.
- - - - -
0abdc0e2 by ur4t at 2023-12-18T14:31:23-05:00
GHCi: fix improper location of ghci_history file
Fixes #24266
- - - - -
f6eb3584 by Matthew Craven at 2023-12-18T14:31:23-05:00
StgToCmm: Detect some no-op case-continuations
...and generate no code for them. Fixes #24264.
- - - - -
8 changed files:
- compiler/GHC/StgToCmm/Expr.hs
- docs/users_guide/9.10.1-notes.rst
- ghc/GHCi/UI.hs
- + testsuite/tests/codeGen/should_compile/T24264.hs
- + testsuite/tests/codeGen/should_compile/T24264.stderr
- testsuite/tests/codeGen/should_compile/all.T
- + testsuite/tests/codeGen/should_run/T24264run.hs
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -570,6 +570,58 @@ cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts
-- Use the same return convention as vanilla 'a'.
cgCase (StgApp a []) bndr alt_type alts
+{-
+Note [Eliminate trivial Solo# continuations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have code like this:
+
+ case scrut of bndr {
+ alt -> Solo# bndr
+ }
+
+The RHS of the only branch does nothing except wrap the case-binder
+returned by 'scrut' in a unary unboxed tuple. But unboxed tuples
+don't exist at run-time, i.e. the branch is a no-op! So we can
+generate code as if we just had 'scrut' instead of a case-expression.
+
+This situation can easily arise for IO or ST code, where the last
+operation a function performs is commonly 'pure $! someExpr'.
+See also #24264 and !11778. More concretely, as of December 2023,
+when building a stage2 "perf+no_profiled_libs" ghc:
+
+ * The special case is reached 398 times.
+ * Of these, 158 have scrutinees that call a function or enter a
+ potential thunk, and would need to push a useless stack frame if
+ not for this optimisation.
+
+We might consider rewriting such case expressions in GHC.Stg.CSE as a
+slight extension of Note [All alternatives are the binder]. But the
+RuntimeReps of 'bndr' and 'Solo# bndr' are not exactly the same, and
+per Note [Typing the STG language] in GHC.Stg.Lint, we do expect Stg
+code to remain RuntimeRep-correct. So we just detect the situation in
+StgToCmm instead.
+
+Crucially, the return conventions for 'ty' and '(# ty #)' are compatible:
+The returned value is passed in the same register(s) or stack slot in
+both conventions, and the set of allowed return values for 'ty'
+is a subset of the allowed return values for '(# ty #)':
+
+ * For a lifted type 'ty', the return convention for 'ty' promises to
+ return an evaluated-properly-tagged heap pointer, while a return
+ type '(# ty #)' only promises to return a heap pointer to an object
+ that can be evaluated later if need be.
+
+ * If 'ty' is unlifted, the allowed return
+ values for 'ty' and '(# ty #)' are identical.
+-}
+
+cgCase scrut bndr _alt_type [GenStgAlt { alt_rhs = rhs}]
+ -- see Note [Eliminate trivial Solo# continuations]
+ | StgConApp dc _ [StgVarArg v] _ <- rhs
+ , isUnboxedTupleDataCon dc
+ , v == bndr
+ = cgExpr scrut
+
cgCase scrut bndr alt_type alts
= -- the general case
do { platform <- getPlatform
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -178,8 +178,9 @@ Runtime system
``ghc-experimental`` library
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Introduced per the `base library split proposal
- <https://github.com/Ericson2314/tech-proposals/blob/ghc-base-libraries/proposals/accepted/051-ghc-base-libraries.rst>`_
+- ``ghc-experimental`` is a new library for functions and data types with
+ weaker stability guarantees. Introduced per the HF Technical Proposal `#51
+ <https://github.com/haskellfoundation/tech-proposals/blob/main/proposals/accepted/051-ghc-base-libraries.rst>`_.
``template-haskell`` library
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -639,30 +639,27 @@ ghciLogAction lastErrLocations old_log_action
_ -> return ()
_ -> return ()
--- | Takes a file name and prefixes it with the appropriate
--- GHC appdir.
--- Uses ~/.ghc (getAppUserDataDirectory) if it exists
--- If it doesn't, then it uses $XDG_DATA_HOME/ghc
--- Earlier we always used to use ~/.ghc, but we want
--- to gradually move to $XDG_DATA_HOME to respect the XDG specification
---
--- As a migration strategy, we will only create new directories in
--- the appropriate XDG location. However, we will use the old directory
--- if it already exists.
-getAppDataFile :: FilePath -> IO (Maybe FilePath)
-getAppDataFile file = do
- let new_path = tryIO (getXdgDirectory XdgConfig "ghc") >>= \case
- Left _ -> pure Nothing
- Right dir -> flip catchIO (const $ return Nothing) $ do
- createDirectoryIfMissing False dir
- pure $ Just $ dir </> file
-
- e_old_path <- tryIO (getAppUserDataDirectory "ghc")
- case e_old_path of
- Right old_path -> doesDirectoryExist old_path >>= \case
- True -> pure $ Just $ old_path </> file
- False -> new_path
- Left _ -> new_path
+-- | Takes a file name and prefixes it with the appropriate GHC appdir.
+-- ~/.ghc (getAppUserDataDirectory) is used if it exists, or XDG directories
+-- are used to respect the XDG specification.
+-- As a migration strategy, currently we will only create new directories in
+-- the appropriate XDG location.
+getAppDataFile :: XdgDirectory -> FilePath -> IO (Maybe FilePath)
+getAppDataFile xdgDir file = do
+ xdgAppDir <-
+ tryIO (getXdgDirectory xdgDir "ghc") >>= \case
+ Left _ -> pure Nothing
+ Right dir -> flip catchIO (const $ pure Nothing) $ do
+ createDirectoryIfMissing False dir
+ pure $ Just dir
+ appDir <-
+ tryIO (getAppUserDataDirectory "ghc") >>= \case
+ Right dir ->
+ doesDirectoryExist dir >>= \case
+ True -> pure $ Just dir
+ False -> pure xdgAppDir
+ Left _ -> pure xdgAppDir
+ pure $ appDir >>= \dir -> Just $ dir </> file
runGHCi :: [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String] -> GHCi ()
runGHCi paths maybe_exprs = do
@@ -670,13 +667,12 @@ runGHCi paths maybe_exprs = do
let
ignore_dot_ghci = gopt Opt_IgnoreDotGhci dflags
- app_user_dir = liftIO $ getAppDataFile "ghci.conf"
+ appDataCfg = liftIO $ getAppDataFile XdgConfig "ghci.conf"
- home_dir = do
- either_dir <- liftIO $ tryIO (getEnv "HOME")
- case either_dir of
- Right home -> return (Just (home </> ".ghci"))
- _ -> return Nothing
+ homeCfg = do
+ liftIO $ tryIO (getEnv "HOME") >>= \case
+ Right home -> pure $ Just $ home </> ".ghci"
+ _ -> pure Nothing
canonicalizePath' :: FilePath -> IO (Maybe FilePath)
canonicalizePath' fp = liftM Just (canonicalizePath fp)
@@ -710,7 +706,7 @@ runGHCi paths maybe_exprs = do
then pure []
else do
userCfgs <- do
- paths <- catMaybes <$> sequence [ app_user_dir, home_dir ]
+ paths <- catMaybes <$> sequence [ appDataCfg, homeCfg ]
checkedPaths <- liftIO $ filterM checkFileAndDirPerms paths
liftIO . fmap (nub . catMaybes) $ mapM canonicalizePath' checkedPaths
@@ -797,12 +793,12 @@ runGHCiInput f = do
dflags <- getDynFlags
let ghciHistory = gopt Opt_GhciHistory dflags
let localGhciHistory = gopt Opt_LocalGhciHistory dflags
- currentDirectory <- liftIO $ getCurrentDirectory
+ currentDirectory <- liftIO getCurrentDirectory
histFile <- case (ghciHistory, localGhciHistory) of
- (True, True) -> return (Just (currentDirectory </> ".ghci_history"))
- (True, _) -> liftIO $ getAppDataFile "ghci_history"
- _ -> return Nothing
+ (True, True) -> pure $ Just $ currentDirectory </> ".ghci_history"
+ (True, _) -> liftIO $ getAppDataFile XdgData "ghci_history"
+ _ -> pure Nothing
runInputT
(setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile})
=====================================
testsuite/tests/codeGen/should_compile/T24264.hs
=====================================
@@ -0,0 +1,18 @@
+module T24264 where
+
+fun :: a -> IO a
+{-# OPAQUE fun #-}
+fun x = do
+ pure ()
+ pure $! x
+ -- This should not push a continuation to the stack before entering 'x'
+
+funPair :: a -> IO (a, a)
+{-# OPAQUE funPair #-}
+funPair x = do
+ pure ()
+ x' <- pure $! x
+ -- This should push a continuation to the stack before entering 'x',
+ -- so the pair can be returned instead. (It's here to make sure
+ -- that the 'returns to' detection continues working correctly.)
+ pure (x', x')
=====================================
testsuite/tests/codeGen/should_compile/T24264.stderr
=====================================
@@ -0,0 +1,70 @@
+
+==================== Output Cmm ====================
+[T24264.fun_entry() { // [R2]
+ { info_tbls: [(cKd,
+ label: T24264.fun_info
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+ srt: Nothing)]
+ stack_info: arg_space: 8
+ }
+ {offset
+ cKd: // global
+ // slowCall
+ R1 = R2; // CmmAssign
+ call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8; // CmmCall
+ }
+ },
+ section ""data" . T24264.fun_closure" {
+ T24264.fun_closure:
+ const T24264.fun_info;
+ }]
+
+
+
+==================== Output Cmm ====================
+[T24264.funPair_entry() { // [R2]
+ { info_tbls: [(cKn,
+ label: block_cKn_info
+ rep: StackRep []
+ srt: Nothing),
+ (cKq,
+ label: T24264.funPair_info
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+ srt: Nothing)]
+ stack_info: arg_space: 8
+ }
+ {offset
+ cKq: // global
+ if ((Sp + -8) < SpLim) (likely: False) goto cKr; else goto cKs; // CmmCondBranch
+ cKr: // global
+ R1 = T24264.funPair_closure; // CmmAssign
+ call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
+ cKs: // global
+ // slowCall
+ I64[Sp - 8] = cKn; // CmmStore
+ R1 = R2; // CmmAssign
+ Sp = Sp - 8; // CmmAssign
+ call stg_ap_0_fast(R1) returns to cKn, args: 8, res: 8, upd: 8; // CmmCall
+ cKn: // global
+ // slow_call for _sK3::P64 with pat stg_ap_0
+ Hp = Hp + 24; // CmmAssign
+ if (Hp > HpLim) (likely: False) goto cKv; else goto cKu; // CmmCondBranch
+ cKv: // global
+ HpAlloc = 24; // CmmAssign
+ call stg_gc_unpt_r1(R1) returns to cKn, args: 8, res: 8, upd: 8; // CmmCall
+ cKu: // global
+ // allocHeapClosure
+ I64[Hp - 16] = (,)_con_info; // CmmStore
+ P64[Hp - 8] = R1; // CmmStore
+ P64[Hp] = R1; // CmmStore
+ R1 = Hp - 15; // CmmAssign
+ Sp = Sp + 8; // CmmAssign
+ call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ }
+ },
+ section ""data" . T24264.funPair_closure" {
+ T24264.funPair_closure:
+ const T24264.funPair_info;
+ }]
+
+
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -128,3 +128,5 @@ test('T21710a', [ unless(tables_next_to_code(), skip) , when(wordsize(32), skip)
, grep_errmsg('(call)',[1]) ]
, compile, ['-ddump-cmm -dno-typeable-binds'])
test('T23002', normal, compile, ['-fregs-graph'])
+test('T24264', grep_errmsg(r'(.*\().*(\) returns to)', [1,2]),
+ compile, ['-O -ddump-cmm -dno-typeable-binds'])
=====================================
testsuite/tests/codeGen/should_run/T24264run.hs
=====================================
@@ -0,0 +1,32 @@
+module Main where
+
+import Control.Exception (evaluate)
+import GHC.Exts (lazy, noinline)
+
+data StrictPair a b = !a :*: !b
+
+tailEval1 :: a -> IO a
+{-# OPAQUE tailEval1 #-}
+tailEval1 = lazy $ \x -> do
+ pure ()
+ pure $! x
+
+tailEval2 :: a -> IO a
+{-# OPAQUE tailEval2 #-}
+tailEval2 x = evaluate x
+
+go :: [a] -> IO ()
+go = noinline mapM_ $ \x -> do
+ y1 <- tailEval1 x
+ y2 <- tailEval2 x
+ evaluate (y1 :*: y2)
+
+main :: IO ()
+main = do
+ let ints :: [Int]
+ ints = take 1000 $ noinline iterate (\x -> x * 35) 1
+ go ints
+ go [LT, EQ, GT]
+ go $ noinline map (toEnum @Ordering . flip mod 3) ints
+ go $ noinline map Left ints
+ go $ noinline map (+) ints
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -240,3 +240,4 @@ test('MulMayOflo_full',
ignore_stdout],
multi_compile_and_run,
['MulMayOflo', [('MulMayOflo_full.cmm', '')], ''])
+test('T24264run', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d8e35333f12ae6b05a16d7803ff6dc15937c36f...f6eb3584aecbc664a2fe7de21a1d054b0646f95f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d8e35333f12ae6b05a16d7803ff6dc15937c36f...f6eb3584aecbc664a2fe7de21a1d054b0646f95f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231218/2c8c5d0b/attachment-0001.html>
More information about the ghc-commits
mailing list