mirror of
https://github.com/janet-lang/janet
synced 2024-12-26 00:10:27 +00:00
Add top level unquote and macro envs.
This improves macros that eval their arguments and makes them easier to write.
This commit is contained in:
parent
8ca10f37bd
commit
2487162ccf
@ -1850,6 +1850,11 @@
|
||||
(res)
|
||||
(error (res :error))))
|
||||
|
||||
(def unquote
|
||||
"(unquote x)\n\nEscapes one level inside of a quasiquote. When used outside of a quasiquote, evaluates
|
||||
its argument at compile-time."
|
||||
:macro eval)
|
||||
|
||||
(defn make-image
|
||||
"Create an image from an environment returned by require.
|
||||
Returns the image source as a string."
|
||||
|
@ -569,15 +569,24 @@ static int macroexpand1(
|
||||
return 0;
|
||||
|
||||
/* Evaluate macro */
|
||||
JanetFiber *fiberp = NULL;
|
||||
JanetFunction *macro = janet_unwrap_function(macroval);
|
||||
int32_t arity = janet_tuple_length(form) - 1;
|
||||
JanetFiber *fiberp = janet_fiber(macro, 64, arity, form + 1);
|
||||
if (NULL == fiberp) {
|
||||
int32_t minar = macro->def->min_arity;
|
||||
int32_t maxar = macro->def->max_arity;
|
||||
const uint8_t *es = NULL;
|
||||
if (minar >= 0 && arity < minar)
|
||||
es = janet_formatc("macro arity mismatch, expected at least %d, got %d", minar, arity);
|
||||
if (maxar >= 0 && arity > maxar)
|
||||
es = janet_formatc("macro arity mismatch, expected at most %d, got %d", maxar, arity);
|
||||
c->result.macrofiber = NULL;
|
||||
janetc_error(c, es);
|
||||
}
|
||||
/* Set env */
|
||||
fiberp->env = c->env;
|
||||
int lock = janet_gclock();
|
||||
JanetSignal status = janet_pcall(
|
||||
macro,
|
||||
janet_tuple_length(form) - 1,
|
||||
form + 1,
|
||||
&x,
|
||||
&fiberp);
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &x);
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", x);
|
||||
|
@ -120,13 +120,6 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a
|
||||
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
|
||||
}
|
||||
|
||||
static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
(void) argn;
|
||||
(void) argv;
|
||||
janetc_cerror(opts.compiler, "cannot use unquote here");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
|
||||
/* Perform destructuring. Be careful to
|
||||
* keep the order registers are freed.
|
||||
* Returns if the slot 'right' can be freed. */
|
||||
@ -819,7 +812,6 @@ static const JanetSpecial janetc_specials[] = {
|
||||
{"quote", janetc_quote},
|
||||
{"set", janetc_varset},
|
||||
{"splice", janetc_splice},
|
||||
{"unquote", janetc_unquote},
|
||||
{"var", janetc_var},
|
||||
{"while", janetc_while}
|
||||
};
|
||||
|
@ -270,4 +270,11 @@
|
||||
(def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
|
||||
(assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f)) "nested quasiquote")
|
||||
|
||||
# Top level unquote
|
||||
(defn constantly
|
||||
[]
|
||||
,(math/random))
|
||||
|
||||
(assert (= (constantly) (constantly)) "top level unquote")
|
||||
|
||||
(end-suite)
|
||||
|
Loading…
Reference in New Issue
Block a user