mirror of
https://github.com/janet-lang/janet
synced 2024-12-23 06:50:26 +00:00
Remove some c functions in favor of bytecode.
This commit is contained in:
Calvin Rose
parent
e60c8a9b75
commit
5e2de33ae7
@ -5,106 +5,106 @@
|
||||
# Use with (import "./path/to/this/file" :prefix "seq.")
|
||||
|
||||
(defmacro delay [& forms]
|
||||
"Lazily evaluate a series of expressions. Returns a function that
|
||||
returns the result of the last expression. Will only evaluate the
|
||||
body once, and then memoizes the result."
|
||||
(def $state (gensym))
|
||||
(def $loaded (gensym))
|
||||
(tuple 'do
|
||||
(tuple 'var $state nil)
|
||||
(tuple 'var $loaded nil)
|
||||
(tuple 'fn (array)
|
||||
(tuple 'if $loaded
|
||||
$state
|
||||
(tuple 'do
|
||||
(tuple ':= $loaded true)
|
||||
(tuple ':= $state (tuple.prepend forms 'do)))))))
|
||||
"Lazily evaluate a series of expressions. Returns a function that
|
||||
returns the result of the last expression. Will only evaluate the
|
||||
body once, and then memoizes the result."
|
||||
(def $state (gensym))
|
||||
(def $loaded (gensym))
|
||||
(tuple 'do
|
||||
(tuple 'var $state nil)
|
||||
(tuple 'var $loaded nil)
|
||||
(tuple 'fn []
|
||||
(tuple 'if $loaded
|
||||
$state
|
||||
(tuple 'do
|
||||
(tuple ':= $loaded true)
|
||||
(tuple ':= $state (tuple.prepend forms 'do)))))))
|
||||
|
||||
# Use tuples instead of structs to save memory
|
||||
(def HEAD :private 0)
|
||||
(def TAIL :private 1)
|
||||
|
||||
(defn empty-seq
|
||||
"The empty sequence."
|
||||
[] nil)
|
||||
"The empty sequence."
|
||||
[] nil)
|
||||
|
||||
(defmacro cons
|
||||
"Create a new sequence by prepending a value to the original sequence."
|
||||
[h t]
|
||||
(def x (tuple h t))
|
||||
(fn [] x))
|
||||
"Create a new sequence by prepending a value to the original sequence."
|
||||
[h t]
|
||||
(def x (tuple h t))
|
||||
(fn [] x))
|
||||
|
||||
(defn empty?
|
||||
"Check if a sequence is empty."
|
||||
[s]
|
||||
(not (s)))
|
||||
"Check if a sequence is empty."
|
||||
[s]
|
||||
(not (s)))
|
||||
|
||||
(defn head
|
||||
"Get the next value of the sequence."
|
||||
[s]
|
||||
(get (s) HEAD))
|
||||
"Get the next value of the sequence."
|
||||
[s]
|
||||
(get (s) HEAD))
|
||||
|
||||
(defn tail
|
||||
"Get the rest of a sequence"
|
||||
[s]
|
||||
(get (s) TAIL))
|
||||
"Get the rest of a sequence"
|
||||
[s]
|
||||
(get (s) TAIL))
|
||||
|
||||
(defn range2
|
||||
"Return a sequence of integers [start, end)."
|
||||
[start end]
|
||||
(if (< start end)
|
||||
(delay (tuple start (range2 (+ 1 start) end)))
|
||||
empty-seq))
|
||||
"Return a sequence of integers [start, end)."
|
||||
[start end]
|
||||
(if (< start end)
|
||||
(delay (tuple start (range2 (+ 1 start) end)))
|
||||
empty-seq))
|
||||
|
||||
(defn range
|
||||
"Return a sequence of integers [0, end)."
|
||||
[end]
|
||||
(range2 0 end))
|
||||
"Return a sequence of integers [0, end)."
|
||||
[end]
|
||||
(range2 0 end))
|
||||
|
||||
(defn map
|
||||
"Return a sequence that is the result of applying f to each value in s."
|
||||
[f s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
|
||||
"Return a sequence that is the result of applying f to each value in s."
|
||||
[f s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
|
||||
|
||||
(defn realize
|
||||
"Force evaluation of a lazy sequence."
|
||||
[s]
|
||||
(when (s) (realize (tail s))))
|
||||
"Force evaluation of a lazy sequence."
|
||||
[s]
|
||||
(when (s) (realize (tail s))))
|
||||
|
||||
(defn realize-map [f s]
|
||||
"Evaluate f on each member of the sequence. Forces evaluation."
|
||||
(when (s) (f (head s)) (realize-map f (tail s))))
|
||||
"Evaluate f on each member of the sequence. Forces evaluation."
|
||||
(when (s) (f (head s)) (realize-map f (tail s))))
|
||||
|
||||
(defn drop
|
||||
"Ignores the first n values of the sequence and returns the rest."
|
||||
[n s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
|
||||
"Ignores the first n values of the sequence and returns the rest."
|
||||
[n s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
|
||||
|
||||
(defn take
|
||||
"Returns at most the first n values of s."
|
||||
[n s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(if (and x (pos? n))
|
||||
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
|
||||
"Returns at most the first n values of s."
|
||||
[n s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(if (and x (pos? n))
|
||||
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
|
||||
|
||||
(defn randseq
|
||||
"Return a sequence of random numbers."
|
||||
[]
|
||||
(delay (tuple (random) (randseq))))
|
||||
"Return a sequence of random numbers."
|
||||
[]
|
||||
(delay (tuple (random) (randseq))))
|
||||
|
||||
(defn take-while
|
||||
"Returns a sequence of values until the predicate is false."
|
||||
[pred s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(when x
|
||||
(def thehead (get HEAD x))
|
||||
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
|
||||
"Returns a sequence of values until the predicate is false."
|
||||
[pred s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(when x
|
||||
(def thehead (get HEAD x))
|
||||
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
|
||||
|
||||
# Iterators are a concept that looks a lot like lazy seq
|
||||
# The following functions turn iterators to lazy seq and vice versa
|
||||
@ -112,10 +112,10 @@ body once, and then memoizes the result."
|
||||
(defn- iter-self
|
||||
[next more]
|
||||
(delay
|
||||
(if (more) (tuple (next) (iter-self next more)))))
|
||||
(if (more) (tuple (next) (iter-self next more)))))
|
||||
|
||||
(defn iter2lazy
|
||||
"Create a lazy sequence from an iterator"
|
||||
"Create a lazy sequence from an iterator"
|
||||
[iter]
|
||||
(def {:more more :next next} iter)
|
||||
(iter-self next more))
|
||||
@ -126,6 +126,6 @@ body once, and then memoizes the result."
|
||||
(var node lazy-seq)
|
||||
{:more (fn [] (node))
|
||||
:next (fn []
|
||||
(when-let [n (node)]
|
||||
(:= node (get n 1))
|
||||
(get n 0)))})
|
||||
(when-let [n (node)]
|
||||
(:= node (get n 1))
|
||||
(get n 0)))})
|
||||
|
||||
@ -1058,7 +1058,7 @@
|
||||
(when c (file.write stdout " cfunction"))
|
||||
(if name
|
||||
(file.write stdout " " name)
|
||||
(when func (file.write stdout " " func)))
|
||||
(when func (file.write stdout " " (string func))))
|
||||
(if source
|
||||
(do
|
||||
(file.write stdout " [" source "]")
|
||||
|
||||
@ -114,48 +114,8 @@ static DstSlot genericSSI(DstFopts opts, int op, DstSlot s, int32_t imm) {
|
||||
return target;
|
||||
}
|
||||
|
||||
static DstSlot add(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_ADD, dst_wrap_integer(0), NULL);
|
||||
}
|
||||
/* Function optimizers */
|
||||
|
||||
static DstSlot mul(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_MULTIPLY, dst_wrap_integer(1), NULL);
|
||||
}
|
||||
|
||||
static DstSlot subUnary(DstFopts opts, DstSlot onearg) {
|
||||
return genericSSS(opts, DOP_SUBTRACT, dst_wrap_integer(0), onearg);
|
||||
}
|
||||
static DstSlot sub(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_SUBTRACT, dst_wrap_integer(0), subUnary);
|
||||
}
|
||||
|
||||
static DstSlot divUnary(DstFopts opts, DstSlot onearg) {
|
||||
return genericSSS(opts, DOP_DIVIDE, dst_wrap_integer(1), onearg);
|
||||
}
|
||||
static DstSlot divide(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_DIVIDE, dst_wrap_integer(1), divUnary);
|
||||
}
|
||||
|
||||
static const DstCFunOptimizer coptimizers[] = {
|
||||
{dst_add, NULL, add},
|
||||
{dst_subtract, NULL, sub},
|
||||
{dst_multiply, NULL, mul},
|
||||
{dst_divide, NULL, divide},
|
||||
};
|
||||
|
||||
/* Get a cfunction optimizer. Return NULL if none exists. */
|
||||
const DstCFunOptimizer *dstc_cfunopt(DstCFunction cfun) {
|
||||
size_t i;
|
||||
size_t n = sizeof(coptimizers)/sizeof(DstCFunOptimizer);
|
||||
for (i = 0; i < n; i++)
|
||||
if (coptimizers[i].cfun == cfun)
|
||||
return coptimizers + i;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Normal function optimizers */
|
||||
|
||||
/* Get, put, etc. */
|
||||
static DstSlot do_error(DstFopts opts, DstSlot *args) {
|
||||
dstc_emit_s(opts.compiler, DOP_ERROR, args[0]);
|
||||
return dstc_cslot(dst_wrap_nil());
|
||||
@ -201,6 +161,54 @@ static DstSlot do_apply1(DstFopts opts, DstSlot *args) {
|
||||
dstc_free_reg(opts.compiler, args[0], fun_reg);
|
||||
return target;
|
||||
}
|
||||
static DstSlot do_add(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_ADD, dst_wrap_integer(0), NULL);
|
||||
}
|
||||
static DstSlot do_sub_unary(DstFopts opts, DstSlot slot) {
|
||||
return genericSSS(opts, DOP_SUBTRACT, dst_wrap_integer(0), slot);
|
||||
}
|
||||
static DstSlot do_sub(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_SUBTRACT, dst_wrap_integer(0), do_sub_unary);
|
||||
}
|
||||
static DstSlot do_mul(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_MULTIPLY, dst_wrap_integer(1), NULL);
|
||||
}
|
||||
static DstSlot do_div_unary(DstFopts opts, DstSlot slot) {
|
||||
return genericSSS(opts, DOP_DIVIDE, dst_wrap_integer(1), slot);
|
||||
}
|
||||
static DstSlot do_div(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_DIVIDE, dst_wrap_integer(1), do_div_unary);
|
||||
}
|
||||
static DstSlot do_band(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_BAND, dst_wrap_integer(-1), NULL);
|
||||
}
|
||||
static DstSlot do_bor(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_BOR, dst_wrap_integer(0), NULL);
|
||||
}
|
||||
static DstSlot do_bxor(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_BXOR, dst_wrap_integer(0), NULL);
|
||||
}
|
||||
static DstSlot do_lshift_unary(DstFopts opts, DstSlot s) {
|
||||
return genericSSS(opts, DOP_SHIFT_LEFT, dst_wrap_integer(1), s);
|
||||
}
|
||||
static DstSlot do_lshift(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_SHIFT_LEFT,
|
||||
dst_wrap_integer(1), do_lshift_unary);
|
||||
}
|
||||
static DstSlot do_rshift_unary(DstFopts opts, DstSlot s) {
|
||||
return genericSSS(opts, DOP_SHIFT_RIGHT, dst_wrap_integer(1), s);
|
||||
}
|
||||
static DstSlot do_rshift(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_SHIFT_RIGHT,
|
||||
dst_wrap_integer(1), do_rshift_unary);
|
||||
}
|
||||
static DstSlot do_rshiftu_unary(DstFopts opts, DstSlot s) {
|
||||
return genericSSS(opts, DOP_SHIFT_RIGHT_UNSIGNED, dst_wrap_integer(1), s);
|
||||
}
|
||||
static DstSlot do_rshiftu(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_SHIFT_RIGHT,
|
||||
dst_wrap_integer(1), do_rshiftu_unary);
|
||||
}
|
||||
|
||||
/* Arranged by tag */
|
||||
static const DstFunOptimizer optimizers[] = {
|
||||
@ -212,12 +220,24 @@ static const DstFunOptimizer optimizers[] = {
|
||||
{fixarity2, do_resume},
|
||||
{fixarity2, do_get},
|
||||
{fixarity2, do_put},
|
||||
{fixarity1, do_length}
|
||||
{fixarity1, do_length},
|
||||
{NULL, do_add},
|
||||
{NULL, do_sub},
|
||||
{NULL, do_mul},
|
||||
{NULL, do_div},
|
||||
{NULL, do_band},
|
||||
{NULL, do_bor},
|
||||
{NULL, do_bxor},
|
||||
{NULL, do_lshift},
|
||||
{NULL, do_rshift},
|
||||
{NULL, do_rshiftu},
|
||||
};
|
||||
|
||||
const DstFunOptimizer *dstc_funopt(uint32_t flags) {
|
||||
uint32_t tag = flags & DST_FUNCDEF_FLAG_TAG;
|
||||
if (tag == 0 || tag > 8) return NULL;
|
||||
if (tag == 0 || tag >=
|
||||
((sizeof(optimizers)/sizeof(uint32_t) - 1)))
|
||||
return NULL;
|
||||
return optimizers + tag;
|
||||
}
|
||||
|
||||
|
||||
@ -386,13 +386,7 @@ static DstSlot dstc_call(DstFopts opts, DstSlot *slots, DstSlot fun) {
|
||||
DstCompiler *c = opts.compiler;
|
||||
int specialized = 0;
|
||||
if (fun.flags & DST_SLOT_CONSTANT) {
|
||||
if (dst_checktype(fun.constant, DST_CFUNCTION)) {
|
||||
const DstCFunOptimizer *o = dstc_cfunopt(dst_unwrap_cfunction(fun.constant));
|
||||
if (o && (!o->can_optimize || o->can_optimize(opts, slots))) {
|
||||
specialized = 1;
|
||||
retslot = o->optimize(opts, slots);
|
||||
}
|
||||
} else if (dst_checktype(fun.constant, DST_FUNCTION)) {
|
||||
if (dst_checktype(fun.constant, DST_FUNCTION)) {
|
||||
DstFunction *f = dst_unwrap_function(fun.constant);
|
||||
const DstFunOptimizer *o = dstc_funopt(f->def->flags);
|
||||
if (o && (!o->can_optimize || o->can_optimize(opts, slots))) {
|
||||
|
||||
@ -37,6 +37,16 @@
|
||||
#define DST_FUN_GET 6
|
||||
#define DST_FUN_PUT 7
|
||||
#define DST_FUN_LENGTH 8
|
||||
#define DST_FUN_ADD 9
|
||||
#define DST_FUN_SUBTRACT 10
|
||||
#define DST_FUN_MULTIPLY 11
|
||||
#define DST_FUN_DIVIDE 12
|
||||
#define DST_FUN_BAND 13
|
||||
#define DST_FUN_BOR 14
|
||||
#define DST_FUN_BXOR 15
|
||||
#define DST_FUN_LSHIFT 16
|
||||
#define DST_FUN_RSHIFT 17
|
||||
#define DST_FUN_RSHIFTU 18
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct DstCompiler DstCompiler;
|
||||
@ -45,7 +55,6 @@ typedef struct SlotTracker SlotTracker;
|
||||
typedef struct DstScope DstScope;
|
||||
typedef struct DstSlot DstSlot;
|
||||
typedef struct DstFopts DstFopts;
|
||||
typedef struct DstCFunOptimizer DstCFunOptimizer;
|
||||
typedef struct DstFunOptimizer DstFunOptimizer;
|
||||
typedef struct DstSpecial DstSpecial;
|
||||
|
||||
@ -148,15 +157,6 @@ struct DstFopts {
|
||||
/* Get the default form options */
|
||||
DstFopts dstc_fopts_default(DstCompiler *c);
|
||||
|
||||
/* A grouping of optimizations on a cfunction given certain conditions
|
||||
* on the arguments (such as all constants, or some known types). The appropriate
|
||||
* optimizations should be tried before compiling a normal function call. */
|
||||
struct DstCFunOptimizer {
|
||||
DstCFunction cfun;
|
||||
int (*can_optimize)(DstFopts opts, DstSlot *args);
|
||||
DstSlot (*optimize)(DstFopts opts, DstSlot *args);
|
||||
};
|
||||
|
||||
/* For optimizing builtin normal functions. */
|
||||
struct DstFunOptimizer {
|
||||
int (*can_optimize)(DstFopts opts, DstSlot *args);
|
||||
@ -172,7 +172,6 @@ struct DstSpecial {
|
||||
/****************************************************/
|
||||
|
||||
/* Get an optimizer if it exists, otherwise NULL */
|
||||
const DstCFunOptimizer *dstc_cfunopt(DstCFunction cfun);
|
||||
const DstFunOptimizer *dstc_funopt(uint32_t flags);
|
||||
|
||||
/* Get a special. Return NULL if none exists */
|
||||
|
||||
@ -77,6 +77,76 @@ static void dst_quick_asm(
|
||||
dst_env_def(env, name, dst_wrap_function(dst_thunk(def)));
|
||||
}
|
||||
|
||||
#define SSS(op, a, b, c) (op | (a << 8) | (b << 16) | (c << 24))
|
||||
#define SS(op, a, b) SSS(op, a, b, 0)
|
||||
#define S(op, a) SSS(op, a, 0, 0)
|
||||
/* Variadic operator assembly. Must be templatized for each different opcode. */
|
||||
/* Reg 0: Argument tuple (args) */
|
||||
/* Reg 1: Argument count (argn) */
|
||||
/* Reg 2: Jump flag (jump?) */
|
||||
/* Reg 3: Accumulator (accum) */
|
||||
/* Reg 4: Next operand (operand) */
|
||||
/* Reg 5: Loop iterator (i) */
|
||||
static DST_THREAD_LOCAL uint32_t varop_asm[] = {
|
||||
DOP_LENGTH | (1 << 8), /* Put number of arguments in register 1 -> argn = count(args) */
|
||||
|
||||
/* Cheack nullary */
|
||||
DOP_EQUALS_IMMEDIATE | (2 << 8) | (1 << 16) | (0 << 24), /* Check if numargs equal to 0 */
|
||||
DOP_JUMP_IF_NOT | (2 << 8) | (3 << 16), /* If not 0, jump to next check */
|
||||
/* Nullary */
|
||||
DOP_LOAD_INTEGER | (3 << 8), /* accum = nullary value */
|
||||
DOP_RETURN | (3 << 8), /* return accum */
|
||||
|
||||
/* Check unary */
|
||||
DOP_EQUALS_IMMEDIATE | (2 << 8) | (1 << 16) | (1 << 24), /* Check if numargs equal to 1 */
|
||||
DOP_JUMP_IF_NOT | (2 << 8) | (5 << 16), /* If not 1, jump to next check */
|
||||
/* Unary */
|
||||
DOP_LOAD_INTEGER | (3 << 8), /* accum = unary value */
|
||||
DOP_GET_INDEX | (4 << 8) | (0 << 16) | (0 << 24), /* operand = args[0] */
|
||||
DOP_NOOP | (3 << 8) | (3 << 16) | (4 << 24), /* accum = accum op operand */
|
||||
DOP_RETURN | (3 << 8), /* return accum */
|
||||
|
||||
/* Mutli (2 or more) arity */
|
||||
/* Prime loop */
|
||||
DOP_GET_INDEX | (3 << 8) | (0 << 16) | (0 << 24), /* accum = args[0] */
|
||||
DOP_LOAD_INTEGER | (5 << 8) | (1 << 16), /* i = 1 */
|
||||
/* Main loop */
|
||||
DOP_GET | (4 << 8) | (0 << 16) | (5 << 24), /* operand = args[i] */
|
||||
DOP_NOOP | (3 << 8) | (3 << 16) | (4 << 24), /* accum = accum op operand */
|
||||
DOP_ADD_IMMEDIATE | (5 << 8) | (5 << 16) | (1 << 24), /* i++ */
|
||||
DOP_EQUALS_INTEGER | (2 << 8) | (5 << 16) | (1 << 24), /* jump? = (i == argn) */
|
||||
DOP_JUMP_IF_NOT | (2 << 8) | ((uint32_t)(-4) << 16), /* if not jump? go back 4 */
|
||||
/* Done, do last and return accumulator */
|
||||
DOP_RETURN | (3 << 8) /* return accum */
|
||||
};
|
||||
|
||||
#define VAROP_NULLARY_LOC 3
|
||||
#define VAROP_UNARY_LOC 7
|
||||
#define VAROP_OP_LOC1 9
|
||||
#define VAROP_OP_LOC2 14
|
||||
|
||||
/* Templatize a varop */
|
||||
static void templatize_varop(
|
||||
DstTable *env,
|
||||
int32_t flags,
|
||||
const char *name,
|
||||
int32_t nullary,
|
||||
int32_t unary,
|
||||
uint32_t op) {
|
||||
varop_asm[VAROP_NULLARY_LOC] = SS(DOP_LOAD_INTEGER, 3, nullary);
|
||||
varop_asm[VAROP_UNARY_LOC] = SS(DOP_LOAD_INTEGER, 3, unary);
|
||||
varop_asm[VAROP_OP_LOC1] = SSS(op, 3, 3, 4);
|
||||
varop_asm[VAROP_OP_LOC2] = SSS(op, 3, 3, 4);
|
||||
dst_quick_asm(
|
||||
env,
|
||||
flags | DST_FUNCDEF_FLAG_VARARG,
|
||||
name,
|
||||
0,
|
||||
6,
|
||||
varop_asm,
|
||||
sizeof(varop_asm));
|
||||
}
|
||||
|
||||
DstTable *dst_stl_env(int flags) {
|
||||
static uint32_t error_asm[] = {
|
||||
DOP_ERROR
|
||||
@ -125,6 +195,18 @@ DstTable *dst_stl_env(int flags) {
|
||||
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));
|
||||
|
||||
/* Variadic ops */
|
||||
templatize_varop(env, DST_FUN_ADD, "+", 0, 0, DOP_ADD);
|
||||
templatize_varop(env, DST_FUN_SUBTRACT, "-", 0, 0, DOP_SUBTRACT);
|
||||
templatize_varop(env, DST_FUN_MULTIPLY, "*", 1, 1, DOP_MULTIPLY);
|
||||
templatize_varop(env, DST_FUN_DIVIDE, "/", 1, 1, DOP_DIVIDE);
|
||||
templatize_varop(env, DST_FUN_BAND, "&", -1, -1, DOP_BAND);
|
||||
templatize_varop(env, DST_FUN_BOR, "|", 0, 0, DOP_BOR);
|
||||
templatize_varop(env, DST_FUN_BXOR, "^", 0, 0, DOP_BXOR);
|
||||
templatize_varop(env, DST_FUN_LSHIFT, "<<", 1, 1, DOP_SHIFT_LEFT);
|
||||
templatize_varop(env, DST_FUN_RSHIFT, ">>", 1, 1, DOP_SHIFT_RIGHT);
|
||||
templatize_varop(env, DST_FUN_RSHIFTU, ">>>", 1, 1, DOP_SHIFT_RIGHT_UNSIGNED);
|
||||
|
||||
dst_env_def(env, "VERSION", dst_cstringv(DST_VERSION));
|
||||
|
||||
/* Set as gc root */
|
||||
|
||||
@ -112,6 +112,7 @@ static const DstInstructionDef dst_ops[] = {
|
||||
{"lds", DOP_LOAD_SELF},
|
||||
{"ldt", DOP_LOAD_TRUE},
|
||||
{"ldu", DOP_LOAD_UPVALUE},
|
||||
{"length", DOP_LENGTH},
|
||||
{"lt", DOP_LESS_THAN},
|
||||
{"lti", DOP_LESS_THAN_INTEGER},
|
||||
{"ltim", DOP_LESS_THAN_IMMEDIATE},
|
||||
|
||||
200
src/core/math.c
200
src/core/math.c
@ -72,100 +72,6 @@ int dst_real(DstArgs args) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
#define ADD(x, y) ((x) + (y))
|
||||
#define SUB(x, y) ((x) - (y))
|
||||
#define MUL(x, y) ((x) * (y))
|
||||
#define MOD(x, y) ((x) % (y))
|
||||
#define DIV(x, y) ((x) / (y))
|
||||
|
||||
#define DST_DEFINE_BINOP(name, op, rop, onerr)\
|
||||
Dst dst_op_##name(Dst lhs, Dst rhs) {\
|
||||
if (!(dst_checktype(lhs, DST_INTEGER) || dst_checktype(lhs, DST_REAL))) onerr;\
|
||||
if (!(dst_checktype(rhs, DST_INTEGER) || dst_checktype(rhs, DST_REAL))) onerr;\
|
||||
return dst_checktype(lhs, DST_INTEGER)\
|
||||
? (dst_checktype(rhs, DST_INTEGER)\
|
||||
? dst_wrap_integer(op(dst_unwrap_integer(lhs), dst_unwrap_integer(rhs)))\
|
||||
: dst_wrap_real(rop((double)dst_unwrap_integer(lhs), dst_unwrap_real(rhs))))\
|
||||
: (dst_checktype(rhs, DST_INTEGER)\
|
||||
? dst_wrap_real(rop(dst_unwrap_real(lhs), (double)dst_unwrap_integer(rhs)))\
|
||||
: dst_wrap_real(rop(dst_unwrap_real(lhs), dst_unwrap_real(rhs))));\
|
||||
}
|
||||
|
||||
DST_DEFINE_BINOP(add, ADD, ADD, return dst_wrap_nil())
|
||||
DST_DEFINE_BINOP(subtract, SUB, SUB, return dst_wrap_nil())
|
||||
DST_DEFINE_BINOP(multiply, MUL, MUL, return dst_wrap_nil())
|
||||
|
||||
#define DST_DEFINE_DIVIDER_OP(name, op, rop)\
|
||||
Dst dst_op_##name(Dst lhs, Dst rhs) {\
|
||||
if (!(dst_checktype(lhs, DST_INTEGER) || dst_checktype(lhs, DST_REAL))) return dst_wrap_nil();\
|
||||
if (!(dst_checktype(rhs, DST_INTEGER) || dst_checktype(rhs, DST_REAL))) return dst_wrap_nil();\
|
||||
return dst_checktype(lhs, DST_INTEGER)\
|
||||
? (dst_checktype(rhs, DST_INTEGER)\
|
||||
? (dst_unwrap_integer(rhs) == 0 || ((dst_unwrap_integer(lhs) == INT32_MIN) && (dst_unwrap_integer(rhs) == -1)))\
|
||||
? dst_wrap_nil()\
|
||||
: dst_wrap_integer(op(dst_unwrap_integer(lhs), dst_unwrap_integer(rhs)))\
|
||||
: dst_wrap_real(rop((double)dst_unwrap_integer(lhs), dst_unwrap_real(rhs))))\
|
||||
: (dst_checktype(rhs, DST_INTEGER)\
|
||||
? dst_wrap_real(rop(dst_unwrap_real(lhs), (double)dst_unwrap_integer(rhs)))\
|
||||
: dst_wrap_real(rop(dst_unwrap_real(lhs), dst_unwrap_real(rhs))));\
|
||||
}
|
||||
|
||||
DST_DEFINE_DIVIDER_OP(divide, DIV, DIV)
|
||||
DST_DEFINE_DIVIDER_OP(modulo, MOD, fmod)
|
||||
|
||||
#define DST_DEFINE_REDUCER(name, fop, start)\
|
||||
int dst_##name(DstArgs args) {\
|
||||
int32_t i;\
|
||||
Dst accum = dst_wrap_integer(start);\
|
||||
for (i = 0; i < args.n; i++) {\
|
||||
accum = fop(accum, args.v[i]);\
|
||||
}\
|
||||
if (dst_checktype(accum, DST_NIL)) {\
|
||||
*args.ret = dst_cstringv("expected number");\
|
||||
return 1;\
|
||||
}\
|
||||
*args.ret = accum;\
|
||||
return 0;\
|
||||
}
|
||||
|
||||
DST_DEFINE_REDUCER(add, dst_op_add, 0)
|
||||
DST_DEFINE_REDUCER(multiply, dst_op_multiply, 1)
|
||||
|
||||
#define DST_DEFINE_DIVIDER(name, unarystart)\
|
||||
int dst_##name(DstArgs args) {\
|
||||
int32_t i;\
|
||||
Dst accum;\
|
||||
if (args.n < 1) {\
|
||||
*args.ret = dst_cstringv("expected at least one argument");\
|
||||
return 1;\
|
||||
} else if (args.n == 1) {\
|
||||
accum = unarystart;\
|
||||
i = 0;\
|
||||
} else {\
|
||||
accum = args.v[0];\
|
||||
i = 1;\
|
||||
}\
|
||||
for (; i < args.n; i++) {\
|
||||
accum = dst_op_##name(accum, args.v[i]);\
|
||||
}\
|
||||
if (dst_checktype(accum, DST_NIL)) {\
|
||||
*args.ret = dst_cstringv("expected number or division error");\
|
||||
return 1;\
|
||||
}\
|
||||
*args.ret = accum;\
|
||||
return 0;\
|
||||
}
|
||||
|
||||
DST_DEFINE_DIVIDER(divide, dst_wrap_real(1))
|
||||
DST_DEFINE_DIVIDER(modulo, dst_wrap_real(1))
|
||||
DST_DEFINE_DIVIDER(subtract, dst_wrap_integer(0))
|
||||
|
||||
#undef ADD
|
||||
#undef SUB
|
||||
#undef MUL
|
||||
#undef MOD
|
||||
#undef DST_DEFINE_BINOP
|
||||
|
||||
int dst_bnot(DstArgs args) {
|
||||
if (args.n != 1) {
|
||||
*args.ret = dst_cstringv("expected 1 argument");
|
||||
@ -179,48 +85,20 @@ int dst_bnot(DstArgs args) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
#define DST_DEFINE_BITOP(name, op, start)\
|
||||
int dst_##name(DstArgs args) {\
|
||||
int32_t i;\
|
||||
int32_t accum = start;\
|
||||
for (i = 0; i < args.n; i++) {\
|
||||
Dst arg = args.v[i];\
|
||||
if (!dst_checktype(arg, DST_INTEGER)) {\
|
||||
*args.ret = dst_cstringv("expected integer");\
|
||||
return -1;\
|
||||
}\
|
||||
accum op dst_unwrap_integer(arg);\
|
||||
}\
|
||||
*args.ret = dst_wrap_integer(accum);\
|
||||
return 0;\
|
||||
}
|
||||
|
||||
DST_DEFINE_BITOP(band, &=, -1)
|
||||
DST_DEFINE_BITOP(bor, |=, 0)
|
||||
DST_DEFINE_BITOP(bxor, ^=, 0)
|
||||
|
||||
int dst_lshift(DstArgs args) {
|
||||
int32_t lhs, rhs;
|
||||
int dst_remainder(DstArgs args) {
|
||||
DST_FIXARITY(args, 2);
|
||||
DST_ARG_INTEGER(lhs, args, 0);
|
||||
DST_ARG_INTEGER(rhs, args, 1);
|
||||
DST_RETURN_INTEGER(args, lhs >> rhs);
|
||||
}
|
||||
|
||||
int dst_rshift(DstArgs args) {
|
||||
int32_t lhs, rhs;
|
||||
DST_FIXARITY(args, 2);
|
||||
DST_ARG_INTEGER(lhs, args, 0);
|
||||
DST_ARG_INTEGER(rhs, args, 1);
|
||||
DST_RETURN_INTEGER(args, lhs << rhs);
|
||||
}
|
||||
|
||||
int dst_lshiftu(DstArgs args) {
|
||||
int32_t lhs, rhs;
|
||||
DST_FIXARITY(args, 2);
|
||||
DST_ARG_INTEGER(lhs, args, 0);
|
||||
DST_ARG_INTEGER(rhs, args, 1);
|
||||
DST_RETURN_INTEGER(args, (int32_t)((uint32_t)lhs << rhs));
|
||||
if (dst_checktype(args.v[0], DST_INTEGER) &&
|
||||
dst_checktype(args.v[1], DST_INTEGER)) {
|
||||
int32_t x, y;
|
||||
x = dst_unwrap_integer(args.v[0]);
|
||||
y = dst_unwrap_integer(args.v[1]);
|
||||
DST_RETURN_INTEGER(args, x % y);
|
||||
} else {
|
||||
double x, y;
|
||||
DST_ARG_NUMBER(x, args, 0);
|
||||
DST_ARG_NUMBER(y, args, 1);
|
||||
DST_RETURN_REAL(args, fmod(x, y));
|
||||
}
|
||||
}
|
||||
|
||||
#define DST_DEFINE_MATHOP(name, fop)\
|
||||
@ -337,15 +215,7 @@ DEF_NUMERIC_COMP(eq, ==)
|
||||
DEF_NUMERIC_COMP(neq, !=)
|
||||
|
||||
static const DstReg cfuns[] = {
|
||||
{"random", dst_rand},
|
||||
{"seedrandom", dst_srand},
|
||||
{"int", dst_int},
|
||||
{"real", dst_real},
|
||||
{"+", dst_add},
|
||||
{"-", dst_subtract},
|
||||
{"*", dst_multiply},
|
||||
{"/", dst_divide},
|
||||
{"%", dst_modulo},
|
||||
{"%", dst_remainder},
|
||||
{"=", dst_strict_equal},
|
||||
{"not=", dst_strict_notequal},
|
||||
{"order<", dst_ascending},
|
||||
@ -358,27 +228,25 @@ static const DstReg cfuns[] = {
|
||||
{">", dst_numeric_gt},
|
||||
{"<=", dst_numeric_lte},
|
||||
{">=", dst_numeric_gte},
|
||||
{"|", dst_bor},
|
||||
{"&", dst_band},
|
||||
{"^", dst_bxor},
|
||||
{"~", dst_bnot},
|
||||
{">>", dst_lshift},
|
||||
{"<<", dst_rshift},
|
||||
{">>>", dst_lshiftu},
|
||||
{"not", dst_not},
|
||||
{"cos", dst_cos},
|
||||
{"sin", dst_sin},
|
||||
{"tan", dst_tan},
|
||||
{"acos", dst_acos},
|
||||
{"asin", dst_asin},
|
||||
{"atan", dst_atan},
|
||||
{"exp", dst_exp},
|
||||
{"log", dst_log},
|
||||
{"log10", dst_log10},
|
||||
{"sqrt", dst_sqrt},
|
||||
{"floor", dst_floor},
|
||||
{"ceil", dst_ceil},
|
||||
{"pow", dst_pow},
|
||||
{"int", dst_int},
|
||||
{"real", dst_real},
|
||||
{"math.random", dst_rand},
|
||||
{"math.seedrandom", dst_srand},
|
||||
{"math.cos", dst_cos},
|
||||
{"math.sin", dst_sin},
|
||||
{"math.tan", dst_tan},
|
||||
{"math.acos", dst_acos},
|
||||
{"math.asin", dst_asin},
|
||||
{"math.atan", dst_atan},
|
||||
{"math.exp", dst_exp},
|
||||
{"math.log", dst_log},
|
||||
{"math.log10", dst_log10},
|
||||
{"math.sqrt", dst_sqrt},
|
||||
{"math.floor", dst_floor},
|
||||
{"math.ceil", dst_ceil},
|
||||
{"math.pow", dst_pow},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@ -387,8 +255,8 @@ int dst_lib_math(DstArgs args) {
|
||||
DstTable *env = dst_env_arg(args);
|
||||
dst_env_cfuns(env, cfuns);
|
||||
|
||||
dst_env_def(env, "pi", dst_wrap_real(3.1415926535897931));
|
||||
dst_env_def(env, "e", dst_wrap_real(2.7182818284590451));
|
||||
dst_env_def(env, "inf", dst_wrap_real(INFINITY));
|
||||
dst_env_def(env, "math.pi", dst_wrap_real(3.1415926535897931));
|
||||
dst_env_def(env, "math.e", dst_wrap_real(2.7182818284590451));
|
||||
dst_env_def(env, "math.inf", dst_wrap_real(INFINITY));
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -336,10 +336,10 @@ static void *op_lookup[255] = {
|
||||
vm_assert(dst_checktype(op1, DST_INTEGER) || dst_checktype(op1, DST_REAL), "expected number");
|
||||
vm_assert(dst_checktype(op2, DST_INTEGER) || dst_checktype(op2, DST_REAL), "expected number");
|
||||
if (dst_checktype(op2, DST_INTEGER) && dst_unwrap_integer(op2) == 0)
|
||||
vm_throw("integer divide error");
|
||||
vm_throw("integer divide by zero");
|
||||
if (dst_checktype(op2, DST_INTEGER) && dst_unwrap_integer(op2) == -1 &&
|
||||
dst_checktype(op1, DST_INTEGER) && dst_unwrap_integer(op1) == INT32_MIN)
|
||||
vm_throw("integer divide error");
|
||||
vm_throw("integer divide out of range");
|
||||
stack[oparg(1, 0xFF)] = dst_checktype(op1, DST_INTEGER)
|
||||
? (dst_checktype(op2, DST_INTEGER)
|
||||
? dst_wrap_integer(dst_unwrap_integer(op1) / dst_unwrap_integer(op2))
|
||||
|
||||
@ -35,20 +35,9 @@ int dst_core_native(DstArgs args);
|
||||
/* Arithmetic */
|
||||
int dst_int(DstArgs args);
|
||||
int dst_real(DstArgs args);
|
||||
int dst_add(DstArgs args);
|
||||
int dst_subtract(DstArgs args);
|
||||
int dst_multiply(DstArgs args);
|
||||
int dst_divide(DstArgs args);
|
||||
int dst_modulo(DstArgs args);
|
||||
int dst_rand(DstArgs args);
|
||||
int dst_srand(DstArgs args);
|
||||
int dst_bor(DstArgs args);
|
||||
int dst_band(DstArgs args);
|
||||
int dst_bxor(DstArgs args);
|
||||
int dst_bnot(DstArgs args);
|
||||
int dst_lshift(DstArgs args);
|
||||
int dst_rshift(DstArgs args);
|
||||
int dst_lshiftu(DstArgs args);
|
||||
int dst_remainder(DstArgs args);
|
||||
|
||||
/* Math */
|
||||
int dst_cos(DstArgs args);
|
||||
|
||||
@ -45,7 +45,7 @@
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
+) "type ordering")
|
||||
print) "type ordering")
|
||||
|
||||
(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
|
||||
(assert (= (get {} 1) nil) "get nil from empty struct")
|
||||
|
||||
@ -21,8 +21,8 @@
|
||||
(import test.helper :prefix "" :exit true)
|
||||
(start-suite 1)
|
||||
|
||||
(assert (= 400.0 (sqrt 160000)) "sqrt(160000)=400")
|
||||
(assert (= (real 400) (sqrt 160000)) "sqrt(160000)=400")
|
||||
(assert (= 400.0 (math.sqrt 160000)) "sqrt(160000)=400")
|
||||
(assert (= (real 400) (math.sqrt 160000)) "sqrt(160000)=400")
|
||||
|
||||
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
|
||||
(assert (= (get test-struct 'def) 1) "struct get")
|
||||
@ -47,7 +47,7 @@
|
||||
(:= good false)))
|
||||
(assert good e))
|
||||
|
||||
(assert-many (fn [] (>= 1 (random) 0)) 200 "(random) between 0 and 1")
|
||||
(assert-many (fn [] (>= 1 (math.random) 0)) 200 "(random) between 0 and 1")
|
||||
|
||||
## Table prototypes
|
||||
|
||||
@ -167,4 +167,16 @@
|
||||
(def f (compile (tuple.prepend manydefs 'do) *env*))
|
||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||
|
||||
# Some higher order functions and macros
|
||||
|
||||
(def my-array @[1 2 3 4 5 6])
|
||||
(def x (if-let [x (get my-array 5)] x))
|
||||
(assert (= x 6) "if-let")
|
||||
(def x (if-let [y (get @{} :key)] 10 nil))
|
||||
(assert (not x) "if-let 2")
|
||||
|
||||
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
|
||||
(def myfun (juxt + - * /))
|
||||
(assert (= '[2 -2 2 0] (myfun 2)) "juxt")
|
||||
|
||||
(end-suite)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user