[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: ghci: fix isMinTTY.h casing for Windows targets
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Aug 19 15:45:40 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
3a145315 by Cheng Shao at 2024-08-18T13:05:45-04:00
ghci: fix isMinTTY.h casing for Windows targets
This commit fixes isMinTTY.h casing in isMinTTY.c that's compiled for
Windows targets. While this looks harmless given Windows filesystems
are case-insensitive by default, it does cause a compilation warning
with recent versions of clang, so we might as well fix the casing:
```
driver\ghci\isMinTTY.c:10:10: error:
warning: non-portable path to file '"isMinTTY.h"'; specified path differs in case from file name on disk [-Wnonportable-include-path]
|
10 | #include "isMINTTY.h"
| ^
#include "isMINTTY.h"
^~~~~~~~~~~~
"isMinTTY.h"
1 warning generated.
```
- - - - -
d32c4bda by Matthew Pickering at 2024-08-19T11:45:33-04:00
Update directory submodule to latest master
The primary reason for this bump is to fix the warning from `ghc-pkg
check`:
```
Warning: include-dirs: /data/home/ubuntu/.ghcup/ghc/9.6.2/lib/ghc-9.6.2/lib/../lib/aarch64-linux-ghc-9.6.2/directory-1.3.8.1/include doesn't exist or isn't a directory
```
This also requires adding the `file-io` package as a boot library (which
is discussed in #25145)
Fixes #23594 #25145
- - - - -
d4fa319f by Sebastian Graf at 2024-08-19T11:45:34-04:00
Improve efficiency of `assertError` (#24625)
... by moving `lazy` to the exception-throwing branch.
It's all documented in `Note [Strictness of assertError]`.
- - - - -
11 changed files:
- .gitmodules
- docs/users_guide/9.12.1-notes.rst
- driver/utils/isMinTTY.c
- hadrian/src/Packages.hs
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- libraries/directory
- + libraries/file-io
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- + testsuite/tests/simplCore/should_compile/T24625.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
.gitmodules
=====================================
@@ -118,3 +118,6 @@
[submodule "hadrian/vendored/Cabal"]
path = hadrian/vendored/Cabal
url = https://gitlab.haskell.org/ghc/packages/Cabal.git
+[submodule "libraries/file-io"]
+ path = libraries/file-io
+ url = https://gitlab.haskell.org/ghc/packages/file-io.git
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -222,3 +222,4 @@ for further change information.
libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
libraries/os-string/os-string.cabal: Dependency of ``filepath`` library
+ libraries/file-io/file-io.cabal: Dependency of ``directory`` library
=====================================
driver/utils/isMinTTY.c
=====================================
@@ -7,7 +7,7 @@
#include <stdbool.h>
#include <windows.h>
-#include "isMINTTY.h"
+#include "isMinTTY.h"
bool isMinTTY() {
const HANDLE h = GetStdHandle(STD_ERROR_HANDLE);
=====================================
hadrian/src/Packages.hs
=====================================
@@ -4,7 +4,7 @@ module Packages (
array, base, binary, bytestring, cabal, cabalSyntax, checkPpr,
checkExact, countDeps,
compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls,
- exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform,
+ exceptions, filepath, fileio, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform,
ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim,
ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
@@ -40,7 +40,7 @@ ghcPackages =
, ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs
, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString
, parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell
- , terminfo, text, time, transformers, unlit, unix, win32, xhtml
+ , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio
, timeout
, lintersCommon
, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ]
@@ -79,6 +79,7 @@ directory = lib "directory"
dumpDecls = util "dump-decls"
exceptions = lib "exceptions"
filepath = lib "filepath"
+fileio = lib "file-io"
genapply = util "genapply"
genprimopcode = util "genprimopcode"
ghc = prg "ghc-bin" `setPath` "ghc"
=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -138,6 +138,7 @@ toolTargets = [ cabalSyntax
, directory
, process
, filepath
+ , fileio
, osString
-- , ghc -- # depends on ghc library
-- , runGhc -- # depends on ghc library
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -83,8 +83,9 @@ stage0Packages = do
return $ [ cabalSyntax
, cabal
, compiler
- , directory -- depends on filepath
+ , directory -- depends on filepath, fileIo
, filepath -- depends on os-string
+ , fileio
, ghc
, ghcBoot
, ghcBootThNext
=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit a97a8a8f30d652f972192122fd5f459a147c13e5
+Subproject commit 6045b93c4ef7a713c8f3d6837ca69f8e96b12bf1
=====================================
libraries/file-io
=====================================
@@ -0,0 +1 @@
+Subproject commit a4a0464ccd38e8380c202949a90b21d9e592aeef
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
=====================================
@@ -438,13 +438,10 @@ instance Show IOException where
"" -> id
_ -> showString " (" . showString s . showString ")")
--- Note the use of "lazy". This means that
--- assert False (throw e)
--- will throw the assertion failure rather than e. See trac #5561.
assertError :: (?callStack :: CallStack) => Bool -> a -> a
assertError predicate v
- | predicate = lazy v
- | otherwise = unsafeDupablePerformIO $ do
+ | predicate = v
+ | otherwise = lazy $ unsafeDupablePerformIO $ do -- lazy: See Note [Strictness of assertError]
ccsStack <- currentCallStack
let
implicitParamCallStack = prettyCallStackLines ?callStack
@@ -452,6 +449,44 @@ assertError predicate v
stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
throwIO (AssertionFailed ("Assertion failed\n" ++ stack))
+{- Note [Strictness of assertError]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It is vital that Demand Analysis does not see `assertError p e` as strict in e.
+#5561 details what happens otherwise, tested by libraries/base/tests/assert.hs:
+
+ let e1 i = throw Overflow
+ in assertError False (e1 5)
+
+This should *not* throw the Overflow exception; rather it should throw an
+AssertionError.
+Hence we use GHC.Exts.lazy to make assertError appear lazy in e, so that it
+is not called by-value.
+(Note that the reason we need `lazy` in the first place is that error has a
+bottoming result, which is strict in all free variables.)
+The way we achieve this is a bit subtle; before #24625 we defined it as
+
+ assertError p e | p = lazy e
+ | otherwise = error "assertion"
+
+but this means that in the following example (full code in T24625) we cannot
+cancel away the allocation of `Just x` because of the intervening `lazy`:
+
+ case assertError False (Just x) of Just y -> y
+ ==> { simplify }
+ case lazy (Just x) of Just y -> y
+
+Instead, we put `lazy` in the otherwise branch, thus
+
+ assertError p e | p = e
+ | otherwise = lazy $ error "assertion"
+
+The effect on #5561 is the same: since the otherwise branch appears lazy in e,
+the overall demand on `e` must be lazy as well.
+Furthermore, since there is no intervening `lazy` on the expected code path,
+the Simplifier may perform case-of-case on e and simplify the `Just x` example
+to `x`.
+-}
+
unsupportedOperation :: IOError
unsupportedOperation =
(IOError Nothing UnsupportedOperation ""
@@ -480,4 +515,3 @@ untangle coded message
_ -> (loc, "")
}
not_bar c = c /= '|'
-
=====================================
testsuite/tests/simplCore/should_compile/T24625.hs
=====================================
@@ -0,0 +1,14 @@
+module T24625 where
+
+import GHC.IO.Exception
+import GHC.Exts
+
+data Foo = Foo !Int !Int String
+
+true :: Bool
+true = True
+{-# NOINLINE true #-}
+
+function :: Int -> Int -> String -> Int
+function !a !b c = case assertError true (Foo a b c) of
+ Foo a b c -> a + b
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -526,5 +526,6 @@ test('T24808', [ grep_errmsg(r'myFunction') ], compile, ['-O -ddump-simpl'])
# T24944 needs -O2 because it's about SpecConstr
test('T24944', [extra_files(['T24944a.hs'])], multimod_compile, ['T24944', '-v0 -O2'])
+test('T24625', [ grep_errmsg(r'case lazy') ], compile, ['-O -fno-ignore-asserts -ddump-simpl -dsuppress-uniques'])
test('T24725a', [ grep_errmsg(r'testedRule')], compile, ['-O -ddump-rule-firings'])
test('T25033', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a12fd0d1e07b1172833e8e03da355453b0d74994...d4fa319fa52b5f59125ff0a6d741c5a7e3c634e1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a12fd0d1e07b1172833e8e03da355453b0d74994...d4fa319fa52b5f59125ff0a6d741c5a7e3c634e1
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/20240819/7b4b1a76/attachment-0001.html>
More information about the ghc-commits
mailing list