diff --git a/3 b/3 new file mode 100644 index 00000000..20b160ea --- /dev/null +++ b/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)) + diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index 06cb6103..16a61675 100644 --- a/src/compiler/boot.dst +++ b/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))) + diff --git a/src/compiler/specials.c b/src/compiler/specials.c index 37ebab21..babe63c4 100644 --- a/src/compiler/specials.c +++ b/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; } diff --git a/src/core/corelib.c b/src/core/corelib.c index 7c4deb5e..48a110bf 100644 --- a/src/core/corelib.c +++ b/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])])); } diff --git a/src/core/io.c b/src/core/io.c index c4bd2cec..0d17b67a 100644 --- a/src/core/io.c +++ b/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 }; diff --git a/src/core/value.c b/src/core/value.c index 6b17a24b..2053b4b2 100644 --- a/src/core/value.c +++ b/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)) { diff --git a/src/include/dst/dst.h b/src/include/dst/dst.h index da06dbd8..d56649fe 100644 --- a/src/include/dst/dst.h +++ b/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); diff --git a/src/parser/ast.c b/src/parser/ast.c index d7f496fe..51d19f0f 100644 --- a/src/parser/ast.c +++ b/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 }; diff --git a/src/parser/parse.c b/src/parser/parse.c index dadb6816..11372d10 100644 --- a/src/parser/parse.c +++ b/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 };