mirror of
https://github.com/janet-lang/janet
synced 2026-04-07 23:41:27 +00:00
Compare commits
21 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
41bb6a9833 | ||
|
|
95e54c66b6 | ||
|
|
31e2415bbb | ||
|
|
2a5234b390 | ||
|
|
ad5b0a371e | ||
|
|
ba4dd9b5bb | ||
|
|
d42bdf2443 | ||
|
|
a246877c1e | ||
|
|
98e68a5cb4 | ||
|
|
e12aace02c | ||
|
|
51a9c7104d | ||
|
|
75dc08ff21 | ||
|
|
6fa60820a3 | ||
|
|
609a9621af | ||
|
|
8ba1121161 | ||
|
|
9a080197e7 | ||
|
|
e65375277a | ||
|
|
4a111b38b1 | ||
|
|
a363dce943 | ||
|
|
687a3c91f5 | ||
|
|
951aa0d8cd |
@@ -1,6 +1,9 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 0.4.1 latest - ??
|
||||
- Add array/remove function
|
||||
|
||||
## 0.4.0 - 2019-03-08
|
||||
- Fix a number of smaller bugs
|
||||
- Added :export option to import and require
|
||||
|
||||
6
Makefile
6
Makefile
@@ -177,13 +177,13 @@ valgrind: $(JANET_TARGET)
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
########################
|
||||
##### Distribution #####
|
||||
|
||||
@@ -43,7 +43,8 @@ int main() {
|
||||
/* Set up VM */
|
||||
int status;
|
||||
JanetTable *env;
|
||||
env = janet_core_env();
|
||||
|
||||
env = janet_core_env(NULL);
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
|
||||
|
||||
@@ -212,7 +212,32 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
restsize);
|
||||
memcpy(array->data + at, argv + 2, chunksize);
|
||||
array->count += (argc - 2);
|
||||
return janet_wrap_array(array);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
int32_t n = 1;
|
||||
if (at < 0) {
|
||||
at = array->count + at + 1;
|
||||
}
|
||||
if (at < 0 || at > array->count)
|
||||
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
||||
if (argc == 3) {
|
||||
n = janet_getinteger(argv, 2);
|
||||
if (n < 0)
|
||||
janet_panicf("expected non-negative integer for argument n, got %v", argv[2]);
|
||||
}
|
||||
if (at + n > array->count) {
|
||||
n = array->count - at;
|
||||
}
|
||||
memmove(array->data + at,
|
||||
array->data + at + n,
|
||||
(array->count - at - n) * sizeof(Janet));
|
||||
array->count -= n;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
@@ -270,6 +295,13 @@ static const JanetReg array_cfuns[] = {
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{
|
||||
"array/remove", cfun_array_remove,
|
||||
JDOC("(array/remove arr at [, n=1])\n\n"
|
||||
"Remove up to n elements starting at index at in array arr. at can index from "
|
||||
"the end of the array with a negative index, and n must be a non-negative integer. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -147,19 +147,18 @@ static const TypeAlias type_aliases[] = {
|
||||
{"callable", JANET_TFLAG_CALLABLE},
|
||||
{"cfunction", JANET_TFLAG_CFUNCTION},
|
||||
{"dictionary", JANET_TFLAG_DICTIONARY},
|
||||
{"false", JANET_TFLAG_FALSE},
|
||||
{"fiber", JANET_TFLAG_FIBER},
|
||||
{"function", JANET_TFLAG_FUNCTION},
|
||||
{"indexed", JANET_TFLAG_INDEXED},
|
||||
{"keyword", JANET_TFLAG_KEYWORD},
|
||||
{"nil", JANET_TFLAG_NIL},
|
||||
{"number", JANET_TFLAG_NUMBER},
|
||||
{"pointer", JANET_TFLAG_POINTER},
|
||||
{"string", JANET_TFLAG_STRING},
|
||||
{"struct", JANET_TFLAG_STRUCT},
|
||||
{"symbol", JANET_TFLAG_SYMBOL},
|
||||
{"keyword", JANET_TFLAG_KEYWORD},
|
||||
{"table", JANET_TFLAG_BOOLEAN},
|
||||
{"true", JANET_TFLAG_TRUE},
|
||||
{"tuple", JANET_TFLAG_BOOLEAN}
|
||||
{"table", JANET_TFLAG_TABLE},
|
||||
{"tuple", JANET_TFLAG_TUPLE}
|
||||
};
|
||||
|
||||
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
||||
@@ -525,15 +524,20 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
/* Set function arity */
|
||||
x = janet_get1(s, janet_csymbolv("arity"));
|
||||
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
||||
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
|
||||
|
||||
x = janet_get1(s, janet_csymbolv("max-arity"));
|
||||
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
|
||||
|
||||
x = janet_get1(s, janet_csymbolv("min-arity"));
|
||||
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
|
||||
|
||||
/* Check vararg */
|
||||
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Check strict arity */
|
||||
x = janet_get1(s, janet_csymbolv("fix-arity"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
||||
|
||||
/* Check source */
|
||||
x = janet_get1(s, janet_csymbolv("source"));
|
||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||
@@ -822,6 +826,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
JanetArray *constants;
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
||||
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
||||
if (NULL != def->source) {
|
||||
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
||||
@@ -829,9 +835,6 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
janet_table_put(ret, janet_csymbolv("fix-arity"), janet_wrap_true());
|
||||
}
|
||||
if (NULL != def->name) {
|
||||
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
||||
}
|
||||
|
||||
@@ -208,6 +208,8 @@ JanetFuncDef *janet_funcdef_alloc() {
|
||||
def->flags = 0;
|
||||
def->slotcount = 0;
|
||||
def->arity = 0;
|
||||
def->min_arity = 0;
|
||||
def->max_arity = INT32_MAX;
|
||||
def->source = NULL;
|
||||
def->sourcemap = NULL;
|
||||
def->name = NULL;
|
||||
|
||||
@@ -95,16 +95,8 @@ DEFINE_GETTER(buffer, BUFFER, JanetBuffer *)
|
||||
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
||||
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
||||
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||
|
||||
int janet_getboolean(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (janet_checktype(x, JANET_TRUE)) {
|
||||
return 1;
|
||||
} else if (!janet_checktype(x, JANET_FALSE)) {
|
||||
janet_panicf("bad slot #%d, expected boolean, got %v", n, x);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
DEFINE_GETTER(boolean, BOOLEAN, int)
|
||||
DEFINE_GETTER(pointer, POINTER, void *)
|
||||
|
||||
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
|
||||
@@ -97,7 +97,6 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
|
||||
scope.syms = NULL;
|
||||
scope.envs = NULL;
|
||||
scope.defs = NULL;
|
||||
scope.selfconst = -1;
|
||||
scope.bytecode_start = janet_v_count(c->buffer);
|
||||
scope.flags = flags;
|
||||
scope.parent = c->scope;
|
||||
@@ -644,6 +643,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
def->source = c->source;
|
||||
|
||||
def->arity = 0;
|
||||
def->min_arity = 0;
|
||||
def->flags = 0;
|
||||
if (scope->flags & JANET_SCOPE_ENV) {
|
||||
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
||||
|
||||
@@ -96,6 +96,7 @@ struct JanetSlot {
|
||||
#define JANET_SCOPE_TOP 4
|
||||
#define JANET_SCOPE_UNUSED 8
|
||||
#define JANET_SCOPE_CLOSURE 16
|
||||
#define JANET_SCOPE_WHILE 32
|
||||
|
||||
/* A symbol and slot pair */
|
||||
typedef struct SymPair {
|
||||
@@ -131,9 +132,6 @@ struct JanetScope {
|
||||
* that corresponds to the direct parent's stack will always have value 0. */
|
||||
int32_t *envs;
|
||||
|
||||
/* Where to add reference to self in constants */
|
||||
int32_t selfconst;
|
||||
|
||||
int32_t bytecode_start;
|
||||
int flags;
|
||||
};
|
||||
|
||||
@@ -142,7 +142,7 @@
|
||||
|
||||
(defmacro if-not
|
||||
"Shorthand for (if (not ... "
|
||||
[condition exp-1 exp-2 &]
|
||||
[condition exp-1 &opt exp-2]
|
||||
~(if ,condition ,exp-2 ,exp-1))
|
||||
|
||||
(defmacro when
|
||||
@@ -232,8 +232,8 @@
|
||||
(while (> i 0)
|
||||
(-- i)
|
||||
(set ret (if (= ret true)
|
||||
(get forms i)
|
||||
(tuple 'if (get forms i) ret))))
|
||||
(get forms i)
|
||||
(tuple 'if (get forms i) ret))))
|
||||
ret)
|
||||
|
||||
(defmacro or
|
||||
@@ -247,13 +247,123 @@
|
||||
(-- i)
|
||||
(def fi (get forms i))
|
||||
(set ret (if (idempotent? fi)
|
||||
(tuple 'if fi fi ret)
|
||||
(do
|
||||
(def $fi (gensym))
|
||||
(tuple 'do (tuple 'def $fi fi)
|
||||
(tuple 'if $fi $fi ret))))))
|
||||
(tuple 'if fi fi ret)
|
||||
(do
|
||||
(def $fi (gensym))
|
||||
(tuple 'do (tuple 'def $fi fi)
|
||||
(tuple 'if $fi $fi ret))))))
|
||||
ret)
|
||||
|
||||
(defmacro with-syms
|
||||
"Evaluates body with each symbol in syms bound to a generated, unique symbol."
|
||||
[syms & body]
|
||||
(var i 0)
|
||||
(def len (length syms))
|
||||
(def accum @[])
|
||||
(while (< i len)
|
||||
(array/push accum (get syms i) [gensym])
|
||||
(++ i))
|
||||
~(let (,;accum) ,;body))
|
||||
|
||||
(defn- for-template
|
||||
[binding start stop step comparison delta body]
|
||||
(with-syms [i s]
|
||||
~(do
|
||||
(var ,i ,start)
|
||||
(def ,s ,stop)
|
||||
(while (,comparison ,i ,s)
|
||||
(def ,binding ,i)
|
||||
,;body
|
||||
(set ,i (,delta ,i ,step))))))
|
||||
|
||||
(defn- each-template
|
||||
[binding in body]
|
||||
(with-syms [i len]
|
||||
(def ds (if (idempotent? in) in (gensym)))
|
||||
~(do
|
||||
(var ,i 0)
|
||||
,(unless (= ds in) ~(def ,ds ,in))
|
||||
(def ,len (,length ,ds))
|
||||
(while (,< ,i ,len)
|
||||
(def ,binding (get ,ds ,i))
|
||||
,;body
|
||||
(++ ,i)))))
|
||||
|
||||
(defn- keys-template
|
||||
[binding in pair? body]
|
||||
(with-syms [k]
|
||||
(def ds (if (idempotent? in) in (gensym)))
|
||||
~(do
|
||||
,(unless (= ds in) ~(def ,ds ,in))
|
||||
(var ,k (,next ,ds nil))
|
||||
(while ,k
|
||||
(def ,binding ,(if pair? ~(tuple ,k (get ,ds ,k)) k))
|
||||
,;body
|
||||
(set ,k (,next ,ds ,k))))))
|
||||
|
||||
(defn- iterate-template
|
||||
[binding expr body]
|
||||
(with-syms [i]
|
||||
~(do
|
||||
(var ,i nil)
|
||||
(while (set ,i ,expr)
|
||||
,body))))
|
||||
|
||||
(defn- loop1
|
||||
[body head i]
|
||||
|
||||
(def {i binding
|
||||
(+ i 1) verb
|
||||
(+ i 2) object} head)
|
||||
|
||||
(cond
|
||||
|
||||
# Terminate recursion
|
||||
(<= (length head) i)
|
||||
~(do ,;body)
|
||||
|
||||
# 2 term expression
|
||||
(keyword? binding)
|
||||
(let [rest (loop1 body head (+ i 2))]
|
||||
(case binding
|
||||
:while ~(do (if ,verb nil (break)) ,rest)
|
||||
:let ~(let ,verb (do ,rest))
|
||||
:after ~(do ,rest ,verb nil)
|
||||
:before ~(do ,verb ,rest nil)
|
||||
:repeat (with-syms [iter]
|
||||
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
|
||||
:when ~(when ,verb ,rest)
|
||||
(error (string "unexpected loop modifier " binding))))
|
||||
|
||||
# 3 term expression
|
||||
(let [rest (loop1 body head (+ i 3))]
|
||||
(case verb
|
||||
:range (let [[start stop step] object]
|
||||
(for-template binding start stop (or step 1) < + [rest]))
|
||||
:keys (keys-template binding object false [rest])
|
||||
:pairs (keys-template binding object true [rest])
|
||||
:down (let [[start stop step] object]
|
||||
(for-template binding start stop (or step 1) > - [rest]))
|
||||
:in (each-template binding object [rest])
|
||||
:iterate (iterate-template binding object rest)
|
||||
:generate (with-syms [f s]
|
||||
~(let [,f ,object]
|
||||
(while true
|
||||
(def ,binding (,resume ,f))
|
||||
(if (= :dead (,fiber/status ,f)) (break))
|
||||
,rest)))
|
||||
(error (string "unexpected loop verb " verb))))))
|
||||
|
||||
(defmacro for
|
||||
"Do a c style for loop for side effects. Returns nil."
|
||||
[i start stop & body]
|
||||
(for-template i start stop 1 < + body))
|
||||
|
||||
(defmacro each
|
||||
"Loop over each value in ind. Returns nil."
|
||||
[x ind & body]
|
||||
(each-template x ind body))
|
||||
|
||||
(defmacro loop
|
||||
"A general purpose loop macro. This macro is similar to the Common Lisp
|
||||
loop macro, although intentionally much smaller in scope.
|
||||
@@ -285,139 +395,13 @@
|
||||
\t:when condition - only evaluates the loop body when condition is true.\n\n
|
||||
The loop macro always evaluates to nil."
|
||||
[head & body]
|
||||
(def len (length head))
|
||||
(if (not= :tuple (type head))
|
||||
(error "expected tuple for loop head"))
|
||||
(defn doone
|
||||
[i preds &]
|
||||
(default preds @['and])
|
||||
(if (>= i len)
|
||||
['do ;body]
|
||||
(do
|
||||
(def {i bindings
|
||||
(+ i 1) verb
|
||||
(+ i 2) object} head)
|
||||
(if (keyword? bindings)
|
||||
(case bindings
|
||||
:while (do
|
||||
(array/push preds verb)
|
||||
(doone (+ i 2) preds))
|
||||
:let (tuple 'let verb (doone (+ i 2) preds))
|
||||
:when (tuple 'if verb (doone (+ i 2) preds))
|
||||
:before (tuple 'do verb (doone (+ i 2) preds))
|
||||
:after (tuple 'do (doone (+ i 2) preds) verb)
|
||||
:repeat (do
|
||||
(def $iter (gensym))
|
||||
(def $n (gensym))
|
||||
(def spreds @['and (tuple < $iter $n)])
|
||||
(def sub (doone (+ i 2) spreds))
|
||||
(tuple 'do
|
||||
(tuple 'def $n verb)
|
||||
(tuple 'var $iter 0)
|
||||
(tuple 'while
|
||||
(tuple/slice spreds)
|
||||
(tuple 'set $iter (tuple + 1 $iter))
|
||||
sub)))
|
||||
(error (string "unexpected loop predicate: " bindings)))
|
||||
(case verb
|
||||
:iterate (do
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple 'set $iter object)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'var $iter nil)
|
||||
(tuple 'while (tuple/slice preds)
|
||||
(tuple 'def bindings $iter)
|
||||
subloop)))
|
||||
:range (do
|
||||
(def [start end _inc] object)
|
||||
(def inc (if _inc _inc 1))
|
||||
(def endsym (gensym))
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple < $iter endsym)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'var $iter start)
|
||||
(tuple 'def endsym end)
|
||||
(tuple 'while (tuple/slice preds)
|
||||
(tuple 'def bindings $iter)
|
||||
subloop
|
||||
(tuple 'set $iter (tuple + $iter inc)))))
|
||||
:down (do
|
||||
(def [start end _dec] object)
|
||||
(def dec (if _dec _dec 1))
|
||||
(def endsym (gensym))
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple > $iter endsym)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'var $iter start)
|
||||
(tuple 'def endsym end)
|
||||
(tuple 'while (tuple/slice preds)
|
||||
(tuple 'def bindings $iter)
|
||||
subloop
|
||||
(tuple 'set $iter (tuple - $iter dec)))))
|
||||
:keys (do
|
||||
(def $dict (gensym))
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple not= nil $iter)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $dict object)
|
||||
(tuple 'var $iter (tuple next $dict nil))
|
||||
(tuple 'while (tuple/slice preds)
|
||||
(tuple 'def bindings $iter)
|
||||
subloop
|
||||
(tuple 'set $iter (tuple next $dict $iter)))))
|
||||
:pairs (do
|
||||
(def sym? (symbol? bindings))
|
||||
(def $dict (gensym))
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple not= nil $iter)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $dict object)
|
||||
(tuple 'var $iter (tuple next $dict nil))
|
||||
(tuple 'while (tuple/slice preds)
|
||||
(if sym?
|
||||
(tuple 'def bindings (tuple tuple $iter (tuple get $dict $iter))))
|
||||
(if-not sym? (tuple 'def (get bindings 0) $iter))
|
||||
(if-not sym? (tuple 'def (get bindings 1) (tuple get $dict $iter)))
|
||||
subloop
|
||||
(tuple 'set $iter (tuple next $dict $iter)))))
|
||||
:in (do
|
||||
(def $len (gensym))
|
||||
(def $i (gensym))
|
||||
(def $indexed (gensym))
|
||||
(def preds @['and (tuple < $i $len)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $indexed object)
|
||||
(tuple 'def $len (tuple length $indexed))
|
||||
(tuple 'var $i 0)
|
||||
(tuple 'while (tuple/slice preds 0)
|
||||
(tuple 'def bindings (tuple get $indexed $i))
|
||||
subloop
|
||||
(tuple 'set $i (tuple + 1 $i)))))
|
||||
:generate (do
|
||||
(def $fiber (gensym))
|
||||
(def $yieldval (gensym))
|
||||
(def preds @['and
|
||||
(do
|
||||
(def s (gensym))
|
||||
(tuple 'do
|
||||
(tuple 'def s (tuple fiber/status $fiber))
|
||||
(tuple 'or (tuple = s :pending) (tuple = s :new))))])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $fiber object)
|
||||
(tuple 'var $yieldval (tuple resume $fiber))
|
||||
(tuple 'while (tuple/slice preds 0)
|
||||
(tuple 'def bindings $yieldval)
|
||||
subloop
|
||||
(tuple 'set $yieldval (tuple resume $fiber)))))
|
||||
(error (string "unexpected loop verb: " verb)))))))
|
||||
(doone 0 nil))
|
||||
(loop1 body head 0))
|
||||
|
||||
(put _env 'loop1 nil)
|
||||
(put _env 'for-template nil)
|
||||
(put _env 'iterate-template nil)
|
||||
(put _env 'each-template nil)
|
||||
(put _env 'keys-template nil)
|
||||
|
||||
(defmacro seq
|
||||
"Similar to loop, but accumulates the loop body into an array and returns that.
|
||||
@@ -430,42 +414,32 @@
|
||||
"Create a generator expression using the loop syntax. Returns a fiber
|
||||
that yields all values inside the loop in order. See loop for details."
|
||||
[head & body]
|
||||
~(fiber/new (fn [&] (loop ,head (yield (do ,;body))))))
|
||||
|
||||
(defmacro for
|
||||
"Do a c style for loop for side effects. Returns nil."
|
||||
[binding start end & body]
|
||||
(apply loop (tuple binding :range (tuple start end)) body))
|
||||
|
||||
(defmacro each
|
||||
"Loop over each value in ind. Returns nil."
|
||||
[binding ind & body]
|
||||
(apply loop (tuple binding :in ind) body))
|
||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body))))))
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [&] ...body))."
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [] ...body))."
|
||||
[& body]
|
||||
(tuple fiber/new (tuple 'fn '[&] ;body)))
|
||||
(tuple fiber/new (tuple 'fn '[] ;body)))
|
||||
|
||||
(defn sum
|
||||
"Returns the sum of xs. If xs is empty, returns 0."
|
||||
[xs]
|
||||
(var accum 0)
|
||||
(loop [x :in xs] (+= accum x))
|
||||
(each x xs (+= accum x))
|
||||
accum)
|
||||
|
||||
(defn product
|
||||
"Returns the product of xs. If xs is empty, returns 1."
|
||||
[xs]
|
||||
(var accum 1)
|
||||
(loop [x :in xs] (*= accum x))
|
||||
(each x xs (*= accum x))
|
||||
accum)
|
||||
|
||||
(defmacro if-let
|
||||
"Make multiple bindings, and if all are truthy,
|
||||
evaluate the tru form. If any are false or nil, evaluate
|
||||
the fal form. Bindings have the same syntax as the let macro."
|
||||
[bindings tru fal &]
|
||||
[bindings tru &opt fal]
|
||||
(def len (length bindings))
|
||||
(if (zero? len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
@@ -509,7 +483,7 @@
|
||||
4 (let [[f g h i] functions] (fn [x] (f (g (h (i x))))))
|
||||
(let [[f g h i j] functions]
|
||||
(comp (fn [x] (f (g (h (i (j x))))))
|
||||
;(tuple/slice functions 5 -1)))))
|
||||
;(tuple/slice functions 5 -1)))))
|
||||
|
||||
(defn identity
|
||||
"A function that returns its first argument."
|
||||
@@ -526,13 +500,9 @@
|
||||
order should take two values and return true or false (a comparison).
|
||||
Returns nil if args is empty."
|
||||
[order args]
|
||||
(def len (length args))
|
||||
(when (pos? len)
|
||||
(var [ret] args)
|
||||
(loop [i :range [0 len]]
|
||||
(def v (get args i))
|
||||
(if (order v ret) (set ret v)))
|
||||
ret))
|
||||
(var [ret] args)
|
||||
(each x args (if (order x ret) (set ret x)))
|
||||
ret)
|
||||
|
||||
(defn max
|
||||
"Returns the numeric maximum of the arguments."
|
||||
@@ -576,7 +546,7 @@
|
||||
[a lo hi by]
|
||||
(def pivot (get a hi))
|
||||
(var i lo)
|
||||
(loop [j :range [lo hi]]
|
||||
(for j lo hi
|
||||
(def aj (get a j))
|
||||
(when (by aj pivot)
|
||||
(def ai (get a i))
|
||||
@@ -595,7 +565,7 @@
|
||||
(sort-help a (+ piv 1) hi by))
|
||||
a)
|
||||
|
||||
(fn sort [a by &]
|
||||
(fn sort [a &opt by]
|
||||
(sort-help a 0 (- (length a) 1) (or by order<)))))
|
||||
|
||||
(defn sorted
|
||||
@@ -608,8 +578,7 @@
|
||||
an indexed type (array, tuple) with a function to produce a value."
|
||||
[f init ind]
|
||||
(var res init)
|
||||
(loop [x :in ind]
|
||||
(set res (f res x)))
|
||||
(each x ind (set res (f res x)))
|
||||
res)
|
||||
|
||||
(defn map
|
||||
@@ -619,19 +588,19 @@
|
||||
(def ninds (length inds))
|
||||
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
||||
(var limit (length (get inds 0)))
|
||||
(loop [i :range [0 ninds]]
|
||||
(for i 0 ninds
|
||||
(def l (length (get inds i)))
|
||||
(if (< l limit) (set limit l)))
|
||||
(def [i1 i2 i3 i4] inds)
|
||||
(def res (array/new limit))
|
||||
(case ninds
|
||||
1 (loop [i :range [0 limit]] (set (res i) (f (get i1 i))))
|
||||
2 (loop [i :range [0 limit]] (set (res i) (f (get i1 i) (get i2 i))))
|
||||
3 (loop [i :range [0 limit]] (set (res i) (f (get i1 i) (get i2 i) (get i3 i))))
|
||||
4 (loop [i :range [0 limit]] (set (res i) (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
|
||||
(loop [i :range [0 limit]]
|
||||
1 (for i 0 limit (set (res i) (f (get i1 i))))
|
||||
2 (for i 0 limit (set (res i) (f (get i1 i) (get i2 i))))
|
||||
3 (for i 0 limit (set (res i) (f (get i1 i) (get i2 i) (get i3 i))))
|
||||
4 (for i 0 limit (set (res i) (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
|
||||
(for i 0 limit
|
||||
(def args (array/new ninds))
|
||||
(loop [j :range [0 ninds]] (set (args j) (get (get inds j) i)))
|
||||
(for j 0 ninds (set (args j) (get (get inds j) i)))
|
||||
(set (res i) (f ;args))))
|
||||
res)
|
||||
|
||||
@@ -640,21 +609,16 @@
|
||||
use array to concatenate the results."
|
||||
[f ind]
|
||||
(def res @[])
|
||||
(loop [x :in ind]
|
||||
(each x ind
|
||||
(array/concat res (f x)))
|
||||
res)
|
||||
|
||||
(defmacro with-syms
|
||||
"Evaluates body with each symbol in syms bound to a generated, unique symbol."
|
||||
[syms & body]
|
||||
~(let ,(mapcat (fn [s] @[s (tuple gensym)]) syms) ,;body))
|
||||
|
||||
(defn filter
|
||||
"Given a predicate, take only elements from an array or tuple for
|
||||
which (pred element) is truthy. Returns a new array."
|
||||
[pred ind]
|
||||
(def res @[])
|
||||
(loop [item :in ind]
|
||||
(each item ind
|
||||
(if (pred item)
|
||||
(array/push res item)))
|
||||
res)
|
||||
@@ -664,7 +628,7 @@
|
||||
is true."
|
||||
[pred ind]
|
||||
(var counter 0)
|
||||
(loop [item :in ind]
|
||||
(each item ind
|
||||
(if (pred item)
|
||||
(++ counter)))
|
||||
counter)
|
||||
@@ -674,7 +638,7 @@
|
||||
which (pred element) is truthy. Returns a new array of truthy predicate results."
|
||||
[pred ind]
|
||||
(def res @[])
|
||||
(loop [item :in ind]
|
||||
(each item ind
|
||||
(if-let [y (pred item)]
|
||||
(array/push res y)))
|
||||
res)
|
||||
@@ -688,12 +652,12 @@
|
||||
1 (do
|
||||
(def [n] args)
|
||||
(def arr (array/new n))
|
||||
(loop [i :range [0 n]] (put arr i i))
|
||||
(for i 0 n (put arr i i))
|
||||
arr)
|
||||
2 (do
|
||||
(def [n m] args)
|
||||
(def arr (array/new n))
|
||||
(loop [i :range [n m]] (put arr (- i n) i))
|
||||
(def arr (array/new (- m n)))
|
||||
(for i n m (put arr (- i n) i))
|
||||
arr)
|
||||
3 (do
|
||||
(def [n m s] args)
|
||||
@@ -737,10 +701,12 @@
|
||||
|
||||
(defn drop-until
|
||||
"Given a predicate, remove elements from an indexed type that satisfy
|
||||
the predicate, and abort on first failure. Returns a new tuple."
|
||||
the predicate, and abort on first failure. Returns a new array."
|
||||
[pred ind]
|
||||
(def i (find-index pred ind))
|
||||
(array/slice ind i))
|
||||
(if i
|
||||
(array/slice ind i)
|
||||
@[]))
|
||||
|
||||
(defn drop-while
|
||||
"Same as (drop-until (complement pred) ind)."
|
||||
@@ -753,7 +719,7 @@
|
||||
[& funs]
|
||||
(fn [& args]
|
||||
(def ret @[])
|
||||
(loop [f :in funs]
|
||||
(each f funs
|
||||
(array/push ret (f ;args)))
|
||||
(tuple/slice ret 0)))
|
||||
|
||||
@@ -762,7 +728,7 @@
|
||||
[& funs]
|
||||
(def parts @['tuple])
|
||||
(def $args (gensym))
|
||||
(loop [f :in funs]
|
||||
(each f funs
|
||||
(array/push parts (tuple apply f $args)))
|
||||
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
|
||||
|
||||
@@ -869,7 +835,7 @@
|
||||
last value."
|
||||
[x as & forms]
|
||||
(var prev x)
|
||||
(loop [form :in forms]
|
||||
(each form forms
|
||||
(def sym (gensym))
|
||||
(def next-prev (postwalk (fn [y] (if (= y as) sym y)) form))
|
||||
(set prev ~(let [,sym ,prev] ,next-prev)))
|
||||
@@ -882,7 +848,7 @@
|
||||
last value."
|
||||
[x as & forms]
|
||||
(var prev x)
|
||||
(loop [form :in forms]
|
||||
(each form forms
|
||||
(def sym (gensym))
|
||||
(def next-prev (postwalk (fn [y] (if (= y as) sym y)) form))
|
||||
(set prev ~(if-let [,sym ,prev] ,next-prev)))
|
||||
@@ -916,8 +882,8 @@
|
||||
|
||||
(defn invert
|
||||
"Returns a table of where the keys of an associative data structure
|
||||
are the values, and the values of the keys. If multiple keys have the same
|
||||
value, one key will be ignored."
|
||||
are the values, and the values of the keys. If multiple keys have the same
|
||||
value, one key will be ignored."
|
||||
[ds]
|
||||
(def ret @{})
|
||||
(loop [k :keys ds]
|
||||
@@ -932,7 +898,7 @@ value, one key will be ignored."
|
||||
(def lk (length keys))
|
||||
(def lv (length vals))
|
||||
(def len (if (< lk lv) lk lv))
|
||||
(loop [i :range [0 len]]
|
||||
(for i 0 len
|
||||
(put res (get keys i) (get vals i)))
|
||||
res)
|
||||
|
||||
@@ -998,8 +964,7 @@ value, one key will be ignored."
|
||||
"Get the number of occurrences of each value in a indexed structure."
|
||||
[ind]
|
||||
(def freqs @{})
|
||||
(loop
|
||||
[x :in ind]
|
||||
(each x ind
|
||||
(def n (get freqs x))
|
||||
(set (freqs x) (if n (+ 1 n) 1)))
|
||||
freqs)
|
||||
@@ -1014,7 +979,7 @@ value, one key will be ignored."
|
||||
(def len (min ;(map length cols)))
|
||||
(loop [i :range [0 len]
|
||||
ci :range [0 ncol]]
|
||||
(array/push res (get (get cols ci) i))))
|
||||
(array/push res (get (get cols ci) i))))
|
||||
res)
|
||||
|
||||
(defn distinct
|
||||
@@ -1022,14 +987,14 @@ value, one key will be ignored."
|
||||
[xs]
|
||||
(def ret @[])
|
||||
(def seen @{})
|
||||
(loop [x :in xs] (if (get seen x) nil (do (put seen x true) (array/push ret x))))
|
||||
(each x xs (if (get seen x) nil (do (put seen x true) (array/push ret x))))
|
||||
ret)
|
||||
|
||||
(defn flatten-into
|
||||
"Takes a nested array (tree), and appends the depth first traversal of
|
||||
that array to an array 'into'. Returns array into."
|
||||
[into xs]
|
||||
(loop [x :in xs]
|
||||
(each x xs
|
||||
(if (indexed? x)
|
||||
(flatten-into into x)
|
||||
(array/push into x)))
|
||||
@@ -1095,7 +1060,7 @@ value, one key will be ignored."
|
||||
(defn spit
|
||||
"Write contents to a file at path.
|
||||
Can optionally append to the file."
|
||||
[path contents mode &]
|
||||
[path contents &opt mode]
|
||||
(default mode :w)
|
||||
(def f (file/open path mode))
|
||||
(if-not f (error (string "could not open file " path " with mode " mode)))
|
||||
@@ -1188,15 +1153,15 @@ value, one key will be ignored."
|
||||
match if it is equal to x."
|
||||
[x & cases]
|
||||
(with-idemp $x x
|
||||
(def len (length cases))
|
||||
(def len-1 (dec len))
|
||||
((fn aux [i]
|
||||
(cond
|
||||
(= i len-1) (get cases i)
|
||||
(< i len-1) (with-syms [$res]
|
||||
~(if (= ,sentinel (def ,$res ,(match-1 (get cases i) $x (fn [] (get cases (inc i))) @{})))
|
||||
,(aux (+ 2 i))
|
||||
,$res)))) 0)))
|
||||
(def len (length cases))
|
||||
(def len-1 (dec len))
|
||||
((fn aux [i]
|
||||
(cond
|
||||
(= i len-1) (get cases i)
|
||||
(< i len-1) (with-syms [$res]
|
||||
~(if (= ,sentinel (def ,$res ,(match-1 (get cases i) $x (fn [] (get cases (inc i))) @{})))
|
||||
,(aux (+ 2 i))
|
||||
,$res)))) 0)))
|
||||
|
||||
(put _env 'sentinel nil)
|
||||
(put _env 'match-1 nil)
|
||||
@@ -1234,16 +1199,16 @@ value, one key will be ignored."
|
||||
(buffer/push-string buf word)
|
||||
(buffer/clear word))
|
||||
|
||||
(loop [b :in text]
|
||||
(each b text
|
||||
(if (and (not= b 10) (not= b 32))
|
||||
(if (= b 9)
|
||||
(buffer/push-string word " ")
|
||||
(buffer/push-byte word b))
|
||||
(do
|
||||
(if (> (length word) 0) (pushword))
|
||||
(when (= b 10)
|
||||
(buffer/push-string buf "\n ")
|
||||
(set current 0)))))
|
||||
(if (= b 9)
|
||||
(buffer/push-string word " ")
|
||||
(buffer/push-byte word b))
|
||||
(do
|
||||
(if (> (length word) 0) (pushword))
|
||||
(when (= b 10)
|
||||
(buffer/push-string buf "\n ")
|
||||
(set current 0)))))
|
||||
|
||||
# Last word
|
||||
(pushword)
|
||||
@@ -1437,7 +1402,7 @@ value, one key will be ignored."
|
||||
"Create a new environment table. The new environment
|
||||
will inherit bindings from the parent environment, but new
|
||||
bindings will not pollute the parent environment."
|
||||
[parent &]
|
||||
[&opt parent]
|
||||
(def parent (if parent parent _env))
|
||||
(def newenv (table/setproto @{} parent))
|
||||
newenv)
|
||||
@@ -1460,14 +1425,6 @@ value, one key will be ignored."
|
||||
(file/write stderr "compile error: " msg " while compiling " where "\n")
|
||||
(when macrof (debug/stacktrace macrof)))
|
||||
|
||||
(defn getline
|
||||
"Read a line from stdin into a buffer."
|
||||
[buf p &]
|
||||
(default buf @"")
|
||||
(when p (file/write stdout p))
|
||||
(file/read stdin :line buf)
|
||||
buf)
|
||||
|
||||
(defn run-context
|
||||
"Run a context. This evaluates expressions of janet in an environment,
|
||||
and is encapsulates the parsing, compilation, and evaluation.
|
||||
@@ -1556,7 +1513,7 @@ value, one key will be ignored."
|
||||
(defn eval-string
|
||||
"Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use run-context."
|
||||
[str env &]
|
||||
[str &opt env]
|
||||
(var state (string str))
|
||||
(defn chunks [buf _]
|
||||
(def ret state)
|
||||
@@ -1565,7 +1522,6 @@ value, one key will be ignored."
|
||||
(buffer/push-string buf str)
|
||||
(buffer/push-string buf "\n")))
|
||||
(var returnval nil)
|
||||
(defn error1 [x &] (error x))
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
:on-compile-error (fn [msg errf &]
|
||||
@@ -1583,7 +1539,7 @@ value, one key will be ignored."
|
||||
(defn eval
|
||||
"Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use run-context."
|
||||
[form env &]
|
||||
[form &opt env]
|
||||
(default env *env*)
|
||||
(def res (compile form env "eval"))
|
||||
(if (= (type res) :function)
|
||||
@@ -1655,9 +1611,9 @@ value, one key will be ignored."
|
||||
(def paths (map make-full module/paths))
|
||||
(def res (find check-path paths))
|
||||
(if res res [nil (string "could not find module "
|
||||
path
|
||||
":\n "
|
||||
;(interpose "\n " (map 0 paths)))]))
|
||||
path
|
||||
":\n "
|
||||
;(interpose "\n " (map 0 paths)))]))
|
||||
|
||||
(put _env 'fexists nil)
|
||||
|
||||
@@ -1681,25 +1637,36 @@ value, one key will be ignored."
|
||||
(do
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(unless fullpath (error mod-kind))
|
||||
(def env (case mod-kind
|
||||
:source (do
|
||||
# Normal janet module
|
||||
(def f (file/open fullpath))
|
||||
(def newenv (make-env))
|
||||
(put module/loading fullpath true)
|
||||
(defn chunks [buf _] (file/read f 2048 buf))
|
||||
(run-context {:env newenv
|
||||
:chunks chunks
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
:source fullpath})
|
||||
(file/close f)
|
||||
(put module/loading fullpath nil)
|
||||
(table/setproto newenv nil))
|
||||
:native (native fullpath (make-env))
|
||||
:image (load-image (slurp fullpath))))
|
||||
(def env
|
||||
(case mod-kind
|
||||
:source (do
|
||||
# Normal janet module
|
||||
(def f (file/open fullpath))
|
||||
(def newenv (make-env))
|
||||
(put module/loading fullpath true)
|
||||
(defn chunks [buf _] (file/read f 2048 buf))
|
||||
(defn bp [&opt x y]
|
||||
(def ret (bad-parse x y))
|
||||
(if exit-on-error (os/exit 1))
|
||||
ret)
|
||||
(defn bc [&opt x y z]
|
||||
(def ret (bad-compile x y z))
|
||||
(if exit-on-error (os/exit 1))
|
||||
ret)
|
||||
(run-context {:env newenv
|
||||
:chunks chunks
|
||||
:on-parse-error bp
|
||||
:on-compile-error bc
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
:source fullpath})
|
||||
(file/close f)
|
||||
(put module/loading fullpath nil)
|
||||
(table/setproto newenv nil))
|
||||
:native (native fullpath (make-env))
|
||||
:image (load-image (slurp fullpath))))
|
||||
(put module/cache fullpath env)
|
||||
(put module/cache path env)
|
||||
env)))
|
||||
@@ -1737,7 +1704,7 @@ value, one key will be ignored."
|
||||
get a chunk of source code that should return nil for end of file.
|
||||
The second parameter is a function that is called when a signal is
|
||||
caught."
|
||||
[chunks onsignal &]
|
||||
[&opt chunks onsignal]
|
||||
(def newenv (make-env))
|
||||
(default onsignal (fn [f x]
|
||||
(case (fiber/status f)
|
||||
@@ -1759,7 +1726,7 @@ value, one key will be ignored."
|
||||
|
||||
(defn all-bindings
|
||||
"Get all symbols available in the current environment."
|
||||
[env &]
|
||||
[&opt env]
|
||||
(default env *env*)
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
||||
|
||||
@@ -243,6 +243,29 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_number(janet_hash(argv[0]));
|
||||
}
|
||||
|
||||
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 2);
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
if (argc >= 1) {
|
||||
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||
printf("%s", prompt);
|
||||
fflush(stdout);
|
||||
}
|
||||
{
|
||||
buf->count = 0;
|
||||
int c;
|
||||
for (;;) {
|
||||
c = fgetc(stdin);
|
||||
if (feof(stdin) || c < 0) {
|
||||
break;
|
||||
}
|
||||
janet_buffer_push_u8(buf, (uint8_t) c);
|
||||
if (c == '\n') break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
@@ -393,6 +416,12 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||
"then they will have the same hash value.")
|
||||
},
|
||||
{
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline [, prompt=\"\" [, buffer=@\"\"]])\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -404,12 +433,16 @@ static void janet_quick_asm(
|
||||
int32_t flags,
|
||||
const char *name,
|
||||
int32_t arity,
|
||||
int32_t min_arity,
|
||||
int32_t max_arity,
|
||||
int32_t slots,
|
||||
const uint32_t *bytecode,
|
||||
size_t bytecode_size,
|
||||
const char *doc) {
|
||||
JanetFuncDef *def = janet_funcdef_alloc();
|
||||
def->arity = arity;
|
||||
def->min_arity = min_arity;
|
||||
def->max_arity = max_arity;
|
||||
def->flags = flags;
|
||||
def->slotcount = slots;
|
||||
def->bytecode = malloc(bytecode_size);
|
||||
@@ -485,6 +518,8 @@ static void templatize_varop(
|
||||
flags | JANET_FUNCDEF_FLAG_VARARG,
|
||||
name,
|
||||
0,
|
||||
0,
|
||||
INT32_MAX,
|
||||
6,
|
||||
varop_asm,
|
||||
sizeof(varop_asm),
|
||||
@@ -538,6 +573,8 @@ static void templatize_comparator(
|
||||
flags | JANET_FUNCDEF_FLAG_VARARG,
|
||||
name,
|
||||
0,
|
||||
0,
|
||||
INT32_MAX,
|
||||
6,
|
||||
comparator_asm,
|
||||
sizeof(comparator_asm),
|
||||
@@ -575,7 +612,7 @@ static void make_apply(JanetTable *env) {
|
||||
S(JOP_TAILCALL, 0)
|
||||
};
|
||||
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
||||
"apply", 1, 6, apply_asm, sizeof(apply_asm),
|
||||
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
|
||||
JDOC("(apply f & args)\n\n"
|
||||
"Applies a function to a variable number of arguments. Each element in args "
|
||||
"is used as an argument to f, except the last element in args, which is expected to "
|
||||
@@ -618,43 +655,43 @@ static const uint32_t bnot_asm[] = {
|
||||
};
|
||||
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
||||
|
||||
JanetTable *janet_core_env(void) {
|
||||
JanetTable *env = janet_table(0);
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
janet_quick_asm(env, JANET_FUN_YIELD | JANET_FUNCDEF_FLAG_FIXARITY,
|
||||
"debug", 0, 1, debug_asm, sizeof(debug_asm),
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug)\n\n"
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns nil."));
|
||||
janet_quick_asm(env, JANET_FUN_ERROR | JANET_FUNCDEF_FLAG_FIXARITY,
|
||||
"error", 1, 1, error_asm, sizeof(error_asm),
|
||||
janet_quick_asm(env, JANET_FUN_ERROR,
|
||||
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
||||
JDOC("(error e)\n\n"
|
||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_YIELD,
|
||||
"yield", 1, 2, yield_asm, sizeof(yield_asm),
|
||||
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
|
||||
JDOC("(yield x)\n\n"
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||
"resume", 2, 2, resume_asm, sizeof(resume_asm),
|
||||
JDOC("(resume fiber [,x])\n\n"
|
||||
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||
JDOC("(resume fiber &opt x)\n\n"
|
||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_GET | JANET_FUNCDEF_FLAG_FIXARITY,
|
||||
"get", 2, 2, get_asm, sizeof(get_asm),
|
||||
janet_quick_asm(env, JANET_FUN_GET,
|
||||
"get", 2, 2, 2, 2, get_asm, sizeof(get_asm),
|
||||
JDOC("(get ds key)\n\n"
|
||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||
"integer representations of bytes as result of a get call."));
|
||||
janet_quick_asm(env, JANET_FUN_PUT | JANET_FUNCDEF_FLAG_FIXARITY,
|
||||
"put", 3, 3, put_asm, sizeof(put_asm),
|
||||
janet_quick_asm(env, JANET_FUN_PUT,
|
||||
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||
JDOC("(put ds key value)\n\n"
|
||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||
@@ -662,13 +699,13 @@ JanetTable *janet_core_env(void) {
|
||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||
janet_quick_asm(env, JANET_FUN_LENGTH | JANET_FUNCDEF_FLAG_FIXARITY,
|
||||
"length", 1, 1, length_asm, sizeof(length_asm),
|
||||
janet_quick_asm(env, JANET_FUN_LENGTH,
|
||||
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
|
||||
JDOC("(length ds)\n\n"
|
||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||
janet_quick_asm(env, JANET_FUN_BNOT | JANET_FUNCDEF_FLAG_FIXARITY,
|
||||
"bnot", 1, 1, bnot_asm, sizeof(bnot_asm),
|
||||
janet_quick_asm(env, JANET_FUN_BNOT,
|
||||
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
|
||||
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
||||
make_apply(env);
|
||||
|
||||
@@ -791,7 +828,6 @@ JanetTable *janet_core_env(void) {
|
||||
janet_lib_typed_array(env);
|
||||
#endif
|
||||
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
/* Run bootstrap source */
|
||||
janet_dobytes(env, janet_gen_core, janet_gen_core_size, "core.janet", NULL);
|
||||
|
||||
@@ -78,11 +78,9 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
|
||||
case JANET_NIL:
|
||||
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
|
||||
break;
|
||||
case JANET_TRUE:
|
||||
janetc_emit(c, (reg << 8) | JOP_LOAD_TRUE);
|
||||
break;
|
||||
case JANET_FALSE:
|
||||
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
|
||||
case JANET_BOOLEAN:
|
||||
janetc_emit(c, (reg << 8) |
|
||||
(janet_unwrap_boolean(k) ? JOP_LOAD_TRUE : JOP_LOAD_FALSE));
|
||||
break;
|
||||
case JANET_NUMBER: {
|
||||
double dval = janet_unwrap_number(k);
|
||||
|
||||
@@ -138,11 +138,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
if (next_arity < func->def->min_arity) return 1;
|
||||
if (next_arity > func->def->max_arity) return 1;
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
@@ -204,11 +201,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t stacksize;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
if (next_arity < func->def->min_arity) return 1;
|
||||
if (next_arity > func->def->max_arity) return 1;
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
@@ -303,10 +297,8 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != 0) {
|
||||
janet_panic("expected nullary function in fiber constructor");
|
||||
}
|
||||
if (func->def->min_arity != 0) {
|
||||
janet_panic("expected nullary function in fiber constructor");
|
||||
}
|
||||
fiber = janet_fiber(func, 64, 0, NULL);
|
||||
if (argc == 2) {
|
||||
|
||||
@@ -376,8 +376,7 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
||||
if (janet_type(lhs) != janet_type(rhs))
|
||||
return 0;
|
||||
switch (janet_type(lhs)) {
|
||||
case JANET_TRUE:
|
||||
case JANET_FALSE:
|
||||
case JANET_BOOLEAN:
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
||||
|
||||
@@ -203,6 +203,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
pushint(st, def->flags);
|
||||
pushint(st, def->slotcount);
|
||||
pushint(st, def->arity);
|
||||
pushint(st, def->min_arity);
|
||||
pushint(st, def->max_arity);
|
||||
pushint(st, def->constants_length);
|
||||
pushint(st, def->bytecode_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||
@@ -339,9 +341,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NIL:
|
||||
case JANET_FALSE:
|
||||
case JANET_TRUE:
|
||||
pushbyte(st, 200 + type);
|
||||
pushbyte(st, LB_NIL);
|
||||
return;
|
||||
case JANET_BOOLEAN:
|
||||
pushbyte(st, janet_unwrap_boolean(x) ? LB_TRUE : LB_FALSE);
|
||||
return;
|
||||
case JANET_NUMBER: {
|
||||
double xval = janet_unwrap_number(x);
|
||||
@@ -708,6 +711,8 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->flags = readint(st, &data);
|
||||
def->slotcount = readint(st, &data);
|
||||
def->arity = readint(st, &data);
|
||||
def->min_arity = readint(st, &data);
|
||||
def->max_arity = readint(st, &data);
|
||||
|
||||
/* Read some lengths */
|
||||
constants_length = readint(st, &data);
|
||||
|
||||
@@ -179,11 +179,9 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
return;
|
||||
case JANET_TRUE:
|
||||
janet_buffer_push_cstring(buffer, "true");
|
||||
return;
|
||||
case JANET_FALSE:
|
||||
janet_buffer_push_cstring(buffer, "false");
|
||||
case JANET_BOOLEAN:
|
||||
janet_buffer_push_cstring(buffer,
|
||||
janet_unwrap_boolean(x) ? "true" : "false");
|
||||
return;
|
||||
case JANET_NUMBER:
|
||||
number_to_string_b(buffer, janet_unwrap_number(x));
|
||||
@@ -315,8 +313,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_TRUE:
|
||||
case JANET_FALSE:
|
||||
case JANET_BOOLEAN:
|
||||
break;
|
||||
default: {
|
||||
Janet seenid = janet_table_get(&S->seen, x);
|
||||
|
||||
@@ -471,6 +471,61 @@ static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
|
||||
return janet_v_count(scope->defs) - 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* break
|
||||
*
|
||||
* jump :end or retn if in function
|
||||
*/
|
||||
static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
JanetScope *scope = c->scope;
|
||||
if (argn > 1) {
|
||||
janetc_cerror(c, "expected at most 1 argument");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
|
||||
/* Find scope to break from */
|
||||
while (scope) {
|
||||
if (scope->flags & (JANET_SCOPE_FUNCTION | JANET_SCOPE_WHILE))
|
||||
break;
|
||||
scope = scope->parent;
|
||||
}
|
||||
if (NULL == scope) {
|
||||
janetc_cerror(c, "break must occur in while loop or closure");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
|
||||
/* Emit code to break from that scope */
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
||||
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
||||
/* Closure body with return argument */
|
||||
subopts.flags |= JANET_FOPTS_TAIL;
|
||||
JanetSlot ret = janetc_value(subopts, argv[0]);
|
||||
ret.flags |= JANET_SLOT_RETURNED;
|
||||
return ret;
|
||||
} else {
|
||||
/* while loop IIFE or no argument */
|
||||
if (argn) {
|
||||
subopts.flags |= JANET_FOPTS_DROP;
|
||||
janetc_value(subopts, argv[0]);
|
||||
}
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
JanetSlot s = janetc_cslot(janet_wrap_nil());
|
||||
s.flags |= JANET_SLOT_RETURNED;
|
||||
return s;
|
||||
}
|
||||
} else {
|
||||
if (argn) {
|
||||
subopts.flags |= JANET_FOPTS_DROP;
|
||||
janetc_value(subopts, argv[0]);
|
||||
}
|
||||
/* Tag the instruction so the while special can turn it into a proper jump */
|
||||
janetc_emit(c, 0x80 | JOP_JUMP);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* :whiletop
|
||||
* ...
|
||||
@@ -495,7 +550,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
|
||||
labelwt = janet_v_count(c->buffer);
|
||||
|
||||
janetc_scope(&tempscope, c, 0, "while");
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||
|
||||
/* Compile condition */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
@@ -569,6 +624,13 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
if (!infinite) c->buffer[labelc] |= (uint32_t)(labeld - labelc) << 16;
|
||||
c->buffer[labeljt] |= (uint32_t)(labelwt - labeljt) << 8;
|
||||
|
||||
/* Calculate breaks */
|
||||
for (int32_t i = labelwt; i < labeld; i++) {
|
||||
if (c->buffer[i] == (0x80 | JOP_JUMP)) {
|
||||
c->buffer[i] = JOP_JUMP | ((labeld - i) << 8);
|
||||
}
|
||||
}
|
||||
|
||||
/* Pop scope and return nil slot */
|
||||
janetc_popscope(c);
|
||||
|
||||
@@ -581,16 +643,17 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetSlot ret;
|
||||
Janet head;
|
||||
JanetScope fnscope;
|
||||
int32_t paramcount, argi, parami, arity, defindex, i;
|
||||
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
const Janet *params;
|
||||
const char *errmsg = NULL;
|
||||
|
||||
/* Function flags */
|
||||
int vararg = 0;
|
||||
int fixarity = 1;
|
||||
int allow_extra = 0;
|
||||
int selfref = 0;
|
||||
int seenamp = 0;
|
||||
int seenopt = 0;
|
||||
|
||||
/* Begin function */
|
||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||
@@ -621,19 +684,32 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
Janet param = params[i];
|
||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
/* Check for varargs and unfixed arity */
|
||||
if ((!seenamp) &&
|
||||
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
|
||||
seenamp = 1;
|
||||
fixarity = 0;
|
||||
if (i == paramcount - 1) {
|
||||
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||
if (seenamp) {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
allow_extra = 1;
|
||||
arity--;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "variable argument symbol in unexpected location";
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
|
||||
if (seenopt) {
|
||||
errmsg = "only one &opt allowed";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
errmsg = "&opt cannot be last item in parameter list";
|
||||
goto error;
|
||||
}
|
||||
min_arity = i;
|
||||
arity--;
|
||||
seenopt = 1;
|
||||
} else {
|
||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||
}
|
||||
@@ -642,6 +718,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||
if (!seenopt) min_arity = arity;
|
||||
|
||||
/* Check for self ref */
|
||||
if (selfref) {
|
||||
JanetSlot slot = janetc_farslot(c);
|
||||
@@ -653,17 +732,20 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
/* Compile function body */
|
||||
if (parami + 1 == argn) {
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
} else for (argi = parami + 1; argi < argn; argi++) {
|
||||
} else {
|
||||
for (argi = parami + 1; argi < argn; argi++) {
|
||||
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
|
||||
janetc_value(subopts, argv[argi]);
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
goto error2;
|
||||
}
|
||||
}
|
||||
|
||||
/* Build function */
|
||||
def = janetc_pop_funcdef(c);
|
||||
def->arity = arity;
|
||||
if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
||||
def->min_arity = min_arity;
|
||||
def->max_arity = max_arity;
|
||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||
@@ -686,6 +768,7 @@ error2:
|
||||
|
||||
/* Keep in lexicographic order */
|
||||
static const JanetSpecial janetc_specials[] = {
|
||||
{"break", janetc_break},
|
||||
{"def", janetc_def},
|
||||
{"do", janetc_do},
|
||||
{"fn", janetc_fn},
|
||||
|
||||
@@ -144,7 +144,7 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
||||
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
||||
}
|
||||
bucket = janet_table_find(t, key);
|
||||
if (janet_checktype(bucket->value, JANET_FALSE))
|
||||
if (janet_checktype(bucket->value, JANET_BOOLEAN))
|
||||
--t->deleted;
|
||||
bucket->key = key;
|
||||
bucket->value = value;
|
||||
|
||||
@@ -42,7 +42,6 @@ const char *const janet_type_names[16] = {
|
||||
"number",
|
||||
"nil",
|
||||
"boolean",
|
||||
"boolean",
|
||||
"fiber",
|
||||
"string",
|
||||
"symbol",
|
||||
@@ -54,7 +53,8 @@ const char *const janet_type_names[16] = {
|
||||
"buffer",
|
||||
"function",
|
||||
"cfunction",
|
||||
"abstract"
|
||||
"abstract",
|
||||
"pointer"
|
||||
};
|
||||
|
||||
const char *const janet_signal_names[14] = {
|
||||
@@ -328,16 +328,27 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||
(void) p;
|
||||
janet_table_put(env, janet_csymbolv(name), x);
|
||||
Janet key = janet_csymbolv(name);
|
||||
Janet value;
|
||||
/* During boot, allow replacing core library cfunctions with values from
|
||||
* the env. */
|
||||
Janet check = janet_table_get(env, key);
|
||||
if (janet_checktype(check, JANET_NIL)) {
|
||||
value = x;
|
||||
} else {
|
||||
value = check;
|
||||
if (janet_checktype(check, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, value, key);
|
||||
}
|
||||
}
|
||||
janet_table_put(env, key, value);
|
||||
}
|
||||
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
(void) regprefix;
|
||||
while (cfuns->name) {
|
||||
Janet name = janet_csymbolv(cfuns->name);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -36,10 +36,11 @@ int janet_equals(Janet x, Janet y) {
|
||||
} else {
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
case JANET_TRUE:
|
||||
case JANET_FALSE:
|
||||
result = 1;
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||
break;
|
||||
@@ -68,11 +69,8 @@ int32_t janet_hash(Janet x) {
|
||||
case JANET_NIL:
|
||||
hash = 0;
|
||||
break;
|
||||
case JANET_FALSE:
|
||||
hash = 1;
|
||||
break;
|
||||
case JANET_TRUE:
|
||||
hash = 2;
|
||||
case JANET_BOOLEAN:
|
||||
hash = janet_unwrap_boolean(x);
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
@@ -111,9 +109,9 @@ int janet_compare(Janet x, Janet y) {
|
||||
if (janet_type(x) == janet_type(y)) {
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
case JANET_FALSE:
|
||||
case JANET_TRUE:
|
||||
return 0;
|
||||
case JANET_BOOLEAN:
|
||||
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
case JANET_NUMBER:
|
||||
/* Check for NaNs to ensure total order */
|
||||
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
||||
|
||||
@@ -125,22 +125,22 @@ Janet janet_wrap_nil() {
|
||||
|
||||
Janet janet_wrap_true(void) {
|
||||
Janet y;
|
||||
y.type = JANET_TRUE;
|
||||
y.as.u64 = 0;
|
||||
y.type = JANET_BOOLEAN;
|
||||
y.as.u64 = 1;
|
||||
return y;
|
||||
}
|
||||
|
||||
Janet janet_wrap_false(void) {
|
||||
Janet y;
|
||||
y.type = JANET_FALSE;
|
||||
y.type = JANET_BOOLEAN;
|
||||
y.as.u64 = 0;
|
||||
return y;
|
||||
}
|
||||
|
||||
Janet janet_wrap_boolean(int x) {
|
||||
Janet y;
|
||||
y.type = x ? JANET_TRUE : JANET_FALSE;
|
||||
y.as.u64 = 0;
|
||||
y.type = JANET_BOOLEAN;
|
||||
y.as.u64 = !!x;
|
||||
return y;
|
||||
}
|
||||
|
||||
@@ -166,6 +166,7 @@ JANET_WRAP_DEFINE(function, JanetFunction *, JANET_FUNCTION, pointer)
|
||||
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
|
||||
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
|
||||
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
|
||||
JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
||||
|
||||
#undef JANET_WRAP_DEFINE
|
||||
|
||||
|
||||
@@ -29,7 +29,7 @@ extern "C" {
|
||||
|
||||
/***** START SECTION CONFIG *****/
|
||||
|
||||
#define JANET_VERSION "0.4.0"
|
||||
#define JANET_VERSION "0.4.1"
|
||||
|
||||
#ifndef JANET_BUILD
|
||||
#define JANET_BUILD "local"
|
||||
@@ -299,8 +299,7 @@ typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
typedef enum JanetType {
|
||||
JANET_NUMBER,
|
||||
JANET_NIL,
|
||||
JANET_FALSE,
|
||||
JANET_TRUE,
|
||||
JANET_BOOLEAN,
|
||||
JANET_FIBER,
|
||||
JANET_STRING,
|
||||
JANET_SYMBOL,
|
||||
@@ -312,15 +311,15 @@ typedef enum JanetType {
|
||||
JANET_BUFFER,
|
||||
JANET_FUNCTION,
|
||||
JANET_CFUNCTION,
|
||||
JANET_ABSTRACT
|
||||
JANET_ABSTRACT,
|
||||
JANET_POINTER
|
||||
} JanetType;
|
||||
|
||||
#define JANET_COUNT_TYPES (JANET_ABSTRACT + 1)
|
||||
#define JANET_COUNT_TYPES (JANET_POINTER + 1)
|
||||
|
||||
/* Type flags */
|
||||
#define JANET_TFLAG_NIL (1 << JANET_NIL)
|
||||
#define JANET_TFLAG_FALSE (1 << JANET_FALSE)
|
||||
#define JANET_TFLAG_TRUE (1 << JANET_TRUE)
|
||||
#define JANET_TFLAG_BOOLEAN (1 << JANET_BOOLEAN)
|
||||
#define JANET_TFLAG_FIBER (1 << JANET_FIBER)
|
||||
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
|
||||
#define JANET_TFLAG_STRING (1 << JANET_STRING)
|
||||
@@ -334,9 +333,9 @@ typedef enum JanetType {
|
||||
#define JANET_TFLAG_FUNCTION (1 << JANET_FUNCTION)
|
||||
#define JANET_TFLAG_CFUNCTION (1 << JANET_CFUNCTION)
|
||||
#define JANET_TFLAG_ABSTRACT (1 << JANET_ABSTRACT)
|
||||
#define JANET_TFLAG_POINTER (1 << JANET_POINTER)
|
||||
|
||||
/* Some abstractions */
|
||||
#define JANET_TFLAG_BOOLEAN (JANET_TFLAG_TRUE | JANET_TFLAG_FALSE)
|
||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
||||
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
||||
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
||||
@@ -403,7 +402,8 @@ JANET_API Janet janet_nanbox_from_double(double d);
|
||||
JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
|
||||
#define janet_truthy(x) \
|
||||
(!(janet_checktype((x), JANET_NIL) || janet_checktype((x), JANET_FALSE)))
|
||||
(!janet_checktype((x), JANET_NIL) && \
|
||||
(!janet_checktype((x), JANET_BOOLEAN) || ((x).u64 & 0x1)))
|
||||
|
||||
#define janet_nanbox_from_payload(t, p) \
|
||||
janet_nanbox_from_bits(janet_nanbox_tag(t) | (p))
|
||||
@@ -416,14 +416,13 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
|
||||
/* Wrap the simple types */
|
||||
#define janet_wrap_nil() janet_nanbox_from_payload(JANET_NIL, 1)
|
||||
#define janet_wrap_true() janet_nanbox_from_payload(JANET_TRUE, 1)
|
||||
#define janet_wrap_false() janet_nanbox_from_payload(JANET_FALSE, 1)
|
||||
#define janet_wrap_boolean(b) janet_nanbox_from_payload((b) ? JANET_TRUE : JANET_FALSE, 1)
|
||||
#define janet_wrap_true() janet_nanbox_from_payload(JANET_BOOLEAN, 1)
|
||||
#define janet_wrap_false() janet_nanbox_from_payload(JANET_BOOLEAN, 0)
|
||||
#define janet_wrap_boolean(b) janet_nanbox_from_payload(JANET_BOOLEAN, !!(b))
|
||||
#define janet_wrap_number(r) janet_nanbox_from_double(r)
|
||||
|
||||
/* Unwrap the simple types */
|
||||
#define janet_unwrap_boolean(x) \
|
||||
(janet_checktype(x, JANET_TRUE))
|
||||
#define janet_unwrap_boolean(x) ((x).u64 & 0x1)
|
||||
#define janet_unwrap_number(x) ((x).number)
|
||||
|
||||
/* Wrap the pointer types */
|
||||
@@ -439,6 +438,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define janet_wrap_abstract(s) janet_nanbox_wrap_((s), JANET_ABSTRACT)
|
||||
#define janet_wrap_function(s) janet_nanbox_wrap_((s), JANET_FUNCTION)
|
||||
#define janet_wrap_cfunction(s) janet_nanbox_wrap_((s), JANET_CFUNCTION)
|
||||
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
|
||||
|
||||
/* Unwrap the pointer types */
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
|
||||
@@ -485,16 +485,17 @@ union Janet {
|
||||
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
||||
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
||||
: (x).tagged.type == (t))
|
||||
#define janet_truthy(x) ((x).tagged.type != JANET_NIL && (x).tagged.type != JANET_FALSE)
|
||||
#define janet_truthy(x) \
|
||||
((x).tagged.type != JANET_NIL && ((x).tagged.type != JANET_BOOLEAN || ((x).tagged.payload.integer & 0x1)))
|
||||
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
|
||||
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
#define janet_wrap_nil() janet_nanbox32_from_tagi(JANET_NIL, 0)
|
||||
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_TRUE, 0)
|
||||
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_FALSE, 0)
|
||||
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi((b) ? JANET_TRUE : JANET_FALSE, 0)
|
||||
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_BOOLEAN, 1)
|
||||
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_BOOLEAN, 0)
|
||||
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi(JANET_BOOLEAN, !!(b))
|
||||
|
||||
/* Wrap the pointer types */
|
||||
#define janet_wrap_struct(s) janet_nanbox32_from_tagp(JANET_STRUCT, (void *)(s))
|
||||
@@ -509,6 +510,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_wrap_abstract(s) janet_nanbox32_from_tagp(JANET_ABSTRACT, (void *)(s))
|
||||
#define janet_wrap_function(s) janet_nanbox32_from_tagp(JANET_FUNCTION, (void *)(s))
|
||||
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
||||
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
|
||||
@@ -523,7 +525,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_boolean(x) ((x).tagged.type == JANET_TRUE)
|
||||
#define janet_unwrap_boolean(x) ((x).tagged.payload.integer)
|
||||
JANET_API double janet_unwrap_number(Janet x);
|
||||
|
||||
#else
|
||||
@@ -544,7 +546,7 @@ struct Janet {
|
||||
#define janet_type(x) ((x).type)
|
||||
#define janet_checktype(x, t) ((x).type == (t))
|
||||
#define janet_truthy(x) \
|
||||
((x).type != JANET_NIL && (x).type != JANET_FALSE)
|
||||
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
||||
@@ -559,7 +561,7 @@ struct Janet {
|
||||
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).as.pointer)
|
||||
#define janet_unwrap_boolean(x) ((x).type == JANET_TRUE)
|
||||
#define janet_unwrap_boolean(x) ((x).as.u64 & 0x1)
|
||||
#define janet_unwrap_number(x) ((x).as.number)
|
||||
|
||||
JANET_API Janet janet_wrap_nil(void);
|
||||
@@ -579,6 +581,7 @@ JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||
JANET_API Janet janet_wrap_abstract(void *x);
|
||||
JANET_API Janet janet_wrap_pointer(void *x);
|
||||
|
||||
/* End of tagged union implementation */
|
||||
#endif
|
||||
@@ -725,7 +728,6 @@ struct JanetAbstractHead {
|
||||
/* Some function definition flags */
|
||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||
#define JANET_FUNCDEF_FLAG_FIXARITY 0x40000
|
||||
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
|
||||
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
||||
@@ -755,6 +757,8 @@ struct JanetFuncDef {
|
||||
int32_t flags;
|
||||
int32_t slotcount; /* The amount of stack space required for the function */
|
||||
int32_t arity; /* Not including varargs */
|
||||
int32_t min_arity; /* Including varargs */
|
||||
int32_t max_arity; /* Including varargs */
|
||||
int32_t constants_length;
|
||||
int32_t bytecode_length;
|
||||
int32_t environments_length;
|
||||
@@ -1015,7 +1019,7 @@ struct JanetCompileResult {
|
||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where);
|
||||
|
||||
/* Get the default environment for janet */
|
||||
JANET_API JanetTable *janet_core_env(void);
|
||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
|
||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||
@@ -1243,6 +1247,7 @@ JANET_API JanetFiber *janet_getfiber(const Janet *argv, int32_t n);
|
||||
JANET_API JanetFunction *janet_getfunction(const Janet *argv, int32_t n);
|
||||
JANET_API JanetCFunction janet_getcfunction(const Janet *argv, int32_t n);
|
||||
JANET_API int janet_getboolean(const Janet *argv, int32_t n);
|
||||
JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
|
||||
|
||||
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
||||
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
||||
|
||||
@@ -33,7 +33,14 @@ int main(int argc, char **argv) {
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
env = janet_core_env();
|
||||
|
||||
/* Replace original getline with new line getter */
|
||||
JanetTable *replacements = janet_table(0);
|
||||
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||
janet_line_init();
|
||||
|
||||
/* Get core env */
|
||||
env = janet_core_env(replacements);
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
@@ -41,11 +48,6 @@ int main(int argc, char **argv) {
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||
|
||||
/* Expose line getter */
|
||||
janet_def(env, "getline", janet_wrap_cfunction(janet_line_getter), NULL);
|
||||
janet_register("getline", janet_line_getter);
|
||||
janet_line_init();
|
||||
|
||||
/* Run startup script */
|
||||
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
||||
|
||||
|
||||
@@ -70,7 +70,7 @@ void repl_init(void) {
|
||||
janet_init();
|
||||
janet_register("repl-yield", repl_yield);
|
||||
janet_register("js", cfun_js);
|
||||
env = janet_core_env();
|
||||
env = janet_core_env(NULL);
|
||||
|
||||
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
||||
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
||||
|
||||
@@ -43,7 +43,7 @@
|
||||
(def b (tarray/new :float64 10 2 64 buf))))
|
||||
|
||||
(def a (tarray/new :float64 10))
|
||||
(def b (tarray/new :float64 5 2 0 a))
|
||||
(def b (tarray/new :float64 5 2 0 a))
|
||||
|
||||
(assert-no-error
|
||||
"fill tarray"
|
||||
@@ -56,6 +56,36 @@
|
||||
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
|
||||
|
||||
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||
|
||||
(end-suite)
|
||||
|
||||
# Array remove
|
||||
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4")
|
||||
|
||||
# Break
|
||||
|
||||
(var summation 0)
|
||||
(for i 0 10
|
||||
(+= summation i)
|
||||
(if (= i 7) (break)))
|
||||
(assert (= summation 28) "break 1")
|
||||
|
||||
(assert (= nil ((fn [] (break) 4))) "break 2")
|
||||
|
||||
# Break with value
|
||||
|
||||
# Shouldn't error out
|
||||
(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
|
||||
(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
|
||||
|
||||
# drop-until
|
||||
|
||||
(assert (deep= (drop-until pos? @[]) @[]) "drop-until 1")
|
||||
(assert (deep= (drop-until pos? @[1 2 3]) @[1 2 3]) "drop-until 2")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 -3]) @[]) "drop-until 3")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 3]) @[3]) "drop-until 4")
|
||||
(assert (deep= (drop-until pos? @[-1 1 -2]) @[1 -2]) "drop-until 5")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -51,6 +51,7 @@
|
||||
"src/core/symcache.c"
|
||||
"src/core/table.c"
|
||||
"src/core/tuple.c"
|
||||
"src/core/typedarray.c"
|
||||
"src/core/util.c"
|
||||
"src/core/value.c"
|
||||
"src/core/vector.c"
|
||||
|
||||
@@ -47,7 +47,7 @@
|
||||
:error (error (parser/error p)))
|
||||
|
||||
# Make ast from forms
|
||||
(def ast ~(fn [params &] (default params @{}) (,buffer ;forms)))
|
||||
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
|
||||
|
||||
(def ctor (compile ast *env* source))
|
||||
(if-not (function? ctor)
|
||||
|
||||
@@ -13,6 +13,7 @@
|
||||
'def true
|
||||
'splice true
|
||||
'set true
|
||||
'break true
|
||||
'unquote true
|
||||
'quasiquote true
|
||||
'quote true
|
||||
|
||||
@@ -344,7 +344,8 @@
|
||||
# Now we generate the bindings in the language.
|
||||
|
||||
(def- specials
|
||||
@["def"
|
||||
@["break"
|
||||
"def"
|
||||
"do"
|
||||
"var"
|
||||
"set"
|
||||
|
||||
Reference in New Issue
Block a user