From b6175e4296e3a9d49042bc127d383ede695f3967 Mon Sep 17 00:00:00 2001 From: ML Date: Fri, 7 Apr 2023 21:09:02 -0400 Subject: [PATCH 01/29] Add `keep-syntax` and `keep-syntax!` functions These functions are designed to make it easier to properly preserve the sourcemap and tuple type in macros. This commit also modifies the threading macros to make use of these functions. --- src/boot/boot.janet | 36 ++++++++++++++++++++++++++++-------- test/suite0010.janet | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 5ab4bc87..ae8477f0 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1232,6 +1232,29 @@ (,eprintf (,dyn :pretty-format "%q") ,s) ,s)) +(defn keep-syntax + ``Creates a tuple with the tuple type and sourcemap of `before` but the + elements of `after`. If either one of its argements is not a tuple, returns + `after` unmodified. Useful to preserve syntactic information when transforming + an ast in macros.`` + [before after] + (if (and (= :tuple (type before)) + (= :tuple (type after))) + (do + (def res (if (= :parens (tuple/type before)) + (tuple/slice after) + (tuple/brackets ;after))) + (tuple/setmap res ;(tuple/sourcemap before))) + after)) + +(defn keep-syntax! + ``Like `keep-syntax`, but if `after` is an array, it is coerced into a tuple. + Useful to preserve syntactic information when transforming an ast in macros.`` + [before after] + (keep-syntax before (if (= :array (type after)) + (tuple/slice after) + after))) + (defmacro -> ``Threading macro. Inserts x as the second value in the first form in `forms`, and inserts the modified first form into the second form @@ -1242,7 +1265,7 @@ (tuple (in n 0) (array/slice n 1)) (tuple n @[]))) (def parts (array/concat @[h last] t)) - (tuple/slice parts 0)) + (keep-syntax! n parts)) (reduce fop x forms)) (defmacro ->> @@ -1255,7 +1278,7 @@ (tuple (in n 0) (array/slice n 1)) (tuple n @[]))) (def parts (array/concat @[h] t @[last])) - (tuple/slice parts 0)) + (keep-syntax! n parts)) (reduce fop x forms)) (defmacro -?> @@ -1271,7 +1294,7 @@ (tuple n @[]))) (def sym (gensym)) (def parts (array/concat @[h sym] t)) - ~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0)))) + ~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts)))) (reduce fop x forms)) (defmacro -?>> @@ -1287,7 +1310,7 @@ (tuple n @[]))) (def sym (gensym)) (def parts (array/concat @[h] t @[sym])) - ~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0)))) + ~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts)))) (reduce fop x forms)) (defn- walk-ind [f form] @@ -1311,10 +1334,7 @@ :table (walk-dict f form) :struct (table/to-struct (walk-dict f form)) :array (walk-ind f form) - :tuple (let [x (walk-ind f form)] - (if (= :parens (tuple/type form)) - (tuple/slice x) - (tuple/brackets ;x))) + :tuple (keep-syntax! form (walk-ind f form)) form)) (defn postwalk diff --git a/test/suite0010.janet b/test/suite0010.janet index e3db6818..5ac0cd16 100644 --- a/test/suite0010.janet +++ b/test/suite0010.janet @@ -44,6 +44,43 @@ (assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple") (assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array") +# Sourcemaps in threading macros +(defn check-threading [macro expansion] + (def expanded (macex1 (tuple macro 0 '(x) '(y)))) + (assert (= expanded expansion) (string macro " expansion value")) + (def smap-x (tuple/sourcemap (get expanded 1))) + (def smap-y (tuple/sourcemap expanded)) + (def line first) + (defn column [t] (t 1)) + (assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence")) + (assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence")) + (assert (or (< (line smap-x) (line smap-y)) + (and (= (line smap-x) (line smap-y)) + (< (column smap-x) (column smap-y)))) + (string macro " relation between x and y sourcemap"))) + +(check-threading '-> '(y (x 0))) +(check-threading '->> '(y (x 0))) + +# keep-syntax +(let [brak '[1 2 3] + par '(1 2 3)] + + (tuple/setmap brak 2 1) + + (assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3]) "keep-syntax brackets ignore array") + (assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3]) "keep-syntax! brackets replace array") + + (assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4)) "keep-syntax! parens coerce array") + (assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3)) "keep-syntax! brackets not parens") + (assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3]) "keep-syntax! parens not brackets") + (assert (= (tuple/sourcemap brak) + (tuple/sourcemap (keep-syntax! brak @[1 2 3]))) "keep-syntax! brackets source map") + + (keep-syntax par brak) + (assert (not= (tuple/sourcemap brak) (tuple/sourcemap par)) "keep-syntax no mutate") + (assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type")) + # Cancel test (def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti)) (assert (= 1 (resume f)) "cancel resume 1") From f3192303ab562b3b21a73faa1267bf85173d0e5a Mon Sep 17 00:00:00 2001 From: Chloe Kudryavtsev Date: Wed, 19 Apr 2023 12:55:25 -0400 Subject: [PATCH 02/29] check for NULL in get_fmt_mapping (fixes #1105) When there is no format to be found after a %, get_fmt_mapping returns NULL. It then gets called against strlen, which is a typical SEGV. Check for NULL aginst mapping, which signals a null format being specified. --- src/core/pp.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/pp.c b/src/core/pp.c index cd545ad1..d55b8536 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -811,6 +811,7 @@ static const char *scanformat( while (p2 <= p) { if (strchr(FMT_REPLACE_INTTYPES, *p2) != NULL) { const char *mapping = get_fmt_mapping(*p2++); + if (!mapping) janet_panic("invalid format (found null)"); size_t len = strlen(mapping); strcpy(form, mapping); form += len; From 0902a5a981a7906b8306487fe92c1d4e824a7f8f Mon Sep 17 00:00:00 2001 From: Chloe Kudryavtsev Date: Thu, 20 Apr 2023 11:51:11 -0400 Subject: [PATCH 03/29] improve null format handling there was a request to improve the error message, but the whole function has non-informative errors. (both functions, actually, since the code is duplicated) as such, instead of catching it directly, address the assumption that led to the SIGSEGV and let it be caught by the functions themselves, thus reusing existing error messages (which can then be improved separately). --- src/core/pp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/pp.c b/src/core/pp.c index d55b8536..d058cb1e 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -809,9 +809,9 @@ static const char *scanformat( *(form++) = '%'; const char *p2 = strfrmt; while (p2 <= p) { - if (strchr(FMT_REPLACE_INTTYPES, *p2) != NULL) { + char *loc = strchr(FMT_REPLACE_INTTYPES, *p2); + if (loc != NULL && *loc != '\0') { const char *mapping = get_fmt_mapping(*p2++); - if (!mapping) janet_panic("invalid format (found null)"); size_t len = strlen(mapping); strcpy(form, mapping); form += len; From 4238a4ca6a20a6bbabca0f3e8d639ea83ce48c16 Mon Sep 17 00:00:00 2001 From: wackbyte Date: Thu, 20 Apr 2023 21:06:33 -0400 Subject: [PATCH 04/29] README grammar and formatting changes --- README.md | 71 +++++++++++++++++++++++++++---------------------------- 1 file changed, 35 insertions(+), 36 deletions(-) diff --git a/README.md b/README.md index 30e8c009..0504a00e 100644 --- a/README.md +++ b/README.md @@ -7,14 +7,14 @@ Janet logo **Janet** is a functional and imperative programming language and bytecode interpreter. It is a -lisp-like language, but lists are replaced +Lisp-like language, but lists are replaced by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples). The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly. There is a REPL for trying out the language, as well as the ability to run script files. This client program is separate from the core runtime, so Janet can be embedded in other programs. Try Janet in your browser at -[https://janet-lang.org](https://janet-lang.org). +. If you'd like to financially support the ongoing development of Janet, consider [sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub. @@ -41,8 +41,8 @@ Lua, but smaller than GNU Guile or Python. * Macros * Multithreading * Per-thread event loop for efficient evented IO -* Byte code interpreter with an assembly interface, as well as bytecode verification -* Tail call Optimization +* Bytecode interpreter with an assembly interface, as well as bytecode verification +* Tail-call optimization * Direct interop with C via abstract types and C functions * Dynamically load C libraries * Functional and imperative standard library @@ -57,7 +57,7 @@ Lua, but smaller than GNU Guile or Python. ## Documentation * For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details. -* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html) +* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html). Documentation is also available locally in the REPL. Use the `(doc symbol-name)` macro to get API @@ -65,7 +65,7 @@ documentation for symbols in the core library. For example, ``` (doc apply) ``` -Shows documentation for the `apply` function. +shows documentation for the `apply` function. To get a list of all bindings in the default environment, use the `(all-bindings)` function. You @@ -84,7 +84,7 @@ the SourceHut mirror is actively maintained. The Makefile is non-portable and requires GNU-flavored make. -``` +```sh cd somewhere/my/projects/janet make make test @@ -100,7 +100,7 @@ Find out more about the available make targets by running `make help`. 32-bit Haiku build instructions are the same as the UNIX-like build instructions, but you need to specify an alternative compiler, such as `gcc-x86`. -``` +```sh cd somewhere/my/projects/janet make CC=gcc-x86 make test @@ -112,10 +112,9 @@ make install-jpm-git ### FreeBSD FreeBSD build instructions are the same as the UNIX-like build instructions, -but you need `gmake` to compile. Alternatively, install directly from -packages, using `pkg install lang/janet`. +but you need `gmake` to compile. Alternatively, install the package directly with `pkg install lang/janet`. -``` +```sh cd somewhere/my/projects/janet gmake gmake test @@ -127,19 +126,19 @@ gmake install-jpm-git ### NetBSD NetBSD build instructions are the same as the FreeBSD build instructions. -Alternatively, install directly from packages, using `pkgin install janet`. +Alternatively, install the package directly with `pkgin install janet`. ### Windows -1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#) -2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet. -3. Run `build_win` to compile janet. +1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#). +2. Run a Visual Studio Command Prompt (`cl.exe` and `link.exe` need to be on your PATH) and `cd` to the directory with Janet. +3. Run `build_win` to compile Janet. 4. Run `build_win test` to make sure everything is working. To build an `.msi` installer executable, in addition to the above steps, you will have to: -5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases) -6. run `build_win dist` +5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases). +6. Run `build_win dist`. Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself. @@ -175,9 +174,9 @@ ninja -C build install Janet can be hacked on with pretty much any environment you like, but for IDE lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the -best option, as it has excellent meson integration. It also offers code completion +best option, as it has excellent Meson integration. It also offers code completion for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim, -Emacs, and Atom will have syntax packages for the Janet language, though. +Emacs, and Atom each have syntax packages for the Janet language, though. ## Installation @@ -186,8 +185,8 @@ to try out the language, you don't need to install anything. You can also move t ## Usage -A REPL is launched when the binary is invoked with no arguments. Pass the -h flag -to display the usage information. Individual scripts can be run with `./janet myscript.janet` +A REPL is launched when the binary is invoked with no arguments. Pass the `-h` flag +to display the usage information. Individual scripts can be run with `./janet myscript.janet`. If you are looking to explore, you can print a list of all available macros, functions, and constants by entering the command `(all-bindings)` into the REPL. @@ -226,8 +225,8 @@ If installed, you can also run `man janet` to get usage information. Janet can be embedded in a host program very easily. The normal build will create a file `build/janet.c`, which is a single C file that contains all the source to Janet. This file, along with -`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C -project and compiled into the project. Janet should be compiled with `-std=c99` +`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C +project and compiled into it. Janet should be compiled with `-std=c99` on most compilers, and will need to be linked to the math library, `-lm`, and the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If there is no need for dynamic modules, add the define @@ -237,24 +236,24 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w ## Examples -See the examples directory for some example janet code. +See the examples directory for some example Janet code. ## Discussion -Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community). -Gitter provides Matrix and irc bridges as well. +Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community). +Gitter provides Matrix and IRC bridges as well. ## FAQ ### Where is (favorite feature from other language)? -It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but -they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense +It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but +it will likely be closed as "will not implement". Often, such features make one usecase simpler at the expense of 5 others by making the language more complicated. ### Is there a language spec? -There is not currently a spec besides the documentation at https://janet-lang.org. +There is not currently a spec besides the documentation at . ### Is this Scheme/Common Lisp? Where are the cons cells? @@ -270,13 +269,13 @@ Internally, Janet is not at all like Clojure. No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors and maps, instead they work well as table keys or other identifiers. -### Can I do Object Oriented programming with Janet? +### Can I do object-oriented programming with Janet? To some extent, yes. However, it is not the recommended method of abstraction, and performance may suffer. That said, tables can be used to make mutable objects with inheritance and polymorphism, where object -methods are implemeted with keywords. +methods are implemented with keywords. -``` +```clj (def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) }) (def my-car (table/setproto @{} Car)) (:honk my-car "Beep!") @@ -287,9 +286,9 @@ methods are implemeted with keywords. Usually, one of a few reasons: - Often, it already exists in a different form and the Clojure port would be redundant. - Clojure programs often generate a lot of garbage and rely on the JVM to clean it up. - Janet does not run on the JVM, and has a more primitive garbage collector. -- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library - without feeling "bolted on", especially when compared to ALGOL like languages. Adding features + Janet does not run on the JVM and has a more primitive garbage collector. +- We want to keep the Janet core small. With Lisps, a feature can usually be added as a library + without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features to the core also makes it a bit more difficult to keep Janet maximally portable. ### Why is my terminal spitting out junk when I run the REPL? @@ -297,7 +296,7 @@ Usually, one of a few reasons: Make sure your terminal supports ANSI escape codes. Most modern terminals will support these, but some older terminals, Windows consoles, or embedded terminals will not. If your terminal does not support ANSI escape codes, run the REPL with -the `-n` flag, which disables color output. You can also try the `-s` if further issues +the `-n` flag, which disables color output. You can also try the `-s` flag if further issues ensue. ## Why is it called "Janet"? From d359c6b43e6128e5d5811676642400c03a45b511 Mon Sep 17 00:00:00 2001 From: wackbyte Date: Sat, 22 Apr 2023 21:46:24 -0400 Subject: [PATCH 05/29] Remove double space in help message --- src/boot/boot.janet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ae8477f0..ae5d59d2 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3865,7 +3865,7 @@ -v : Print the version string -s : Use raw stdin instead of getline like functionality -e code : Execute a string of janet - -E code arguments... : Evaluate an expression as a short-fn with arguments + -E code arguments... : Evaluate an expression as a short-fn with arguments -d : Set the debug flag in the REPL -r : Enter the REPL after running all scripts -R : Disables loading profile.janet when JANET_PROFILE is present From 485099fd6e9e88fdc7521fff7e54a6d7023e9871 Mon Sep 17 00:00:00 2001 From: Ian Henry Date: Sat, 22 Apr 2023 23:40:32 -0700 Subject: [PATCH 06/29] string and peg replacement functions can now take functions Functions will be invoked with the matched text, and their result will be coerced to a string and used as the new replacement text. This also allows passing non-function, non-byteviewable values, which will be converted into strings during replacement (only once, and only if at least one match is found). --- src/core/peg.c | 19 +++++++++++++------ src/core/string.c | 22 +++++++++++++--------- src/core/util.c | 40 ++++++++++++++++++++++++++++++++++++++++ src/core/util.h | 1 + test/suite0002.janet | 4 ++++ test/suite0008.janet | 9 ++++++++- 6 files changed, 79 insertions(+), 16 deletions(-) diff --git a/src/core/peg.c b/src/core/peg.c index b7de920d..3d035533 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -1637,7 +1637,7 @@ typedef struct { JanetPeg *peg; PegState s; JanetByteView bytes; - JanetByteView repl; + Janet subst; int32_t start; } PegCall; @@ -1653,7 +1653,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) { ret.peg = compile_peg(argv[0]); } if (get_replace) { - ret.repl = janet_getbytes(argv, 1); + ret.subst = argv[1]; ret.bytes = janet_getbytes(argv, 2); } else { ret.bytes = janet_getbytes(argv, 1); @@ -1738,7 +1738,8 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) { trail = i; } int32_t nexti = (int32_t)(result - c.bytes.bytes); - janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len); + JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i); + janet_buffer_push_bytes(ret, subst.bytes, subst.len); trail = nexti; if (nexti == i) nexti++; i = nexti; @@ -1754,14 +1755,20 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) { } JANET_CORE_FN(cfun_peg_replace_all, - "(peg/replace-all peg repl text &opt start & args)", - "Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") { + "(peg/replace-all peg subst text &opt start & args)", + "Replace all matches of `peg` in `text` with `subst`, returning a new buffer. " + "The peg does not need to make captures to do replacement. " + "If `subst` is a function, it will be called once for each match " + "and should return the actual replacement text to use.") { return cfun_peg_replace_generic(argc, argv, 0); } JANET_CORE_FN(cfun_peg_replace, "(peg/replace peg repl text &opt start & args)", - "Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. " + "Replace first match of `peg` in `text` with `subst`, returning a new buffer. " + "The peg does not need to make captures to do replacement. " + "If `subst` is a function, it will be called with the matching text, " + "and should return the actual replacement text to use. " "If no matches are found, returns the input string in a new buffer.") { return cfun_peg_replace_generic(argc, argv, 1); } diff --git a/src/core/string.c b/src/core/string.c index 1e1d9622..f898bb94 100644 --- a/src/core/string.c +++ b/src/core/string.c @@ -364,14 +364,13 @@ JANET_CORE_FN(cfun_string_findall, struct replace_state { struct kmp_state kmp; - const uint8_t *subst; - int32_t substlen; + Janet subst; }; static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) { janet_arity(argc, 3, 4); JanetByteView pat = janet_getbytes(argv, 0); - JanetByteView subst = janet_getbytes(argv, 1); + Janet subst = argv[1]; JanetByteView text = janet_getbytes(argv, 2); int32_t start = 0; if (argc == 4) { @@ -380,13 +379,14 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) { } kmp_init(&s->kmp, text.bytes, text.len, pat.bytes, pat.len); s->kmp.i = start; - s->subst = subst.bytes; - s->substlen = subst.len; + s->subst = subst; } JANET_CORE_FN(cfun_string_replace, "(string/replace patt subst str)", "Replace the first occurrence of `patt` with `subst` in the string `str`. " + "If `subst` is a function, it will be called with `patt` only if a match is found, " + "and should return the actual replacement text to use. " "Will return the new string if `patt` is found, otherwise returns `str`.") { int32_t result; struct replace_state s; @@ -397,10 +397,11 @@ JANET_CORE_FN(cfun_string_replace, kmp_deinit(&s.kmp); return janet_stringv(s.kmp.text, s.kmp.textlen); } - buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen); + JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen); + buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + subst.len); safe_memcpy(buf, s.kmp.text, result); - safe_memcpy(buf + result, s.subst, s.substlen); - safe_memcpy(buf + result + s.substlen, + safe_memcpy(buf + result, subst.bytes, subst.len); + safe_memcpy(buf + result + subst.len, s.kmp.text + result + s.kmp.patlen, s.kmp.textlen - result - s.kmp.patlen); kmp_deinit(&s.kmp); @@ -411,6 +412,8 @@ JANET_CORE_FN(cfun_string_replaceall, "(string/replace-all patt subst str)", "Replace all instances of `patt` with `subst` in the string `str`. Overlapping " "matches will not be counted, only the first match in such a span will be replaced. " + "If `subst` is a function, it will be called with `patt` once for each match, " + "and should return the actual replacement text to use. " "Will return the new string if `patt` is found, otherwise returns `str`.") { int32_t result; struct replace_state s; @@ -419,8 +422,9 @@ JANET_CORE_FN(cfun_string_replaceall, replacesetup(argc, argv, &s); janet_buffer_init(&b, s.kmp.textlen); while ((result = kmp_next(&s.kmp)) >= 0) { + JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen); janet_buffer_push_bytes(&b, s.kmp.text + lastindex, result - lastindex); - janet_buffer_push_bytes(&b, s.subst, s.substlen); + janet_buffer_push_bytes(&b, subst.bytes, subst.len); lastindex = result + s.kmp.patlen; kmp_seti(&s.kmp, lastindex); } diff --git a/src/core/util.c b/src/core/util.c index a9395545..ddbb4515 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -663,6 +663,46 @@ JanetBinding janet_binding_from_entry(Janet entry) { return binding; } +/* If the value at the given address can be coerced to a byte view, + return that byte view. If it can't, replace the value at the address + with the result of janet_to_string, and return a byte view over that + string. */ +static JanetByteView memoize_byte_view(Janet *value) { + JanetByteView result; + if (!janet_bytes_view(*value, &result.bytes, &result.len)) { + JanetString str = janet_to_string(*value); + *value = janet_wrap_string(str); + result.bytes = str; + result.len = janet_string_length(str); + } + return result; +} + +static JanetByteView to_byte_view(Janet value) { + JanetByteView result; + if (!janet_bytes_view(value, &result.bytes, &result.len)) { + JanetString str = janet_to_string(value); + result.bytes = str; + result.len = janet_string_length(str); + } + return result; +} + +JanetByteView janet_text_substitution(Janet *subst, const uint8_t *bytes, uint32_t len) { + switch (janet_type(*subst)) { + case JANET_CFUNCTION: { + Janet matched = janet_stringv(bytes, len); + return to_byte_view(janet_unwrap_cfunction(*subst)(1, &matched)); + } + case JANET_FUNCTION: { + Janet matched = janet_stringv(bytes, len); + return to_byte_view(janet_call(janet_unwrap_function(*subst), 1, &matched)); + } + default: + return memoize_byte_view(subst); + } +} + JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { Janet entry = janet_table_get(env, janet_wrap_symbol(sym)); return janet_binding_from_entry(entry); diff --git a/src/core/util.h b/src/core/util.h index 5a4c8808..2eaf003a 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -93,6 +93,7 @@ void janet_buffer_format( Janet *argv); Janet janet_next_impl(Janet ds, Janet key, int is_interpreter); JanetBinding janet_binding_from_entry(Janet entry); +JanetByteView janet_text_substitution(Janet *subst, const uint8_t *bytes, uint32_t len); /* Registry functions */ void janet_registry_put( diff --git a/test/suite0002.janet b/test/suite0002.janet index f971df1a..bb249298 100644 --- a/test/suite0002.janet +++ b/test/suite0002.janet @@ -72,6 +72,10 @@ (assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1") (assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1") (assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2") +(assert (= (string/replace "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyxxxy") "string/replace function") +(assert (= (string/replace-all "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyXXxy") "string/replace-all function") +(assert (= (string/replace "x" 12 "xyx") "12yx") "string/replace stringable") +(assert (= (string/replace-all "x" 12 "xyx") "12y12") "string/replace-all stringable") (assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.") "string/ascii-lower") (assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.") "string/ascii-lower") (assert (= (string/reverse "") "") "string/reverse 1") diff --git a/test/suite0008.janet b/test/suite0008.janet index 8c65027c..457b69ae 100644 --- a/test/suite0008.janet +++ b/test/suite0008.janet @@ -330,7 +330,6 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all") # Peg replace and replace-all -(var ti 0) (defn check-replacer [x y z] (assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace") @@ -339,6 +338,14 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (check-replacer "abc" "Z" "") (check-replacer "aba" "ZZZZZZ" "ababababababa") (check-replacer "aba" "" "ababababababa") +(check-replacer "aba" string/ascii-upper "ababababababa") +(check-replacer "aba" 123 "ababababababa") +(assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa")) + "ABcAA") + "peg/replace-all cfunction") +(assert (= (string (peg/replace-all ~(set "ab") |$ "abcaa")) + "abcaa") + "peg/replace-all function") # Peg bug (assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1") From 9dc7e8ed3afcc9aa885117f67db22790025f2752 Mon Sep 17 00:00:00 2001 From: Ian Henry Date: Sun, 23 Apr 2023 09:09:14 -0700 Subject: [PATCH 07/29] peg replacement functions have access to captures When peg/replace or peg/replace-all are given a function to serve as the text replacement, any captures produced by the PEG are passed as additional arguments to that function. --- src/core/peg.c | 10 +++++----- src/core/string.c | 4 ++-- src/core/util.c | 39 ++++++++++++++++++++++++++------------- src/core/util.h | 6 +++++- test/suite0008.janet | 18 ++++++++++++++++++ 5 files changed, 56 insertions(+), 21 deletions(-) diff --git a/src/core/peg.c b/src/core/peg.c index 3d035533..5057494a 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -1738,7 +1738,7 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) { trail = i; } int32_t nexti = (int32_t)(result - c.bytes.bytes); - JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i); + JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i, c.s.captures); janet_buffer_push_bytes(ret, subst.bytes, subst.len); trail = nexti; if (nexti == i) nexti++; @@ -1758,8 +1758,8 @@ JANET_CORE_FN(cfun_peg_replace_all, "(peg/replace-all peg subst text &opt start & args)", "Replace all matches of `peg` in `text` with `subst`, returning a new buffer. " "The peg does not need to make captures to do replacement. " - "If `subst` is a function, it will be called once for each match " - "and should return the actual replacement text to use.") { + "If `subst` is a function, it will be called with the " + "matching text followed by any captures.") { return cfun_peg_replace_generic(argc, argv, 0); } @@ -1767,8 +1767,8 @@ JANET_CORE_FN(cfun_peg_replace, "(peg/replace peg repl text &opt start & args)", "Replace first match of `peg` in `text` with `subst`, returning a new buffer. " "The peg does not need to make captures to do replacement. " - "If `subst` is a function, it will be called with the matching text, " - "and should return the actual replacement text to use. " + "If `subst` is a function, it will be called with the " + "matching text followed by any captures. " "If no matches are found, returns the input string in a new buffer.") { return cfun_peg_replace_generic(argc, argv, 1); } diff --git a/src/core/string.c b/src/core/string.c index f898bb94..e7957edf 100644 --- a/src/core/string.c +++ b/src/core/string.c @@ -397,7 +397,7 @@ JANET_CORE_FN(cfun_string_replace, kmp_deinit(&s.kmp); return janet_stringv(s.kmp.text, s.kmp.textlen); } - JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen); + JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL); buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + subst.len); safe_memcpy(buf, s.kmp.text, result); safe_memcpy(buf + result, subst.bytes, subst.len); @@ -422,7 +422,7 @@ JANET_CORE_FN(cfun_string_replaceall, replacesetup(argc, argv, &s); janet_buffer_init(&b, s.kmp.textlen); while ((result = kmp_next(&s.kmp)) >= 0) { - JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen); + JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL); janet_buffer_push_bytes(&b, s.kmp.text + lastindex, result - lastindex); janet_buffer_push_bytes(&b, subst.bytes, subst.len); lastindex = result + s.kmp.patlen; diff --git a/src/core/util.c b/src/core/util.c index ddbb4515..3c50bc94 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -688,19 +688,32 @@ static JanetByteView to_byte_view(Janet value) { return result; } -JanetByteView janet_text_substitution(Janet *subst, const uint8_t *bytes, uint32_t len) { - switch (janet_type(*subst)) { - case JANET_CFUNCTION: { - Janet matched = janet_stringv(bytes, len); - return to_byte_view(janet_unwrap_cfunction(*subst)(1, &matched)); - } - case JANET_FUNCTION: { - Janet matched = janet_stringv(bytes, len); - return to_byte_view(janet_call(janet_unwrap_function(*subst), 1, &matched)); - } - default: - return memoize_byte_view(subst); - } +JanetByteView janet_text_substitution( + Janet *subst, + const uint8_t *bytes, + uint32_t len, + JanetArray *extra_argv) { + int32_t extra_argc = extra_argv == NULL ? 0 : extra_argv->count; + JanetType type = janet_type(*subst); + switch (type) { + case JANET_FUNCTION: + case JANET_CFUNCTION: { + int32_t argc = 1 + extra_argc; + Janet *argv = janet_tuple_begin(argc); + argv[0] = janet_stringv(bytes, len); + for (int32_t i = 0; i < extra_argc; i++) { + argv[i + 1] = extra_argv->data[i]; + } + janet_tuple_end(argv); + if (type == JANET_FUNCTION) { + return to_byte_view(janet_call(janet_unwrap_function(*subst), argc, argv)); + } else { + return to_byte_view(janet_unwrap_cfunction(*subst)(argc, argv)); + } + } + default: + return memoize_byte_view(subst); + } } JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { diff --git a/src/core/util.h b/src/core/util.h index 2eaf003a..b8f9cc90 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -93,7 +93,11 @@ void janet_buffer_format( Janet *argv); Janet janet_next_impl(Janet ds, Janet key, int is_interpreter); JanetBinding janet_binding_from_entry(Janet entry); -JanetByteView janet_text_substitution(Janet *subst, const uint8_t *bytes, uint32_t len); +JanetByteView janet_text_substitution( + Janet *subst, + const uint8_t *bytes, + uint32_t len, + JanetArray *extra_args); /* Registry functions */ void janet_registry_put( diff --git a/test/suite0008.janet b/test/suite0008.janet index 457b69ae..1bec7190 100644 --- a/test/suite0008.janet +++ b/test/suite0008.janet @@ -340,6 +340,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (check-replacer "aba" "" "ababababababa") (check-replacer "aba" string/ascii-upper "ababababababa") (check-replacer "aba" 123 "ababababababa") + (assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa")) "ABcAA") "peg/replace-all cfunction") @@ -347,6 +348,23 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 "abcaa") "peg/replace-all function") +(defn peg-test [name f peg subst text expected] + (assert (= (string (f peg subst text)) expected) name)) + +(peg-test "peg/replace has access to captures" + peg/replace + ~(sequence "." (capture (set "ab"))) + (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char))) + ".a.b.c" + ".a -> A, .b.c") + +(peg-test "peg/replace-all has access to captures" + peg/replace-all + ~(sequence "." (capture (set "ab"))) + (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char))) + ".a.b.c" + ".a -> A, .b -> B, .c") + # Peg bug (assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1") (assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2") From ccd874fe4ee42d2bd7037261f6bc43e1c7b2f6ff Mon Sep 17 00:00:00 2001 From: Ian Henry Date: Sun, 23 Apr 2023 21:11:56 -0700 Subject: [PATCH 08/29] add catseq --- src/boot/boot.janet | 7 +++++++ test/suite0001.janet | 3 +++ 2 files changed, 10 insertions(+) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ae8477f0..894097b5 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -611,6 +611,13 @@ (def $accum (gensym)) ~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum)) +(defmacro catseq + ``Similar to `loop`, but concatenates each element from the loop body into an array and returns that. + See `loop` for details.`` + [head & body] + (def $accum (gensym)) + ~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum)) + (defmacro tabseq ``Similar to `loop`, but accumulates key value pairs into a table. See `loop` for details.`` diff --git a/test/suite0001.janet b/test/suite0001.janet index 3dca5fb6..f26b873f 100644 --- a/test/suite0001.janet +++ b/test/suite0001.janet @@ -252,6 +252,9 @@ (def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x)))) (assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2") +(def xs (catseq [x :range [0 3]] [x x])) +(assert (deep= xs @[0 0 1 1 2 2]) "catseq") + # :range-to and :down-to (assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to") (assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to") From 54b54f85f3c3b8151bcd45439f14d72af934a471 Mon Sep 17 00:00:00 2001 From: Ian Henry Date: Sun, 23 Apr 2023 21:35:15 -0700 Subject: [PATCH 09/29] drop with a negative count now drops from the end --- src/boot/boot.janet | 13 +++++++------ test/suite0005.janet | 9 +++++++-- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ae8477f0..2ed4cbb0 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1133,16 +1133,17 @@ (take-until (complement pred) ind)) (defn drop - ``Drop the first n elements in an indexed or bytes type. Returns a new tuple or string - instance, respectively.`` + ``Drop the first `n elements in an indexed or bytes type. Returns a new tuple or string + instance, respectively. If `n` is negative, drops the last `n` elements instead.`` [n ind] (def use-str (bytes? ind)) (def f (if use-str string/slice tuple/slice)) (def len (length ind)) - # make sure start is in [0, len] - (def m (if (> n 0) n 0)) - (def start (if (> m len) len m)) - (f ind start -1)) + (def [start end] + (if (>= n 0) + [(min n len) len] + [0 (max 0 (+ len n))])) + (f ind start end)) (defn drop-until "Same as `(drop-while (complement pred) ind)`." diff --git a/test/suite0005.janet b/test/suite0005.janet index e268b1c7..b50ee188 100644 --- a/test/suite0005.janet +++ b/test/suite0005.janet @@ -83,8 +83,13 @@ (assert (deep= (drop 10 []) []) "drop 2") (assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3") (assert (deep= (drop 10 [1 2 3]) []) "drop 4") -(assert (deep= (drop -2 [:a :b :c]) [:a :b :c]) "drop 5") -(assert-error :invalid-type (drop 3 {}) "drop 6") +(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5") +(assert (deep= (drop -10 [1 2 3]) []) "drop 6") +(assert (deep= (drop 1 "abc") "bc") "drop 7") +(assert (deep= (drop 10 "abc") "") "drop 8") +(assert (deep= (drop -1 "abc") "ab") "drop 9") +(assert (deep= (drop -10 "abc") "") "drop 10") +(assert-error :invalid-type (drop 3 {}) "drop 11") # drop-until From daea91044c35981c408facd0ab5217c1c613d73e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 24 Apr 2023 09:19:15 -0500 Subject: [PATCH 10/29] Give different names to the user9 and user8 fiber statuses. These now have semantic menaings that are pretty difficult to work around. Code that tries to maniuplate user8 and user9 signals right now may be affected --- CHANGELOG.md | 6 ++++++ src/core/fiber.c | 14 ++++++++++++-- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e10a8fb7..99245add 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ # Changelog All notable changes to this project will be documented in this file. +## Unreleased - ??? +- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await` +- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`. +- Add `ev/all-tasks` to see all currently suspended fibers. +- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier. + ## 1.27.0 - 2023-03-05 - Change semantics around bracket tuples to no longer be equal to regular tuples. - Add `index` argument to `ffi/write` for symmetry with `ffi/read`. diff --git a/src/core/fiber.c b/src/core/fiber.c index e7166676..af183c7b 100644 --- a/src/core/fiber.c +++ b/src/core/fiber.c @@ -495,6 +495,8 @@ JANET_CORE_FN(cfun_fiber_new, "* :t - block termination signals: error + user[0-4]\n" "* :u - block user signals\n" "* :y - block yield signals\n" + "* :w - block await signals (user9)\n" + "* :r - block interrupt signals (user8)\n" "* :0-9 - block a specific user signal\n\n" "The sigmask argument also can take environment flags. If any mutually " "exclusive flags are present, the last flag takes precedence.\n\n" @@ -518,7 +520,7 @@ JANET_CORE_FN(cfun_fiber_new, } else { switch (view.bytes[i]) { default: - janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]); + janet_panicf("invalid flag %c, expected a, t, d, e, u, y, w, r, i, or p", view.bytes[i]); break; case 'a': fiber->flags |= @@ -548,6 +550,12 @@ JANET_CORE_FN(cfun_fiber_new, case 'y': fiber->flags |= JANET_FIBER_MASK_YIELD; break; + case 'w': + fiber->flags |= JANET_FIBER_MASK_USER9; + break; + case 'r': + fiber->flags |= JANET_FIBER_MASK_USER8; + break; case 'i': if (!janet_vm.fiber->env) { janet_vm.fiber->env = janet_table(0); @@ -575,7 +583,9 @@ JANET_CORE_FN(cfun_fiber_status, "* :error - the fiber has errored out\n" "* :debug - the fiber is suspended in debug mode\n" "* :pending - the fiber has been yielded\n" - "* :user(0-9) - the fiber is suspended by a user signal\n" + "* :user(0-7) - the fiber is suspended by a user signal\n" + "* :interrupted - the fiber was interrupted\n" + "* :suspended - the fiber is waiting to be resumed by the scheduler\n" "* :alive - the fiber is currently running and cannot be resumed\n" "* :new - the fiber has just been created and not yet run") { janet_fixarity(argc, 1); From 347721ae401a0e67d1d4a7b4f183e69730781071 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 24 Apr 2023 09:37:49 -0500 Subject: [PATCH 11/29] Fix macos behavior - Closes #1097, Fixes #1015 --- src/core/os.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index 89b79c8d..87bed395 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1085,7 +1085,8 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { os_execute_cleanup(envp, child_argv); if (status) { - janet_panicf("%p: %s", argv[0], strerror(errno)); + /* correct for macos bug where errno is not set */ + janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT)); } #endif From 440af9fd647f81446be8bb14160059ab8fce9ed3 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 24 Apr 2023 09:41:33 -0500 Subject: [PATCH 12/29] Remove extra allocation in drop. --- src/boot/boot.janet | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c22fd764..cc280ae9 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1146,10 +1146,9 @@ (def use-str (bytes? ind)) (def f (if use-str string/slice tuple/slice)) (def len (length ind)) - (def [start end] - (if (>= n 0) - [(min n len) len] - [0 (max 0 (+ len n))])) + (def negn (>= n 0)) + (def start (if negn (min n len) 0)) + (def end (if negn len (max 0 (+ len n)))) (f ind start end)) (defn drop-until From a9fae49671891ae524a78740fb29d7b383f34515 Mon Sep 17 00:00:00 2001 From: sogaiu <983021772@users.noreply.github.com> Date: Sun, 30 Apr 2023 21:55:43 +0900 Subject: [PATCH 13/29] Tweak long-string|bytes peg in test suite files --- test/suite0003.janet | 3 ++- test/suite0007.janet | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/test/suite0003.janet b/test/suite0003.janet index f94b1b58..17c9d2d1 100644 --- a/test/suite0003.janet +++ b/test/suite0003.janet @@ -349,7 +349,7 @@ (def janet-longstring ~{:delim (some "`") :open (capture :delim :n) - :close (cmt (* (not (> -1 "`")) (-> :n) (<- :delim)) ,=) + :close (cmt (* (not (> -1 "`")) (-> :n) (<- (backmatch :n))) ,=) :main (* :open (any (if-not :close 1)) :close -1)}) (check-match janet-longstring "`john" false) @@ -359,6 +359,7 @@ (check-match janet-longstring "`` ``" true) (check-match janet-longstring "``` `` ```" true) (check-match janet-longstring "`` ```" false) +(check-match janet-longstring "`a``b`" false) # Line and column capture diff --git a/test/suite0007.janet b/test/suite0007.janet index 3d682678..48889298 100644 --- a/test/suite0007.janet +++ b/test/suite0007.janet @@ -60,7 +60,7 @@ :buffer (/ '(* "@" :bytes) (constant :string)) :long-bytes {:delim (some "`") :open (capture :delim :n) - :close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=) + :close (cmt (* (not (> -1 "`")) (-> :n) '(backmatch :n)) ,=) :main (drop (* :open (any (if-not :close 1)) :close))} :long-string (/ ':long-bytes (constant :string)) :long-buffer (/ '(* "@" :long-bytes) (constant :string)) From 6e9cde8ac17ce01011d8889b7af39422c02f75da Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 30 Apr 2023 10:36:42 -0500 Subject: [PATCH 14/29] Add feature check for windows version shell.c Tried to get console working on windows 7 and below --- src/mainclient/shell.c | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c index c1812d75..05c428e7 100644 --- a/src/mainclient/shell.c +++ b/src/mainclient/shell.c @@ -146,9 +146,13 @@ static void setup_console_output(void) { HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE); DWORD dwMode = 0; GetConsoleMode(hOut, &dwMode); - dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING; + if (IsWindows10OrGreater()) { + dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING; + } SetConsoleMode(hOut, dwMode); - SetConsoleOutputCP(65001); + if (IsValidCodePage(65001)) { + SetConsoleOutputCP(65001); + } } /* Ansi terminal raw mode */ @@ -160,8 +164,10 @@ static int rawmode(void) { dwMode &= ~ENABLE_LINE_INPUT; dwMode &= ~ENABLE_INSERT_MODE; dwMode &= ~ENABLE_ECHO_INPUT; - dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT; - dwMode &= ~ENABLE_PROCESSED_INPUT; + if (IsWindows10OrGreater()) { + dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT; + dwMode &= ~ENABLE_PROCESSED_INPUT; + } if (!SetConsoleMode(hOut, dwMode)) return 1; gbl_israwmode = 1; return 0; @@ -176,8 +182,10 @@ static void norawmode(void) { dwMode |= ENABLE_LINE_INPUT; dwMode |= ENABLE_INSERT_MODE; dwMode |= ENABLE_ECHO_INPUT; - dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT; - dwMode |= ENABLE_PROCESSED_INPUT; + if (IsWindows10OrGreater()) { + dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT; + dwMode |= ENABLE_PROCESSED_INPUT; + } SetConsoleMode(hOut, dwMode); gbl_israwmode = 0; } From 696efcb9e2b00cad58daac7ab410358f85723dd3 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 30 Apr 2023 12:19:55 -0500 Subject: [PATCH 15/29] Add header file. --- src/mainclient/shell.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c index 05c428e7..06f61219 100644 --- a/src/mainclient/shell.c +++ b/src/mainclient/shell.c @@ -30,6 +30,7 @@ #ifdef _WIN32 #include #include +#include #ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING #define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004 #endif From 4cc4a9d38ba4bf9271f96a820decb64c33d61de5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 6 May 2023 10:16:05 -0500 Subject: [PATCH 16/29] (and ... true) will return `true` as per docs. --- src/boot/boot.janet | 2 +- test/suite0001.janet | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index cc280ae9..5a89d832 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -280,7 +280,7 @@ (while (> i 0) (-- i) (def v (in forms i)) - (set ret (if (= ret true) + (set ret (if (= i (- len 1)) v (if (idempotent? v) ['if v ret v] diff --git a/test/suite0001.janet b/test/suite0001.janet index f26b873f..cbe356c7 100644 --- a/test/suite0001.janet +++ b/test/suite0001.janet @@ -345,6 +345,8 @@ (assert (= (and 0 1 nil) nil) "and 0 1 nil") (assert (= (and 1) 1) "and 1") (assert (= (and) true) "and with no arguments") +(assert (= (and 1 true) true) "and with trailing true") +(assert (= (and 1 true 2) 2) "and with internal true") (assert (= (or true true) true) "or true true") (assert (= (or true false) true) "or true false") From 7d57f870071cd5caf211fe0afc7f2cf3d00c4f5a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 6 May 2023 12:08:07 -0500 Subject: [PATCH 17/29] Address #1121 - disallow extra splices. This turns splices that are ignored into compiler errors. Other alternatives here should also be considered, for example making this a compiler warning rather than an error. For example, the latest spork as of a3ee63c137ee3234987dbbca71b566994ff8ae8c has an error of this kind, but the resulting program does work correctly. Also disallow splice propagation - code of the form (+ 1 (do ;[2 3 4]) 5). --- CHANGELOG.md | 1 + src/core/compile.c | 2 ++ src/core/compile.h | 1 + src/core/specials.c | 11 ++++++++++- test/helper.janet | 5 +++++ test/suite0005.janet | 14 ++++++++++++++ 6 files changed, 33 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 99245add..cd28558d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`. - Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await` - Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`. - Add `ev/all-tasks` to see all currently suspended fibers. diff --git a/src/core/compile.c b/src/core/compile.c index 3c31049f..656cdd3d 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -422,6 +422,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) { int32_t i; JanetSlot *ret = NULL; JanetFopts subopts = janetc_fopts_default(c); + subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE; for (i = 0; i < len; i++) { janet_v_push(ret, janetc_value(subopts, vals[i])); } @@ -432,6 +433,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) { JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) { JanetSlot *ret = NULL; JanetFopts subopts = janetc_fopts_default(c); + subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE; const JanetKV *kvs = NULL; int32_t cap = 0, len = 0; janet_dictionary_view(ds, &kvs, &len, &cap); diff --git a/src/core/compile.h b/src/core/compile.h index dc6ae912..39dfa8a8 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -187,6 +187,7 @@ struct JanetCompiler { #define JANET_FOPTS_TAIL 0x10000 #define JANET_FOPTS_HINT 0x20000 #define JANET_FOPTS_DROP 0x40000 +#define JANET_FOPTS_ACCEPT_SPLICE 0x80000 /* Options for compiling a single form */ struct JanetFopts { diff --git a/src/core/specials.c b/src/core/specials.c index a69d9627..8f40cdd7 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -39,6 +39,10 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) { JanetSlot ret; + if (!(opts.flags & JANET_FOPTS_ACCEPT_SPLICE)) { + janetc_cerror(opts.compiler, "splice can only be used in function parameters and data constructors, it has no effect here"); + return janetc_cslot(janet_wrap_nil()); + } if (argn != 1) { janetc_cerror(opts.compiler, "expected 1 argument to splice"); return janetc_cslot(janet_wrap_nil()); @@ -75,7 +79,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) { const uint8_t *head = janet_unwrap_symbol(tup[0]); if (!janet_cstrcmp(head, "unquote")) { if (level == 0) { - return janetc_value(janetc_fopts_default(opts.compiler), tup[1]); + JanetFopts subopts = janetc_fopts_default(opts.compiler); + subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE; + return janetc_value(subopts, tup[1]); } else { level--; } @@ -488,6 +494,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { /* Get options */ condopts = janetc_fopts_default(c); bodyopts = opts; + bodyopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE; /* Set target for compilation */ target = (drop || tail) @@ -564,6 +571,7 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) { subopts.flags = JANET_FOPTS_DROP; } else { subopts = opts; + subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE; } ret = janetc_value(subopts, argv[i]); if (i != argn - 1) { @@ -587,6 +595,7 @@ static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv subopts.flags = JANET_FOPTS_DROP; } else { subopts = opts; + subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE; } ret = janetc_value(subopts, argv[i]); if (i != argn - 1) { diff --git a/test/helper.janet b/test/helper.janet index d76f6368..05ab1db4 100644 --- a/test/helper.janet +++ b/test/helper.janet @@ -24,6 +24,11 @@ (def errsym (keyword (gensym))) ~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg)) +(defn check-compile-error + [form] + (def result (compile form)) + (assert (table? result) (string/format "expected compilation error for %j, but compiled without error" form))) + (defmacro assert-no-error [msg & forms] (def errsym (keyword (gensym))) diff --git a/test/suite0005.janet b/test/suite0005.janet index b50ee188..1733ae8b 100644 --- a/test/suite0005.janet +++ b/test/suite0005.janet @@ -103,4 +103,18 @@ # Quasiquote bracketed tuples (assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples") +# No useless splices +(check-compile-error '((splice [1 2 3]) 0)) +(check-compile-error '(if ;[1 2] 5)) +(check-compile-error '(while ;[1 2 3] (print :hi))) +(check-compile-error '(def x ;[1 2 3])) +(check-compile-error '(fn [x] ;[x 1 2 3])) + +# No splice propagation +(check-compile-error '(+ 1 (do ;[2 3 4]) 5)) +(check-compile-error '(+ 1 (upscope ;[2 3 4]) 5)) +# compiler inlines when condition is constant, ensure that optimization doesn't break +(check-compile-error '(+ 1 (if true ;[3 4]))) +(check-compile-error '(+ 1 (if false nil ;[3 4]))) + (end-suite) From 9bb589f8278837629310bf86d16a02743fec707c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 6 May 2023 15:56:27 -0500 Subject: [PATCH 18/29] update readme --- README.md | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 0504a00e..6319ac77 100644 --- a/README.md +++ b/README.md @@ -201,20 +201,26 @@ Hello, World! nil janet:3:> (os/exit) $ janet -h -usage: build/janet [options] script args... +usage: janet [options] script args... Options are: -h : Show this help -v : Print the version string -s : Use raw stdin instead of getline like functionality -e code : Execute a string of janet + -E code arguments... : Evaluate an expression as a short-fn with arguments + -d : Set the debug flag in the REPL -r : Enter the REPL after running all scripts + -R : Disables loading profile.janet when JANET_PROFILE is present -p : Keep on executing if there is a top-level error (persistent) - -q : Hide prompt, logo, and REPL output (quiet) + -q : Hide logo (quiet) -k : Compile scripts but do not execute (flycheck) -m syspath : Set system path for loading global modules -c source output : Compile janet source code into an image + -i : Load the script argument as an image file instead of source code -n : Disable ANSI color output in the REPL - -l path : Execute code in a file before running the main script + -l lib : Use a module before processing more arguments + -w level : Set the lint warning level - default is "normal" + -x level : Set the lint error level - default is "none" -- : Stop handling options ``` From cabbaded68947a7be3bee5c5b9e0dff0a3963c48 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 6 May 2023 16:33:45 -0500 Subject: [PATCH 19/29] Add support for the NO_COLOR environment variable. --- CHANGELOG.md | 1 + janet.1 | 10 ++++++++++ src/boot/boot.janet | 3 +++ 3 files changed, 14 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index cd28558d..8bcbc75b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts). - Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`. - Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await` - Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`. diff --git a/janet.1 b/janet.1 index 0557ada3..0c946b2b 100644 --- a/janet.1 +++ b/janet.1 @@ -183,6 +183,10 @@ default repl. .BR \-n Disable ANSI colors in the repl. Has no effect if no repl is run. +.TP +.BR \-N +Enable ANSI colors in the repl. Has no effect if no repl is run. + .TP .BR \-r Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no @@ -268,5 +272,11 @@ This variable does nothing in the default configuration of Janet, as PRF is disa cannot be defined for this variable to have an effect. .RE +.B NO_COLOR +.RS +Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime +via dynamic bindings *err-color* and *pretty-format*, or via the command line parameters -n and -N. +.RE + .SH AUTHOR Written by Calvin Rose diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 5a89d832..c120abb0 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3855,6 +3855,7 @@ (if-let [jp (getenv-alias "JANET_PATH")] (setdyn *syspath* jp)) (if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile)) + (set colorize (not (getenv-alias "NO_COLOR"))) (defn- get-lint-level [i] @@ -3883,6 +3884,7 @@ -c source output : Compile janet source code into an image -i : Load the script argument as an image file instead of source code -n : Disable ANSI color output in the REPL + -N : Enable ANSI color output in the REPL -l lib : Use a module before processing more arguments -w level : Set the lint warning level - default is "normal" -x level : Set the lint error level - default is "none" @@ -3898,6 +3900,7 @@ "i" (fn [&] (set expect-image true) 1) "k" (fn [&] (set compile-only true) (set exit-on-error false) 1) "n" (fn [&] (set colorize false) 1) + "N" (fn [&] (set colorize true) 1) "m" (fn [i &] (setdyn *syspath* (in args (+ i 1))) 2) "c" (fn c-switch [i &] (def path (in args (+ i 1))) From 53ba9c800a5853eb2ff027685657cdf85b17109a Mon Sep 17 00:00:00 2001 From: Chloe Kudryavtsev Date: Sat, 6 May 2023 22:13:53 -0400 Subject: [PATCH 20/29] Add get/opt cbytes Like getcstring, but operates on a byteview. When writing bindings (i.e what capi.c is primarily used for), it's common to want to accept a buffer *or* a string rather than just a string. For this, a byteview is perfect (and why not accept keywords while you're at it?). However, there's no built-in function for getting a cstring out of a byteview, this adds one. This also reformulates getcstring to be an edge-case of getcbytes (simply adding an explicit check for stringness). --- src/core/capi.c | 22 ++++++++++++++++++---- src/include/janet.h | 2 ++ 2 files changed, 20 insertions(+), 4 deletions(-) diff --git a/src/core/capi.c b/src/core/capi.c index 0b918e0e..4972d8fb 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -209,14 +209,28 @@ const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const c #undef DEFINE_OPTLEN const char *janet_getcstring(const Janet *argv, int32_t n) { - const uint8_t *jstr = janet_getstring(argv, n); - const char *cstr = (const char *)jstr; - if (strlen(cstr) != (size_t) janet_string_length(jstr)) { - janet_panic("string contains embedded 0s"); + if (!janet_checktype(argv[n], JANET_STRING)) { + janet_panic_type(argv[n], n, JANET_TFLAG_STRING); + } + return janet_getcbytes(argv, n); +} + +const char* janet_getcbytes(const Janet *argv, int32_t n) { + JanetByteView view = janet_getbytes(argv, n); + const char *cstr = (const char *)view.bytes; + if (strlen(cstr) != (size_t) view.len) { + janet_panic("bytes contain embedded 0s"); } return cstr; } +const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) { + if (n >= argc || janet_checktype(argv[n], JANET_NIL)) { + return dflt; + } + return janet_getcbytes(argv, n); +} + int32_t janet_getnat(const Janet *argv, int32_t n) { Janet x = argv[n]; if (!janet_checkint(x)) goto bad; diff --git a/src/include/janet.h b/src/include/janet.h index a6d0d901..88cda071 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1968,6 +1968,7 @@ JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n); JANET_API JanetStruct janet_getstruct(const Janet *argv, int32_t n); JANET_API JanetString janet_getstring(const Janet *argv, int32_t n); JANET_API const char *janet_getcstring(const Janet *argv, int32_t n); +JANET_API const char *janet_getcbytes(const Janet *argv, int32_t n); JANET_API JanetSymbol janet_getsymbol(const Janet *argv, int32_t n); JANET_API JanetKeyword janet_getkeyword(const Janet *argv, int32_t n); JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n); @@ -1997,6 +1998,7 @@ JANET_API JanetTuple janet_opttuple(const Janet *argv, int32_t argc, int32_t n, JANET_API JanetStruct janet_optstruct(const Janet *argv, int32_t argc, int32_t n, JanetStruct dflt); JANET_API JanetString janet_optstring(const Janet *argv, int32_t argc, int32_t n, JanetString dflt); JANET_API const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt); +JANET_API const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt); JANET_API JanetSymbol janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, JanetString dflt); JANET_API JanetKeyword janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, JanetString dflt); JANET_API JanetFiber *janet_optfiber(const Janet *argv, int32_t argc, int32_t n, JanetFiber *dflt); From cd19dec44ab15092b42029aa120c4645aa924526 Mon Sep 17 00:00:00 2001 From: sogaiu <983021772@users.noreply.github.com> Date: Sun, 7 May 2023 22:22:33 +0900 Subject: [PATCH 21/29] Tweak ev/select docstring --- src/core/ev.c | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/core/ev.c b/src/core/ev.c index 2183bef9..df8b04ed 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -985,11 +985,16 @@ JANET_CORE_FN(cfun_channel_pop, JANET_CORE_FN(cfun_channel_choice, "(ev/select & clauses)", - "Block until the first of several channel operations occur. Returns a tuple of the form [:give chan], [:take chan x], or [:close chan], where " - "a :give tuple is the result of a write and :take tuple is the result of a read. Each clause must be either a channel (for " - "a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first " - "clauses will take precedence over later clauses. Both and give and take operations can return a [:close chan] tuple, which indicates that " - "the specified channel was closed while waiting, or that the channel was already closed.") { + "Block until the first of several channel operations occur. Returns a " + "tuple of the form [:give chan], [:take chan x], or [:close chan], " + "where a :give tuple is the result of a write and a :take tuple is the " + "result of a read. Each clause must be either a channel (for a channel " + "take operation) or a tuple [channel x] (for a channel give operation). " + "Operations are tried in order such that earlier clauses take " + "precedence over later clauses. Both give and take operations can " + "return a [:close chan] tuple, which indicates that the specified " + "channel was closed while waiting, or that the channel was already " + "closed.") { janet_arity(argc, 1, -1); int32_t len; const Janet *data; From 2360164e4fd2fcb1e8e086a8181471ca6ff2db1a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 7 May 2023 11:52:11 -0500 Subject: [PATCH 22/29] Address #1125 - fix ev/select to only take and release locks once. By take and releasing locks twice per channel in the case where nothing is reading, there was an opportunity for ev/select to hang in the multithreaded case. Also silence valgrind/helgrind errors. --- src/core/ev.c | 85 +++++++++++++++++++++++++++++++++------------------ 1 file changed, 56 insertions(+), 29 deletions(-) diff --git a/src/core/ev.c b/src/core/ev.c index 2183bef9..3243d304 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -672,19 +672,6 @@ static void janet_chan_init(JanetChannel *chan, int32_t limit, int threaded) { janet_os_mutex_init((JanetOSMutex *) &chan->lock); } -static void janet_chan_deinit(JanetChannel *chan) { - janet_q_deinit(&chan->read_pending); - janet_q_deinit(&chan->write_pending); - if (janet_chan_is_threaded(chan)) { - Janet item; - while (!janet_q_pop(&chan->items, &item, sizeof(item))) { - janet_chan_unpack(chan, &item, 1); - } - } - janet_q_deinit(&chan->items); - janet_os_mutex_deinit((JanetOSMutex *) &chan->lock); -} - static void janet_chan_lock(JanetChannel *chan) { if (!janet_chan_is_threaded(chan)) return; janet_os_mutex_lock((JanetOSMutex *) &chan->lock); @@ -695,6 +682,25 @@ static void janet_chan_unlock(JanetChannel *chan) { janet_os_mutex_unlock((JanetOSMutex *) &chan->lock); } +static void janet_chan_deinit(JanetChannel *chan) { + if (janet_chan_is_threaded(chan)) { + Janet item; + janet_chan_lock(chan); + janet_q_deinit(&chan->read_pending); + janet_q_deinit(&chan->write_pending); + while (!janet_q_pop(&chan->items, &item, sizeof(item))) { + janet_chan_unpack(chan, &item, 1); + } + janet_q_deinit(&chan->items); + janet_chan_unlock(chan); + } else { + janet_q_deinit(&chan->read_pending); + janet_q_deinit(&chan->write_pending); + janet_q_deinit(&chan->items); + } + janet_os_mutex_deinit((JanetOSMutex *) &chan->lock); +} + /* * Janet Channel abstract type */ @@ -771,6 +777,7 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) { int mode = msg.tag; JanetChannel *channel = (JanetChannel *) msg.argp; Janet x = msg.argj; + janet_chan_lock(channel); if (fiber->sched_id == sched_id) { if (mode == JANET_CP_MODE_CHOICE_READ) { janet_assert(!janet_chan_unpack(channel, &x, 0), "packing error"); @@ -791,7 +798,6 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) { int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ); if (is_read) { JanetChannelPending reader; - janet_chan_lock(channel); if (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) { JanetVM *vm = reader.thread; JanetEVGenericMessage msg; @@ -802,10 +808,8 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) { msg.argj = x; janet_ev_post_event(vm, janet_thread_chan_cb, msg); } - janet_chan_unlock(channel); } else { JanetChannelPending writer; - janet_chan_lock(channel); if (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) { JanetVM *vm = writer.thread; JanetEVGenericMessage msg; @@ -816,21 +820,21 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) { msg.argj = janet_wrap_nil(); janet_ev_post_event(vm, janet_thread_chan_cb, msg); } - janet_chan_unlock(channel); } } + janet_chan_unlock(channel); } /* Push a value to a channel, and return 1 if channel should block, zero otherwise. * If the push would block, will add to the write_pending queue in the channel. * Handles both threaded and unthreaded channels. */ -static int janet_channel_push(JanetChannel *channel, Janet x, int mode) { +static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode) { JanetChannelPending reader; int is_empty; if (janet_chan_pack(channel, &x)) { + janet_chan_unlock(channel); janet_panicf("failed to pack value for channel: %v", x); } - janet_chan_lock(channel); if (channel->closed) { janet_chan_unlock(channel); janet_panic("cannot write to closed channel"); @@ -891,12 +895,16 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode) { return 0; } +static int janet_channel_push(JanetChannel *channel, Janet x, int mode) { + janet_chan_lock(channel); + return janet_channel_push_with_lock(channel, x, mode); +} + /* Pop from a channel - returns 1 if item was obtained, 0 otherwise. The item * is returned by reference. If the pop would block, will add to the read_pending * queue in the channel. */ -static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) { +static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int is_choice) { JanetChannelPending writer; - janet_chan_lock(channel); if (channel->closed) { janet_chan_unlock(channel); *item = janet_wrap_nil(); @@ -941,6 +949,11 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) return 1; } +static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) { + janet_chan_lock(channel); + return janet_channel_pop_with_lock(channel, item, is_choice); +} + JanetChannel *janet_channel_unwrap(void *abstract) { return abstract; } @@ -983,6 +996,20 @@ JANET_CORE_FN(cfun_channel_pop, janet_await(); } +static void chan_unlock_args(const Janet *argv, int32_t n) { + for (int32_t i = 0; i < n; i++) { + int32_t len; + const Janet *data; + JanetChannel *chan; + if (janet_indexed_view(argv[i], &data, &len) && len == 2) { + chan = janet_getchannel(data, 0); + } else { + chan = janet_getchannel(argv, i); + } + janet_chan_unlock(chan); + } +} + JANET_CORE_FN(cfun_channel_choice, "(ev/select & clauses)", "Block until the first of several channel operations occur. Returns a tuple of the form [:give chan], [:take chan x], or [:close chan], where " @@ -1002,29 +1029,29 @@ JANET_CORE_FN(cfun_channel_choice, janet_chan_lock(chan); if (chan->closed) { janet_chan_unlock(chan); + chan_unlock_args(argv, i); return make_close_result(chan); } if (janet_q_count(&chan->items) < chan->limit) { - janet_chan_unlock(chan); - janet_channel_push(chan, data[1], 1); + janet_channel_push_with_lock(chan, data[1], 1); + chan_unlock_args(argv, i); return make_write_result(chan); } - janet_chan_unlock(chan); } else { /* Read */ JanetChannel *chan = janet_getchannel(argv, i); janet_chan_lock(chan); if (chan->closed) { janet_chan_unlock(chan); + chan_unlock_args(argv, i); return make_close_result(chan); } if (chan->items.head != chan->items.tail) { Janet item; - janet_chan_unlock(chan); - janet_channel_pop(chan, &item, 1); + janet_channel_pop_with_lock(chan, &item, 1); + chan_unlock_args(argv, i); return make_read_result(chan, item); } - janet_chan_unlock(chan); } } @@ -1033,12 +1060,12 @@ JANET_CORE_FN(cfun_channel_choice, if (janet_indexed_view(argv[i], &data, &len) && len == 2) { /* Write */ JanetChannel *chan = janet_getchannel(data, 0); - janet_channel_push(chan, data[1], 1); + janet_channel_push_with_lock(chan, data[1], 1); } else { /* Read */ Janet item; JanetChannel *chan = janet_getchannel(argv, i); - janet_channel_pop(chan, &item, 1); + janet_channel_pop_with_lock(chan, &item, 1); } } From 19f14adb9e0878440bb8ebb47293fcf9385e2326 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 7 May 2023 21:07:22 -0500 Subject: [PATCH 23/29] Update changelog. --- CHANGELOG.md | 3 +++ src/core/capi.c | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8bcbc75b..95c39ef4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,8 +2,11 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Fix `ev/select` on threaded channels sometimes live-locking. - Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts). + See http://no-color.org/ - Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`. + Instead, raise a compiler error. - Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await` - Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`. - Add `ev/all-tasks` to see all currently suspended fibers. diff --git a/src/core/capi.c b/src/core/capi.c index 4972d8fb..6984d3ad 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -215,7 +215,7 @@ const char *janet_getcstring(const Janet *argv, int32_t n) { return janet_getcbytes(argv, n); } -const char* janet_getcbytes(const Janet *argv, int32_t n) { +const char *janet_getcbytes(const Janet *argv, int32_t n) { JanetByteView view = janet_getbytes(argv, n); const char *cstr = (const char *)view.bytes; if (strlen(cstr) != (size_t) view.len) { From e4be5992b3eb4c72eb0315ad598a30b58b5fa4d3 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 10 May 2023 18:43:33 -0500 Subject: [PATCH 24/29] Address issue with #1131 --- src/core/os.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 87bed395..4cbfa05f 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1043,21 +1043,21 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { if (pipe_in != JANET_HANDLE_NONE) { posix_spawn_file_actions_adddup2(&actions, pipe_in, 0); posix_spawn_file_actions_addclose(&actions, pipe_in); - } else if (new_in != JANET_HANDLE_NONE) { + } else if (new_in != JANET_HANDLE_NONE && new_in != 0) { posix_spawn_file_actions_adddup2(&actions, new_in, 0); posix_spawn_file_actions_addclose(&actions, new_in); } if (pipe_out != JANET_HANDLE_NONE) { posix_spawn_file_actions_adddup2(&actions, pipe_out, 1); posix_spawn_file_actions_addclose(&actions, pipe_out); - } else if (new_out != JANET_HANDLE_NONE) { + } else if (new_out != JANET_HANDLE_NONE && new_out != 1) { posix_spawn_file_actions_adddup2(&actions, new_out, 1); posix_spawn_file_actions_addclose(&actions, new_out); } if (pipe_err != JANET_HANDLE_NONE) { posix_spawn_file_actions_adddup2(&actions, pipe_err, 2); posix_spawn_file_actions_addclose(&actions, pipe_err); - } else if (new_err != JANET_HANDLE_NONE) { + } else if (new_err != JANET_HANDLE_NONE && new_err != 2) { posix_spawn_file_actions_adddup2(&actions, new_err, 2); posix_spawn_file_actions_addclose(&actions, new_err); } From 5cd729c4c1e0277a99559c618487d83f05384b5c Mon Sep 17 00:00:00 2001 From: Ico Doornekamp Date: Mon, 8 May 2023 21:29:29 +0200 Subject: [PATCH 25/29] Added os.strftime() --- src/core/os.c | 92 +++++++++++++++++++++++++++++++------------- test/suite0007.janet | 6 +++ 2 files changed, 71 insertions(+), 27 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 4cbfa05f..c0e5f314 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1351,6 +1351,41 @@ JANET_CORE_FN(os_cryptorand, return janet_wrap_buffer(buffer); } +/* Helper function to get given or current time as local or UTC struct tm. + * - arg n+0: optional time_t to be converted, uses current time if not given + * - arg n+1: optional truthy to indicate the convnersion uses local time */ +static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct tm *t_infos) +{ + time_t t; + if (argc > n && !janet_checktype(argv[n], JANET_NIL)) { + int64_t integer = janet_getinteger64(argv, n); + t = (time_t) integer; + } else { + time(&t); + } + struct tm *t_info = NULL; + if (argc > n+1 && janet_truthy(argv[n+1])) { + /* local time */ +#ifdef JANET_WINDOWS + _tzset(); + localtime_s(t_infos, &t); + t_info = t_infos; +#else + tzset(); + t_info = localtime_r(&t, t_infos); +#endif + } else { + /* utc time */ +#ifdef JANET_WINDOWS + gmtime_s(t_infos, &t); + t_info = t_infos; +#else + t_info = gmtime_r(&t, t_infos); +#endif + } + return t_info; +} + JANET_CORE_FN(os_date, "(os/date &opt time local)", "Returns the given time as a date struct, or the current time if `time` is not given. " @@ -1368,34 +1403,8 @@ JANET_CORE_FN(os_date, "* :dst - if Day Light Savings is in effect") { janet_arity(argc, 0, 2); (void) argv; - time_t t; struct tm t_infos; - struct tm *t_info = NULL; - if (argc && !janet_checktype(argv[0], JANET_NIL)) { - int64_t integer = janet_getinteger64(argv, 0); - t = (time_t) integer; - } else { - time(&t); - } - if (argc >= 2 && janet_truthy(argv[1])) { - /* local time */ -#ifdef JANET_WINDOWS - _tzset(); - localtime_s(&t_infos, &t); - t_info = &t_infos; -#else - tzset(); - t_info = localtime_r(&t, &t_infos); -#endif - } else { - /* utc time */ -#ifdef JANET_WINDOWS - gmtime_s(&t_infos, &t); - t_info = &t_infos; -#else - t_info = gmtime_r(&t, &t_infos); -#endif - } + struct tm *t_info = time_to_tm(argv, argc, 0, &t_infos); JanetKV *st = janet_struct_begin(9); janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec)); janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min)); @@ -1409,6 +1418,34 @@ JANET_CORE_FN(os_date, return janet_wrap_struct(janet_struct_end(st)); } +#define SIZETIMEFMT 250 + +JANET_CORE_FN(os_strftime, + "(os/strftime fmt &opt time local)", + "Format the given time as a string, or the current time if `time` is not given. " + "The time is formatted according to the same rules as the ISO C89 function strftime(). " + "The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for " + "the local timezone.") { + janet_arity(argc, 1, 3); + const char *fmt = janet_getcstring(argv, 0); + /* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */ + static const char *valid = "aAbBcdHIjmMpSUwWxXyYZ%"; + const char *p = fmt; + while (*p) { + if (*p++ == '%') { + if(!strchr(valid, *p)) { + janet_panicf("invalid conversion specifier '%%%c'", *p); + } + p++; + } + } + struct tm t_infos; + struct tm *t_info = time_to_tm(argv, argc, 1, &t_infos); + char buf[SIZETIMEFMT]; + (void)strftime(buf, SIZETIMEFMT, fmt, t_info); + return janet_cstringv(buf); +} + static int entry_getdst(Janet env_entry) { Janet v; if (janet_checktype(env_entry, JANET_TABLE)) { @@ -2311,6 +2348,7 @@ void janet_lib_os(JanetTable *env) { JANET_CORE_REG("os/mktime", os_mktime), JANET_CORE_REG("os/time", os_time), /* not high resolution */ JANET_CORE_REG("os/date", os_date), /* not high resolution */ + JANET_CORE_REG("os/strftime", os_strftime), JANET_CORE_REG("os/sleep", os_sleep), /* env functions */ diff --git a/test/suite0007.janet b/test/suite0007.janet index 48889298..c60a9678 100644 --- a/test/suite0007.janet +++ b/test/suite0007.janet @@ -239,6 +239,12 @@ (assert (= (os/mktime (os/date now true) true) now) "local os/mktime") (assert (= (os/mktime {:year 1970}) 0) "os/mktime default values") +# OS strftime test + +(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 0) "1970-01-01 00:00:00") "strftime UTC epoch") +(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 1388608200) "2014-01-01 20:30:00") "strftime january 2014") +(assert (= (try (os/strftime "%%%d%t") ([err] err)) "invalid conversion specifier '%t'") "invalid conversion specifier") + # Appending buffer to self (with-dyns [:out @""] From ac75b946799c123929330a09add862ae6fdda8c0 Mon Sep 17 00:00:00 2001 From: Chloe Kudryavtsev Date: Thu, 11 May 2023 16:07:34 -0400 Subject: [PATCH 26/29] Make JANET_FN_S* sourceline const Otherwise attempts to use it on some platforms cause the following error `error: initializer element is not a compile-time constant` when attempting to use the corresponding `JANET_REG`. --- src/include/janet.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/include/janet.h b/src/include/janet.h index 88cda071..c88cd35c 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1878,7 +1878,7 @@ JANET_API Janet janet_resolve_core(const char *name); /* sourcemaps only */ #define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_} #define JANET_FN_S(CNAME, USAGE, DOCSTRING) \ - static int32_t CNAME##_sourceline_ = __LINE__; \ + static const int32_t CNAME##_sourceline_ = __LINE__; \ Janet CNAME (int32_t argc, Janet *argv) #define JANET_DEF_S(ENV, JNAME, VAL, DOC) \ janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__) @@ -1894,7 +1894,7 @@ JANET_API Janet janet_resolve_core(const char *name); /* sourcemaps and docstrings */ #define JANET_REG_SD(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, __FILE__, CNAME##_sourceline_} #define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \ - static int32_t CNAME##_sourceline_ = __LINE__; \ + static const int32_t CNAME##_sourceline_ = __LINE__; \ static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \ Janet CNAME (int32_t argc, Janet *argv) #define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \ From 84a4e3e98ac3de2d837d130eece6c19509ac973d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 11 May 2023 18:03:38 -0500 Subject: [PATCH 27/29] Update CHANGELOG. and format. --- CHANGELOG.md | 1 + src/core/ev.c | 18 +++++++++--------- src/core/os.c | 17 ++++++++--------- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 95c39ef4..0451db51 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `os/strftime` for date formatting. - Fix `ev/select` on threaded channels sometimes live-locking. - Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts). See http://no-color.org/ diff --git a/src/core/ev.c b/src/core/ev.c index 1353ef45..8a904745 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -1013,15 +1013,15 @@ static void chan_unlock_args(const Janet *argv, int32_t n) { JANET_CORE_FN(cfun_channel_choice, "(ev/select & clauses)", "Block until the first of several channel operations occur. Returns a " - "tuple of the form [:give chan], [:take chan x], or [:close chan], " - "where a :give tuple is the result of a write and a :take tuple is the " - "result of a read. Each clause must be either a channel (for a channel " - "take operation) or a tuple [channel x] (for a channel give operation). " - "Operations are tried in order such that earlier clauses take " - "precedence over later clauses. Both give and take operations can " - "return a [:close chan] tuple, which indicates that the specified " - "channel was closed while waiting, or that the channel was already " - "closed.") { + "tuple of the form [:give chan], [:take chan x], or [:close chan], " + "where a :give tuple is the result of a write and a :take tuple is the " + "result of a read. Each clause must be either a channel (for a channel " + "take operation) or a tuple [channel x] (for a channel give operation). " + "Operations are tried in order such that earlier clauses take " + "precedence over later clauses. Both give and take operations can " + "return a [:close chan] tuple, which indicates that the specified " + "channel was closed while waiting, or that the channel was already " + "closed.") { janet_arity(argc, 1, -1); int32_t len; const Janet *data; diff --git a/src/core/os.c b/src/core/os.c index c0e5f314..64a03470 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1354,8 +1354,7 @@ JANET_CORE_FN(os_cryptorand, /* Helper function to get given or current time as local or UTC struct tm. * - arg n+0: optional time_t to be converted, uses current time if not given * - arg n+1: optional truthy to indicate the convnersion uses local time */ -static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct tm *t_infos) -{ +static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct tm *t_infos) { time_t t; if (argc > n && !janet_checktype(argv[n], JANET_NIL)) { int64_t integer = janet_getinteger64(argv, n); @@ -1364,7 +1363,7 @@ static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct time(&t); } struct tm *t_info = NULL; - if (argc > n+1 && janet_truthy(argv[n+1])) { + if (argc > n + 1 && janet_truthy(argv[n + 1])) { /* local time */ #ifdef JANET_WINDOWS _tzset(); @@ -1421,11 +1420,11 @@ JANET_CORE_FN(os_date, #define SIZETIMEFMT 250 JANET_CORE_FN(os_strftime, - "(os/strftime fmt &opt time local)", - "Format the given time as a string, or the current time if `time` is not given. " - "The time is formatted according to the same rules as the ISO C89 function strftime(). " - "The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for " - "the local timezone.") { + "(os/strftime fmt &opt time local)", + "Format the given time as a string, or the current time if `time` is not given. " + "The time is formatted according to the same rules as the ISO C89 function strftime(). " + "The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for " + "the local timezone.") { janet_arity(argc, 1, 3); const char *fmt = janet_getcstring(argv, 0); /* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */ @@ -1433,7 +1432,7 @@ JANET_CORE_FN(os_strftime, const char *p = fmt; while (*p) { if (*p++ == '%') { - if(!strchr(valid, *p)) { + if (!strchr(valid, *p)) { janet_panicf("invalid conversion specifier '%%%c'", *p); } p++; From 7e65c2bdad5e5ee545b2f3136c9d1b48deee285f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 11 May 2023 18:15:37 -0500 Subject: [PATCH 28/29] Fix #1130 - mod flipped for signed integers. --- src/core/inttypes.c | 22 ++++++++++++++++++---- test/suite0006.janet | 8 ++++++++ 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/src/core/inttypes.c b/src/core/inttypes.c index 364d9ea8..aa53293c 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -502,6 +502,18 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) { return janet_wrap_abstract(box); } +static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) { + janet_fixarity(argc, 2); + int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); + int64_t op2 = janet_unwrap_s64(argv[0]); + int64_t op1 = janet_unwrap_s64(argv[1]); + int64_t x = op1 % op2; + *box = (op1 > 0) + ? ((op2 > 0) ? x : (0 == x ? x : x + op2)) + : ((op2 > 0) ? (0 == x ? x : x + op2) : x); + return janet_wrap_abstract(box); +} + OPMETHOD(int64_t, s64, add, +) OPMETHOD(int64_t, s64, sub, -) OPMETHODINVERT(int64_t, s64, subi, -) @@ -509,6 +521,7 @@ OPMETHOD(int64_t, s64, mul, *) DIVMETHOD_SIGNED(int64_t, s64, div, /) DIVMETHOD_SIGNED(int64_t, s64, rem, %) DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /) +DIVMETHODINVERT_SIGNED(int64_t, s64, remi, /) OPMETHOD(int64_t, s64, and, &) OPMETHOD(int64_t, s64, or, |) OPMETHOD(int64_t, s64, xor, ^) @@ -521,6 +534,7 @@ OPMETHOD(uint64_t, u64, mul, *) DIVMETHOD(uint64_t, u64, div, /) DIVMETHOD(uint64_t, u64, mod, %) DIVMETHODINVERT(uint64_t, u64, divi, /) +DIVMETHODINVERT(uint64_t, u64, modi, %) OPMETHOD(uint64_t, u64, and, &) OPMETHOD(uint64_t, u64, or, |) OPMETHOD(uint64_t, u64, xor, ^) @@ -542,9 +556,9 @@ static JanetMethod it_s64_methods[] = { {"/", cfun_it_s64_div}, {"r/", cfun_it_s64_divi}, {"mod", cfun_it_s64_mod}, - {"rmod", cfun_it_s64_mod}, + {"rmod", cfun_it_s64_modi}, {"%", cfun_it_s64_rem}, - {"r%", cfun_it_s64_rem}, + {"r%", cfun_it_s64_remi}, {"&", cfun_it_s64_and}, {"r&", cfun_it_s64_and}, {"|", cfun_it_s64_or}, @@ -567,9 +581,9 @@ static JanetMethod it_u64_methods[] = { {"/", cfun_it_u64_div}, {"r/", cfun_it_u64_divi}, {"mod", cfun_it_u64_mod}, - {"rmod", cfun_it_u64_mod}, + {"rmod", cfun_it_u64_modi}, {"%", cfun_it_u64_mod}, - {"r%", cfun_it_u64_mod}, + {"r%", cfun_it_u64_modi}, {"&", cfun_it_u64_and}, {"r&", cfun_it_u64_and}, {"|", cfun_it_u64_or}, diff --git a/test/suite0006.janet b/test/suite0006.janet index cc9683c9..1e8b7237 100644 --- a/test/suite0006.janet +++ b/test/suite0006.janet @@ -261,4 +261,12 @@ (modcheck -10 3) (modcheck -10 -3) +# Check for issue #1130 +(var d (int/s64 7)) +(mod 0 d) + +(var d (int/s64 7)) +(def result (seq [n :in (range -21 0)] (mod n d))) +(assert (deep= result (map int/s64 @[0 1 2 3 4 5 6 0 1 2 3 4 5 6 0 1 2 3 4 5 6])) "issue #1130") + (end-suite) From 1467ab4f93394e0816f3045f24d7ee1376e64916 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 11 May 2023 20:56:12 -0500 Subject: [PATCH 29/29] Copy paste error. --- src/core/inttypes.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/inttypes.c b/src/core/inttypes.c index aa53293c..7073d9aa 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -521,7 +521,7 @@ OPMETHOD(int64_t, s64, mul, *) DIVMETHOD_SIGNED(int64_t, s64, div, /) DIVMETHOD_SIGNED(int64_t, s64, rem, %) DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /) -DIVMETHODINVERT_SIGNED(int64_t, s64, remi, /) +DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %) OPMETHOD(int64_t, s64, and, &) OPMETHOD(int64_t, s64, or, |) OPMETHOD(int64_t, s64, xor, ^)