[Git][ghc/ghc][wip/T23479] 10 commits: JS: add basic support for POSIX *at functions (#25190)
Serge S. Gulin (@gulin.serge)
gitlab at gitlab.haskell.org
Wed Aug 28 16:07:33 UTC 2024
Serge S. Gulin pushed to branch wip/T23479 at Glasgow Haskell Compiler / GHC
Commits:
27dceb42 by Sylvain Henry at 2024-08-26T11:05:11-04:00
JS: add basic support for POSIX *at functions (#25190)
openat/fstatat/unlinkat/dup are now used in the recent release of the
`directory` and `file-io` packages.
As such, these functions are (indirectly) used in the following tests
one we'll bump the `directory` submodule (see !13122):
- openFile008
- jsOptimizer
- T20509
- bkpcabal02
- bkpcabal03
- bkpcabal04
- - - - -
c68be356 by Matthew Pickering at 2024-08-26T11:05:11-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
- - - - -
4ee094d4 by Matthew Pickering at 2024-08-26T11:05:47-04:00
Fix aarch64-alpine target platform description
We are producing bindists where the target triple is
aarch64-alpine-linux
when it should be
aarch64-unknown-linux
This is because the bootstrapped compiler originally set the target
triple to `aarch64-alpine-linux` which is when propagated forwards by
setting `bootstrap_target` from the bootstrap compiler target.
In order to break this chain we explicitly specify build/host/target for
aarch64-alpine.
This requires a new configure flag `--enable-ignore-` which just
switches off a validation check that the target platform of the
bootstrap compiler is the same as the build platform. It is the same,
but the name is just wrong.
These commits can be removed when the bootstrap compiler has the correct
target triple (I looked into patching this on ci-images, but it looked
hard to do correctly as the build/host platform is not in the settings
file).
Fixes #25200
- - - - -
e0e0f2b2 by Matthew Pickering at 2024-08-26T11:05:47-04:00
Bump nixpkgs commit for gen_ci script
- - - - -
63a27091 by doyougnu at 2024-08-26T20:39:30-04:00
rts: win32: emit additional debugging information
-- migration from haskell.nix
- - - - -
aaab3d10 by Vladislav Zavialov at 2024-08-26T20:40:06-04:00
Only export defaults when NamedDefaults are enabled (#25206)
This is a reinterpretation of GHC Proposal #409 that avoids a breaking
change introduced in fa0dbaca6c "Implements the Exportable Named Default proposal"
Consider a module M that has no explicit export list:
module M where
default (Rational)
Should it export the default (Rational)?
The proposal says "yes", and there's a test case for that:
default/DefaultImport04.hs
However, as it turns out, this change in behavior breaks existing
programs, e.g. the colour-2.3.6 package can no longer be compiled,
as reported in #25206.
In this patch, we make implicit exports of defaults conditional on
the NamedDefaults extension. This fix is unintrusive and compliant
with the existing proposal text (i.e. it does not require a proposal
amendment). Should the proposal be amended, we can go for a simpler
solution, such as requiring all defaults to be exported explicitly.
Test case: testsuite/tests/default/T25206.hs
- - - - -
275054fd by Serge S. Gulin at 2024-08-28T18:59:39+03:00
JS: Re-add optimization for literal strings in genApp (fixes 23479 (muted temporary))
Based on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588/
- - - - -
11f74aa3 by Serge S. Gulin at 2024-08-28T18:59:58+03:00
Use name defined at `GHC.Builtin.Names`
- - - - -
68cd79c0 by Serge S. Gulin at 2024-08-28T18:59:58+03:00
Apply 1 suggestion(s) to 1 file(s)
Co-authored-by: Sylvain Henry <sylvain at haskus.fr>
- - - - -
04716d31 by Serge S. Gulin at 2024-08-28T19:07:12+03:00
Attempt to take 805 for id
- - - - -
26 changed files:
- .gitlab/generate-ci/flake.lock
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitmodules
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Symbols.hs
- compiler/GHC/Tc/Gen/Export.hs
- configure.ac
- docs/users_guide/9.12.1-notes.rst
- hadrian/src/Packages.hs
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- libraries/directory
- + libraries/file-io
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- rts/linker/PEi386.c
- + testsuite/tests/default/T25206.hs
- + testsuite/tests/default/T25206.stderr
- + testsuite/tests/default/T25206_helper.hs
- testsuite/tests/default/all.T
- testsuite/tests/javascript/Makefile
- + testsuite/tests/javascript/T23479.hs
- + testsuite/tests/javascript/T23479.stdout
- testsuite/tests/javascript/all.T
Changes:
=====================================
.gitlab/generate-ci/flake.lock
=====================================
@@ -5,11 +5,11 @@
"systems": "systems"
},
"locked": {
- "lastModified": 1687709756,
- "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=",
+ "lastModified": 1710146030,
+ "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
"owner": "numtide",
"repo": "flake-utils",
- "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7",
+ "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
"type": "github"
},
"original": {
@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
- "lastModified": 1687886075,
- "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=",
+ "lastModified": 1724334015,
+ "narHash": "sha256-5sfvc0MswIRNdRWioUhG58rGKGn2o90Ck6l6ClpwQqA=",
"owner": "NixOS",
"repo": "nixpkgs",
- "rev": "a565059a348422af5af9026b5174dc5c0dcefdae",
+ "rev": "6d204f819efff3d552a88d0a44b5aaaee172b784",
"type": "github"
},
"original": {
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -409,7 +409,7 @@ opsysVariables _ FreeBSD13 = mconcat
, "GHC_VERSION" =: "9.6.4"
, "CABAL_INSTALL_VERSION" =: "3.10.2.0"
]
-opsysVariables _ (Linux distro) = distroVariables distro
+opsysVariables arch (Linux distro) = distroVariables arch distro
opsysVariables AArch64 (Darwin {}) =
mconcat [ "NIX_SYSTEM" =: "aarch64-darwin"
, "MACOSX_DEPLOYMENT_TARGET" =: "11.0"
@@ -441,25 +441,30 @@ opsysVariables _ (Windows {}) =
, "GHC_VERSION" =: "9.6.4" ]
opsysVariables _ _ = mempty
-alpineVariables = mconcat
+alpineVariables :: Arch -> Variables
+alpineVariables arch = mconcat $
[ -- Due to #20266
"CONFIGURE_ARGS" =: "--disable-ld-override"
, "INSTALL_CONFIGURE_ARGS" =: "--disable-ld-override"
-- encoding004: due to lack of locale support
-- T10458, ghcilink002: due to #17869
, "BROKEN_TESTS" =: "encoding004 T10458"
+ ] ++
+ [-- Bootstrap compiler has incorrectly configured target triple #25200
+ "CONFIGURE_ARGS" =: "--enable-ignore-build-platform-mismatch --build=aarch64-unknown-linux --host=aarch64-unknown-linux --target=aarch64-unknown-linux"
+ | AArch64 <- [arch]
]
-distroVariables :: LinuxDistro -> Variables
-distroVariables Alpine312 = alpineVariables
-distroVariables Alpine318 = alpineVariables
-distroVariables Alpine320 = alpineVariables
-distroVariables Centos7 = mconcat [
+distroVariables :: Arch -> LinuxDistro -> Variables
+distroVariables arch Alpine312 = alpineVariables arch
+distroVariables arch Alpine318 = alpineVariables arch
+distroVariables arch Alpine320 = alpineVariables arch
+distroVariables _ Centos7 = mconcat [
"HADRIAN_ARGS" =: "--docs=no-sphinx"
, "BROKEN_TESTS" =: "T22012" -- due to #23979
]
-distroVariables Fedora33 = mconcat
+distroVariables _ Fedora33 = mconcat
-- LLC/OPT do not work for some reason in our fedora images
-- These tests fail with this error: T11649 T5681 T7571 T8131b
-- +/opt/llvm/bin/opt: /lib64/libtinfo.so.5: no version information available (required by /opt/llvm/bin/opt)
@@ -467,7 +472,7 @@ distroVariables Fedora33 = mconcat
[ "LLC" =: "/bin/false"
, "OPT" =: "/bin/false"
]
-distroVariables _ = mempty
+distroVariables _ _ = mempty
-----------------------------------------------------------------------------
-- Cache settings, what to cache and when can we share the cache
=====================================
.gitlab/jobs.yaml
=====================================
@@ -376,7 +376,7 @@
"BIN_DIST_NAME": "ghc-aarch64-linux-alpine3_18-validate",
"BROKEN_TESTS": "encoding004 T10458",
"BUILD_FLAVOUR": "validate",
- "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check",
+ "CONFIGURE_ARGS": "--disable-ld-override --enable-ignore-build-platform-mismatch --build=aarch64-unknown-linux --host=aarch64-unknown-linux --target=aarch64-unknown-linux --enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
"TEST_ENV": "aarch64-linux-alpine3_18-validate",
@@ -2933,7 +2933,7 @@
"BIN_DIST_NAME": "ghc-aarch64-linux-alpine3_18-release+no_split_sections",
"BROKEN_TESTS": "encoding004 T10458",
"BUILD_FLAVOUR": "release+no_split_sections",
- "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check",
+ "CONFIGURE_ARGS": "--disable-ld-override --enable-ignore-build-platform-mismatch --build=aarch64-unknown-linux --host=aarch64-unknown-linux --target=aarch64-unknown-linux --enable-strict-ghc-toolchain-check",
"HADRIAN_ARGS": "--hash-unit-ids",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check",
=====================================
.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
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -592,7 +592,8 @@ gHC_INTERNAL_BASE, gHC_INTERNAL_ENUM,
gHC_INTERNAL_ARROW, gHC_INTERNAL_DESUGAR, gHC_INTERNAL_RANDOM, gHC_INTERNAL_EXTS, gHC_INTERNAL_IS_LIST,
gHC_INTERNAL_CONTROL_EXCEPTION_BASE, gHC_INTERNAL_TYPEERROR, gHC_INTERNAL_TYPELITS, gHC_INTERNAL_TYPELITS_INTERNAL,
gHC_INTERNAL_TYPENATS, gHC_INTERNAL_TYPENATS_INTERNAL,
- gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR :: Module
+ gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR,
+ gHC_INTERNAL_JS_PRIM :: Module
gHC_INTERNAL_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Base")
gHC_INTERNAL_ENUM = mkGhcInternalModule (fsLit "GHC.Internal.Enum")
gHC_INTERNAL_GHCI = mkGhcInternalModule (fsLit "GHC.Internal.GHCi")
@@ -635,7 +636,7 @@ gHC_INTERNAL_RANDOM = mkGhcInternalModule (fsLit "GHC.Internal.S
gHC_INTERNAL_EXTS = mkGhcInternalModule (fsLit "GHC.Internal.Exts")
gHC_INTERNAL_IS_LIST = mkGhcInternalModule (fsLit "GHC.Internal.IsList")
gHC_INTERNAL_CONTROL_EXCEPTION_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Control.Exception.Base")
-gHC_INTERNAL_EXCEPTION_CONTEXT = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context")
+gHC_INTERNAL_EXCEPTION_CONTEXT = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context")
gHC_INTERNAL_GENERICS = mkGhcInternalModule (fsLit "GHC.Internal.Generics")
gHC_INTERNAL_TYPEERROR = mkGhcInternalModule (fsLit "GHC.Internal.TypeError")
gHC_INTERNAL_TYPELITS = mkGhcInternalModule (fsLit "GHC.Internal.TypeLits")
@@ -646,6 +647,8 @@ gHC_INTERNAL_DATA_COERCE = mkGhcInternalModule (fsLit "GHC.Internal.D
gHC_INTERNAL_DEBUG_TRACE = mkGhcInternalModule (fsLit "GHC.Internal.Debug.Trace")
gHC_INTERNAL_UNSAFE_COERCE = mkGhcInternalModule (fsLit "GHC.Internal.Unsafe.Coerce")
gHC_INTERNAL_FOREIGN_C_CONSTPTR = mkGhcInternalModule (fsLit "GHC.Internal.Foreign.C.ConstPtr")
+gHC_INTERNAL_JS_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.JS.Prim")
+gHC_INTERNAL_WASM_PRIM_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types")
gHC_INTERNAL_SRCLOC :: Module
gHC_INTERNAL_SRCLOC = mkGhcInternalModule (fsLit "GHC.Internal.SrcLoc")
@@ -1679,7 +1682,10 @@ constPtrConName =
tcQual gHC_INTERNAL_FOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey
jsvalTyConName :: Name
-jsvalTyConName = tcQual (mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types")) (fsLit "JSVal") jsvalTyConKey
+jsvalTyConName = tcQual gHC_INTERNAL_WASM_PRIM_TYPES (fsLit "JSVal") jsvalTyConKey
+
+unsafeUnpackJSStringUtf8ShShName :: Name
+unsafeUnpackJSStringUtf8ShShName = varQual gHC_INTERNAL_JS_PRIM (fsLit "unsafeUnpackJSStringUtf8##") unsafeUnpackJSStringUtf8ShShKey
{-
************************************************************************
@@ -2082,6 +2088,7 @@ typeSymbolKindConNameKey, typeCharKindConNameKey,
, typeNatLogTyFamNameKey
, typeConsSymbolTyFamNameKey, typeUnconsSymbolTyFamNameKey
, typeCharToNatTyFamNameKey, typeNatToCharTyFamNameKey
+ , exceptionContextTyConKey, unsafeUnpackJSStringUtf8ShShKey
:: Unique
typeSymbolKindConNameKey = mkPreludeTyConUnique 400
typeCharKindConNameKey = mkPreludeTyConUnique 401
@@ -2104,9 +2111,10 @@ constPtrTyConKey = mkPreludeTyConUnique 417
jsvalTyConKey = mkPreludeTyConUnique 418
-exceptionContextTyConKey :: Unique
exceptionContextTyConKey = mkPreludeTyConUnique 420
+unsafeUnpackJSStringUtf8ShShKey = mkPreludeMiscIdUnique 805
+
{-
************************************************************************
* *
=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
@@ -86,7 +87,6 @@ rtsApply cfg = jBlock
, moveRegs2
]
-
-- | Generate an application of some args to an Id.
--
-- The case where args is null is common as it's used to generate the evaluation
@@ -98,6 +98,23 @@ genApp
-> [StgArg]
-> G (JStgStat, ExprResult)
genApp ctx i args
+ -- See: https://github.com/ghcjs/ghcjs/blob/b7711fbca7c3f43a61f1dba526e6f2a2656ef44c/src/Gen2/Generator.hs#L876
+ -- Comment by Luite Stegeman <luite.stegeman at iohk.io>
+ -- Special cases for JSString literals.
+ -- We could handle unpackNBytes# here, but that's probably not common
+ -- enough to warrant a special case.
+ -- See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588/#note_503978
+ -- Comment by Jeffrey Young <jeffrey.young at iohk.io>
+ -- We detect if the Id is unsafeUnpackJSStringUtf8## applied to a string literal,
+ -- if so then we convert the unsafeUnpack to a call to h$decode.
+ | [StgVarArg v] <- args
+ , idName i == unsafeUnpackJSStringUtf8ShShName
+ -- See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588
+ -- Comment by Josh Meredith <josh.meredith at iohk.io>
+ -- `typex_expr` can throw an error for certain bindings so it's important
+ -- that this condition comes after matching on the function name
+ , [top] <- concatMap typex_expr (ctxTarget ctx)
+ = (,ExprInline) . (|=) top . app hdDecodeUtf8Z <$> varsForId v
-- let-no-escape
| Just n <- ctxLneBindingStackSize ctx i
=====================================
compiler/GHC/StgToJS/Symbols.hs
=====================================
@@ -1212,3 +1212,8 @@ hdStlStr = fsLit "h$stl"
hdStiStr :: FastString
hdStiStr = fsLit "h$sti"
+
+------------------------------ Pack/Unpack --------------------------------------------
+
+hdDecodeUtf8Z :: FastString
+hdDecodeUtf8Z = fsLit "h$decodeUtf8z"
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -237,7 +237,15 @@ rnExports explicit_mod exports
Nothing -> Nothing
Just _ -> map drop_defaults <$> rn_exports
, tcg_default_exports = case exports of
- Nothing -> filterDefaultEnv ((Just this_mod ==) . cd_module) defaults
+ Nothing ->
+ if xopt LangExt.NamedDefaults dflags then
+ -- NamedDefaults on: implicitly export the defaults declared in this module.
+ -- Test case: default/DefaultImport04.hs
+ filterDefaultEnv ((Just this_mod ==) . cd_module) defaults
+ else
+ -- NamedDefaults off: do not export any defaults (fixes #25206).
+ -- Test case: default/T25206.hs
+ emptyDefaultEnv
_ -> foldMap (foldMap sndOf3) rn_exports
, tcg_dus = tcg_dus tcg_env `plusDU`
usesOnly final_ns
=====================================
configure.ac
=====================================
@@ -111,6 +111,14 @@ AC_ARG_ENABLE(bootstrap-with-devel-snapshot,
[EnableBootstrapWithDevelSnaphost=NO]
)
+AC_ARG_ENABLE(ignore-build-platform-mismatch,
+[AS_HELP_STRING([--ignore-build-platform-mismatch],
+ [Ignore when the target platform reported by the bootstrap compiler doesn''t match the configured build platform. This flag is used to correct mistakes when the target platform is incorrectly reported by the bootstrap (#25200). ])],
+ [FP_CAPITALIZE_YES_NO(["$enableval"], [IgnoreBuildPlatformMismatch])],
+ [IgnoreBuildPlatformMismatch=NO]
+)
+
+
AC_ARG_ENABLE(tarballs-autodownload,
[AS_HELP_STRING([--enable-tarballs-autodownload],
[Automatically download Windows distribution binaries if needed.])],
@@ -279,10 +287,13 @@ FP_PROG_SH
# code for the requested build platform.
if test "$BuildPlatform" != "$bootstrap_target"
then
+ if test "$IgnoreBuildPlatformMismatch" = "NO"
+ then
echo "This GHC (${WithGhc}) does not generate code for the build platform"
echo " GHC target platform : $bootstrap_target"
echo " Desired build platform : $BuildPlatform"
exit 1
+ fi
fi
dnl ** Do an unregisterised build?
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -223,3 +223,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
=====================================
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/jsbits/base.js
=====================================
@@ -138,6 +138,126 @@ function h$base_fstat(fd, stat, stat_off, c) {
h$unsupported(-1, c);
}
+function h$stat(path, path_off, stat, stat_off) {
+#ifndef GHCJS_BROWSER
+ if(h$isNode()) {
+ try {
+ var stats = h$fs.statSync(h$decodeUtf8z(path, path_off));
+ h$base_fillStat(stats, stat, stat_off);
+ return 0;
+ } catch(e) {
+ h$setErrno(e);
+ return -1;
+ }
+ }
+ else
+#endif
+ h$unsupported(-1);
+}
+
+function h$lstat(path, path_off, stat, stat_off) {
+#ifndef GHCJS_BROWSER
+ if(h$isNode()) {
+ try {
+ var stats = h$fs.lstatSync(h$decodeUtf8z(path, path_off));
+ h$base_fillStat(stats, stat, stat_off);
+ return 0;
+ } catch(e) {
+ h$setErrno(e);
+ return -1;
+ }
+ }
+ else
+#endif
+ h$unsupported(-1);
+}
+
+function h$fstatat(dirfd, path, path_off, stat, stat_off, flag) {
+#ifndef GHCJS_BROWSER
+ if(h$isNode()) {
+ var fp = h$calculate_at(dirfd, path, path_off);
+ try {
+ if (flag & h$base_at_symlink_nofollow) {
+ var fs = h$fs.lstatSync(fp);
+ h$base_fillStat(fs, stat, stat_off);
+ return 0;
+ }
+ else {
+ var fs = h$fs.statSync(fp);
+ h$base_fillStat(fs, stat, stat_off);
+ return 0;
+ }
+
+ } catch(e) {
+ h$setErrno(e);
+ return -1;
+ }
+ }
+#endif
+
+ return h$unsupported(-1);
+}
+
+function h$unlinkat(dirfd, path, path_off, flag) {
+#ifndef GHCJS_BROWSER
+ if(h$isNode()) {
+ var fp = h$calculate_at(dirfd, path, path_off);
+ try {
+ if (flag & h$base_at_removedir) {
+ h$fs.rmdirSync(fp);
+ return 0;
+ }
+ else {
+ h$fs.unlinkSync(fp);
+ return 0;
+ }
+
+ } catch(e) {
+ h$setErrno(e);
+ return -1;
+ }
+ }
+#endif
+
+ return h$unsupported(-1);
+}
+
+function h$dup(fd) {
+#ifndef GHCJS_BROWSER
+ if(h$isNode()) {
+ try {
+ // NodeJS doesn't provide "dup" (see
+ // https://github.com/nodejs/node/issues/41733), so we do this hack that
+ // probably only works on Linux.
+ return h$fs.openSync("/proc/self/fd/"+fd);
+ } catch(e) {
+ h$setErrno(e);
+ return -1;
+ }
+ }
+ else
+#endif
+ h$unsupported(-1);
+}
+
+function h$fdopendir(fd) {
+#ifndef GHCJS_BROWSER
+ if(h$isNode()) {
+ try {
+ // NodeJS doesn't provide "fdopendir", so we do this hack that probably
+ // only works on Linux.
+ return h$fs.opendirSync("/proc/self/fd/"+fd);
+ } catch(e) {
+ h$setErrno(e);
+ return -1;
+ }
+ }
+ else
+#endif
+ h$unsupported(-1);
+}
+
+
function h$base_isatty(fd) {
TRACE_IO("base_isatty " + fd)
// return 1; // fixme debug
@@ -333,25 +453,55 @@ function h$realpath(path,off,resolved,resolved_off) {
h$unsupported(-1);
}
-function h$base_open(file, file_off, how, mode, c) {
- return h$open(file,file_off,how,mode,c);
+function h$path_is_abs(path) {
+ return path.charAt(0) === '/';
}
-function h$openat(dirfd, file, file_off, how, mode) {
- if (dirfd != h$base_at_fdcwd) {
- // we only support AT_FDWCD (open) until NodeJS provides "openat"
- return h$unsupported(-1);
+function h$path_join2(p1,p2) {
+ // Emscripten would normalize the path here. We don't for now.
+ return (p1 + '/' + p2);
+}
+
+// Compute path from a FD and a path
+function h$calculate_at(dirfd, file, file_off) {
+ var path = h$decodeUtf8z(file,file_off);
+
+ if (h$path_is_abs(path)) {
+ return path;
+ }
+
+ // relative path
+ var dir;
+ if (dirfd == h$base_at_fdcwd) {
+ dir = h$process.cwd();
}
+#ifndef GHCJS_BROWSER
+ else if (h$isNode()) {
+ // hack that probably only works on Linux with /proc mounted
+ dir = h$fs.readlinkSync("/proc/self/fd/"+dirfd);
+ }
+#endif
else {
- return h$open(file,file_off,how,mode,undefined);
+ return h$unsupported(-1);
}
+
+ return h$path_join2(dir,path);
+}
+
+function h$openat(dirfd, file, file_off, how, mode, c) {
+ var path = h$calculate_at(dirfd, file, file_off);
+ return h$base_open(path, how, mode, c);
+}
+
+function h$open(file, file_off, how, mode, c) {
+ var path = h$decodeUtf8z(file, file_off);
+ return h$base_open(path, how, mode, c);
}
-function h$open(file, file_off, how, mode,c) {
+function h$base_open(fp, how, mode, c) {
#ifndef GHCJS_BROWSER
if(h$isNode()) {
var flags, off;
- var fp = h$decodeUtf8z(file, file_off);
TRACE_IO("open: " + fp)
var acc = how & h$base_o_accmode;
// passing a number lets node.js use it directly as the flags (undocumented)
@@ -586,6 +736,9 @@ const h$base_o_noctty = 0x20000;
const h$base_o_nonblock = 0x00004;
const h$base_o_binary = 0x00000;
const h$base_at_fdcwd = -100;
+const h$base_at_symlink_nofollow = 0x100;
+const h$base_at_removedir = 0x200;
+const h$base_at_symlink_follow = 0x400;
function h$base_stat_check_mode(mode,p) {
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
=====================================
@@ -537,11 +537,11 @@ foreign import javascript interruptible "h$base_lseek"
c_lseek :: CInt -> COff -> CInt -> IO COff
foreign import javascript interruptible "h$base_lstat"
lstat :: CFilePath -> Ptr CStat -> IO CInt
-foreign import javascript interruptible "h$base_open"
+foreign import javascript interruptible "h$open"
c_open :: CFilePath -> CInt -> CMode -> IO CInt
-foreign import javascript interruptible "h$base_open"
+foreign import javascript interruptible "h$open"
c_interruptible_open_ :: CFilePath -> CInt -> CMode -> IO CInt
-foreign import javascript interruptible "h$base_open"
+foreign import javascript interruptible "h$open"
c_safe_open_ :: CFilePath -> CInt -> CMode -> IO CInt
foreign import javascript interruptible "h$base_read"
c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
=====================================
rts/linker/PEi386.c
=====================================
@@ -456,10 +456,12 @@ static OpenedDLL* opened_dlls = NULL;
/* Adds a DLL instance to the list of DLLs in which to search for symbols. */
static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
+ IF_DEBUG(linker, debugBelch("addDLLHandle(%" PATH_FMT ")...\n", dll_name));
/* At this point, we actually know what was loaded.
So bail out if it's already been loaded. */
if (checkIfDllLoaded(instance))
{
+ IF_DEBUG(linker, debugBelch("already loaded: addDLLHandle(%" PATH_FMT ")\n", dll_name));
return;
}
@@ -505,6 +507,7 @@ static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
stgFree(module);
imports++;
} while (imports->Name);
+ IF_DEBUG(linker, debugBelch("done: addDLLHandle(%" PATH_FMT ")\n", dll_name));
}
static OpenedDLL* findLoadedDll(HINSTANCE instance)
=====================================
testsuite/tests/default/T25206.hs
=====================================
@@ -0,0 +1,7 @@
+module T25206 where
+
+import T25206_helper ()
+
+mod1 x = pf
+ where
+ (_,pf) = properFraction x
=====================================
testsuite/tests/default/T25206.stderr
=====================================
@@ -0,0 +1,2 @@
+[1 of 2] Compiling T25206_helper ( T25206_helper.hs, T25206_helper.o )
+[2 of 2] Compiling T25206 ( T25206.hs, T25206.o )
=====================================
testsuite/tests/default/T25206_helper.hs
=====================================
@@ -0,0 +1,3 @@
+module T25206_helper where
+
+default (Rational)
=====================================
testsuite/tests/default/all.T
=====================================
@@ -30,3 +30,4 @@ test('default-fail05', normal, compile_fail, [''])
test('default-fail06', normal, compile_fail, [''])
test('default-fail07', normal, compile_fail, [''])
test('default-fail08', normal, compile_fail, [''])
+test('T25206', [extra_files(['T25206_helper.hs'])], multimod_compile, ['T25206', ''])
=====================================
testsuite/tests/javascript/Makefile
=====================================
@@ -7,3 +7,9 @@ T24495:
./T24495
# check that the optimization occurred
grep -c appendToHsStringA T24495.dump-js
+
+T23479:
+ '$(TEST_HC)' $(TEST_HC_OPTS) T23479.hs -v0 -O1 -dsuppress-uniques -ddump-js -ddump-to-file
+ ./T23479
+ # check that the optimization occurred
+ grep -c " h\$$decodeUtf8z" T23479.dump-js
=====================================
testsuite/tests/javascript/T23479.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE MagicHash #-}
+
+import GHC.Prim
+
+import GHC.JS.Prim
+
+foreign import javascript "((x) => { console.log(x); })"
+ js_log1 :: JSVal -> IO ()
+
+main :: IO ()
+main = do
+ js_log1 (JSVal (unsafeUnpackJSStringUtf8## test_addr_1))
+ where
+ test_addr_1 :: Addr#
+ test_addr_1 = "test_val_1"#
=====================================
testsuite/tests/javascript/T23479.stdout
=====================================
@@ -0,0 +1,2 @@
+test_val_1
+1
=====================================
testsuite/tests/javascript/all.T
=====================================
@@ -22,3 +22,5 @@ test('T23346', normal, compile_and_run, [''])
test('T22455', normal, compile_and_run, ['-ddisable-js-minifier'])
test('T23565', normal, compile_and_run, [''])
test('T24495', normal, makefile_test, ['T24495'])
+
+test('T23479', normal, makefile_test, ['T23479'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ee4a8c01dfa60b7ccb3cf414d2d52c22cdb1ce...04716d31711ab5c7f9594dffd803a81b0d98cc94
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ee4a8c01dfa60b7ccb3cf414d2d52c22cdb1ce...04716d31711ab5c7f9594dffd803a81b0d98cc94
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/20240828/2dcfbcea/attachment-0001.html>
More information about the ghc-commits
mailing list