mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-10-30 23:23:07 +00:00
Code Issues 1 Releases Wiki Activity

Merge remote-tracking branch 'upstream/master' into ta-with-marshal

Browse Source
This commit is contained in:
J.-F. Cap
2019-02-22 15:58:47 +01:00
parent db9ac6dba5 beed839d12
commit e5a4c6fc2b
26 changed files with 236 additions and 190 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGELOG.md
View File

@@ -2,6 +2,8 @@
All notable changes to this project will be documented in this file.
## 0.4.0 - ??
- Remove `tuple/append` and `tuple/prepend`, which may have seened like `O(1)`
operations. Instead, use the `splice` special to extend tuples.
- Add `-m` flag to main client to allow specifying where to load
system modules from.
- Add `-c` flag to main client to allow compiling Janet modules to images.

1
CONTRIBUTING.md
View File

@@ -44,7 +44,6 @@ For changes to the VM and Core code, you will probably need to know C. Janet is
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
omissions.
* No Variable Length Arrays (yes these may work in newer MSVC compilers)
* No `restrict`
* Certain functions in the standard library are not always available

7
Makefile
View File

@@ -65,7 +65,8 @@ all: $(JANET_TARGET) $(JANET_LIBRARY)
##### The bootstrap interpreter that compiles the core image #####
##################################################################
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) src/boot/boot.c) \
JANET_BOOT_SOURCES=$(sort $(wildcard src/boot/*.c))
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
build/core.gen.o \
build/boot.gen.o
@@ -77,7 +78,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
# Now the reason we bootstrap in the first place
build/core_image.c: build/janet_boot
JANET_PATH=$(JANET_PATH) JANET_INCLUDEDIR=$(INCLUDEDIR) build/janet_boot
JANET_PATH=$(JANET_PATH) build/janet_boot
##########################################################
##### The main interpreter program and shared object #####
@@ -229,9 +230,9 @@ install: $(JANET_TARGET)
mkdir -p $(INCLUDEDIR)
cp $(JANET_HEADERS) $(INCLUDEDIR)
mkdir -p $(INCLUDEDIR)/janet
mkdir -p $(JANET_PATH)
ln -sf $(INCLUDEDIR)/janet.h $(INCLUDEDIR)/janet/janet.h
ln -sf $(INCLUDEDIR)/janet.h $(JANET_PATH)/janet.h
mkdir -p $(JANET_PATH)
cp tools/cook.janet $(JANET_PATH)
cp tools/highlight.janet $(JANET_PATH)
cp tools/bars.janet $(JANET_PATH)

8
ctest/array_test.c → src/boot/array_test.c
View File

@@ -23,13 +23,13 @@
#include <janet.h>
#include <assert.h>
int main() {
#include "tests.h"
int array_test() {
int i;
JanetArray *array1, *array2;
janet_init();
array1 = janet_array(10);
array2 = janet_array(0);
@@ -62,7 +62,5 @@ int main() {
assert(array1->count == 5);
janet_deinit();
return 0;
}

18
src/boot/boot.c
View File

@@ -21,16 +21,28 @@
*/
#include <janet.h>
#include "tests.h"
extern const unsigned char *janet_gen_boot;
extern int32_t janet_gen_boot_size;
int main() {
int status;
JanetTable *env;
/* Init janet */
janet_init();
/* Run tests */
array_test();
buffer_test();
number_test();
system_test();
table_test();
/* C tests passed */
/* Set up VM */
janet_init();
int status;
JanetTable *env;
env = janet_core_env();
/* Run bootstrap script to generate core image */

8
ctest/buffer_test.c → src/boot/buffer_test.c
View File

@@ -23,13 +23,13 @@
#include <janet.h>
#include <assert.h>
int main() {
#include "tests.h"
int buffer_test() {
int i;
JanetBuffer *buffer1, *buffer2;
janet_init();
buffer1 = janet_buffer(100);
buffer2 = janet_buffer(0);
@@ -58,7 +58,5 @@ int main() {
assert(buffer1->data[i] == buffer2->data[i]);
}
janet_deinit();
return 0;
}

10
ctest/number_test.c → src/boot/number_test.c
View File

@@ -25,6 +25,8 @@
#include <string.h>
#include <assert.h>
#include "tests.h"
/* Check a subset of numbers against system implementation.
* Note that this depends on the system implementation being correct,
* which may not be the case for old or non compliant systems. Also,
@@ -36,14 +38,12 @@ static void test_valid_str(const char *str) {
double cnum, jnum;
jnum = 0.0;
cnum = atof(str);
err = janet_scan_number((const uint8_t *) str, strlen(str), &jnum);
err = janet_scan_number((const uint8_t *) str, (int32_t) strlen(str), &jnum);
assert(!err);
assert(cnum == jnum);
}
int main() {
janet_init();
int number_test() {
test_valid_str("1.0");
test_valid_str("1");
@@ -63,7 +63,5 @@ int main() {
test_valid_str("0000000011111111111111111111111111");
test_valid_str(".112312333333323123123123123123123");
janet_deinit();
return 0;
}

8
ctest/system_test.c → src/boot/system_test.c
View File

@@ -24,7 +24,9 @@
#include <assert.h>
#include <stdio.h>
int main() {
#include "tests.h"
int system_test() {
#ifdef JANET_32
assert(sizeof(void *) == 4);
@@ -32,8 +34,6 @@ int main() {
assert(sizeof(void *) == 8);
#endif
janet_init();
/* Reflexive testing and nanbox testing */
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
@@ -48,7 +48,5 @@ int main() {
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
janet_deinit();
return 0;
}

8
ctest/table_test.c → src/boot/table_test.c
View File

@@ -23,12 +23,12 @@
#include <janet.h>
#include <assert.h>
int main() {
#include "tests.h"
int table_test() {
JanetTable *t1, *t2;
janet_init();
t1 = janet_table(10);
t2 = janet_table(0);
@@ -61,7 +61,5 @@ int main() {
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
janet_deinit();
return 0;
}

11
src/boot/tests.h Normal file
View File

@@ -0,0 +1,11 @@
#ifndef TESTS_H_DNMBUYYL
#define TESTS_H_DNMBUYYL
/* Tests */
extern int array_test();
extern int buffer_test();
extern int number_test();
extern int system_test();
extern int table_test();
#endif /* end of include guard: TESTS_H_DNMBUYYL */

7
src/core/abstract.c
View File

@@ -27,10 +27,9 @@
/* Create new userdata */
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
char *data = janet_gcalloc(JANET_MEMORY_ABSTRACT, sizeof(JanetAbstractHeader) + size);
JanetAbstractHeader *header = (JanetAbstractHeader *)data;
void *a = data + sizeof(JanetAbstractHeader);
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
sizeof(JanetAbstractHead) + size);
header->size = size;
header->type = atype;
return a;
return (void *) & (header->data);
}

5
src/core/core.janet
View File

@@ -104,9 +104,6 @@
(defn indexed? "Check if x is an array or tuple." [x]
(def t (type x))
(if (= t :array) true (= t :tuple)))
(defn callable? "Check if x is a function or cfunction." [x]
(def t (type x))
(if (= t :function) true (= t :cfunction)))
(defn true? "Check if x is true." [x] (= x true))
(defn false? "Check if x is false." [x] (= x false))
(defn nil? "Check if x is nil." [x] (= x nil))
@@ -311,7 +308,7 @@
[i preds &]
(default preds @['and])
(if (>= i len)
(tuple/prepend body 'do)
['do ;body]
(do
(def {i bindings
(+ i 1) verb

2
src/core/debug.c
View File

@@ -54,7 +54,7 @@ void janet_debug_find(
JanetFuncDef **def_out, int32_t *pc_out,
const uint8_t *source, int32_t offset) {
/* Scan the heap for right func def */
JanetGCMemoryHeader *current = janet_vm_blocks;
JanetGCObject *current = janet_vm_blocks;
/* Keep track of the best source mapping we have seen so far */
int32_t besti = -1;
int32_t best_range = INT32_MAX;

51
src/core/gc.c
View File

@@ -99,7 +99,7 @@ void janet_mark(Janet x) {
}
static void janet_mark_string(const uint8_t *str) {
janet_gc_mark(janet_string_raw(str));
janet_gc_mark(janet_string_head(str));
}
static void janet_mark_buffer(JanetBuffer *buffer) {
@@ -154,16 +154,16 @@ recur: /* Manual tail recursion */
}
static void janet_mark_struct(const JanetKV *st) {
if (janet_gc_reachable(janet_struct_raw(st)))
if (janet_gc_reachable(janet_struct_head(st)))
return;
janet_gc_mark(janet_struct_raw(st));
janet_gc_mark(janet_struct_head(st));
janet_mark_kvs(st, janet_struct_capacity(st));
}
static void janet_mark_tuple(const Janet *tuple) {
if (janet_gc_reachable(janet_tuple_raw(tuple)))
if (janet_gc_reachable(janet_tuple_head(tuple)))
return;
janet_gc_mark(janet_tuple_raw(tuple));
janet_gc_mark(janet_tuple_head(tuple));
janet_mark_many(tuple, janet_tuple_length(tuple));
}
@@ -244,15 +244,13 @@ recur:
}
/* Deinitialize a block of memory */
static void janet_deinit_block(JanetGCMemoryHeader *block) {
void *mem = ((char *)(block + 1));
JanetAbstractHeader *h = (JanetAbstractHeader *)mem;
switch (block->flags & JANET_MEM_TYPEBITS) {
static void janet_deinit_block(JanetGCObject *mem) {
switch (mem->flags & JANET_MEM_TYPEBITS) {
default:
case JANET_MEMORY_FUNCTION:
break; /* Do nothing for non gc types */
case JANET_MEMORY_SYMBOL:
janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
janet_symbol_deinit(((JanetStringHead *) mem)->data);
break;
case JANET_MEMORY_ARRAY:
janet_array_deinit((JanetArray *) mem);
@@ -266,9 +264,11 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
case JANET_MEMORY_BUFFER:
janet_buffer_deinit((JanetBuffer *) mem);
break;
case JANET_MEMORY_ABSTRACT:
if (h->type->gc) {
janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed");
case JANET_MEMORY_ABSTRACT: {
JanetAbstractHead *head = (JanetAbstractHead *)mem;
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
}
break;
case JANET_MEMORY_FUNCENV: {
@@ -293,9 +293,9 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
/* Iterate over all allocated memory, and free memory that is not
* marked as reachable. Flip the gc color flag for next sweep. */
void janet_sweep() {
JanetGCMemoryHeader *previous = NULL;
JanetGCMemoryHeader *current = janet_vm_blocks;
JanetGCMemoryHeader *next;
JanetGCObject *previous = NULL;
JanetGCObject *current = janet_vm_blocks;
JanetGCObject *next;
while (NULL != current) {
next = current->next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
@@ -316,29 +316,26 @@ void janet_sweep() {
/* Allocate some memory that is tracked for garbage collection */
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
JanetGCMemoryHeader *mdata;
size_t total = size + sizeof(JanetGCMemoryHeader);
JanetGCObject *mem;
/* Make sure everything is inited */
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
void *mem = malloc(total);
mem = malloc(size);
/* Check for bad malloc */
if (NULL == mem) {
JANET_OUT_OF_MEMORY;
}
mdata = (JanetGCMemoryHeader *)mem;
/* Configure block */
mdata->flags = type;
mem->flags = type;
/* Prepend block to heap list */
janet_vm_next_collection += (int32_t) size;
mdata->next = janet_vm_blocks;
janet_vm_blocks = mdata;
mem->next = janet_vm_blocks;
janet_vm_blocks = mem;
return (char *) mem + sizeof(JanetGCMemoryHeader);
return (void *)mem;
}
/* Run garbage collection */
@@ -423,10 +420,10 @@ int janet_gcunrootall(Janet root) {
/* Free all allocated memory */
void janet_clear_memory(void) {
JanetGCMemoryHeader *current = janet_vm_blocks;
JanetGCObject *current = janet_vm_blocks;
while (NULL != current) {
janet_deinit_block(current);
JanetGCMemoryHeader *next = current->next;
JanetGCObject *next = current->next;
free(current);
current = next;
}

9
src/core/gc.h
View File

@@ -28,7 +28,7 @@
#endif
/* The metadata header associated with an allocated block of memory */
#define janet_gc_header(mem) ((JanetGCMemoryHeader *)(mem) - 1)
#define janet_gc_header(mem) ((JanetGCObject *)(mem))
#define JANET_MEM_TYPEBITS 0xFF
#define JANET_MEM_REACHABLE 0x100
@@ -40,13 +40,6 @@
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
/* Memory header struct. Node of a linked list of memory blocks. */
typedef struct JanetGCMemoryHeader JanetGCMemoryHeader;
struct JanetGCMemoryHeader {
JanetGCMemoryHeader *next;
uint32_t flags;
};
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
enum JanetMemoryType {
JANET_MEMORY_NONE,

7
src/core/marsh.c
View File

@@ -446,7 +446,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
int32_t i, count, flag;
const Janet *tup = janet_unwrap_tuple(x);
count = janet_tuple_length(tup);
flag = janet_tuple_flag(tup);
flag = janet_tuple_flag(tup) >> 16;
pushbyte(st, LB_TUPLE);
pushint(st, count);
pushint(st, flag);
@@ -847,6 +847,9 @@ static const uint8_t *unmarshal_one_fiber(
fiber->data = NULL;
fiber->child = NULL;
/* Push fiber to seen stack */
janet_array_push(&st->lookup, janet_wrap_fiber(fiber));
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
int32_t frame = 0;
int32_t stack = 0;
@@ -1087,7 +1090,7 @@ static const uint8_t *unmarshal_one(
/* Tuple */
Janet *tup = janet_tuple_begin(len);
int32_t flag = readint(st, &data);
janet_tuple_flag(tup) = flag;
janet_tuple_flag(tup) |= flag << 16;
for (int32_t i = 0; i < len; i++) {
data = unmarshal_one(st, data, tup + i, flags + 1);
}

2
src/core/parse.c
View File

@@ -348,7 +348,7 @@ static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
static Janet close_tuple(JanetParser *p, JanetParseState *state, int32_t flag) {
Janet *ret = janet_tuple_begin(state->argn);
janet_tuple_flag(ret) = flag;
janet_tuple_flag(ret) |= flag;
for (int32_t i = state->argn - 1; i >= 0; i--)
ret[i] = p->args[--p->argcount];
return janet_wrap_tuple(janet_tuple_end(ret));

4
src/core/pp.c
View File

@@ -629,11 +629,11 @@ void janet_buffer_format(
}
case 's': {
const uint8_t *s = janet_getstring(argv, arg);
size_t l = janet_string_length(s);
int32_t l = janet_string_length(s);
if (form[2] == '\0')
janet_buffer_push_bytes(b, s, l);
else {
if (l != strlen((const char *) s))
if (l != (int32_t) strlen((const char *) s))
janet_panic("string contains zeros");
if (!strchr(form, '.') && l >= 100) {
janet_panic

25
src/core/string.c
View File

@@ -31,11 +31,11 @@
/* Begin building a string */
uint8_t *janet_string_begin(int32_t length) {
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + length + 1);
uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
janet_string_length(str) = length;
str[length] = 0;
return str;
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1);
head->length = length;
uint8_t *data = (uint8_t *)head->data;
data[length] = 0;
return data;
}
/* Finish building a string */
@@ -46,14 +46,13 @@ const uint8_t *janet_string_end(uint8_t *str) {
/* Load a buffer as a string */
const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
int32_t hash = janet_string_calchash(buf, len);
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + len + 1);
uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
memcpy(str, buf, len);
str[len] = 0;
janet_string_length(str) = len;
janet_string_hash(str) = hash;
return str;
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1);
head->length = len;
head->hash = janet_string_calchash(buf, len);
uint8_t *data = (uint8_t *)head->data;
memcpy(data, buf, len);
data[len] = 0;
return data;
}
/* Compare two strings */

14
src/core/struct.c
View File

@@ -29,18 +29,18 @@
/* Begin creation of a struct */
JanetKV *janet_struct_begin(int32_t count) {
/* Calculate capacity as power of 2 after 2 * count. */
int32_t capacity = janet_tablen(2 * count);
if (capacity < 0) capacity = janet_tablen(count + 1);
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV));
char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
JanetKV *st = (JanetKV *)(data + 4 * sizeof(int32_t));
size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
head->length = count;
head->capacity = capacity;
head->hash = 0;
JanetKV *st = (JanetKV *)(head->data);
janet_memempty(st, capacity);
janet_struct_length(st) = count;
janet_struct_capacity(st) = capacity;
janet_struct_hash(st) = 0;
return st;
}

24
src/core/symcache.c
View File

@@ -25,6 +25,8 @@
* checks, all symbols are interned so that there is a single copy of it in the
* whole program. Equality is then just a pointer check. */
#include <string.h>
#ifndef JANET_AMALG
#include <janet.h>
#include "state.h"
@@ -176,10 +178,10 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
if (success)
return *bucket;
newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
+ (2 * sizeof(int32_t));
janet_string_hash(newstr) = hash;
janet_string_length(newstr) = len;
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
head->hash = hash;
head->length = len;
newstr = (uint8_t *)(head->data);
memcpy(newstr, str, len);
newstr[len] = 0;
janet_symcache_put((const uint8_t *)newstr, bucket);
@@ -188,9 +190,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
/* Get a symbol from a cstring */
const uint8_t *janet_csymbol(const char *cstr) {
int32_t len = 0;
while (cstr[len]) len++;
return janet_symbol((const uint8_t *)cstr, len);
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
}
/* Store counter for genysm to avoid quadratic behavior */
@@ -234,13 +234,11 @@ const uint8_t *janet_symbol_gen(void) {
hash,
&status);
} while (status && (inc_gensym(), 1));
sym = (uint8_t *) janet_gcalloc(
JANET_MEMORY_SYMBOL,
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
(2 * sizeof(int32_t));
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
head->length = sizeof(gensym_counter) - 1;
head->hash = hash;
sym = (uint8_t *)(head->data);
memcpy(sym, gensym_counter, sizeof(gensym_counter));
janet_string_length(sym) = sizeof(gensym_counter) - 1;
janet_string_hash(sym) = hash;
janet_symcache_put((const uint8_t *)sym, bucket);
return (const uint8_t *)sym;
}

46
src/core/tuple.c
View File

@@ -31,13 +31,12 @@
* which should be filled with Janets. The memory will not be collected until
* janet_tuple_end is called. */
Janet *janet_tuple_begin(int32_t length) {
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 5 * sizeof(int32_t) + length * sizeof(Janet));
Janet *tuple = (Janet *)(data + (5 * sizeof(int32_t)));
janet_tuple_length(tuple) = length;
janet_tuple_sm_start(tuple) = -1;
janet_tuple_sm_end(tuple) = -1;
janet_tuple_flag(tuple) = 0;
return tuple;
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
head->sm_start = -1;
head->sm_end = -1;
head->length = length;
return (Janet *)(head->data);
}
/* Finish building a tuple */
@@ -106,26 +105,6 @@ static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
}
static Janet cfun_tuple_prepend(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
JanetView view = janet_getindexed(argv, 0);
Janet *n = janet_tuple_begin(view.len - 1 + argc);
memcpy(n - 1 + argc, view.items, sizeof(Janet) * view.len);
for (int32_t i = 1; i < argc; i++) {
n[argc - i - 1] = argv[i];
}
return janet_wrap_tuple(janet_tuple_end(n));
}
static Janet cfun_tuple_append(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
JanetView view = janet_getindexed(argv, 0);
Janet *n = janet_tuple_begin(view.len - 1 + argc);
memcpy(n, view.items, sizeof(Janet) * view.len);
memcpy(n + view.len, argv + 1, sizeof(Janet) * (argc - 1));
return janet_wrap_tuple(janet_tuple_end(n));
}
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
const Janet *tup = janet_gettuple(argv, 0);
@@ -150,19 +129,6 @@ static const JanetReg tuple_cfuns[] = {
"they default to 0 and the length of arrtup respectively."
"Returns the new tuple.")
},
{
"tuple/append", cfun_tuple_append,
JDOC("(tuple/append tup & items)\n\n"
"Returns a new tuple that is the result of appending "
"each element in items to tup.")
},
{
"tuple/prepend", cfun_tuple_prepend,
JDOC("(tuple/prepend tup & items)\n\n"
"Prepends each element in items to tuple and "
"returns a new tuple. Items are prepended such that the "
"last element in items is the first element in the new tuple.")
},
{
"tuple/type", cfun_tuple_type,
JDOC("(tuple/type tup)\n\n"

114
src/include/janet.h
View File

@@ -210,6 +210,7 @@ extern "C" {
#include <stdlib.h>
#include <stdarg.h>
#include <setjmp.h>
#include <stddef.h>
/* Names of all of the types */
extern const char *const janet_type_names[16];
@@ -262,15 +263,23 @@ typedef union Janet Janet;
typedef struct Janet Janet;
#endif
/* All of the janet types */
/* Use type punning for GC objects */
typedef struct JanetGCObject JanetGCObject;
/* All of the primary Janet GCed types */
typedef struct JanetFunction JanetFunction;
typedef struct JanetArray JanetArray;
typedef struct JanetBuffer JanetBuffer;
typedef struct JanetTable JanetTable;
typedef struct JanetFiber JanetFiber;
/* Prefixed Janet types */
typedef struct JanetTupleHead JanetTupleHead;
typedef struct JanetStructHead JanetStructHead;
typedef struct JanetStringHead JanetStringHead;
typedef struct JanetAbstractHead JanetAbstractHead;
/* Other structs */
typedef struct JanetAbstractHeader JanetAbstractHeader;
typedef struct JanetFuncDef JanetFuncDef;
typedef struct JanetFuncEnv JanetFuncEnv;
typedef struct JanetKV JanetKV;
@@ -582,6 +591,14 @@ JANET_API int janet_checkint64(Janet x);
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
/* GC Object type pun. The lower 16 bits of flags are reserved for the garbage collector,
* but the upper 16 can be used per type for custom flags. The current collector is a linked
* list of blocks, which is naive but works. */
struct JanetGCObject {
int32_t flags;
JanetGCObject *next;
};
/* Fiber signal masks. */
#define JANET_FIBER_MASK_ERROR 2
#define JANET_FIBER_MASK_DEBUG 4
@@ -607,14 +624,15 @@ JANET_API int janet_checkint64(Janet x);
/* A lightweight green thread in janet. Does not correspond to
* operating system threads. */
struct JanetFiber {
Janet *data;
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
JanetGCObject gc; /* GC Object stuff */
int32_t flags; /* More flags */
int32_t frame; /* Index of the stack frame */
int32_t stackstart; /* Beginning of next args */
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
int32_t capacity;
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
int32_t flags; /* Various flags */
Janet *data;
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
};
/* Mark if a stack frame is a tail call for debugging */
@@ -637,25 +655,28 @@ struct JanetStackFrame {
/* A dynamic array type. */
struct JanetArray {
Janet *data;
JanetGCObject gc;
int32_t count;
int32_t capacity;
Janet *data;
};
/* A byte buffer type. Used as a mutable string or string builder. */
struct JanetBuffer {
uint8_t *data;
JanetGCObject gc;
int32_t count;
int32_t capacity;
uint8_t *data;
};
/* A mutable associative data type. Backed by a hashtable. */
struct JanetTable {
JanetKV *data;
JanetTable *proto;
JanetGCObject gc;
int32_t count;
int32_t capacity;
int32_t deleted;
JanetKV *data;
JanetTable *proto;
};
/* A key value pair in a struct or table */
@@ -664,6 +685,41 @@ struct JanetKV {
Janet value;
};
/* Prefix for a tuple */
struct JanetTupleHead {
JanetGCObject gc;
int32_t length;
int32_t hash;
int32_t sm_start;
int32_t sm_end;
const Janet data[];
};
/* Prefix for a struct */
struct JanetStructHead {
JanetGCObject gc;
int32_t length;
int32_t hash;
int32_t capacity;
const JanetKV data[];
};
/* Prefix for a string */
struct JanetStringHead {
JanetGCObject gc;
int32_t length;
int32_t hash;
const uint8_t data[];
};
/* Prefix for an abstract value */
struct JanetAbstractHead {
JanetGCObject gc;
const JanetAbstractType *type;
size_t size;
char data[];
};
/* Some function definition flags */
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
@@ -683,6 +739,7 @@ struct JanetSourceMapping {
/* A function definition. Contains information needed to instantiate closures. */
struct JanetFuncDef {
JanetGCObject gc;
int32_t *environments; /* Which environments to capture from parent. */
Janet *constants;
JanetFuncDef **defs;
@@ -704,6 +761,7 @@ struct JanetFuncDef {
/* A function environment */
struct JanetFuncEnv {
JanetGCObject gc;
union {
JanetFiber *fiber;
Janet *values;
@@ -715,6 +773,7 @@ struct JanetFuncEnv {
/* A function */
struct JanetFunction {
JanetGCObject gc;
JanetFuncDef *def;
JanetFuncEnv *envs[];
};
@@ -754,12 +813,6 @@ struct JanetAbstractType {
void (*put)(void *data, Janet key, Janet value);
};
/* Contains information about abstract types */
struct JanetAbstractHeader {
const JanetAbstractType *type;
size_t size;
};
struct JanetReg {
const char *name;
JanetCFunction cfun;
@@ -992,14 +1045,14 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
/* Tuple */
#define JANET_TUPLE_FLAG_BRACKETCTOR 1
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
#define janet_tuple_raw(t) ((int32_t *)(t) - 5)
#define janet_tuple_length(t) (janet_tuple_raw(t)[0])
#define janet_tuple_hash(t) ((janet_tuple_raw(t)[1]))
#define janet_tuple_sm_start(t) ((janet_tuple_raw(t)[2]))
#define janet_tuple_sm_end(t) ((janet_tuple_raw(t)[3]))
#define janet_tuple_flag(t) ((janet_tuple_raw(t)[4]))
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
#define janet_tuple_sm_start(t) (janet_tuple_head(t)->sm_start)
#define janet_tuple_sm_end(t) (janet_tuple_head(t)->sm_end)
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
JANET_API Janet *janet_tuple_begin(int32_t length);
JANET_API const Janet *janet_tuple_end(Janet *tuple);
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
@@ -1007,9 +1060,9 @@ JANET_API int janet_tuple_equal(const Janet *lhs, const Janet *rhs);
JANET_API int janet_tuple_compare(const Janet *lhs, const Janet *rhs);
/* String/Symbol functions */
#define janet_string_raw(s) ((int32_t *)(s) - 2)
#define janet_string_length(s) (janet_string_raw(s)[0])
#define janet_string_hash(s) ((janet_string_raw(s)[1]))
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
#define janet_string_length(s) (janet_string_head(s)->length)
#define janet_string_hash(s) (janet_string_head(s)->hash)
JANET_API uint8_t *janet_string_begin(int32_t length);
JANET_API const uint8_t *janet_string_end(uint8_t *str);
JANET_API const uint8_t *janet_string(const uint8_t *buf, int32_t len);
@@ -1039,11 +1092,10 @@ JANET_API const uint8_t *janet_symbol_gen(void);
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
/* Structs */
#define janet_struct_raw(t) ((int32_t *)(t) - 4)
#define janet_struct_length(t) (janet_struct_raw(t)[0])
#define janet_struct_capacity(t) (janet_struct_raw(t)[1])
#define janet_struct_hash(t) (janet_struct_raw(t)[2])
/* Do something with the 4th header slot - flags? */
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
JANET_API JanetKV *janet_struct_begin(int32_t count);
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
@@ -1079,7 +1131,7 @@ JANET_API Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
/* Abstract */
#define janet_abstract_header(u) ((JanetAbstractHeader *)(u) - 1)
#define janet_abstract_header(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
#define janet_abstract_type(u) (janet_abstract_header(u)->type)
#define janet_abstract_size(u) (janet_abstract_header(u)->size)
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);

5
test/helper.janet
View File

@@ -26,6 +26,11 @@
(def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-no-error
[msg & forms]
(def errsym (keyword (gensym)))
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defn start-suite [x]
(set suite-num x)
(print "\nRunning test suite " x " tests...\n "))

10
test/suite1.janet
View File

@@ -97,8 +97,8 @@
# of the triangle to the leaves of the triangle.
(defn myfold [xs ys]
(let [xs1 (tuple/prepend xs 0)
xs2 (tuple/append xs 0)
(let [xs1 [;xs 0]
xs2 [0 ;xs]
m1 (map + xs1 ys)
m2 (map + xs2 ys)]
(map max m1 m2)))
@@ -175,10 +175,14 @@
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
(def strct {:a @[nil]})
(put (strct :a) 0 strct)
(testmarsh strct "cyclic struct")
# Large functions
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
(array/push manydefs (tuple * 10000 3 5 7 9))
(def f (compile (tuple/prepend manydefs 'do) *env*))
(def f (compile ['do ;manydefs] *env*))
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
# Some higher order functions and macros

18
test/suite4.janet
View File

@@ -43,5 +43,23 @@
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
# More marshalling code
(defn check-image
"Run a marshaling test using the make-image and load-image functions."
[x msg]
(assert-no-error msg (load-image (make-image x))))
(check-image (fn [] (fn [] 1)) "marshal nested functions")
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
(check-image (fiber/new (fn [] (fiber/new (fn [] 1)))) "marshal nested fibers")
(def issue-53-x
(fiber/new
(fn []
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
(check-image issue-53-x "issue 53 regression")
(end-suite)