Replace unquote-splicing with a more general splce special form.

This allows splicing behavior in normal function calls.

src/core/compile.c

@@ -321,12 +321,40 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
 /* Push slots load via janetc_toslots. */
 void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
     int32_t i;
-    for (i = 0; i < janet_v_count(slots) - 2; i += 3)
+    int32_t count = janet_v_count(slots);
-        janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i+1], slots[i+2], 0);
+    for (i = 0; i < count;) {
-    if (i == janet_v_count(slots) - 2)
+        if (slots[i].flags & JANET_SLOT_SPLICED) {
-        janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
+            janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i], 0);
-    else if (i == janet_v_count(slots) - 1)
+            i++;
-        janetc_emit_s(c, JOP_PUSH, slots[i], 0);
+        } else if (i + 1 == count) {
+            janetc_emit_s(c, JOP_PUSH, slots[i], 0);
+            i++;
+        } else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
+            janetc_emit_s(c, JOP_PUSH, slots[i], 0);
+            janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+1], 0);
+            i += 2;
+        } else if (i + 2 == count) {
+            janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
+            i += 2;
+        } else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
+            janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
+            janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+2], 0);
+            i += 3;
+        } else {
+            janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i+1], slots[i+2], 0);
+            i += 3;
+        }
+    }
+}
+
+/* Check if a list of slots has any spliced slots */
+static int has_spliced(JanetSlot *slots) {
+    int32_t i;
+    for (i = 0; i < janet_v_count(slots); i++) {
+        if (slots[i].flags & JANET_SLOT_SPLICED)
+            return 1;
+    }
+    return 0;
 }
 
 /* Free slots loaded via janetc_toslots */
@@ -361,7 +389,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
     JanetSlot retslot;
     JanetCompiler *c = opts.compiler;
     int specialized = 0;
-    if (fun.flags & JANET_SLOT_CONSTANT) {
+    if (fun.flags & JANET_SLOT_CONSTANT && !has_spliced(slots)) {
         if (janet_checktype(fun.constant, JANET_FUNCTION)) {
             JanetFunction *f = janet_unwrap_function(fun.constant);
             const JanetFunOptimizer *o = janetc_funopt(f->def->flags);
@@ -521,6 +549,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
                         ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
                         janetc_freeslot(c, head);
                     }
+                    ret.flags &= ~JANET_SLOT_SPLICED;
                 }
                 break;
             case JANET_SYMBOL:

src/core/core.janet

@@ -40,7 +40,7 @@
       (:= index (+ index 1)))
     (array/push modifiers (string buf ")\n\n" docstr))
     # Build return value
-    ~(def ,name ;modifiers (fn ,name ;(tuple/slice more start)))))
+    ~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
 
 (defn defmacro :macro
   "Define a macro."
@@ -60,7 +60,7 @@
 (defmacro def-
   "Define a private value that will not be exported."
   [name & more]
-  ~(def name :private ;more))
+  ~(def name :private ,;more))
 
 (defn defglobal
   "Dynamically create a global def."
@@ -165,12 +165,12 @@
 (defmacro when
   "Evaluates the body when the condition is true. Otherwise returns nil."
   [condition & body]
-  ~(if ,condition (do ;body)))
+  ~(if ,condition (do ,;body)))
 
 (defmacro unless
   "Shorthand for (when (not ... "
   [condition & body]
-  ~(if ,condition nil (do ;body)))
+  ~(if ,condition nil (do ,;body)))
 
 (defmacro cond
   "Evaluates conditions sequentially until the first true condition
@@ -404,7 +404,7 @@
   "Create a generator expression using the loop syntax. Returns a fiber
   that yields all values inside the loop in order. See loop for details."
   [head & body]
-  ~(fiber/new (fn [&] (loop ,head (yield (do ;body))))))
+  ~(fiber/new (fn [&] (loop ,head (yield (do ,;body))))))
 
 (defmacro for
   "Do a c style for loop for side effects. Returns nil."
@@ -416,21 +416,23 @@
   [binding ind & body]
   (apply loop [tuple binding :in ind] body))
 
