diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index ffdd8a41..78f2f339 100644 --- a/src/compiler/boot.dst +++ b/src/compiler/boot.dst @@ -1,6 +1,10 @@ # Bootstrap the dst environment # Copyright 2018 (C) Calvin Rose +(var *env* + "The current environment. Is dynamically bound." + _env) + (def defn :macro "Define a function" (fn [name & more] @@ -18,7 +22,7 @@ (def defmacro :macro "Define a macro." (do - (def defn* (get (get _env 'defn) 'value)) + (def defn* (get (get _env 'defn) :value)) (fn [name & more] (def args (array-concat [] name :macro more)) (apply1 defn* args)))) @@ -355,11 +359,95 @@ If no match is found, returns nil" (foreach s (fn [x] (put tab x true))) (keys tab)) +(defn macroexpand1 + "Expand macros in a form, but do not recursively expand macros." + [x] + + (defn doarray [a] + (def len (length a)) + (def newa []) + (for [i 0 len] + (array-push newa (macroexpand1 (get a i)))) + newa) + + (defn dotable [t] + (def newt @{}) + (var key (next t nil)) + (while (not= nil key) + (put newt (macroexpand1 key) (macroexpand1 (get t key))) + (:= key (next t key))) + newt) + + (defn expandlast [t] + (def len (length t)) + (def last (get t (- len 1))) + (tuple-append (tuple-slice t 0 -2) (macroexpand1 last))) + + (defn expandall [t] + (def args (doarray (tuple-slice t 1))) + (apply tuple (get t 0) args)) + + (defn expandfn [t] + (def args (doarray (tuple-slice t 2))) + (apply tuple 'fn (get t 1) args)) + + (def specs { + ':= expandlast + 'ast-quote identity + 'def expandlast + 'do expandall + 'fn expandfn + 'if expandall + 'quote identity + 'var expandlast + 'while expandall + }) + + (defn dotup [t] + (def h (get t 0)) + (def s (get specs h)) + (def entry (get *env* h)) + (def m (get entry :value)) + (def m? (get entry :macro)) + (cond + s (s t) + m? (apply1 m (tuple-slice t 1)) + (apply1 tuple (doarray t)))) + + (defn doarray* [a] + (def res (doarray a)) + (if (= (apply tuple res) (apply tuple a)) a res)) + + (defn dotable* [t] + (def res (dotable t)) + (if (= (table-to-struct res) (table-to-struct t)) t res)) + + (def ux (ast-unwrap1 x)) + (select (type ux) + :tuple (dotup ux) + :array (doarray* ux) + :struct (table-to-struct (dotable ux)) + :table (dotable* ux) + ux)) + +(defn macroexpand + "Expand macros completely." + [x] + (var previous x) + (var current (macroexpand1 x)) + (var counter 0) + (while (not= current previous) + (if (> (++ counter) 200) + (error "macro expansion too nested")) + (:= previous current) + (:= current (macroexpand1 current))) + current) + (defn make-env [parent safe] (def parent (if parent parent _env)) (def newenv (setproto @{} parent)) (if (not safe) - (put newenv '_env @{'value newenv})) + (put newenv '_env @{:value newenv})) newenv) (def run-context @@ -444,9 +532,12 @@ onvalue." (put loading path true) (def f (file-open path)) (defn chunks [buf] (file-read f 1024 buf)) + (def oldenv *env*) + (:= *env* newenv) (run-context newenv chunks identity (fn [t x] (print (string t " error: " x)))) (file-close f) + (:= *env* oldenv) (put loading path nil) newenv))))) @@ -469,7 +560,7 @@ onvalue." (file-flush stdout) (file-read stdin :line buf)) (defn onvalue [x] - (put newenv '_ @{'value x}) + (put newenv '_ @{:value x}) (pp x)) (run-context newenv (if getchunk getchunk chunks) onvalue (fn [t x] (print (string t " error: " x))))) diff --git a/src/compiler/compile.c b/src/compiler/compile.c index 62f8964d..0d89cbf4 100644 --- a/src/compiler/compile.c +++ b/src/compiler/compile.c @@ -263,7 +263,7 @@ DstSlot dstc_resolve( dstc_error(c, ast, dst_formatc("unknown symbol %q", sym)); return dstc_cslot(dst_wrap_nil()); } - ref = dst_get(check, dst_csymbolv("ref")); + ref = dst_get(check, dst_csymbolv(":ref")); if (dst_checktype(ref, DST_ARRAY)) { DstSlot ret = dstc_cslot(ref); /* TODO save type info */ @@ -271,7 +271,7 @@ DstSlot dstc_resolve( ret.flags &= ~DST_SLOT_CONSTANT; return ret; } else { - Dst value = dst_get(check, dst_csymbolv("value")); + Dst value = dst_get(check, dst_csymbolv(":value")); return dstc_cslot(value); } } @@ -819,7 +819,7 @@ recur: for (;;) { if (dst_checktype(entry, DST_NIL)) break; if (dst_checktype(dst_get(entry, dst_csymbolv(":macro")), DST_NIL)) break; - fn = dst_get(entry, dst_csymbolv("value")); + fn = dst_get(entry, dst_csymbolv(":value")); if (!dst_checktype(fn, DST_FUNCTION)) break; if (macrorecur++ > DST_RECURSION_GUARD) { dstc_cerror(c, ast, "macro expansion recursed too deeply"); diff --git a/src/compiler/specials.c b/src/compiler/specials.c index f65955ed..e657ebc1 100644 --- a/src/compiler/specials.c +++ b/src/compiler/specials.c @@ -228,7 +228,7 @@ static void varleaf( reftab->proto = attr; DstArray *ref = dst_array(1); dst_array_push(ref, dst_wrap_nil()); - dst_table_put(reftab, dst_csymbolv("ref"), dst_wrap_array(ref)); + dst_table_put(reftab, dst_csymbolv(":ref"), dst_wrap_array(ref)); dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(reftab)); refslot = dstc_cslot(dst_wrap_array(ref)); refarrayslot = refslot; @@ -266,7 +266,7 @@ static void defleaf( DstTable *tab = dst_table(2); tab->proto = attr; int32_t tableindex, valsymindex, valueindex; - DstSlot valsym = dstc_cslot(dst_csymbolv("value")); + DstSlot valsym = dstc_cslot(dst_csymbolv(":value")); DstSlot tabslot = dstc_cslot(dst_wrap_table(tab)); /* Add env entry to env */ diff --git a/src/compiler/stl.c b/src/compiler/stl.c index 15584f60..96013e4b 100644 --- a/src/compiler/stl.c +++ b/src/compiler/stl.c @@ -109,6 +109,7 @@ DstTable *dst_stl_env() { dst_lib_array(args); dst_lib_tuple(args); dst_lib_buffer(args); + dst_lib_table(args); dst_lib_parse(args); dst_lib_compile(args); dst_lib_asm(args); diff --git a/src/core/table.c b/src/core/table.c index 4d7de197..ecdd9dd3 100644 --- a/src/core/table.c +++ b/src/core/table.c @@ -235,4 +235,25 @@ void dst_table_merge_struct(DstTable *table, const DstKV *other) { dst_table_mergekv(table, other, dst_struct_capacity(other)); } +static int cfun_tostruct(DstArgs args) { + DstTable *t; + if (args.n != 1 || !dst_checktype(args.v[0], DST_TABLE)) { + return dst_throw(args, "expected table"); + } + t = dst_unwrap_table(args.v[0]); + return dst_return(args, dst_wrap_struct(dst_table_to_struct(t))); +} + +static const DstReg cfuns[] = { + {"table-to-struct", cfun_tostruct}, + {NULL, NULL} +}; + +/* Load the table module */ +int dst_lib_table(DstArgs args) { + DstTable *env = dst_env_arg(args); + dst_env_cfuns(env, cfuns); + return 0; +} + #undef dst_table_maphash diff --git a/src/core/util.c b/src/core/util.c index 8c8b3800..c251704d 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -112,7 +112,7 @@ int dst_cstrcmp(const uint8_t *str, const char *other) { /* Add a module definition */ void dst_env_def(DstTable *env, const char *name, Dst val) { DstTable *subt = dst_table(1); - dst_table_put(subt, dst_csymbolv("value"), val); + dst_table_put(subt, dst_csymbolv(":value"), val); dst_table_put(env, dst_csymbolv(name), dst_wrap_table(subt)); } @@ -121,7 +121,7 @@ void dst_env_var(DstTable *env, const char *name, Dst val) { DstArray *array = dst_array(1); DstTable *subt = dst_table(1); dst_array_push(array, val); - dst_table_put(subt, dst_csymbolv("ref"), dst_wrap_array(array)); + dst_table_put(subt, dst_csymbolv(":ref"), dst_wrap_array(array)); dst_table_put(env, dst_csymbolv(name), dst_wrap_table(subt)); } @@ -139,11 +139,11 @@ Dst dst_env_resolve(DstTable *env, const char *name) { Dst ref; Dst entry = dst_table_get(env, dst_csymbolv(name)); if (dst_checktype(entry, DST_NIL)) return dst_wrap_nil(); - ref = dst_get(entry, dst_csymbolv("ref")); + ref = dst_get(entry, dst_csymbolv(":ref")); if (dst_checktype(ref, DST_ARRAY)) { return dst_getindex(ref, 0); } - return dst_get(entry, dst_csymbolv("value")); + return dst_get(entry, dst_csymbolv(":value")); } /* Get module from the arguments passed to library */ diff --git a/src/include/dst/dstcorelib.h b/src/include/dst/dstcorelib.h index fb91417e..b59c78e9 100644 --- a/src/include/dst/dstcorelib.h +++ b/src/include/dst/dstcorelib.h @@ -112,6 +112,7 @@ int dst_lib_math(DstArgs args); int dst_lib_array(DstArgs args); int dst_lib_tuple(DstArgs args); int dst_lib_buffer(DstArgs args); +int dst_lib_table(DstArgs args); /* Useful for compiler */ Dst dst_op_add(Dst lhs, Dst rhs); diff --git a/src/parser/ast.c b/src/parser/ast.c index 51d19f0f..664ebcbb 100644 --- a/src/parser/ast.c +++ b/src/parser/ast.c @@ -152,6 +152,7 @@ static Dst astunwrap_table(DstTable *other) { } if (!prescan) return dst_wrap_table(other); table = dst_table(other->capacity); + table->proto = other->proto; iter = NULL; while ((iter = dst_table_next(other, iter))) { if (iter == prescan) break;