1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-15 21:24:48 +00:00
janet/src/core/corelib.c

803 lines
30 KiB
C
Raw Normal View History

/*
* Copyright (c) 2018 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
2018-09-06 02:18:42 +00:00
#include <janet/janet.h>
#include "compile.h"
#include "state.h"
#include "util.h"
/* Generated bytes */
extern const unsigned char *janet_gen_core;
2018-12-08 22:20:24 +00:00
extern int32_t janet_gen_core_size;
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
* with native code. */
2018-10-17 03:08:26 +00:00
#if defined(JANET_NO_DYNAMIC_MODULES)
typedef int Clib;
#define load_clib(name) ((void) name, 0)
#define symbol_clib(lib, sym) ((void) lib, (void) sym, 0)
#define error_clib() "dynamic libraries not supported"
#elif defined(JANET_WINDOWS)
#include <windows.h>
typedef HINSTANCE Clib;
#define load_clib(name) LoadLibrary((name))
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
#define error_clib() "could not load dynamic library"
#else
#include <dlfcn.h>
typedef void *Clib;
#define load_clib(name) dlopen((name), RTLD_NOW)
#define symbol_clib(lib, sym) dlsym((lib), (sym))
#define error_clib() dlerror()
#endif
2018-09-06 02:18:42 +00:00
JanetCFunction janet_native(const char *name, const uint8_t **error) {
Clib lib = load_clib(name);
2018-09-06 02:18:42 +00:00
JanetCFunction init;
if (!lib) {
2018-09-06 02:18:42 +00:00
*error = janet_cstring(error_clib());
return NULL;
}
2018-09-06 02:18:42 +00:00
init = (JanetCFunction) symbol_clib(lib, "_janet_init");
if (!init) {
2018-09-06 02:18:42 +00:00
*error = janet_cstring("could not find _janet_init symbol");
return NULL;
}
return init;
}
2018-09-06 02:18:42 +00:00
static int janet_core_native(JanetArgs args) {
JanetCFunction init;
const uint8_t *error = NULL;
const uint8_t *path = NULL;
2018-09-06 02:18:42 +00:00
JANET_FIXARITY(args, 1);
JANET_ARG_STRING(path, args, 0);
init = janet_native((const char *)path, &error);
if (!init) {
2018-09-06 02:18:42 +00:00
JANET_THROWV(args, janet_wrap_string(error));
}
2018-09-06 02:18:42 +00:00
JANET_RETURN_CFUNCTION(args, init);
}
2018-09-06 02:18:42 +00:00
static int janet_core_print(JanetArgs args) {
int32_t i;
2018-01-14 17:10:45 +00:00
for (i = 0; i < args.n; ++i) {
int32_t j, len;
2018-09-06 02:18:42 +00:00
const uint8_t *vstr = janet_to_string(args.v[i]);
len = janet_string_length(vstr);
for (j = 0; j < len; ++j) {
putc(vstr[j], stdout);
}
}
putc('\n', stdout);
2018-09-06 02:18:42 +00:00
JANET_RETURN_NIL(args);
}
2018-09-06 02:18:42 +00:00
static int janet_core_describe(JanetArgs args) {
int32_t i;
2018-09-06 02:18:42 +00:00
JanetBuffer b;
janet_buffer_init(&b, 0);
2018-01-14 17:10:45 +00:00
for (i = 0; i < args.n; ++i) {
int32_t len;
2018-09-06 02:18:42 +00:00
const uint8_t *str = janet_description(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(&b, str, len);
}
2018-09-06 02:18:42 +00:00
*args.ret = janet_stringv(b.data, b.count);
janet_buffer_deinit(&b);
return 0;
}
2018-09-06 02:18:42 +00:00
static int janet_core_string(JanetArgs args) {
int32_t i;
2018-09-06 02:18:42 +00:00
JanetBuffer b;
janet_buffer_init(&b, 0);
2018-01-14 17:10:45 +00:00
for (i = 0; i < args.n; ++i) {
int32_t len;
2018-09-06 02:18:42 +00:00
const uint8_t *str = janet_to_string(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(&b, str, len);
}
2018-09-06 02:18:42 +00:00
*args.ret = janet_stringv(b.data, b.count);
janet_buffer_deinit(&b);
return 0;
}
2018-09-06 02:18:42 +00:00
static int janet_core_symbol(JanetArgs args) {
int32_t i;
2018-09-06 02:18:42 +00:00
JanetBuffer b;
janet_buffer_init(&b, 0);
for (i = 0; i < args.n; ++i) {
int32_t len;
2018-09-06 02:18:42 +00:00
const uint8_t *str = janet_to_string(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(&b, str, len);
}
2018-09-06 02:18:42 +00:00
*args.ret = janet_symbolv(b.data, b.count);
janet_buffer_deinit(&b);
return 0;
}
static int janet_core_keyword(JanetArgs args) {
int32_t i;
JanetBuffer b;
janet_buffer_init(&b, 0);
for (i = 0; i < args.n; ++i) {
int32_t len;
const uint8_t *str = janet_to_string(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(&b, str, len);
}
*args.ret = janet_keywordv(b.data, b.count);
janet_buffer_deinit(&b);
return 0;
}
2018-09-06 02:18:42 +00:00
static int janet_core_buffer(JanetArgs args) {
int32_t i;
2018-09-06 02:18:42 +00:00
JanetBuffer *b = janet_buffer(0);
for (i = 0; i < args.n; ++i) {
int32_t len;
2018-09-06 02:18:42 +00:00
const uint8_t *str = janet_to_string(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(b, str, len);
}
2018-09-06 02:18:42 +00:00
JANET_RETURN_BUFFER(args, b);
}
2018-11-23 20:33:49 +00:00
static int janet_core_is_abstract(JanetArgs args) {
JANET_FIXARITY(args, 1);
JANET_RETURN_BOOLEAN(args, janet_checktype(args.v[0], JANET_ABSTRACT));
}
2018-09-06 02:18:42 +00:00
static int janet_core_scannumber(JanetArgs args) {
const uint8_t *data;
double val;
int32_t len;
2018-09-06 02:18:42 +00:00
JANET_FIXARITY(args, 1);
JANET_ARG_BYTES(data, len, args, 0);
if (janet_scan_number(data, len, &val))
JANET_THROW(args, "failed to scan number");
JANET_RETURN_NUMBER(args, val);
}
2018-09-06 02:18:42 +00:00
static int janet_core_tuple(JanetArgs args) {
JANET_RETURN_TUPLE(args, janet_tuple_n(args.v, args.n));
}
2018-09-06 02:18:42 +00:00
static int janet_core_array(JanetArgs args) {
JanetArray *array = janet_array(args.n);
2018-01-14 17:10:45 +00:00
array->count = args.n;
2018-09-06 02:18:42 +00:00
memcpy(array->data, args.v, args.n * sizeof(Janet));
JANET_RETURN_ARRAY(args, array);
}
2018-09-06 02:18:42 +00:00
static int janet_core_table(JanetArgs args) {
int32_t i;
2018-09-06 02:18:42 +00:00
JanetTable *table = janet_table(args.n >> 1);
if (args.n & 1)
2018-09-06 02:18:42 +00:00
JANET_THROW(args, "expected even number of arguments");
2018-01-14 17:10:45 +00:00
for (i = 0; i < args.n; i += 2) {
2018-09-06 02:18:42 +00:00
janet_table_put(table, args.v[i], args.v[i + 1]);
}
2018-09-06 02:18:42 +00:00
JANET_RETURN_TABLE(args, table);
}
2018-09-06 02:18:42 +00:00
static int janet_core_struct(JanetArgs args) {
int32_t i;
2018-09-06 02:18:42 +00:00
JanetKV *st = janet_struct_begin(args.n >> 1);
if (args.n & 1)
2018-09-06 02:18:42 +00:00
JANET_THROW(args, "expected even number of arguments");
2018-01-14 17:10:45 +00:00
for (i = 0; i < args.n; i += 2) {
2018-09-06 02:18:42 +00:00
janet_struct_put(st, args.v[i], args.v[i + 1]);
}
2018-09-06 02:18:42 +00:00
JANET_RETURN_STRUCT(args, janet_struct_end(st));
}
2018-09-06 02:18:42 +00:00
static int janet_core_gensym(JanetArgs args) {
JANET_FIXARITY(args, 0);
JANET_RETURN_SYMBOL(args, janet_symbol_gen());
}
2018-09-06 02:18:42 +00:00
static int janet_core_gccollect(JanetArgs args) {
(void) args;
2018-09-06 02:18:42 +00:00
janet_collect();
return 0;
}
2018-09-06 02:18:42 +00:00
static int janet_core_gcsetinterval(JanetArgs args) {
int32_t val;
2018-09-06 02:18:42 +00:00
JANET_FIXARITY(args, 1);
JANET_ARG_INTEGER(val, args, 0);
if (val < 0)
2018-09-06 02:18:42 +00:00
JANET_THROW(args, "expected non-negative integer");
janet_vm_gc_interval = val;
JANET_RETURN_NIL(args);
}
2018-09-06 02:18:42 +00:00
static int janet_core_gcinterval(JanetArgs args) {
JANET_FIXARITY(args, 0);
JANET_RETURN_INTEGER(args, janet_vm_gc_interval);
}
2018-09-06 02:18:42 +00:00
static int janet_core_type(JanetArgs args) {
JANET_FIXARITY(args, 1);
JanetType t = janet_type(args.v[0]);
if (t == JANET_ABSTRACT) {
JANET_RETURN(args, janet_ckeywordv(janet_abstract_type(janet_unwrap_abstract(args.v[0]))->name));
} else {
JANET_RETURN(args, janet_ckeywordv(janet_type_names[t]));
}
}
2018-09-06 02:18:42 +00:00
static int janet_core_next(JanetArgs args) {
Janet ds;
const JanetKV *kv;
JANET_FIXARITY(args, 2);
JANET_CHECKMANY(args, 0, JANET_TFLAG_DICTIONARY);
ds = args.v[0];
2018-09-06 02:18:42 +00:00
if (janet_checktype(ds, JANET_TABLE)) {
JanetTable *t = janet_unwrap_table(ds);
kv = janet_checktype(args.v[1], JANET_NIL)
2018-02-03 23:12:07 +00:00
? NULL
2018-09-06 02:18:42 +00:00
: janet_table_find(t, args.v[1]);
kv = janet_table_next(t, kv);
} else {
2018-09-06 02:18:42 +00:00
const JanetKV *st = janet_unwrap_struct(ds);
kv = janet_checktype(args.v[1], JANET_NIL)
2018-02-03 23:12:07 +00:00
? NULL
2018-09-06 02:18:42 +00:00
: janet_struct_find(st, args.v[1]);
kv = janet_struct_next(st, kv);
}
2018-07-09 00:54:41 +00:00
if (kv)
2018-09-06 02:18:42 +00:00
JANET_RETURN(args, kv->key);
JANET_RETURN_NIL(args);
}
2018-09-06 02:18:42 +00:00
static int janet_core_hash(JanetArgs args) {
JANET_FIXARITY(args, 1);
JANET_RETURN_INTEGER(args, janet_hash(args.v[0]));
}
2018-09-06 02:18:42 +00:00
static const JanetReg cfuns[] = {
{"native", janet_core_native,
"(native path)\n\n"
"Load a native module from the given path. The path "
"must be an absolute or relative path on the file system, and is "
"usually a .so file on Unix systems, and a .dll file on Windows. "
"Returns an environment table that contains functions and other values "
"from the native module."
},
{"print", janet_core_print,
"(print & xs)\n\n"
"Print values to the console (standard out). Value are converted "
"to strings if they are not already. After printing all values, a "
"newline character is printed. Returns nil."
},
{"describe", janet_core_describe,
"(describe x)\n\n"
"Returns a string that is a human readable description of a value x."
},
{"string", janet_core_string,
"(string & parts)\n\n"
"Creates a string by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. "
"Returns the new string."
},
{"symbol", janet_core_symbol,
"(symbol & xs)\n\n"
"Creates a symbol by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new symbol."
},
{"keyword", janet_core_keyword,
"(keyword & xs)\n\n"
"Creates a keyword by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new keyword."
},
{"buffer", janet_core_buffer,
"(buffer & xs)\n\n"
"Creates a new buffer by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new buffer."
},
2018-11-23 20:33:49 +00:00
{"abstract?", janet_core_is_abstract,
"(abstract? x)\n\n"
"Check if x is an abstract type."
},
{"table", janet_core_table,
"(table & kvs)\n\n"
"Creates a new table from a variadic number of keys and values. "
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
"an odd number of elements, an error will be thrown. Returns the "
"new table."
},
{"array", janet_core_array,
"(array & items)\n\n"
"Create a new array that contains items. Returns the new array."
},
{"scan-number", janet_core_scannumber,
"(scan-number str)\n\n"
"Parse a number from a byte sequence an return that number, either and integer "
"or a real. The number "
"must be in the same format as numbers in janet source code. Will return nil "
"on an invalid number."
},
{"tuple", janet_core_tuple,
"(tuple & items)\n\n"
"Creates a new tuple that contains items. Returns the new tuple."
},
{"struct", janet_core_struct,
"(struct & kvs)\n\n"
"Create a new struct from a sequence of key value pairs. "
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
"an odd number of elements, an error will be thrown. Returns the "
"new struct."
},
{"gensym", janet_core_gensym,
"(gensym)\n\n"
"Returns a new symbol that is unique across the runtime. This means it "
"will not collide with any already created symbols during compilation, so "
"it can be used in macros to generate automatic bindings."
},
{"gccollect", janet_core_gccollect,
"(gccollect)\n\n"
"Run garbage collection. You should probably not call this manually."
},
{"gcsetinterval", janet_core_gcsetinterval,
"(gcsetinterval interval)\n\n"
"Set an integer number of bytes to allocate before running garbage collection. "
"Low valuesi for interval will be slower but use less memory. "
"High values will be faster but use more memory."
},
{"gcinterval", janet_core_gcinterval,
"(gcinterval)\n\n"
"Returns the integer number of bytes to allocate before running an iteration "
"of garbage collection."
},
{"type", janet_core_type,
"(type x)\n\n"
"Returns the type of x as a keyword symbol. x is one of\n"
"\t:nil\n"
"\t:boolean\n"
"\t:integer\n"
"\t:real\n"
"\t:array\n"
"\t:tuple\n"
"\t:table\n"
"\t:struct\n"
"\t:string\n"
"\t:buffer\n"
"\t:symbol\n"
"\t:function\n"
"\t:cfunction\n\n"
"or another symbol for an abstract type."
},
{"next", janet_core_next,
"(next dict key)\n\n"
"Gets the next key in a struct or table. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if they data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through. "
},
{"hash", janet_core_hash,
"(hash value)\n\n"
"Gets a hash value for any janet value. The hash is an integer can be used "
"as a cheap hash function for all janet objects. If two values are strictly equal, "
"then they will have the same hash value."
},
{NULL, NULL, NULL}
};
/* Utility for inline assembly */
2018-09-06 02:18:42 +00:00
static void janet_quick_asm(
JanetTable *env,
int32_t flags,
const char *name,
int32_t arity,
int32_t slots,
const uint32_t *bytecode,
size_t bytecode_size,
const char *doc) {
2018-09-06 02:18:42 +00:00
JanetFuncDef *def = janet_funcdef_alloc();
def->arity = arity;
def->flags = flags;
def->slotcount = slots;
def->bytecode = malloc(bytecode_size);
2018-08-06 01:32:32 +00:00
def->bytecode_length = (int32_t)(bytecode_size / sizeof(uint32_t));
2018-09-06 02:18:42 +00:00
def->name = janet_cstring(name);
if (!def->bytecode) {
2018-09-06 02:18:42 +00:00
JANET_OUT_OF_MEMORY;
}
memcpy(def->bytecode, bytecode, bytecode_size);
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
}
2018-09-06 02:18:42 +00:00
/* Macros for easier inline janet assembly */
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
#define S(op, a) ((op) | ((a) << 8))
#define SI(op, a, I) ((op) | ((a) << 8) | ((uint32_t)(I) << 16))
/* Templatize a varop */
static void templatize_varop(
2018-09-06 02:18:42 +00:00
JanetTable *env,
int32_t flags,
const char *name,
int32_t nullary,
int32_t unary,
uint32_t op,
const char *doc) {
/* Variadic operator assembly. Must be templatized for each different opcode. */
/* Reg 0: Argument tuple (args) */
/* Reg 1: Argument count (argn) */
/* Reg 2: Jump flag (jump?) */
/* Reg 3: Accumulator (accum) */
/* Reg 4: Next operand (operand) */
/* Reg 5: Loop iterator (i) */
uint32_t varop_asm[] = {
2018-09-06 02:18:42 +00:00
SS(JOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
/* Check nullary */
2018-09-06 02:18:42 +00:00
SSS(JOP_EQUALS_IMMEDIATE, 2, 1, 0), /* Check if numargs equal to 0 */
SI(JOP_JUMP_IF_NOT, 2, 3), /* If not 0, jump to next check */
/* Nullary */
2018-09-06 02:18:42 +00:00
SI(JOP_LOAD_INTEGER, 3, nullary), /* accum = nullary value */
S(JOP_RETURN, 3), /* return accum */
/* Check unary */
2018-09-06 02:18:42 +00:00
SSI(JOP_EQUALS_IMMEDIATE, 2, 1, 1), /* Check if numargs equal to 1 */
SI(JOP_JUMP_IF_NOT, 2, 5), /* If not 1, jump to next check */
/* Unary */
2018-09-06 02:18:42 +00:00
SI(JOP_LOAD_INTEGER, 3, unary), /* accum = unary value */
SSI(JOP_GET_INDEX, 4, 0, 0), /* operand = args[0] */
SSS(op, 3, 3, 4), /* accum = accum op operand */
2018-09-06 02:18:42 +00:00
S(JOP_RETURN, 3), /* return accum */
/* Mutli (2 or more) arity */
/* Prime loop */
2018-09-06 02:18:42 +00:00
SSI(JOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */
/* Main loop */
2018-09-06 02:18:42 +00:00
SSS(JOP_GET, 4, 0, 5), /* operand = args[i] */
SSS(op, 3, 3, 4), /* accum = accum op operand */
2018-09-06 02:18:42 +00:00
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SSI(JOP_EQUALS, 2, 5, 1), /* jump? = (i == argn) */
2018-09-06 02:18:42 +00:00
SI(JOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
/* Done, do last and return accumulator */
2018-09-06 02:18:42 +00:00
S(JOP_RETURN, 3) /* return accum */
};
2018-09-06 02:18:42 +00:00
janet_quick_asm(
env,
2018-09-06 02:18:42 +00:00
flags | JANET_FUNCDEF_FLAG_VARARG,
name,
0,
6,
varop_asm,
sizeof(varop_asm),
doc);
}
/* Templatize variadic comparators */
static void templatize_comparator(
2018-09-06 02:18:42 +00:00
JanetTable *env,
int32_t flags,
const char *name,
int invert,
uint32_t op,
const char *doc) {
/* Reg 0: Argument tuple (args) */
/* Reg 1: Argument count (argn) */
/* Reg 2: Jump flag (jump?) */
/* Reg 3: Last value (last) */
/* Reg 4: Next operand (next) */
/* Reg 5: Loop iterator (i) */
uint32_t comparator_asm[] = {
2018-09-06 02:18:42 +00:00
SS(JOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
SSS(JOP_LESS_THAN_IMMEDIATE, 2, 1, 2), /* Check if numargs less than 2 */
SI(JOP_JUMP_IF, 2, 10), /* If numargs < 2, jump to done */
/* Prime loop */
2018-09-06 02:18:42 +00:00
SSI(JOP_GET_INDEX, 3, 0, 0), /* last = args[0] */
SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */
/* Main loop */
2018-09-06 02:18:42 +00:00
SSS(JOP_GET, 4, 0, 5), /* next = args[i] */
SSS(op, 2, 3, 4), /* jump? = last compare next */
2018-09-06 02:18:42 +00:00
SI(JOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SS(JOP_MOVE_NEAR, 3, 4), /* last = next */
SSI(JOP_EQUALS, 2, 5, 1), /* jump? = (i == argn) */
2018-09-06 02:18:42 +00:00
SI(JOP_JUMP_IF_NOT, 2, -6), /* if not jump? go back 6 */
/* Done, return true */
2018-09-06 02:18:42 +00:00
S(invert ? JOP_LOAD_FALSE : JOP_LOAD_TRUE, 3),
S(JOP_RETURN, 3),
/* Failed, return false */
2018-09-06 02:18:42 +00:00
S(invert ? JOP_LOAD_TRUE : JOP_LOAD_FALSE, 3),
S(JOP_RETURN, 3)
};
2018-09-06 02:18:42 +00:00
janet_quick_asm(
env,
2018-09-06 02:18:42 +00:00
flags | JANET_FUNCDEF_FLAG_VARARG,
name,
0,
6,
comparator_asm,
sizeof(comparator_asm),
doc);
}
2018-08-26 16:53:39 +00:00
/* Make the apply function */
2018-09-06 02:18:42 +00:00
static void make_apply(JanetTable *env) {
2018-08-26 16:53:39 +00:00
/* Reg 0: Function (fun) */
/* Reg 1: Argument tuple (args) */
/* Reg 2: Argument count (argn) */
/* Reg 3: Jump flag (jump?) */
/* Reg 4: Loop iterator (i) */
/* Reg 5: Loop values (x) */
uint32_t apply_asm[] = {
2018-09-06 02:18:42 +00:00
SS(JOP_LENGTH, 2, 1),
SSS(JOP_EQUALS_IMMEDIATE, 3, 2, 0), /* Immediate tail call if no args */
SI(JOP_JUMP_IF, 3, 9),
2018-08-26 16:53:39 +00:00
/* Prime loop */
2018-09-06 02:18:42 +00:00
SI(JOP_LOAD_INTEGER, 4, 0), /* i = 0 */
2018-08-26 16:53:39 +00:00
/* Main loop */
2018-09-06 02:18:42 +00:00
SSS(JOP_GET, 5, 1, 4), /* x = args[i] */
SSI(JOP_ADD_IMMEDIATE, 4, 4, 1), /* i++ */
SSI(JOP_EQUALS, 3, 4, 2), /* jump? = (i == argn) */
2018-09-06 02:18:42 +00:00
SI(JOP_JUMP_IF, 3, 3), /* if jump? go forward 3 */
S(JOP_PUSH, 5),
(JOP_JUMP | ((uint32_t)(-5) << 8)),
2018-08-26 16:53:39 +00:00
/* Push the array */
2018-09-06 02:18:42 +00:00
S(JOP_PUSH_ARRAY, 5),
2018-08-26 16:53:39 +00:00
/* Call the funciton */
2018-09-06 02:18:42 +00:00
S(JOP_TAILCALL, 0)
2018-08-26 16:53:39 +00:00
};
2018-09-06 02:18:42 +00:00
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 6, apply_asm, sizeof(apply_asm),
"(apply f & args)\n\n"
"Applies a function to a variable number of arguments. Each element in args "
"is used as an argument to f, except the last element in args, which is expected to "
"be an array-like. Each element in this last argument is then also pushed as an argument to "
"f. For example:\n\n"
"\t(apply + 1000 (range 10))\n\n"
"sums the first 10 integers and 1000.)");
2018-08-26 16:53:39 +00:00
}
2018-09-06 02:18:42 +00:00
JanetTable *janet_core_env(void) {
static const uint32_t error_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_ERROR
};
static const uint32_t debug_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_SIGNAL | (2 << 24),
JOP_RETURN_NIL
};
static const uint32_t yield_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_SIGNAL | (3 << 24),
JOP_RETURN
};
static const uint32_t resume_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_RESUME | (1 << 24),
JOP_RETURN
};
static const uint32_t get_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_GET | (1 << 24),
JOP_RETURN
};
static const uint32_t put_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_PUT | (1 << 16) | (2 << 24),
JOP_RETURN
};
static const uint32_t length_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_LENGTH,
JOP_RETURN
};
static const uint32_t bnot_asm[] = {
2018-09-06 02:18:42 +00:00
JOP_BNOT,
JOP_RETURN
};
2018-09-06 02:18:42 +00:00
JanetTable *env = janet_table(0);
Janet ret = janet_wrap_table(env);
/* Load main functions */
2018-09-06 02:18:42 +00:00
janet_cfuns(env, NULL, cfuns);
janet_quick_asm(env, JANET_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm),
"(debug)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns nil.");
janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm),
"(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber.");
janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm),
"(yield x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume.");
janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm),
"(resume fiber [,x])\n\n"
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber.");
janet_quick_asm(env, JANET_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm),
"(get ds key)\n\n"
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
"symbols, and buffers are all associative and can be used with get. Order structures, name "
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
"take any value as a key except nil and return a value except nil. Byte sequences will return "
"integer representations of bytes as result of a get call.");
janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm),
"(put ds key value)\n\n"
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds.");
janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm),
"(length ds)\n\n"
"Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure.");
janet_quick_asm(env, JANET_FUN_BNOT, "bnot", 1, 1, bnot_asm, sizeof(bnot_asm),
"(bnot x)\n\nReturns the bitwise inverse of integer x.");
2018-08-26 16:53:39 +00:00
make_apply(env);
/* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
"(+ & xs)\n\n"
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.");
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
"(- & xs)\n\n"
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements.");
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
"(* & xs)\n\n"
"Returns the product of all elements in xs. If xs is empty, returns 1.");
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
"(/ & xs)\n\n"
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values. Division by two integers uses truncating division.");
2018-12-17 03:13:48 +00:00
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
"(band & xs)\n\n"
"Returns the bitwise and of all values in xs. Each x in xs must be an integer.");
2018-12-17 03:13:48 +00:00
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
"(bor & xs)\n\n"
"Returns the bitwise or of all values in xs. Each x in xs must be an integer.");
2018-12-17 03:13:48 +00:00
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
"(bxor & xs)\n\n"
"Returns the bitwise xor of all values in xs. Each in xs must be an integer.");
2018-12-17 03:13:48 +00:00
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
"(blshift x & shifts)\n\n"
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer.");
2018-12-17 03:13:48 +00:00
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
"(brshift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer.");
2018-12-17 03:13:48 +00:00
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
"(brushift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive.");
/* Variadic comparators */
templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN,
"(order> & xs)\n\n"
"Check if xs is strictly descending according to a total order "
"over all values. Returns a boolean.");
templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN,
"(order< & xs)\n\n"
"Check if xs is strictly increasing according to a total order "
"over all values. Returns a boolean.");
templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN,
"(order>= & xs)\n\n"
"Check if xs is not increasing according to a total order "
"over all values. Returns a boolean.");
templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN,
"(order<= & xs)\n\n"
"Check if xs is not decreasing according to a total order "
"over all values. Returns a boolean.");
templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS,
"(= & xs)\n\n"
"Returns true if all values in xs are the same, false otherwise.");
templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS,
"(not= & xs)\n\n"
"Return true if any values in xs are not equal, otherwise false.");
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
"(> & xs)\n\n"
"Check if xs is in numerically descending order. Returns a boolean.");
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN,
"(< & xs)\n\n"
"Check if xs is in numerically ascending order. Returns a boolean.");
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
"(>= & xs)\n\n"
"Check if xs is in numerically non-ascending order. Returns a boolean.");
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
"(<= & xs)\n\n"
"Check if xs is in numerically non-descending order. Returns a boolean.");
templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL,
"(== & xs)\n\n"
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean.");
templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL,
"(not== & xs)\n\n"
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean.");
2018-08-07 04:54:47 +00:00
/* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
"The version number of the running janet program.");
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
"The build identifier of the running janet program.");
/* Set as gc root */
2018-09-06 02:18:42 +00:00
janet_gcroot(janet_wrap_table(env));
/* Load auxiliary envs */
{
2018-09-06 02:18:42 +00:00
JanetArgs args;
args.n = 1;
args.v = &ret;
args.ret = &ret;
2018-09-06 02:18:42 +00:00
janet_lib_io(args);
janet_lib_math(args);
janet_lib_array(args);
janet_lib_tuple(args);
janet_lib_buffer(args);
janet_lib_table(args);
janet_lib_fiber(args);
janet_lib_os(args);
janet_lib_parse(args);
janet_lib_compile(args);
janet_lib_debug(args);
2018-09-06 02:18:42 +00:00
janet_lib_string(args);
janet_lib_marsh(args);
#ifdef JANET_ASSEMBLER
janet_lib_asm(args);
#endif
}
/* Allow references to the environment */
janet_def(env, "_env", ret, "The environment table for the current scope.");
/* Run bootstrap source */
janet_dobytes(env, janet_gen_core, janet_gen_core_size, "core.janet", NULL);
return env;
}