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:
Calvin Rose 2019-12-04 18:36:37 -06:00
parent 8ca10f37bd
commit 2487162ccf
4 changed files with 28 additions and 15 deletions

View File

@ -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."

View File

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

View File

@ -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}
};

View File

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