1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-07 23:41:27 +00:00

Compare commits

...

21 Commits

Author SHA1 Message Date
rncar
41bb6a9833 Added a getter to the new pointer type. 2019-03-14 14:21:44 -04:00
Calvin Rose
95e54c66b6 Use one tag type true and false
We moved the literals true and false into one tag
type, so we an extra tag for raw pointer types
(light userdata). These can be used from the C API via
janet_wrap_pointer and janet_unwrap_pointer.
2019-03-13 14:50:25 -04:00
Calvin Rose
31e2415bbb Fix some indentation problems. 2019-03-12 20:56:16 -04:00
Calvin Rose
2a5234b390 Properly bail on parse and compile errors
If -p flag is not set, we should bail on all three kinds
of errors, not just runtime errors. This includes
parse and compile errors. Before, parse and compile errors
were not properly affected by the :exit parameter to require, which
in turn caused scripts to not bail on parse or compile errors.
2019-03-12 20:41:17 -04:00
Calvin Rose
ad5b0a371e Optional param in bars.janet 2019-03-12 11:35:27 -04:00
Calvin Rose
ba4dd9b5bb Fix splice -> unquote splice 2019-03-12 11:16:27 -04:00
Calvin Rose
d42bdf2443 Add proper optional arguments.
Use &opt in the parameter list to get optional arguments.
2019-03-12 00:23:14 -04:00
Calvin Rose
a246877c1e Remove iterate-template from exported core symbols. 2019-03-11 01:01:59 -04:00
Calvin Rose
98e68a5cb4 Update special form lists to include break. 2019-03-11 00:58:26 -04:00
Calvin Rose
e12aace02c Update web build. 2019-03-10 23:06:10 -04:00
Calvin Rose
51a9c7104d Hide each-template 2019-03-10 13:31:42 -04:00
Quan Nguyen
75dc08ff21 Fix nil error on drop-until fn 2019-03-10 12:39:55 -04:00
Calvin Rose
6fa60820a3 Merge pull request #64 from quan-nh/master
Correct doc for drop-until fn
2019-03-09 23:47:00 -05:00
Quan Nguyen
609a9621af Correct doc for drop-until fn 2019-03-10 11:36:27 +07:00
Calvin Rose
8ba1121161 Add early returns via break.
Inside a while loop, the argument to
break does nothing as while loops always
return nil.
2019-03-09 22:01:10 -05:00
Calvin Rose
9a080197e7 Switch some instances of loop in core
Several instances of loop in the core library are
switched over to the simpler each and for macros.
2019-03-09 21:01:47 -05:00
Calvin Rose
e65375277a Update the loop macro.
Using the new break special form, the loop
macro was cleaned up. Loop bindings are also
able to be used immediately after declaration, so
forms like (loop [x :range [0 10] :while (< x 5)] (print x)) will
now compile correctly.
2019-03-09 20:47:07 -05:00
Calvin Rose
4a111b38b1 Add break special.
The break special form can break out of both loops
and functions with an early (nil) return. Mainly useful
for generated code in macros, and should probably be discouraged
in user written code.
2019-03-09 17:15:50 -05:00
Calvin Rose
a363dce943 Allow proper overriding of cfunctions in the core.
Allow overriding functions in the core libray to provide better
functionality on startup. Used to include our getline function in
the repl but use a simpler version in the core library.
2019-03-08 11:39:18 -05:00
Calvin Rose
687a3c91f5 Add array/remove and update CHANGELOG. 2019-03-08 10:24:21 -05:00
Calvin Rose
951aa0d8cd Add typed array code to amalg. 2019-03-08 10:02:09 -05:00
29 changed files with 562 additions and 404 deletions

View File

@@ -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

View File

@@ -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 #####

View File

@@ -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);

View File

@@ -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}
};

View File

@@ -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));
}

View File

@@ -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;

View File

@@ -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];

View File

@@ -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;

View File

@@ -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;
};

View File

@@ -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))))

View File

@@ -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);

View File

@@ -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);

View File

@@ -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) {

View File

@@ -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. */

View File

@@ -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);

View File

@@ -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);

View File

@@ -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},

View File

@@ -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;

View File

@@ -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++;
}
}

View File

@@ -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))

View File

@@ -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

View File

@@ -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);

View File

@@ -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);

View File

@@ -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);

View File

@@ -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)

View File

@@ -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"

View File

@@ -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)

View File

@@ -13,6 +13,7 @@
'def true
'splice true
'set true
'break true
'unquote true
'quasiquote true
'quote true

View File

@@ -344,7 +344,8 @@
# Now we generate the bindings in the language.
(def- specials
@["def"
@["break"
"def"
"do"
"var"
"set"