Merge branch 'master' of https://github.com/bakpakin/dst

Makefile

@@ -130,6 +130,10 @@ natives: $(DST_TARGET)
 	$(MAKE) -C natives/hello
 	$(MAKE) -j 8 -C natives/sqlite3
 
+clean-natives:
+	$(MAKE) -C natives/hello clean
+	$(MAKE) -C natives/sqlite3 clean
+
 #################
 ##### Other #####
 #################

appveyor.yml

@@ -2,6 +2,7 @@ version: 1.0.{build}
 branches:
   only:
   - master
+  - alpha
 clone_folder: c:\projects\dst
 image:
 - Visual Studio 2017

extra/metabuild.dst

@@ -0,0 +1,51 @@
+# A script to help generate build files on different platforms
+
+(def- make-cflags "-std=c99 -Wall -Wextra -O2 -shared -fpic")
+(def- make-ldflags "")
+
+(defn $
+  "Do and get the value of a subshell command"
+  [command]
+  (def f (file.popen command))
+  (def ret (file.read f :all))
+  (file.close f)
+  ret)
+
+(defn- emit-rule
+  "Emit a rule in a makefile"
+  @[out target deps recipe]
+  (default recipe "@echo '-----'")
+  (file.write
+    out 
+    target 
+    ": " 
+    (if (indexed? deps) (string.join deps " ") deps) 
+    "\n\t"
+    (if (indexed? recipe) (string.join recipe "\n\t") recipe)
+    "\n\n")
+  out)
+
+(defn generate-make
+  "Generate a makefile"
+  [out-path sources target]
+  (def out (file.open out-path :w))
+  (def csources (filter (fn [x] (= ".c" (string.slice x -2))) sources))
+  (def hsources (filter (fn [x] (= ".h" (string.slice x -2))) sources))
+  (file.write
+    out
+    "# Autogenerated Makefile, do not edit\n"
+    "# Generated at " ($ `date`)
+    "\nCFLAGS:=" make-cflags
+    "\nLDFLAGS:=" make-ldflags
+    "\nSOURCES:=" (string.join csources " ")
+    "\nHEADERS:=" (string.join hsources " ")
+    "\nOBJECTS:=$(patsubst %.c,%.o,${SOURCES})"
+    "\nTARGET:=" target ".so"
+    "\n\n")
+  (emit-rule out "all" "${TARGET}")
+  (emit-rule out "%.o" @["%.c" "${HEADERS}"] "${CC} ${CFLAGS} -o $@ $< ${LDFLAGS}")
+  (emit-rule out "${TARGET}" "${SOURCES}" "${CC} ${CFLAGS} -o $@ $^ ${LDFLAGS}")
+  (emit-rule out "clean" "" "rm ${OBJECTS}")
+  # Phony targets
+  (emit-rule out ".PHONY" @["all" "clean"])
+  nil)

natives/sqlite3/Makefile

@@ -54,4 +54,7 @@ clean:
 	rm sqlite3.h
 	rm $(TARGET)
 
+install:
+	cp $(TARGET) $(DST_PATH)
+
 .PHONY: clean all

natives/sqlite3/main.c

@@ -393,7 +393,7 @@ static const DstReg cfuns[] = {
     {NULL, NULL}
 };
 
