Remove some c functions in favor of bytecode.

examples/lazyseqs.dst

@@ -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
+  "Lazily evaluate a series of expressions. Returns a function that
-returns the result of the last expression. Will only evaluate the
+  returns the result of the last expression. Will only evaluate the
-body once, and then memoizes the result."
+  body once, and then memoizes the result."
- (def $state (gensym))
+  (def $state (gensym))
- (def $loaded (gensym))
+  (def $loaded (gensym))
- (tuple 'do
+  (tuple 'do
-  (tuple 'var $state nil)
+         (tuple 'var $state nil)
-  (tuple 'var $loaded nil)
+         (tuple 'var $loaded nil)
-  (tuple 'fn (array)
+         (tuple 'fn []
-   (tuple 'if $loaded
+                (tuple 'if $loaded
-    $state
+                       $state
-    (tuple 'do
+                       (tuple 'do
-     (tuple ':= $loaded true)
+                              (tuple ':= $loaded true)
-     (tuple ':= $state (tuple.prepend forms 'do)))))))
+                              (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."
+  "The empty sequence."
- [] nil)
+  [] nil)
 
 (defmacro cons
- "Create a new sequence by prepending a value to the original sequence."
+  "Create a new sequence by prepending a value to the original sequence."
- [h t]
+  [h t]
- (def x (tuple h t))
+  (def x (tuple h t))
- (fn [] x))
+  (fn [] x))
 
 (defn empty?
- "Check if a sequence is empty."
+  "Check if a sequence is empty."
- [s]
+  [s]
- (not (s)))
+  (not (s)))
 
 (defn head
- "Get the next value of the sequence."
+  "Get the next value of the sequence."
- [s]
+  [s]
- (get (s) HEAD))
+  (get (s) HEAD))
 
 (defn tail
- "Get the rest of a sequence"
+  "Get the rest of a sequence"
- [s]
+  [s]
- (get (s) TAIL))
+  (get (s) TAIL))
 
 (defn range2
- "Return a sequence of integers [start, end)."
+  "Return a sequence of integers [start, end)."
- [start end]
+  [start end]
- (if (< start end)
+  (if (< start end)
-  (delay (tuple start (range2 (+ 1 start) end)))
+    (delay (tuple start (range2 (+ 1 start) end)))
-  empty-seq))
+    empty-seq))
 
 (defn range
- "Return a sequence of integers [0, end)."
+  "Return a sequence of integers [0, end)."
- [end]
+  [end]
- (range2 0 end))
+  (range2 0 end))
 
 (defn map
- "Return a sequence that is the result of applying f to each value in s."
+  "Return a sequence that is the result of applying f to each value in s."
- [f s]
+  [f s]
- (delay
+  (delay
-  (def x (s))
+    (def x (s))
-  (if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
+    (if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
 
 (defn realize
- "Force evaluation of a lazy sequence."
+  "Force evaluation of a lazy sequence."
- [s]
+  [s]
- (when (s) (realize (tail s))))
+  (when (s) (realize (tail s))))
 
 (defn realize-map [f s]
- "Evaluate f on each member of the sequence. Forces evaluation."
+  "Evaluate f on each member of the sequence. Forces evaluation."
- (when (s) (f (head s)) (realize-map f (tail s))))
+  (when (s) (f (head s)) (realize-map f (tail s))))
 
 (defn drop
- "Ignores the first n values of the sequence and returns the rest."
+  "Ignores the first n values of the sequence and returns the rest."
- [n s]
+  [n s]
- (delay
+  (delay
-  (def x (s))
+    (def x (s))
-  (if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
+    (if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
 
 (defn take
- "Returns at most the first n values of s."
+  "Returns at most the first n values of s."
- [n s]
+  [n s]
- (delay
+  (delay
-  (def x (s))
+    (def x (s))
-  (if (and x (pos? n))
+    (if (and x (pos? n))
-   (tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
+      (tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
 
 (defn randseq
- "Return a sequence of random numbers."
+  "Return a sequence of random numbers."
- []
+  []
- (delay (tuple (random) (randseq))))
+  (delay (tuple (random) (randseq))))
 
 (defn take-while
- "Returns a sequence of values until the predicate is false."
+  "Returns a sequence of values until the predicate is false."
- [pred s]
+  [pred s]
- (delay
+  (delay
-  (def x (s))
+    (def x (s))
-  (when x
+    (when x
-   (def thehead (get HEAD x))
+      (def thehead (get HEAD x))
-   (if thehead (tuple thehead (take-while pred (get TAIL 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)]
+           (when-let [n (node)]
-        (:= node (get n 1))
+                     (:= node (get n 1))
-        (get n 0)))})
+                     (get n 0)))})

src/compiler/boot.dst

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

src/compiler/cfuns.c

@@ -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) {
+/* Function optimizers */
-    return opreduce(opts, args, DOP_ADD, dst_wrap_integer(0), NULL);
-}
 
-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;
 }
 

src/compiler/compile.c

@@ -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)) {
+        if (dst_checktype(fun.constant, DST_FUNCTION)) {
-            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)) {
             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))) {

src/compiler/compile.h

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

src/compiler/stl.c

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

src/core/asm.c

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

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_remainder(DstArgs args) {
-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;
     DST_FIXARITY(args, 2);
-    DST_ARG_INTEGER(lhs, args, 0);
+    if (dst_checktype(args.v[0], DST_INTEGER) &&
-    DST_ARG_INTEGER(rhs, args, 1);
+            dst_checktype(args.v[1], DST_INTEGER)) {
-    DST_RETURN_INTEGER(args, lhs >> rhs);
+        int32_t x, y;
-}
+        x = dst_unwrap_integer(args.v[0]);
-
+        y = dst_unwrap_integer(args.v[1]);
-int dst_rshift(DstArgs args) {
+        DST_RETURN_INTEGER(args, x % y);
-    int32_t lhs, rhs;
+    } else {
-    DST_FIXARITY(args, 2);
+        double x, y;
-    DST_ARG_INTEGER(lhs, args, 0);
+        DST_ARG_NUMBER(x, args, 0);
-    DST_ARG_INTEGER(rhs, args, 1);
+        DST_ARG_NUMBER(y, args, 1);
-    DST_RETURN_INTEGER(args, lhs << rhs);
+        DST_RETURN_REAL(args, fmod(x, y));
-}
+    }
-
-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));
 }
 
 #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},
+    {"%", dst_remainder},
-    {"seedrandom", dst_srand},
-    {"int", dst_int},
-    {"real", dst_real},
-    {"+", dst_add},
-    {"-", dst_subtract},
-    {"*", dst_multiply},
-    {"/", dst_divide},
-    {"%", dst_modulo},
     {"=", 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},
+    {"int", dst_int},
-    {"sin", dst_sin},
+    {"real", dst_real},
-    {"tan", dst_tan},
+    {"math.random", dst_rand},
-    {"acos", dst_acos},
+    {"math.seedrandom", dst_srand},
-    {"asin", dst_asin},
+    {"math.cos", dst_cos},
-    {"atan", dst_atan},
+    {"math.sin", dst_sin},
-    {"exp", dst_exp},
+    {"math.tan", dst_tan},
-    {"log", dst_log},
+    {"math.acos", dst_acos},
-    {"log10", dst_log10},
+    {"math.asin", dst_asin},
-    {"sqrt", dst_sqrt},
+    {"math.atan", dst_atan},
-    {"floor", dst_floor},
+    {"math.exp", dst_exp},
-    {"ceil", dst_ceil},
+    {"math.log", dst_log},
-    {"pow", dst_pow},
+    {"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, "math.pi", dst_wrap_real(3.1415926535897931));
-    dst_env_def(env, "e", dst_wrap_real(2.7182818284590451));
+    dst_env_def(env, "math.e", dst_wrap_real(2.7182818284590451));
-    dst_env_def(env, "inf", dst_wrap_real(INFINITY));
+    dst_env_def(env, "math.inf", dst_wrap_real(INFINITY));
     return 0;
 }

src/core/vm.c

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

src/include/dst/dstcorelib.h

@@ -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_remainder(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);
 
 /* Math */
 int dst_cos(DstArgs args);

test/suite0.dst

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

test/suite1.dst

@@ -21,8 +21,8 @@
 (import test.helper :prefix "" :exit true)
 (start-suite 1)
 
-(assert (= 400.0 (sqrt 160000)) "sqrt(160000)=400")
+(assert (= 400.0 (math.sqrt 160000)) "sqrt(160000)=400")
-(assert (= (real 400) (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)