mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-27 00:40:26 +00:00
Code Issues 1 Releases Wiki Activity

Merge branch 'master' into new-style-math-bindings

Browse Source
This commit is contained in:
Andrew Owen 2021-07-27 19:19:39 -06:00 committed by GitHub
commit 1c7505e04a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
21 changed files with 1498 additions and 1885 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/boot/boot.janet
View File

@ -3053,10 +3053,10 @@
(print-index identity)))
(defmacro doc
`Shows documentation for the given symbol, or can show a list of available bindings.
If sym is a symbol, will look for documentation for that symbol. If sym is a string
or is not provided, will show all lexical and dynamic bindings in the current environment with
that prefix (all bindings will be shown if no prefix is given).`
``Shows documentation for the given symbol, or can show a list of available bindings.
If `sym` is a symbol, will look for documentation for that symbol. If `sym` is a string
or is not provided, will show all lexical and dynamic bindings in the current environment
containing that string (all bindings will be shown if no string is given).``
[&opt sym]
~(,doc* ',sym))

221
src/core/buffer.c
View File

@ -162,14 +162,20 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
/* C functions */
static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_new,
"(buffer/new capacity)",
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
"Returns a new buffer of length 0.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getinteger(argv, 0);
JanetBuffer *buffer = janet_buffer(cap);
return janet_wrap_buffer(buffer);
}
static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_new_filled,
"(buffer/new-filled count &opt byte)",
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
"Returns the new buffer.") {
janet_arity(argc, 1, 2);
int32_t count = janet_getinteger(argv, 0);
int32_t byte = 0;
@ -183,7 +189,10 @@ static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
return janet_wrap_buffer(buffer);
}
static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_fill,
"(buffer/fill buffer &opt byte)",
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
"Returns the modified buffer.") {
janet_arity(argc, 1, 2);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t byte = 0;
@ -196,7 +205,10 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_trim,
"(buffer/trim buffer)",
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
"modified buffer.") {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
if (buffer->count < buffer->capacity) {
@ -211,7 +223,10 @@ static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_u8,
"(buffer/push-byte buffer & xs)",
"Append bytes to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@ -221,7 +236,11 @@ static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_word,
"(buffer/push-word buffer & xs)",
"Append machine words to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
"throw an error if the buffer overflows.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@ -235,7 +254,12 @@ static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_chars,
"(buffer/push-string buffer & xs)",
"Push byte sequences onto the end of a buffer. "
"Will accept any of strings, keywords, symbols, and buffers. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@ -250,7 +274,13 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_push,
"(buffer/push buffer & xs)",
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@ -270,14 +300,19 @@ static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
}
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_clear,
"(buffer/clear buffer)",
"Sets the size of a buffer to 0 and empties it. The buffer retains "
"its memory so it can be efficiently refilled. Returns the modified buffer.") {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
buffer->count = 0;
return argv[0];
}
static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_popn,
"(buffer/popn buffer n)",
"Removes the last n bytes from the buffer. Returns the modified buffer.") {
janet_fixarity(argc, 2);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t n = janet_getinteger(argv, 1);
@ -290,7 +325,12 @@ static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_slice,
"(buffer/slice bytes &opt start end)",
"Takes a slice of a byte sequence 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 buffer. "
"Returns a new buffer.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
JanetBuffer *buffer = janet_buffer(range.end - range.start);
@ -314,7 +354,9 @@ static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, i
*bit = which_bit;
}
static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_bitset,
"(buffer/bit-set buffer index)",
"Sets the bit at the given bit-index. Returns the buffer.") {
int bit;
int32_t index;
JanetBuffer *buffer;
@ -323,7 +365,9 @@ static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_bitclear,
"(buffer/bit-clear buffer index)",
"Clears the bit at the given bit-index. Returns the buffer.") {
int bit;
int32_t index;
JanetBuffer *buffer;
@ -332,7 +376,9 @@ static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_bitget,
"(buffer/bit buffer index)",
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.") {
int bit;
int32_t index;
JanetBuffer *buffer;
@ -340,7 +386,9 @@ static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
}
static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_bittoggle,
"(buffer/bit-toggle buffer index)",
"Toggles the bit at the given bit index in buffer. Returns the buffer.") {
int bit;
int32_t index;
JanetBuffer *buffer;
@ -349,7 +397,11 @@ static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_blit,
"(buffer/blit dest src &opt dest-start src-start src-end)",
"Insert the contents of src into dest. Can optionally take indices that "
"indicate which part of src to copy into which part of dest. Indices can be "
"negative to index from the end of src or dest. Returns dest.") {
janet_arity(argc, 2, 5);
JanetBuffer *dest = janet_getbuffer(argv, 0);
JanetByteView src = janet_getbytes(argv, 1);
@ -386,7 +438,10 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_buffer_format,
"(buffer/format buffer format & args)",
"Snprintf like functionality for printing values into a buffer. Returns "
" the modified buffer.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
const char *strfrmt = (const char *) janet_getstring(argv, 1);
@ -394,116 +449,26 @@ static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
return argv[0];
}
static const JanetReg buffer_cfuns[] = {
{
"buffer/new", cfun_buffer_new,
JDOC("(buffer/new capacity)\n\n"
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
"Returns a new buffer of length 0.")
},
{
"buffer/new-filled", cfun_buffer_new_filled,
JDOC("(buffer/new-filled count &opt byte)\n\n"
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
"Returns the new buffer.")
},
{
"buffer/fill", cfun_buffer_fill,
JDOC("(buffer/fill buffer &opt byte)\n\n"
"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 & xs)\n\n"
"Append bytes to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.")
},
{
"buffer/push-word", cfun_buffer_word,
JDOC("(buffer/push-word buffer & xs)\n\n"
"Append machine words to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
"throw an error if the buffer overflows.")
},
{
"buffer/push-string", cfun_buffer_chars,
JDOC("(buffer/push-string buffer & xs)\n\n"
"Push byte sequences onto the end of a buffer. "
"Will accept any of strings, keywords, symbols, and buffers. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{
"buffer/push", cfun_buffer_push,
JDOC("(buffer/push buffer & xs)\n\n"
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{
"buffer/popn", cfun_buffer_popn,
JDOC("(buffer/popn buffer n)\n\n"
"Removes the last n bytes from the buffer. Returns the modified buffer.")
},
{
"buffer/clear", cfun_buffer_clear,
JDOC("(buffer/clear buffer)\n\n"
"Sets the size of a buffer to 0 and empties it. The buffer retains "
"its memory so it can be efficiently refilled. Returns the modified buffer.")
},
{
"buffer/slice", cfun_buffer_slice,
JDOC("(buffer/slice bytes &opt start end)\n\n"
"Takes a slice of a byte sequence 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 buffer. "
"Returns a new buffer.")
},
{
"buffer/bit-set", cfun_buffer_bitset,
JDOC("(buffer/bit-set buffer index)\n\n"
"Sets the bit at the given bit-index. Returns the buffer.")
},
{
"buffer/bit-clear", cfun_buffer_bitclear,
JDOC("(buffer/bit-clear buffer index)\n\n"
"Clears the bit at the given bit-index. Returns the buffer.")
},
{
"buffer/bit", cfun_buffer_bitget,
JDOC("(buffer/bit buffer index)\n\n"
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
},
{
"buffer/bit-toggle", cfun_buffer_bittoggle,
JDOC("(buffer/bit-toggle buffer index)\n\n"
"Toggles the bit at the given bit index in buffer. Returns the buffer.")
},
{
"buffer/blit", cfun_buffer_blit,
JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
"Insert the contents of src into dest. Can optionally take indices that "
"indicate which part of src to copy into which part of dest. Indices can be "
"negative to index from the end of src or dest. Returns dest.")
},
{
"buffer/format", cfun_buffer_format,
JDOC("(buffer/format buffer format & args)\n\n"
"Snprintf like functionality for printing values into a buffer. Returns "
" the modified buffer.")
},
{NULL, NULL, NULL}
};
void janet_lib_buffer(JanetTable *env) {
janet_core_cfuns(env, NULL, buffer_cfuns);
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
JANET_CORE_REG("buffer/push", cfun_buffer_push),
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
JANET_CORE_REG("buffer/slice", cfun_buffer_slice),
JANET_CORE_REG("buffer/bit-set", cfun_buffer_bitset),
JANET_CORE_REG("buffer/bit-clear", cfun_buffer_bitclear),
JANET_CORE_REG("buffer/bit", cfun_buffer_bitget),
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
JANET_CORE_REG("buffer/format", cfun_buffer_format),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
}

29
src/core/compile.c
View File

@ -942,7 +942,14 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
}
/* C Function for compiling */
static Janet cfun(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun,
"(compile ast &opt env source lints)",
"Compiles an Abstract Syntax Tree (ast) into a function. "
"Pair the compile function with parsing functionality to implement "
"eval. Returns a new function and does not modify ast. Returns an error "
"struct with keys :line, :column, and :error if compilation fails. "
"If a `lints` array is given, linting messages will be appended to the array. "
"Each message will be a tuple of the form `(level line col message)`.") {
janet_arity(argc, 1, 4);
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm.fiber->env;
if (NULL == env) {
@ -973,20 +980,10 @@ static Janet cfun(int32_t argc, Janet *argv) {
}
}
static const JanetReg compile_cfuns[] = {
{
"compile", cfun,
JDOC("(compile ast &opt env source lints)\n\n"
"Compiles an Abstract Syntax Tree (ast) into a function. "
"Pair the compile function with parsing functionality to implement "
"eval. Returns a new function and does not modify ast. Returns an error "
"struct with keys :line, :column, and :error if compilation fails. "
"If a `lints` array is given, linting messages will be appended to the array. "
"Each message will be a tuple of the form `(level line col message)`.")
},
{NULL, NULL, NULL}
};
void janet_lib_compile(JanetTable *env) {
janet_core_cfuns(env, NULL, compile_cfuns);
JanetRegExt cfuns[] = {
JANET_CORE_REG("compile", cfun),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, cfuns);
}

399
src/core/corelib.c
View File

@ -143,7 +143,18 @@ static int is_path_sep(char c) {
}
/* Used for module system. */
static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_expand_path,
"(module/expand-path path template)",
"Expands a path template as found in `module/paths` for `module/find`. "
"This takes in a path (the argument to require) and a template string, "
"to expand the path to a path that can be "
"used for importing files. The replacements are as follows:\n\n"
"* :all: -- the value of path verbatim\n\n"
"* :cur: -- the current file, or (dyn :current-file)\n\n"
"* :dir: -- the directory containing the current file\n\n"
"* :name: -- the name component of path, with extension if given\n\n"
"* :native: -- the extension used to load natives, .so or .dll\n\n"
"* :sys: -- the system path, or (dyn :syspath)") {
janet_fixarity(argc, 2);
const char *input = janet_getcstring(argv, 0);
const char *template = janet_getcstring(argv, 1);
@ -266,7 +277,9 @@ static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
return janet_wrap_buffer(out);
}
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_dyn,
"(dyn key &opt default)",
"Get a dynamic binding. Returns the default value (or nil) if no binding found.") {
janet_arity(argc, 1, 2);
Janet value;
if (janet_vm.fiber->env) {
@ -280,7 +293,9 @@ static Janet janet_core_dyn(int32_t argc, Janet *argv) {
return value;
}
static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_setdyn,
"(setdyn key value)",
"Set a dynamic binding. Returns value.") {
janet_fixarity(argc, 2);
if (!janet_vm.fiber->env) {
janet_vm.fiber->env = janet_table(2);
@ -289,7 +304,13 @@ static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
return argv[1];
}
static Janet janet_core_native(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_native,
"(native path &opt env)",
"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.") {
JanetModule init;
janet_arity(argc, 1, 2);
const uint8_t *path = janet_getstring(argv, 0);
@ -309,47 +330,72 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
return janet_wrap_table(env);
}
static Janet janet_core_describe(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_describe,
"(describe x)",
"Returns a string that is a human-readable description of a value x.") {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < argc; ++i)
janet_description_b(b, argv[i]);
return janet_stringv(b->data, b->count);
}
static Janet janet_core_string(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_string,
"(string & xs)",
"Creates a string by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new string.") {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < argc; ++i)
janet_to_string_b(b, argv[i]);
return janet_stringv(b->data, b->count);
}
static Janet janet_core_symbol(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_symbol,
"(symbol & xs)",
"Creates a symbol by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new symbol.") {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < argc; ++i)
janet_to_string_b(b, argv[i]);
return janet_symbolv(b->data, b->count);
}
static Janet janet_core_keyword(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_keyword,
"(keyword & xs)",
"Creates a keyword by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new keyword.") {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < argc; ++i)
janet_to_string_b(b, argv[i]);
return janet_keywordv(b->data, b->count);
}
static Janet janet_core_buffer(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_buffer,
"(buffer & xs)",
"Creates a buffer by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new buffer.") {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < argc; ++i)
janet_to_string_b(b, argv[i]);
return janet_wrap_buffer(b);
}
static Janet janet_core_is_abstract(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_is_abstract,
"(abstract? x)",
"Check if x is an abstract type.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktype(argv[0], JANET_ABSTRACT));
}
static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_scannumber,
"(scan-number str)",
"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.") {
double number;
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 0);
@ -358,18 +404,24 @@ static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
return janet_wrap_number(number);
}
static Janet janet_core_tuple(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_tuple,
"(tuple & items)",
"Creates a new tuple that contains items. Returns the new tuple.") {
return janet_wrap_tuple(janet_tuple_n(argv, argc));
}
static Janet janet_core_array(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_array,
"(array & items)",
"Create a new array that contains items. Returns the new array.") {
JanetArray *array = janet_array(argc);
array->count = argc;
safe_memcpy(array->data, argv, argc * sizeof(Janet));
return janet_wrap_array(array);
}
static Janet janet_core_slice(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_slice,
"(slice x &opt start end)",
"Extract a sub-range of an indexed data structure or byte sequence.") {
JanetRange range;
JanetByteView bview;
JanetView iview;
@ -384,7 +436,12 @@ static Janet janet_core_slice(int32_t argc, Janet *argv) {
}
}
static Janet janet_core_table(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_table,
"(table & kvs)",
"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.") {
int32_t i;
if (argc & 1)
janet_panic("expected even number of arguments");
@ -395,7 +452,12 @@ static Janet janet_core_table(int32_t argc, Janet *argv) {
return janet_wrap_table(table);
}
static Janet janet_core_struct(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_struct,
"(struct & kvs)",
"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.") {
int32_t i;
if (argc & 1)
janet_panic("expected even number of arguments");
@ -406,20 +468,30 @@ static Janet janet_core_struct(int32_t argc, Janet *argv) {
return janet_wrap_struct(janet_struct_end(st));
}
static Janet janet_core_gensym(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_gensym,
"(gensym)",
"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.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_symbol(janet_symbol_gen());
}
static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_gccollect,
"(gccollect)",
"Run garbage collection. You should probably not call this manually.") {
(void) argv;
(void) argc;
janet_collect();
return janet_wrap_nil();
}
static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_gcsetinterval,
"(gcsetinterval interval)",
"Set an integer number of bytes to allocate before running garbage collection. "
"Low values for interval will be slower but use less memory. "
"High values will be faster but use more memory.") {
janet_fixarity(argc, 1);
size_t s = janet_getsize(argv, 0);
/* limit interval to 48 bits */
@ -432,13 +504,33 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_gcinterval,
"(gcinterval)",
"Returns the integer number of bytes to allocate before running an iteration "
"of garbage collection.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number((double) janet_vm.gc_interval);
}
static Janet janet_core_type(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_type,
"(type x)",
"Returns the type of `x` as a keyword. `x` is one of:\n\n"
"* :nil\n\n"
"* :boolean\n\n"
"* :number\n\n"
"* :array\n\n"
"* :tuple\n\n"
"* :table\n\n"
"* :struct\n\n"
"* :string\n\n"
"* :buffer\n\n"
"* :symbol\n\n"
"* :keyword\n\n"
"* :function\n\n"
"* :cfunction\n\n"
"* :fiber\n\n"
"or another keyword for an abstract type.") {
janet_fixarity(argc, 1);
JanetType t = janet_type(argv[0]);
if (t == JANET_ABSTRACT) {
@ -448,12 +540,21 @@ static Janet janet_core_type(int32_t argc, Janet *argv) {
}
}
static Janet janet_core_hash(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_hash,
"(hash value)",
"Gets a hash for any value. The hash is an integer can be used "
"as a cheap hash function for all values. If two values are strictly equal, "
"then they will have the same hash value.") {
janet_fixarity(argc, 1);
return janet_wrap_number(janet_hash(argv[0]));
}
static Janet janet_core_getline(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_getline,
"(getline &opt prompt buf env)",
"Reads a line of input into a buffer, including the newline character, using a prompt. "
"An optional environment table can be provided for auto-complete. "
"Returns the modified buffer. "
"Use this function to implement a simple interface for a terminal program.") {
FILE *in = janet_dynfile("in", stdin);
FILE *out = janet_dynfile("out", stdout);
janet_arity(argc, 0, 3);
@ -478,21 +579,27 @@ static Janet janet_core_getline(int32_t argc, Janet *argv) {
return janet_wrap_buffer(buf);
}
static Janet janet_core_trace(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_trace,
"(trace func)",
"Enable tracing on a function. Returns the function.") {
janet_fixarity(argc, 1);
JanetFunction *func = janet_getfunction(argv, 0);
func->gc.flags |= JANET_FUNCFLAG_TRACE;
return argv[0];
}
static Janet janet_core_untrace(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_untrace,
"(untrace func)",
"Disables tracing on a function. Returns the function.") {
janet_fixarity(argc, 1);
JanetFunction *func = janet_getfunction(argv, 0);
func->gc.flags &= ~JANET_FUNCFLAG_TRACE;
return argv[0];
}
static Janet janet_core_check_int(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_check_int,
"(int? x)",
"Check if x can be exactly represented as a 32 bit signed two's complement integer.") {
janet_fixarity(argc, 1);
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
double num = janet_unwrap_number(argv[0]);
@ -501,7 +608,9 @@ ret_false:
return janet_wrap_false();
}
static Janet janet_core_check_nat(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_check_nat,
"(nat? x)",
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") {
janet_fixarity(argc, 1);
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
double num = janet_unwrap_number(argv[0]);
@ -510,7 +619,9 @@ ret_false:
return janet_wrap_false();
}
static Janet janet_core_signal(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_core_signal,
"(signal what x)",
"Raise a signal with payload x. ") {
janet_arity(argc, 1, 2);
int sig;
if (janet_checkint(argv[0])) {
@ -535,205 +646,6 @@ static Janet janet_core_signal(int32_t argc, Janet *argv) {
janet_signalv(sig, payload);
}
static const JanetReg corelib_cfuns[] = {
{
"native", janet_core_native,
JDOC("(native path &opt env)\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.")
},
{
"describe", janet_core_describe,
JDOC("(describe x)\n\n"
"Returns a string that is a human-readable description of a value x.")
},
{
"string", janet_core_string,
JDOC("(string & xs)\n\n"
"Creates a string by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new string.")
},
{
"symbol", janet_core_symbol,
JDOC("(symbol & xs)\n\n"
"Creates a symbol by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new symbol.")
},
{
"keyword", janet_core_keyword,
JDOC("(keyword & xs)\n\n"
"Creates a keyword by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new keyword.")
},
{
"buffer", janet_core_buffer,
JDOC("(buffer & xs)\n\n"
"Creates a buffer by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new buffer.")
},
{
"abstract?", janet_core_is_abstract,
JDOC("(abstract? x)\n\n"
"Check if x is an abstract type.")
},
{
"table", janet_core_table,
JDOC("(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,
JDOC("(array & items)\n\n"
"Create a new array that contains items. Returns the new array.")
},
{
"scan-number", janet_core_scannumber,
JDOC("(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,
JDOC("(tuple & items)\n\n"
"Creates a new tuple that contains items. Returns the new tuple.")
},
{
"struct", janet_core_struct,
JDOC("(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,
JDOC("(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,
JDOC("(gccollect)\n\n"
"Run garbage collection. You should probably not call this manually.")
},
{
"gcsetinterval", janet_core_gcsetinterval,
JDOC("(gcsetinterval interval)\n\n"
"Set an integer number of bytes to allocate before running garbage collection. "
"Low values for interval will be slower but use less memory. "
"High values will be faster but use more memory.")
},
{
"gcinterval", janet_core_gcinterval,
JDOC("(gcinterval)\n\n"
"Returns the integer number of bytes to allocate before running an iteration "
"of garbage collection.")
},
{
"type", janet_core_type,
JDOC("(type x)\n\n"
"Returns the type of `x` as a keyword. `x` is one of:\n\n"
"* :nil\n\n"
"* :boolean\n\n"
"* :number\n\n"
"* :array\n\n"
"* :tuple\n\n"
"* :table\n\n"
"* :struct\n\n"
"* :string\n\n"
"* :buffer\n\n"
"* :symbol\n\n"
"* :keyword\n\n"
"* :function\n\n"
"* :cfunction\n\n"
"* :fiber\n\n"
"or another keyword for an abstract type.")
},
{
"hash", janet_core_hash,
JDOC("(hash value)\n\n"
"Gets a hash for any value. The hash is an integer can be used "
"as a cheap hash function for all values. If two values are strictly equal, "
"then they will have the same hash value.")
},
{
"getline", janet_core_getline,
JDOC("(getline &opt prompt buf env)\n\n"
"Reads a line of input into a buffer, including the newline character, using a prompt. "
"An optional environment table can be provided for auto-complete. "
"Returns the modified buffer. "
"Use this function to implement a simple interface for a terminal program.")
},
{
"dyn", janet_core_dyn,
JDOC("(dyn key &opt default)\n\n"
"Get a dynamic binding. Returns the default value (or nil) if no binding found.")
},
{
"setdyn", janet_core_setdyn,
JDOC("(setdyn key value)\n\n"
"Set a dynamic binding. Returns value.")
},
{
"trace", janet_core_trace,
JDOC("(trace func)\n\n"
"Enable tracing on a function. Returns the function.")
},
{
"untrace", janet_core_untrace,
JDOC("(untrace func)\n\n"
"Disables tracing on a function. Returns the function.")
},
{
"module/expand-path", janet_core_expand_path,
JDOC("(module/expand-path path template)\n\n"
"Expands a path template as found in `module/paths` for `module/find`. "
"This takes in a path (the argument to require) and a template string, "
"to expand the path to a path that can be "
"used for importing files. The replacements are as follows:\n\n"
"* :all: -- the value of path verbatim\n\n"
"* :cur: -- the current file, or (dyn :current-file)\n\n"
"* :dir: -- the directory containing the current file\n\n"
"* :name: -- the name component of path, with extension if given\n\n"
"* :native: -- the extension used to load natives, .so or .dll\n\n"
"* :sys: -- the system path, or (dyn :syspath)")
},
{
"int?", janet_core_check_int,
JDOC("(int? x)\n\n"
"Check if x can be exactly represented as a 32 bit signed two's complement integer.")
},
{
"nat?", janet_core_check_nat,
JDOC("(nat? x)\n\n"
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.")
},
{
"slice", janet_core_slice,
JDOC("(slice x &opt start end)\n\n"
"Extract a sub-range of an indexed data structure or byte sequence.")
},
{
"signal", janet_core_signal,
JDOC("(signal what x)\n\n"
"Raise a signal with payload x. ")
},
{NULL, NULL, NULL}
};
#ifdef JANET_BOOTSTRAP
/* Utility for inline assembly */
@ -1006,7 +918,38 @@ static const uint32_t cmp_asm[] = {
*/
static void janet_load_libs(JanetTable *env) {
janet_core_cfuns(env, NULL, corelib_cfuns);
JanetRegExt corelib_cfuns[] = {
JANET_CORE_REG("native", janet_core_native),
JANET_CORE_REG("describe", janet_core_describe),
JANET_CORE_REG("string", janet_core_string),
JANET_CORE_REG("symbol", janet_core_symbol),
JANET_CORE_REG("keyword", janet_core_keyword),
JANET_CORE_REG("buffer", janet_core_buffer),
JANET_CORE_REG("abstract?", janet_core_is_abstract),
JANET_CORE_REG("table", janet_core_table),
JANET_CORE_REG("array", janet_core_array),
JANET_CORE_REG("scan-number", janet_core_scannumber),
JANET_CORE_REG("tuple", janet_core_tuple),
JANET_CORE_REG("struct", janet_core_struct),
JANET_CORE_REG("gensym", janet_core_gensym),
JANET_CORE_REG("gccollect", janet_core_gccollect),
JANET_CORE_REG("gcsetinterval", janet_core_gcsetinterval),
JANET_CORE_REG("gcinterval", janet_core_gcinterval),
JANET_CORE_REG("type", janet_core_type),
JANET_CORE_REG("hash", janet_core_hash),
JANET_CORE_REG("getline", janet_core_getline),
JANET_CORE_REG("dyn", janet_core_dyn),
JANET_CORE_REG("setdyn", janet_core_setdyn),
JANET_CORE_REG("trace", janet_core_trace),
JANET_CORE_REG("untrace", janet_core_untrace),
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
JANET_CORE_REG("int?", janet_core_check_int),
JANET_CORE_REG("nat?", janet_core_check_nat),
JANET_CORE_REG("slice", janet_core_slice),
JANET_CORE_REG("signal", janet_core_signal),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, corelib_cfuns);
janet_lib_io(env);
janet_lib_math(env);
janet_lib_array(env);

157
src/core/debug.c
View File

@ -195,7 +195,13 @@ static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32
*bytecode_offset = offset;
}
static Janet cfun_debug_break(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_break,
"(debug/break source line col)",
"Sets a breakpoint in `source` at a given line and column. "
"Will throw an error if the breakpoint location "
"cannot be found. For example\n\n"
"\t(debug/break \"core.janet\" 10 4)\n\n"
"will set a breakpoint at line 10, 4th column of the file core.janet.") {
JanetFuncDef *def;
int32_t offset;
helper_find(argc, argv, &def, &offset);
@ -203,7 +209,11 @@ static Janet cfun_debug_break(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_unbreak,
"(debug/unbreak source line column)",
"Remove a breakpoint with a source key at a given line and column. "
"Will throw an error if the breakpoint "
"cannot be found.") {
JanetFuncDef *def;
int32_t offset = 0;
helper_find(argc, argv, &def, &offset);
@ -211,7 +221,11 @@ static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_fbreak,
"(debug/fbreak fun &opt pc)",
"Set a breakpoint in a given function. pc is an optional offset, which "
"is in bytecode instructions. fun is a function value. Will throw an error "
"if the offset is too large or negative.") {
JanetFuncDef *def;
int32_t offset = 0;
helper_find_fun(argc, argv, &def, &offset);
@ -219,7 +233,9 @@ static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_unfbreak,
"(debug/unfbreak fun &opt pc)",
"Unset a breakpoint set with debug/fbreak.") {
JanetFuncDef *def;
int32_t offset;
helper_find_fun(argc, argv, &def, &offset);
@ -227,7 +243,12 @@ static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_lineage,
"(debug/lineage fib)",
"Returns an array of all child fibers from a root fiber. This function "
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
"the fiber handling the error can see which fiber raised the signal. This function should "
"be used mostly for debugging purposes.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
JanetArray *array = janet_array(0);
@ -284,7 +305,21 @@ static Janet doframe(JanetStackFrame *frame) {
return janet_wrap_table(t);
}
static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_stack,
"(debug/stack fib)",
"Gets information about the stack as an array of tables. Each table "
"in the array contains information about a stack frame. The top-most, current "
"stack frame is the first table in the array, and the bottom-most stack frame "
"is the last value. Each stack frame contains some of the following attributes:\n\n"
"* :c - true if the stack frame is a c function invocation\n\n"
"* :column - the current source column of the stack frame\n\n"
"* :function - the function that the stack frame represents\n\n"
"* :line - the current source line of the stack frame\n\n"
"* :name - the human-friendly name of the function\n\n"
"* :pc - integer indicating the location of the program counter\n\n"
"* :source - string with the file path or other identifier for the source code\n\n"
"* :slots - array of all values in each slot\n\n"
"* :tail - boolean indicating a tail call") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
JanetArray *array = janet_array(0);
@ -300,7 +335,11 @@ static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
return janet_wrap_array(array);
}
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_stacktrace,
"(debug/stacktrace fiber &opt err)",
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
"an error value to print the stack trace with. If `err` is nil or not "
"provided, will skip the error line. Returns the fiber.") {
janet_arity(argc, 1, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
@ -308,7 +347,11 @@ static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_argstack,
"(debug/arg-stack fiber)",
"Gets all values currently on the fiber's argument stack. Normally, "
"this should be empty unless the fiber signals while pushing arguments "
"to make a function call. Returns a new array.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
@ -317,7 +360,11 @@ static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
return janet_wrap_array(array);
}
static Janet cfun_debug_step(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_debug_step,
"(debug/step fiber &opt x)",
"Run a fiber for one virtual instruction of the Janet machine. Can optionally "
"pass in a value that will be passed as the resuming value. Returns the signal value, "
"which will usually be nil, as breakpoints raise nil signals.") {
janet_arity(argc, 1, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet out = janet_wrap_nil();
@ -325,85 +372,19 @@ static Janet cfun_debug_step(int32_t argc, Janet *argv) {
return out;
}
static const JanetReg debug_cfuns[] = {
{
"debug/break", cfun_debug_break,
JDOC("(debug/break source line col)\n\n"
"Sets a breakpoint in `source` at a given line and column. "
"Will throw an error if the breakpoint location "
"cannot be found. For example\n\n"
"\t(debug/break \"core.janet\" 10 4)\n\n"
"will set a breakpoint at line 10, 4th column of the file core.janet.")
},
{
"debug/unbreak", cfun_debug_unbreak,
JDOC("(debug/unbreak source line column)\n\n"
"Remove a breakpoint with a source key at a given line and column. "
"Will throw an error if the breakpoint "
"cannot be found.")
},
{
"debug/fbreak", cfun_debug_fbreak,
JDOC("(debug/fbreak fun &opt pc)\n\n"
"Set a breakpoint in a given function. pc is an optional offset, which "
"is in bytecode instructions. fun is a function value. Will throw an error "
"if the offset is too large or negative.")
},
{
"debug/unfbreak", cfun_debug_unfbreak,
JDOC("(debug/unfbreak fun &opt pc)\n\n"
"Unset a breakpoint set with debug/fbreak.")
},
{
"debug/arg-stack", cfun_debug_argstack,
JDOC("(debug/arg-stack fiber)\n\n"
"Gets all values currently on the fiber's argument stack. Normally, "
"this should be empty unless the fiber signals while pushing arguments "
"to make a function call. Returns a new array.")
},
{
"debug/stack", cfun_debug_stack,
JDOC("(debug/stack fib)\n\n"
"Gets information about the stack as an array of tables. Each table "
"in the array contains information about a stack frame. The top-most, current "
"stack frame is the first table in the array, and the bottom-most stack frame "
"is the last value. Each stack frame contains some of the following attributes:\n\n"
"* :c - true if the stack frame is a c function invocation\n\n"
"* :column - the current source column of the stack frame\n\n"
"* :function - the function that the stack frame represents\n\n"
"* :line - the current source line of the stack frame\n\n"
"* :name - the human-friendly name of the function\n\n"
"* :pc - integer indicating the location of the program counter\n\n"
"* :source - string with the file path or other identifier for the source code\n\n"
"* :slots - array of all values in each slot\n\n"
"* :tail - boolean indicating a tail call")
},
{
"debug/stacktrace", cfun_debug_stacktrace,
JDOC("(debug/stacktrace fiber &opt err)\n\n"
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
"an error value to print the stack trace with. If `err` is nil or not "
"provided, will skip the error line. Returns the fiber.")
},
{
"debug/lineage", cfun_debug_lineage,
JDOC("(debug/lineage fib)\n\n"
"Returns an array of all child fibers from a root fiber. This function "
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
"the fiber handling the error can see which fiber raised the signal. This function should "
"be used mostly for debugging purposes.")
},
{
"debug/step", cfun_debug_step,
JDOC("(debug/step fiber &opt x)\n\n"
"Run a fiber for one virtual instruction of the Janet machine. Can optionally "
"pass in a value that will be passed as the resuming value. Returns the signal value, "
"which will usually be nil, as breakpoints raise nil signals.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_debug(JanetTable *env) {
janet_core_cfuns(env, NULL, debug_cfuns);
JanetRegExt debug_cfuns[] = {
JANET_CORE_REG("debug/break", cfun_debug_break),
JANET_CORE_REG("debug/unbreak", cfun_debug_unbreak),
JANET_CORE_REG("debug/fbreak", cfun_debug_fbreak),
JANET_CORE_REG("debug/unfbreak", cfun_debug_unfbreak),
JANET_CORE_REG("debug/arg-stack", cfun_debug_argstack),
JANET_CORE_REG("debug/stack", cfun_debug_stack),
JANET_CORE_REG("debug/stacktrace", cfun_debug_stacktrace),
JANET_CORE_REG("debug/lineage", cfun_debug_lineage),
JANET_CORE_REG("debug/step", cfun_debug_step),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, debug_cfuns);
}

291
src/core/ev.c
View File

@ -721,7 +721,10 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
/* Channel Methods */
static Janet cfun_channel_push(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_push,
"(ev/give channel value)",
"Write a value to a channel, suspending the current fiber if the channel is full."
) {
janet_fixarity(argc, 2);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
if (janet_channel_push(channel, argv[1], 0)) {
@ -730,7 +733,10 @@ static Janet cfun_channel_push(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_channel_pop(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_pop,
"(ev/take channel)",
"Read from a channel, suspending the current fiber if no value is available."
) {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
Janet item;
@ -740,7 +746,13 @@ static Janet cfun_channel_pop(int32_t argc, Janet *argv) {
janet_await();
}
static Janet cfun_channel_choice(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_choice,
"(ev/select & clauses)",
"Block until the first of several channel operations occur. Returns a tuple of the form [:give chan] or [:take chan x], where "
"a :give tuple is the result of a write and :take tuple is the result of a write. Each clause must be either a channel (for "
"a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first "
"clauses will take precedence over later clauses."
) {
janet_arity(argc, 1, -1);
int32_t len;
const Janet *data;
@ -782,19 +794,28 @@ static Janet cfun_channel_choice(int32_t argc, Janet *argv) {
janet_await();
}
static Janet cfun_channel_full(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_full,
"(ev/full channel)",
"Check if a channel is full or not."
) {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_boolean(janet_q_count(&channel->items) >= channel->limit);
}
static Janet cfun_channel_capacity(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_capacity,
"(ev/capacity channel)",
"Get the number of items a channel will store before blocking writers."
) {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_integer(channel->limit);
}
static Janet cfun_channel_count(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_count,
"(ev/count channel)",
"Get the number of items currently waiting in a channel."
) {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_integer(janet_q_count(&channel->items));
@ -810,12 +831,19 @@ static void fisher_yates_args(int32_t argc, Janet *argv) {
}
}
static Janet cfun_channel_rchoice(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_rchoice,
"(ev/rselect & clauses)",
"Similar to ev/select, but will try clauses in a random order for fairness."
) {
fisher_yates_args(argc, argv);
return cfun_channel_choice(argc, argv);
}
static Janet cfun_channel_new(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_channel_new,
"(ev/chan &opt capacity)",
"Create a new channel. capacity is the number of values to queue before "
"blocking writers, defaults to 0 if not provided. Returns a new channel."
) {
janet_arity(argc, 0, 1);
int32_t limit = janet_optnat(argv, argc, 0, 0);
JanetChannel *channel = janet_abstract(&ChannelAT, sizeof(JanetChannel));
@ -1082,6 +1110,23 @@ static int make_epoll_events(int mask) {
return events;
}
static void janet_epoll_sync_callback(JanetEVGenericMessage msg) {
JanetListenerState *state = msg.argp;
JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
if (state->stream->_mask & JANET_ASYNC_LISTEN_WRITE)
status1 = state->machine(state, JANET_ASYNC_EVENT_WRITE);
if (state->stream->_mask & JANET_ASYNC_LISTEN_WRITE)
status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
if (status1 == JANET_ASYNC_STATUS_DONE ||
status2 == JANET_ASYNC_STATUS_DONE) {
janet_unlisten(state, 0);
} else {
/* Repost event */
janet_ev_post_event(NULL, janet_epoll_sync_callback, msg);
}
}
/* Wait for the next event */
JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user) {
int is_first = !(stream->state);
@ -1095,9 +1140,23 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
status = epoll_ctl(janet_vm.epoll, op, stream->handle, &ev);
} while (status == -1 && errno == EINTR);
if (status == -1) {
if (errno == EPERM) {
/* Couldn't add to event loop, so assume that it completes
* synchronously. In that case, fire the completion
* event manually, since this should be a read or write
* event to a file. So we just post a custom event to do the read/write
* asap. */
/* Use flag to indicate state is not registered in epoll */
state->_mask |= (1 << JANET_ASYNC_EVENT_COMPLETE);
JanetEVGenericMessage msg = {0};
msg.argp = state;
janet_ev_post_event(NULL, janet_epoll_sync_callback, msg);
} else {
/* Unexpected error */
janet_unlisten_impl(state, 0);
janet_panicv(janet_ev_lasterr());
}
}
return state;
}
@ -1105,6 +1164,8 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
static void janet_unlisten(JanetListenerState *state, int is_gc) {
JanetStream *stream = state->stream;
if (!(stream->flags & JANET_STREAM_CLOSED)) {
/* Use flag to indicate state is not registered in epoll */
if (!(state->_mask & (1 << JANET_ASYNC_EVENT_COMPLETE))) {
int is_last = (state->_next == NULL && stream->state == state);
int op = is_last ? EPOLL_CTL_DEL : EPOLL_CTL_MOD;
struct epoll_event ev;
@ -1118,6 +1179,7 @@ static void janet_unlisten(JanetListenerState *state, int is_gc) {
janet_panicv(janet_ev_lasterr());
}
}
}
/* Destroy state machine and free memory */
janet_unlisten_impl(state, is_gc);
}
@ -1358,7 +1420,7 @@ void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage ms
JanetSelfPipeEvent event;
event.msg = msg;
event.cb = cb;
int fd = vm->selfpipe;
int fd = vm->selfpipe[1];
/* handle a bit of back pressure before giving up. */
int tries = 4;
while (tries > 0) {
@ -2082,7 +2144,14 @@ error:
/* C functions */
static Janet cfun_ev_go(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_ev_go,
"(ev/go fiber &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. Optionally pass "
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
"An optional `core/channel` can be provided as well as a supervisor. When various "
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
"If not provided, the new fiber will inherit the current supervisor."
) {
janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
@ -2134,7 +2203,14 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
return args;
}
static Janet cfun_ev_thread(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_ev_thread,
"(ev/thread fiber &opt value flags)",
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
"to resume with. "
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. "
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
"Otherwise, returns (a copy of) the final result from the fiber on the new thread."
) {
janet_arity(argc, 1, 3);
janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
@ -2166,7 +2242,12 @@ static Janet cfun_ev_thread(int32_t argc, Janet *argv) {
}
}
static Janet cfun_ev_give_supervisor(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_ev_give_supervisor,
"(ev/give-supervisor tag & payload)",
"Send a message to the current supervior channel if there is one. The message will be a "
"tuple of all of the arguments combined into a single message, where the first element is tag. "
"By convention, tag should be a keyword indicating the type of message. Returns nil."
) {
janet_arity(argc, 1, -1);
JanetChannel *chan = janet_vm.root_fiber->supervisor_channel;
if (NULL != chan) {
@ -2188,13 +2269,22 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
janet_await();
}
static Janet cfun_ev_sleep(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_ev_sleep,
"(ev/sleep sec)",
"Suspend the current fiber for sec seconds without blocking the event loop."
) {
janet_fixarity(argc, 1);
double sec = janet_getnumber(argv, 0);
janet_sleep_await(sec);
}
static Janet cfun_ev_deadline(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_ev_deadline,
"(ev/deadline sec &opt tocancel tocheck)",
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`."
) {
janet_arity(argc, 1, 3);
double sec = janet_getnumber(argv, 0);
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber);
@ -2209,7 +2299,10 @@ static Janet cfun_ev_deadline(int32_t argc, Janet *argv) {
return janet_wrap_fiber(tocancel);
}
static Janet cfun_ev_cancel(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_ev_cancel,
"(ev/cancel fiber err)",
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately"
) {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet err = argv[1];
@ -2217,14 +2310,25 @@ static Janet cfun_ev_cancel(int32_t argc, Janet *argv) {
return argv[0];
}
Janet janet_cfun_stream_close(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_cfun_stream_close,
"(ev/close stream)",
"Close a stream. This should be the same as calling (:close stream) for all streams."
) {
janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_close(stream);
return argv[0];
}
Janet janet_cfun_stream_read(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_cfun_stream_read,
"(ev/read stream n &opt buffer timeout)",
"Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
"`:all` to read into the buffer until end of stream. "
"Optionally provide a buffer to write into "
"as well as a timeout in seconds after which to cancel the operation and raise an error. "
"Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "
"error if there are problems with the IO operation."
) {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE);
@ -2241,7 +2345,11 @@ Janet janet_cfun_stream_read(int32_t argc, Janet *argv) {
janet_await();
}
Janet janet_cfun_stream_chunk(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_cfun_stream_chunk,
"(ev/chunk stream n &opt buffer timeout)",
"Same as ev/read, but will not return early if less than n bytes are available. If an end of "
"stream is reached, will also return early with the collected bytes."
) {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE);
@ -2253,7 +2361,11 @@ Janet janet_cfun_stream_chunk(int32_t argc, Janet *argv) {
janet_await();
}
Janet janet_cfun_stream_write(int32_t argc, Janet *argv) {
JANET_CORE_FN(janet_cfun_stream_write,
"(ev/write stream data &opt timeout)",
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.") {
janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_WRITABLE);
@ -2269,127 +2381,30 @@ Janet janet_cfun_stream_write(int32_t argc, Janet *argv) {
janet_await();
}
static const JanetReg ev_cfuns[] = {
{
"ev/go", cfun_ev_go,
JDOC("(ev/go fiber &opt value supervisor)\n\n"
"Put a fiber on the event loop to be resumed later. Optionally pass "
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
"An optional `core/channel` can be provided as well as a supervisor. When various "
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
"If not provided, the new fiber will inherit the current supervisor.")
},
{
"ev/thread", cfun_ev_thread,
JDOC("(ev/thread fiber &opt value flags)\n\n"
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
"to resume with. "
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. "
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
"Otherwise, returns (a copy of) the final result from the fiber on the new thread.")
},
{
"ev/give-supervisor", cfun_ev_give_supervisor,
JDOC("(ev/give-supervsior tag & payload)\n\n"
"Send a message to the current supervior channel if there is one. The message will be a "
"tuple of all of the arguments combined into a single message, where the first element is tag. "
"By convention, tag should be a keyword indicating the type of message. Returns nil.")
},
{
"ev/sleep", cfun_ev_sleep,
JDOC("(ev/sleep sec)\n\n"
"Suspend the current fiber for sec seconds without blocking the event loop.")
},
{
"ev/deadline", cfun_ev_deadline,
JDOC("(ev/deadline sec &opt tocancel tocheck)\n\n"
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`.")
},
{
"ev/chan", cfun_channel_new,
JDOC("(ev/chan &opt capacity)\n\n"
"Create a new channel. capacity is the number of values to queue before "
"blocking writers, defaults to 0 if not provided. Returns a new channel.")
},
{
"ev/give", cfun_channel_push,
JDOC("(ev/give channel value)\n\n"
"Write a value to a channel, suspending the current fiber if the channel is full.")
},
{
"ev/take", cfun_channel_pop,
JDOC("(ev/take channel)\n\n"
"Read from a channel, suspending the current fiber if no value is available.")
},
{
"ev/full", cfun_channel_full,
JDOC("(ev/full channel)\n\n"
"Check if a channel is full or not.")
},
{
"ev/capacity", cfun_channel_capacity,
JDOC("(ev/capacity channel)\n\n"
"Get the number of items a channel will store before blocking writers.")
},
{
"ev/count", cfun_channel_count,
JDOC("(ev/count channel)\n\n"
"Get the number of items currently waiting in a channel.")
},
{
"ev/cancel", cfun_ev_cancel,
JDOC("(ev/cancel fiber err)\n\n"
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately")
},
{
"ev/select", cfun_channel_choice,
JDOC("(ev/select & clauses)\n\n"
"Block until the first of several channel operations occur. Returns a tuple of the form [:give chan] or [:take chan x], where "
"a :give tuple is the result of a write and :take tuple is the result of a write. Each clause must be either a channel (for "
"a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first "
"clauses will take precedence over later clauses.")
},
{
"ev/rselect", cfun_channel_rchoice,
JDOC("(ev/rselect & clauses)\n\n"
"Similar to ev/select, but will try clauses in a random order for fairness.")
},
{
"ev/close", janet_cfun_stream_close,
JDOC("(ev/close stream)\n\n"
"Close a stream. This should be the same as calling (:close stream) for all streams.")
},
{
"ev/read", janet_cfun_stream_read,
JDOC("(ev/read stream n &opt buffer timeout)\n\n"
"Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
"`:all` to read into the buffer until end of stream. "
"Optionally provide a buffer to write into "
"as well as a timeout in seconds after which to cancel the operation and raise an error. "
"Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "
"error if there are problems with the IO operation.")
},
{
"ev/chunk", janet_cfun_stream_chunk,
JDOC("(ev/chunk stream n &opt buffer timeout)\n\n"
"Same as ev/read, but will not return early if less than n bytes are available. If an end of "
"stream is reached, will also return early with the collected bytes.")
},
{
"ev/write", janet_cfun_stream_write,
JDOC("(ev/write stream data &opt timeout)\n\n"
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.")
},
{NULL, NULL, NULL}
void janet_lib_ev(JanetTable *env) {
JanetRegExt ev_cfuns_ext[] = {
JANET_CORE_REG("ev/give", cfun_channel_push),
JANET_CORE_REG("ev/take", cfun_channel_pop),
JANET_CORE_REG("ev/full", cfun_channel_full),
JANET_CORE_REG("ev/capacity", cfun_channel_capacity),
JANET_CORE_REG("ev/count", cfun_channel_count),
JANET_CORE_REG("ev/select", cfun_channel_choice),
JANET_CORE_REG("ev/rselect", cfun_channel_rchoice),
JANET_CORE_REG("ev/chan", cfun_channel_new),
JANET_CORE_REG("ev/go", cfun_ev_go),
JANET_CORE_REG("ev/thread", cfun_ev_thread),
JANET_CORE_REG("ev/give-supervisor", cfun_ev_give_supervisor),
JANET_CORE_REG("ev/sleep", cfun_ev_sleep),
JANET_CORE_REG("ev/deadline", cfun_ev_deadline),
JANET_CORE_REG("ev/cancel", cfun_ev_cancel),
JANET_CORE_REG("ev/close", janet_cfun_stream_close),
JANET_CORE_REG("ev/read", janet_cfun_stream_read),
JANET_CORE_REG("ev/chunk", janet_cfun_stream_chunk),
JANET_CORE_REG("ev/write", janet_cfun_stream_write),
JANET_REG_END
};
void janet_lib_ev(JanetTable *env) {
janet_core_cfuns(env, NULL, ev_cfuns);
janet_core_cfuns_ext(env, NULL, ev_cfuns_ext);
janet_register_abstract_type(&janet_stream_type);
}

177
src/core/fiber.c
View File

@ -451,7 +451,10 @@ JanetFiber *janet_root_fiber(void) {
/* CFuns */
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_getenv,
"(fiber/getenv fiber)",
"Gets the environment for a fiber. Returns nil if no such table is "
"set yet.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
return fiber->env ?
@ -459,7 +462,10 @@ static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
janet_wrap_nil();
}
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_setenv,
"(fiber/setenv fiber table)",
"Sets the environment table for a fiber. Set to nil to remove the current "
"environment.") {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
if (janet_checktype(argv[1], JANET_NIL)) {
@ -470,7 +476,30 @@ static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_new,
"(fiber/new func &opt sigmask)",
"Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber "
"when called. The mask is specified as a keyword where each character "
"is used to indicate a signal to block. If the ev module is enabled, and "
"this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
"will result in messages being sent to the supervisor channel. "
"The default sigmask is :y. "
"For example,\n\n"
" (fiber/new myfun :e123)\n\n"
"blocks error signals and user signals 1, 2 and 3. The signals are "
"as follows:\n\n"
"* :a - block all signals\n"
"* :d - block debug signals\n"
"* :e - block error signals\n"
"* :t - block termination signals: error + user[0-4]\n"
"* :u - block user signals\n"
"* :y - block yield signals\n"
"* :0-9 - block a specific user signal\n\n"
"The sigmask argument also can take environment flags. If any mutually "
"exclusive flags are present, the last flag takes precedence.\n\n"
"* :i - inherit the environment from the current fiber\n"
"* :p - the environment table's prototype is the current environment table") {
janet_arity(argc, 1, 2);
JanetFunction *func = janet_getfunction(argv, 0);
JanetFiber *fiber;
@ -539,32 +568,53 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
return janet_wrap_fiber(fiber);
}
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_status,
"(fiber/status fib)",
"Get the status of a fiber. The status will be one of:\n\n"
"* :dead - the fiber has finished\n"
"* :error - the fiber has errored out\n"
"* :debug - the fiber is suspended in debug mode\n"
"* :pending - the fiber has been yielded\n"
"* :user(0-9) - the fiber is suspended by a user signal\n"
"* :alive - the fiber is currently running and cannot be resumed\n"
"* :new - the fiber has just been created and not yet run") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
uint32_t s = janet_fiber_status(fiber);
return janet_ckeywordv(janet_status_names[s]);
}
static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_current,
"(fiber/current)",
"Returns the currently running fiber.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_fiber(janet_vm.fiber);
}
static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_root,
"(fiber/root)",
"Returns the current root fiber. The root fiber is the oldest ancestor "
"that does not have a parent.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_fiber(janet_vm.root_fiber);
}
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_maxstack,
"(fiber/maxstack fib)",
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
"the fiber's stack is not allocated up front, the fiber will not allocated more "
"than this amount and will throw a stack-overflow error if more memory is needed. ") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
return janet_wrap_integer(fiber->maxstack);
}
static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_setmaxstack,
"(fiber/setmaxstack fib maxstack)",
"Sets the maximum stack size in janet values for a fiber. By default, the "
"maximum stack size is usually 8192.") {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
int32_t maxs = janet_getinteger(argv, 1);
@ -575,7 +625,9 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_can_resume,
"(fiber/can-resume? fiber)",
"Check if a fiber is finished and cannot be resumed.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
JanetFiberStatus s = janet_fiber_status(fiber);
@ -589,101 +641,28 @@ static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
return janet_wrap_boolean(!isFinished);
}
static Janet cfun_fiber_last_value(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_fiber_last_value,
"(fiber/last-value",
"Get the last value returned or signaled from the fiber.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
return fiber->last_value;
}
static const JanetReg fiber_cfuns[] = {
{
"fiber/new", cfun_fiber_new,
JDOC("(fiber/new func &opt sigmask)\n\n"
"Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber "
"when called. The mask is specified as a keyword where each character "
"is used to indicate a signal to block. If the ev module is enabled, and "
"this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
"will result in messages being sent to the supervisor channel. "
"The default sigmask is :y. "
"For example,\n\n"
" (fiber/new myfun :e123)\n\n"
"blocks error signals and user signals 1, 2 and 3. The signals are "
"as follows:\n\n"
"* :a - block all signals\n"
"* :d - block debug signals\n"
"* :e - block error signals\n"
"* :t - block termination signals: error + user[0-4]\n"
"* :u - block user signals\n"
"* :y - block yield signals\n"
"* :0-9 - block a specific user signal\n\n"
"The sigmask argument also can take environment flags. If any mutually "
"exclusive flags are present, the last flag takes precedence.\n\n"
"* :i - inherit the environment from the current fiber\n"
"* :p - the environment table's prototype is the current environment table")
},
{
"fiber/status", cfun_fiber_status,
JDOC("(fiber/status fib)\n\n"
"Get the status of a fiber. The status will be one of:\n\n"
"* :dead - the fiber has finished\n"
"* :error - the fiber has errored out\n"
"* :debug - the fiber is suspended in debug mode\n"
"* :pending - the fiber has been yielded\n"
"* :user(0-9) - the fiber is suspended by a user signal\n"
"* :alive - the fiber is currently running and cannot be resumed\n"
"* :new - the fiber has just been created and not yet run")
},
{
"fiber/root", cfun_fiber_root,
JDOC("(fiber/root)\n\n"
"Returns the current root fiber. The root fiber is the oldest ancestor "
"that does not have a parent.")
},
{
"fiber/current", cfun_fiber_current,
JDOC("(fiber/current)\n\n"
"Returns the currently running fiber.")
},
{
"fiber/maxstack", cfun_fiber_maxstack,
JDOC("(fiber/maxstack fib)\n\n"
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
"the fiber's stack is not allocated up front, the fiber will not allocated more "
"than this amount and will throw a stack-overflow error if more memory is needed. ")
},
{
"fiber/setmaxstack", cfun_fiber_setmaxstack,
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
"Sets the maximum stack size in janet values for a fiber. By default, the "
"maximum stack size is usually 8192.")
},
{
"fiber/getenv", cfun_fiber_getenv,
JDOC("(fiber/getenv fiber)\n\n"
"Gets the environment for a fiber. Returns nil if no such table is "
"set yet.")
},
{
"fiber/setenv", cfun_fiber_setenv,
JDOC("(fiber/setenv fiber table)\n\n"
"Sets the environment table for a fiber. Set to nil to remove the current "
"environment.")
},
{
"fiber/can-resume?", cfun_fiber_can_resume,
JDOC("(fiber/can-resume? fiber)\n\n"
"Check if a fiber is finished and cannot be resumed.")
},
{
"fiber/last-value", cfun_fiber_last_value,
JDOC("(fiber/last-value\n\n"
"Get the last value returned or signaled from the fiber.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_fiber(JanetTable *env) {
janet_core_cfuns(env, NULL, fiber_cfuns);
JanetRegExt fiber_cfuns[] = {
JANET_CORE_REG("fiber/new", cfun_fiber_new),
JANET_CORE_REG("fiber/status", cfun_fiber_status),
JANET_CORE_REG("fiber/root", cfun_fiber_root),
JANET_CORE_REG("fiber/current", cfun_fiber_current),
JANET_CORE_REG("fiber/maxstack", cfun_fiber_maxstack),
JANET_CORE_REG("fiber/setmaxstack", cfun_fiber_setmaxstack),
JANET_CORE_REG("fiber/getenv", cfun_fiber_getenv),
JANET_CORE_REG("fiber/setenv", cfun_fiber_setenv),
JANET_CORE_REG("fiber/can-resume?", cfun_fiber_can_resume),
JANET_CORE_REG("fiber/last-value", cfun_fiber_last_value),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, fiber_cfuns);
}

29
src/core/inttypes.c
View File

@ -193,12 +193,16 @@ Janet janet_wrap_u64(uint64_t x) {
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_it_s64_new,
"(int/s64 value)",
"Create a boxed signed 64 bit integer from a string value.") {
janet_fixarity(argc, 1);
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
}
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_it_u64_new,
"(int/u64 value)",
"Create a boxed unsigned 64 bit integer from a string value.") {
janet_fixarity(argc, 1);
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}
@ -505,23 +509,14 @@ static int it_u64_get(void *p, Janet key, Janet *out) {
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out);
}
static const JanetReg it_cfuns[] = {
{
"int/s64", cfun_it_s64_new,
JDOC("(int/s64 value)\n\n"
"Create a boxed signed 64 bit integer from a string value.")
},
{
"int/u64", cfun_it_u64_new,
JDOC("(int/u64 value)\n\n"
"Create a boxed unsigned 64 bit integer from a string value.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_inttypes(JanetTable *env) {
janet_core_cfuns(env, NULL, it_cfuns);
JanetRegExt it_cfuns[] = {
JANET_CORE_REG("int/s64", cfun_it_s64_new),
JANET_CORE_REG("int/u64", cfun_it_u64_new),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, it_cfuns);
janet_register_abstract_type(&janet_s64_type);
janet_register_abstract_type(&janet_u64_type);
}

313
src/core/io.c
View File

@ -114,7 +114,12 @@ static void *makef(FILE *f, int32_t flags) {
/* Open a process */
#ifndef JANET_NO_PROCESSES
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_popen,
"(file/popen command &opt mode) (DEPRECATED for os/spawn)",
"Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process "
"can be written to. Returns the new file.") {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode = NULL;
@ -143,7 +148,10 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
}
#endif
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_temp,
"(file/temp)",
"Open an anonymous temporary file that is removed on close. "
"Raises an error on failure.") {
(void)argv;
janet_fixarity(argc, 0);
// XXX use mkostemp when we can to avoid CLOEXEC race.
@ -153,7 +161,20 @@ static Janet cfun_io_temp(int32_t argc, Janet *argv) {
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
}
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_fopen,
"(file/open path &opt mode)",
"Open a file. `path` is an absolute or relative path, and "
"`mode` is a set of flags indicating the mode to open the file in. "
"`mode` is a keyword where each character represents a flag. If the file "
"cannot be opened, returns nil, otherwise returns the new file handle. "
"Mode flags:\n\n"
"* r - allow reading from the file\n\n"
"* w - allow writing to the file\n\n"
"* a - append to the file\n\n"
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
"* b - open the file in binary mode (rather than text mode)\n\n"
"* + - append to the file instead of overwriting it\n\n"
"* n - error if the file cannot be opened instead of returning nil") {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode;
@ -184,7 +205,16 @@ static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
}
/* Read a certain number of bytes into memory */
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_fread,
"(file/read f what &opt buf)",
"Read a number of bytes from a file `f` into a buffer. A buffer `buf` can "
"be provided as an optional third argument, otherwise a new buffer "
"is created. `what` can either be an integer or a keyword. Returns the "
"buffer with file contents. "
"Values for `what`:\n\n"
"* :all - read the whole file\n\n"
"* :line - read up to and including the next newline character\n\n"
"* n (integer) - read up to n bytes from the file") {
janet_arity(argc, 2, 3);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
@ -224,7 +254,10 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
}
/* Write bytes to a file */
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_fwrite,
"(file/write f bytes)",
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
"file.") {
janet_arity(argc, 1, -1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
@ -247,7 +280,10 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
}
/* Flush the bytes in the file */
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_fflush,
"(file/flush f)",
"Flush any buffered bytes to the file system. In most files, writes are "
"buffered for efficiency reasons. Returns the file handle.") {
janet_fixarity(argc, 1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
@ -291,7 +327,12 @@ static int cfun_io_gc(void *p, size_t len) {
}
/* Close a file */
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_fclose,
"(file/close f)",
"Close a file and release all related resources. When you are "
"done reading a file, close it to prevent a resource leak and let "
"other processes read the file. If the file is the result of a file/popen "
"call, close waits for and returns the process exit status.") {
janet_fixarity(argc, 1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
@ -318,7 +359,15 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
}
/* Seek a file */
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_fseek,
"(file/seek f &opt whence n)",
"Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
"* :cur - jump relative to the current file location\n\n"
"* :set - jump relative to the beginning of the file\n\n"
"* :end - jump relative to the end of the file\n\n"
"By default, `whence` is :cur. Optionally a value `n` may be passed "
"for the relative number of bytes to seek in the file. `n` may be a real "
"number to handle large files of more than 4GB. Returns the file handle.") {
janet_arity(argc, 2, 3);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
@ -480,28 +529,47 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
}
static Janet cfun_io_print(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_print,
"(print & xs)",
"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. Use the value of (dyn :out stdout) to determine "
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
"a buffer. Returns nil.") {
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
}
static Janet cfun_io_prin(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_prin,
"(prin & xs)",
"Same as print, but does not add trailing newline.") {
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
}
static Janet cfun_io_eprint(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_eprint,
"(eprint & xs)",
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
}
static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_eprin,
"(eprin & xs)",
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_xprint,
"(xprint to & xs)",
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
"newline character. The value to print "
"to is the first argument, and is otherwise the same as print. Returns nil.") {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_xprin,
"(xprin to & xs)",
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
"to is the first argument, and is otherwise the same as prin. Returns nil.") {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
@ -557,28 +625,40 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
}
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_printf,
"(printf fmt & xs)",
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.") {
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
}
static Janet cfun_io_prinf(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_prinf,
"(prinf fmt & xs)",
"Like printf but with no trailing newline.") {
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
}
static Janet cfun_io_eprintf(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_eprintf,
"(eprintf fmt & xs)",
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.") {
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
}
static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_eprinf,
"(eprinf fmt & xs)",
"Like eprintf but with no trailing newline.") {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_xprintf,
"(xprintf to fmt & xs)",
"Like printf but prints to an explicit file or value to. Returns nil.") {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_xprinf,
"(xprinf to fmt & xs)",
"Like prinf but prints to an explicit file or value to. Returns nil.") {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
@ -601,14 +681,18 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
}
}
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_flush,
"(flush)",
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.") {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("out", stdout);
return janet_wrap_nil();
}
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_io_eflush,
"(eflush)",
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.") {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("err", stderr);
@ -651,162 +735,6 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
return;
}
static const JanetReg io_cfuns[] = {
{
"print", cfun_io_print,
JDOC("(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. Use the value of (dyn :out stdout) to determine "
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
"a buffer. Returns nil.")
},
{
"prin", cfun_io_prin,
JDOC("(prin & xs)\n\n"
"Same as print, but does not add trailing newline.")
},
{
"printf", cfun_io_printf,
JDOC("(printf fmt & xs)\n\n"
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.")
},
{
"prinf", cfun_io_prinf,
JDOC("(prinf fmt & xs)\n\n"
"Like printf but with no trailing newline.")
},
{
"eprin", cfun_io_eprin,
JDOC("(eprin & xs)\n\n"
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).")
},
{
"eprint", cfun_io_eprint,
JDOC("(eprint & xs)\n\n"
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).")
},
{
"eprintf", cfun_io_eprintf,
JDOC("(eprintf fmt & xs)\n\n"
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.")
},
{
"eprinf", cfun_io_eprinf,
JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.")
},
{
"xprint", cfun_io_xprint,
JDOC("(xprint to & xs)\n\n"
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
"newline character. The value to print "
"to is the first argument, and is otherwise the same as print. Returns nil.")
},
{
"xprin", cfun_io_xprin,
JDOC("(xprin to & xs)\n\n"
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
"to is the first argument, and is otherwise the same as prin. Returns nil.")
},
{
"xprintf", cfun_io_xprintf,
JDOC("(xprint to fmt & xs)\n\n"
"Like printf but prints to an explicit file or value to. Returns nil.")
},
{
"xprinf", cfun_io_xprinf,
JDOC("(xprin to fmt & xs)\n\n"
"Like prinf but prints to an explicit file or value to. Returns nil.")
},
{
"flush", cfun_io_flush,
JDOC("(flush)\n\n"
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
},
{
"eflush", cfun_io_eflush,
JDOC("(eflush)\n\n"
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
},
{
"file/temp", cfun_io_temp,
JDOC("(file/temp)\n\n"
"Open an anonymous temporary file that is removed on close. "
"Raises an error on failure.")
},
{
"file/open", cfun_io_fopen,
JDOC("(file/open path &opt mode)\n\n"
"Open a file. `path` is an absolute or relative path, and "
"`mode` is a set of flags indicating the mode to open the file in. "
"`mode` is a keyword where each character represents a flag. If the file "
"cannot be opened, returns nil, otherwise returns the new file handle. "
"Mode flags:\n\n"
"* r - allow reading from the file\n\n"
"* w - allow writing to the file\n\n"
"* a - append to the file\n\n"
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
"* b - open the file in binary mode (rather than text mode)\n\n"
"* + - append to the file instead of overwriting it\n\n"
"* n - error if the file cannot be opened instead of returning nil")
},
{
"file/close", cfun_io_fclose,
JDOC("(file/close f)\n\n"
"Close a file and release all related resources. When you are "
"done reading a file, close it to prevent a resource leak and let "
"other processes read the file. If the file is the result of a file/popen "
"call, close waits for and returns the process exit status.")
},
{
"file/read", cfun_io_fread,
JDOC("(file/read f what &opt buf)\n\n"
"Read a number of bytes from a file `f` into a buffer. A buffer `buf` can "
"be provided as an optional third argument, otherwise a new buffer "
"is created. `what` can either be an integer or a keyword. Returns the "
"buffer with file contents. "
"Values for `what`:\n\n"
"* :all - read the whole file\n\n"
"* :line - read up to and including the next newline character\n\n"
"* n (integer) - read up to n bytes from the file")
},
{
"file/write", cfun_io_fwrite,
JDOC("(file/write f bytes)\n\n"
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
"file.")
},
{
"file/flush", cfun_io_fflush,
JDOC("(file/flush f)\n\n"
"Flush any buffered bytes to the file system. In most files, writes are "
"buffered for efficiency reasons. Returns the file handle.")
},
{
"file/seek", cfun_io_fseek,
JDOC("(file/seek f &opt whence n)\n\n"
"Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
"* :cur - jump relative to the current file location\n\n"
"* :set - jump relative to the beginning of the file\n\n"
"* :end - jump relative to the end of the file\n\n"
"By default, `whence` is :cur. Optionally a value `n` may be passed "
"for the relative number of bytes to seek in the file. `n` may be a real "
"number to handle large files of more than 4GB. Returns the file handle.")
},
#ifndef JANET_NO_PROCESSES
{
"file/popen", cfun_io_popen,
JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
"Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process "
"can be written to. Returns the new file.")
},
#endif
{NULL, NULL, NULL}
};
/* C API */
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
@ -839,7 +767,34 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
/* Module entry point */
void janet_lib_io(JanetTable *env) {
janet_core_cfuns(env, NULL, io_cfuns);
JanetRegExt io_cfuns[] = {
JANET_CORE_REG("print", cfun_io_print),
JANET_CORE_REG("prin", cfun_io_prin),
JANET_CORE_REG("printf", cfun_io_printf),
JANET_CORE_REG("prinf", cfun_io_prinf),
JANET_CORE_REG("eprin", cfun_io_eprin),
JANET_CORE_REG("eprint", cfun_io_eprint),
JANET_CORE_REG("eprintf", cfun_io_eprintf),
JANET_CORE_REG("eprinf", cfun_io_eprinf),
JANET_CORE_REG("xprint", cfun_io_xprint),
JANET_CORE_REG("xprin", cfun_io_xprin),
JANET_CORE_REG("xprintf", cfun_io_xprintf),
JANET_CORE_REG("xprinf", cfun_io_xprinf),
JANET_CORE_REG("flush", cfun_io_flush),
JANET_CORE_REG("eflush", cfun_io_eflush),
JANET_CORE_REG("file/temp", cfun_io_temp),
JANET_CORE_REG("file/open", cfun_io_fopen),
JANET_CORE_REG("file/close", cfun_io_fclose),
JANET_CORE_REG("file/read", cfun_io_fread),
JANET_CORE_REG("file/write", cfun_io_fwrite),
JANET_CORE_REG("file/flush", cfun_io_fflush),
JANET_CORE_REG("file/seek", cfun_io_fseek),
#ifndef JANET_NO_PROCESSES
JANET_CORE_REG("file/popen", cfun_io_popen),
#endif
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, io_cfuns);
janet_register_abstract_type(&janet_file_type);
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
/* stdout */

57
src/core/marsh.c
View File

@ -1391,13 +1391,24 @@ Janet janet_unmarshal(
/* C functions */
static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_env_lookup,
"(env-lookup env)",
"Creates a forward lookup table for unmarshalling from an environment. "
"To create a reverse lookup table, use the invert function to swap keys "
"and values in the returned table.") {
janet_fixarity(argc, 1);
JanetTable *env = janet_gettable(argv, 0);
return janet_wrap_table(janet_env_lookup(env));
}
static Janet cfun_marshal(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_marshal,
"(marshal x &opt reverse-lookup buffer)",
"Marshal a value into a buffer and return the buffer. The buffer "
"can then later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal "
"aliased values that are found in the table. Then a forward "
"lookup table can be used to recover the original value when "
"unmarshalling.") {
janet_arity(argc, 1, 3);
JanetBuffer *buffer;
JanetTable *rreg = NULL;
@ -1413,7 +1424,11 @@ static Janet cfun_marshal(int32_t argc, Janet *argv) {
return janet_wrap_buffer(buffer);
}
static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_unmarshal,
"(unmarshal buffer &opt lookup)",
"Unmarshal a value from a buffer. An optional lookup table "
"can be provided to allow for aliases to be resolved. Returns the value "
"unmarshalled from the buffer.") {
janet_arity(argc, 1, 2);
JanetByteView view = janet_getbytes(argv, 0);
JanetTable *reg = NULL;
@ -1423,35 +1438,13 @@ static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
return janet_unmarshal(view.bytes, (size_t) view.len, 0, reg, NULL);
}
static const JanetReg marsh_cfuns[] = {
{
"marshal", cfun_marshal,
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
"Marshal a value into a buffer and return the buffer. The buffer "
"can then later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal "
"aliased values that are found in the table. Then a forward "
"lookup table can be used to recover the original value when "
"unmarshalling.")
},
{
"unmarshal", cfun_unmarshal,
JDOC("(unmarshal buffer &opt lookup)\n\n"
"Unmarshal a value from a buffer. An optional lookup table "
"can be provided to allow for aliases to be resolved. Returns the value "
"unmarshalled from the buffer.")
},
{
"env-lookup", cfun_env_lookup,
JDOC("(env-lookup env)\n\n"
"Creates a forward lookup table for unmarshalling from an environment. "
"To create a reverse lookup table, use the invert function to swap keys "
"and values in the returned table.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_marsh(JanetTable *env) {
janet_core_cfuns(env, NULL, marsh_cfuns);
JanetRegExt marsh_cfuns[] = {
JANET_CORE_REG("marshal", cfun_marshal),
JANET_CORE_REG("unmarshal", cfun_unmarshal),
JANET_CORE_REG("env-lookup", cfun_env_lookup),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, marsh_cfuns);
}

186
src/core/net.c
View File

@ -311,7 +311,13 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
* C Funs
*/
static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_net_sockaddr,
"(net/address host port &opt type)",
"Look up the connection information for a given hostname, port, and connection type. Returns "
"a handle that can be used to send datagrams over network without establishing a connection. "
"On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
"given in the port argument. On Linux, abstract "
"unix domain sockets are specified with a leading '@' character in port.") {
janet_arity(argc, 2, 4);
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
@ -350,7 +356,11 @@ static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
}
}
static Janet cfun_net_connect(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_net_connect,
"(net/connect host port &opt type)",
"Open a connection to communicate with a server. Returns a duplex stream "
"that can be used to communicate with the server. Type is an optional keyword "
"to specify a connection type, either :stream or :datagram. The default is :stream. ") {
janet_arity(argc, 2, 3);
int socktype = janet_get_sockettype(argv, argc, 2);
@ -442,7 +452,14 @@ static const char *serverify_socket(JSock sfd) {
#define JANET_SHUTDOWN_W SHUT_WR
#endif
static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_net_shutdown,
"(net/shutdown stream &opt mode)",
"Stop communication on this socket in a graceful manner, either in both directions or just "
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
"* `:r` disables reading new data from the socket.\n"
"* `:w` disable writing data to the socket.\n\n"
"Returns the original socket.") {
janet_arity(argc, 1, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_SOCKET);
@ -473,7 +490,13 @@ static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_net_listen(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_net_listen,
"(net/listen host port &opt type)",
"Creates a server. Returns a new stream that is neither readable nor "
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
"The type parameter specifies the type of network connection, either "
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
":stream. The host and port arguments are the same as in net/address.") {
janet_arity(argc, 2, 3);
/* Get host, port, and handler*/
@ -547,7 +570,10 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
}
}
static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_accept_loop,
"(net/accept-loop stream handler)",
"Shorthand for running a server stream that will continuously accept new connections. "
"Blocks the current fiber until the stream is closed, and will return the stream.") {
janet_fixarity(argc, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
@ -555,7 +581,11 @@ static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
janet_sched_accept(stream, fun);
}
static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_accept,
"(net/accept stream &opt timeout)",
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns a new duplex stream which represents a connection to the client.") {
janet_arity(argc, 1, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
@ -564,7 +594,13 @@ static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
janet_sched_accept(stream, NULL);
}
static Janet cfun_stream_read(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_read,
"(net/read stream nbytes &opt buf timeout)",
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
@ -581,7 +617,10 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
janet_await();
}
static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_chunk,
"(net/chunk stream nbytes &opt buf timeout)",
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
"Takes an optional timeout in seconds, after which will return nil.") {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
@ -593,7 +632,10 @@ static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
janet_await();
}
static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_recv_from,
"(net/recv-from stream nbytes buf &opt timoeut)",
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
"packet came from. Takes an optional timeout in seconds, after which will return nil.") {
janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
@ -605,7 +647,11 @@ static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
janet_await();
}
static Janet cfun_stream_write(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_write,
"(net/write stream data &opt timeout)",
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.") {
janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
@ -621,7 +667,11 @@ static Janet cfun_stream_write(int32_t argc, Janet *argv) {
janet_await();
}
static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_send_to,
"(net/send-to stream dest data &opt timeout)",
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns stream.") {
janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
@ -638,7 +688,10 @@ static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
janet_await();
}
static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_stream_flush,
"(net/flush stream)",
"Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
"Use this to make sure data is sent without delay. Returns stream.") {
janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
@ -672,101 +725,24 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) {
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
}
static const JanetReg net_cfuns[] = {
{
"net/address", cfun_net_sockaddr,
JDOC("(net/address host port &opt type)\n\n"
"Look up the connection information for a given hostname, port, and connection type. Returns "
"a handle that can be used to send datagrams over network without establishing a connection. "
"On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
"given in the port argument. On Linux, abstract "
"unix domain sockets are specified with a leading '@' character in port.")
},
{
"net/listen", cfun_net_listen,
JDOC("(net/listen host port &opt type)\n\n"
"Creates a server. Returns a new stream that is neither readable nor "
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
"The type parameter specifies the type of network connection, either "
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
":stream. The host and port arguments are the same as in net/address.")
},
{
"net/accept", cfun_stream_accept,
JDOC("(net/accept stream &opt timeout)\n\n"
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns a new duplex stream which represents a connection to the client.")
},
{
"net/accept-loop", cfun_stream_accept_loop,
JDOC("(net/accept-loop stream handler)\n\n"
"Shorthand for running a server stream that will continuously accept new connections. "
"Blocks the current fiber until the stream is closed, and will return the stream.")
},
{
"net/read", cfun_stream_read,
JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
},
{
"net/chunk", cfun_stream_chunk,
JDOC("(net/chunk stream nbytes &opt buf timeout)\n\n"
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
"Takes an optional timeout in seconds, after which will return nil.")
},
{
"net/write", cfun_stream_write,
JDOC("(net/write stream data &opt timeout)\n\n"
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.")
},
{
"net/send-to", cfun_stream_send_to,
JDOC("(net/send-to stream dest data &opt timeout)\n\n"
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns stream.")
},
{
"net/recv-from", cfun_stream_recv_from,
JDOC("(net/recv-from stream nbytes buf &opt timoeut)\n\n"
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
"packet came from. Takes an optional timeout in seconds, after which will return nil.")
},
{
"net/flush", cfun_stream_flush,
JDOC("(net/flush stream)\n\n"
"Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
"Use this to make sure data is sent without delay. Returns stream.")
},
{
"net/connect", cfun_net_connect,
JDOC("(net/connect host port &opt type)\n\n"
"Open a connection to communicate with a server. Returns a duplex stream "
"that can be used to communicate with the server. Type is an optional keyword "
"to specify a connection type, either :stream or :datagram. The default is :stream. ")
},
{
"net/shutdown", cfun_net_shutdown,
JDOC("(net/shutdown stream &opt mode)\n\n"
"Stop communication on this socket in a graceful manner, either in both directions or just "
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
"* `:r` disables reading new data from the socket.\n"
"* `:w` disable writing data to the socket.\n\n"
"Returns the original socket.")
},
{NULL, NULL, NULL}
};
void janet_lib_net(JanetTable *env) {
janet_core_cfuns(env, NULL, net_cfuns);
JanetRegExt net_cfuns[] = {
JANET_CORE_REG("net/address", cfun_net_sockaddr),
JANET_CORE_REG("net/listen", cfun_net_listen),
JANET_CORE_REG("net/accept", cfun_stream_accept),
JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop),
JANET_CORE_REG("net/read", cfun_stream_read),
JANET_CORE_REG("net/chunk", cfun_stream_chunk),
JANET_CORE_REG("net/write", cfun_stream_write),
JANET_CORE_REG("net/send-to", cfun_stream_send_to),
JANET_CORE_REG("net/recv-from", cfun_stream_recv_from),
JANET_CORE_REG("net/flush", cfun_stream_flush),
JANET_CORE_REG("net/connect", cfun_net_connect),
JANET_CORE_REG("net/shutdown", cfun_net_shutdown),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, net_cfuns);
}
void janet_net_init(void) {

629
src/core/os.c
View File

@ -117,7 +117,18 @@ static void janet_unlock_environ(void) {
#define janet_stringify1(x) #x
#define janet_stringify(x) janet_stringify1(x)
static Janet os_which(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_which,
"(os/which)",
"Check the current operating system. Returns one of:\n\n"
"* :windows\n\n"
"* :macos\n\n"
"* :web - Web assembly (emscripten)\n\n"
"* :linux\n\n"
"* :freebsd\n\n"
"* :openbsd\n\n"
"* :netbsd\n\n"
"* :posix - A POSIX compatible system (default)\n\n"
"May also return a custom keyword specified at build time.") {
janet_fixarity(argc, 0);
(void) argv;
#if defined(JANET_OS_NAME)
@ -144,7 +155,16 @@ static Janet os_which(int32_t argc, Janet *argv) {
}
/* Detect the ISA we are compiled for */
static Janet os_arch(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_arch,
"(os/arch)",
"Check the ISA that janet was compiled for. Returns one of:\n\n"
"* :x86\n\n"
"* :x86-64\n\n"
"* :arm\n\n"
"* :aarch64\n\n"
"* :sparc\n\n"
"* :wasm\n\n"
"* :unknown\n") {
janet_fixarity(argc, 0);
(void) argv;
/* Check 64-bit vs 32-bit */
@ -172,7 +192,10 @@ static Janet os_arch(int32_t argc, Janet *argv) {
#undef janet_stringify1
#undef janet_stringify
static Janet os_exit(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_exit,
"(os/exit &opt x)",
"Exit from janet with an exit code equal to x. If x is not an integer, "
"the exit with status equal the hash of x.") {
janet_arity(argc, 0, 1);
int status;
if (argc == 0) {
@ -502,7 +525,9 @@ os_proc_wait_impl(JanetProc *proc) {
#endif
}
static Janet os_proc_wait(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_proc_wait,
"(os/proc-wait proc)",
"Block until the subprocess completes. Returns the subprocess return code.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@ -513,7 +538,11 @@ static Janet os_proc_wait(int32_t argc, Janet *argv) {
#endif
}
static Janet os_proc_kill(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_proc_kill,
"(os/proc-kill proc &opt wait)",
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If wait is truthy, will wait for the process to finsih and "
"returns the exit code. Otherwise, returns proc.") {
janet_arity(argc, 1, 2);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
if (proc->flags & JANET_PROC_WAITED) {
@ -546,7 +575,10 @@ static Janet os_proc_kill(int32_t argc, Janet *argv) {
}
}
static Janet os_proc_close(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_proc_close,
"(os/proc-close proc)",
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
"if they have not been closed. Returns nil.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@ -997,11 +1029,32 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
}
}
static Janet os_execute(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_execute,
"(os/execute args &opt flags env)",
"Execute a program on the system and pass it string arguments. `flags` "
"is a keyword that modifies how the program will execute.\n"
"* :e - enables passing an environment to the program. Without :e, the "
"current environment is inherited.\n"
"* :p - allows searching the current PATH for the binary to execute. "
"Without this flag, binaries must use absolute paths.\n"
"* :x - raise error if exit code is non-zero.\n"
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
"`env` is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
"These arguments should be core/file values. "
"One can also pass in the :pipe keyword "
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
"to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
"the same parameters as `os/execute`, but will return an object that contains references to these "
"files via (return-value :in), (return-value :out), and (return-value :err). "
"Returns the exit status of the program.") {
return os_execute_impl(argc, argv, 0);
}
static Janet os_spawn(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_spawn,
"(os/spawn args &opt flags env)",
"Execute a program on the system and return a handle to the process. Otherwise, the "
"same arguments as os/execute. Does not wait for the process.") {
return os_execute_impl(argc, argv, 1);
}
@ -1020,7 +1073,9 @@ static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
}
#endif
static Janet os_shell(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_shell,
"(os/shell str)",
"Pass a command string str directly to the system shell.") {
janet_arity(argc, 0, 1);
const char *cmd = argc
? janet_getcstring(argv, 0)
@ -1037,7 +1092,9 @@ static Janet os_shell(int32_t argc, Janet *argv) {
#endif /* JANET_NO_PROCESSES */
static Janet os_environ(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_environ,
"(os/environ)",
"Get a copy of the os environment table.") {
(void) argv;
janet_fixarity(argc, 0);
int32_t nenv = 0;
@ -1066,7 +1123,9 @@ static Janet os_environ(int32_t argc, Janet *argv) {
return janet_wrap_table(t);
}
static Janet os_getenv(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_getenv,
"(os/getenv variable &opt dflt)",
"Get the string value of an environment variable.") {
janet_arity(argc, 1, 2);
const char *cstr = janet_getcstring(argv, 0);
const char *res = getenv(cstr);
@ -1080,7 +1139,9 @@ static Janet os_getenv(int32_t argc, Janet *argv) {
return ret;
}
static Janet os_setenv(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_setenv,
"(os/setenv variable value)",
"Set an environment variable.") {
#ifdef JANET_WINDOWS
#define SETENV(K,V) _putenv_s(K, V)
#define UNSETENV(K) _putenv_s(K, "")
@ -1101,14 +1162,20 @@ static Janet os_setenv(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_time(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_time,
"(os/time)",
"Get the current time expressed as the number of seconds since "
"January 1, 1970, the Unix epoch. Returns a real number.") {
janet_fixarity(argc, 0);
(void) argv;
double dtime = (double)(time(NULL));
return janet_wrap_number(dtime);
}
static Janet os_clock(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_clock,
"(os/clock)",
"Return the number of seconds since some fixed point in time. The clock "
"is guaranteed to be non decreasing in real time.") {
janet_fixarity(argc, 0);
(void) argv;
struct timespec tv;
@ -1117,7 +1184,10 @@ static Janet os_clock(int32_t argc, Janet *argv) {
return janet_wrap_number(dtime);
}
static Janet os_sleep(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_sleep,
"(os/sleep n)",
"Suspend the program for n seconds. 'nsec' can be a real number. Returns "
"nil.") {
janet_fixarity(argc, 1);
double delay = janet_getnumber(argv, 0);
if (delay < 0) janet_panic("invalid argument to sleep");
@ -1135,7 +1205,9 @@ static Janet os_sleep(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_cwd(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_cwd,
"(os/cwd)",
"Returns the current working directory.") {
janet_fixarity(argc, 0);
(void) argv;
char buf[FILENAME_MAX];
@ -1149,7 +1221,9 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
return janet_cstringv(ptr);
}
static Janet os_cryptorand(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_cryptorand,
"(os/cryptorand n &opt buf)",
"Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.") {
JanetBuffer *buffer;
janet_arity(argc, 1, 2);
int32_t offset;
@ -1171,7 +1245,21 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
return janet_wrap_buffer(buffer);
}
static Janet os_date(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_date,
"(os/date &opt time local)",
"Returns the given time as a date struct, or the current time if `time` is not given. "
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
"the local timezone.\n\n"
"* :seconds - number of seconds [0-61]\n\n"
"* :minutes - number of minutes [0-59]\n\n"
"* :hours - number of hours [0-23]\n\n"
"* :month-day - day of month [0-30]\n\n"
"* :month - month of year [0, 11]\n\n"
"* :year - years since year 0 (e.g. 2019)\n\n"
"* :week-day - day of the week [0-6]\n\n"
"* :year-day - day of the year [0-365]\n\n"
"* :dst - if Day Light Savings is in effect") {
janet_arity(argc, 0, 2);
(void) argv;
time_t t;
@ -1269,7 +1357,14 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
return (timeint_t)janet_unwrap_number(i);
}
static Janet os_mktime(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_mktime,
"(os/mktime date-struct &opt local)",
"Get the broken down date-struct time expressed as the number "
" of seconds since January 1, 1970, the Unix epoch. "
"Returns a real number. "
"Date is given in UTC unless local is truthy, in which case the "
"date is computed for the local timezone.\n\n"
"Inverse function to os/date.") {
janet_arity(argc, 1, 2);
time_t t;
struct tm t_info;
@ -1315,7 +1410,12 @@ static Janet os_mktime(int32_t argc, Janet *argv) {
#define j_symlink symlink
#endif
static Janet os_link(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_link,
"(os/link oldpath newpath &opt symlink)",
"Create a link at newpath that points to oldpath and returns nil. "
"Iff symlink is truthy, creates a symlink. "
"Iff symlink is falsey or not provided, "
"creates a hard link. Does not work on Windows.") {
janet_arity(argc, 2, 3);
#ifdef JANET_WINDOWS
(void) argc;
@ -1331,7 +1431,9 @@ static Janet os_link(int32_t argc, Janet *argv) {
#endif
}
static Janet os_symlink(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_symlink,
"(os/symlink oldpath newpath)",
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).") {
janet_fixarity(argc, 2);
#ifdef JANET_WINDOWS
(void) argc;
@ -1349,7 +1451,11 @@ static Janet os_symlink(int32_t argc, Janet *argv) {
#undef j_symlink
static Janet os_mkdir(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_mkdir,
"(os/mkdir path)",
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
"errors otherwise.") {
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@ -1362,7 +1468,9 @@ static Janet os_mkdir(int32_t argc, Janet *argv) {
janet_panicf("%s: %s", strerror(errno), path);
}
static Janet os_rmdir(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_rmdir,
"(os/rmdir path)",
"Delete a directory. The directory must be empty to succeed.") {
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@ -1374,7 +1482,9 @@ static Janet os_rmdir(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_cd(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_cd,
"(os/cd path)",
"Change current directory to path. Returns nil on success, errors on failure.") {
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@ -1386,7 +1496,10 @@ static Janet os_cd(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_touch(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_touch,
"(os/touch path &opt actime modtime)",
"Update the access time and modification times for a file. By default, sets "
"times to the current time.") {
janet_arity(argc, 1, 3);
const char *path = janet_getcstring(argv, 0);
struct utimbuf timebuf, *bufp;
@ -1406,7 +1519,9 @@ static Janet os_touch(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_remove(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_remove,
"(os/rm path)",
"Delete a file. Returns nil.") {
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
int status = remove(path);
@ -1415,7 +1530,9 @@ static Janet os_remove(int32_t argc, Janet *argv) {
}
#ifndef JANET_NO_SYMLINKS
static Janet os_readlink(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_readlink,
"(os/readlink path)",
"Read the contents of a symbolic link. Does not work on Windows.\n") {
janet_fixarity(argc, 1);
#ifdef JANET_WINDOWS
(void) argc;
@ -1680,15 +1797,39 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
}
}
static Janet os_stat(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_stat,
"(os/stat path &opt tab|key)",
"Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
" only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
"* :dev - the device that the file is on\n\n"
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
"* :int-permissions - A Unix permission integer like 8r744\n\n"
"* :permissions - A Unix permission string like \"rwxr--r--\"\n\n"
"* :uid - File uid\n\n"
"* :gid - File gid\n\n"
"* :nlink - number of links to file\n\n"
"* :rdev - Real device of file. 0 on windows.\n\n"
"* :size - size of file in bytes\n\n"
"* :blocks - number of blocks in file. 0 on windows\n\n"
"* :blocksize - size of blocks in file. 0 on windows\n\n"
"* :accessed - timestamp when file last accessed\n\n"
"* :changed - timestamp when file last changed (permissions changed)\n\n"
"* :modified - timestamp when file last modified (content changed)\n") {
return os_stat_or_lstat(0, argc, argv);
}
static Janet os_lstat(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_lstat,
"(os/lstat path &opt tab|key)",
"Like os/stat, but don't follow symlinks.\n") {
return os_stat_or_lstat(1, argc, argv);
}
static Janet os_chmod(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_chmod,
"(os/chmod path mode)",
"Change file permissions, where mode is a permission string as returned by "
"os/perm-string, or an integer as returned by os/perm-int. "
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
janet_fixarity(argc, 2);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@ -1701,7 +1842,9 @@ static Janet os_chmod(int32_t argc, Janet *argv) {
}
#ifndef JANET_NO_UMASK
static Janet os_umask(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_umask,
"(os/umask mask)",
"Set a new umask, returns the old umask.") {
janet_fixarity(argc, 1);
int mask = (int) os_getmode(argv, 0);
#ifdef JANET_WINDOWS
@ -1713,7 +1856,10 @@ static Janet os_umask(int32_t argc, Janet *argv) {
}
#endif
static Janet os_dir(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_dir,
"(os/dir dir &opt array)",
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
"with only the file name or directory name and no prefix.") {
janet_arity(argc, 1, 2);
const char *dir = janet_getcstring(argv, 0);
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
@ -1748,7 +1894,9 @@ static Janet os_dir(int32_t argc, Janet *argv) {
return janet_wrap_array(paths);
}
static Janet os_rename(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_rename,
"(os/rename oldname newname)",
"Rename a file on disk to a new path. Returns nil.") {
janet_fixarity(argc, 2);
const char *src = janet_getcstring(argv, 0);
const char *dest = janet_getcstring(argv, 1);
@ -1759,7 +1907,10 @@ static Janet os_rename(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_realpath(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_realpath,
"(os/realpath path)",
"Get the absolute path for a given path, following ../, ./, and symlinks. "
"Returns an absolute path as a string. Will raise an error on Windows.") {
janet_fixarity(argc, 1);
const char *src = janet_getcstring(argv, 0);
#ifdef JANET_NO_REALPATH
@ -1777,12 +1928,19 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
#endif
}
static Janet os_permission_string(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_permission_string,
"(os/perm-string int)",
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
"to a human readable string, that follows the formatting "
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
"include the file/directory/symlink character as rendered by `ls`.") {
janet_fixarity(argc, 1);
return os_make_permstring(os_get_unix_mode(argv, 0));
}
static Janet os_permission_int(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_permission_int,
"(os/perm-int bytes)",
"Parse a 9 character permission string and return an integer that can be used by chmod.") {
janet_fixarity(argc, 1);
return janet_wrap_integer(os_get_unix_mode(argv, 0));
}
@ -1798,7 +1956,31 @@ static jmode_t os_optmode(int32_t argc, const Janet *argv, int32_t n, int32_t df
return janet_perm_from_unix(dflt);
}
static Janet os_open(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_open,
"(os/open path &opt flags mode)",
"Create a stream from a file, like the POSIX open system call. Returns a new stream. "
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
"The default mode is 8r666. "
"Allowed flags are as follows:\n\n"
" * :r - open this file for reading\n"
" * :w - open this file for writing\n"
" * :c - create a new file (O_CREATE)\n"
" * :e - fail if the file exists (O_EXCL)\n"
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
"Posix only flags:\n\n"
" * :a - append to a file (O_APPEND)\n"
" * :x - O_SYNC\n"
" * :C - O_NOCTTY\n\n"
"Windows only flags:\n\n"
" * :R - share reads (FILE_SHARE_READ)\n"
" * :W - share writes (FILE_SHARE_WRITE)\n"
" * :D - share deletes (FILE_SHARE_DELETE)\n"
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
" * :O - FILE_ATTRIBUTE_READONLY\n"
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
" * :b - FILE_FLAG_NO_BUFFERING\n") {
janet_arity(argc, 1, 3);
const char *path = janet_getcstring(argv, 0);
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
@ -1940,7 +2122,11 @@ static Janet os_open(int32_t argc, Janet *argv) {
return janet_wrap_abstract(janet_stream(fd, stream_flags, NULL));
}
static Janet os_pipe(int32_t argc, Janet *argv) {
JANET_CORE_FN(os_pipe,
"(os/pipe)",
"Create a readable stream and a writable stream that are connected. Returns a two element "
"tuple where the first element is a readable stream and the second element is the writable "
"stream.") {
(void) argv;
janet_fixarity(argc, 0);
JanetHandle fds[2];
@ -1955,320 +2141,6 @@ static Janet os_pipe(int32_t argc, Janet *argv) {
#endif /* JANET_REDUCED_OS */
static const JanetReg os_cfuns[] = {
{
"os/exit", os_exit,
JDOC("(os/exit &opt x)\n\n"
"Exit from janet with an exit code equal to x. If x is not an integer, "
"the exit with status equal the hash of x.")
},
{
"os/which", os_which,
JDOC("(os/which)\n\n"
"Check the current operating system. Returns one of:\n\n"
"* :windows\n\n"
"* :macos\n\n"
"* :web - Web assembly (emscripten)\n\n"
"* :linux\n\n"
"* :freebsd\n\n"
"* :openbsd\n\n"
"* :netbsd\n\n"
"* :posix - A POSIX compatible system (default)\n\n"
"May also return a custom keyword specified at build time.")
},
{
"os/arch", os_arch,
JDOC("(os/arch)\n\n"
"Check the ISA that janet was compiled for. Returns one of:\n\n"
"* :x86\n\n"
"* :x86-64\n\n"
"* :arm\n\n"
"* :aarch64\n\n"
"* :sparc\n\n"
"* :wasm\n\n"
"* :unknown\n")
},
#ifndef JANET_REDUCED_OS
{
"os/environ", os_environ,
JDOC("(os/environ)\n\n"
"Get a copy of the os environment table.")
},
{
"os/getenv", os_getenv,
JDOC("(os/getenv variable &opt dflt)\n\n"
"Get the string value of an environment variable.")
},
{
"os/dir", os_dir,
JDOC("(os/dir dir &opt array)\n\n"
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
"with only the file name or directory name and no prefix.")
},
{
"os/stat", os_stat,
JDOC("(os/stat path &opt tab|key)\n\n"
"Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
" only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
"* :dev - the device that the file is on\n\n"
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
"* :int-permissions - A Unix permission integer like 8r744\n\n"
"* :permissions - A Unix permission string like \"rwxr--r--\"\n\n"
"* :uid - File uid\n\n"
"* :gid - File gid\n\n"
"* :nlink - number of links to file\n\n"
"* :rdev - Real device of file. 0 on windows.\n\n"
"* :size - size of file in bytes\n\n"
"* :blocks - number of blocks in file. 0 on windows\n\n"
"* :blocksize - size of blocks in file. 0 on windows\n\n"
"* :accessed - timestamp when file last accessed\n\n"
"* :changed - timestamp when file last changed (permissions changed)\n\n"
"* :modified - timestamp when file last modified (content changed)\n")
},
{
"os/lstat", os_lstat,
JDOC("(os/lstat path &opt tab|key)\n\n"
"Like os/stat, but don't follow symlinks.\n")
},
{
"os/chmod", os_chmod,
JDOC("(os/chmod path mode)\n\n"
"Change file permissions, where mode is a permission string as returned by "
"os/perm-string, or an integer as returned by os/perm-int. "
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.")
},
{
"os/touch", os_touch,
JDOC("(os/touch path &opt actime modtime)\n\n"
"Update the access time and modification times for a file. By default, sets "
"times to the current time.")
},
{
"os/cd", os_cd,
JDOC("(os/cd path)\n\n"
"Change current directory to path. Returns nil on success, errors on failure.")
},
#ifndef JANET_NO_UMASK
{
"os/umask", os_umask,
JDOC("(os/umask mask)\n\n"
"Set a new umask, returns the old umask.")
},
#endif
{
"os/mkdir", os_mkdir,
JDOC("(os/mkdir path)\n\n"
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
"errors otherwise.")
},
{
"os/rmdir", os_rmdir,
JDOC("(os/rmdir path)\n\n"
"Delete a directory. The directory must be empty to succeed.")
},
{
"os/rm", os_remove,
JDOC("(os/rm path)\n\n"
"Delete a file. Returns nil.")
},
{
"os/link", os_link,
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
"Create a link at newpath that points to oldpath and returns nil. "
"Iff symlink is truthy, creates a symlink. "
"Iff symlink is falsey or not provided, "
"creates a hard link. Does not work on Windows.")
},
#ifndef JANET_NO_SYMLINKS
{
"os/symlink", os_symlink,
JDOC("(os/symlink oldpath newpath)\n\n"
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).")
},
{
"os/readlink", os_readlink,
JDOC("(os/readlink path)\n\n"
"Read the contents of a symbolic link. Does not work on Windows.\n")
},
#endif
#ifndef JANET_NO_PROCESSES
{
"os/execute", os_execute,
JDOC("(os/execute args &opt flags env)\n\n"
"Execute a program on the system and pass it string arguments. `flags` "
"is a keyword that modifies how the program will execute.\n"
"* :e - enables passing an environment to the program. Without :e, the "
"current environment is inherited.\n"
"* :p - allows searching the current PATH for the binary to execute. "
"Without this flag, binaries must use absolute paths.\n"
"* :x - raise error if exit code is non-zero.\n"
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
"`env` is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
"These arguments should be core/file values. "
"One can also pass in the :pipe keyword "
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
"to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
"the same parameters as `os/execute`, but will return an object that contains references to these "
"files via (return-value :in), (return-value :out), and (return-value :err). "
"Returns the exit status of the program.")
},
{
"os/spawn", os_spawn,
JDOC("(os/spawn args &opt flags env)\n\n"
"Execute a program on the system and return a handle to the process. Otherwise, the "
"same arguments as os/execute. Does not wait for the process.")
},
{
"os/shell", os_shell,
JDOC("(os/shell str)\n\n"
"Pass a command string str directly to the system shell.")
},
{
"os/proc-wait", os_proc_wait,
JDOC("(os/proc-wait proc)\n\n"
"Block until the subprocess completes. Returns the subprocess return code.")
},
{
"os/proc-kill", os_proc_kill,
JDOC("(os/proc-kill proc &opt wait)\n\n"
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If wait is truthy, will wait for the process to finsih and "
"returns the exit code. Otherwise, returns proc.")
},
{
"os/proc-close", os_proc_close,
JDOC("(os/proc-close proc)\n\n"
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
"if they have not been closed. Returns nil.")
},
#endif
{
"os/setenv", os_setenv,
JDOC("(os/setenv variable value)\n\n"
"Set an environment variable.")
},
{
"os/time", os_time,
JDOC("(os/time)\n\n"
"Get the current time expressed as the number of seconds since "
"January 1, 1970, the Unix epoch. Returns a real number.")
},
{
"os/mktime", os_mktime,
JDOC("(os/mktime date-struct &opt local)\n\n"
"Get the broken down date-struct time expressed as the number "
" of seconds since January 1, 1970, the Unix epoch. "
"Returns a real number. "
"Date is given in UTC unless local is truthy, in which case the "
"date is computed for the local timezone.\n\n"
"Inverse function to os/date.")
},
{
"os/clock", os_clock,
JDOC("(os/clock)\n\n"
"Return the number of seconds since some fixed point in time. The clock "
"is guaranteed to be non decreasing in real time.")
},
{
"os/sleep", os_sleep,
JDOC("(os/sleep n)\n\n"
"Suspend the program for n seconds. 'nsec' can be a real number. Returns "
"nil.")
},
{
"os/cwd", os_cwd,
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"
"Returns the given time as a date struct, or the current time if `time` is not given. "
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
"the local timezone.\n\n"
"* :seconds - number of seconds [0-61]\n\n"
"* :minutes - number of minutes [0-59]\n\n"
"* :hours - number of hours [0-23]\n\n"
"* :month-day - day of month [0-30]\n\n"
"* :month - month of year [0, 11]\n\n"
"* :year - years since year 0 (e.g. 2019)\n\n"
"* :week-day - day of the week [0-6]\n\n"
"* :year-day - day of the year [0-365]\n\n"
"* :dst - if Day Light Savings is in effect")
},
{
"os/rename", os_rename,
JDOC("(os/rename oldname newname)\n\n"
"Rename a file on disk to a new path. Returns nil.")
},
{
"os/realpath", os_realpath,
JDOC("(os/realpath path)\n\n"
"Get the absolute path for a given path, following ../, ./, and symlinks. "
"Returns an absolute path as a string. Will raise an error on Windows.")
},
{
"os/perm-string", os_permission_string,
JDOC("(os/perm-string int)\n\n"
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
"to a human readable string, that follows the formatting "
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
"include the file/directory/symlink character as rendered by `ls`.")
},
{
"os/perm-int", os_permission_int,
JDOC("(os/perm-int bytes)\n\n"
"Parse a 9 character permission string and return an integer that can be used by chmod.")
},
#ifdef JANET_EV
{
"os/open", os_open,
JDOC("(os/open path &opt flags mode)\n\n"
"Create a stream from a file, like the POSIX open system call. Returns a new stream. "
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
"The default mode is 8r666. "
"Allowed flags are as follows:\n\n"
" * :r - open this file for reading\n"
" * :w - open this file for writing\n"
" * :c - create a new file (O_CREATE)\n"
" * :e - fail if the file exists (O_EXCL)\n"
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
"Posix only flags:\n\n"
" * :a - append to a file (O_APPEND)\n"
" * :x - O_SYNC\n"
" * :C - O_NOCTTY\n\n"
"Windows only flags:\n\n"
" * :R - share reads (FILE_SHARE_READ)\n"
" * :W - share writes (FILE_SHARE_WRITE)\n"
" * :D - share deletes (FILE_SHARE_DELETE)\n"
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
" * :O - FILE_ATTRIBUTE_READONLY\n"
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
" * :b - FILE_FLAG_NO_BUFFERING\n")
},
{
"os/pipe", os_pipe,
JDOC("(os/pipe)\n\n"
"Create a readable stream and a writable stream that are connected. Returns a two element "
"tuple where the first element is a readable stream and the second element is the writable "
"stream.")
},
#endif
#endif
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_os(JanetTable *env) {
#if !defined(JANET_REDUCED_OS) && defined(JANET_WINDOWS) && defined(JANET_THREADS)
@ -2281,5 +2153,56 @@ void janet_lib_os(JanetTable *env) {
#endif
#ifndef JANET_NO_PROCESSES
#endif
janet_core_cfuns(env, NULL, os_cfuns);
JanetRegExt os_cfuns[] = {
JANET_CORE_REG("os/exit", os_exit),
JANET_CORE_REG("os/which", os_which),
JANET_CORE_REG("os/arch", os_arch),
#ifndef JANET_REDUCED_OS
JANET_CORE_REG("os/environ", os_environ),
JANET_CORE_REG("os/getenv", os_getenv),
JANET_CORE_REG("os/dir", os_dir),
JANET_CORE_REG("os/stat", os_stat),
JANET_CORE_REG("os/lstat", os_lstat),
JANET_CORE_REG("os/chmod", os_chmod),
JANET_CORE_REG("os/touch", os_touch),
JANET_CORE_REG("os/cd", os_cd),
#ifndef JANET_NO_UMASK
JANET_CORE_REG("os/umask", os_umask),
#endif
JANET_CORE_REG("os/mkdir", os_mkdir),
JANET_CORE_REG("os/rmdir", os_rmdir),
JANET_CORE_REG("os/rm", os_remove),
JANET_CORE_REG("os/link", os_link),
#ifndef JANET_NO_SYMLINKS
JANET_CORE_REG("os/symlink", os_symlink),
JANET_CORE_REG("os/readlink", os_readlink),
#endif
#ifndef JANET_NO_PROCESSES
JANET_CORE_REG("os/execute", os_execute),
JANET_CORE_REG("os/spawn", os_spawn),
JANET_CORE_REG("os/shell", os_shell),
JANET_CORE_REG("os/proc-wait", os_proc_wait),
JANET_CORE_REG("os/proc-kill", os_proc_kill),
JANET_CORE_REG("os/proc-close", os_proc_close),
#endif
JANET_CORE_REG("os/setenv", os_setenv),
JANET_CORE_REG("os/time", os_time),
JANET_CORE_REG("os/mktime", os_mktime),
JANET_CORE_REG("os/clock", os_clock),
JANET_CORE_REG("os/sleep", os_sleep),
JANET_CORE_REG("os/cwd", os_cwd),
JANET_CORE_REG("os/cryptorand", os_cryptorand),
JANET_CORE_REG("os/date", os_date),
JANET_CORE_REG("os/rename", os_rename),
JANET_CORE_REG("os/realpath", os_realpath),
JANET_CORE_REG("os/perm-string", os_permission_string),
JANET_CORE_REG("os/perm-int", os_permission_int),
#ifdef JANET_EV
JANET_CORE_REG("os/open", os_open),
JANET_CORE_REG("os/pipe", os_pipe),
#endif
#endif
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, os_cfuns);
}

197
src/core/parse.c
View File

@ -878,7 +878,10 @@ const JanetAbstractType janet_parser_type = {
};
/* C Function parser */
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_parser,
"(parser/new)",
"Creates and returns a new parser object. Parsers are state machines "
"that can receive bytes, and generate a stream of values.") {
(void) argv;
janet_fixarity(argc, 0);
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
@ -886,7 +889,11 @@ static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
return janet_wrap_abstract(p);
}
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_consume,
"(parser/consume parser bytes &opt index)",
"Input bytes into the parser and parse them. Will not throw errors "
"if there is a parse error. Starts at the byte index given by index. Returns "
"the number of bytes read.") {
janet_arity(argc, 2, 3);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
JanetByteView view = janet_getbytes(argv, 1);
@ -911,14 +918,20 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
return janet_wrap_integer(i);
}
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_eof,
"(parser/eof parser)",
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.") {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
janet_parser_eof(p);
return argv[0];
}
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_insert,
"(parser/insert parser value)",
"Insert a value into the parser. This means that the parser state can be manipulated "
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
"and tuples, for example. Returns the parser.") {
janet_fixarity(argc, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
JanetParseState *s = p->states + p->statecount - 1;
@ -957,13 +970,17 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_has_more,
"(parser/has-more parser)",
"Check if the parser has more values in the value queue.") {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
return janet_wrap_boolean(janet_parser_has_more(p));
}
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_byte,
"(parser/byte parser b)",
"Input a single byte into the parser byte stream. Returns the parser.") {
janet_fixarity(argc, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
int32_t i = janet_getinteger(argv, 1);
@ -971,7 +988,13 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_status,
"(parser/status parser)",
"Gets the current status of the parser state machine. The status will "
"be one of:\n\n"
"* :pending - a value is being parsed.\n\n"
"* :error - a parsing error was encountered.\n\n"
"* :root - the parser can either read more values or safely terminate.") {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *stat = NULL;
@ -992,7 +1015,12 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
return janet_ckeywordv(stat);
}
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_error,
"(parser/error parser)",
"If the parser is in the error state, returns the message associated with "
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
"queue, so be sure to handle everything in the queue before calling "
"parser/error.") {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *err = janet_parser_error(p);
@ -1004,7 +1032,13 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_produce,
"(parser/produce parser &opt wrap)",
"Dequeue the next value in the parse queue. Will return nil if "
"no parsed values are in the queue, otherwise will dequeue the "
"next value. If `wrap` is truthy, will return a 1-element tuple that "
"wraps the result. This tuple can be used for source-mapping "
"purposes.") {
janet_arity(argc, 1, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
if (argc == 2 && janet_truthy(argv[1])) {
@ -1014,14 +1048,22 @@ static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
}
}
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_flush,
"(parser/flush parser)",
"Clears the parser state and parse queue. Can be used to reset the parser "
"if an error was encountered. Does not reset the line and column counter, so "
"to begin parsing in a new context, create a new parser.") {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
janet_parser_flush(p);
return argv[0];
}
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_where,
"(parser/where parser &opt line col)",
"Returns the current line number and column of the parser's internal state. If line is "
"provided, the current line number of the parser is first set to that value. If column is "
"also provided, the current column number of the parser is also first set to that value.") {
janet_arity(argc, 1, 3);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
if (argc > 1) {
@ -1162,7 +1204,16 @@ static const struct ParserStateGetter parser_state_getters[] = {
{NULL, NULL}
};
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_state,
"(parser/state parser &opt key)",
"Returns a representation of the internal state of the parser. If a key is passed, "
"only that information about the state is returned. Allowed keys are:\n\n"
"* :delimiters - Each byte in the string represents a nested data structure. For example, "
"if the parser state is '([\"', then the parser is in the middle of parsing a "
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n"
"* :frames - Each table in the array represents a 'frame' in the parser state. Frames "
"contain information about the start of the expression being parsed as well as the "
"type of that expression and some type-specific information.") {
janet_arity(argc, 1, 2);
const uint8_t *key = NULL;
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
@ -1190,7 +1241,11 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
}
}
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_parse_clone,
"(parser/clone p)",
"Creates a deep clone of a parser that is identical to the input parser. "
"This cloned parser can be used to continue parsing from a good checkpoint "
"if parsing later fails. Returns a new parser.") {
janet_fixarity(argc, 1);
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
@ -1225,105 +1280,23 @@ static Janet parsernext(void *p, Janet key) {
return janet_nextmethod(parser_methods, key);
}
static const JanetReg parse_cfuns[] = {
{
"parser/new", cfun_parse_parser,
JDOC("(parser/new)\n\n"
"Creates and returns a new parser object. Parsers are state machines "
"that can receive bytes, and generate a stream of values.")
},
{
"parser/clone", cfun_parse_clone,
JDOC("(parser/clone p)\n\n"
"Creates a deep clone of a parser that is identical to the input parser. "
"This cloned parser can be used to continue parsing from a good checkpoint "
"if parsing later fails. Returns a new parser.")
},
{
"parser/has-more", cfun_parse_has_more,
JDOC("(parser/has-more parser)\n\n"
"Check if the parser has more values in the value queue.")
},
{
"parser/produce", cfun_parse_produce,
JDOC("(parser/produce parser &opt wrap)\n\n"
"Dequeue the next value in the parse queue. Will return nil if "
"no parsed values are in the queue, otherwise will dequeue the "
"next value. If `wrap` is truthy, will return a 1-element tuple that "
"wraps the result. This tuple can be used for source-mapping "
"purposes.")
},
{
"parser/consume", cfun_parse_consume,
JDOC("(parser/consume parser bytes &opt index)\n\n"
"Input bytes into the parser and parse them. Will not throw errors "
"if there is a parse error. Starts at the byte index given by index. Returns "
"the number of bytes read.")
},
{
"parser/byte", cfun_parse_byte,
JDOC("(parser/byte parser b)\n\n"
"Input a single byte into the parser byte stream. Returns the parser.")
},
{
"parser/error", cfun_parse_error,
JDOC("(parser/error parser)\n\n"
"If the parser is in the error state, returns the message associated with "
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
"queue, so be sure to handle everything in the queue before calling "
"parser/error.")
},
{
"parser/status", cfun_parse_status,
JDOC("(parser/status parser)\n\n"
"Gets the current status of the parser state machine. The status will "
"be one of:\n\n"
"* :pending - a value is being parsed.\n\n"
"* :error - a parsing error was encountered.\n\n"
"* :root - the parser can either read more values or safely terminate.")
},
{
"parser/flush", cfun_parse_flush,
JDOC("(parser/flush parser)\n\n"
"Clears the parser state and parse queue. Can be used to reset the parser "
"if an error was encountered. Does not reset the line and column counter, so "
"to begin parsing in a new context, create a new parser.")
},
{
"parser/state", cfun_parse_state,
JDOC("(parser/state parser &opt key)\n\n"
"Returns a representation of the internal state of the parser. If a key is passed, "
"only that information about the state is returned. Allowed keys are:\n\n"
"* :delimiters - Each byte in the string represents a nested data structure. For example, "
"if the parser state is '([\"', then the parser is in the middle of parsing a "
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n"
"* :frames - Each table in the array represents a 'frame' in the parser state. Frames "
"contain information about the start of the expression being parsed as well as the "
"type of that expression and some type-specific information.")
},
{
"parser/where", cfun_parse_where,
JDOC("(parser/where parser &opt line col)\n\n"
"Returns the current line number and column of the parser's internal state. If line is "
"provided, the current line number of the parser is first set to that value. If column is "
"also provided, the current column number of the parser is also first set to that value.")
},
{
"parser/eof", cfun_parse_eof,
JDOC("(parser/eof parser)\n\n"
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
},
{
"parser/insert", cfun_parse_insert,
JDOC("(parser/insert parser value)\n\n"
"Insert a value into the parser. This means that the parser state can be manipulated "
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
"and tuples, for example. Returns the parser.")
},
{NULL, NULL, NULL}
};
/* Load the library */
void janet_lib_parse(JanetTable *env) {
janet_core_cfuns(env, NULL, parse_cfuns);
JanetRegExt parse_cfuns[] = {
JANET_CORE_REG("parser/new", cfun_parse_parser),
JANET_CORE_REG("parser/clone", cfun_parse_clone),
JANET_CORE_REG("parser/has-more", cfun_parse_has_more),
JANET_CORE_REG("parser/produce", cfun_parse_produce),
JANET_CORE_REG("parser/consume", cfun_parse_consume),
JANET_CORE_REG("parser/byte", cfun_parse_byte),
JANET_CORE_REG("parser/error", cfun_parse_error),
JANET_CORE_REG("parser/status", cfun_parse_status),
JANET_CORE_REG("parser/flush", cfun_parse_flush),
JANET_CORE_REG("parser/state", cfun_parse_state),
JANET_CORE_REG("parser/where", cfun_parse_where),
JANET_CORE_REG("parser/eof", cfun_parse_eof),
JANET_CORE_REG("parser/insert", cfun_parse_insert),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, parse_cfuns);
}

285
src/core/string.c
View File

@ -170,25 +170,37 @@ static int32_t kmp_next(struct kmp_state *state) {
/* CFuns */
static Janet cfun_string_slice(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_slice,
"(string/slice bytes &opt start end)",
"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. Note that index -1 is synonymous with "
"index (length bytes) to allow a full negative slice range. ") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_stringv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_symbol_slice,
"(symbol/slice bytes &opt start end)",
"Same a string/slice, but returns a symbol.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_symbolv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_keyword_slice,
"(keyword/slice bytes &opt start end)",
"Same a string/slice, but returns a keyword.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_keywordv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_repeat,
"(string/repeat bytes n)",
"Returns a string that is n copies of bytes concatenated.") {
janet_fixarity(argc, 2);
JanetByteView view = janet_getbytes(argv, 0);
int32_t rep = janet_getinteger(argv, 1);
@ -204,7 +216,9 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
return janet_wrap_string(janet_string_end(newbuf));
}
static Janet cfun_string_bytes(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_bytes,
"(string/bytes str)",
"Returns an array of integers that are the byte values of the string.") {
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 0);
Janet *tup = janet_tuple_begin(view.len);
@ -215,7 +229,10 @@ static Janet cfun_string_bytes(int32_t argc, Janet *argv) {
return janet_wrap_tuple(janet_tuple_end(tup));
}
static Janet cfun_string_frombytes(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_frombytes,
"(string/from-bytes & byte-vals)",
"Creates a string from integer parameters with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.") {
int32_t i;
uint8_t *buf = janet_string_begin(argc);
for (i = 0; i < argc; i++) {
@ -225,7 +242,11 @@ static Janet cfun_string_frombytes(int32_t argc, Janet *argv) {
return janet_wrap_string(janet_string_end(buf));
}
static Janet cfun_string_asciilower(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_asciilower,
"(string/ascii-lower str)",
"Returns a new string where all bytes are replaced with the "
"lowercase version of themselves in ASCII. Does only a very simple "
"case check, meaning no unicode support.") {
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 0);
uint8_t *buf = janet_string_begin(view.len);
@ -240,7 +261,11 @@ static Janet cfun_string_asciilower(int32_t argc, Janet *argv) {
return janet_wrap_string(janet_string_end(buf));
}
static Janet cfun_string_asciiupper(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_asciiupper,
"(string/ascii-upper str)",
"Returns a new string where all bytes are replaced with the "
"uppercase version of themselves in ASCII. Does only a very simple "
"case check, meaning no unicode support.") {
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 0);
uint8_t *buf = janet_string_begin(view.len);
@ -255,7 +280,9 @@ static Janet cfun_string_asciiupper(int32_t argc, Janet *argv) {
return janet_wrap_string(janet_string_end(buf));
}
static Janet cfun_string_reverse(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_reverse,
"(string/reverse str)",
"Returns a string that is the reversed version of str.") {
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 0);
uint8_t *buf = janet_string_begin(view.len);
@ -279,7 +306,11 @@ static void findsetup(int32_t argc, Janet *argv, struct kmp_state *s, int32_t ex
s->i = start;
}
static Janet cfun_string_find(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_find,
"(string/find patt str &opt start-index)",
"Searches for the first instance of pattern patt in string "
"str. Returns the index of the first character in patt if found, "
"otherwise returns nil.") {
int32_t result;
struct kmp_state state;
findsetup(argc, argv, &state, 0);
@ -290,7 +321,9 @@ static Janet cfun_string_find(int32_t argc, Janet *argv) {
: janet_wrap_integer(result);
}
static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_hasprefix,
"(string/has-prefix? pfx str)",
"Tests whether str starts with pfx.") {
janet_fixarity(argc, 2);
JanetByteView prefix = janet_getbytes(argv, 0);
JanetByteView str = janet_getbytes(argv, 1);
@ -299,7 +332,9 @@ static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
: janet_wrap_boolean(memcmp(prefix.bytes, str.bytes, prefix.len) == 0);
}
static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_hassuffix,
"(string/has-suffix? sfx str)",
"Tests whether str ends with sfx.") {
janet_fixarity(argc, 2);
JanetByteView suffix = janet_getbytes(argv, 0);
JanetByteView str = janet_getbytes(argv, 1);
@ -310,7 +345,12 @@ static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
suffix.len) == 0);
}
static Janet cfun_string_findall(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_findall,
"(string/find-all patt str &opt start-index)",
"Searches for all instances of pattern patt in string "
"str. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are counted individually, meaning a byte in str "
"may contribute to multiple found patterns.") {
int32_t result;
struct kmp_state state;
findsetup(argc, argv, &state, 0);
@ -344,7 +384,10 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
s->substlen = subst.len;
}
static Janet cfun_string_replace(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_replace,
"(string/replace patt subst str)",
"Replace the first occurrence of patt with subst in the string str. "
"Will return the new string if patt is found, otherwise returns str.") {
int32_t result;
struct replace_state s;
uint8_t *buf;
@ -364,7 +407,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
return janet_wrap_string(janet_string_end(buf));
}
static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_replaceall,
"(string/replace-all patt subst str)",
"Replace all instances of patt with subst in the string str. Overlapping "
"matches will not be counted, only the first match in such a span will be replaced. "
"Will return the new string if patt is found, otherwise returns str.") {
int32_t result;
struct replace_state s;
JanetBuffer b;
@ -384,7 +431,13 @@ static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
return janet_wrap_string(ret);
}
static Janet cfun_string_split(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_split,
"(string/split delim str &opt start limit)",
"Splits a string str with delimiter delim and returns an array of "
"substrings. The substrings will not contain the delimiter delim. If delim "
"is not found, the returned array will have one element. Will start searching "
"for delim at the index start (if provided), and return up to a maximum "
"of limit results (if provided).") {
int32_t result;
JanetArray *array;
struct kmp_state state;
@ -406,7 +459,11 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
return janet_wrap_array(array);
}
static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_checkset,
"(string/check-set set str)",
"Checks that the string str only contains bytes that appear in the string set. "
"Returns true if all bytes in str appear in set, false if some bytes in str do "
"not appear in set.") {
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
janet_fixarity(argc, 2);
JanetByteView set = janet_getbytes(argv, 0);
@ -428,7 +485,10 @@ static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
return janet_wrap_true();
}
static Janet cfun_string_join(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_join,
"(string/join parts &opt sep)",
"Joins an array of strings into one string, optionally separated by "
"a separator string sep.") {
janet_arity(argc, 1, 2);
JanetView parts = janet_getindexed(argv, 0);
JanetByteView joiner;
@ -468,7 +528,10 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
return janet_wrap_string(janet_string_end(buf));
}
static Janet cfun_string_format(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_format,
"(string/format format & values)",
"Similar to snprintf, but specialized for operating with Janet values. Returns "
"a new string.") {
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_buffer(0);
const char *strfrmt = (const char *) janet_getstring(argv, 0);
@ -508,7 +571,10 @@ static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetB
}
}
static Janet cfun_string_trim(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_trim,
"(string/trim str &opt set)",
"Trim leading and trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.") {
JanetByteView str, set;
trim_help_args(argc, argv, &str, &set);
int32_t left_edge = trim_help_leftedge(str, set);
@ -518,163 +584,52 @@ static Janet cfun_string_trim(int32_t argc, Janet *argv) {
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
}
static Janet cfun_string_triml(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_triml,
"(string/triml str &opt set)",
"Trim leading whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.") {
JanetByteView str, set;
trim_help_args(argc, argv, &str, &set);
int32_t left_edge = trim_help_leftedge(str, set);
return janet_stringv(str.bytes + left_edge, str.len - left_edge);
}
static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_string_trimr,
"(string/trimr str &opt set)",
"Trim trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.") {
JanetByteView str, set;
trim_help_args(argc, argv, &str, &set);
int32_t right_edge = trim_help_rightedge(str, set);
return janet_stringv(str.bytes, right_edge);
}
static const JanetReg string_cfuns[] = {
{
"string/slice", cfun_string_slice,
JDOC("(string/slice bytes &opt start end)\n\n"
"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. Note that index -1 is synonymous with "
"index (length bytes) to allow a full negative slice range. ")
},
{
"keyword/slice", cfun_keyword_slice,
JDOC("(keyword/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a keyword.")
},
{
"symbol/slice", cfun_symbol_slice,
JDOC("(symbol/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a symbol.")
},
{
"string/repeat", cfun_string_repeat,
JDOC("(string/repeat bytes n)\n\n"
"Returns a string that is n copies of bytes concatenated.")
},
{
"string/bytes", cfun_string_bytes,
JDOC("(string/bytes str)\n\n"
"Returns an array of integers that are the byte values of the string.")
},
{
"string/from-bytes", cfun_string_frombytes,
JDOC("(string/from-bytes & byte-vals)\n\n"
"Creates a string from integer parameters with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.")
},
{
"string/ascii-lower", cfun_string_asciilower,
JDOC("(string/ascii-lower str)\n\n"
"Returns a new string where all bytes are replaced with the "
"lowercase version of themselves in ASCII. Does only a very simple "
"case check, meaning no unicode support.")
},
{
"string/ascii-upper", cfun_string_asciiupper,
JDOC("(string/ascii-upper str)\n\n"
"Returns a new string where all bytes are replaced with the "
"uppercase version of themselves in ASCII. Does only a very simple "
"case check, meaning no unicode support.")
},
{
"string/reverse", cfun_string_reverse,
JDOC("(string/reverse str)\n\n"
"Returns a string that is the reversed version of str.")
},
{
"string/find", cfun_string_find,
JDOC("(string/find patt str &opt start-index)\n\n"
"Searches for the first instance of pattern patt in string "
"str. Returns the index of the first character in patt if found, "
"otherwise returns nil.")
},
{
"string/find-all", cfun_string_findall,
JDOC("(string/find-all patt str &opt start-index)\n\n"
"Searches for all instances of pattern patt in string "
"str. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are counted individually, meaning a byte in str "
"may contribute to multiple found patterns.")
},
{
"string/has-prefix?", cfun_string_hasprefix,
JDOC("(string/has-prefix? pfx str)\n\n"
"Tests whether str starts with pfx.")
},
{
"string/has-suffix?", cfun_string_hassuffix,
JDOC("(string/has-suffix? sfx str)\n\n"
"Tests whether str ends with sfx.")
},
{
"string/replace", cfun_string_replace,
JDOC("(string/replace patt subst str)\n\n"
"Replace the first occurrence of patt with subst in the string str. "
"Will return the new string if patt is found, otherwise returns str.")
},
{
"string/replace-all", cfun_string_replaceall,
JDOC("(string/replace-all patt subst str)\n\n"
"Replace all instances of patt with subst in the string str. Overlapping "
"matches will not be counted, only the first match in such a span will be replaced. "
"Will return the new string if patt is found, otherwise returns str.")
},
{
"string/split", cfun_string_split,
JDOC("(string/split delim str &opt start limit)\n\n"
"Splits a string str with delimiter delim and returns an array of "
"substrings. The substrings will not contain the delimiter delim. If delim "
"is not found, the returned array will have one element. Will start searching "
"for delim at the index start (if provided), and return up to a maximum "
"of limit results (if provided).")
},
{
"string/check-set", cfun_string_checkset,
JDOC("(string/check-set set str)\n\n"
"Checks that the string str only contains bytes that appear in the string set. "
"Returns true if all bytes in str appear in set, false if some bytes in str do "
"not appear in set.")
},
{
"string/join", cfun_string_join,
JDOC("(string/join parts &opt sep)\n\n"
"Joins an array of strings into one string, optionally separated by "
"a separator string sep.")
},
{
"string/format", cfun_string_format,
JDOC("(string/format format & values)\n\n"
"Similar to snprintf, but specialized for operating with Janet values. Returns "
"a new string.")
},
{
"string/trim", cfun_string_trim,
JDOC("(string/trim str &opt set)\n\n"
"Trim leading and trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.")
},
{
"string/triml", cfun_string_triml,
JDOC("(string/triml str &opt set)\n\n"
"Trim leading whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.")
},
{
"string/trimr", cfun_string_trimr,
JDOC("(string/trimr str &opt set)\n\n"
"Trim trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_string(JanetTable *env) {
janet_core_cfuns(env, NULL, string_cfuns);
JanetRegExt string_cfuns[] = {
JANET_CORE_REG("string/slice", cfun_string_slice),
JANET_CORE_REG("keyword/slice", cfun_keyword_slice),
JANET_CORE_REG("symbol/slice", cfun_symbol_slice),
JANET_CORE_REG("string/repeat", cfun_string_repeat),
JANET_CORE_REG("string/bytes", cfun_string_bytes),
JANET_CORE_REG("string/from-bytes", cfun_string_frombytes),
JANET_CORE_REG("string/ascii-lower", cfun_string_asciilower),
JANET_CORE_REG("string/ascii-upper", cfun_string_asciiupper),
JANET_CORE_REG("string/reverse", cfun_string_reverse),
JANET_CORE_REG("string/find", cfun_string_find),
JANET_CORE_REG("string/find-all", cfun_string_findall),
JANET_CORE_REG("string/has-prefix?", cfun_string_hasprefix),
JANET_CORE_REG("string/has-suffix?", cfun_string_hassuffix),
JANET_CORE_REG("string/replace", cfun_string_replace),
JANET_CORE_REG("string/replace-all", cfun_string_replaceall),
JANET_CORE_REG("string/split", cfun_string_split),
JANET_CORE_REG("string/check-set", cfun_string_checkset),
JANET_CORE_REG("string/join", cfun_string_join),
JANET_CORE_REG("string/format", cfun_string_format),
JANET_CORE_REG("string/trim", cfun_string_trim),
JANET_CORE_REG("string/triml", cfun_string_triml),
JANET_CORE_REG("string/trimr", cfun_string_trimr),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, string_cfuns);
}

95
src/core/table.c
View File

@ -268,13 +268,21 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
/* C Functions */
static Janet cfun_table_new(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_table_new,
"(table/new capacity)",
"Creates a new empty table with pre-allocated memory "
"for capacity entries. This means that if one knows the number of "
"entries going to go in a table on creation, extra memory allocation "
"can be avoided. Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getinteger(argv, 0);
return janet_wrap_table(janet_table(cap));
}
static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_table_getproto,
"(table/getproto tab)",
"Get the prototype table of a table. Returns nil if a table "
"has no prototype, otherwise returns the prototype.") {
janet_fixarity(argc, 1);
JanetTable *t = janet_gettable(argv, 0);
return t->proto
@ -282,7 +290,9 @@ static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
: janet_wrap_nil();
}
static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_table_setproto,
"(table/setproto tab proto)",
"Set the prototype of a table. Returns the original table tab.") {
janet_fixarity(argc, 2);
JanetTable *table = janet_gettable(argv, 0);
JanetTable *proto = NULL;
@ -293,79 +303,54 @@ static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_table_tostruct(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_table_tostruct,
"(table/to-struct tab)",
"Convert a table to a struct. Returns a new struct. This function "
"does not take into account prototype tables.") {
janet_fixarity(argc, 1);
JanetTable *t = janet_gettable(argv, 0);
return janet_wrap_struct(janet_table_to_struct(t));
}
static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_table_rawget,
"(table/rawget tab key)",
"Gets a value from a table without looking at the prototype table. "
"If a table tab does not contain t directly, the function will return "
"nil without checking the prototype. Returns the value in the table.") {
janet_fixarity(argc, 2);
JanetTable *table = janet_gettable(argv, 0);
return janet_table_rawget(table, argv[1]);
}
static Janet cfun_table_clone(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_table_clone,
"(table/clone tab)",
"Create a copy of a table. Updates to the new table will not change the old table, "
"and vice versa.") {
janet_fixarity(argc, 1);
JanetTable *table = janet_gettable(argv, 0);
return janet_wrap_table(janet_table_clone(table));
}
static Janet cfun_table_clear(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_table_clear,
"(table/clear tab)",
"Remove all key-value pairs in a table and return the modified table `tab`.") {
janet_fixarity(argc, 1);
JanetTable *table = janet_gettable(argv, 0);
janet_table_clear(table);
return janet_wrap_table(table);
}
static const JanetReg table_cfuns[] = {
{
"table/new", cfun_table_new,
JDOC("(table/new capacity)\n\n"
"Creates a new empty table with pre-allocated memory "
"for capacity entries. This means that if one knows the number of "
"entries going to go in a table on creation, extra memory allocation "
"can be avoided. Returns the new table.")
},
{
"table/to-struct", cfun_table_tostruct,
JDOC("(table/to-struct tab)\n\n"
"Convert a table to a struct. Returns a new struct. This function "
"does not take into account prototype tables.")
},
{
"table/getproto", cfun_table_getproto,
JDOC("(table/getproto tab)\n\n"
"Get the prototype table of a table. Returns nil if a table "
"has no prototype, otherwise returns the prototype.")
},
{
"table/setproto", cfun_table_setproto,
JDOC("(table/setproto tab proto)\n\n"
"Set the prototype of a table. Returns the original table tab.")
},
{
"table/rawget", cfun_table_rawget,
JDOC("(table/rawget tab key)\n\n"
"Gets a value from a table without looking at the prototype table. "
"If a table tab does not contain t directly, the function will return "
"nil without checking the prototype. Returns the value in the table.")
},
{
"table/clone", cfun_table_clone,
JDOC("(table/clone tab)\n\n"
"Create a copy of a table. Updates to the new table will not change the old table, "
"and vice versa.")
},
{
"table/clear", cfun_table_clear,
JDOC("(table/clear tab)\n\n"
"Remove all key-value pairs in a table and return the modified table `tab`.")
},
{NULL, NULL, NULL}
};
/* Load the table module */
void janet_lib_table(JanetTable *env) {
janet_core_cfuns(env, NULL, table_cfuns);
JanetRegExt table_cfuns[] = {
JANET_CORE_REG("table/new", cfun_table_new),
JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
JANET_CORE_REG("table/getproto", cfun_table_getproto),
JANET_CORE_REG("table/setproto", cfun_table_setproto),
JANET_CORE_REG("table/rawget", cfun_table_rawget),
JANET_CORE_REG("table/clone", cfun_table_clone),
JANET_CORE_REG("table/clear", cfun_table_clear),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, table_cfuns);
}

97
src/core/thread.c
View File

@ -596,13 +596,24 @@ JanetThread *janet_thread_current(void) {
* Cfuns
*/
static Janet cfun_thread_current(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_thread_current,
"(thread/current)",
"Get the current running thread.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_abstract(janet_thread_current());
}
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_thread_new,
"(thread/new func &opt capacity flags)",
"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\n"
"* :h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n\n"
"* :a - Allow sending over registered abstract types to the new thread\n\n"
"* :c - Send over cfunction information to the new thread.\n\n"
"Returns a handle to the new thread.") {
janet_arity(argc, 1, 3);
/* Just type checking */
janet_getfunction(argv, 0);
@ -645,7 +656,11 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) {
return janet_wrap_abstract(thread);
}
static Janet cfun_thread_send(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_thread_send,
"(thread/send thread msgi &opt timeout)",
"Send a message to the thread. By default, the timeout is 1 second, but an optional timeout "
"in seconds can be provided. Use math/inf for no timeout. "
"Will throw an error if there is a problem sending the message.") {
janet_arity(argc, 2, 3);
JanetThread *thread = janet_getthread(argv, 0);
int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0));
@ -660,7 +675,12 @@ static Janet cfun_thread_send(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_thread_receive,
"(thread/receive &opt timeout)",
"Get a message sent to this thread. If timeout (in seconds) is provided, an error "
"will be thrown after the timeout has elapsed but "
"no messages are received. The default timeout is 1 second, and math/inf cam be passed to "
"turn off the timeout.") {
janet_arity(argc, 0, 1);
double wait = janet_optnumber(argv, argc, 0, 1.0);
Janet out;
@ -676,14 +696,20 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
return out;
}
static Janet cfun_thread_close(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_thread_close,
"(thread/close thread)",
"Close a thread, unblocking it and ending communication with it. Note that closing "
"a thread is idempotent and does not cancel the thread's operation. Returns nil.") {
janet_fixarity(argc, 1);
JanetThread *thread = janet_getthread(argv, 0);
janet_close_thread(thread);
return janet_wrap_nil();
}
static Janet cfun_thread_exit(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_thread_exit,
"(thread/exit &opt code)",
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
"not end the current process.") {
(void) argv;
janet_arity(argc, 0, 1);
#if defined(JANET_WINDOWS)
@ -712,57 +738,18 @@ static Janet janet_thread_next(void *p, Janet key) {
return janet_nextmethod(janet_thread_methods, key);
}
static const JanetReg threadlib_cfuns[] = {
{
"thread/current", cfun_thread_current,
JDOC("(thread/current)\n\n"
"Get the current running thread.")
},
{
"thread/new", cfun_thread_new,
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\n"
"* :h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n\n"
"* :a - Allow sending over registered abstract types to the new thread\n\n"
"* :c - Send over cfunction information to the new thread.\n\n"
"Returns a handle to the new thread.")
},
{
"thread/send", cfun_thread_send,
JDOC("(thread/send thread msgi &opt timeout)\n\n"
"Send a message to the thread. By default, the timeout is 1 second, but an optional timeout "
"in seconds can be provided. Use math/inf for no timeout. "
"Will throw an error if there is a problem sending the message.")
},
{
"thread/receive", cfun_thread_receive,
JDOC("(thread/receive &opt timeout)\n\n"
"Get a message sent to this thread. If timeout (in seconds) is provided, an error "
"will be thrown after the timeout has elapsed but "
"no messages are received. The default timeout is 1 second, and math/inf cam be passed to "
"turn off the timeout.")
},
{
"thread/close", cfun_thread_close,
JDOC("(thread/close thread)\n\n"
"Close a thread, unblocking it and ending communication with it. Note that closing "
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
},
{
"thread/exit", cfun_thread_exit,
JDOC("(thread/exit &opt code)\n\n"
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
"not end the current process.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_thread(JanetTable *env) {
janet_core_cfuns(env, NULL, threadlib_cfuns);
JanetRegExt threadlib_cfuns[] = {
JANET_CORE_REG("thread/current", cfun_thread_current),
JANET_CORE_REG("thread/new", cfun_thread_new),
JANET_CORE_REG("thread/send", cfun_thread_send),
JANET_CORE_REG("thread/receive", cfun_thread_receive),
JANET_CORE_REG("thread/close", cfun_thread_close),
JANET_CORE_REG("thread/exit", cfun_thread_exit),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, threadlib_cfuns);
janet_register_abstract_type(&janet_thread_type);
}

83
src/core/tuple.c
View File

@ -55,19 +55,35 @@ const Janet *janet_tuple_n(const Janet *values, int32_t n) {
/* C Functions */
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_tuple_brackets,
"(tuple/brackets & xs)",
"Creates a new bracketed tuple containing the elements xs.") {
const Janet *tup = janet_tuple_n(argv, argc);
janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
return janet_wrap_tuple(tup);
}
static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_tuple_slice,
"(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])",
"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. "
"'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.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
}
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_tuple_type,
"(tuple/type tup)",
"Checks how the tuple was constructed. Will return the keyword "
":brackets if the tuple was parsed with brackets, and :parens "
"otherwise. The two types of tuples will behave the same most of "
"the time, but will print differently and be treated differently by "
"the compiler.") {
janet_fixarity(argc, 1);
const Janet *tup = janet_gettuple(argv, 0);
if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) {
@ -77,7 +93,10 @@ static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
}
}
static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_tuple_sourcemap,
"(tuple/sourcemap tup)",
"Returns the sourcemap metadata attached to a tuple, "
" which is another tuple (line, column).") {
janet_fixarity(argc, 1);
const Janet *tup = janet_gettuple(argv, 0);
Janet contents[2];
@ -86,7 +105,10 @@ static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
return janet_wrap_tuple(janet_tuple_n(contents, 2));
}
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
JANET_CORE_FN(cfun_tuple_setmap,
"(tuple/setmap tup line column)",
"Set the sourcemap metadata on a tuple. line and column indicate "
"should be integers.") {
janet_fixarity(argc, 3);
const Janet *tup = janet_gettuple(argv, 0);
janet_tuple_head(tup)->sm_line = janet_getinteger(argv, 1);
@ -94,48 +116,15 @@ static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
return argv[0];
}
static const JanetReg tuple_cfuns[] = {
{
"tuple/brackets", cfun_tuple_brackets,
JDOC("(tuple/brackets & xs)\n\n"
"Creates a new bracketed tuple containing the elements xs.")
},
{
"tuple/slice", cfun_tuple_slice,
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. "
"'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.")
},
{
"tuple/type", cfun_tuple_type,
JDOC("(tuple/type tup)\n\n"
"Checks how the tuple was constructed. Will return the keyword "
":brackets if the tuple was parsed with brackets, and :parens "
"otherwise. The two types of tuples will behave the same most of "
"the time, but will print differently and be treated differently by "
"the compiler.")
},
{
"tuple/sourcemap", cfun_tuple_sourcemap,
JDOC("(tuple/sourcemap tup)\n\n"
"Returns the sourcemap metadata attached to a tuple, "
" which is another tuple (line, column).")
},
{
"tuple/setmap", cfun_tuple_setmap,
JDOC("(tuple/setmap tup line column)\n\n"
"Set the sourcemap metadata on a tuple. line and column indicate "
"should be integers.")
},
{NULL, NULL, NULL}
};
/* Load the tuple module */
void janet_lib_tuple(JanetTable *env) {
janet_core_cfuns(env, NULL, tuple_cfuns);
JanetRegExt tuple_cfuns[] = {
JANET_CORE_REG("tuple/brackets", cfun_tuple_brackets),
JANET_CORE_REG("tuple/slice", cfun_tuple_slice),
JANET_CORE_REG("tuple/type", cfun_tuple_type),
JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap),
JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, tuple_cfuns);
}

3
src/core/util.c
View File

@ -553,7 +553,8 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
}
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) {
(void) sf, sl;
(void) sf;
(void) sl;
janet_core_def(env, name, x, p);
}

9
src/include/janet.h
View File

@ -1765,7 +1765,7 @@ JANET_API Janet janet_resolve_core(const char *name);
/* no docstrings or sourcemaps */
#define JANET_REG_(JNAME, CNAME) {JNAME, CNAME, NULL, NULL, 0}
#define JANET_FN_(CNAME, USAGE, DOCSTRING) \
static Janet CNAME (int32_t argc, Janet *argv)
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_(ENV, JNAME, VAL, DOC) \
janet_def(ENV, JNAME, VAL, NULL)
@ -1773,7 +1773,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
static int32_t CNAME##_sourceline_ = __LINE__; \
static Janet CNAME (int32_t argc, Janet *argv)
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
@ -1781,7 +1781,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0}
#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
static Janet CNAME (int32_t argc, Janet *argv)
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
janet_def(ENV, JNAME, VAL, DOC)
@ -1790,10 +1790,11 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
static int32_t CNAME##_sourceline_ = __LINE__; \
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
static Janet CNAME (int32_t argc, Janet *argv)
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
/* Choose defaults for source mapping and docstring based on config defs */
#if defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
#define JANET_REG JANET_REG_