diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index 71e14dc6..47f8933f 100644 --- a/src/compiler/boot.dst +++ b/src/compiler/boot.dst @@ -32,18 +32,20 @@ (apply tuple (array-concat ['defn name 'private] more))) +(defmacro comment + "Ignores the body of the comment." + []) + (defmacro when - "(when cond & body) - Evaluates the body when the condition is true. Otherwise returns nil." + "Evaluates the body when the condition is true. Otherwise returns nil." [cond & body] (tuple 'if cond (tuple-prepend body 'do))) (defmacro cond - "(cond & body) - Evaluates conditions sequentially until the first true condition - is found, and then executes the corresponding body. If there are an - odd number of forms, the last expression is executed if no forms - are matched. If there are no matches, return nil." +"Evaluates conditions sequentially until the first true condition +is found, and then executes the corresponding body. If there are an +odd number of forms, the last expression is executed if no forms +are matched. If there are no matches, return nil." [& pairs] (defn aux [i] (def restlen (- (length pairs) i)) @@ -55,8 +57,7 @@ (aux 0)) (defn doc - "(doc sym) - Shows documentation for the given symbol." + "Shows documentation for the given symbol." [sym] (def x (get *env* sym)) (if (not x) @@ -66,10 +67,9 @@ (print "\n" (if d d "no documentation found.") "\n")))) (defmacro select -"(select dispatch & body) - Select the body that equals the dispatch value. When pairs - has an odd number of arguments, the last is the default expression. - If no match is found, returns nil" +"Select the body that equals the dispatch value. When pairs +has an odd number of arguments, the last is the default expression. +If no match is found, returns nil" [dispatch & pairs] (def sym (gensym)) (defn aux [i] @@ -87,8 +87,7 @@ (defmacro and [x y] (tuple 'if x y false)) (defn identity - "(identity x) - A function that returns its first argument." + "A function that returns its first argument." [x] x) (def seq (do @@ -204,8 +203,6 @@ (tuple-prepend body 'do) (tuple 'varset! sym (tuple '+ sym inc))))) -# Compile time - (defn make-env [parent] (def parent (if parent parent _env)) (def newenv (setproto @{} parent)) @@ -213,18 +210,17 @@ (put _env '_env nil) (def run-context - "(run-context env chunks onvalue onerr) - Run a context. This evaluates expressions of dst in an environment, - and is encapsulates the parsing, compilation, and evaluation of dst. - env is the environment to evaluate the code in, chunks is a function - that returns strings or buffers of source code (from a repl, file, - network connection, etc. onvalue and onerr are callbacks that are - invoked when a result is returned and when an error is produced, - respectively. +"Run a context. This evaluates expressions of dst in an environment, +and is encapsulates the parsing, compilation, and evaluation of dst. +env is the environment to evaluate the code in, chunks is a function +that returns strings or buffers of source code (from a repl, file, +network connection, etc. onvalue and onerr are callbacks that are +invoked when a result is returned and when an error is produced, +respectively. - This function can be used to implemement a repl very easily, simply - pass a function that reads line from stdin to chunks, and print to - onvalue." +This function can be used to implemement a repl very easily, simply +pass a function that reads line from stdin to chunks, and print to +onvalue." (do (defn val-stream [chunks onerr] (var going true) @@ -259,7 +255,6 @@ (do (varset! temp nil) tempval) (resume f))) {:more more :next next}) - (fn [env chunks onvalue onerr] (defn doone [source] (def f (fiber (fn [] @@ -301,8 +296,7 @@ (def { :prefix prefix } (apply table args)) - (defn one [pair] - (def [k v] pair) + (defn one [[k v]] (when (not (get v 'private)) (put *env* (symbol (if prefix prefix "") k) v))) (doseq (map one (pairs env)))) diff --git a/src/compiler/specials.c b/src/compiler/specials.c index b89cb62c..55c19eaa 100644 --- a/src/compiler/specials.c +++ b/src/compiler/specials.c @@ -49,10 +49,8 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right, DstAst *ast, const uint8_t *sym, DstSlot s, - int32_t argn, - const Dst *argv), - int32_t argn, - const Dst *argv) { + DstTable *attr), + DstTable *attr) { DstAst *ast = dst_ast_node(left); left = dst_ast_unwrap1(left); switch (dst_type(left)) { @@ -61,7 +59,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right, break; case DST_SYMBOL: /* Leaf, assign right to left */ - leaf(c, ast, dst_unwrap_symbol(left), right, argn, argv); + leaf(c, ast, dst_unwrap_symbol(left), right, attr); break; case DST_TUPLE: case DST_ARRAY: @@ -94,7 +92,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right, newright.constant = dst_wrap_nil(); newright.flags = DST_SLOTTYPE_ANY; /* Traverse into the structure */ - destructure(c, subval, newright, leaf, argn, argv); + destructure(c, subval, newright, leaf, attr); dstc_postread(c, right, localright); } } @@ -124,7 +122,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right, newright.constant = dst_wrap_nil(); newright.flags = DST_SLOTTYPE_ANY; /* Traverse into the structure */ - destructure(c, subval, newright, leaf, argn, argv); + destructure(c, subval, newright, leaf, attr); dstc_postread(c, right, localright); } } @@ -161,14 +159,15 @@ DstSlot dstc_varset(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) { } /* Add attributes to a global def or var table */ -static void handleattr(DstCompiler *c, int32_t argn, const Dst *argv, DstTable *tab) { +static DstTable *handleattr(DstCompiler *c, int32_t argn, const Dst *argv) { int32_t i; + DstTable *tab = dst_table(2); for (i = 1; i < argn - 1; i++) { Dst attr = dst_ast_unwrap1(argv[i]); switch (dst_type(attr)) { default: dstc_cerror(c, dst_ast_node(argv[i]), "could not add metadata to binding"); - return; + break; case DST_SYMBOL: dst_table_put(tab, attr, dst_wrap_true()); break; @@ -177,6 +176,7 @@ static void handleattr(DstCompiler *c, int32_t argn, const Dst *argv, DstTable * break; } } + return tab; } static DstSlot dohead(DstCompiler *c, DstFopts opts, DstAst *ast, Dst *head, int32_t argn, const Dst *argv) { @@ -220,16 +220,15 @@ static void varleaf( DstAst *ast, const uint8_t *sym, DstSlot s, - int32_t argn, - const Dst *argv) { + DstTable *attr) { if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) { DstSlot refslot, refarrayslot; /* Global var, generate var */ DstTable *reftab = dst_table(1); + 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)); - handleattr(c, argn, argv, reftab); dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(reftab)); refslot = dstc_cslot(dst_wrap_array(ref)); refarrayslot = refslot; @@ -253,7 +252,7 @@ DstSlot dstc_var(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) { Dst head; DstSlot ret = dohead(c, opts, ast, &head, argn, argv); if (dstc_iserr(&opts)) return dstc_cslot(dst_wrap_nil()); - destructure(c, argv[0], ret, varleaf, argn, argv); + destructure(c, argv[0], ret, varleaf, handleattr(c, argn, argv)); return dstc_cslot(dst_wrap_nil()); } @@ -262,16 +261,15 @@ static void defleaf( DstAst *ast, const uint8_t *sym, DstSlot s, - int32_t argn, - const Dst *argv) { + DstTable *attr) { if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) { DstTable *tab = dst_table(2); + tab->proto = attr; int32_t tableindex, valsymindex, valueindex; DstSlot valsym = dstc_cslot(dst_csymbolv("value")); DstSlot tabslot = dstc_cslot(dst_wrap_table(tab)); /* Add env entry to env */ - handleattr(c, argn, argv, tab); dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(tab)); /* Put value in table when evaulated */ @@ -297,7 +295,7 @@ DstSlot dstc_def(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) { opts.flags &= ~DST_FOPTS_HINT; DstSlot ret = dohead(c, opts, ast, &head, argn, argv); if (dstc_iserr(&opts)) return dstc_cslot(dst_wrap_nil()); - destructure(c, argv[0], ret, defleaf, argn, argv); + destructure(c, argv[0], ret, defleaf, handleattr(c, argn, argv)); return dstc_cslot(dst_wrap_nil()); } @@ -550,11 +548,15 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) { slot.constant = dst_wrap_nil(); slot.index = dstc_lsloti(c); dstc_nameslot(c, dst_unwrap_symbol(param), slot); - arity++; } else { - dstc_cerror(c, dst_ast_node(params[i]), "expected symbol as function parameter"); - return dstc_cslot(dst_wrap_nil()); + DstSlot s; + s.envindex = -1; + s.flags = DST_SLOTTYPE_ANY; + s.constant = dst_wrap_nil(); + s.index = dstc_lsloti(c); + destructure(c, param, s, defleaf, NULL); } + arity++; } } else { dstc_cerror(c, ast, "expected function parameters"); @@ -573,7 +575,9 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) { } /* Compile function body */ - for (argi = parami + 1; argi < argn; argi++) { + if (parami + 1 == argn) { + dstc_emit(c, ast, DOP_RETURN_NIL); + } else for (argi = parami + 1; argi < argn; argi++) { DstSlot s; subopts.flags = argi == (argn - 1) ? DST_FOPTS_TAIL : DST_FOPTS_DROP; s = dstc_value(subopts, argv[argi]);