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
['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))))

46
src/compiler/specials.c
View File

@ -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]);