mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-07 17:29:54 +00:00
Code Issues 1 Releases Wiki Activity

Allow destructuring in function args

Browse Source
This commit is contained in:
Calvin Rose 2018-03-12 02:06:51 -04:00
parent 8445b1187f
commit e393e3dda0
2 changed files with 50 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
src/compiler/boot.dst
View File

@ -32,18 +32,20 @@
(apply tuple (array-concat (apply tuple (array-concat
['defn name 'private] more))) ['defn name 'private] more)))
(defmacro comment
"Ignores the body of the comment."
[])
(defmacro when (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] [cond & body]
(tuple 'if cond (tuple-prepend body 'do))) (tuple 'if cond (tuple-prepend body 'do)))
(defmacro cond (defmacro cond
"(cond & body) "Evaluates conditions sequentially until the first true condition
Evaluates conditions sequentially until the first true condition is found, and then executes the corresponding body. If there are an
is found, and then executes the corresponding body. If there are an odd number of forms, the last expression is executed if no forms
odd number of forms, the last expression is executed if no forms are matched. If there are no matches, return nil."
are matched. If there are no matches, return nil."
[& pairs] [& pairs]
(defn aux [i] (defn aux [i]
(def restlen (- (length pairs) i)) (def restlen (- (length pairs) i))
@ -55,8 +57,7 @@
(aux 0)) (aux 0))
(defn doc (defn doc
"(doc sym) "Shows documentation for the given symbol."
Shows documentation for the given symbol."
[sym] [sym]
(def x (get *env* sym)) (def x (get *env* sym))
(if (not x) (if (not x)
@ -66,10 +67,9 @@
(print "\n" (if d d "no documentation found.") "\n")))) (print "\n" (if d d "no documentation found.") "\n"))))
(defmacro select (defmacro select
"(select dispatch & body) "Select the body that equals the dispatch value. When pairs
Select the body that equals the dispatch value. When pairs has an odd number of arguments, the last is the default expression.
has an odd number of arguments, the last is the default expression. If no match is found, returns nil"
If no match is found, returns nil"
[dispatch & pairs] [dispatch & pairs]
(def sym (gensym)) (def sym (gensym))
(defn aux [i] (defn aux [i]
@ -87,8 +87,7 @@
(defmacro and [x y] (tuple 'if x y false)) (defmacro and [x y] (tuple 'if x y false))
(defn identity (defn identity
"(identity x) "A function that returns its first argument."
A function that returns its first argument."
[x] x) [x] x)
(def seq (do (def seq (do
@ -204,8 +203,6 @@
(tuple-prepend body 'do) (tuple-prepend body 'do)
(tuple 'varset! sym (tuple '+ sym inc))))) (tuple 'varset! sym (tuple '+ sym inc)))))
# Compile time
(defn make-env [parent] (defn make-env [parent]
(def parent (if parent parent _env)) (def parent (if parent parent _env))
(def newenv (setproto @{} parent)) (def newenv (setproto @{} parent))
@ -213,18 +210,17 @@
(put _env '_env nil) (put _env '_env nil)
(def run-context (def run-context
"(run-context env chunks onvalue onerr) "Run a context. This evaluates expressions of dst in an environment,
Run a context. This evaluates expressions of dst in an environment, and is encapsulates the parsing, compilation, and evaluation of dst.
and is encapsulates the parsing, compilation, and evaluation of dst. env is the environment to evaluate the code in, chunks is a function
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,
that returns strings or buffers of source code (from a repl, file, network connection, etc. onvalue and onerr are callbacks that are
network connection, etc. onvalue and onerr are callbacks that are invoked when a result is returned and when an error is produced,
invoked when a result is returned and when an error is produced, respectively.
respectively.
This function can be used to implemement a repl very easily, simply 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 pass a function that reads line from stdin to chunks, and print to
onvalue." onvalue."
(do (do
(defn val-stream [chunks onerr] (defn val-stream [chunks onerr]
(var going true) (var going true)
@ -259,7 +255,6 @@
(do (varset! temp nil) tempval) (do (varset! temp nil) tempval)
(resume f))) (resume f)))
{:more more :next next}) {:more more :next next})
(fn [env chunks onvalue onerr] (fn [env chunks onvalue onerr]
(defn doone [source] (defn doone [source]
(def f (fiber (fn [] (def f (fiber (fn []
@ -301,8 +296,7 @@
(def { (def {
:prefix prefix :prefix prefix
} (apply table args)) } (apply table args))
(defn one [pair] (defn one [[k v]]
(def [k v] pair)
(when (not (get v 'private)) (when (not (get v 'private))
(put *env* (symbol (if prefix prefix "") k) v))) (put *env* (symbol (if prefix prefix "") k) v)))
(doseq (map one (pairs env)))) (doseq (map one (pairs env))))

46
src/compiler/specials.c
View File

@ -49,10 +49,8 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
DstAst *ast, DstAst *ast,
const uint8_t *sym, const uint8_t *sym,
DstSlot s, DstSlot s,
int32_t argn, DstTable *attr),
const Dst *argv), DstTable *attr) {
int32_t argn,
const Dst *argv) {
DstAst *ast = dst_ast_node(left); DstAst *ast = dst_ast_node(left);
left = dst_ast_unwrap1(left); left = dst_ast_unwrap1(left);
switch (dst_type(left)) { switch (dst_type(left)) {
@ -61,7 +59,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
break; break;
case DST_SYMBOL: case DST_SYMBOL:
/* Leaf, assign right to left */ /* 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; break;
case DST_TUPLE: case DST_TUPLE:
case DST_ARRAY: case DST_ARRAY:
@ -94,7 +92,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
newright.constant = dst_wrap_nil(); newright.constant = dst_wrap_nil();
newright.flags = DST_SLOTTYPE_ANY; newright.flags = DST_SLOTTYPE_ANY;
/* Traverse into the structure */ /* Traverse into the structure */
destructure(c, subval, newright, leaf, argn, argv); destructure(c, subval, newright, leaf, attr);
dstc_postread(c, right, localright); dstc_postread(c, right, localright);
} }
} }
@ -124,7 +122,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
newright.constant = dst_wrap_nil(); newright.constant = dst_wrap_nil();
newright.flags = DST_SLOTTYPE_ANY; newright.flags = DST_SLOTTYPE_ANY;
/* Traverse into the structure */ /* Traverse into the structure */
destructure(c, subval, newright, leaf, argn, argv); destructure(c, subval, newright, leaf, attr);
dstc_postread(c, right, localright); 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 */ /* 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; int32_t i;
DstTable *tab = dst_table(2);
for (i = 1; i < argn - 1; i++) { for (i = 1; i < argn - 1; i++) {
Dst attr = dst_ast_unwrap1(argv[i]); Dst attr = dst_ast_unwrap1(argv[i]);
switch (dst_type(attr)) { switch (dst_type(attr)) {
default: default:
dstc_cerror(c, dst_ast_node(argv[i]), "could not add metadata to binding"); dstc_cerror(c, dst_ast_node(argv[i]), "could not add metadata to binding");
return; break;
case DST_SYMBOL: case DST_SYMBOL:
dst_table_put(tab, attr, dst_wrap_true()); dst_table_put(tab, attr, dst_wrap_true());
break; break;
@ -177,6 +176,7 @@ static void handleattr(DstCompiler *c, int32_t argn, const Dst *argv, DstTable *
break; break;
} }
} }
return tab;
} }
static DstSlot dohead(DstCompiler *c, DstFopts opts, DstAst *ast, Dst *head, int32_t argn, const Dst *argv) { 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, DstAst *ast,
const uint8_t *sym, const uint8_t *sym,
DstSlot s, DstSlot s,
int32_t argn, DstTable *attr) {
const Dst *argv) {
if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) { if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) {
DstSlot refslot, refarrayslot; DstSlot refslot, refarrayslot;
/* Global var, generate var */ /* Global var, generate var */
DstTable *reftab = dst_table(1); DstTable *reftab = dst_table(1);
reftab->proto = attr;
DstArray *ref = dst_array(1); DstArray *ref = dst_array(1);
dst_array_push(ref, dst_wrap_nil()); 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));
handleattr(c, argn, argv, reftab);
dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(reftab)); dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(reftab));
refslot = dstc_cslot(dst_wrap_array(ref)); refslot = dstc_cslot(dst_wrap_array(ref));
refarrayslot = refslot; refarrayslot = refslot;
@ -253,7 +252,7 @@ DstSlot dstc_var(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
Dst head; Dst head;
DstSlot ret = dohead(c, opts, ast, &head, argn, argv); DstSlot ret = dohead(c, opts, ast, &head, argn, argv);
if (dstc_iserr(&opts)) return dstc_cslot(dst_wrap_nil()); 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()); return dstc_cslot(dst_wrap_nil());
} }
@ -262,16 +261,15 @@ static void defleaf(
DstAst *ast, DstAst *ast,
const uint8_t *sym, const uint8_t *sym,
DstSlot s, DstSlot s,
int32_t argn, DstTable *attr) {
const Dst *argv) {
if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) { if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) {
DstTable *tab = dst_table(2); DstTable *tab = dst_table(2);
tab->proto = attr;
int32_t tableindex, valsymindex, valueindex; 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)); DstSlot tabslot = dstc_cslot(dst_wrap_table(tab));
/* Add env entry to env */ /* Add env entry to env */
handleattr(c, argn, argv, tab);
dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(tab)); dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(tab));
/* Put value in table when evaulated */ /* 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; opts.flags &= ~DST_FOPTS_HINT;
DstSlot ret = dohead(c, opts, ast, &head, argn, argv); DstSlot ret = dohead(c, opts, ast, &head, argn, argv);
if (dstc_iserr(&opts)) return dstc_cslot(dst_wrap_nil()); 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()); 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.constant = dst_wrap_nil();
slot.index = dstc_lsloti(c); slot.index = dstc_lsloti(c);
dstc_nameslot(c, dst_unwrap_symbol(param), slot); dstc_nameslot(c, dst_unwrap_symbol(param), slot);
arity++;
} else { } else {
dstc_cerror(c, dst_ast_node(params[i]), "expected symbol as function parameter"); DstSlot s;
return dstc_cslot(dst_wrap_nil()); 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 { } else {
dstc_cerror(c, ast, "expected function parameters"); 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 */ /* 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; DstSlot s;
subopts.flags = argi == (argn - 1) ? DST_FOPTS_TAIL : DST_FOPTS_DROP; subopts.flags = argi == (argn - 1) ? DST_FOPTS_TAIL : DST_FOPTS_DROP;
s = dstc_value(subopts, argv[argi]); s = dstc_value(subopts, argv[argi]);