-int _dst_init(DstArgs args) {
+DST_MODULE_ENTRY(DstArgs args) {
     DstTable *env = dst_env_arg(args);
     dst_env_cfuns(env, cfuns);
     return 0;

src/core/asm.c

@@ -24,21 +24,6 @@
 #include <dst/dst.h>
 #include "util.h"
 
-/* Convert a slot to to an integer for bytecode */
-
-/* Types of instructions (some of them) */
-/* _0arg - op.---.--.-- (return-nil, noop, vararg arguments)
- * _s - op.src.--.-- (push1)
- * _l - op.XX.XX.XX (jump)
- * _ss - op.dest.XX.XX (move, swap)
- * _sl - op.check.XX.XX (jump-if)
- * _st - op.check.TT.TT (typecheck)
- * _si - op.dest.XX.XX (load-integer)
- * _sss - op.dest.op1.op2 (add, subtract, arithmetic, comparison)
- * _ses - op.dest.up.which (load-upvalue, save-upvalue)
- * _sc - op.dest.CC.CC (load-constant, closure)
- */
-
 /* Definition for an instruction in the assembler */
 typedef struct DstInstructionDef DstInstructionDef;
 struct DstInstructionDef {
@@ -91,6 +76,7 @@ static const DstInstructionDef dst_ops[] = {
     {"eq", DOP_EQUALS},
     {"eqi", DOP_EQUALS_INTEGER},
     {"eqim", DOP_EQUALS_IMMEDIATE},
+    {"eqn", DOP_NUMERIC_EQUAL},
     {"eqr", DOP_EQUALS_REAL},
     {"err", DOP_ERROR},
     {"get", DOP_GET},
@@ -98,7 +84,9 @@ static const DstInstructionDef dst_ops[] = {
     {"gt", DOP_GREATER_THAN},
     {"gti", DOP_GREATER_THAN_INTEGER},
     {"gtim", DOP_GREATER_THAN_IMMEDIATE},
+    {"gtn", DOP_NUMERIC_GREATER_THAN},
     {"gtr", DOP_GREATER_THAN_REAL},
+    {"gten", DOP_NUMERIC_GREATER_THAN_EQUAL},
     {"gter", DOP_GREATER_THAN_EQUAL_REAL},
     {"jmp", DOP_JUMP},
     {"jmpif", DOP_JUMP_IF},
@@ -114,7 +102,9 @@ static const DstInstructionDef dst_ops[] = {
     {"lt", DOP_LESS_THAN},
     {"lti", DOP_LESS_THAN_INTEGER},
     {"ltim", DOP_LESS_THAN_IMMEDIATE},
+    {"ltn", DOP_NUMERIC_LESS_THAN},
     {"ltr", DOP_LESS_THAN_REAL},
+    {"lten", DOP_NUMERIC_LESS_THAN_EQUAL},
     {"lter", DOP_LESS_THAN_EQUAL_REAL},
     {"mkarr", DOP_MAKE_ARRAY},
     {"mkbuf", DOP_MAKE_BUFFER},
@@ -304,7 +294,7 @@ static int32_t doarg_1(
                         ret = dst_unwrap_integer(result);
                     }
                 } else {
-                    dst_asm_errorv(a, dst_formatc("unknown name %q", x));
+                    dst_asm_errorv(a, dst_formatc("unknown name %v", x));
                 }
             } else if (argtype == DST_OAT_TYPE || argtype == DST_OAT_SIMPLETYPE) {
                 const TypeAlias *alias = dst_strbinsearch(
@@ -315,7 +305,7 @@ static int32_t doarg_1(
                 if (alias) {
                     ret = alias->mask;
                 } else {
-                    dst_asm_errorv(a, dst_formatc("unknown type %q", x));
+                    dst_asm_errorv(a, dst_formatc("unknown type %v", x));
                 }
             } else {
                 goto error;
@@ -324,7 +314,7 @@ static int32_t doarg_1(
                 /* Add a new env */
                 ret = dst_asm_addenv(a, x);
                 if (ret < -1) {
-                    dst_asm_errorv(a, dst_formatc("unknown environment %q", x));
+                    dst_asm_errorv(a, dst_formatc("unknown environment %v", x));
                 }
             }
             break;
@@ -539,6 +529,9 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, Dst source, int flags) {
 
     /* Check for function name */
     a.name = dst_get(s, dst_csymbolv("name"));
+    if (!dst_checktype(a.name, DST_NIL)) {
+        def->name = dst_to_string(a.name);
+    }
 
     /* Set function arity */
     x = dst_get(s, dst_csymbolv("arity"));
@@ -683,7 +676,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, Dst source, int flags) {
                             sizeof(DstInstructionDef),
                             dst_unwrap_symbol(t[0]));
                     if (NULL == idef)
-                        dst_asm_errorv(&a, dst_formatc("unknown instruction %v", instr));
+                        dst_asm_errorv(&a, dst_formatc("unknown instruction %v", t[0]));
                     op = read_instruction(&a, idef, t);
                 }
                 def->bytecode[a.bytecode_count++] = op;
@@ -842,6 +835,9 @@ Dst dst_disasm(DstFuncDef *def) {
     if (def->flags & DST_FUNCDEF_FLAG_VARARG) {
         dst_table_put(ret, dst_csymbolv("vararg"), dst_wrap_true());
     }
+    if (NULL != def->name) {
+        dst_table_put(ret, dst_csymbolv("name"), dst_wrap_string(def->name));
+    }
 
     /* Add constants */
     if (def->constants_length > 0) {
@@ -919,7 +915,7 @@ static int cfun_asm(DstArgs args) {
     }
 }
 
-int cfun_disasm(DstArgs args) {
+static int cfun_disasm(DstArgs args) {
     DstFunction *f;
     DST_FIXARITY(args, 1);
     DST_ARG_FUNCTION(f, args, 0);

src/core/bytecode.c

@@ -102,7 +102,12 @@ enum DstInstructionType dst_instructions[DOP_INSTRUCTION_COUNT] = {
     DIT_S, /* DOP_MAKE_TUPLE */
     DIT_S, /* DOP_MAKE_STRUCT */
     DIT_S, /* DOP_MAKE_TABLE */
-    DIT_S /* DOP_MAKE_STRING */
+    DIT_S, /* DOP_MAKE_STRING */
+    DIT_SSS, /* DOP_NUMERIC_LESS_THAN */
+    DIT_SSS, /* DOP_NUMERIC_LESS_THAN_EQUAL */
+    DIT_SSS, /* DOP_NUMERIC_GREATER_THAN */
+    DIT_SSS, /* DOP_NUMERIC_GREATER_THAN_EQUAL */
+    DIT_SSS /* DOP_NUMERIC_EQUAL */
 };
 
 /* Verify some bytecode */

src/core/cfuns.c

@@ -36,6 +36,9 @@ static int fixarity1(DstFopts opts, DstSlot *args) {
 static int fixarity2(DstFopts opts, DstSlot *args) {
     (void) opts;
     return dst_v_count(args) == 2;
+}static int fixarity3(DstFopts opts, DstSlot *args) {
+    (void) opts;
+    return dst_v_count(args) == 3;
 }
 
 /* Generic hanldling for $A = op $B */
@@ -91,7 +94,8 @@ static DstSlot do_get(DstFopts opts, DstSlot *args) {
     return opreduce(opts, args, DOP_GET, dst_wrap_nil());
 }
 static DstSlot do_put(DstFopts opts, DstSlot *args) {
-    return opreduce(opts, args, DOP_PUT, dst_wrap_nil());
+    dstc_emit_sss(opts.compiler, DOP_PUT, args[0], args[1], args[2], 0);
+    return args[0];
 }
 static DstSlot do_length(DstFopts opts, DstSlot *args) {
     return genericSS(opts, DOP_LENGTH, args[0]);
@@ -118,7 +122,7 @@ static DstSlot do_apply1(DstFopts opts, DstSlot *args) {
     return target;
 }
 
-/* Varidadic operatros specialization */
+/* Varidadic operators specialization */
 
 static DstSlot do_add(DstFopts opts, DstSlot *args) {
     return opreduce(opts, args, DOP_ADD, dst_wrap_integer(0));
@@ -150,6 +154,85 @@ static DstSlot do_rshift(DstFopts opts, DstSlot *args) {
 static DstSlot do_rshiftu(DstFopts opts, DstSlot *args) {
     return opreduce(opts, args, DOP_SHIFT_RIGHT, dst_wrap_integer(1));
 }
+static DstSlot do_bnot(DstFopts opts, DstSlot *args) {
+    return genericSS(opts, DOP_BNOT, args[0]);
+}
+
+/* Specialization for comparators */
+static DstSlot compreduce(
+        DstFopts opts,
+        DstSlot *args,
+        int op,
+        int invert) {
+    DstCompiler *c = opts.compiler;
+    int32_t i, len;
+    len = dst_v_count(args);
+    int32_t *labels = NULL;
+    DstSlot t;
+    if (len < 2) {
+        return invert
+            ? dstc_cslot(dst_wrap_false())
+            : dstc_cslot(dst_wrap_true());
+    }
+    t = dstc_gettarget(opts);
+    for (i = 1; i < len; i++) {
+        dstc_emit_sss(c, op, t, args[i - 1], args[i], 1);
+        if (i != (len - 1)) {
+            int32_t label = dstc_emit_si(c, DOP_JUMP_IF_NOT, t, 0, 1);
+            dst_v_push(labels, label);
+        }
+    }
+    int32_t end = dst_v_count(c->buffer);
+    if (invert) {
+        dstc_emit_si(c, DOP_JUMP_IF, t, 3, 0);
+        dstc_emit_s(c, DOP_LOAD_TRUE, t, 1);
+        dstc_emit(c, DOP_JUMP | (2 << 8));
+        dstc_emit_s(c, DOP_LOAD_FALSE, t, 1);
+    }
+    for (i = 0; i < dst_v_count(labels); i++) {
+        int32_t label = labels[i];
+        c->buffer[label] |= ((end - label) << 16);
+    }
+    dst_v_free(labels);
+    return t;
+}
+
+static DstSlot do_order_gt(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_GREATER_THAN, 0);
+}
+static DstSlot do_order_lt(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_LESS_THAN, 0);
+}
+static DstSlot do_order_gte(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_LESS_THAN, 1);
+}
+static DstSlot do_order_lte(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_GREATER_THAN, 1);
+}
+static DstSlot do_order_eq(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_EQUALS, 0);
+}
+static DstSlot do_order_neq(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_EQUALS, 1);
+}
+static DstSlot do_gt(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_NUMERIC_GREATER_THAN, 0);
+}
+static DstSlot do_lt(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_NUMERIC_LESS_THAN, 0);
+}
+static DstSlot do_gte(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_NUMERIC_GREATER_THAN_EQUAL, 0);
+}
+static DstSlot do_lte(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_NUMERIC_LESS_THAN_EQUAL, 0);
+}
+static DstSlot do_eq(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_NUMERIC_EQUAL, 0);
+}
+static DstSlot do_neq(DstFopts opts, DstSlot *args) {
+    return compreduce(opts, args, DOP_NUMERIC_EQUAL, 1);
+}
 
 /* Arranged by tag */
 static const DstFunOptimizer optimizers[] = {
@@ -159,7 +242,7 @@ static const DstFunOptimizer optimizers[] = {
     {fixarity1, do_yield},
     {fixarity2, do_resume},
     {fixarity2, do_get},
-    {fixarity2, do_put},
+    {fixarity3, do_put},
     {fixarity1, do_length},
     {NULL, do_add},
     {NULL, do_sub},
@@ -170,14 +253,29 @@ static const DstFunOptimizer optimizers[] = {
     {NULL, do_bxor},
     {NULL, do_lshift},
     {NULL, do_rshift},
-    {NULL, do_rshiftu}
+    {NULL, do_rshiftu},
+    {fixarity1, do_bnot},
+    {NULL, do_order_gt},
+    {NULL, do_order_lt},
+    {NULL, do_order_gte},
+    {NULL, do_order_lte},
+    {NULL, do_order_eq},
+    {NULL, do_order_neq},
+    {NULL, do_gt},
+    {NULL, do_lt},
+    {NULL, do_gte},
+    {NULL, do_lte},
+    {NULL, do_eq},
+    {NULL, do_neq}
 };
 
 const DstFunOptimizer *dstc_funopt(uint32_t flags) {
     uint32_t tag = flags & DST_FUNCDEF_FLAG_TAG;
-    if (tag == 0 || tag >=
+    if (tag == 0)
-            ((sizeof(optimizers)/sizeof(uint32_t) - 1)))
         return NULL;
-    return optimizers + tag - 1;
+    uint32_t index = tag - 1;
+    if (index >= (sizeof(optimizers)/sizeof(optimizers[0])))
+        return NULL;
+    return optimizers + index;
 }
 

src/core/compile.c

@@ -118,6 +118,12 @@ void dstc_popscope(DstCompiler *c) {
     /* Move free slots to parent scope if not a new function.
      * We need to know the total number of slots used when compiling the function. */
     if (!(oldscope->flags & (DST_SCOPE_FUNCTION | DST_SCOPE_UNUSED)) && newscope) {
+        /* Parent scopes inherit child's closure flag. Needed
+         * for while loops. (if a while loop creates a closure, it
+         * is compiled to a tail recursive iife) */
+        if (oldscope->flags & DST_SCOPE_CLOSURE) {
+            newscope->flags |= DST_SCOPE_CLOSURE;
+        }
         if (newscope->ra.max < oldscope->ra.max)
             newscope->ra.max = oldscope->ra.max;
 

src/core/compile.h

@@ -45,6 +45,19 @@
 #define DST_FUN_LSHIFT 16
 #define DST_FUN_RSHIFT 17
 #define DST_FUN_RSHIFTU 18
+#define DST_FUN_BNOT 19
+#define DST_FUN_ORDER_GT 20
+#define DST_FUN_ORDER_LT 21
+#define DST_FUN_ORDER_GTE 22
+#define DST_FUN_ORDER_LTE 23 
+#define DST_FUN_ORDER_EQ 24 
+#define DST_FUN_ORDER_NEQ 25
+#define DST_FUN_GT 26  
+#define DST_FUN_LT 27   
+#define DST_FUN_GTE 28 
+#define DST_FUN_LTE 29  
+#define DST_FUN_EQ 30   
+#define DST_FUN_NEQ 31
 
 /* Compiler typedefs */
 typedef struct DstCompiler DstCompiler;
@@ -67,22 +80,23 @@ typedef struct DstSpecial DstSpecial;
 
 /* A stack slot */
 struct DstSlot {
+    Dst constant; /* If the slot has a constant value */
     int32_t index;
     int32_t envindex; /* 0 is local, positive number is an upvalue */
     uint32_t flags;
-    Dst constant; /* If the slot has a constant value */
 };
 
 #define DST_SCOPE_FUNCTION 1
 #define DST_SCOPE_ENV 2
 #define DST_SCOPE_TOP 4
 #define DST_SCOPE_UNUSED 8
+#define DST_SCOPE_CLOSURE 16
 
 /* A symbol and slot pair */
 typedef struct SymPair {
+    DstSlot slot;
     const uint8_t *sym;
     int keep;
-    DstSlot slot;
 } SymPair;
 
 /* A lexical scope during compilation */
@@ -101,12 +115,12 @@ struct DstScope {
     /* Map of symbols to slots. Use a simple linear scan for symbols. */
     SymPair *syms;
 
-    /* Regsiter allocator */
-    DstcRegisterAllocator ra;
-
     /* FuncDefs */
     DstFuncDef **defs;
 
+    /* Regsiter allocator */
+    DstcRegisterAllocator ra;
+
     /* Referenced closure environents. The values at each index correspond
      * to which index to get the environment from in the parent. The environment
      * that corresponds to the direct parent's stack will always have value 0. */
@@ -121,7 +135,6 @@ struct DstScope {
 
 /* Compilation state */
 struct DstCompiler {
-    int recursion_guard;
     
     /* Pointer to current scope */
     DstScope *scope;
@@ -129,16 +142,20 @@ struct DstCompiler {
     uint32_t *buffer;
     DstSourceMapping *mapbuffer;
 
-    /* Keep track of where we are in the source */
-    DstSourceMapping current_mapping;
-
     /* Hold the environment */
     DstTable *env;
 
     /* Name of source to attach to generated functions */
     const uint8_t *source;
 
+    /* The result of compilation */
     DstCompileResult result;
+
+    /* Keep track of where we are in the source */
+    DstSourceMapping current_mapping;
+
+    /* Prevent unbounded recursion */
+    int recursion_guard;
 };
 
 #define DST_FOPTS_TAIL 0x10000
@@ -148,8 +165,8 @@ struct DstCompiler {
 /* Options for compiling a single form */
 struct DstFopts {
     DstCompiler *compiler;
-    uint32_t flags; /* bit set of accepted primitive types */
     DstSlot hint;
+    uint32_t flags; /* bit set of accepted primitive types */
 };
 
 /* Get the default form options */

src/core/core.dst

@@ -48,9 +48,29 @@
   [name & more]
   (apply1 tuple (array.concat @['def name :private] more)))
 
+(defmacro defasm
+  "Define a function using assembly"
+  [name & body]
+  (def tab (apply1 table body))
+  (tuple 'def name (tuple asm (tuple 'quote tab))))
+
+(defn defglobal
+  "Dynamically create a global def."
+  [name value]
+  (def name* (symbol name))
+  (put *env* name* @{:value value})
+  nil)
+
+(defn varglobal
+  "Dynamically create a global var."
+  [name init]
+  (def name* (symbol name))
+  (put *env* name* @{:ref @[init]})
+  nil)
+
 # Basic predicates
 (defn even? [x] (== 0 (% x 2)))
-(defn odd? [x] (== 1 (% x 2)))
+(defn odd? [x] (not= 0 (% x 2)))
 (defn zero? [x] (== x 0))
 (defn pos? [x] (> x 0))
 (defn neg? [x] (< x 0))
@@ -96,8 +116,6 @@
        :table true
        :struct true})
     (fn [x] (not (get non-atomic-types (type x))))))
-(defn sum [xs] (apply1 + xs))
-(defn product [xs] (apply1 * xs))
 
 # C style macros and functions for imperative sugar
 (defn inc [x] (+ x 1))
@@ -214,88 +232,6 @@
   (array.concat accum body)
   (apply1 tuple accum))
 
-(defmacro loop
-  "A general purpose loop macro."
-  [head & body]
-  (def len (length head))
-  (defn doone
-    [i preds]
-    (default preds @['and])
-    (if (>= i len)
-      (tuple.prepend body 'do)
-      (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)))
-            :when (tuple 'if verb (doone (+ i 2)))
-            (error ("unexpected loop predicate: " verb)))
-          (case verb
-            :iterate (do
-                       (def preds @['and (tuple ':= bindings object)])
-                       (def subloop (doone (+ i 3) preds))
-                       (tuple 'do
-                              (tuple 'var bindings nil)
-                              (tuple 'while (apply1 tuple preds)
-                                     subloop)))
-            :range (do
-                     (def [start end _inc] object)
-                     (def inc (if _inc _inc 1))
-                     (def endsym (gensym))
-                     (def preds @['and (tuple < bindings endsym)])
-                     (def subloop (doone (+ i 3) preds))
-                     (tuple 'do
-                            (tuple 'var bindings start)
-                            (tuple 'def endsym end)
-                            (tuple 'while (apply1 tuple preds)
-                                   subloop
-                                   (tuple ':= bindings (tuple + bindings inc)))))
-            :keys (do
-                    (def $dict (gensym))
-                    (def preds @['and (tuple not= nil bindings)])
-                    (def subloop (doone (+ i 3) preds))
-                    (tuple 'do
-                           (tuple 'def $dict object)
-                           (tuple 'var bindings (tuple next $dict nil))
-                           (tuple 'while (apply1 tuple preds)
-                                  subloop
-                                  (tuple ':= bindings (tuple next $dict bindings)))))
-            :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 (apply1 tuple preds)
-                                (tuple 'def bindings (tuple get $indexed $i))
-                                subloop
-                                (tuple ':= $i (tuple + 1 $i)))))
-            (error ("unexpected loop verb: " verb)))))))
-  (doone 0))
-
-(defmacro for
-  "Similar to loop, but accumulates the loop body into an array and returns that."
-  [head & body]
-  (def $accum (gensym))
-  (tuple 'do
-         (tuple 'def $accum @[])
-         (tuple 'loop head
-                (tuple array.push $accum
-                       (tuple.prepend body 'do)))
-         $accum))
-
 (defmacro and
   "Evaluates to the last argument if all preceding elements are true, otherwise
   evaluates to false."
@@ -327,16 +263,114 @@
                (tuple 'do (tuple 'def $fi fi)
                       (tuple 'if $fi $fi (aux (inc i))))))))) 0)))
 
+(defmacro loop
+  "A general purpose loop macro."
+  [head & body]
+  (def len (length head))
+  (defn doone
+    @[i preds]
+    (default preds @['and])
+    (if (>= i len)
+      (tuple.prepend body 'do)
+      (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)))
+            :when (tuple 'if verb (doone (+ i 2)))
+            (error ("unexpected loop predicate: " verb)))
+          (case verb
+            :iterate (do
+                       (def $iter (gensym))
+                       (def preds @['and (tuple ':= $iter object)])
+                       (def subloop (doone (+ i 3) preds))
+                       (tuple 'do
+                              (tuple 'var $iter nil)
+                              (tuple 'while (apply1 tuple 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 (apply1 tuple preds)
+                                   (tuple 'def bindings $iter)
+                                   subloop
+                                   (tuple ':= $iter (tuple + $iter inc)))))
+            :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 (apply1 tuple preds)
+                                  (tuple 'def bindings $iter)
+                                  subloop
+                                  (tuple ':= $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 (apply1 tuple preds)
+                                (tuple 'def bindings (tuple get $indexed $i))
+                                subloop
+                                (tuple ':= $i (tuple + 1 $i)))))
+            (error (string "unexpected loop verb: " verb)))))))
+  (doone 0 nil))
+
+(defmacro for
+  "Similar to loop, but accumulates the loop body into an array and returns that."
+  [head & body]
+  (def $accum (gensym))
+  (tuple 'do
+         (tuple 'def $accum @[])
+         (tuple 'loop head
+                (tuple array.push $accum
+                       (tuple.prepend body 'do)))
+         $accum))
+
+(defn sum [xs]
+  (var accum 0)
+  (loop [x :in xs] (+= accum x))
+  accum)
+
+(defn product [xs]
+  (var accum 1)
+  (loop [x :in xs] (*= accum x))
+  accum)
+
 (defmacro coro
   "A wrapper for making fibers. Same as (fiber (fn [] ...body))."
   [& body]
-  (tuple fiber.new (apply tuple 'fn [] body)))
+  (tuple fiber.new (apply tuple 'fn @[] body)))
 
 (defmacro if-let
   "Takes the first one or two forms in a vector and if both are true binds
   all the forms with let and evaluates the first expression else
   evaluates the second"
-  [bindings tru fal]
+  @[bindings tru fal]
   (def len (length bindings))
   (if (zero? len) (error "expected at least 1 binding"))
   (if (odd? len) (error "expected an even number of bindings"))
@@ -443,12 +477,12 @@
         (sort-help a (+ piv 1) hi by))
       a)
 
-    (fn [a by]
+    (fn @[a by]
       (sort-help a 0 (- (length a) 1) (or by order<)))))
 
 (defn sorted
   "Returns the sorted version of an indexed data structure."
-  [ind by]
+  @[ind by]
   (def sa (sort (apply1 array ind) by))
   (if (= :tuple (type ind))
     (apply1 tuple sa)
@@ -457,7 +491,7 @@
 (defn reduce
   "Reduce, also know as fold-left in many languages, transforms
   an indexed type (array, tuple) with a function to produce a value."
-  [f init ind]
+  @[f init ind]
   (var res init)
   (loop [x :in ind]
     (:= res (f res x)))
@@ -476,14 +510,14 @@
   (def [i1 i2 i3 i4] inds)
   (def res (array.new limit))
   (case ninds
-    1 (loop [i :range [0 limit]] (array.push res (f (get i1 i))))
+    1 (loop [i :range [0 limit]] (put res i (f (get i1 i))))
-    2 (loop [i :range [0 limit]] (array.push res (f (get i1 i) (get i2 i))))
+    2 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i))))
-    3 (loop [i :range [0 limit]] (array.push res (f (get i1 i) (get i2 i) (get i3 i))))
+    3 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i) (get i3 i))))
-    4 (loop [i :range [0 limit]] (array.push res (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
+    4 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
     (loop [i :range [0 limit]]
       (def args (array.new ninds))
-          (loop [j :range [0 ninds]] (array.push args (get (get inds j) i)))
+      (loop [j :range [0 ninds]] (put args j (get (get inds j) i)))
-          (array.push res (apply1 f args))))
+      (put res i (apply1 f args))))
   res)
 
 (defn each
@@ -511,7 +545,7 @@
   "Map a function over every element in an array or tuple and
   use array to concatenate the results. Returns the same
   type as the input sequence."
-  [f ind t]
+  @[f ind t]
   (def res @[])
   (loop [x :in ind]
     (array.concat res (f x)))
@@ -522,7 +556,7 @@
 (defn filter
   "Given a predicate, take only elements from an array or tuple for
   which (pred element) is truthy. Returns the same type as the input sequence."
-  [pred ind t]
+  @[pred ind t]
   (def res @[])
   (loop [item :in ind]
     (if (pred item)
@@ -533,10 +567,19 @@
 
 (defn range
   "Create an array of values [0, n)."
-  [n]
+  [& args]
+  (case (length args)
+    1 (do
+        (def [n] args)
         (def arr (array.new n))
         (loop [i :range [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))
+        arr)
+    (error "expected 1 to 2 arguments to range")))
 
 (defn find-index
   "Find the index of indexed type for which pred is true. Returns nil if not found."
@@ -630,12 +673,12 @@
   (if (zero? (length more)) f
     (fn [& r] (apply1 f (array.concat @[] more r)))))
 
-(defn every? [pred seq]
+(defn every? [pred ind]
   (var res true)
   (var i 0)
-  (def len (length seq))
+  (def len (length ind))
   (while (< i len)
-    (def item (get seq i))
+    (def item (get ind i))
     (if (pred item)
       (++ i)
       (do (:= res false) (:= i len))))
@@ -666,7 +709,7 @@
 (defn zipcoll
   "Creates an table or tuple from two arrays/tuples. If a third argument of
   :struct is given result is struct else is table."
-  [keys vals t]
+  @[keys vals t]
   (def res @{})
   (def lk (length keys))
   (def lv (length vals))
@@ -866,16 +909,15 @@
     (def args (map macroexpand-1 (tuple.slice t 2)))
     (apply tuple 'fn (get t 1) args))
 
-  (def specs {
+  (def specs
-              ':= expanddef
+    {':= expanddef
      'def expanddef
      'do expandall
      'fn expandfn
      'if expandall
      'quote identity
      'var expanddef
-              'while expandall
+     'while expandall})
-              })
 
   (defn dotup [t]
     (def h (get t 0))
@@ -888,7 +930,8 @@
       m? (apply1 m (tuple.slice t 1))
       (apply1 tuple (map macroexpand-1 t))))
 
-  (def ret (case (type x)
+  (def ret
+    (case (type x)
       :tuple (dotup x)
       :array (map macroexpand-1 x)
       :struct (table.to-struct (dotable x macroexpand-1))
@@ -944,7 +987,8 @@
 ###
 ###
 
-(defn make-env [parent]
+(defn make-env 
+  @[parent]
   (def parent (if parent parent _env))
   (def newenv (table.setproto @{} parent))
   (put newenv '_env @{:value newenv :private true})
@@ -962,7 +1006,7 @@
   This function can be used to implement a repl very easily, simply
   pass a function that reads line from stdin to chunks, and print to
   onvalue."
-  [env chunks onvalue onerr where]
+  @[env chunks onvalue onerr where]
 
   # Are we done yet?
   (var going true)
@@ -1004,7 +1048,7 @@
     (var good true)
     (def f
       (fiber.new
-        (fn []
+        (fn @[]
           (def res (compile source env where))
           (if (= (type res) :function)
             (res)
@@ -1045,16 +1089,14 @@
   (when f
     (def st (fiber.stack f))
     (loop
-      [{
+      [{:function func
-        :function func
         :tail tail
         :pc pc
         :c c
         :name name
         :source source
         :line source-line
-        :column source-col
+        :column source-col} :in st]
-        } :in st]
       (file.write stdout "  in")
       (when c (file.write stdout " cfunction"))
       (if name
@@ -1080,7 +1122,7 @@
   environment is needed, use run-context."
   [str]
   (var state (string str))
-  (defn chunks [buf]
+  (defn chunks [buf _]
     (def ret state)
     (:= state nil)
     (if ret
@@ -1089,21 +1131,26 @@
   (run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler "eval")
   returnval)
 
-(def module.paths
+(do
+  (def syspath (or (os.getenv "DST_PATH") "/usr/local/lib/dst/"))
+  (defglobal 'module.paths
     @["./?.dst"
       "./?/init.dst"
       "./dst_modules/?.dst"
       "./dst_modules/?/init.dst"
-    "/usr/local/dst/0.0.0/?.dst"
+      (string syspath VERSION "/?.dst")
-    "/usr/local/dst/0.0.0/?/init.dst"])
+      (string syspath VERSION "/?/init.dst")
-
+      (string syspath "/?.dst")
-(def module.native-paths
+      (string syspath "/?/init.dst")])
+  (defglobal 'module.native-paths
     @["./?.so"
       "./?/??.so"
       "./dst_modules/?.so"
       "./dst_modules/?/??.so"
-    "/usr/local/dst/0.0.0/?.so"
+      (string syspath VERSION "/?.so")
-    "/usr/local/dst/0.0.0/?/??.so"])
+      (string syspath VERSION "/?/??.so")
+      (string syspath "/?.so")
+      (string syspath "/?/??.so")]))
 
 (defn module.find
   [path paths]
@@ -1145,7 +1192,7 @@
 
     (def cache @{})
     (def loading @{})
-    (fn require [path args]
+    (fn require @[path args]
       (when (get loading path)
         (error (string "circular dependency: module " path " is loading")))
       (def {:exit exit-on-error} (or args {}))
@@ -1160,21 +1207,21 @@
           (if f
             (do
               # Normal dst module
-              (defn chunks [buf] (file.read f 1024 buf))
+              (defn chunks [buf _] (file.read f 1024 buf))
               (run-context newenv chunks identity
                            (if exit-on-error
-                             (fn [a b c d] (default-error-handler a b c d) (os.exit 1))
+                             (fn @[a b c d] (default-error-handler a b c d) (os.exit 1))
                              default-error-handler)
                            path)
-              (file.close f)
+              (file.close f))
-              (put loading path nil)
-              newenv)
             (do
               # Try native module
               (def n (find-native path))
               (if (not n)
                 (error (string "could not open file for module " path)))
-              ((native n)))))))))
+              ((native n) newenv)))
+          (put loading path false)
+          newenv)))))
 
 (defn import* [env path & args]
   (def targs (apply1 table args))
@@ -1193,11 +1240,12 @@
       (put env (symbol prefix k) newv))
     (:= k (next newenv k))))
 
-(defmacro import [path & args]
+(defmacro import
   "Import a module. First requires the module, and then merges its
   symbols into the current environment, prepending a given prefix as needed.
   (use the :as or :prefix option to set a prefix). If no prefix is provided,
   use the name of the module as a prefix."
+  [path & args]
   (def argm (map (fn [x]
                    (if (and (symbol? x) (= (get x 0) 58))
                      x
@@ -1205,9 +1253,10 @@
                  args))
   (apply tuple import* '_env (string path) argm))
 
-(defn repl [getchunk onvalue onerr]
+(defn repl
   "Run a repl. The first parameter is an optional function to call to
   get a chunk of source code. Should return nil for end of file."
+  @[getchunk onvalue onerr]
   (def newenv (make-env))
   (default getchunk (fn [buf]
                       (file.read stdin :line buf)))
@@ -1219,7 +1268,7 @@
 
 (defn all-symbols
   "Get all symbols available in the current environment."
-  [env]
+  @[env]
   (default env *env*)
   (def envs @[])
   (do (var e env) (while e (array.push envs e) (:= e (table.getproto e))))

src/core/corelib.c

@@ -256,10 +256,11 @@ static int dst_core_gcinterval(DstArgs args) {
 
 static int dst_core_type(DstArgs args) {
     DST_FIXARITY(args, 1);
-    if (dst_checktype(args.v[0], DST_ABSTRACT)) {
+    DstType t = dst_type(args.v[0]);
+    if (t == DST_ABSTRACT) {
         DST_RETURN(args, dst_csymbolv(dst_abstract_type(dst_unwrap_abstract(args.v[0]))->name));
     } else {
-        DST_RETURN(args, dst_csymbolv(dst_type_names[dst_type(args.v[0])]));
+        DST_RETURN(args, dst_csymbolv(dst_type_names[t]));
     }
 }
 
@@ -282,9 +283,8 @@ static int dst_core_next(DstArgs args) {
             : dst_struct_find(st, args.v[1]);
         kv = dst_struct_next(st, kv);
     }
-    if (kv) {
+    if (kv)
         DST_RETURN(args, kv->key);
-    }
     DST_RETURN_NIL(args);
 }
 
@@ -344,57 +344,11 @@ static void dst_quick_asm(
 }
 
 /* Macros for easier inline dst assembly */
-#define SSS(op, a, b, c) (op | (a << 8) | (b << 16) | (c << 24))
+#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
-#define SS(op, a, b) (op | (a << 8) | (b << 16))
+#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
-#define SSI(op, a, b, I) (op | (a << 8) | (b << 16) | ((uint32_t)(I) << 24))
+#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
-#define S(op, a) (op | (a << 8))
+#define S(op, a) ((op) | ((a) << 8))
-#define SI(op, a, I) (op | (a << 8) | ((uint32_t)(I) << 16))
+#define SI(op, a, I) ((op) | ((a) << 8) | ((uint32_t)(I) << 16))
-
-/* 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[] = {
-    SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
-
-    /* Check nullary */
-    SSS(DOP_EQUALS_IMMEDIATE, 2, 1, 0), /* Check if numargs equal to 0 */
-    SI(DOP_JUMP_IF_NOT, 2, 3), /* If not 0, jump to next check */
-    /* Nullary */
-    SI(DOP_LOAD_INTEGER, 3, 0),  /* accum = nullary value */
-    S(DOP_RETURN, 3), /* return accum */
-
-    /* Check unary */
-    SSI(DOP_EQUALS_IMMEDIATE, 2, 1, 1), /* Check if numargs equal to 1 */
-    SI(DOP_JUMP_IF_NOT, 2, 5), /* If not 1, jump to next check */
-    /* Unary */
-    S(DOP_LOAD_INTEGER, 3), /* accum = unary value */
-    SSI(DOP_GET_INDEX, 4, 0, 0), /* operand = args[0] */
-    SSS(DOP_NOOP, 3, 3, 4), /* accum = accum op operand */
-    S(DOP_RETURN, 3), /* return accum */
-
-    /* Mutli (2 or more) arity */
-    /* Prime loop */
-    SSI(DOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
-    SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
-    /* Main loop */
-    SSS(DOP_GET, 4, 0, 5), /* operand = args[i] */
-    SSS(DOP_NOOP, 3, 3, 4), /* accum = accum op operand */
-    SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
-    SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
-    SI(DOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
-
-    /* Done, do last and return accumulator */
-    S(DOP_RETURN, 3) /* 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(
@@ -404,10 +358,48 @@ static void templatize_varop(
         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);
+    /* Variadic operator assembly. Must be templatized for each different opcode. */
-    varop_asm[VAROP_OP_LOC1] = SSS(op, 3, 3, 4);
+    /* Reg 0: Argument tuple (args) */
-    varop_asm[VAROP_OP_LOC2] = SSS(op, 3, 3, 4);
+    /* Reg 1: Argument count (argn) */
+    /* Reg 2: Jump flag (jump?) */
+    /* Reg 3: Accumulator (accum) */
+    /* Reg 4: Next operand (operand) */
+    /* Reg 5: Loop iterator (i) */
+    uint32_t varop_asm[] = {
+        SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
+
+        /* Check nullary */
+        SSS(DOP_EQUALS_IMMEDIATE, 2, 1, 0), /* Check if numargs equal to 0 */
+        SI(DOP_JUMP_IF_NOT, 2, 3), /* If not 0, jump to next check */
+        /* Nullary */
+        SI(DOP_LOAD_INTEGER, 3, nullary),  /* accum = nullary value */
+        S(DOP_RETURN, 3), /* return accum */
+
+        /* Check unary */
+        SSI(DOP_EQUALS_IMMEDIATE, 2, 1, 1), /* Check if numargs equal to 1 */
+        SI(DOP_JUMP_IF_NOT, 2, 5), /* If not 1, jump to next check */
+        /* Unary */
+        SI(DOP_LOAD_INTEGER, 3, unary), /* accum = unary value */
+        SSI(DOP_GET_INDEX, 4, 0, 0), /* operand = args[0] */
+        SSS(op, 3, 3, 4), /* accum = accum op operand */
+        S(DOP_RETURN, 3), /* return accum */
+
+        /* Mutli (2 or more) arity */
+        /* Prime loop */
+        SSI(DOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
+        SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
+        /* Main loop */
+        SSS(DOP_GET, 4, 0, 5), /* operand = args[i] */
+        SSS(op, 3, 3, 4), /* accum = accum op operand */
+        SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
+        SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
+        SI(DOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
+
+        /* Done, do last and return accumulator */
+        S(DOP_RETURN, 3) /* return accum */
+    };
+
     dst_quick_asm(
             env,
             flags | DST_FUNCDEF_FLAG_VARARG,
@@ -418,38 +410,93 @@ static void templatize_varop(
             sizeof(varop_asm));
 }
 
-DstTable *dst_stl_env(int flags) {
+/* Templatize variadic comparators */
-    static uint32_t error_asm[] = {
+static void templatize_comparator(
+        DstTable *env,
+        int32_t flags,
+        const char *name,
+        int invert,
+        uint32_t op) {
+
+    /* Reg 0: Argument tuple (args) */
+    /* Reg 1: Argument count (argn) */
+    /* Reg 2: Jump flag (jump?) */
+    /* Reg 3: Last value (last) */
+    /* Reg 4: Next operand (next) */
+    /* Reg 5: Loop iterator (i) */
+    uint32_t comparator_asm[] = {
+        SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
+        SSS(DOP_LESS_THAN_IMMEDIATE, 2, 1, 2), /* Check if numargs less than 2 */
+        SI(DOP_JUMP_IF, 2, 10), /* If numargs < 2, jump to done */
+
+        /* Prime loop */
+        SSI(DOP_GET_INDEX, 3, 0, 0), /* last = args[0] */
+        SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
+
+        /* Main loop */
+        SSS(DOP_GET, 4, 0, 5), /* next = args[i] */
+        SSS(op, 2, 3, 4), /* jump? = last compare next */
+        SI(DOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */
+        SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
+        SS(DOP_MOVE_NEAR, 3, 4), /* last = next */
+        SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
+        SI(DOP_JUMP_IF_NOT, 2, -6), /* if not jump? go back 6 */
+
+        /* Done, return true */
+        S(invert ? DOP_LOAD_FALSE : DOP_LOAD_TRUE, 3),
+        S(DOP_RETURN, 3),
+
+        /* Failed, return false */
+        S(invert ? DOP_LOAD_TRUE : DOP_LOAD_FALSE, 3),
+        S(DOP_RETURN, 3)
+    };
+
+    dst_quick_asm(
+            env,
+            flags | DST_FUNCDEF_FLAG_VARARG,
+            name,
+            0,
+            6,
+            comparator_asm,
+            sizeof(comparator_asm));
+}
+
+DstTable *dst_core_env(void) {
+    static const uint32_t error_asm[] = {
         DOP_ERROR
     };
-    static uint32_t apply_asm[] = {
+    static const uint32_t apply_asm[] = {
        DOP_PUSH_ARRAY | (1 << 8),
        DOP_TAILCALL
     };
-    static uint32_t debug_asm[] = {
+    static const uint32_t debug_asm[] = {
        DOP_SIGNAL | (2 << 24),
        DOP_RETURN_NIL
     };
-    static uint32_t yield_asm[] = {
+    static const uint32_t yield_asm[] = {
         DOP_SIGNAL | (3 << 24),
         DOP_RETURN
     };
-    static uint32_t resume_asm[] = {
+    static const uint32_t resume_asm[] = {
         DOP_RESUME | (1 << 24),
         DOP_RETURN
     };
-    static uint32_t get_asm[] = {
+    static const uint32_t get_asm[] = {
         DOP_GET | (1 << 24),
         DOP_RETURN
     };
-    static uint32_t put_asm[] = {
+    static const uint32_t put_asm[] = {
         DOP_PUT | (1 << 16) | (2 << 24),
         DOP_RETURN
     };
-    static uint32_t length_asm[] = {
+    static const uint32_t length_asm[] = {
         DOP_LENGTH,
         DOP_RETURN
     };
+    static const uint32_t bnot_asm[] = {
+        DOP_BNOT,
+        DOP_RETURN
+    };
 
     DstTable *env = dst_table(0);
     Dst ret = dst_wrap_table(env);
@@ -465,6 +512,7 @@ DstTable *dst_stl_env(int flags) {
     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));
 
     /* Variadic ops */
     templatize_varop(env, DST_FUN_ADD, "+", 0, 0, DOP_ADD);
@@ -478,6 +526,20 @@ DstTable *dst_stl_env(int flags) {
     templatize_varop(env, DST_FUN_RSHIFT, ">>", 1, 1, DOP_SHIFT_RIGHT);
     templatize_varop(env, DST_FUN_RSHIFTU, ">>>", 1, 1, DOP_SHIFT_RIGHT_UNSIGNED);
 
+    /* Variadic comparators */
+    templatize_comparator(env, DST_FUN_ORDER_GT, "order>", 0, DOP_GREATER_THAN);
+    templatize_comparator(env, DST_FUN_ORDER_LT, "order<", 0, DOP_LESS_THAN);
+    templatize_comparator(env, DST_FUN_ORDER_GTE, "order>=", 1, DOP_LESS_THAN);
+    templatize_comparator(env, DST_FUN_ORDER_LTE, "order<=", 1, DOP_GREATER_THAN);
+    templatize_comparator(env, DST_FUN_ORDER_EQ, "=", 0, DOP_EQUALS);
+    templatize_comparator(env, DST_FUN_ORDER_NEQ, "not=", 1, DOP_EQUALS);
+    templatize_comparator(env, DST_FUN_GT, ">", 0, DOP_NUMERIC_GREATER_THAN);
+    templatize_comparator(env, DST_FUN_LT, "<", 0, DOP_NUMERIC_LESS_THAN);
+    templatize_comparator(env, DST_FUN_GTE, ">=", 0, DOP_NUMERIC_GREATER_THAN_EQUAL);
+    templatize_comparator(env, DST_FUN_LTE, "<=", 0, DOP_NUMERIC_LESS_THAN_EQUAL);
+    templatize_comparator(env, DST_FUN_EQ, "==", 0, DOP_NUMERIC_EQUAL);
+    templatize_comparator(env, DST_FUN_NEQ, "not==", 1, DOP_NUMERIC_EQUAL);
+
     dst_env_def(env, "VERSION", dst_cstringv(DST_VERSION));
 
     /* Set as gc root */
@@ -510,8 +572,5 @@ DstTable *dst_stl_env(int flags) {
     /* Run bootstrap source */
     dst_dobytes(env, dst_gen_core, sizeof(dst_gen_core), "core.dst");
 
-    if (flags & DST_STL_NOGCROOT)
-        dst_gcunroot(dst_wrap_table(env));
-
     return env;
 }

src/core/fiber.c

@@ -107,7 +107,7 @@ void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n) {
 }
 
 /* Push a stack frame to a fiber */
-void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
+int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
     DstStackFrame *newframe;
 
     int32_t i;
@@ -116,6 +116,13 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
     int32_t nextframe = fiber->stackstart;
     int32_t nextstacktop = nextframe + func->def->slotcount + DST_FRAME_SIZE;
 
+    /* Check strict arity */
+    if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
+        if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
+            return 1;
+        }
+    }
+
     if (fiber->capacity < nextstacktop) {
         dst_fiber_setcapacity(fiber, 2 * nextstacktop);
     }
@@ -146,6 +153,9 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
                 oldtop - tuplehead));
         }
     }
+
+    /* Good return */
+    return 0;
 }
 
 /* If a frame has a closure environment, detach it from
@@ -165,12 +175,19 @@ static void dst_env_detach(DstFuncEnv *env) {
 }
 
 /* Create a tail frame for a function */
-void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
+int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
     int32_t i;
     int32_t nextframetop = fiber->frame + func->def->slotcount;
     int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
     int32_t stacksize;
 
+    /* Check strict arity */
+    if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
+        if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
+            return 1;
+        }
+    }
+
     if (fiber->capacity < nextstacktop) {
         dst_fiber_setcapacity(fiber, 2 * nextstacktop);
     }
@@ -213,6 +230,9 @@ void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
     dst_fiber_frame(fiber)->func = func;
     dst_fiber_frame(fiber)->pc = func->def->bytecode;
     dst_fiber_frame(fiber)->flags |= DST_STACKFRAME_TAILCALL;
+
+    /* Good return */
+    return 0;
 }
 
 /* Push a stack frame to a fiber for a c function */
@@ -263,6 +283,11 @@ static int cfun_new(DstArgs args) {
     DST_MINARITY(args, 1);
     DST_MAXARITY(args, 2);
     DST_ARG_FUNCTION(func, args, 0);
+    if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
+        if (func->def->arity != 1) {
+            DST_THROW(args, "expected unit arity function in fiber constructor");
+        }
+    }
     fiber = dst_fiber(func, 64);
     if (args.n == 2) {
         const uint8_t *flags;

src/core/fiber.h

@@ -40,8 +40,8 @@ void dst_fiber_push(DstFiber *fiber, Dst x);
 void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y);
 void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z);
 void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n);
-void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
+int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
-void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
+int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
 void dst_fiber_cframe(DstFiber *fiber, DstCFunction cfun);
 void dst_fiber_popframe(DstFiber *fiber);
 

src/core/gc.c

@@ -339,6 +339,24 @@ void dst_gcroot(Dst root) {
     dst_vm_root_count = newcount;
 }
 
+/* Identity equality for GC purposes */
+static int dst_gc_idequals(Dst lhs, Dst rhs) {
+    if (dst_type(lhs) != dst_type(rhs))
+        return 0;
+    switch (dst_type(lhs)) {
+        case DST_TRUE:
+        case DST_FALSE:
+        case DST_NIL:
+            return 1;
+        case DST_INTEGER:
+            return dst_unwrap_integer(lhs) == dst_unwrap_integer(rhs);
+        case DST_REAL:
+            return dst_unwrap_real(lhs) == dst_unwrap_real(rhs);
+        default:
+            return dst_unwrap_pointer(lhs) == dst_unwrap_pointer(rhs);
+    }
+}
+
 /* Remove a root value from the GC. This allows the gc to potentially reclaim
  * a value and all its children. */
 int dst_gcunroot(Dst root) {
@@ -346,7 +364,7 @@ int dst_gcunroot(Dst root) {
     Dst *v = dst_vm_roots;
     /* Search from top to bottom as access is most likely LIFO */
     for (v = dst_vm_roots; v < vtop; v++) {
-        if (dst_equals(root, *v)) {
+        if (dst_gc_idequals(root, *v)) {
             *v = dst_vm_roots[--dst_vm_root_count];
             return 1;
         }
@@ -361,7 +379,7 @@ int dst_gcunrootall(Dst root) {
     int ret = 0;
     /* Search from top to bottom as access is most likely LIFO */
     for (v = dst_vm_roots; v < vtop; v++) {
-        if (dst_equals(root, *v)) {
+        if (dst_gc_idequals(root, *v)) {
             *v = dst_vm_roots[--dst_vm_root_count];
             vtop--;
             ret = 1;

src/core/io.c

@@ -154,10 +154,9 @@ static int dst_io_popen(DstArgs args) {
     }
     flags = (fmode[0] == 'r') ? IO_PIPED | IO_READ : IO_PIPED | IO_WRITE;
 #ifdef DST_WINDOWS
-    f = _popen((const char *)fname, (const char *)fmode);
+#define popen _popen
-#else
-    f = popen((const char *)fname, (const char *)fmode);
 #endif
+    f = popen((const char *)fname, (const char *)fmode);
     if (!f) {
         if (errno == EMFILE) {
             DST_THROW(args, "too many streams are open");
@@ -317,10 +316,9 @@ static int dst_io_fclose(DstArgs args) {
         DST_THROW(args, "file not closable");
     if (iof->flags & IO_PIPED) {
 #ifdef DST_WINDOWS
-        if (_pclose(iof->file)) DST_THROW(args, "could not close file");
+#define pclose _pclose
-#else
-        if (pclose(iof->file)) DST_THROW(args, "could not close file");
 #endif
+        if (pclose(iof->file)) DST_THROW(args, "could not close file");
     } else {
         if (fclose(iof->file)) DST_THROW(args, "could not close file");
     }

src/core/math.c

@@ -71,19 +71,6 @@ int dst_real(DstArgs args) {
     return 0;
 }
 
-int dst_bnot(DstArgs args) {
-    if (args.n != 1) {
-        *args.ret = dst_cstringv("expected 1 argument");
-        return 1;
-    }
-    if (!dst_checktype(args.v[0], DST_INTEGER)) {
-        *args.ret = dst_cstringv("expected integer");
-        return 1;
-    }
-    *args.ret = dst_wrap_integer(~dst_unwrap_integer(args.v[0]));
-    return 0;
-}
-
 int dst_remainder(DstArgs args) {
     DST_FIXARITY(args, 2);
     if (dst_checktype(args.v[0], DST_INTEGER) &&
@@ -137,85 +124,13 @@ int dst_##name(DstArgs args) {\
 DST_DEFINE_MATH2OP(atan2, atan2)
 DST_DEFINE_MATH2OP(pow, pow)
 
-/* Comparison */
-#define DST_DEFINE_COMPARATOR(name, pred)\
-static int dst_##name(DstArgs args) {\
-    int32_t i;\
-    for (i = 0; i < args.n - 1; i++) {\
-        if (dst_compare(args.v[i], args.v[i+1]) pred) {\
-            DST_RETURN_FALSE(args);\
-        }\
-    }\
-    DST_RETURN_TRUE(args);\
-}
-
-DST_DEFINE_COMPARATOR(ascending, >= 0)
-DST_DEFINE_COMPARATOR(descending, <= 0)
-DST_DEFINE_COMPARATOR(notdescending, > 0)
-DST_DEFINE_COMPARATOR(notascending, < 0)
-
-/* Boolean logic */
-static int dst_strict_equal(DstArgs args) {
-    int32_t i;
-    for (i = 0; i < args.n - 1; i++) {
-        if (!dst_equals(args.v[i], args.v[i+1])) {
-            DST_RETURN(args, dst_wrap_false());
-        }
-    }
-    DST_RETURN(args, dst_wrap_true());
-}
-
-static int dst_strict_notequal(DstArgs args) {
-    int32_t i;
-    for (i = 0; i < args.n - 1; i++) {
-        if (dst_equals(args.v[i], args.v[i+1])) {
-            DST_RETURN(args, dst_wrap_false());
-        }
-    }
-    DST_RETURN(args, dst_wrap_true());
-}
-
 static int dst_not(DstArgs args) {
     DST_FIXARITY(args, 1);
     DST_RETURN_BOOLEAN(args, !dst_truthy(args.v[0]));
 }
 
-#define DEF_NUMERIC_COMP(name, op) \
-int dst_numeric_##name(DstArgs args) { \
-    int32_t i; \
-    for (i = 1; i < args.n; i++) { \
-        double x = 0, y = 0; \
-        DST_ARG_NUMBER(x, args, i-1);\
-        DST_ARG_NUMBER(y, args, i);\
-        if (!(x op y)) { \
-            DST_RETURN(args, dst_wrap_false()); \
-        } \
-    } \
-    DST_RETURN(args, dst_wrap_true()); \
-}
-
-DEF_NUMERIC_COMP(gt, >)
-DEF_NUMERIC_COMP(lt, <)
-DEF_NUMERIC_COMP(lte, <=)
-DEF_NUMERIC_COMP(gte, >=)
-DEF_NUMERIC_COMP(eq, ==)
-DEF_NUMERIC_COMP(neq, !=)
-
 static const DstReg cfuns[] = {
     {"%", dst_remainder},
-    {"=", dst_strict_equal},
-    {"not=", dst_strict_notequal},
-    {"order<", dst_ascending},
-    {"order>", dst_descending},
-    {"order<=", dst_notdescending},
-    {"order>=", dst_notascending},
-    {"==", dst_numeric_eq},
-    {"not==", dst_numeric_neq},
-    {"<", dst_numeric_lt},
-    {">", dst_numeric_gt},
-    {"<=", dst_numeric_lte},
-    {">=", dst_numeric_gte},
-    {"~", dst_bnot},
     {"not", dst_not},
     {"int", dst_int},
     {"real", dst_real},

src/core/os.c

@@ -153,6 +153,9 @@ static int os_getenv(DstArgs args) {
     DST_ARG_STRING(k, args, 0);
     const char *cstr = (const char *) k;
     const char *res = getenv(cstr);
+    if (!res) {
+        DST_RETURN_NIL(args);
+    }
     DST_RETURN(args, cstr
             ? dst_cstringv(res)
             : dst_wrap_nil());
@@ -195,10 +198,28 @@ static int os_exit(DstArgs args) {
     return 0;
 }
 
+/* Clock shim for windows */
+#ifdef DST_WINDOWS
+static int clock_gettime(int x, struct timespec *spec) {
+    (void) x;
+    int64_t wintime = 0LL;
+    GetSystemTimeAsFileTime((FILETIME*)&wintime);
+    /* Windows epoch is January 1, 1601 apparently*/
+    wintime -= 116444736000000000LL;
+    spec->tv_sec  = wintime / 10000000LL;
+    /* Resolution is 100 nanoseconds. */
+    spec->tv_nsec = wintime % 10000000LL * 100;
+    return 0;
+}
+#define CLOCK_MONOTONIC 0
+#endif
+
 static int os_clock(DstArgs args) {
     DST_FIXARITY(args, 0);
-    clock_t time = clock();
+    struct timespec tv;
-    double dtime = time / (double) (CLOCKS_PER_SEC);
+    if (clock_gettime(CLOCK_MONOTONIC, &tv))
+        DST_THROW(args, "could not get time");
+    double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
     DST_RETURN_REAL(args, dtime);
 }
 

src/core/parse.c

@@ -419,7 +419,7 @@ static int longstring(DstParser *p, DstParseState *state, uint8_t c) {
     } else if (state->flags & PFLAG_END_CANDIDATE) {
         int i;
         /* We are checking a potential end of the string */
-        if (c != '`' && state->qcount == state->argn) {
+        if (state->qcount == state->argn) {
             stringend(p, state);
             return 0;
         }

src/core/specials.c

@@ -26,7 +26,7 @@
 #include "vector.h"
 #include "emit.h"
 
-DstSlot dstc_quote(DstFopts opts, int32_t argn, const Dst *argv) {
+static DstSlot dstc_quote(DstFopts opts, int32_t argn, const Dst *argv) {
     if (argn != 1) {
         dstc_cerror(opts.compiler, "expected 1 argument");
         return dstc_cslot(dst_wrap_nil());
@@ -91,7 +91,7 @@ static int destructure(DstCompiler *c,
     }
 }
 
-DstSlot dstc_varset(DstFopts opts, int32_t argn, const Dst *argv) {
+static DstSlot dstc_varset(DstFopts opts, int32_t argn, const Dst *argv) {
     DstFopts subopts = dstc_fopts_default(opts.compiler);
     DstSlot ret, dest;
     Dst head;
@@ -189,7 +189,7 @@ static int varleaf(
     }
 }
 
-DstSlot dstc_var(DstFopts opts, int32_t argn, const Dst *argv) {
+static DstSlot dstc_var(DstFopts opts, int32_t argn, const Dst *argv) {
     DstCompiler *c = opts.compiler;
     Dst head;
     DstSlot ret = dohead(c, opts, &head, argn, argv);
@@ -222,7 +222,7 @@ static int defleaf(
     }
 }
 
-DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
+static DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
     DstCompiler *c = opts.compiler;
     Dst head;
     opts.flags &= ~DST_FOPTS_HINT;
@@ -245,13 +245,13 @@ DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
  * ...
  * :done
  */
-DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
+static DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
     DstCompiler *c = opts.compiler;
     int32_t labelr, labeljr, labeld, labeljd;
     DstFopts condopts, bodyopts;
     DstSlot cond, left, right, target;
     Dst truebody, falsebody;
-    DstScope tempscope;
+    DstScope condscope, tempscope;
     const int tail = opts.flags & DST_FOPTS_TAIL;
     const int drop = opts.flags & DST_FOPTS_DROP;
 
@@ -268,7 +268,13 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
     condopts = dstc_fopts_default(c);
     bodyopts = opts;
 
+    /* Set target for compilation */
+    target = (drop || tail)
+        ? dstc_cslot(dst_wrap_nil())
+        : dstc_gettarget(opts);
+
     /* Compile condition */
+    dstc_scope(&condscope, c, 0, "if");
     cond = dstc_value(condopts, argv[0]);
 
     /* Check constant condition. */
@@ -283,15 +289,11 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
         dstc_scope(&tempscope, c, 0, "if-body");
         target = dstc_value(bodyopts, truebody);
         dstc_popscope(c);
+        dstc_popscope(c);
         dstc_throwaway(bodyopts, falsebody);
         return target;
     }
 
-    /* Set target for compilation */
-    target = (drop || tail)
-        ? dstc_cslot(dst_wrap_nil())
-        : dstc_gettarget(opts);
-
     /* Compile jump to right */
     labeljr = dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
 
@@ -312,6 +314,9 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
     if (!drop && !tail) dstc_copy(c, target, right);
     dstc_popscope(c);
 
+    /* Pop main scope */
+    dstc_popscope(c);
+
     /* Write jumps - only add jump lengths if jump actually emitted */
     labeld = dst_v_count(c->buffer);
     c->buffer[labeljr] |= (labelr - labeljr) << 16;
@@ -323,7 +328,7 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
 
 /* Compile a do form. Do forms execute their body sequentially and
  * evaluate to the last expression in the body. */
-DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
+static DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
     int32_t i;
     DstSlot ret = dstc_cslot(dst_wrap_nil());
     DstCompiler *c = opts.compiler;
@@ -345,6 +350,19 @@ DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
     return ret;
 }
 
+/* Add a funcdef to the top most function scope */
+static int32_t dstc_addfuncdef(DstCompiler *c, DstFuncDef *def) {
+    DstScope *scope = c->scope;
+    while (scope) {
+        if (scope->flags & DST_SCOPE_FUNCTION)
+            break;
+        scope = scope->parent;
+    }
+    dst_assert(scope, "could not add funcdef");
+    dst_v_push(scope->defs, def);
+    return dst_v_count(scope->defs) - 1;
+}
+
 /*
  * :whiletop
  * ...
@@ -354,7 +372,7 @@ DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
  * jump :whiletop
  * :done
  */
-DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
+static DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
     DstCompiler *c = opts.compiler;
     DstSlot cond;
     DstFopts subopts = dstc_fopts_default(c);
@@ -369,6 +387,8 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
 
     labelwt = dst_v_count(c->buffer);
 
+    dstc_scope(&tempscope, c, 0, "while");
+
     /* Compile condition */
     cond = dstc_value(subopts, argv[0]);
 
@@ -376,20 +396,17 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
     if (cond.flags & DST_SLOT_CONSTANT) {
         /* Loop never executes */
         if (!dst_truthy(cond.constant)) {
+            dstc_popscope(c);
             return dstc_cslot(dst_wrap_nil());
         }
         /* Infinite loop */
         infinite = 1;
     }
 
-    dstc_scope(&tempscope, c, 0, "while");
-
     /* Infinite loop does not need to check condition */
-    if (!infinite) {
+    labelc = infinite
-        labelc = dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
+        ? 0
-    } else {
+        : dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
-        labelc = 0;
-    }
 
     /* Compile body */
     for (i = 1; i < argn; i++) {
@@ -397,6 +414,44 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
         dstc_freeslot(c, dstc_value(subopts, argv[i]));
     }
 
+    /* Check if closure created in while scope. If so,
+     * recompile in a function scope. */
+    if (tempscope.flags & DST_SCOPE_CLOSURE) {
+        tempscope.flags |= DST_SCOPE_UNUSED;
+        dstc_popscope(c);
+        dst_v__cnt(c->buffer) = labelwt;
+        dst_v__cnt(c->mapbuffer) = labelwt;
+
+        dstc_scope(&tempscope, c, DST_SCOPE_FUNCTION, "while-iife");
+
+        /* Recompile in the function scope */
+        cond = dstc_value(subopts, argv[0]);
+        if (!(cond.flags & DST_SLOT_CONSTANT)) {
+            /* If not an infinte loop, return nil when condition false */
+            dstc_emit_si(c, DOP_JUMP_IF, cond, 2, 0);
+            dstc_emit(c, DOP_RETURN_NIL);
+        }
+        for (i = 1; i < argn; i++) {
+            subopts.flags = DST_FOPTS_DROP;
+            dstc_freeslot(c, dstc_value(subopts, argv[i]));
+        }
+        /* But now add tail recursion */
+        int32_t tempself = dstc_regalloc_temp(&tempscope.ra, DSTC_REGTEMP_0);
+        dstc_emit(c, DOP_LOAD_SELF | (tempself << 8));
+        dstc_emit(c, DOP_TAILCALL | (tempself << 8));
+        /* Compile function */
+        DstFuncDef *def = dstc_pop_funcdef(c);
+        def->name = dst_cstring("_while");
+        int32_t defindex = dstc_addfuncdef(c, def);
+        /* And then load the closure and call it. */
+        int32_t cloreg = dstc_regalloc_temp(&c->scope->ra, DSTC_REGTEMP_0);
+        dstc_emit(c, DOP_CLOSURE | (cloreg << 8) | (defindex << 16));
+        dstc_emit(c, DOP_CALL | (cloreg << 8) | (cloreg << 16));
+        dstc_regalloc_free(&c->scope->ra, cloreg);
+        c->scope->flags |= DST_SCOPE_CLOSURE;
+        return dstc_cslot(dst_wrap_nil());
+    }
+
     /* Compile jump to whiletop */
     labeljt = dst_v_count(c->buffer);
     dstc_emit(c, DOP_JUMP);
@@ -412,20 +467,7 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
     return dstc_cslot(dst_wrap_nil());
 }
 
-/* Add a funcdef to the top most function scope */
+static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
-static int32_t dstc_addfuncdef(DstCompiler *c, DstFuncDef *def) {
-    DstScope *scope = c->scope;
-    while (scope) {
-        if (scope->flags & DST_SCOPE_FUNCTION)
-            break;
-        scope = scope->parent;
-    }
-    dst_assert(scope, "could not add funcdef");
-    dst_v_push(scope->defs, def);
-    return dst_v_count(scope->defs) - 1;
-}
-
-DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
     DstCompiler *c = opts.compiler;
     DstFuncDef *def;
     DstSlot ret;
@@ -439,6 +481,7 @@ DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
     int selfref = 0;
 
     /* Begin function */
+    c->scope->flags |= DST_SCOPE_CLOSURE;
     dstc_scope(&fnscope, c, DST_SCOPE_FUNCTION, "function");
 
     if (argn < 2) {
@@ -506,7 +549,14 @@ DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
     /* Build function */
     def = dstc_pop_funcdef(c);
     def->arity = arity;
-    if (varargs) def->flags |= DST_FUNCDEF_FLAG_VARARG;
+
+    /* Tuples indicated fixed arity, arrays indicate flexible arity */
+    /* TODO - revisit this */
+    if (varargs) 
+        def->flags |= DST_FUNCDEF_FLAG_VARARG;
+    else if (dst_checktype(paramv, DST_TUPLE))
+        def->flags |= DST_FUNCDEF_FLAG_FIXARITY;
+
     if (selfref) def->name = dst_unwrap_symbol(head);
     defindex = dstc_addfuncdef(c, def);
 

src/core/string.c

@@ -356,6 +356,19 @@ void dst_description_b(DstBuffer *buffer, Dst x) {
             }
             goto fallthrough;
         }
+    case DST_FUNCTION:
+        {
+            DstFunction *fun = dst_unwrap_function(x);
+            DstFuncDef *def = fun->def;
+            if (def->name) {
+                const uint8_t *n = def->name;
+                dst_buffer_push_cstring(buffer, "<function ");
+                dst_buffer_push_bytes(buffer, n, dst_string_length(n));
+                dst_buffer_push_u8(buffer, '>');
+                break;
+            }
+            goto fallthrough;
+        }
     fallthrough:
     default:
         string_description_b(buffer, dst_type_names[dst_type(x)] + 1, dst_unwrap_pointer(x));
@@ -423,6 +436,15 @@ const uint8_t *dst_description(Dst x) {
             }
             goto fallthrough;
         }
+    case DST_FUNCTION:
+        {
+            DstFunction *fun = dst_unwrap_function(x);
+            DstFuncDef *def = fun->def;
+            if (def->name) {
+                return dst_formatc("<function %S>", def->name);
+            }
+            goto fallthrough;
+        }
     fallthrough:
     default:
         return string_description(dst_type_names[dst_type(x)] + 1, dst_unwrap_pointer(x));

src/core/symcache.c

@@ -209,8 +209,10 @@ static void inc_gensym(void) {
     for (int i = sizeof(gensym_counter) - 2; i; i--) {
         if (gensym_counter[i] == '9') {
             gensym_counter[i] = 'a';
+            break;
         } else if (gensym_counter[i] == 'z') {
             gensym_counter[i] = 'A';
+            break;
         } else if (gensym_counter[i] == 'Z') {
             gensym_counter[i] = '0';
         } else {

src/core/vm.c

@@ -190,6 +190,11 @@ static void *op_lookup[255] = {
     &&label_DOP_MAKE_STRUCT,
     &&label_DOP_MAKE_TABLE,
     &&label_DOP_MAKE_TUPLE,
+    &&label_DOP_NUMERIC_LESS_THAN,
+    &&label_DOP_NUMERIC_LESS_THAN_EQUAL,
+    &&label_DOP_NUMERIC_GREATER_THAN,
+    &&label_DOP_NUMERIC_GREATER_THAN_EQUAL,
+    &&label_DOP_NUMERIC_EQUAL,
     &&label_unknown_op
 };
 #else
@@ -257,6 +262,23 @@ static void *op_lookup[255] = {
         vm_next();\
     }
 
+#define vm_numcomp(op)\
+    {\
+        Dst op1 = stack[oparg(2, 0xFF)];\
+        Dst op2 = stack[oparg(3, 0xFF)];\
+        vm_assert_types(op1, DST_TFLAG_NUMBER);\
+        vm_assert_types(op2, DST_TFLAG_NUMBER);\
+        stack[oparg(1, 0xFF)] = dst_wrap_boolean(dst_checktype(op1, DST_INTEGER)\
+            ? (dst_checktype(op2, DST_INTEGER)\
+                ? dst_unwrap_integer(op1) op dst_unwrap_integer(op2)\
+                : (double)dst_unwrap_integer(op1) op dst_unwrap_real(op2))\
+            : (dst_checktype(op2, DST_INTEGER)\
+                ? dst_unwrap_real(op1) op (double)dst_unwrap_integer(op2)\
+                : dst_unwrap_real(op1) op dst_unwrap_real(op2)));\
+        pc++;\
+        vm_next();\
+    }
+
     /* Main interpreter loop. Semantically is a switch on
      * (*pc & 0xFF) inside of an infinte loop. */
     VM_START();
@@ -325,6 +347,21 @@ static void *op_lookup[255] = {
     VM_OP(DOP_MULTIPLY)
     vm_binop(*);
 
+    VM_OP(DOP_NUMERIC_LESS_THAN)
+    vm_numcomp(<);
+
+    VM_OP(DOP_NUMERIC_LESS_THAN_EQUAL)
+    vm_numcomp(<=);
+
+    VM_OP(DOP_NUMERIC_GREATER_THAN)
+    vm_numcomp(>);
+
+    VM_OP(DOP_NUMERIC_GREATER_THAN_EQUAL)
+    vm_numcomp(>=);
+
+    VM_OP(DOP_NUMERIC_EQUAL)
+    vm_numcomp(==);
+
     VM_OP(DOP_DIVIDE_INTEGER)
     vm_assert(dst_unwrap_integer(stack[oparg(3, 0xFF)]) != 0, "integer divide error");
     vm_assert(!(dst_unwrap_integer(stack[oparg(3, 0xFF)]) == -1 &&
@@ -385,6 +422,7 @@ static void *op_lookup[255] = {
 
     VM_OP(DOP_BNOT)
     stack[oparg(1, 0xFF)] = dst_wrap_integer(~dst_unwrap_integer(stack[oparg(2, 0xFFFF)]));
+    ++pc;
     vm_next();
 
     VM_OP(DOP_SHIFT_RIGHT_UNSIGNED)
@@ -730,7 +768,8 @@ static void *op_lookup[255] = {
         if (dst_checktype(callee, DST_FUNCTION)) {
             func = dst_unwrap_function(callee);
             dst_stack_frame(stack)->pc = pc;
-            dst_fiber_funcframe(fiber, func);
+            if (dst_fiber_funcframe(fiber, func))
+                goto vm_arity_error;
             stack = fiber->data + fiber->frame;
             pc = func->def->bytecode;
             vm_checkgc_next();
@@ -756,7 +795,8 @@ static void *op_lookup[255] = {
         Dst callee = stack[oparg(1, 0xFFFFFF)];
         if (dst_checktype(callee, DST_FUNCTION)) {
             func = dst_unwrap_function(callee);
-            dst_fiber_funcframe_tail(fiber, func);
+            if (dst_fiber_funcframe_tail(fiber, func))
+                goto vm_arity_error;
             stack = fiber->data + fiber->frame;
             pc = func->def->bytecode;
             vm_checkgc_next();
@@ -1152,6 +1192,19 @@ static void *op_lookup[255] = {
         goto vm_reset;
     }
 
+    /* Handle function calls with bad arity */
+    vm_arity_error:
+    {
+        int32_t nargs = fiber->stacktop - fiber->stackstart;
+        retreg = dst_wrap_string(dst_formatc("%V called with %d argument%s, expected %d",
+                    dst_wrap_function(func),
+                    nargs,
+                    nargs == 1 ? "" : "s",
+                    func->def->arity));
+        signal = DST_SIGNAL_ERROR;
+        goto vm_exit;
+    }
+
     /* Resume a child fiber */
     vm_resume_child:
     {
@@ -1255,14 +1308,17 @@ DstSignal dst_call(
         *f = fiber;
     for (i = 0; i < argn; i++)
         dst_fiber_push(fiber, argv[i]);
-    dst_fiber_funcframe(fiber, fiber->root);
+    if (dst_fiber_funcframe(fiber, fiber->root)) {
+        *out = dst_cstringv("arity mismatch");
+        return DST_SIGNAL_ERROR;
+    }
     /* Prevent push an extra value on the stack */
     dst_fiber_set_status(fiber, DST_STATUS_PENDING);
     return dst_continue(fiber, dst_wrap_nil(), out);
 }
 
 /* Setup VM */
-int dst_init() {
+int dst_init(void) {
     /* Garbage collection */
     dst_vm_blocks = NULL;
     dst_vm_next_collection = 0;
@@ -1283,7 +1339,7 @@ int dst_init() {
 }
 
 /* Clear all memory associated with the VM */
-void dst_deinit() {
+void dst_deinit(void) {
     dst_clear_memory();
     dst_symcache_deinit();
     free(dst_vm_roots);

src/include/dst/dst.h

@@ -515,9 +515,9 @@ Dst dst_wrap_abstract(void *x);
 
 /* Hold components of arguments passed to DstCFunction. */
 struct DstArgs {
-    int32_t n;
     Dst *v;
     Dst *ret;
+    int32_t n;
 };
 
 /* Fiber flags */
@@ -811,6 +811,11 @@ enum DstOpCode {
     DOP_MAKE_STRUCT,
     DOP_MAKE_TABLE,
     DOP_MAKE_TUPLE,
+    DOP_NUMERIC_LESS_THAN,
+    DOP_NUMERIC_LESS_THAN_EQUAL,
+    DOP_NUMERIC_GREATER_THAN,
+    DOP_NUMERIC_GREATER_THAN_EQUAL,
+    DOP_NUMERIC_EQUAL,
     DOP_INSTRUCTION_COUNT
 };
 
@@ -855,16 +860,16 @@ enum DstCompileStatus {
     DST_COMPILE_ERROR
 };
 struct DstCompileResult {
-    enum DstCompileStatus status;
     DstFuncDef *funcdef;
     const uint8_t *error;
     DstFiber *macrofiber;
     DstSourceMapping error_mapping;
+    enum DstCompileStatus status;
 };
 DstCompileResult dst_compile(Dst source, DstTable *env, const uint8_t *where);
 
 /* Get the default environment for dst */
-DstTable *dst_stl_env();
+DstTable *dst_core_env(void);
 
 int dst_dobytes(DstTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath);
 int dst_dostring(DstTable *env, const char *str, const char *sourcePath);
@@ -939,7 +944,7 @@ void dst_puts(const uint8_t *str);
 const uint8_t *dst_symbol(const uint8_t *str, int32_t len);
 const uint8_t *dst_symbol_from_string(const uint8_t *str);
 const uint8_t *dst_csymbol(const char *str);
-const uint8_t *dst_symbol_gen();
+const uint8_t *dst_symbol_gen(void);
 #define dst_symbolv(str, len) dst_wrap_symbol(dst_symbol((str), (len)))
 #define dst_csymbolv(cstr) dst_wrap_symbol(dst_csymbol(cstr))
 
@@ -1033,10 +1038,6 @@ void dst_env_cfuns(DstTable *env, const DstReg *cfuns);
 DstBindingType dst_env_resolve(DstTable *env, const uint8_t *sym, Dst *out);
 DstTable *dst_env_arg(DstArgs args);
 
-/* STL */
-#define DST_STL_NOGCROOT 1
-DstTable *dst_stl_env(int flags);
-
 /* C Function helpers */
 int dst_arity_err(DstArgs args, int32_t n, const char *prefix);
 int dst_type_err(DstArgs args, int32_t n, DstType expected);
@@ -1058,6 +1059,9 @@ int dst_lib_parse(DstArgs args);
 int dst_lib_asm(DstArgs args);
 int dst_lib_compile(DstArgs args);
 
+/* Helpers for writing modules */
+#define DST_MODULE_ENTRY int _dst_init
+
 /***** END SECTION MAIN *****/
 
 /***** START SECTION MACROS *****/
@@ -1151,7 +1155,7 @@ int dst_lib_compile(DstArgs args);
 #define DST_ARG_CFUNCTION(DEST, A, N) _DST_ARG(DST_CFUNCTION, cfunction, DEST, A, N)
 #define DST_ARG_ABSTRACT(DEST, A, N) _DST_ARG(DST_ABSTRACT, abstract, DEST, A, N)
 
-#define DST_RETURN_NIL(A) return DST_SIGNAL_OK
+#define DST_RETURN_NIL(A) do { return DST_SIGNAL_OK; } while (0)
 #define DST_RETURN_FALSE(A) DST_RETURN(A, dst_wrap_false())
 #define DST_RETURN_TRUE(A) DST_RETURN(A, dst_wrap_true())
 #define DST_RETURN_BOOLEAN(A, X) DST_RETURN(A, dst_wrap_boolean(X))

src/mainclient/init.dst

@@ -1,5 +1,5 @@
 # Copyright 2017-2018 (C) Calvin Rose
-(table.setproto @{ 1 2} @{})
+
 (do
 
   (var *should-repl* :private false)
@@ -23,17 +23,17 @@
   -- Stop handling options`)
            (os.exit 0)
            1)
-     "v" (fn [] (print VERSION) (os.exit 0) 1)
+     "v" (fn @[] (print VERSION) (os.exit 0) 1)
-     "s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
+     "s" (fn @[] (:= *raw-stdin* true) (:= *should-repl* true) 1)
-     "r" (fn [] (:= *should-repl* true) 1)
+     "r" (fn @[] (:= *should-repl* true) 1)
-     "p" (fn [] (:= *exit-on-error* false) 1)
+     "p" (fn @[] (:= *exit-on-error* false) 1)
-     "-" (fn [] (:= *handleopts* false) 1)
+     "-" (fn @[] (:= *handleopts* false) 1)
-     "e" (fn [i] 
+     "e" (fn @[i] 
            (:= *no-file* false)
            (eval (get args (+ i 1)))
            2)})
 
-  (defn- dohandler [n i]
+  (defn- dohandler @[n i]
     (def h (get handlers n))
     (if h (h i) (print "unknown flag -" n)))
 

src/mainclient/main.c

@@ -32,7 +32,7 @@ int main(int argc, char **argv) {
 
     /* Set up VM */
     dst_init();
-    env = dst_stl_env(0);
+    env = dst_core_env();
 
     /* Create args tuple */
     args = dst_array(argc);

test/suite0.dst

@@ -155,7 +155,7 @@
 
 # yield tests
 
-(def t (fiber.new (fn [] (yield 1) (yield 2) 3)))
+(def t (fiber.new (fn @[] (yield 1) (yield 2) 3)))
 
 (assert (= 1 (resume t)) "initial transfer to new fiber")
 (assert (= 2 (resume t)) "second transfer to fiber")

test/suite1.dst

@@ -43,7 +43,7 @@
 (defn assert-many [f n e]
  (var good true)
  (loop [i :range [0 n]]
-  (if (not (f i))
+  (if (not (f))
    (:= good false)))
  (assert good e))
 
@@ -76,9 +76,9 @@
 # More fiber semantics
 
 (var myvar 0)
-(defn fiberstuff []
+(defn fiberstuff @[]
   (++ myvar)
-  (def f (fiber.new (fn [] (++ myvar) (debug) (++ myvar))))
+  (def f (fiber.new (fn @[] (++ myvar) (debug) (++ myvar))))
   (resume f)
   (++ myvar))
 
@@ -198,4 +198,16 @@
 (def xs (apply1 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=
+(assert (not= 1 1 0) "not= 1")
+(assert (not= 0 1 1) "not= 2")
+
+# Closure in while loop
+(def closures (for [i :range [0 5]] (fn [] i)))
+(assert (= 0 ((get closures 0))) "closure in loop 0")
+(assert (= 1 ((get closures 1))) "closure in loop 1")
+(assert (= 2 ((get closures 2))) "closure in loop 2")
+(assert (= 3 ((get closures 3))) "closure in loop 3")
+(assert (= 4 ((get closures 4))) "closure in loop 4")
+
 (end-suite)