From b9a2bb810476c68e81c09b3a3bb428e026f50ea9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 12 Feb 2020 09:34:23 -0600 Subject: [PATCH 01/28] Fix documentation for defer. --- 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 6d201ba9..bc7d72c0 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -287,7 +287,7 @@ ~(let (,;accum) ,;body)) (defmacro defer - "Run form unconditionally after form, even if the body throws an error." + "Run form unconditionally after body, even if the body throws an error." [form & body] (with-syms [f r] ~(do From a360cb792230cab7e2db8b029b61367c596fa3ce Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 15 Feb 2020 10:04:44 -0600 Subject: [PATCH 02/28] Update marshal to take 3 arguments. --- src/core/marsh.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index 48ba55cb..1af1ba9f 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -1274,7 +1274,7 @@ static Janet cfun_env_lookup(int32_t argc, Janet *argv) { } static Janet cfun_marshal(int32_t argc, Janet *argv) { - janet_arity(argc, 1, 2); + janet_arity(argc, 1, 3); JanetBuffer *buffer; JanetTable *rreg = NULL; if (argc > 1) { From 4b440618d69092da02f5c4529dcb72d75ba4d696 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 21 Feb 2020 20:21:17 -0600 Subject: [PATCH 03/28] Correct docs for type form. --- src/core/cfuns.c | 11 ++++++----- src/core/corelib.c | 7 +++---- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/core/cfuns.c b/src/core/cfuns.c index 96b040be..40db0ff1 100644 --- a/src/core/cfuns.c +++ b/src/core/cfuns.c @@ -70,10 +70,10 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) { /* Emit an insruction that implements a form by itself. */ static JanetSlot opfunction( - JanetFopts opts, - JanetSlot *args, - int op, - Janet defaultArg2) { + JanetFopts opts, + JanetSlot *args, + int op, + Janet defaultArg2) { JanetCompiler *c = opts.compiler; int32_t len; len = janet_v_count(args); @@ -82,7 +82,8 @@ static JanetSlot opfunction( t = janetc_gettarget(opts); janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1); return t; - } else if (len == 2) { + } else { + /* len == 2 */ t = janetc_gettarget(opts); janetc_emit_sss(c, op, t, args[0], args[1], 1); } diff --git a/src/core/corelib.c b/src/core/corelib.c index 3d57459d..6e38e1fb 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -599,11 +599,10 @@ static const JanetReg corelib_cfuns[] = { { "type", janet_core_type, JDOC("(type x)\n\n" - "Returns the type of x as a keyword symbol. x is one of\n" + "Returns the type of x as a keyword. x is one of\n" "\t:nil\n" "\t:boolean\n" - "\t:integer\n" - "\t:real\n" + "\t:number\n" "\t:array\n" "\t:tuple\n" "\t:table\n" @@ -614,7 +613,7 @@ static const JanetReg corelib_cfuns[] = { "\t:keyword\n" "\t:function\n" "\t:cfunction\n\n" - "or another symbol for an abstract type.") + "or another keyword for an abstract type.") }, { "hash", janet_core_hash, From aaabca6fc7dd2860b80b25142d40960b85ce8dc5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 21 Feb 2020 21:10:42 -0600 Subject: [PATCH 04/28] Make flychecker handle more kinds of defs. This should help when redefining certain forms. Will also not do functional arity checking against nil forms, as that is the default value when a def doesn't evaluate. --- src/boot/boot.janet | 42 ++++++++++++++++++++++++++++++++++++++---- src/core/compile.c | 1 + 2 files changed, 39 insertions(+), 4 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index bc7d72c0..4cfa11b7 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2225,6 +2225,29 @@ ### ### +(defn- no-side-effects + "Check if form may have side effects. If returns true, then the src + must not have side effects, such as calling a C function." + [src] + (cond + (tuple? src) + (if (= (tuple/type src) :brackets) + (all no-side-effects src)) + (array? src) + (all no-side-effects src) + (dictionary? src) + (and (all no-side-effects (keys src)) + (all no-side-effects (values src))) + true)) + +(defn- is-safe-def [x] (no-side-effects (last x))) + +(def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true + 'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def + 'defglobal is-safe-def 'varglobal is-safe-def}) + +(def- importers {'import true 'import* true 'use true 'dofile true 'require true}) + (defn cli-main "Entrance for the Janet CLI tool. Call this functions with the command line arguments as an array or tuple of strings to invoke the CLI interface." @@ -2292,15 +2315,21 @@ (def h (in handlers n)) (if h (h i) (do (print "unknown flag -" n) ((in handlers "h"))))) - (def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true}) - (def- importers {'import true 'import* true 'use true 'dofile true 'require true}) (defn- evaluator [thunk source env where] (if *compile-only* (when (tuple? source) + (def head (source 0)) + (def safe-check (safe-forms head)) (cond - (safe-forms (source 0)) (thunk) - (importers (source 0)) + # Sometimes safe form + (function? safe-check) + (if (safe-check source) (thunk)) + # Always safe form + safe-check + (thunk) + # Import-like form + (importers head) (do (let [[l c] (tuple/sourcemap source) newtup (tuple/setmap (tuple ;source :evaluator evaluator) l c)] @@ -2347,6 +2376,11 @@ (setdyn :err-color (if *colorize* true)) (repl getchunk onsig env))) +(put _env 'no-side-effects nil) +(put _env 'is-safe-def nil) +(put _env 'safe-forms nil) +(put _env 'importers nil) + ### ### diff --git a/src/core/compile.c b/src/core/compile.c index 62fb4b0b..4c69c2ef 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -455,6 +455,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) { break; case JANET_CFUNCTION: case JANET_ABSTRACT: + case JANET_NIL: break; case JANET_KEYWORD: if (min_arity == 0) { From 20d5d560f35518e9da97f039288d51b71dbfad34 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 22 Feb 2020 19:18:08 -0600 Subject: [PATCH 05/28] Add bf to main test suite. --- meson.build | 3 +- test/suite8.janet | 73 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+), 1 deletion(-) create mode 100644 test/suite8.janet diff --git a/meson.build b/meson.build index d8915246..e4919b9f 100644 --- a/meson.build +++ b/meson.build @@ -216,7 +216,8 @@ test_files = [ 'test/suite4.janet', 'test/suite5.janet', 'test/suite6.janet', - 'test/suite7.janet' + 'test/suite7.janet', + 'test/suite8.janet' ] foreach t : test_files test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir()) diff --git a/test/suite8.janet b/test/suite8.janet new file mode 100644 index 00000000..a43777e9 --- /dev/null +++ b/test/suite8.janet @@ -0,0 +1,73 @@ +# Copyright (c) 2020 Calvin Rose & contributors +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +# IN THE SOFTWARE. + +(import ./helper :prefix "" :exit true) +(start-suite 8) + +### +### Compiling brainfuck to Janet. +### + +(def- bf-peg + "Peg for compiling brainfuck into a Janet source ast." + (peg/compile + ~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x)))) + :- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x)))) + :> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x)))) + :< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x)))) + :. (* "." (constant (prinf "%c" (get DATA POS)))) + :loop (/ (* "[" :main "]") ,(fn [& captures] + ~(while (not= (get DATA POS) 0) + ,;captures))) + :main (any (+ :s :loop :+ :- :> :< :.)) })) + +(defn bf + "Run brainfuck." + [text] + (eval + ~(let [DATA (array/new-filled 100 0)] + (var POS 50) + ,;(peg/match bf-peg text)))) + +(defn test-bf + "Test some bf for expected output." + [input output] + (def b @"") + (with-dyns [:out b] + (bf input)) + (assert (= (string output) (string b)) + (string "bf input '" + input + "' failed, expected " + (describe output) + ", got " + (describe (string b)) + "."))) + +(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n") + +(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>-> ++++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+." + "Hello World!\n") + +(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--." + "Hello, World!") + +(end-suite) From 6a13703e329a946a0e10c296e3ea3c9cc0f73241 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 23 Feb 2020 13:31:27 -0600 Subject: [PATCH 06/28] Add `signal` and `fiber/can-resume?`. These additions, along with the change that user signals 0-4 cannot be resumed, allow delimited continuation semantics, while repsecting existing forms like `defer`, `with`, `with-vars`, etc. --- src/boot/boot.janet | 13 ++++++------- src/core/corelib.c | 25 +++++++++++++++++++++++++ src/core/fiber.c | 29 +++++++++++++++++++++++++++++ src/core/vm.c | 1 + 4 files changed, 61 insertions(+), 7 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 4cfa11b7..2cc70166 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -287,11 +287,12 @@ ~(let (,;accum) ,;body)) (defmacro defer - "Run form unconditionally after body, even if the body throws an error." + "Run form unconditionally after body, even if the body throws an error. + Will also run form if a user signal 0-4 is received." [form & body] (with-syms [f r] ~(do - (def ,f (,fiber/new (fn [] ,;body) :ie)) + (def ,f (,fiber/new (fn [] ,;body) :ti)) (def ,r (,resume ,f)) ,form (if (= (,fiber/status ,f) :dead) @@ -975,11 +976,10 @@ (with-syms [ret f s] ~(do ,;saveold - (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ei)) + (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti)) (def ,ret (,resume ,f)) ,;restoreold - (if (= (,fiber/status ,f) :error) (,propagate ,ret ,f)) - ,ret))) + (if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f))))) (defn partial "Partial function application." @@ -1855,8 +1855,7 @@ (on-compile-error msg errf where)))) (or guard :a))) (fiber/setenv f env) - (while (let [fs (fiber/status f)] - (and (not= :dead fs) (not= :error fs))) + (while (fiber/can-resume? f) (def res (resume f resumeval)) (when good (when going (set resumeval (onstatus f res)))))) diff --git a/src/core/corelib.c b/src/core/corelib.c index 6e38e1fb..5498fe6a 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -489,6 +489,26 @@ ret_false: return janet_wrap_false(); } +static Janet janet_core_signal(int32_t argc, Janet *argv) { + janet_arity(argc, 1, 2); + int sig; + if (janet_checkint(argv[0])) { + int32_t s = janet_unwrap_integer(argv[0]); + if (s < 0 || s > 9) { + janet_panicf("expected user signal between 0 and 9, got %d", s); + } + sig = JANET_SIGNAL_USER0 + s; + } else { + JanetKeyword kw = janet_getkeyword(argv, 0); + if (!janet_cstrcmp(kw, "yield")) sig = JANET_SIGNAL_YIELD; + if (!janet_cstrcmp(kw, "error")) sig = JANET_SIGNAL_ERROR; + if (!janet_cstrcmp(kw, "debug")) sig = JANET_SIGNAL_DEBUG; + janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]); + } + Janet payload = argc == 2 ? argv[1] : janet_wrap_nil(); + janet_signalv(sig, payload); +} + static const JanetReg corelib_cfuns[] = { { "native", janet_core_native, @@ -679,6 +699,11 @@ static const JanetReg corelib_cfuns[] = { JDOC("(slice x &opt start end)\n\n" "Extract a sub-range of an indexed data strutrue or byte sequence.") }, + { + "signal", janet_core_signal, + JDOC("(signal what x)\n\n" + "Raise a signal with payload x. ") + }, {NULL, NULL, NULL} }; diff --git a/src/core/fiber.c b/src/core/fiber.c index 124b9f39..cac67c40 100644 --- a/src/core/fiber.c +++ b/src/core/fiber.c @@ -386,6 +386,15 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) { JANET_FIBER_MASK_USER | JANET_FIBER_MASK_YIELD; break; + case 't': + fiber->flags |= + JANET_FIBER_MASK_ERROR | + JANET_FIBER_MASK_USER0 | + JANET_FIBER_MASK_USER1 | + JANET_FIBER_MASK_USER2 | + JANET_FIBER_MASK_USER3 | + JANET_FIBER_MASK_USER4; + break; case 'd': fiber->flags |= JANET_FIBER_MASK_DEBUG; break; @@ -448,6 +457,20 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) { return argv[0]; } +static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + JanetFiber *fiber = janet_getfiber(argv, 0); + JanetFiberStatus s = janet_fiber_status(fiber); + int isFinished = s == JANET_STATUS_DEAD || + s == JANET_STATUS_ERROR || + s == JANET_STATUS_USER0 || + s == JANET_STATUS_USER1 || + s == JANET_STATUS_USER2 || + s == JANET_STATUS_USER3 || + s == JANET_STATUS_USER4; + return janet_wrap_boolean(!isFinished); +} + static const JanetReg fiber_cfuns[] = { { "fiber/new", cfun_fiber_new, @@ -463,6 +486,7 @@ static const JanetReg fiber_cfuns[] = { "\ta - block all signals\n" "\td - block debug signals\n" "\te - block error signals\n" + "\tt - block termination signals: error + user[0-4]\n" "\tu - block user signals\n" "\ty - block yield signals\n" "\t0-9 - block a specific user signal\n\n" @@ -513,6 +537,11 @@ static const JanetReg fiber_cfuns[] = { "Sets the environment table for a fiber. Set to nil to remove the current " "environment.") }, + { + "fiber/can-resume?", cfun_fiber_can_resume, + JDOC("(fiber/can-resume? fiber)\n\n" + "Check if a fiber is finished and cannot be resumed.") + }, {NULL, NULL, NULL} }; diff --git a/src/core/vm.c b/src/core/vm.c index 6b918f2d..ef19f5e8 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -1249,6 +1249,7 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) { } if (old_status == JANET_STATUS_ALIVE || old_status == JANET_STATUS_DEAD || + (old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) || old_status == JANET_STATUS_ERROR) { const uint8_t *str = janet_formatc("cannot resume fiber with status :%s", janet_status_names[old_status]); From 738490e67436d78fd4da2ed8f0b66937737e8c85 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 23 Feb 2020 14:47:29 -0600 Subject: [PATCH 07/28] Allow function that takes 1 argument to fiber/new. This allows reuse of closures when creating many fibers. --- src/core/fiber.c | 15 +++++++++++---- src/core/vm.c | 13 +++++++++++++ 2 files changed, 24 insertions(+), 4 deletions(-) diff --git a/src/core/fiber.c b/src/core/fiber.c index cac67c40..6a4c140c 100644 --- a/src/core/fiber.c +++ b/src/core/fiber.c @@ -65,7 +65,14 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t if (newstacktop >= fiber->capacity) { janet_fiber_setcapacity(fiber, 2 * newstacktop); } - safe_memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet)); + if (argv) { + memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet)); + } else { + /* If argv not given, fill with nil */ + for (int32_t i = 0; i < argc; i++) { + fiber->data[fiber->stacktop + i] = janet_wrap_nil(); + } + } fiber->stacktop = newstacktop; } if (janet_fiber_funcframe(fiber, callee)) return NULL; @@ -362,10 +369,10 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) { janet_arity(argc, 1, 2); JanetFunction *func = janet_getfunction(argv, 0); JanetFiber *fiber; - if (func->def->min_arity != 0) { - janet_panic("expected nullary function in fiber constructor"); + if (func->def->min_arity > 1) { + janet_panicf("fiber function must accept 0 or 1 arguments"); } - fiber = janet_fiber(func, 64, 0, NULL); + fiber = janet_fiber(func, 64, func->def->min_arity, NULL); if (argc == 2) { int32_t i; JanetByteView view = janet_getbytes(argv, 1); diff --git a/src/core/vm.c b/src/core/vm.c index ef19f5e8..2ed67d54 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -1270,6 +1270,19 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) { fiber->child = NULL; } + /* Handle new fibers being resumed with a non-nil value */ + if (old_status == JANET_STATUS_NEW && !janet_checktype(in, JANET_NIL)) { + Janet *stack = fiber->data + fiber->frame; + JanetFunction *func = janet_stack_frame(stack)->func; + if (func) { + if (func->def->arity > 0) { + stack[0] = in; + } else if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) { + stack[0] = janet_wrap_tuple(janet_tuple_n(&in, 1)); + } + } + } + /* Save global state */ int32_t oldn = janet_vm_stackn++; int handle = janet_vm_gc_suspend; From f5f3858da1bea00f1d5e3b3d931af3ea87d1681d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 23 Feb 2020 14:55:21 -0600 Subject: [PATCH 08/28] Update CHANGELOG.md --- CHANGELOG.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 96e4e9af..9c367b5a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,15 @@ # Changelog All notable changes to this project will be documented in this file. +## Unreleased +- Add `signal` +- Add `fiber/can-resume?` +- Allow fiber functions to accept arguments that are passed in via `resume`. +- Make flychecking slightly less strict but more useful +- Correct arity for `next` +- Correct arity for `marshal` +- Add `flush` and `eflush` + ## 1.7.0 - 2020-02-01 - Remove `file/fileno` and `file/fdopen`. - Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal From 8c41c0b6a7b9c6e2bcef66fd00495cce16b7d425 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 23 Feb 2020 15:27:57 -0600 Subject: [PATCH 09/28] Address MSVC warning. --- src/boot/boot.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/boot/boot.c b/src/boot/boot.c index 89822336..dd78dadb 100644 --- a/src/boot/boot.c +++ b/src/boot/boot.c @@ -104,7 +104,7 @@ int main(int argc, const char **argv) { } fclose(boot_file); - status = janet_dobytes(env, boot_buffer, boot_size, boot_filename, NULL); + status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL); /* Deinitialize vm */ janet_deinit(); From 59d288c429034109362a60cd244efb4dcc2f513c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 23 Feb 2020 16:35:33 -0600 Subject: [PATCH 10/28] Add `prompt` and `return`. User friendly delimited continuations. While this was doable with signals before, this does not require C and will play nicely with existing error handling, defers, and with statements. --- CHANGELOG.md | 1 + src/boot/boot.janet | 18 ++++++++++++++++++ test/suite8.janet | 20 ++++++++++++++++++++ 3 files changed, 39 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9c367b5a..c7e47c7e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ All notable changes to this project will be documented in this file. - Correct arity for `next` - Correct arity for `marshal` - Add `flush` and `eflush` +- Add `prompt` and `return` on top of signal for user friendly delimited continuations. ## 1.7.0 - 2020-02-01 - Remove `file/fileno` and `file/fdopen`. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 2cc70166..f9c1ba22 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -299,6 +299,24 @@ ,r (propagate ,r ,f))))) +(defmacro prompt + "Set up a prompt point that can be aborted to. Tag should be a value + that is used in a return statement, like a keyword." + [tag & body] + (with-syms [res target payload fib] + ~(do + (def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0)) + (def ,res (,resume ,fib)) + (def [,target ,payload] ,res) + (if (,= ,tag ,target) + ,payload + (propagate ,res ,fib))))) + +(defn return + "Return to a prompt point." + [to value] + (signal 0 [to value])) + (defmacro with "Evaluate body with some resource, which will be automatically cleaned up if there is an error in body. binding is bound to the expression ctor, and diff --git a/test/suite8.janet b/test/suite8.janet index a43777e9..ca496d28 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -70,4 +70,24 @@ (test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--." "Hello, World!") +# Prompts + +(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1") + +(defn- inner-loop + [i] + (if (= i 5) + (return :a 10))) + +(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2") + +(defn- inner-loop2 + [i] + (try + (if (= i 5) + (error 10)) + ([err] (return :a err)))) + +(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3") + (end-suite) From 05bd5767de3be12db53ecf7a2a7828cd053c5368 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 23 Feb 2020 17:15:04 -0600 Subject: [PATCH 11/28] Add label macro. A lexically scoped version of prompt is often useful. --- src/boot/boot.janet | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index f9c1ba22..e3cf2c0e 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -300,7 +300,7 @@ (propagate ,r ,f))))) (defmacro prompt - "Set up a prompt point that can be aborted to. Tag should be a value + "Set up a checkpoint that can be returned to. Tag should be a value that is used in a return statement, like a keyword." [tag & body] (with-syms [res target payload fib] @@ -312,9 +312,17 @@ ,payload (propagate ,res ,fib))))) +(defmacro label + "Set a label point that is lexically scoped. Name should be a symbol + that will be bound to the label." + [name & body] + ~(do + (def ,name ',(gensym)) + ,(apply prompt name body))) + (defn return "Return to a prompt point." - [to value] + [to &opt value] (signal 0 [to value])) (defmacro with From 734c85d7eff01bb726995d901acf62b4fb2ae26d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 23 Feb 2020 17:35:01 -0600 Subject: [PATCH 12/28] Properly handle recursion with labels. Use an empty buffer, which has pointer equality semantics, for tag from a label. --- src/boot/boot.janet | 2 +- test/suite8.janet | 11 ++++++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index e3cf2c0e..78c04a12 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -317,7 +317,7 @@ that will be bound to the label." [name & body] ~(do - (def ,name ',(gensym)) + (def ,name @"") ,(apply prompt name body))) (defn return diff --git a/test/suite8.janet b/test/suite8.janet index ca496d28..c967a3ea 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -70,7 +70,16 @@ (test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--." "Hello, World!") -# Prompts +# Prompts and Labels + +(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1") + +(defn recur + [lab x y] + (when (= x y) (return lab :done)) + (def res (label newlab (recur (or lab newlab) (+ x 1) y))) + (if lab :oops res)) +(assert (= :done (recur nil 0 10)) "label 2") (assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1") From 2779037f1319c2d21ad22fa5e99690773ca075fd Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 25 Feb 2020 20:02:03 -0600 Subject: [PATCH 13/28] Clean up Makefile. --- Makefile | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/Makefile b/Makefile index dff7c925..3ea844e4 100644 --- a/Makefile +++ b/Makefile @@ -37,8 +37,7 @@ MANPATH?=$(PREFIX)/share/man/man1/ PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig DEBUGGER=gdb -CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \ - -DJANET_BUILD=$(JANET_BUILD) +CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden LDFLAGS:=$(LDFLAGS) -rdynamic # For installation @@ -129,14 +128,15 @@ JANET_BOOT_HEADERS=src/boot/tests.h ########################################################## JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) +BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS) $(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS) build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) - $(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $< + $(CC) $(BOOT_CFLAGS) -o $@ -c $< build/janet_boot: $(JANET_BOOT_OBJECTS) - $(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS) + $(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS) # Now the reason we bootstrap in the first place build/janet.c: build/janet_boot src/boot/boot.janet @@ -301,15 +301,5 @@ test-install: cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git -build/embed_janet.o: build/janet.c $(JANET_HEADERS) - $(CC) $(CFLAGS) -c $< -o $@ -build/embed_main.o: test/amalg/main.c $(JANET_HEADERS) - $(CC) $(CFLAGS) -c $< -o $@ -build/embed_test: build/embed_janet.o build/embed_main.o - $(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS) - -test-amalg: build/embed_test - ./build/embed_test - .PHONY: clean install repl debug valgrind test \ valtest emscripten dist uninstall docs grammar format From 8262290bff631239cda07506f7ffd8ee06d2f23d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 25 Feb 2020 20:02:14 -0600 Subject: [PATCH 14/28] Improve C string format (janet_formatc, janet_panicf) The supported formatters here now match up more with the string/format, buffer/format, printf, eprintf, etc. --- src/core/pp.c | 225 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 135 insertions(+), 90 deletions(-) diff --git a/src/core/pp.c b/src/core/pp.c index 4b6a2a90..23e708de 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -688,96 +688,6 @@ static void pushtypes(JanetBuffer *buffer, int types) { } } -void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) { - for (const char *c = format; *c; c++) { - switch (*c) { - default: - janet_buffer_push_u8(bufp, *c); - break; - case '%': { - if (c[1] == '\0') - break; - switch (*++c) { - default: - janet_buffer_push_u8(bufp, *c); - break; - case 'f': - number_to_string_b(bufp, va_arg(args, double)); - break; - case 'd': - integer_to_string_b(bufp, va_arg(args, long)); - break; - case 'S': { - const uint8_t *str = va_arg(args, const uint8_t *); - janet_buffer_push_bytes(bufp, str, janet_string_length(str)); - break; - } - case 's': - janet_buffer_push_cstring(bufp, va_arg(args, const char *)); - break; - case 'c': - janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long)); - break; - case 'q': { - const uint8_t *str = va_arg(args, const uint8_t *); - janet_escape_string_b(bufp, str); - break; - } - case 't': { - janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet))); - break; - } - case 'T': { - int types = va_arg(args, long); - pushtypes(bufp, types); - break; - } - case 'V': { - janet_to_string_b(bufp, va_arg(args, Janet)); - break; - } - case 'v': { - janet_description_b(bufp, va_arg(args, Janet)); - break; - } - case 'p': { - janet_pretty(bufp, 4, 0, va_arg(args, Janet)); - break; - } - case 'P': { - janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet)); - break; - } - } - } - } - } -} - -/* Helper function for formatting strings. Useful for generating error messages and the like. - * Similar to printf, but specialized for operating with janet. */ -const uint8_t *janet_formatc(const char *format, ...) { - va_list args; - const uint8_t *ret; - JanetBuffer buffer; - int32_t len = 0; - - /* Calculate length, init buffer and args */ - while (format[len]) len++; - janet_buffer_init(&buffer, len); - va_start(args, format); - - /* Run format */ - janet_formatb(&buffer, format, args); - - /* Iterate length */ - va_end(args); - - ret = janet_string(buffer.data, buffer.count); - janet_buffer_deinit(&buffer); - return ret; -} - /* * code adapted from lua/lstrlib.c http://lua.org */ @@ -818,6 +728,141 @@ static const char *scanformat( return p; } +void janet_formatb(JanetBuffer *b, const char *format, va_list args) { + const char *format_end = format + strlen(format); + const char *c = format; + int32_t startlen = b->count; + while (c < format_end) { + if (*c != '%') { + janet_buffer_push_u8(b, (uint8_t) *c++); + } else if (*++c == '%') { + janet_buffer_push_u8(b, (uint8_t) *c++); + } else { + char form[MAX_FORMAT], item[MAX_ITEM]; + char width[3], precision[3]; + int nb = 0; /* number of bytes in added item */ + c = scanformat(c, form, width, precision); + switch (*c++) { + case 'c': { + int n = va_arg(args, long); + nb = snprintf(item, MAX_ITEM, form, n); + break; + } + case 'd': + case 'i': + case 'o': + case 'u': + case 'x': + case 'X': { + int32_t n = va_arg(args, long); + nb = snprintf(item, MAX_ITEM, form, n); + break; + } + case 'a': + case 'A': + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': { + double d = va_arg(args, double); + nb = snprintf(item, MAX_ITEM, form, d); + break; + } + case 's': + case 'S': { + const char *str = va_arg(args, const char *); + int32_t len = c[-1] == 's' + ? (int32_t) strlen(str) + : janet_string_length((JanetString) str); + if (form[2] == '\0') + janet_buffer_push_bytes(b, (const uint8_t *) str, len); + else { + if (len != (int32_t) strlen((const char *) str)) + janet_panic("string contains zeros"); + if (!strchr(form, '.') && len >= 100) { + janet_panic("no precision and string is too long to be formatted"); + } else { + nb = snprintf(item, MAX_ITEM, form, str); + } + } + break; + } + case 'V': + janet_to_string_b(b, va_arg(args, Janet)); + break; + case 'v': + janet_description_b(b, va_arg(args, Janet)); + break; + case 't': + janet_buffer_push_cstring(b, typestr(va_arg(args, Janet))); + break; + case 'T': { + int types = va_arg(args, long); + pushtypes(b, types); + break; + } + case 'Q': + case 'q': + case 'P': + case 'p': { /* janet pretty , precision = depth */ + int depth = atoi(precision); + if (depth < 1) depth = 4; + char d = c[-1]; + int has_color = (d == 'P') || (d == 'Q'); + int has_oneline = (d == 'Q') || (d == 'q'); + int flags = 0; + flags |= has_color ? JANET_PRETTY_COLOR : 0; + flags |= has_oneline ? JANET_PRETTY_ONELINE : 0; + janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen); + break; + } + case 'j': { + int depth = atoi(precision); + if (depth < 1) + depth = JANET_RECURSION_GUARD; + janet_jdn_(b, depth, va_arg(args, Janet), startlen); + break; + } + default: { + /* also treat cases 'nLlh' */ + janet_panicf("invalid conversion '%s' to 'format'", + form); + } + } + if (nb >= MAX_ITEM) + janet_panicf("format buffer overflow", form); + if (nb > 0) + janet_buffer_push_bytes(b, (uint8_t *) item, nb); + } + + } +} + +/* Helper function for formatting strings. Useful for generating error messages and the like. + * Similar to printf, but specialized for operating with janet. */ +const uint8_t *janet_formatc(const char *format, ...) { + va_list args; + const uint8_t *ret; + JanetBuffer buffer; + int32_t len = 0; + + /* Calculate length, init buffer and args */ + while (format[len]) len++; + janet_buffer_init(&buffer, len); + va_start(args, format); + + /* Run format */ + janet_formatb(&buffer, format, args); + + /* Iterate length */ + va_end(args); + + ret = janet_string(buffer.data, buffer.count); + janet_buffer_deinit(&buffer); + return ret; +} + /* Shared implementation between string/format and * buffer/format */ void janet_buffer_format( From 7d26de6697ef64f0badcc05177489351bbcd9c75 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 25 Feb 2020 20:08:22 -0600 Subject: [PATCH 15/28] Update changelog. --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c7e47c7e..5d167fb2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased +- Improve `janet_formatc` and `janet_panicf` formatters to be more like `string/format`. + This makes it easier to make nice error messages from C. - Add `signal` - Add `fiber/can-resume?` - Allow fiber functions to accept arguments that are passed in via `resume`. From 8cb63cebbe0a7c705edc2162142a78adada7c6ca Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 25 Feb 2020 20:31:38 -0600 Subject: [PATCH 16/28] Remove 'make test-amalg' from CI. --- .builds/.freebsd.yaml | 1 - .builds/.openbsd.yaml | 1 - .travis.yml | 1 - 3 files changed, 3 deletions(-) diff --git a/.builds/.freebsd.yaml b/.builds/.freebsd.yaml index e430138e..a2b4b589 100644 --- a/.builds/.freebsd.yaml +++ b/.builds/.freebsd.yaml @@ -10,4 +10,3 @@ tasks: gmake test sudo gmake install gmake test-install - gmake test-amalg diff --git a/.builds/.openbsd.yaml b/.builds/.openbsd.yaml index 1203a4d8..89d411f0 100644 --- a/.builds/.openbsd.yaml +++ b/.builds/.openbsd.yaml @@ -10,4 +10,3 @@ tasks: gmake test doas gmake install gmake test-install - gmake test-amalg diff --git a/.travis.yml b/.travis.yml index 64bb8b5f..67c71a42 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,7 +4,6 @@ script: - make test - sudo make install - make test-install -- make test-amalg - make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz compiler: - clang From 10ec319c32e5e2863fa809ddb6187ff3aeef5899 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 27 Feb 2020 00:16:54 -0600 Subject: [PATCH 17/28] Add better debug info to amalgamated source. --- src/boot/boot.c | 1 + src/boot/boot.janet | 3 ++- src/include/janet.h | 4 ++-- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/boot/boot.c b/src/boot/boot.c index dd78dadb..2fae36f2 100644 --- a/src/boot/boot.c +++ b/src/boot/boot.c @@ -105,6 +105,7 @@ int main(int argc, const char **argv) { fclose(boot_file); status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL); + free(boot_buffer); /* Deinitialize vm */ janet_deinit(); diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 78c04a12..55328943 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2522,7 +2522,8 @@ (defn do-one-flie [fname] - (print "\n/* " fname " */\n") + (print "\n/* " fname " */") + (print "#line 0 \"" fname "\"\n") (def source (slurp fname)) (print (string/replace-all "\r" "" source))) diff --git a/src/include/janet.h b/src/include/janet.h index cc8d7069..46e65558 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -681,8 +681,8 @@ JANET_API int janet_checkint(Janet x); JANET_API int janet_checkint64(Janet x); JANET_API int janet_checksize(Janet x); JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at); -#define janet_checkintrange(x) ((x) == (int32_t)(x)) -#define janet_checkint64range(x) ((x) == (int64_t)(x)) +#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x)) +#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x)) #define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x)) #define janet_wrap_integer(x) janet_wrap_number((int32_t)(x)) From 6b093bdcca9f055f82770c0adea20ab384d9c4d3 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 27 Feb 2020 17:58:17 -0600 Subject: [PATCH 18/28] Address #288 and partially #287 The %q formatter for janet_formatc now expects a Janet, not a JanetString or JanetSymbol or JanetKeyword. Also fix some reference counting issues with threads when destroying threads, which should fix #287's SIGSEGV. Still fails to send messages sometimes, though. --- src/core/compile.c | 2 +- src/core/thread.c | 70 +++++++++++++++++++++++++++------------------- 2 files changed, 43 insertions(+), 29 deletions(-) diff --git a/src/core/compile.c b/src/core/compile.c index 4c69c2ef..b95e0096 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -202,7 +202,7 @@ JanetSlot janetc_resolve( switch (btype) { default: case JANET_BINDING_NONE: - janetc_error(c, janet_formatc("unknown symbol %q", sym)); + janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym))); return janetc_cslot(janet_wrap_nil()); case JANET_BINDING_DEF: case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */ diff --git a/src/core/thread.c b/src/core/thread.c index 370e3359..61f23b52 100644 --- a/src/core/thread.c +++ b/src/core/thread.c @@ -51,10 +51,6 @@ struct JanetMailbox { pthread_cond_t cond; #endif - /* Setup procedure - requires a parent mailbox - * to receive thunk from */ - JanetMailbox *parent; - /* Memory management - reference counting */ int refCount; int closed; @@ -70,6 +66,11 @@ struct JanetMailbox { JanetBuffer messages[]; }; +typedef struct { + JanetMailbox *original; + JanetMailbox *newbox; +} JanetMailboxPair; + static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL; static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL; static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL; @@ -82,7 +83,7 @@ static JanetTable *janet_thread_get_decode(void) { return janet_vm_thread_decode; } -static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) { +static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) { JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity); if (NULL == mailbox) { JANET_OUT_OF_MEMORY; @@ -96,7 +97,6 @@ static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, ui #endif mailbox->refCount = refCount; mailbox->closed = 0; - mailbox->parent = parent; mailbox->messageCount = 0; mailbox->messageCapacity = capacity; mailbox->messageFirst = 0; @@ -175,6 +175,23 @@ static int thread_mark(void *p, size_t size) { return 0; } +static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) { + JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair)); + if (NULL == pair) { + JANET_OUT_OF_MEMORY; + } + pair->original = original; + janet_mailbox_ref(original, 1); + pair->newbox = janet_mailbox_create(1, 16); + return pair; +} + +static void destory_mailbox_pair(JanetMailboxPair *pair) { + janet_mailbox_ref(pair->original, -1); + janet_mailbox_ref(pair->newbox, -1); + free(pair); +} + /* Abstract waiting for timeout across windows/posix */ typedef struct { int timedwait; @@ -402,6 +419,7 @@ static JanetAbstractType Thread_AT = { static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) { JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread)); + janet_mailbox_ref(mailbox, 1); thread->mailbox = mailbox; thread->encode = encode; return thread; @@ -412,12 +430,13 @@ JanetThread *janet_getthread(const Janet *argv, int32_t n) { } /* Runs in new thread */ -static int thread_worker(JanetMailbox *mailbox) { +static int thread_worker(JanetMailboxPair *pair) { JanetFiber *fiber = NULL; Janet out; /* Use the mailbox we were given */ - janet_vm_mailbox = mailbox; + janet_vm_mailbox = pair->newbox; + janet_mailbox_ref(pair->newbox, 1); /* Init VM */ janet_init(); @@ -426,9 +445,7 @@ static int thread_worker(JanetMailbox *mailbox) { JanetTable *encode = janet_get_core_table("make-image-dict"); /* Create parent thread */ - JanetThread *parent = janet_make_thread(mailbox->parent, encode); - janet_mailbox_ref(mailbox->parent, -1); - mailbox->parent = NULL; /* only used to create the thread */ + JanetThread *parent = janet_make_thread(pair->original, encode); Janet parentv = janet_wrap_abstract(parent); /* Unmarshal the function */ @@ -449,16 +466,18 @@ static int thread_worker(JanetMailbox *mailbox) { fiber = janet_fiber(func, 64, 1, argv); JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out); if (sig != JANET_SIGNAL_OK) { - janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(mailbox, encode))); + janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode))); janet_stacktrace(fiber, out); } /* Normal exit */ + destory_mailbox_pair(pair); janet_deinit(); return 0; /* Fail to set something up */ error: + destory_mailbox_pair(pair); janet_eprintf("\nthread failed to start\n"); janet_deinit(); return 1; @@ -467,12 +486,12 @@ error: #ifdef JANET_WINDOWS static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) { - thread_worker((JanetMailbox *)param); + thread_worker((JanetMailboxPair *)param); return 0; } -static int janet_thread_start_child(JanetThread *thread) { - HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, thread->mailbox, 0, NULL); +static int janet_thread_start_child(JanetMailboxPair *pair) { + HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL); int ret = NULL == handle; /* Does not kill thread, simply detatches */ if (!ret) CloseHandle(handle); @@ -482,13 +501,13 @@ static int janet_thread_start_child(JanetThread *thread) { #else static void *janet_pthread_wrapper(void *param) { - thread_worker((JanetMailbox *)param); + thread_worker((JanetMailboxPair *)param); return NULL; } -static int janet_thread_start_child(JanetThread *thread) { +static int janet_thread_start_child(JanetMailboxPair *pair) { pthread_t handle; - int error = pthread_create(&handle, NULL, janet_pthread_wrapper, thread->mailbox); + int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair); if (error) { return 1; } else { @@ -505,7 +524,7 @@ static int janet_thread_start_child(JanetThread *thread) { void janet_threads_init(void) { if (NULL == janet_vm_mailbox) { - janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10); + janet_vm_mailbox = janet_mailbox_create(1, 10); } janet_vm_thread_decode = NULL; janet_vm_thread_current = NULL; @@ -529,7 +548,6 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) { janet_fixarity(argc, 0); if (NULL == janet_vm_thread_current) { janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict")); - janet_mailbox_ref(janet_vm_mailbox, 1); janet_gcroot(janet_wrap_abstract(janet_vm_thread_current)); } return janet_wrap_abstract(janet_vm_thread_current); @@ -544,15 +562,11 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) { janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap); } JanetTable *encode = janet_get_core_table("make-image-dict"); - JanetMailbox *mailbox = janet_mailbox_create(janet_vm_mailbox, 2, (uint16_t) cap); - /* one for created thread, one for ->parent reference in new mailbox */ - janet_mailbox_ref(janet_vm_mailbox, 2); - - JanetThread *thread = janet_make_thread(mailbox, encode); - if (janet_thread_start_child(thread)) { - janet_mailbox_ref(mailbox, -1); /* mailbox reference */ - janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */ + JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox); + JanetThread *thread = janet_make_thread(pair->newbox, encode); + if (janet_thread_start_child(pair)) { + destory_mailbox_pair(pair); janet_panic("could not start thread"); } From b17bf259f725a6b1f045522af1121fafbf209f41 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 28 Feb 2020 09:04:28 -0600 Subject: [PATCH 19/28] Fix typo: destory -> destroy --- src/core/thread.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/thread.c b/src/core/thread.c index 61f23b52..109e4939 100644 --- a/src/core/thread.c +++ b/src/core/thread.c @@ -186,7 +186,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) { return pair; } -static void destory_mailbox_pair(JanetMailboxPair *pair) { +static void destroy_mailbox_pair(JanetMailboxPair *pair) { janet_mailbox_ref(pair->original, -1); janet_mailbox_ref(pair->newbox, -1); free(pair); @@ -471,13 +471,13 @@ static int thread_worker(JanetMailboxPair *pair) { } /* Normal exit */ - destory_mailbox_pair(pair); + destroy_mailbox_pair(pair); janet_deinit(); return 0; /* Fail to set something up */ error: - destory_mailbox_pair(pair); + destroy_mailbox_pair(pair); janet_eprintf("\nthread failed to start\n"); janet_deinit(); return 1; @@ -566,7 +566,7 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) { JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox); JanetThread *thread = janet_make_thread(pair->newbox, encode); if (janet_thread_start_child(pair)) { - destory_mailbox_pair(pair); + destroy_mailbox_pair(pair); janet_panic("could not start thread"); } From 2349ea94055a86c71afff75920f17f9a361379f0 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 1 Mar 2020 12:05:24 -0600 Subject: [PATCH 20/28] Update docs for buffer/push-word Should be little endian, not big endian. --- src/core/buffer.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/buffer.c b/src/core/buffer.c index 1f2327a5..85213ad7 100644 --- a/src/core/buffer.c +++ b/src/core/buffer.c @@ -387,7 +387,7 @@ static const JanetReg buffer_cfuns[] = { "buffer/push-word", cfun_buffer_word, JDOC("(buffer/push-word buffer x)\n\n" "Append a machine word to a buffer. The 4 bytes of the integer are appended " - "in twos complement, big endian order, unsigned. Returns the modified buffer. Will " + "in twos complement, little endian order, unsigned. Returns the modified buffer. Will " "throw an error if the buffer overflows.") }, { From 951e10f27220fe9bed6862ff61058328866a562e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Mar 2020 08:21:14 -0600 Subject: [PATCH 21/28] Address #292 Faulty Makefile fallback. --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 3ea844e4..51d9d1e4 100644 --- a/Makefile +++ b/Makefile @@ -27,7 +27,7 @@ PREFIX?=/usr/local INCLUDEDIR?=$(PREFIX)/include BINDIR?=$(PREFIX)/bin LIBDIR?=$(PREFIX)/lib -JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\"" +JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\"" CLIBS=-lm -lpthread JANET_TARGET=build/janet JANET_LIBRARY=build/libjanet.so From 8580d3c27e31f1dfb5c9b10138f7c3ce113cf026 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Mar 2020 17:44:44 -0600 Subject: [PATCH 22/28] Address #240 - Support DESTDIR in Makefile. --- Makefile | 52 ++++++++++++++++++++++++++-------------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/Makefile b/Makefile index 51d9d1e4..d6daee37 100644 --- a/Makefile +++ b/Makefile @@ -41,7 +41,7 @@ CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvi LDFLAGS:=$(LDFLAGS) -rdynamic # For installation -LDCONFIG:=ldconfig "$(LIBDIR)" +LDCONFIG:=ldconfig "$(DESTDIR)$(LIBDIR)" # Check OS UNAME:=$(shell uname -s) @@ -230,7 +230,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet SONAME=libjanet.so.1 -.PHONY: build/janet.pc +.INTERMEDIATE: build/janet.pc build/janet.pc: $(JANET_TARGET) echo 'prefix=$(PREFIX)' > $@ echo 'exec_prefix=$${prefix}' >> $@ @@ -246,33 +246,33 @@ build/janet.pc: $(JANET_TARGET) echo 'Libs.private: $(CLIBS)' >> $@ install: $(JANET_TARGET) build/janet.pc - mkdir -p '$(BINDIR)' - cp $(JANET_TARGET) '$(BINDIR)/janet' - mkdir -p '$(INCLUDEDIR)/janet' - cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet' - mkdir -p '$(JANET_PATH)' - mkdir -p '$(LIBDIR)' - cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' - cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a' - ln -sf $(SONAME) '$(LIBDIR)/libjanet.so' - ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME) - cp -rf auxbin/* '$(BINDIR)' - mkdir -p '$(MANPATH)' - cp janet.1 '$(MANPATH)' - cp jpm.1 '$(MANPATH)' - mkdir -p '$(PKG_CONFIG_PATH)' - cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc' + mkdir -p '$(DESTDIR)$(BINDIR)' + cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' + mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' + cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet' + mkdir -p '$(DESTDIR)$(JANET_PATH)' + mkdir -p '$(DESTDIR)$(LIBDIR)' + cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' + cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a' + ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' + ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) + cp -rf auxbin/* '$(DESTDIR)$(BINDIR)' + mkdir -p '$(DESTDIR)$(MANPATH)' + cp janet.1 '$(DESTDIR)$(MANPATH)' + cp jpm.1 '$(DESTDIR)$(MANPATH)' + mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)' + cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc' -$(LDCONFIG) uninstall: - -rm '$(BINDIR)/janet' - -rm '$(BINDIR)/jpm' - -rm -rf '$(INCLUDEDIR)/janet' - -rm -rf '$(LIBDIR)'/libjanet.* - -rm '$(PKG_CONFIG_PATH)/janet.pc' - -rm '$(MANPATH)/janet.1' - -rm '$(MANPATH)/jpm.1' - # -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here + -rm '$(DESTDIR)$(BINDIR)/janet' + -rm '$(DESTDIR)$(BINDIR)/jpm' + -rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet' + -rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.* + -rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc' + -rm '$(DESTDIR)$(MANPATH)/janet.1' + -rm '$(DESTDIR)$(MANPATH)/jpm.1' + # -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here ################# ##### Other ##### From 7c2c50ee16d17cedef0d5fe4f572115fb7bcb6be Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Mar 2020 18:03:44 -0600 Subject: [PATCH 23/28] For #240 - don't run ldconfig for DESTDIR installs. --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index d6daee37..52927abb 100644 --- a/Makefile +++ b/Makefile @@ -41,7 +41,7 @@ CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvi LDFLAGS:=$(LDFLAGS) -rdynamic # For installation -LDCONFIG:=ldconfig "$(DESTDIR)$(LIBDIR)" +LDCONFIG:=ldconfig "$(LIBDIR)" # Check OS UNAME:=$(shell uname -s) @@ -262,7 +262,7 @@ install: $(JANET_TARGET) build/janet.pc cp jpm.1 '$(DESTDIR)$(MANPATH)' mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)' cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc' - -$(LDCONFIG) + [ -z '$(DESTDIR)' ] && $(LDCONFIG) || true uninstall: -rm '$(DESTDIR)$(BINDIR)/janet' From f06addfe0613fb072814056d6f1b411031d59e60 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Mar 2020 18:13:25 -0600 Subject: [PATCH 24/28] For #240, address case when LDCONFIG is empty --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 52927abb..9b38f6ce 100644 --- a/Makefile +++ b/Makefile @@ -47,13 +47,13 @@ LDCONFIG:=ldconfig "$(LIBDIR)" UNAME:=$(shell uname -s) ifeq ($(UNAME), Darwin) CLIBS:=$(CLIBS) -ldl - LDCONFIG:= + LDCONFIG:=true else ifeq ($(UNAME), Linux) CLIBS:=$(CLIBS) -lrt -ldl endif # For other unix likes, add flags here! ifeq ($(UNAME), Haiku) - LDCONFIG:= + LDCONFIG:=true LDFLAGS=-Wl,--export-dynamic endif From 6bc67b70a6e78fd8ff3596030250fb602d3ab175 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Mar 2020 22:26:26 -0600 Subject: [PATCH 25/28] Address #294 Correct invalid format string, which masked a panic with another, less useful panic. --- src/core/peg.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/peg.c b/src/core/peg.c index 07775412..6e839f9e 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -476,7 +476,7 @@ JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) { static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) { if (argc != arity) { - peg_panicf(b, "expected %d argument%s, got %d%", + peg_panicf(b, "expected %d argument%s, got %d", arity, arity == 1 ? "" : "s", argc); From a07de921d0c02b72b58e452c71fca9dc3027498b Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Wed, 4 Mar 2020 14:35:57 +0100 Subject: [PATCH 26/28] Create janet.pc also from Meson. --- meson.build | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/meson.build b/meson.build index e4919b9f..41cf36d1 100644 --- a/meson.build +++ b/meson.build @@ -230,6 +230,11 @@ run_target('repl', command : [janet_nativeclient]) janet_dep = declare_dependency(include_directories : incdir, link_with : libjanet) +# pkgconfig +pkg = import('pkgconfig') +pkg.generate(libjanet, + description: 'Library for the Janet programming language.') + # Installation install_man('janet.1') install_man('jpm.1') From bc2ebce0869d6c9cf233a8a818832c072e45fc40 Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Wed, 4 Mar 2020 14:56:04 +0100 Subject: [PATCH 27/28] Make ctrl-d behave like delete, but exit on an empty line. This is the default readline behavior. --- src/mainclient/shell.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c index 1ef3fd5c..9b736627 100644 --- a/src/mainclient/shell.c +++ b/src/mainclient/shell.c @@ -620,8 +620,12 @@ static int line() { clearlines(); return -1; case 4: /* ctrl-d, eof */ - clearlines(); - return -1; + if (gbl_len == 0) { /* quit on empty line */ + clearlines(); + return -1; + } + kdelete(1); + break; case 5: /* ctrl-e */ gbl_pos = gbl_len; refresh(); From 47e8f669f5bc5f5c10d93ad2ebaf71690c98356d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 5 Mar 2020 09:32:43 -0600 Subject: [PATCH 28/28] Fix match behavior for lone nil. --- src/boot/boot.janet | 20 +++++++++++--------- test/suite8.janet | 8 ++++++++ 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 55328943..1b61e6df 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1317,7 +1317,7 @@ ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel) (do (put seen pattern true) - ~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch)))) + ~(do (def ,pattern ,expr) ,(onmatch)))) (and (tuple? pattern) (= :parens (tuple/type pattern))) (if (and (= (pattern 0) '@) (symbol? (pattern 1))) @@ -1334,12 +1334,14 @@ (var i -1) (with-idemp $arr expr - ~(if (indexed? ,$arr) - ,((fn aux [] - (++ i) - (if (= i len) - (onmatch) - (match-1 (in pattern i) (tuple in $arr i) aux seen)))) + ~(if (,indexed? ,$arr) + (if (< (,length ,$arr) ,len) + ,sentinel + ,((fn aux [] + (++ i) + (if (= i len) + (onmatch) + (match-1 (in pattern i) (tuple in $arr i) aux seen))))) ,sentinel))) (dictionary? pattern) @@ -1347,12 +1349,12 @@ (var key nil) (with-idemp $dict expr - ~(if (dictionary? ,$dict) + ~(if (,dictionary? ,$dict) ,((fn aux [] (set key (next pattern key)) (if (= key nil) (onmatch) - (match-1 (in pattern key) (tuple in $dict key) aux seen)))) + (match-1 [(in pattern key) [not= (in pattern key) nil]] [in $dict key] aux seen)))) ,sentinel))) :else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel))) diff --git a/test/suite8.janet b/test/suite8.janet index c967a3ea..4c948511 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -99,4 +99,12 @@ (assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3") +# Match checks + +(assert (= :hi (match nil nil :hi)) "match 1") +(assert (= :hi (match {:a :hi} {:a a} a)) "match 2") +(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3") +(assert (= nil (match [1 2] [a b c] a)) "match 4") +(assert (= 2 (match [1 2] [a b] b)) "match 5") + (end-suite)