Fix small compiler bug

3

@@ -0,0 +1,116 @@
+(def defmacro macro
+  (fn [name & more] (tuple 'def name 'macro (tuple-prepend (tuple-prepend more name) 'fn))))
+
+(defmacro defn
+ [name & more] 
+ (tuple 'def name (tuple-prepend (tuple-prepend more name) 'fn)))
+
+(defmacro when
+ [cond & body] 
+ (tuple 'if cond (tuple-prepend body 'do)))
+
+(def seq (do
+  (defn array-seq [x]
+    (def len (length x))
+    (var i 0)
+    {
+      :more (fn [] (< i len))
+      :next (fn []
+        (def ret (get x i))
+        (varset! i (+ i 1))
+        ret) 
+    })
+  (def seqs {
+    :array array-seq
+    :tuple array-seq
+    :struct (fn [x] x)})
+  (fn [x]
+   (def makeseq (get seqs (type x)))
+   (if makeseq (makeseq x) (error "expected sequence")))))
+
+(defn range [top]
+  (var i 0)
+  {
+    :more (fn [] (< i top))
+    :next (fn []
+      (def ret i)
+      (varset! i (+ i 1))
+      ret) 
+  })
+
+(defn doseq [s] 
+ (def s (seq s))
+ (def more? (get s :more))
+ (def getnext (get s :next))
+ (while (more?)
+    (getnext)))
+
+(defn map [f s]
+ (def s (seq s))
+ (def more (get s :more))
+ (def getnext (get s :next))
+ {
+  :more more
+  :next (fn [] (f (getnext)))
+ })
+
+(defn reduce [f start s]
+  (def s (seq s))
+  (def more? (get s :more))
+  (def getnext (get s :next))
+  (var ret start)
+  (while (more?)
+    (varset! ret (f ret (getnext))))
+  ret)
+
+(defmacro for [head & body]
+  (def head (ast-unwrap1 head))
+  (def sym (get head 0))
+  (def start (get head 1))
+  (def end (get head 2))
+  (def _inc (get head 3))
+  (def inc (if _inc _inc 1))
+  (tuple 'do
+    (tuple 'var sym start)
+    (tuple 'while (tuple '< sym end)
+     (tuple-prepend body 'do)
+     (tuple 'varset! sym (tuple '+ sym 1))
+      )))
+
+(defn pp-seq [pp buf a start end]
+ (def len (length a))
+ (buffer-push-string buf start)
+ (for [i 0 len]
+  (when (not= i 0) (buffer-push-string buf " "))
+  (pp buf (get a i)))
+ (buffer-push-string buf end)
+ buf)
+
+(defn pp-dict [pp buf a start end]
+ (var k (next a nil))
+ (buffer-push-string buf start)
+ (while k
+  (def v (get a k))
+  (pp buf k)
+  (buffer-push-string buf " ")
+  (pp buf v)
+  (buffer-push-string buf "\n")
+  (varset! k (next a k))
+ )
+ (buffer-push-string buf end)
+ buf)
+
+(def _printers {
+ :array  (fn [pp buf x] (pp-seq pp buf x "[" "]"))
+ :tuple  (fn [pp buf x] (pp-seq pp buf x "(" ")"))
+ :table  (fn [pp buf x] (pp-dict pp buf x "@{" "}"))
+ :struct (fn [pp buf x] (pp-dict pp buf x "{" "}"))
+})
+
+(defn _default_printer [_ buf x] (buffer-push-string buf (string x)) buf)
+
+(defn pp [buf x]
+  (def pmaybe (get _printers (type x)))
+  (def p (if pmaybe pmaybe _default_printer))
+  (p pp buf x))
+

src/compiler/boot.dst

@@ -64,7 +64,7 @@
   ret)
 
 (defmacro for [head & body]
-  (def head (ast-unwrap head))
+  (def head (ast-unwrap1 head))
   (def sym (get head 0))
   (def start (get head 1))
   (def end (get head 2))
@@ -76,3 +76,50 @@
      (tuple-prepend body 'do)
      (tuple 'varset! sym (tuple '+ sym 1))
       )))
