From 2487162ccf5af488bdf163cd542efe87262c94ff Mon Sep 17 00:00:00 2001
From: Calvin Rose <calsrose@gmail.com>
Date: Wed, 4 Dec 2019 18:36:37 -0600
Subject: [PATCH] Add top level unquote and macro envs.

This improves macros that eval their arguments and
makes them easier to write.
---
 src/boot/boot.janet |  5 +++++
 src/core/compile.c  | 23 ++++++++++++++++-------
 src/core/specials.c |  8 --------
 test/suite7.janet   |  7 +++++++
 4 files changed, 28 insertions(+), 15 deletions(-)

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)