mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-10-26 21:27:42 +00:00
Code Issues 1 Releases Wiki Activity

Remove apply1 and optimize apply.

Browse Source
This commit is contained in:
Calvin Rose
2018-08-26 12:53:39 -04:00
parent 73b397f7de
commit 45d0597294
6 changed files with 67 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/core/cfuns.c
View File

@@ -33,6 +33,10 @@ static int fixarity1(DstFopts opts, DstSlot *args) {
(void) opts;
return dst_v_count(args) == 1;
}
static int minarity2(DstFopts opts, DstSlot *args) {
(void) opts;
return dst_v_count(args) >= 2;
}
static int fixarity2(DstFopts opts, DstSlot *args) {
(void) opts;
return dst_v_count(args) == 2;
@@ -106,18 +110,27 @@ static DstSlot do_yield(DstFopts opts, DstSlot *args) {
static DstSlot do_resume(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_RESUME, dst_wrap_nil());
}
static DstSlot do_apply1(DstFopts opts, DstSlot *args) {
static DstSlot do_apply(DstFopts opts, DstSlot *args) {
/* Push phase */
dstc_emit_s(opts.compiler, DOP_PUSH_ARRAY, args[1], 0);
DstCompiler *c = opts.compiler;
int32_t i;
for (i = 1; i < dst_v_count(args) - 3; i += 3)
dstc_emit_sss(c, DOP_PUSH_3, args[i], args[i+1], args[i+2], 0);
if (i == dst_v_count(args) - 3)
dstc_emit_ss(c, DOP_PUSH_2, args[i], args[i+1], 0);
else if (i == dst_v_count(args) - 2)
dstc_emit_s(c, DOP_PUSH, args[i], 0);
/* Push array phase */
dstc_emit_s(c, DOP_PUSH_ARRAY, dst_v_last(args), 0);
/* Call phase */
DstSlot target;
if (opts.flags & DST_FOPTS_TAIL) {
dstc_emit_s(opts.compiler, DOP_TAILCALL, args[0], 0);
dstc_emit_s(c, DOP_TAILCALL, args[0], 0);
target = dstc_cslot(dst_wrap_nil());
target.flags |= DST_SLOT_RETURNED;
} else {
target = dstc_gettarget(opts);
dstc_emit_ss(opts.compiler, DOP_CALL, target, args[0], 1);
dstc_emit_ss(c, DOP_CALL, target, args[0], 1);
}
return target;
}
@@ -238,7 +251,7 @@ static DstSlot do_neq(DstFopts opts, DstSlot *args) {
static const DstFunOptimizer optimizers[] = {
{fixarity0, do_debug},
{fixarity1, do_error},
{fixarity2, do_apply1},
{minarity2, do_apply},
{fixarity1, do_yield},
{fixarity2, do_resume},
{fixarity2, do_get},

2
src/core/compile.h
View File

@@ -29,7 +29,7 @@
/* Tags for some functions for the prepared inliner */
#define DST_FUN_DEBUG 1
#define DST_FUN_ERROR 2
#define DST_FUN_APPLY1 3
#define DST_FUN_APPLY 3
#define DST_FUN_YIELD 4
#define DST_FUN_RESUME 5
#define DST_FUN_GET 6

26
src/core/core.dst
View File

@@ -31,7 +31,7 @@
(def defmacro :macro
"Define a macro."
(fn defmacro [name & more]
(apply1 defn (array.concat @[name :macro] more))))
(apply defn (array.concat @[name :macro] more))))
(defmacro defmacro-
"Define a private macro that will not be exported."
@@ -51,7 +51,7 @@
(defmacro defasm
"Define a function using assembly"
[name & body]
(def tab (apply1 table body))
(def tab (apply table body))
(tuple 'def name (tuple asm (tuple 'quote tab))))
(defn defglobal
@@ -188,14 +188,6 @@
[sym]
(tuple doc* '_env (tuple 'quote sym)))
(defn apply
"Evaluate to (f ...args), where the final value of args must be an array or
tuple and will be spliced into the function call. For example, (apply + 1 2 @[3 4])
evaluates to 10."
[f & args]
(def last (- (length args) 1))
(apply1 f (array.concat (array.slice args 0 -2) (get args last))))
(defmacro case
"Select the body that equals the dispatch value. When pairs
has an odd number of arguments, the last is the default expression.
@@ -528,7 +520,7 @@
(loop [i :range [0 limit]]
(def args (array.new ninds))
(loop [j :range [0 ninds]] (put args j (get (get inds j) i)))
(put res i (apply1 f args))))
(put res i (apply f args))))
res)
(defn map
@@ -556,7 +548,7 @@
(loop [i :range [0 limit]]
(def args (array.new ninds))
(loop [j :range [0 ninds]] (array.push args (get (get inds j) i)))
(apply1 f args))))
(apply f args))))
(defn mapcat
"Map a function over every element in an array or tuple and
@@ -648,7 +640,7 @@
(fn [& args]
(def ret @[])
(loop [f :in funs]
(array.push ret (apply1 f args)))
(array.push ret (apply f args)))
(tuple.slice ret 0)))
(defmacro juxt
@@ -656,7 +648,7 @@
(def parts @['tuple])
(def $args (gensym))
(loop [f :in funs]
(array.push parts (tuple apply1 f $args)))
(array.push parts (tuple apply f $args)))
(tuple 'fn (tuple '& $args) (tuple.slice parts 0)))
(defmacro ->
@@ -689,7 +681,7 @@
"Partial function application."
[f & more]
(if (zero? (length more)) f
(fn [& r] (apply1 f (array.concat @[] more r)))))
(fn [& r] (apply f (array.concat @[] more r)))))
(defn every? [pred ind]
(var res true)
@@ -945,7 +937,7 @@
(def m? (get entry :macro))
(cond
s (s t)
m? (apply1 m (tuple.slice t 1))
m? (apply m (tuple.slice t 1))
(tuple.slice (map macroexpand-1 t) 0)))
(def ret
@@ -1250,7 +1242,7 @@
newenv)))))
(defn import* [env path & args]
(def targs (apply1 table args))
(def targs (apply table args))
(def {
:as as
:prefix prefix

40
src/core/corelib.c
View File

@@ -462,14 +462,44 @@ static void templatize_comparator(
sizeof(comparator_asm));
}
/* Make the apply function */
static void make_apply(DstTable *env) {
/* Reg 0: Function (fun) */
/* Reg 1: Argument tuple (args) */
/* Reg 2: Argument count (argn) */
/* Reg 3: Jump flag (jump?) */
/* Reg 4: Loop iterator (i) */
/* Reg 5: Loop values (x) */
uint32_t apply_asm[] = {
SS(DOP_LENGTH, 2, 1),
SSS(DOP_EQUALS_IMMEDIATE, 3, 2, 0), /* Immediate tail call if no args */
SI(DOP_JUMP_IF, 3, 9),
/* Prime loop */
SI(DOP_LOAD_INTEGER, 4, 0), /* i = 0 */
/* Main loop */
SSS(DOP_GET, 5, 1, 4), /* x = args[i] */
SSI(DOP_ADD_IMMEDIATE, 4, 4, 1), /* i++ */
SSI(DOP_EQUALS_INTEGER, 3, 4, 2), /* jump? = (i == argn) */
SI(DOP_JUMP_IF, 3, 3), /* if jump? go forward 3 */
S(DOP_PUSH, 5),
(DOP_JUMP | ((uint32_t)(-5) << 8)),
/* Push the array */
S(DOP_PUSH_ARRAY, 5),
/* Call the funciton */
S(DOP_TAILCALL, 0)
};
dst_quick_asm(env, DST_FUN_APPLY | DST_FUNCDEF_FLAG_VARARG,
"apply", 1, 6, apply_asm, sizeof(apply_asm));
}
DstTable *dst_core_env(void) {
static const uint32_t error_asm[] = {
DOP_ERROR
};
static const uint32_t apply_asm[] = {
DOP_PUSH_ARRAY | (1 << 8),
DOP_TAILCALL
};
static const uint32_t debug_asm[] = {
DOP_SIGNAL | (2 << 24),
DOP_RETURN_NIL
@@ -507,13 +537,13 @@ DstTable *dst_core_env(void) {
dst_quick_asm(env, DST_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm));
dst_quick_asm(env, DST_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm));
dst_quick_asm(env, DST_FUN_APPLY1, "apply1", 2, 2, apply_asm, sizeof(apply_asm));
dst_quick_asm(env, DST_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm));
dst_quick_asm(env, DST_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm));
dst_quick_asm(env, DST_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm));
dst_quick_asm(env, DST_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm));
dst_quick_asm(env, DST_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm));
dst_quick_asm(env, DST_FUN_BNOT, "~", 1, 1, bnot_asm, sizeof(bnot_asm));
make_apply(env);
/* Variadic ops */
templatize_varop(env, DST_FUN_ADD, "+", 0, 0, DOP_ADD);

6
test/suite1.dst
View File

@@ -202,7 +202,7 @@
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)), "case with default")
# Testing the loop and for macros
(def xs (apply1 tuple (for [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
(def xs (apply tuple (for [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "for macro 1")
# Some testing for not=
@@ -230,8 +230,8 @@
"Check if two arrays are equal in an element by element comparison"
[a b]
(if (and (array? a) (array? b))
(= (apply1 tuple a) (apply1 tuple b))))
(assert (= (apply1 tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
(= (apply tuple a) (apply tuple b))))
(assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
(def arr (array))
(array.push arr :hello)
(array.push arr :world)

2
test/suite2.dst
View File

@@ -42,7 +42,7 @@
# Looping idea
(def xs
(for [x :in '[-1 0 1], y :in '[-1 0 1] :when (not= x y 0)] (tuple x y)))
(def txs (apply1 tuple xs))
(def txs (apply tuple xs))
(assert (= txs '[[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested for")