From 73db8584e0b0d3ce8925e511685da8cc6ae3883a Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Tue, 3 Dec 2019 21:14:00 +1300 Subject: [PATCH 01/15] Fix typo. --- 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 060e25b8..323c2c3a 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -888,7 +888,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) { for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) { peg = janet_table_get_ex(grammar, peg, &grammar); if (!grammar || janet_checktype(peg, JANET_NIL)) - peg_panic(b, "unkown rule"); + peg_panic(b, "unknown rule"); b->form = peg; b->grammar = grammar; } From a20e956f6ddd37f3cdef07b241454015e113b572 Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Tue, 3 Dec 2019 22:05:43 +1300 Subject: [PATCH 02/15] Explain the logic behind negative slice indices. --- src/core/array.c | 3 ++- src/core/string.c | 3 ++- src/core/tuple.c | 5 ++++- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/core/array.c b/src/core/array.c index 1eb67061..2e2a6692 100644 --- a/src/core/array.c +++ b/src/core/array.c @@ -273,7 +273,8 @@ static const JanetReg array_cfuns[] = { "Takes a slice of array or tuple from start to end. The range is half open, " "[start, end). Indexes can also be negative, indicating indexing from the end of the " "end of the array. By default, start is 0 and end is the length of the array. " - "Returns a new array.") + "Note that index -1 is synonymous with index (length arrtup) to allow a full " + "negative slice range. Returns a new array.") }, { "array/concat", cfun_array_concat, diff --git a/src/core/string.c b/src/core/string.c index f9cb04b6..f4fb92e3 100644 --- a/src/core/string.c +++ b/src/core/string.c @@ -525,7 +525,8 @@ static const JanetReg string_cfuns[] = { "Returns a substring from a byte sequence. The substring is from " "index start inclusive to index end exclusive. All indexing " "is from 0. 'start' and 'end' can also be negative to indicate indexing " - "from the end of the string.") + "from the end of the string. Note that index -1 is synonymous with " + "index (length bytes) to allow a full negative slice range. ") }, { "string/repeat", cfun_string_repeat, diff --git a/src/core/tuple.c b/src/core/tuple.c index c87653ac..19ce92d6 100644 --- a/src/core/tuple.c +++ b/src/core/tuple.c @@ -143,7 +143,10 @@ static const JanetReg tuple_cfuns[] = { JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n" "Take a sub sequence of an array or tuple from index start " "inclusive to index end exclusive. If start or end are not provided, " - "they default to 0 and the length of arrtup respectively." + "they default to 0 and the length of arrtup respectively. " + "'start' and 'end' can also be negative to indicate indexing " + "from the end of the input. Note that index -1 is synonymous with " + "index '(length arrtup)' to allow a full negative slice range. " "Returns the new tuple.") }, { From 9911c90b1d567905f2c14dce3ab864f75931daaa Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Wed, 4 Dec 2019 13:58:21 +1300 Subject: [PATCH 03/15] Handle missing get case. --- src/core/value.c | 7 ++++++- test/suite0.janet | 2 ++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/core/value.c b/src/core/value.c index bc1c43ad..1189e3fb 100644 --- a/src/core/value.c +++ b/src/core/value.c @@ -229,7 +229,8 @@ Janet janet_get(Janet ds, Janet key) { return (type->get)(abst, key); } case JANET_ARRAY: - case JANET_TUPLE: { + case JANET_TUPLE: + case JANET_BUFFER: { if (!janet_checkint(key)) return janet_wrap_nil(); int32_t index = janet_unwrap_integer(key); if (index < 0) return janet_wrap_nil(); @@ -237,6 +238,10 @@ Janet janet_get(Janet ds, Janet key) { JanetArray *a = janet_unwrap_array(ds); if (index >= a->count) return janet_wrap_nil(); return a->data[index]; + } else if (t == JANET_BUFFER) { + JanetBuffer *b = janet_unwrap_buffer(ds); + if (index >= b->count) return janet_wrap_nil(); + return janet_wrap_integer(b->data[index]); } else { const Janet *t = janet_unwrap_tuple(ds); if (index >= janet_tuple_length(t)) return janet_wrap_nil(); diff --git a/test/suite0.janet b/test/suite0.janet index b13ee819..16b764d3 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -55,6 +55,8 @@ (assert (= (get @{} 1) nil) "get nil from empty table") (assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct") (assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table") +(assert (= (get @"\0" 0) 0) "get non nil from buffer") +(assert (= (get @"\0" 1) nil) "get nil from buffer oob") (assert (put @{} :boop :bap) "can add to empty table") (assert (put @{1 3} :boop :bap) "can add to non-empty table") From 0ac5b243c723f079dc88325c5be4be8dfd9d324f Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Wed, 4 Dec 2019 11:29:11 +1300 Subject: [PATCH 04/15] Add os/cryptorand. --- src/core/os.c | 70 +++++++++++++++++++++++++++++++++++++++++++-- src/include/janet.h | 6 +++- test/suite7.janet | 22 ++++++++++++++ tools/format.sh | 2 +- 4 files changed, 95 insertions(+), 5 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 65479f7f..dc617996 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -25,8 +25,6 @@ #include "util.h" #endif -#include - #ifndef JANET_REDUCED_OS #include @@ -36,6 +34,8 @@ #include #include +#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR) + #ifdef JANET_WINDOWS #include #include @@ -473,12 +473,13 @@ static Janet os_sleep(int32_t argc, Janet *argv) { #ifdef JANET_WINDOWS Sleep((DWORD)(delay * 1000)); #else + int rc; struct timespec ts; ts.tv_sec = (time_t) delay; ts.tv_nsec = (delay <= UINT32_MAX) ? (long)((delay - ((uint32_t)delay)) * 1000000000) : 0; - nanosleep(&ts, NULL); + RETRY_EINTR(rc, nanosleep(&ts, &ts)); #endif return janet_wrap_nil(); } @@ -497,6 +498,64 @@ static Janet os_cwd(int32_t argc, Janet *argv) { return janet_cstringv(ptr); } +static Janet os_cryptorand(int32_t argc, Janet *argv) { + JanetBuffer *buffer; + const char *genericerr = "unable to get sufficient random data"; + janet_arity(argc, 1, 2); + int32_t offset; + int32_t n = janet_getinteger(argv, 0); + if (n < 0) janet_panic("expected positive integer"); + if (argc == 2) { + buffer = janet_getbuffer(argv, 1); + offset = buffer->count; + } else { + offset = 0; + buffer = janet_buffer(n); + } + /* We could optimize here by adding setcount_uninit */ + janet_buffer_setcount(buffer, offset + n); + +#ifdef JANET_WINDOWS + for (int32_t i = offset; i < buffer->count; i += sizeof(unsigned int)) { + unsigned int v; + if (rand_s(&v)) + janet_panic(genericerr); + for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < buffer->count); j++) { + buffer->data[i + j] = v & 0xff; + v = v >> 8; + } + } +#elif defined(__linux__) || defined(__APPLE__) + /* We should be able to call getrandom on linux, but it doesn't seem + to be uniformly supported on linux distros. Macos may support + arc4random_buf, but it needs investigation. + + In both cases, use this fallback path for now... */ + int rc; + int randfd; + RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY)); + if (randfd < 0) + janet_panic(genericerr); + while (n > 0) { + ssize_t nread; + RETRY_EINTR(nread, read(randfd, buffer->data + offset, n)); + if (nread <= 0) { + RETRY_EINTR(rc, close(randfd)); + janet_panic(genericerr); + } + offset += nread; + n -= nread; + } + RETRY_EINTR(rc, close(randfd)); +#elif defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) + (void) errmsg; + arc4random_buf(buffer->data + offset, n); +#else + janet_panic("cryptorand currently unsupported on this platform"); +#endif + return janet_wrap_buffer(buffer); +} + static Janet os_date(int32_t argc, Janet *argv) { janet_arity(argc, 0, 2); (void) argv; @@ -981,6 +1040,11 @@ static const JanetReg os_cfuns[] = { JDOC("(os/cwd)\n\n" "Returns the current working directory.") }, + { + "os/cryptorand", os_cryptorand, + JDOC("(os/cryptorand n &opt buf)\n\n" + "Get or append n bytes of good quality random data provided by the os. Returns a new buffer or buf.") + }, { "os/date", os_date, JDOC("(os/date &opt time local)\n\n" diff --git a/src/include/janet.h b/src/include/janet.h index 02219c8d..e0bd5027 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -228,9 +228,13 @@ typedef struct { /***** START SECTION TYPES *****/ +#ifdef JANET_WINDOWS +// Must be defined before including stdlib.h +#define _CRT_RAND_S +#endif +#include #include #include -#include #include #include #include diff --git a/test/suite7.janet b/test/suite7.janet index 430951a1..3b1f6957 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -238,4 +238,26 @@ # Issue #183 - just parse it :) 1e-4000000000000000000000 +# Ensure randomness puts n of pred into our buffer eventually +(defn cryptorand-check + [n pred] + (def max-attempts 10000) + (var attempts 0) + (while (not= attempts max-attempts) + (def cryptobuf (os/cryptorand 10)) + (when (= n (count pred cryptobuf)) + (break)) + (++ attempts)) + (not= attempts max-attempts)) + +(def v (math/rng-int (math/rng (os/time)) 100)) +(assert (cryptorand-check 0 |(= $ v)) "cryptorand skips value sometimes") +(assert (cryptorand-check 1 |(= $ v)) "cryptorand has value sometimes") + +(do + (def buf (buffer/new-filled 1)) + (os/cryptorand 1 buf) + (assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer") + (assert (= (length buf) 2) "cryptorand appends to buffer")) + (end-suite) diff --git a/tools/format.sh b/tools/format.sh index 8d2ba436..f5b4a88c 100755 --- a/tools/format.sh +++ b/tools/format.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash # Format all code with astyle From 70328437f136ca762fbc7a19b9058df333479b76 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Dec 2019 20:33:21 -0600 Subject: [PATCH 05/15] Add math/rng-buffer. Allow math/seedrandom to use buffer as seed. --- src/core/math.c | 55 +++++++++++++++++++++++++++++++++++++++++++---- test/suite7.janet | 5 +++++ 2 files changed, 56 insertions(+), 4 deletions(-) diff --git a/src/core/math.c b/src/core/math.c index d764d8c1..1bee495e 100644 --- a/src/core/math.c +++ b/src/core/math.c @@ -153,9 +153,44 @@ static Janet cfun_rng_int(int32_t argc, Janet *argv) { } } +static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) { + uint32_t word = janet_rng_u32(rng); + buf[0] = word & 0xFF; + buf[1] = (word >> 8) & 0xFF; + buf[2] = (word >> 16) & 0xFF; + buf[3] = (word >> 24) & 0xFF; +} + +static Janet cfun_rng_buffer(int32_t argc, Janet *argv) { + janet_arity(argc, 2, 3); + JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type); + int32_t n = janet_getnat(argv, 1); + JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n); + + /* Split into first part (that is divisible by 4), and rest */ + int32_t first_part = n & ~3; + int32_t second_part = n - first_part; + + /* Get first part in chunks of 4 bytes */ + janet_buffer_extra(buffer, n); + uint8_t *buf = buffer->data + buffer->count; + for (int32_t i = 0; i < first_part; i += 4) rng_get_4bytes(rng, buf + i); + buffer->count += first_part; + + /* Get remaining 0 - 3 bytes */ + if (second_part) { + uint8_t wordbuf[4] = {0}; + rng_get_4bytes(rng, wordbuf); + janet_buffer_push_bytes(buffer, wordbuf, second_part); + } + + return janet_wrap_buffer(buffer); +} + static const JanetMethod rng_methods[] = { {"uniform", cfun_rng_uniform}, {"int", cfun_rng_int}, + {"buffer", cfun_rng_buffer}, {NULL, NULL} }; @@ -175,8 +210,13 @@ static Janet janet_rand(int32_t argc, Janet *argv) { /* Seed the random number generator */ static Janet janet_srand(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - int32_t x = janet_getinteger(argv, 0); - janet_rng_seed(&janet_vm_rng, (uint32_t) x); + if (janet_checkint(argv[0])) { + uint32_t seed = (uint32_t)(janet_getinteger(argv, 0)); + janet_rng_seed(&janet_vm_rng, seed); + } else { + JanetByteView bytes = janet_getbytes(argv, 0); + janet_rng_longseed(&janet_vm_rng, bytes.bytes, bytes.len); + } return janet_wrap_nil(); } @@ -255,8 +295,8 @@ static const JanetReg math_cfuns[] = { { "math/seedrandom", janet_srand, JDOC("(math/seedrandom seed)\n\n" - "Set the seed for the random number generator. 'seed' should be " - "an integer.") + "Set the seed for the random number generator. seed should be " + "an integer or a buffer.") }, { "math/cos", janet_cos, @@ -391,6 +431,12 @@ static const JanetReg math_cfuns[] = { "Extract a random random integer in the range [0, max] from the RNG. If " "no max is given, the default is 2^31 - 1.") }, + { + "math/rng-buffer", cfun_rng_buffer, + JDOC("(math/rng-buffer rng n &opt buf)\n\n" + "Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is " + "provided, otherwise appends to the given buffer. Returns the buffer.") + }, { "math/hypot", janet_hypot, JDOC("(math/hypot a b)\n\n" @@ -422,6 +468,7 @@ static const JanetReg math_cfuns[] = { /* Module entry point */ void janet_lib_math(JanetTable *env) { janet_core_cfuns(env, NULL, math_cfuns); + janet_register_abstract_type(&JanetRNG_type); #ifdef JANET_BOOTSTRAP janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931), JDOC("The value pi.")); diff --git a/test/suite7.janet b/test/suite7.janet index 3b1f6957..2c2dc1da 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -208,6 +208,11 @@ (for i 0 75 (test-rng (math/rng (:int seedrng)))) +(assert (deep-not= (-> 123 math/rng (:buffer 16)) + (-> 456 math/rng (:buffer 16))) "math/rng-buffer 1") + +(assert-no-error "math/rng-buffer 2" (math/seedrandom "abcdefg")) + # OS Date test (assert (deep= {:year-day 0 From 73a4c395d2efa1a4802ccd0e1efff31da6ed1b97 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Dec 2019 21:00:59 -0600 Subject: [PATCH 06/15] Address #190 We don't ever invoke ld directly, so ignore --linker on non-windows. For --compiler and --archiver, default to $CC and $AR. These are overshadowed by CLI flags or settings in project.janet. --- auxbin/jpm | 19 ++++++++++--------- jpm.1 | 11 ++++++----- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/auxbin/jpm b/auxbin/jpm index 5d991a18..64f1e011 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -108,9 +108,9 @@ # Compilation Defaults # -(def default-compiler (if is-win "cl" "cc")) -(def default-linker (if is-win "link" "cc")) -(def default-archiver (if is-win "lib" "ar")) +(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc"))) +(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc"))) +(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar"))) # Default flags for natives, but not required (def default-lflags (if is-win ["/nologo"] [])) @@ -312,7 +312,7 @@ (defn- link-c "Link object files together to make a native module." [opts target & objects] - (def ld (opt opts :linker default-linker)) + (def linker (opt opts (if is-win :linker :compiler) default-linker)) (def cflags (getcflags opts)) (def lflags [;(opt opts :lflags default-lflags) ;(if (opts :static) [] dynamic-lflags)]) @@ -320,8 +320,8 @@ (check-cc) (print "linking " target "...") (if is-win - (shell ld ;lflags (string "/OUT:" target) ;objects (win-import-library)) - (shell ld ;cflags `-o` target ;objects ;lflags)))) + (shell linker ;lflags (string "/OUT:" target) ;objects (win-import-library)) + (shell linker ;cflags `-o` target ;objects ;lflags)))) (defn- archive-c "Link object files together to make a static library." @@ -858,9 +858,10 @@ Keys are: --headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH. --binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH. --libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH. - --compiler : C compiler to use for natives. Defaults to cc (cl on windows). - --archiver : C compiler to use for static libraries. Defaults to ar (lib on windows). - --linker : C linker to use for linking natives. Defaults to cc (link on windows). + --compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows). + --archiver : C compiler to use for static libraries. Defaults to $AR ar (lib.exe on windows). + --linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on + other platforms. --pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git Flags are: diff --git a/jpm.1 b/jpm.1 index 809875a3..e31c1ef6 100644 --- a/jpm.1 +++ b/jpm.1 @@ -60,23 +60,24 @@ Linking statically might be a better idea, even in that case. Defaults to $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more. .TP -.BR \-\-compiler=cc +.BR \-\-compiler=$CC Sets the compiler used for compiling native modules and standalone executables. Defaults to cc. .TP -.BR \-\-linker=ld -Sets the linker used to create native modules and executables. +.BR \-\-linker +Sets the linker used to create native modules and executables. Only used on windows, where +it defaults to link.exe. .TP .BR \-\-pkglist=https://github.com/janet-lang/pkgs.git Sets the git repository for the package listing used to resolve shorthand package names. .TP -.BR \-\-archiver=ar +.BR \-\-archiver=$AR Sets the command used for creating static libraries, use for linking into the standalone executable. Native modules are compiled twice, once a normal native module (shared object), and once as an -archive. +archive. Defaults to ar. .SH COMMANDS .TP From 328454729e9639d07d26386ccfbe9e792bf12317 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 3 Dec 2019 21:24:22 -0600 Subject: [PATCH 07/15] Add nan? --- src/boot/boot.janet | 1 + 1 file changed, 1 insertion(+) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c6d48bcd..96ed9465 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -73,6 +73,7 @@ nil) # Basic predicates +(defn nan? "Check if x is NaN" [x] (not= x x)) (defn even? "Check if x is even." [x] (== 0 (% x 2))) (defn odd? "Check if x is odd." [x] (not= 0 (% x 2))) (defn zero? "Check if x is zero." [x] (== x 0)) From db9e431bf7c65d29c9c643a5619fbb5d3feec864 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 08:18:54 -0600 Subject: [PATCH 08/15] Address #213 - disallow non-indexed ds for loop range. --- src/boot/boot.janet | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 96ed9465..3b247628 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -326,6 +326,11 @@ (def ,binding ,i) ,body)))) +(defn- check-indexed [x] + (if (indexed? x) + x + (error (string "expected tuple for range, got " x)))) + (defn- loop1 [body head i] @@ -355,11 +360,11 @@ (def {(+ i 2) object} head) (let [rest (loop1 body head (+ i 3))] (case verb - :range (let [[start stop step] object] + :range (let [[start stop step] (check-indexed object)] (for-template binding start stop (or step 1) < + [rest])) :keys (keys-template binding object false [rest]) :pairs (keys-template binding object true [rest]) - :down (let [[start stop step] object] + :down (let [[start stop step] (check-indexed object)] (for-template binding start stop (or step 1) > - [rest])) :in (each-template binding object [rest]) :iterate (iterate-template binding object rest) @@ -416,6 +421,7 @@ (loop1 body head 0)) (put _env 'loop1 nil) +(put _env 'check-indexed nil) (put _env 'for-template nil) (put _env 'iterate-template nil) (put _env 'each-template nil) From f39cf702dbf7927ef2f8bf9b483f2b8658798472 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 08:30:36 -0600 Subject: [PATCH 09/15] Address #212 - don't include janet args in script args. --- src/boot/boot.janet | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 3b247628..34c9b739 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2216,7 +2216,9 @@ (+= i (dohandler (string/slice arg 1) i)) (do (set *no-file* false) - (dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator) + (def env (make-env)) + (put env :args (array/slice args i)) + (dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator :env env) (set i lenargs)))) (when (and (not *compile-only*) (or *should-repl* *no-file*)) From 4199c42fe2b6fd9e106eccfc20035f65120d9143 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 16:40:53 -0600 Subject: [PATCH 10/15] Add support for nested quasiquotation. This brings Janet more in line with Scheme, Common Lisp, and Clojure. --- src/core/specials.c | 27 +++++++++++++++++++-------- test/suite7.janet | 5 +++++ 2 files changed, 24 insertions(+), 8 deletions(-) diff --git a/src/core/specials.c b/src/core/specials.c index 1f82b099..83c686b1 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -55,7 +55,11 @@ static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) { return target; } -static JanetSlot quasiquote(JanetFopts opts, Janet x) { +static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) { + if (depth == 0) { + janetc_cerror(opts.compiler, "quasiquote too deeply nested"); + return janetc_cslot(janet_wrap_nil()); + } JanetSlot *slots = NULL; switch (janet_type(x)) { default: @@ -66,11 +70,18 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) { len = janet_tuple_length(tup); if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) { const uint8_t *head = janet_unwrap_symbol(tup[0]); - if (!janet_cstrcmp(head, "unquote")) - return janetc_value(janetc_fopts_default(opts.compiler), tup[1]); + if (!janet_cstrcmp(head, "unquote")) { + if (level == 0) { + return janetc_value(janetc_fopts_default(opts.compiler), tup[1]); + } else { + level--; + } + } else if (!janet_cstrcmp(head, "quasiquote")) { + level++; + } } for (i = 0; i < len; i++) - janet_v_push(slots, quasiquote(opts, tup[i])); + janet_v_push(slots, quasiquote(opts, tup[i], depth - 1, level)); return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) ? JOP_MAKE_BRACKET_TUPLE : JOP_MAKE_TUPLE); @@ -79,7 +90,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) { int32_t i; JanetArray *array = janet_unwrap_array(x); for (i = 0; i < array->count; i++) - janet_v_push(slots, quasiquote(opts, array->data[i])); + janet_v_push(slots, quasiquote(opts, array->data[i], depth - 1, level)); return qq_slots(opts, slots, JOP_MAKE_ARRAY); } case JANET_TABLE: @@ -88,8 +99,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) { int32_t len, cap = 0; janet_dictionary_view(x, &kvs, &len, &cap); while ((kv = janet_dictionary_next(kvs, cap, kv))) { - JanetSlot key = quasiquote(opts, kv->key); - JanetSlot value = quasiquote(opts, kv->value); + JanetSlot key = quasiquote(opts, kv->key, depth - 1, level); + JanetSlot value = quasiquote(opts, kv->value, depth - 1, level); key.flags &= ~JANET_SLOT_SPLICED; value.flags &= ~JANET_SLOT_SPLICED; janet_v_push(slots, key); @@ -106,7 +117,7 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a janetc_cerror(opts.compiler, "expected 1 argument"); return janetc_cslot(janet_wrap_nil()); } - return quasiquote(opts, argv[0]); + return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0); } static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) { diff --git a/test/suite7.janet b/test/suite7.janet index 2c2dc1da..2f92d2c0 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -265,4 +265,9 @@ (assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer") (assert (= (length buf) 2) "cryptorand appends to buffer")) +# Nested quasiquotation + +(def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)) +(assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f)) "nested quasiquote") + (end-suite) From 8ca10f37bd1cb486990e26b89cfd6d91a0a67a57 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 16:51:34 -0600 Subject: [PATCH 11/15] Update CHANGELOG.md --- CHANGELOG.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1fa66238..372cc8a2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,17 @@ All notable changes to this project will be documented in this file. contains `(quit some-value)`, the value of that module returned to `(require "somemod")` is the return value. This lets module writers completely customize a module without writing a loader. +- Add nested quasiquotation. +- Add `os/cryptorand` +- Add `prinf` and `eprinf` to be have like `printf` and `eprintf`. The latter two functions + now including a trailing newline, like the other print functions. +- Add nan? +- Add `janet_in` to C API. +- Add `truthy?` +- Add `os/environ` +- Use `(doc)` with no arguments to see available bindings and dynamic bindings. +- `jpm` will use `CC` and `AR` environment variables when compiling programs. +- Numerous small bug fixes and usability improvements. ### 1.5.1 - 2019-11-16 - Fix bug when printing buffer to self in some edge cases. From 2487162ccf5af488bdf163cd542efe87262c94ff Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 18:36:37 -0600 Subject: [PATCH 12/15] Add top level unquote and macro envs. This improves macros that eval their arguments and makes them easier to write. --- src/boot/boot.janet | 5 +++++ src/core/compile.c | 23 ++++++++++++++++------- src/core/specials.c | 8 -------- test/suite7.janet | 7 +++++++ 4 files changed, 28 insertions(+), 15 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 34c9b739..5ec3be6e 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1850,6 +1850,11 @@ (res) (error (res :error)))) +(def unquote + "(unquote x)\n\nEscapes one level inside of a quasiquote. When used outside of a quasiquote, evaluates + its argument at compile-time." + :macro eval) + (defn make-image "Create an image from an environment returned by require. Returns the image source as a string." diff --git a/src/core/compile.c b/src/core/compile.c index e6b9de64..e1725516 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -569,15 +569,24 @@ static int macroexpand1( return 0; /* Evaluate macro */ - JanetFiber *fiberp = NULL; JanetFunction *macro = janet_unwrap_function(macroval); + int32_t arity = janet_tuple_length(form) - 1; + JanetFiber *fiberp = janet_fiber(macro, 64, arity, form + 1); + if (NULL == fiberp) { + int32_t minar = macro->def->min_arity; + int32_t maxar = macro->def->max_arity; + const uint8_t *es = NULL; + if (minar >= 0 && arity < minar) + es = janet_formatc("macro arity mismatch, expected at least %d, got %d", minar, arity); + if (maxar >= 0 && arity > maxar) + es = janet_formatc("macro arity mismatch, expected at most %d, got %d", maxar, arity); + c->result.macrofiber = NULL; + janetc_error(c, es); + } + /* Set env */ + fiberp->env = c->env; int lock = janet_gclock(); - JanetSignal status = janet_pcall( - macro, - janet_tuple_length(form) - 1, - form + 1, - &x, - &fiberp); + JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &x); janet_gcunlock(lock); if (status != JANET_SIGNAL_OK) { const uint8_t *es = janet_formatc("(macro) %V", x); diff --git a/src/core/specials.c b/src/core/specials.c index 83c686b1..210f8004 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -120,13 +120,6 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0); } -static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) { - (void) argn; - (void) argv; - janetc_cerror(opts.compiler, "cannot use unquote here"); - return janetc_cslot(janet_wrap_nil()); -} - /* Perform destructuring. Be careful to * keep the order registers are freed. * Returns if the slot 'right' can be freed. */ @@ -819,7 +812,6 @@ static const JanetSpecial janetc_specials[] = { {"quote", janetc_quote}, {"set", janetc_varset}, {"splice", janetc_splice}, - {"unquote", janetc_unquote}, {"var", janetc_var}, {"while", janetc_while} }; diff --git a/test/suite7.janet b/test/suite7.janet index 2f92d2c0..ed9f3820 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -270,4 +270,11 @@ (def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)) (assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f)) "nested quasiquote") +# Top level unquote +(defn constantly + [] + ,(math/random)) + +(assert (= (constantly) (constantly)) "top level unquote") + (end-suite) From 11a7a7069af315a55bb7a8b890f283e1a5545c55 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 18:46:36 -0600 Subject: [PATCH 13/15] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 372cc8a2..0e447b1a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,7 @@ All notable changes to this project will be documented in this file. - Add `os/environ` - Use `(doc)` with no arguments to see available bindings and dynamic bindings. - `jpm` will use `CC` and `AR` environment variables when compiling programs. +- Allow top level unquotes to do compile-time evaluation. - Numerous small bug fixes and usability improvements. ### 1.5.1 - 2019-11-16 From 49954c7a30ec3ce56f1df5fa64c4c37213f82761 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 19:53:13 -0600 Subject: [PATCH 14/15] Remove top-level unquote for comptime macro True top level unquote currently requires basically double compilation as it currently stands. Also, implementing such double compilation looses all source mapping information. This is a compromise implementation that makes it clear that this works differently than a true top-level unquote. --- src/boot/boot.janet | 6 +++--- src/core/specials.c | 8 ++++++++ test/suite7.janet | 4 ++-- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 5ec3be6e..86755ca9 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1850,9 +1850,9 @@ (res) (error (res :error)))) -(def unquote - "(unquote x)\n\nEscapes one level inside of a quasiquote. When used outside of a quasiquote, evaluates - its argument at compile-time." +(def comptime + "(comptime x)\n\n + Evals x at compile time and returns the result. Similar to a top level unquote." :macro eval) (defn make-image diff --git a/src/core/specials.c b/src/core/specials.c index 210f8004..83c686b1 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -120,6 +120,13 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0); } +static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) { + (void) argn; + (void) argv; + janetc_cerror(opts.compiler, "cannot use unquote here"); + return janetc_cslot(janet_wrap_nil()); +} + /* Perform destructuring. Be careful to * keep the order registers are freed. * Returns if the slot 'right' can be freed. */ @@ -812,6 +819,7 @@ static const JanetSpecial janetc_specials[] = { {"quote", janetc_quote}, {"set", janetc_varset}, {"splice", janetc_splice}, + {"unquote", janetc_unquote}, {"var", janetc_var}, {"while", janetc_while} }; diff --git a/test/suite7.janet b/test/suite7.janet index ed9f3820..f7efb9a7 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -273,8 +273,8 @@ # Top level unquote (defn constantly [] - ,(math/random)) + (comptime (math/random))) -(assert (= (constantly) (constantly)) "top level unquote") +(assert (= (constantly) (constantly)) "comptime 1") (end-suite) From 77cb8237199bdd6eed9df0e97b3369d276559b31 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 4 Dec 2019 20:02:15 -0600 Subject: [PATCH 15/15] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0e447b1a..29af2365 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,7 +28,7 @@ All notable changes to this project will be documented in this file. - Add `os/environ` - Use `(doc)` with no arguments to see available bindings and dynamic bindings. - `jpm` will use `CC` and `AR` environment variables when compiling programs. -- Allow top level unquotes to do compile-time evaluation. +- Add `comptime` macro for compile time evaluation. - Numerous small bug fixes and usability improvements. ### 1.5.1 - 2019-11-16