-(defn sum [xs]
+(defmacro coro
+  "A wrapper for making fibers. Same as (fiber/new (fn [&] ...body))."
+  [& body]
+  (tuple fiber/new (tuple 'fn '[&] ;body)))
+
+(defn sum
+  [xs]
   (var accum 0)
   (loop [x :in xs] (+= accum x))
   accum)
 
-(defn product [xs]
+(defn product
+  [xs]
   (var accum 1)
   (loop [x :in xs] (*= accum x))
   accum)
 
-(defmacro coro
-  "A wrapper for making fibers. Same as (fiber/new (fn [&] ...body))."
-  [& body]
-  (tuple fiber/new (apply tuple 'fn '[&] body)))
-
 (defmacro if-let
   "Takes the first one or two forms in a vector and if both are true binds
   all the forms with let and evaluates the first expression else
@@ -466,7 +468,7 @@
   "Takes the first one or two forms in vector and if true binds
   all the forms  with let and evaluates the body"
   [bindings & body]
-  ~(if-let ,bindings (do ;body)))
+  ~(if-let ,bindings (do ,;body)))
 
 (defn comp
   "Takes multiple functions and returns a function that is the composition
@@ -479,8 +481,8 @@
     3 (let [[f g h]     functions] (fn [x] (f (g (h x)))))
     4 (let [[f g h i]   functions] (fn [x] (f (g (h (i x))))))
     (let [[f g h i j] functions]
-      (apply comp (fn [x] (f (g (h (i (j x))))))
+      (comp (fn [x] (f (g (h (i (j x))))))
-             (tuple/slice functions 5 -1)))))
+             ;(tuple/slice functions 5 -1)))))
 
 (defn identity
   "A function that returns its first argument."
@@ -590,7 +592,7 @@
     (loop [i :range [0 limit]]
       (def args (array/new ninds))
       (loop [j :range [0 ninds]] (:= args.j inds.j.i))
-      (:= res.i (apply f args))))
+      (:= res.i (f ;args))))
   res)
 
 (defn mapcat
@@ -696,7 +698,7 @@
   (fn [& args]
     (def ret @[])
     (loop [f :in funs]
-      (array/push ret (apply f args)))
+      (array/push ret (f ;args)))
     (tuple/slice ret 0)))
 
 (defmacro juxt
@@ -738,7 +740,7 @@
   "Partial function application."
   [f & more]
   (if (zero? (length more)) f
-    (fn [& r] (apply f (array/concat @[] more r)))))
+    (fn [& r] (f ;more ;r))))
 
 (defn every? 
   "Returns true if each value in is truthy, otherwise the first
@@ -787,7 +789,7 @@ value, one key will be ignored."
   The key then, is associated to the function's return value"
   [coll a-key a-function & args]
   (def old-value coll.a-key)
-  (:= coll.a-key (apply a-function old-value args)))
+  (:= coll.a-key (a-function old-value ;args)))
 
 (defn merge-into
   "Merges multiple tables/structs into a table. If a key appears in more than one
@@ -857,7 +859,7 @@ value, one key will be ignored."
   (def res @[])
   (def ncol (length cols))
   (when (> ncol 0)
-    (def len (apply min (map length cols)))
+    (def len (min ;(map length cols)))
     (loop [i :range [0 len]
            ci :range [0 ncol]]
         (array/push res cols.ci.i)))
@@ -1008,16 +1010,16 @@ value, one key will be ignored."
 
   (defn expandall [t]
     (def args (map macex1 (tuple/slice t 1)))
-    (apply tuple t.0 args))
+    (tuple t.0 ;args))
 
   (defn expandfn [t]
     (if (symbol? t.1)
       (do
         (def args (map macex1 (tuple/slice t 3)))
-        (apply tuple 'fn t.1 t.2 args))
+        (tuple 'fn t.1 t.2 ;args))
       (do
         (def args (map macex1 (tuple/slice t 2)))
-        (apply tuple 'fn t.1 args))))
+        (tuple 'fn t.1 ;args))))
 
   (defn expandqq [t]
     (defn qq [x]
@@ -1052,7 +1054,7 @@ value, one key will be ignored."
     (def m? entry:macro)
     (cond
       s (s t)
-      m? (apply m (tuple/slice t 1))
+      m? (m ;(tuple/slice t 1))
       (tuple/slice (map macex1 t))))
 
   (def ret
@@ -1358,7 +1360,7 @@ value, one key will be ignored."
 
 (defn import* 
   [env path & args]
-  (def targs (apply table args))
+  (def targs (table ;args))
   (def {:as as
         :prefix prefix} targs)
   (def newenv (require path targs))
@@ -1383,7 +1385,7 @@ value, one key will be ignored."
                      x
                      (string x)))
                  args))
-  (apply tuple import* '_env (string path) argm))
+  (tuple import* '_env (string path) ;argm))
 
 (defn repl
   "Run a repl. The first parameter is an optional function to call to

src/core/parse.c

@@ -171,7 +171,7 @@ static void popstate(JanetParser *p, Janet val) {
             const char *which = 
                 (c == '\'') ? "quote" :
                 (c == ',') ? "unquote" :
-                (c == ';') ? "unquote-splicing" :
+                (c == ';') ? "splice" :
                 (c == '~') ? "quasiquote" : "<unknown>";
             t[0] = janet_csymbolv(which);
             t[1] = val;

src/core/specials.c

@@ -34,20 +34,26 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
     return janetc_cslot(argv[0]);
 }
 
+static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
+    JanetSlot ret;
+    if (argn != 1) {
+        janetc_cerror(opts.compiler, "expected 1 argument");
+        return janetc_cslot(janet_wrap_nil());
+    }
+    ret = janetc_value(opts, argv[0]);
+    ret.flags |= JANET_SLOT_SPLICED;
+    return ret;
+}
+
 static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) {
     JanetSlot target = janetc_gettarget(opts);
-    int32_t i;
+    janetc_pushslots(opts.compiler, slots);
-    for (i = 0; i < janet_v_count(slots); i++) {
-        JanetSlot s = slots[i];
-        int op = (s.flags & JANET_SLOT_SPLICED) ? JOP_PUSH_ARRAY : JOP_PUSH;
-        janetc_emit_s(opts.compiler, op, s, 0);
-    }
     janetc_freeslots(opts.compiler, slots);
     janetc_emit_s(opts.compiler, makeop, target, 1);
     return target;
 }
 
-static JanetSlot quasiquote(JanetFopts opts, Janet x, int can_splice) {
+static JanetSlot quasiquote(JanetFopts opts, Janet x) {
     JanetSlot *slots = NULL;
     switch (janet_type(x)) {
         default:
@@ -59,20 +65,11 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int can_splice) {
                 len = janet_tuple_length(tup);
                 if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
                     const uint8_t *head = janet_unwrap_symbol(tup[0]);
-                    if (!janet_cstrcmp(head, "unquote")) {
+                    if (!janet_cstrcmp(head, "unquote"))
                         return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
-                    } else if (!janet_cstrcmp(head, "unquote-splicing")) {
-                        JanetSlot s;
-                        if (!can_splice) {
-                            janetc_cerror(opts.compiler, "cannot use unquote-splicing here");
-                        }
-                        s = janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
-                        s.flags |= JANET_SLOT_SPLICED;
-                        return s;
-                    }
                 }
                 for (i = 0; i < len; i++)
-                    janet_v_push(slots, quasiquote(opts, tup[i], 1));
+                    janet_v_push(slots, quasiquote(opts, tup[i]));
                 return qq_slots(opts, slots, JOP_MAKE_TUPLE);
             }
         case JANET_ARRAY:
@@ -80,7 +77,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int can_splice) {
                 int32_t i;
                 JanetArray *array = janet_unwrap_array(x);
                 for (i = 0; i < array->count; i++)
-                    janet_v_push(slots, quasiquote(opts, array->data[i], 1));
+                    janet_v_push(slots, quasiquote(opts, array->data[i]));
                 return qq_slots(opts, slots, JOP_MAKE_ARRAY);
             }
         case JANET_TABLE:
@@ -90,8 +87,12 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int can_splice) {
                 int32_t len, cap;
                 janet_dictionary_view(x, &kvs, &len, &cap);
                 while ((kv = janet_dictionary_next(kvs, cap, kv))) {
-                    janet_v_push(slots, quasiquote(opts, kv->key, 0));
+                    JanetSlot key = quasiquote(opts, kv->key);
-                    janet_v_push(slots, quasiquote(opts, kv->value, 0));
+                    JanetSlot value =  quasiquote(opts, kv->value);
+                    key.flags &= ~JANET_SLOT_SPLICED;
+                    value.flags &= ~JANET_SLOT_SPLICED;
+                    janet_v_push(slots, key);
+                    janet_v_push(slots, value);
                 }
                 return qq_slots(opts, slots, 
                         janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
@@ -104,7 +105,7 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a
         janetc_cerror(opts.compiler, "expected 1 argument");
         return janetc_cslot(janet_wrap_nil());
     }
-    return quasiquote(opts, argv[0], 0);
+    return quasiquote(opts, argv[0]);
 }
 
 static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -114,13 +115,6 @@ static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv
     return janetc_cslot(janet_wrap_nil());
 }
 
-static JanetSlot janetc_unquote_splicing(JanetFopts opts, int32_t argn, const Janet *argv) {
-    (void) argn;
-    (void) argv;
-    janetc_cerror(opts.compiler, "cannot use unquote-splicing here");
-    return janetc_cslot(janet_wrap_nil());
-}
-
 /* Preform destructuring. Be careful to
  * keep the order registers are freed. 
  * Returns if the slot 'right' can be freed. */
@@ -661,8 +655,9 @@ static const JanetSpecial janetc_specials[] = {
     {"if", janetc_if},
     {"quasiquote", janetc_quasiquote},
     {"quote", janetc_quote},
+    {"splice", janetc_splice},
+    {"unquote", janetc_unquote},
     {"unquote", janetc_unquote},
-    {"unquote-splicing", janetc_unquote_splicing},
     {"var", janetc_var},
     {"while", janetc_while}
 };