mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-12-06 16:48:08 +00:00
Code Issues 1 Releases Wiki Activity

Merge branch 'master' into ev

Browse Source
This commit is contained in:
Calvin Rose
2020-06-22 22:25:44 -05:00
parent b1a4f05b5a de9951594e
commit 328ee94412
21 changed files with 377 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
src/boot/boot.janet
View File

@@ -433,6 +433,17 @@
(def ,binding ,i)
,body))))
(defn- loop-fiber-template
[binding expr body]
(with-syms [f s]
(def ds (if (idempotent? binding) binding (gensym)))
~(let [,f ,expr]
(while true
(def ,ds (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,;(if (= ds binding) [] [~(def ,binding ,ds)])
,;body))))
(defn- loop1
[body head i]
@@ -470,12 +481,7 @@
:pairs (keys-template binding object true [rest])
:in (each-template binding object [rest])
:iterate (iterate-template binding object rest)
:generate (with-syms [f s]
~(let [,f ,object]
(while true
(def ,binding (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,rest)))
:generate (loop-fiber-template binding object [rest])
(error (string "unexpected loop verb " verb)))))
(defmacro for
@@ -493,6 +499,18 @@
[x ds & body]
(keys-template x ds true body))
(defmacro eachy
"Resume a fiber in a loop until it has errored or died. Evaluate the body
of the loop with binding set to the yielded value."
[x fiber & body]
(loop-fiber-template x fiber body))
(defmacro repeat
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
[n & body]
(with-syms [iter]
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
(defmacro each
"Loop over each value in ds. Returns nil."
[x ds & body]
@@ -542,6 +560,7 @@
(put _env 'each-template nil)
(put _env 'keys-template nil)
(put _env 'range-template nil)
(put _env 'loop-fiber-template nil)
(defmacro seq
"Similar to loop, but accumulates the loop body into an array and returns that.

4
src/conf/janetconf.h
View File

@@ -28,9 +28,9 @@
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 10
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_PATCH 2
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.10.0"
#define JANET_VERSION "1.10.2-dev"
/* #define JANET_BUILD "local" */

25
src/core/array.c
View File

@@ -270,6 +270,26 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetArray *array = janet_getarray(argv, 0);
if (array->count) {
if (array->count < array->capacity) {
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
array->data = newData;
array->capacity = array->count;
}
} else {
array->capacity = 0;
free(array->data);
array->data = NULL;
}
return argv[0];
}
static const JanetReg array_cfuns[] = {
{
"array/new", cfun_array_new,
@@ -345,6 +365,11 @@ static const JanetReg array_cfuns[] = {
"By default, n is 1. "
"Returns the array.")
},
{
"array/trim", cfun_array_trim,
JDOC("(array/trim arr)\n\n"
"Set the backing capacity of an array to its current length. Returns the modified array.")
},
{NULL, NULL, NULL}
};

26
src/core/buffer.c
View File

@@ -197,6 +197,26 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
if (buffer->count) {
if (buffer->count < buffer->capacity) {
uint8_t *newData = realloc(buffer->data, buffer->count);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
buffer->data = newData;
buffer->capacity = buffer->count;
}
} else {
buffer->capacity = 0;
free(buffer->data);
buffer->data = NULL;
}
return argv[0];
}
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
@@ -379,6 +399,12 @@ static const JanetReg buffer_cfuns[] = {
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
"Returns the modified buffer.")
},
{
"buffer/trim", cfun_buffer_trim,
JDOC("(buffer/trim buffer)\n\n"
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
"modified buffer.")
},
{
"buffer/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer x)\n\n"

17
src/core/capi.c
View File

@@ -325,7 +325,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
}
Janet janet_dyn(const char *name) {
if (!janet_vm_fiber) return janet_wrap_nil();
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) return janet_wrap_nil();
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
}
if (janet_vm_fiber->env) {
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
} else {
@@ -334,11 +337,15 @@ Janet janet_dyn(const char *name) {
}
void janet_setdyn(const char *name, Janet value) {
if (!janet_vm_fiber) return;
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
} else {
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {

8
src/core/inttypes.c
View File

@@ -206,14 +206,14 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
// In the following code explicit casts are sometimes used to help
// make it clear when int/float conversions are happening.
//
static int64_t compare_double_double(double x, double y) {
static int compare_double_double(double x, double y) {
return (x < y) ? -1 : ((x > y) ? 1 : 0);
}
static int64_t compare_int64_double(int64_t x, double y) {
static int compare_int64_double(int64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
} else if ((y > ((double) - MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) INT64_MAX)) {
@@ -226,7 +226,7 @@ static int64_t compare_int64_double(int64_t x, double y) {
}
}
static int64_t compare_uint64_double(uint64_t x, double y) {
static int compare_uint64_double(uint64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
} else if (y < 0) {

4
src/core/os.c
View File

@@ -1225,6 +1225,9 @@ static Janet os_rename(int32_t argc, Janet *argv) {
static Janet os_realpath(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
const char *src = janet_getcstring(argv, 0);
#ifdef JANET_NO_REALPATH
janet_panic("os/realpath not enabled for this platform");
#else
#ifdef JANET_WINDOWS
char *dest = _fullpath(NULL, src, _MAX_PATH);
#else
@@ -1234,6 +1237,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
Janet ret = janet_cstringv(dest);
free(dest);
return ret;
#endif
}
static Janet os_permission_string(int32_t argc, Janet *argv) {

12
src/core/pp.c
View File

@@ -123,9 +123,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
#undef HEX
#undef BUFSIZE
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
for (int32_t i = 0; i < len; ++i) {
@@ -354,12 +351,16 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
if (depth == 0) return 1;
switch (janet_type(x)) {
case JANET_NIL:
case JANET_NUMBER:
case JANET_BOOLEAN:
case JANET_BUFFER:
case JANET_STRING:
janet_description_b(S->buffer, x);
break;
case JANET_NUMBER:
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
S->buffer->count += count;
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
@@ -994,3 +995,6 @@ void janet_buffer_format(
}
}
}
#undef HEX
#undef BUFSIZE

22
src/core/run.c
View File

@@ -23,7 +23,6 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
/* Run a string */
@@ -56,9 +55,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1;
}
} else {
ret = janet_wrap_string(cres.error);
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
janet_stacktrace(cres.macrofiber, ret);
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
@@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
}
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR:
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(&parser);
errflags |= 0x04;
janet_eprintf("parse error in %s: %s\n",
sourcePath, janet_parser_error(&parser));
ret = janet_cstringv(e);
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
done = 1;
break;
case JANET_PARSE_PENDING:
if (index == len) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, bytes[index++]);
}
break;
}
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index >= len) {
janet_parser_eof(&parser);
} else {

3
src/core/state.h
View File

@@ -34,6 +34,9 @@
typedef struct JanetScratch JanetScratch;
/* Top level dynamic bindings */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
/* Cache the core environment */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;

71
src/core/thread.c
View File

@@ -66,9 +66,15 @@ struct JanetMailbox {
JanetBuffer messages[];
};
#define JANET_THREAD_HEAVYWEIGHT 0x1
#define JANET_THREAD_ABSTRACTS 0x2
#define JANET_THREAD_CFUNCTIONS 0x4
static const char janet_thread_flags[] = "hac";
typedef struct {
JanetMailbox *original;
JanetMailbox *newbox;
uint64_t flags;
} JanetMailboxPair;
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
@@ -175,7 +181,7 @@ static int thread_mark(void *p, size_t size) {
return 0;
}
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
if (NULL == pair) {
JANET_OUT_OF_MEMORY;
@@ -183,6 +189,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
pair->original = original;
janet_mailbox_ref(original, 1);
pair->newbox = janet_mailbox_create(1, 16);
pair->flags = flags;
return pair;
}
@@ -442,16 +449,44 @@ static int thread_worker(JanetMailboxPair *pair) {
janet_init();
/* Get dictionaries for default encode/decode */
JanetTable *encode = janet_get_core_table("make-image-dict");
JanetTable *encode;
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
janet_vm_thread_decode = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
}
/* Create parent thread */
JanetThread *parent = janet_make_thread(pair->original, encode);
Janet parentv = janet_wrap_abstract(parent);
/* Unmarshal the abstract registry */
if (pair->flags & JANET_THREAD_ABSTRACTS) {
Janet reg;
int status = janet_thread_receive(&reg, INFINITY);
if (status) goto error;
if (!janet_checktype(reg, JANET_TABLE)) goto error;
janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
janet_vm_abstract_registry = janet_unwrap_table(reg);
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
}
/* Unmarshal the normal registry */
if (pair->flags & JANET_THREAD_CFUNCTIONS) {
Janet reg;
int status = janet_thread_receive(&reg, INFINITY);
if (status) goto error;
if (!janet_checktype(reg, JANET_TABLE)) goto error;
janet_gcunroot(janet_wrap_table(janet_vm_registry));
janet_vm_registry = janet_unwrap_table(reg);
janet_gcroot(janet_wrap_table(janet_vm_registry));
}
/* Unmarshal the function */
Janet funcv;
int status = janet_thread_receive(&funcv, INFINITY);
if (status) goto error;
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
JanetFunction *func = janet_unwrap_function(funcv);
@@ -558,22 +593,40 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
}
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
janet_arity(argc, 1, 3);
/* Just type checking */
janet_getfunction(argv, 0);
int32_t cap = janet_optinteger(argv, argc, 1, 10);
if (cap < 1 || cap > UINT16_MAX) {
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
}
JanetTable *encode = janet_get_core_table("make-image-dict");
uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
JanetTable *encode;
if (flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
}
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
JanetThread *thread = janet_make_thread(pair->newbox, encode);
if (janet_thread_start_child(pair)) {
destroy_mailbox_pair(pair);
janet_panic("could not start thread");
}
if (flags & JANET_THREAD_ABSTRACTS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
janet_panic("could not send abstract registry to thread");
}
}
if (flags & JANET_THREAD_CFUNCTIONS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
janet_panic("could not send registry to thread");
}
}
/* If thread started, send the worker function. */
if (janet_thread_send(thread, argv[0], INFINITY)) {
janet_panicf("could not send worker function %v to thread", argv[0]);
@@ -638,10 +691,14 @@ static const JanetReg threadlib_cfuns[] = {
},
{
"thread/new", cfun_thread_new,
JDOC("(thread/new func &opt capacity)\n\n"
JDOC("(thread/new func &opt capacity flags)\n\n"
"Start a new thread that will start immediately. "
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
"Can optionally provide flags to the new thread - supported flags are:\n"
"\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
"\t:a - Allow sending over registered abstract types to the new thread\n"
"\t:c - Send over cfunction information to the new thread.\n"
"Returns a handle to the new thread.")
},
{

8
src/core/vm.c
View File

@@ -33,6 +33,7 @@
#include <math.h>
/* VM state */
JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
@@ -929,7 +930,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
}
janet_stack_frame(stack)->pc = pc;
if (janet_fiber_funcframe(fiber, func)) {
@@ -968,7 +969,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
}
if (janet_fiber_funcframe_tail(fiber, func)) {
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
@@ -1419,6 +1420,8 @@ int janet_init(void) {
janet_vm_traversal_top = NULL;
/* Core env */
janet_vm_core_env = NULL;
/* Dynamic bindings */
janet_vm_top_dyns = NULL;
/* Seed RNG */
janet_rng_seed(janet_default_rng(), 0);
/* Fibers */
@@ -1449,6 +1452,7 @@ void janet_deinit(void) {
janet_vm_registry = NULL;
janet_vm_abstract_registry = NULL;
janet_vm_core_env = NULL;
janet_vm_top_dyns = NULL;
free(janet_vm_traversal_base);
janet_vm_fiber = NULL;
janet_vm_root_fiber = NULL;

1
src/include/janet.h
View File

@@ -1373,6 +1373,7 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);