Fix a compiler bug in the do special form.

examples/lazyseqs.dst

@@ -4,23 +4,21 @@
 # that must be called (realizing it), and the memoized.
 # Use with (import "./path/to/this/file" :prefix "seq/")
 
-(defn- mem0 [f]
+(defmacro delay [& forms]
- "Memoize a 0 arity function."
+ "Lazily evaluate a series of expressions. Returns a function that
- (var state nil)
+returns the result of the last expression. Will only evaluate the
- (var loaded nil)
+body once, and then memoizes the result."
- (fn []
+ (def $state (gensym))
-  (if loaded
+ (def $loaded (gensym))
-   state
+ (tuple 'do
-   (do 
+  (tuple 'var $state nil)
-    (:= loaded true)
+  (tuple 'var $loaded nil)
-    (:= state (f))))))
+  (tuple 'fn (array)
-
+   (tuple 'if $loaded
-# This creates one more closure than necessary but oh well
+    $state
-(defmacro delay 
+    (tuple 'do
- "Macro for lazy evaluation. Returns a function that will evaluate
+     (tuple ':= $loaded true)
-the body when invoked. If called a second time, will return the first return value
+     (tuple ':= $state (tuple-prepend forms 'do)))))))
-that was memoized."
- [& forms] (tuple mem0 (apply tuple 'fn [] forms)))
 
 # Use tuples instead of structs to save memory
 (def HEAD :private 0)
@@ -63,13 +61,12 @@ that was memoized."
  [end]
  (range2 0 end))
 
-(defn maps
+(defn map
  "Return a sequence that is the result of apply f to each value in s."
  [f s]
  (delay
   (def x (s))
-  (if x (tuple (f (get x HEAD)) (maps f (get x TAIL))))))
+  (if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
-(def map maps)
 
 (defn realize
  "Force evaluation of a lazy sequence."
@@ -108,4 +105,3 @@ that was memoized."
   (when x
    (def thehead (get HEAD x))
    (if thehead (tuple thehead (take-while pred (get TAIL x)))))))
-

src/compiler/boot.dst

@@ -305,8 +305,8 @@ If no match is found, returns nil"
 
 # Start pretty printer
 (def pp (do
-  (defn- pp-seq [pp seen buf a start end]
+  (defn- pp-seq [pp seen buf a start end checkcycle]
-   (if (get seen a)
+   (if (and checkcycle (get seen a))
     (buffer-push-string buf "<cycle>")
     (do
      (put seen a true)
@@ -318,8 +318,8 @@ If no match is found, returns nil"
      (buffer-push-string buf end)))
    buf)
 
-  (defn- pp-dict [pp seen buf a start end]
+  (defn- pp-dict [pp seen buf a start end checkcycle]
-   (if (get seen a)
+   (if (and checkcycle (get seen a))
     (buffer-push-string buf "<cycle>")
     (do
      (put seen a true)
@@ -336,9 +336,9 @@ If no match is found, returns nil"
    buf)
 
   (def printers :private {
-   :array  (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]"))
+   :array  (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]" true))
    :tuple  (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
-   :table  (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}"))
+   :table  (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}" true))
    :struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
   })
 

src/compiler/specials.c

@@ -352,9 +352,9 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
     }
 
     /* Set target for compilation */
-    target = (!drop && !tail) 
+    target = (drop || tail) 
-        ? dstc_gettarget(opts)
+        ? dstc_cslot(dst_wrap_nil())
-        : dstc_cslot(dst_wrap_nil());
+        : dstc_gettarget(opts);
 
     /* Compile jump to right */
     condlocal = dstc_preread(c, ast, 0xFF, 1, cond);
@@ -393,7 +393,7 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
  * evaluate to the last expression in the body. */
 DstSlot dstc_do(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
     int32_t i;
-    DstSlot ret;
+    DstSlot ret = dstc_cslot(dst_wrap_nil());
     DstCompiler *c = opts.compiler;
     DstFopts subopts = dstc_fopts_default(c);
     (void) ast;
@@ -401,8 +401,8 @@ DstSlot dstc_do(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
     for (i = 0; i < argn; i++) {
         if (i != argn - 1) {
             subopts.flags = DST_FOPTS_DROP;
-        } else if (opts.flags & DST_FOPTS_TAIL) {
+        } else {
-            subopts.flags = DST_FOPTS_TAIL;
+            subopts = opts;
         }
         ret = dstc_value(subopts, argv[i]);
         if (i != argn - 1) {

src/core/struct.c

@@ -31,7 +31,7 @@ DstKV *dst_struct_begin(int32_t count) {
 
     /* Calculate capacity as power of 2 after 2 * count. */
     int32_t capacity = dst_tablen(2 * count);
-    if (capacity < 0) capacity = dst_tablen(count);
+    if (capacity < 0) capacity = dst_tablen(count + 1);
 
     size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(DstKV));
     char *data = dst_gcalloc(DST_MEMORY_STRUCT, s);
@@ -40,6 +40,7 @@ DstKV *dst_struct_begin(int32_t count) {
     dst_struct_length(st) = count;
     dst_struct_capacity(st) = capacity;
     dst_struct_hash(st) = 0;
+    (dst_struct_raw(st)[3]) = 0;
     return st;
 }
 
@@ -155,7 +156,7 @@ const DstKV *dst_struct_end(DstKV *st) {
 /* Get an item from a struct */
 Dst dst_struct_get(const DstKV *st, Dst key) {
     const DstKV *kv = dst_struct_find(st, key);
-    if (NULL == kv || dst_checktype(kv->key, DST_NIL)) {
+    if (NULL == kv) {
         return dst_wrap_nil();
     } else {
         return kv->value;

src/core/symcache.c

@@ -216,7 +216,7 @@ static void inc_counter(uint8_t *digits, int base, int len) {
 }
 
 /* Generate a unique symbol. This is used in the library function gensym. The
- * symbol will be of the format prefix--XXXXXX, where X is a base64 digit, and
+ * symbol will be of the format prefix_XXXXXX, where X is a base64 digit, and
  * prefix is the argument passed.  */
 const uint8_t *dst_symbol_gen(const uint8_t *buf, int32_t len) {
     const uint8_t **bucket = NULL;
@@ -224,15 +224,14 @@ const uint8_t *dst_symbol_gen(const uint8_t *buf, int32_t len) {
     uint8_t counter[6] = {63, 63, 63, 63, 63, 63};
     /* Leave spaces for 6 base 64 digits and two dashes. That means 64^6 possible suffixes, which
      * is enough for resolving collisions. */
-    int32_t newlen = len + 8;
+    int32_t newlen = len + 7;
     int32_t newbufsize = newlen + 2 * sizeof(int32_t) + 1;
     uint8_t *str = (uint8_t *)dst_gcalloc(DST_MEMORY_SYMBOL, newbufsize) + 2 * sizeof(int32_t);
     dst_string_length(str) = newlen;
     memcpy(str, buf, len);
-    str[len] = '-';
+    str[len] = '_';
-    str[len + 1] = '-';
     str[newlen] = 0;
-    uint8_t *saltbuf = str + len + 2;
+    uint8_t *saltbuf = str + len + 1;
     int status = 1;
     while (status) {
         int i;

test/suite1.dst

@@ -20,5 +20,37 @@
 
 (print "\nRunning Suite 1 Tests...\n")
 
+(var num-tests-passed 0)
+(var num-tests-run 0)
+(def assert (fn [x e]
+	(:= num-tests-run (+ 1 num-tests-run))
+	(if x
+		(do
+			(print "  \e[32m✔\e[0m " e)
+			(:= num-tests-passed (+ 1 num-tests-passed))
+			x)
+		(do
+			(print "  \e[31m✘\e[0m " e)
+			x))))
+
 (if (not= 400.0 (sqrt 160000)) (error "sqrt(160000)=400"))
 (if (not= (real 400) (sqrt 160000)) (error "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")
+(assert (= (get test-struct 'bork) 2) "struct get")
+(assert (= (get test-struct 'sam) 3) "struct get")
+(assert (= (get test-struct 'a) 'b) "struct get")
+(assert (= :array (type (get test-struct 'het))) "struct get")
+
+(defn myfun [x]
+  (var a 10)
+  (:= a (do
+         (def y x)
+         (if x 8 9))))
+
+(assert (= (myfun true) 8) "check do form regression")
+(assert (= (myfun false) 9) "check do form regression")
+
+(print "\n" num-tests-passed " of " num-tests-run " tests passed\n")
+(if (not= num-tests-passed num-tests-run) (exit 1))