+
+(defn pp-seq [pp buf a indent start end]
+ (def len (length a))
+ (buffer-push-string buf start)
+ (for [i 0 len]
+  (when (not= i 0) (buffer-push-string buf " "))
+  (pp buf (get a i) indent))
+ (buffer-push-string buf end)
+ buf)
+
+(defn push-line [buf indent]
+  (buffer-push-string buf "\n")
+  (for [i 0 indent] (buffer-push-string buf " "))
+)
+  
+(defn pp-dict [pp buf a indent start end]
+ (var k (next a nil))
+ (buffer-push-string buf start)
+ (def newindent (+ 2 indent))
+ (push-line buf newindent)
+ (while k
+  (def v (get a k))
+  (pp buf k)
+  (buffer-push-string buf " ")
+  (pp buf v)
+  (varset! k (next a k))
+  (push-line buf (if k newindent indent))
+ )
+ (buffer-push-string buf end)
+ buf)
+
+(def _printers {
+ :array  (fn [pp buf x i] (pp-seq pp buf x i "[" "]"))
+ :tuple  (fn [pp buf x i] (pp-seq pp buf x i "(" ")"))
+ :table  (fn [pp buf x i] (pp-dict pp buf x i "@{" "}"))
+ :struct (fn [pp buf x i] (pp-dict pp buf x i "{" "}"))
+})
+
+(defn _default_printer [_ buf x] (buffer-push-string buf (string x)) buf)
+
+(defn pp1 [buf x indent]
+  (def pmaybe (get _printers (type x)))
+  (def p (if pmaybe pmaybe _default_printer))
+  (p pp1 buf x indent))
+
+(defn pp [x] (print (pp1 (buffer) x 0)))
+

src/compiler/specials.c

@@ -123,8 +123,8 @@ static DstSlot namelocal(DstCompiler *c, DstAst *ast, Dst head, int32_t flags, D
         dstc_copy(c, ast, localslot, ret);
         ret = localslot;
     }
+    ret.flags |= flags;
     dstc_nameslot(c, dst_unwrap_symbol(head), ret); 
-    ret.flags |= DST_SLOT_NAMED;
     return ret;
 }
 

src/core/corelib.c

@@ -218,7 +218,7 @@ int dst_core_gccollect(DstArgs args) {
 int dst_core_type(DstArgs args) {
     if (args.n != 1) return dst_throw(args, "expected 1 argument");
     if (dst_checktype(args.v[0], DST_ABSTRACT)) {
-        return dst_return(args, dst_cstringv(dst_abstract_type(dst_unwrap_abstract(args.v[0]))->name));
+        return dst_return(args, dst_csymbolv(dst_abstract_type(dst_unwrap_abstract(args.v[0]))->name));
     } else {
         return dst_return(args, dst_csymbolv(dst_type_names[dst_type(args.v[0])]));
     }

src/core/io.c

@@ -40,7 +40,7 @@ struct IOFile {
 static int dst_io_gc(void *p, size_t len);
 
 DstAbstractType dst_io_filetype = {
-    "core.file",
+    ":core.file",
     dst_io_gc,
     NULL
 };

src/core/value.c

@@ -254,26 +254,6 @@ int32_t dst_length(Dst x) {
     }
 }
 
-/* Get the capacity of an object. Returns 0 for invalid types */
-int32_t dst_capacity(Dst x) {
-    switch (dst_type(x)) {
-        default:
-            return 0;
-        case DST_STRING:
-            return dst_string_length(dst_unwrap_string(x));
-        case DST_ARRAY:
-            return dst_unwrap_array(x)->capacity;
-        case DST_BUFFER:
-            return dst_unwrap_buffer(x)->capacity;
-        case DST_TUPLE:
-            return dst_tuple_length(dst_unwrap_tuple(x));
-        case DST_STRUCT:
-            return dst_struct_length(dst_unwrap_struct(x));
-        case DST_TABLE:
-            return dst_unwrap_table(x)->capacity;
-    }
-}
-
 /* Index into a data structure. Returns nil for out of bounds or invlalid data structure */
 Dst dst_getindex(Dst ds, int32_t index) {
     switch (dst_type(ds)) {

src/include/dst/dst.h

@@ -184,7 +184,6 @@ Dst dst_get(Dst ds, Dst key);
 void dst_put(Dst ds, Dst key, Dst value);
 const DstKV *dst_next(Dst ds, const DstKV *kv);
 int32_t dst_length(Dst x);
-int32_t dst_capacity(Dst x);
 Dst dst_getindex(Dst ds, int32_t index);
 void dst_setindex(Dst ds, Dst value, int32_t index);
 int dst_cstrcmp(const uint8_t *str, const char *other);

src/parser/ast.c

@@ -32,7 +32,7 @@ static int dst_ast_gcmark(void *p, size_t size) {
 
 /* AST type */
 static DstAbstractType dst_ast_type = {
-    "parse.ast",
+    ":parse.ast",
     NULL,
     dst_ast_gcmark
 };

src/parser/parse.c

@@ -533,7 +533,7 @@ static int parsergc(void *p, size_t size) {
 }
 
 DstAbstractType dst_parse_parsertype = {
-    "parse.parser",
+    ":parse.parser",
     parsergc,
     parsermark
 };