diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 34c9b739..5ec3be6e 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -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." diff --git a/src/core/compile.c b/src/core/compile.c index e6b9de64..e1725516 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -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); diff --git a/src/core/specials.c b/src/core/specials.c index 83c686b1..210f8004 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -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} }; diff --git a/test/suite7.janet b/test/suite7.janet index 2f92d2c0..ed9f3820 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -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)