[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: rts/RtsFlags: Refactor size parsing
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Nov 14 07:44:21 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
63467c3c by Ben Gamari at 2024-11-14T02:44:00-05:00
rts/RtsFlags: Refactor size parsing
This makes a number of improvements mentioned in #20201:
* fail if the argument cannot be parsed as a number (`-Mturtles`)
* fail if an unrecognized unit is given (e.g. `-M1x`)
- - - - -
550b99a5 by Ben Gamari at 2024-11-14T02:44:00-05:00
testsuite: Add tests for RTS flag parsing error handling
See #20201.
- - - - -
646d2e4c by Ryan Scott at 2024-11-14T02:44:00-05:00
Add regression test for #16234
Issue #16234 was likely fixed by !9765. This adds a regression test to ensure
that it remains fixed.
Fixes #16234.
- - - - -
a3cf00d4 by Ben Gamari at 2024-11-14T02:44:01-05:00
configure: Accept happy-2.1.2
happy-2.1 was released in late Oct 2024. I have confirmed that master
bootstraps with it. Here we teach configure to accept this tool.
Fixes #25438.
- - - - -
7bb9a5e7 by Cheng Shao at 2024-11-14T02:44:02-05:00
misc: improve clangd compile_flags.txt flags
This patch improves the compile_flags.txt config used to power clangd
for the rts C codebase. The flags in the file are sampled & deduped
from a real stage1 build with clang-19 and vastly improves the IDE
accuracy when hacking the rts.
For maximum code coverage under the default settings,
compile_flags.txt defaults to threaded+profiled+dynamic+debug way.
This does not mean profdyn needs to be actually built in _build/stage1
for IDE to work. To activate IDE for other RTS ways, simply remove one
of the -D flags at the end of compile_flags.txt and restart clangd.
- - - - -
3381649b by Cheng Shao at 2024-11-14T02:44:02-05:00
testsuite: add regression test T25473
This commit adds regression test T25473 marked as broken due to #25473.
It will be fixed in the subsequent commit.
- - - - -
31ff157f by Cheng Shao at 2024-11-14T02:44:02-05:00
wasm: fix foreign import javascript "wrapper" in TH/ghci
This patch fixes foreign import javascript "wrapper" in wasm backend's
TH/ghci by fixing the handling of dyld/finalization_registry magic
variables. Fixes T25473 and closes #25473.
- - - - -
23 changed files:
- compile_flags.txt
- libraries/ghci/GHCi/ObjLink.hs
- m4/fptools_happy.m4
- rts/RtsFlags.c
- + testsuite/tests/rts/T20201a.hs
- + testsuite/tests/rts/T20201a.stderr
- + testsuite/tests/rts/T20201b.hs
- + testsuite/tests/rts/T20201b.stderr
- testsuite/tests/rts/all.T
- + testsuite/tests/th/wasm/T25473A.hs
- + testsuite/tests/th/wasm/T25473B.hs
- + testsuite/tests/th/wasm/all.T
- + testsuite/tests/typecheck/should_compile/T16234/ControlMonadClasses.hs
- + testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesCore.hs
- + testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesEffects.hs
- + testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesReader.hs
- + testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesState.hs
- + testsuite/tests/typecheck/should_compile/T16234/ControlMonadPrimitive.hs
- + testsuite/tests/typecheck/should_compile/T16234/DataPeano.hs
- + testsuite/tests/typecheck/should_compile/T16234/Main.hs
- + testsuite/tests/typecheck/should_compile/T16234/Makefile
- + testsuite/tests/typecheck/should_compile/T16234/all.T
- utils/jsffi/dyld.mjs
Changes:
=====================================
compile_flags.txt
=====================================
@@ -1,5 +1,29 @@
--xc
--Irts
+-Wimplicit
+-include
+rts/include/ghcversion.h
-Irts/include
--I.hie-bios/stage0/lib
--I_build/stage1/rts/build/include/
+-I_build/stage1/rts/build
+-I_build/stage1/rts/build/include
+-Irts
+-Ilibraries/ghc-internal/include
+-I_build/stage1/libraries/ghc-internal/build/include
+-Ilibraries/ghc-bignum/include
+-I_build/stage1/libraries/ghc-bignum/build/include
+-Wno-unknown-pragmas
+-Wall
+-Wextra
+-Wstrict-prototypes
+-Wmissing-prototypes
+-Wmissing-declarations
+-Winline
+-Wpointer-arith
+-Wmissing-noreturn
+-Wnested-externs
+-Wredundant-decls
+-Wundef
+-DFS_NAMESPACE=rts
+-DCOMPILING_RTS
+-DTHREADED_RTS
+-DDEBUG
+-DDYNAMIC
+-DPROFILING
=====================================
libraries/ghci/GHCi/ObjLink.hs
=====================================
@@ -76,7 +76,7 @@ loadDLL f =
evaluate =<< js_loadDLL (toJSString f)
pure $ Right nullPtr
-foreign import javascript safe "__exports.__dyld.loadDLL($1)"
+foreign import javascript safe "__ghc_wasm_jsffi_dyld.loadDLL($1)"
js_loadDLL :: JSString -> IO ()
loadArchive :: String -> IO ()
@@ -96,7 +96,7 @@ lookupSymbol sym = do
r <- js_lookupSymbol $ toJSString sym
evaluate $ if r == nullPtr then Nothing else Just r
-foreign import javascript unsafe "__exports.__dyld.lookupSymbol($1)"
+foreign import javascript unsafe "__ghc_wasm_jsffi_dyld.lookupSymbol($1)"
js_lookupSymbol :: JSString -> IO (Ptr a)
lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a))
@@ -114,7 +114,7 @@ addLibrarySearchPath p = do
evaluate =<< js_addLibrarySearchPath (toJSString p)
pure nullPtr
-foreign import javascript safe "__exports.__dyld.addLibrarySearchPath($1)"
+foreign import javascript safe "__ghc_wasm_jsffi_dyld.addLibrarySearchPath($1)"
js_addLibrarySearchPath :: JSString -> IO ()
removeLibrarySearchPath :: Ptr () -> IO Bool
@@ -128,7 +128,7 @@ findSystemLibrary f = m `catch` \(_ :: JSException) -> pure Nothing
p <- evaluate $ fromJSString p'
pure $ Just p
-foreign import javascript safe "__exports.__dyld.findSystemLibrary($1)"
+foreign import javascript safe "__ghc_wasm_jsffi_dyld.findSystemLibrary($1)"
js_findSystemLibrary :: JSString -> IO JSString
#else
=====================================
m4/fptools_happy.m4
=====================================
@@ -24,13 +24,13 @@ changequote([, ])dnl
])
if test ! -f compiler/GHC/Parser.hs || test ! -f compiler/GHC/Cmm/Parser.hs
then
- failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.1 is required to compile GHC"
+ failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.2 is required to compile GHC"
FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.20.0],
[AC_MSG_ERROR([$failure_msg])])[]
FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[1.21.0],
FP_COMPARE_VERSIONS([$fptools_cv_happy_version], [-le], [2.0.1],
[AC_MSG_ERROR([$failure_msg])])[])[]
- FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[2.1.0],
+ FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[2.2.0],
[AC_MSG_ERROR([$failure_msg])])[]
fi
=====================================
rts/RtsFlags.c
=====================================
@@ -2148,7 +2148,6 @@ static void initStatsFile (FILE *f)
static StgWord64
decodeSize(const char *flag, uint32_t offset, StgWord64 min, StgWord64 max)
{
- char c;
const char *s;
StgDouble m;
StgWord64 val;
@@ -2161,19 +2160,47 @@ decodeSize(const char *flag, uint32_t offset, StgWord64 min, StgWord64 max)
}
else
{
- m = atof(s);
- c = s[strlen(s)-1];
-
- if (c == 't' || c == 'T')
- m *= (StgWord64)1024*1024*1024*1024;
- else if (c == 'g' || c == 'G')
- m *= 1024*1024*1024;
- else if (c == 'm' || c == 'M')
- m *= 1024*1024;
- else if (c == 'k' || c == 'K')
- m *= 1024;
- else if (c == 'w' || c == 'W')
- m *= sizeof(W_);
+ char *end;
+ m = strtod(s, &end);
+
+ if (end == s) {
+ errorBelch("error in RTS option %s: unable to parse number '%s'", flag, s);
+ stg_exit(EXIT_FAILURE);
+ }
+
+ StgWord64 unit;
+ switch (*end) {
+ case 't':
+ case 'T':
+ unit = (StgWord64)1024*1024*1024*1024;
+ break;
+ case 'g':
+ case 'G':
+ unit = 1024*1024*1024;
+ break;
+ case 'm':
+ case 'M':
+ unit = 1024*1024;
+ break;
+ case 'k':
+ case 'K':
+ unit = 1024;
+ break;
+ case 'w':
+ case 'W':
+ unit = sizeof(W_);
+ break;
+ case 'b':
+ case 'B':
+ case '\0':
+ unit = 1;
+ break;
+ default:
+ errorBelch("error in RTS option %s: unknown unit suffix '%c'", flag, *end);
+ stg_exit(EXIT_FAILURE);
+ }
+
+ m *= unit;
}
val = (StgWord64)m;
=====================================
testsuite/tests/rts/T20201a.hs
=====================================
@@ -0,0 +1 @@
+main = putStrLn "hi"
=====================================
testsuite/tests/rts/T20201a.stderr
=====================================
@@ -0,0 +1 @@
+T20201a: error in RTS option -AturtlesM: unable to parse number 'turtlesM'
=====================================
testsuite/tests/rts/T20201b.hs
=====================================
@@ -0,0 +1,2 @@
+main = putStrLn "hi"
+
=====================================
testsuite/tests/rts/T20201b.stderr
=====================================
@@ -0,0 +1 @@
+T20201b: error in RTS option -A64z: unknown unit suffix 'z'
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -587,6 +587,9 @@ test('decodeMyStack_emptyListForMissingFlag',
, js_broken(22261) # cloneMyStack# not yet implemented
], compile_and_run, [''])
+test('T20201a', exit_code(1), compile_and_run, ['-with-rtsopts -AturtlesM'])
+test('T20201b', exit_code(1), compile_and_run, ['-with-rtsopts -A64z'])
+
test('T22012', [js_skip, extra_ways(['ghci'])], compile_and_run, ['T22012_c.c'])
# Skip for JS platform as the JS RTS is always single threaded
=====================================
testsuite/tests/th/wasm/T25473A.hs
=====================================
@@ -0,0 +1,8 @@
+module T25473A where
+
+import GHC.Wasm.Prim
+
+type BinOp a = a -> a -> a
+
+foreign import javascript "wrapper"
+ mkJSBinOp :: BinOp Int -> IO JSVal
=====================================
testsuite/tests/th/wasm/T25473B.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T25473B where
+
+import Language.Haskell.TH
+import T25473A
+
+$(runIO $ do
+ _ <- mkJSBinOp (+)
+ pure [])
=====================================
testsuite/tests/th/wasm/all.T
=====================================
@@ -0,0 +1,5 @@
+setTestOpts([
+ unless(arch('wasm32'), skip)
+])
+
+test('T25473', [], multimod_compile, ['T25473B', '-v0'])
=====================================
testsuite/tests/typecheck/should_compile/T16234/ControlMonadClasses.hs
=====================================
@@ -0,0 +1,7 @@
+module ControlMonadClasses
+ ( -- * Reader
+ MonadReader
+ ) where
+
+import ControlMonadClassesReader
+import ControlMonadClassesState ()
=====================================
testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesCore.hs
=====================================
@@ -0,0 +1,23 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+module ControlMonadClassesCore where
+
+import Data.Kind (Type)
+import DataPeano
+
+type family CanDo (m :: Type -> Type) (eff :: k) :: Bool
+
+type family MapCanDo (eff :: k) (stack :: Type -> Type) :: [Bool] where
+ MapCanDo eff (t m) = CanDo (t m) eff ': MapCanDo eff m
+ MapCanDo eff m = '[ CanDo m eff ]
+
+type family FindTrue
+ (bs :: [Bool])
+ :: Peano
+ where
+ FindTrue ('True ': t) = 'Zero
+ FindTrue ('False ': t) = 'Succ (FindTrue t)
+
+type Find eff (m :: Type -> Type) =
+ FindTrue (MapCanDo eff m)
=====================================
testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesEffects.hs
=====================================
@@ -0,0 +1,5 @@
+module ControlMonadClassesEffects where
+
+import Data.Kind (Type)
+
+data EffReader (e :: Type)
=====================================
testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesReader.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+module ControlMonadClassesReader where
+
+import qualified Control.Monad.Trans.State.Lazy as SL
+import ControlMonadClassesCore
+import ControlMonadClassesEffects
+import Control.Monad.Trans.Class
+import Data.Kind (Type)
+import DataPeano
+
+class Monad m => MonadReaderN (n :: Peano) (r :: Type) m
+instance Monad m => MonadReaderN 'Zero r (SL.StateT r m)
+instance (MonadTrans t, Monad (t m), MonadReaderN n r m, Monad m)
+ => MonadReaderN ('Succ n) r (t m)
+
+type MonadReader e m = MonadReaderN (Find (EffReader e) m) e m
=====================================
testsuite/tests/typecheck/should_compile/T16234/ControlMonadClassesState.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+module ControlMonadClassesState where
+
+import qualified Control.Monad.Trans.State.Lazy as SL
+import ControlMonadClassesCore
+import ControlMonadClassesEffects
+
+type instance CanDo (SL.StateT s m) eff = StateCanDo s eff
+
+type family StateCanDo s eff where
+ StateCanDo s (EffReader s) = 'True
+ StateCanDo s eff = 'False
=====================================
testsuite/tests/typecheck/should_compile/T16234/ControlMonadPrimitive.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeFamilies #-}
+module ControlMonadPrimitive (PrimMonad(..)) where
+
+import Control.Monad.Trans.State (StateT)
+
+class Monad m => PrimMonad m where
+ type PrimState m
+instance PrimMonad m => PrimMonad (StateT s m) where
+ type PrimState (StateT s m) = PrimState m
=====================================
testsuite/tests/typecheck/should_compile/T16234/DataPeano.hs
=====================================
@@ -0,0 +1,3 @@
+module DataPeano where
+
+data Peano = Zero | Succ Peano
=====================================
testsuite/tests/typecheck/should_compile/T16234/Main.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeFamilies #-}
+module Main where
+
+import ControlMonadClasses (MonadReader)
+--import ControlMonadPrimitive ()
+import Control.Monad.Trans.State.Lazy (StateT)
+
+main :: (n ~ StateT () IO, MonadReader () n) => IO ()
+main = undefined
=====================================
testsuite/tests/typecheck/should_compile/T16234/Makefile
=====================================
@@ -0,0 +1,17 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean:
+ rm -f *.o *.hi
+
+T16234:
+ $(MAKE) -s --no-print-directory clean
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c DataPeano.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c ControlMonadPrimitive.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c ControlMonadClassesCore.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c ControlMonadClassesEffects.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c ControlMonadClassesReader.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c ControlMonadClassesState.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c ControlMonadClasses.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c Main.hs
=====================================
testsuite/tests/typecheck/should_compile/T16234/all.T
=====================================
@@ -0,0 +1 @@
+test('T16234', [extra_files(['DataPeano.hs', 'ControlMonadPrimitive.hs', 'ControlMonadClassesCore.hs', 'ControlMonadClassesEffects.hs', 'ControlMonadClassesReader.hs', 'ControlMonadClassesState.hs', 'ControlMonadClasses.hs', 'Main.hs'])], makefile_test, ['T16234'])
=====================================
utils/jsffi/dyld.mjs
=====================================
@@ -293,9 +293,13 @@ class DyLD {
#loadedSos = new Set();
// Mapping from export names to export funcs. It's also passed as
- // __exports in JSFFI code, hence the "memory" special field. __dyld
- // is used by ghci to call into here.
- exportFuncs = { memory: this.#memory, __dyld: this };
+ // __exports in JSFFI code, hence the "memory" special field.
+ exportFuncs = { memory: this.#memory };
+
+ // The FinalizationRegistry used by JSFFI.
+ #finalizationRegistry = new FinalizationRegistry((sp) =>
+ this.exportFuncs.rts_freeStablePtr(sp)
+ );
// The GOT.func table.
#gotFunc = {};
@@ -623,17 +627,22 @@ class DyLD {
const mod = await modp;
- // Fulfill the ghc_wasm_jsffi imports
+ // Fulfill the ghc_wasm_jsffi imports. Use new Function()
+ // instead of eval() to prevent bindings in this local scope to
+ // be accessed by JSFFI code snippets.
Object.assign(
import_obj.ghc_wasm_jsffi,
new Function(
- "return (__exports) => ({".concat(
+ "__exports",
+ "__ghc_wasm_jsffi_dyld",
+ "__ghc_wasm_jsffi_finalization_registry",
+ "return {".concat(
...parseSections(mod).map(
(rec) => `${rec[0]}: ${parseRecord(rec)}, `
),
- "});"
+ "};"
)
- )()(this.exportFuncs)
+ )(this.exportFuncs, this, this.#finalizationRegistry)
);
// Fulfill the rest of the imports
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58c591e44e5bc22c151a9a5b08881c45cd44ffb0...31ff157fc624bd8e0442f5fecfdd10a93346a525
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58c591e44e5bc22c151a9a5b08881c45cd44ffb0...31ff157fc624bd8e0442f5fecfdd10a93346a525
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/20241114/079319d2/attachment-0001.html>
More information about the ghc-commits
mailing list