mirror of
https://github.com/janet-lang/janet
synced 2024-11-28 19:19:53 +00:00
Merge branch 'master' into threads-3
This commit is contained in:
commit
1a4035b02c
12
CHANGELOG.md
12
CHANGELOG.md
@ -18,6 +18,18 @@ 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.
|
||||
- Add `comptime` macro for compile time evaluation.
|
||||
- Numerous small bug fixes and usability improvements.
|
||||
|
||||
### 1.5.1 - 2019-11-16
|
||||
- Fix bug when printing buffer to self in some edge cases.
|
||||
|
19
auxbin/jpm
19
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")))
|
||||
|
||||
# Detect threads
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
@ -322,7 +322,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)])
|
||||
@ -330,8 +330,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."
|
||||
@ -868,9 +868,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:
|
||||
|
11
jpm.1
11
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
|
||||
|
@ -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))
|
||||
@ -325,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]
|
||||
|
||||
@ -354,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)
|
||||
@ -415,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)
|
||||
@ -1843,6 +1850,7 @@
|
||||
(res)
|
||||
(error (res :error))))
|
||||
|
||||
<<<<<<< HEAD
|
||||
|
||||
(def make-image-dict
|
||||
"A table used in combination with marshal to marshal code (images), such that
|
||||
@ -1854,6 +1862,11 @@
|
||||
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)."
|
||||
@{})
|
||||
|
||||
(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
|
||||
"Create an image from an environment returned by require.
|
||||
Returns the image source as a string."
|
||||
@ -2216,7 +2229,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*))
|
||||
|
@ -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,
|
||||
|
@ -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);
|
||||
|
@ -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."));
|
||||
|
@ -25,8 +25,6 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#include <time.h>
|
||||
@ -36,6 +34,8 @@
|
||||
#include <string.h>
|
||||
#include <sys/stat.h>
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#include <direct.h>
|
||||
@ -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"
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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) {
|
||||
|
@ -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,
|
||||
|
@ -354,15 +354,25 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
|
||||
int32_t count;
|
||||
const Janet *items;
|
||||
if (janet_indexed_view(argv[0], &items, &count)) {
|
||||
int32_t realcount = 0;
|
||||
JanetThread **threads = janet_smalloc(sizeof(JanetThread *) * count);
|
||||
/* Select on multiple threads */
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
JanetThread *thread = janet_getthread(items, i);
|
||||
if (thread->rx != NULL) threads[realcount++] = thread;
|
||||
if (count == 0) {
|
||||
janet_panics("expected at least 1 thread");
|
||||
}
|
||||
if (count == 1) {
|
||||
JanetThread *thread = janet_getthread(items, 0);
|
||||
if (NULL == thread->rx) janet_panic("channel has closed");
|
||||
status = janet_channel_receive(thread->rx, &out, thread->decode, 0);
|
||||
} else {
|
||||
/* Select */
|
||||
int32_t realcount = 0;
|
||||
JanetThread **threads = janet_smalloc(sizeof(JanetThread *) * count);
|
||||
/* Select on multiple threads */
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
JanetThread *thread = janet_getthread(items, i);
|
||||
if (thread->rx != NULL) threads[realcount++] = thread;
|
||||
}
|
||||
status = janet_channel_select(realcount, threads, &out);
|
||||
janet_sfree(threads);
|
||||
}
|
||||
status = janet_channel_select(realcount, threads, &out);
|
||||
janet_sfree(threads);
|
||||
} else {
|
||||
/* Get from one thread */
|
||||
JanetThread *thread = janet_getthread(argv, 0);
|
||||
@ -411,7 +421,7 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
{
|
||||
"thread/receive", cfun_thread_receive,
|
||||
JDOC("(thread/receive threads)\n\n"
|
||||
"Get a value sent to thread. Will block if there is no value was sent to this thread "
|
||||
"Get a value sent to 1 or more threads. Will block if no value was sent to this thread "
|
||||
"yet. threads can also be an array or tuple of threads, in which case "
|
||||
"thread/receive will select on the first thread to return a value. Returns "
|
||||
"the message sent to the thread.")
|
||||
|
@ -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.")
|
||||
},
|
||||
{
|
||||
|
@ -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();
|
||||
|
@ -233,9 +233,13 @@ typedef struct {
|
||||
|
||||
/***** START SECTION TYPES *****/
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
// Must be defined before including stdlib.h
|
||||
#define _CRT_RAND_S
|
||||
#endif
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdarg.h>
|
||||
#include <setjmp.h>
|
||||
#include <stddef.h>
|
||||
|
@ -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")
|
||||
|
||||
|
@ -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
|
||||
@ -238,4 +243,38 @@
|
||||
# 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"))
|
||||
|
||||
# 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")
|
||||
|
||||
# Top level unquote
|
||||
(defn constantly
|
||||
[]
|
||||
(comptime (math/random)))
|
||||
|
||||
(assert (= (constantly) (constantly)) "comptime 1")
|
||||
|
||||
(end-suite)
|
||||
|
@ -1,4 +1,4 @@
|
||||
#!/bin/bash
|
||||
#!/usr/bin/env bash
|
||||
|
||||
# Format all code with astyle
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user