mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-10-25 20:57:40 +00:00
Code Issues 1 Releases Wiki Activity

Merge branch 'master' into threads-3

Browse Source
This commit is contained in:
Calvin Rose
2019-12-04 22:39:30 -06:00
parent e908029392 77cb823719
commit 1a4035b02c
18 changed files with 280 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/boot/boot.janet
View File

@@ -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*))

3
src/core/array.c
View 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,

23
src/core/compile.c
View File

@@ -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);

55
src/core/math.c
View File

@@ -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."));

70
src/core/os.c
View File

@@ -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"

2
src/core/peg.c
View File

@@ -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;
}

27
src/core/specials.c
View File

@@ -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) {

3
src/core/string.c
View File

@@ -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,

28
src/core/thread.c
View File

@@ -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.")

5
src/core/tuple.c
View File

@@ -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.")
},
{

7
src/core/value.c
View File

@@ -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();

6
src/include/janet.h
View File

@@ -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>