Add alternation destructuring operator ?//

This is a first pass to show the implementation.
It needs tests and evaluation, but doesn't break any existing tests.

NOT READY FOR MERGING

src/compile.c

@@ -159,8 +159,15 @@ block gen_const_global(jv constant, const char *name) {
   return inst_block(i);
 }
 
+block gen_op_pushk_under(jv constant) {
+  assert(opcode_describe(PUSHK_UNDER)->flags & OP_HAS_CONSTANT);
+  inst* i = inst_new(PUSHK_UNDER);
+  i->imm.constant = constant;
+  return inst_block(i);
+}
+
 int block_is_const(block b) {
-  return (block_is_single(b) && b.first->op == LOADK);
+  return (block_is_single(b) && (b.first->op == LOADK || b.first->op == PUSHK_UNDER));
 }
 
 int block_is_const_inf(block b) {
@@ -220,6 +227,10 @@ block gen_op_bound(opcode op, block binder) {
   return b;
 }
 
+block gen_dictpair(block k, block v) {
+  return BLOCK(gen_subexp(k), gen_subexp(v), gen_op_simple(INSERT));
+}
+
 
 static void inst_join(inst* a, inst* b) {
   assert(a && b);
@@ -563,9 +574,15 @@ block gen_call(const char* name, block args) {
   return b;
 }
 
-
-
 block gen_subexp(block a) {
+  if (block_is_noop(a)) {
+    return gen_op_simple(DUP);
+  }
+  if (block_is_single(a) && a.first->op == LOADK) {
+    jv c = block_const(a);
+    block_free(a);
+    return gen_op_pushk_under(c);
+  }
   return BLOCK(gen_op_simple(SUBEXP_BEGIN), a, gen_op_simple(SUBEXP_END));
 }
 
@@ -583,27 +600,35 @@ block gen_const_object(block expr) {
   jv k = jv_null();
   jv v = jv_null();
   for (inst *i = expr.first; i; i = i->next) {
-    if (i->op != SUBEXP_BEGIN ||
+    if (i->op == PUSHK_UNDER) {
+      k = jv_copy(i->imm.constant);
+      i = i->next;
+    } else if (i->op != SUBEXP_BEGIN ||
         i->next == NULL ||
         i->next->op != LOADK ||
         i->next->next == NULL ||
         i->next->next->op != SUBEXP_END) {
       is_const = 0;
       break;
+    } else {
+      k = jv_copy(i->next->imm.constant);
+      i = i->next->next->next;
     }
-    k = jv_copy(i->next->imm.constant);
-    i = i->next->next->next;
-    if (i == NULL ||
+    if (i != NULL && i->op == PUSHK_UNDER) {
+      v = jv_copy(i->imm.constant);
+      i = i->next;
+    } else if (i == NULL ||
         i->op != SUBEXP_BEGIN ||
         i->next == NULL ||
         i->next->op != LOADK ||
         i->next->next == NULL ||
         i->next->next->op != SUBEXP_END) {
       is_const = 0;
       break;
+    } else {
+      v = jv_copy(i->next->imm.constant);
+      i = i->next->next->next;
     }
-    v = jv_copy(i->next->imm.constant);
-    i = i->next->next->next;
     if (i == NULL || i->op != INSERT) {
       is_const = 0;
       break;
@@ -709,19 +734,100 @@ static block bind_matcher(block matcher, block body) {
   // block_has_only_binders(matcher), which is not true here as matchers
   // may also contain code to extract the correct elements
   for (inst* i = matcher.first; i; i = i->next) {
-    if (i->op == STOREV && !i->bound_by)
+    if ((i->op == STOREV || i->op == STOREVN) && !i->bound_by)
       block_bind_subblock(inst_block(i), body, OP_HAS_VARIABLE, 0);
   }
   return BLOCK(matcher, body);
 }
 
+
+// Extract destructuring var names from the block
+// *vars should be a jv_object (for set semantics)
+static void block_get_unbound_vars(block b, jv *vars) {
+  assert(vars != NULL);
+  assert(jv_get_kind(*vars) == JV_KIND_OBJECT);
+  for (inst* i = b.first; i; i = i->next) {
+    if (i->subfn.first) {
+      block_get_unbound_vars(i->subfn, vars);
+      continue;
+    }
+    if ((i->op == STOREV || i->op == STOREVN) && i->bound_by == NULL) {
+      *vars = jv_object_set(*vars, jv_string(i->symbol), jv_true());
+    }
+  }
+}
+
+/* Build wrappers around destructuring matchers so that we can chain them
+ * when we have errors.  The approach is as follows:
+ * FORK_OPT NEXT_MATCHER (unless last matcher)
+ * existing_matcher_block
+ * JUMP BODY
+ */
+static block bind_alternation_matchers(block matchers, block body) {
+  block preamble = {0};
+  block altmatchers = {0};
+  block mb = {0};
+
+  // Pass through the matchers to find all destructured names.
+  while (matchers.first && matchers.first->op == DESTRUCTURE_ALT) {
+    block_append(&altmatchers, inst_block(block_take(&matchers)));
+  }
+
+  // We don't have any alternations here, so we can use the simplest case.
+  if (altmatchers.first == NULL) {
+    return bind_matcher(matchers, body);
+  }
+
+  // The final matcher needs to strip the error from the previous FORK_OPT
+  block final_matcher = BLOCK(gen_op_simple(POP), gen_op_simple(DUP), matchers);
+
+  // Collect var names
+  jv all_vars = jv_object();
+  block_get_unbound_vars(altmatchers, &all_vars);
+  block_get_unbound_vars(final_matcher, &all_vars);
+
+  // We need a preamble of STOREVs to which to bind the matchers and the body.
+  jv_object_keys_foreach(all_vars, key) {
+    preamble = BLOCK(preamble,
+                     gen_op_simple(DUP),
+                     gen_const(jv_null()),
+                     gen_op_unbound(STOREV, jv_string_value(key)));
+    jv_free(key);
+  }
+  jv_free(all_vars);
+
+  // Now we build each matcher in turn
+  for (inst *i = altmatchers.first; i; i = i->next) {
+    block submatcher = i->subfn;
+
+    // Get rid of the error from the previous matcher
+    if (mb.first != NULL) {
+      submatcher = BLOCK(gen_op_simple(POP), gen_op_simple(DUP), submatcher);
+    }
+
+    // If we're successful, jump to the end of the matchers
+    submatcher = BLOCK(submatcher, gen_op_target(JUMP, final_matcher));
+
+    // FORK_OPT to the end of this submatcher so we can skip to the next one on error
+    mb = BLOCK(mb, gen_op_target(FORK_OPT, submatcher), submatcher);
+
+    // We're done with this inst and we don't want it anymore
+    // But we can't let it free the submatcher block.
+    i->subfn.first = i->subfn.last = NULL;
+  }
+  // We're done with these insts now.
+  block_free(altmatchers);
+
+  return bind_matcher(preamble, BLOCK(mb, final_matcher, body));
+}
+
 block gen_reduce(block source, block matcher, block init, block body) {
   block res_var = gen_op_var_fresh(STOREV, "reduce");
   block update_var = gen_op_bound(STOREV, res_var);
   block jmp = gen_op_target(JUMP, body);
   block loop = BLOCK(gen_op_simple(DUPN),
                      source,
-                     bind_matcher(matcher,
+                     bind_alternation_matchers(matcher,
                                   BLOCK(gen_op_bound(LOADVN, res_var),
                                         /*
                                          * We fork to the body, jump to
@@ -755,7 +861,7 @@ block gen_foreach(block source, block matcher, block init, block update, block e
                      source,
                      // destructure the value into variable(s) for all the code
                      // in the body to see
-                     bind_matcher(matcher,
+                     bind_alternation_matchers(matcher,
                                   // load the loop state variable
                                   BLOCK(gen_op_bound(LOADVN, state_var),
                                         // generate updated state
@@ -861,6 +967,17 @@ block gen_or(block a, block b) {
                                                    gen_const(jv_false())))));
 }
 
+block gen_destructure_alt(block matcher) {
+  for (inst *i = matcher.first; i; i = i->next) {
+    if (i->op == STOREV) {
+      i->op = STOREVN;
+    }
+  }
+  inst* i = inst_new(DESTRUCTURE_ALT);
+  i->subfn = matcher;
+  return inst_block(i);
+}
+
 block gen_var_binding(block var, const char* name, block body) {
   return gen_destructure(var, gen_op_unbound(STOREV, name), body);
 }
@@ -873,9 +990,16 @@ block gen_array_matcher(block left, block curr) {
     // `left` was returned by this function, so the third inst is the
     // constant containing the previously used index
     assert(left.first->op == DUP);
-    assert(left.first->next->op == SUBEXP_BEGIN);
-    assert(left.first->next->next->op == LOADK);
-    index = 1 + (int) jv_number_value(left.first->next->next->imm.constant);
+    assert(left.first->next != NULL);
+    inst *i = NULL;
+    if (left.first->next->op == PUSHK_UNDER) {
+      i = left.first->next;
+    } else {
+      assert(left.first->next->op == SUBEXP_BEGIN);
+      assert(left.first->next->next->op == LOADK);
+      i = left.first->next->next;
+    }
+    index = 1 + (int) jv_number_value(i->imm.constant);
   }
 
   // `left` goes at the end so that the const index is in a predictable place
@@ -888,13 +1012,18 @@ block gen_object_matcher(block name, block curr) {
                curr);
 }
 
-block gen_destructure(block var, block matcher, block body) {
+block gen_destructure(block var, block matchers, block body) {
   // var bindings can be added after coding the program; leave the TOP first.
   block top = gen_noop();
   if (body.first && body.first->op == TOP)
     top = inst_block(block_take(&body));
 
-  return BLOCK(top, gen_op_simple(DUP), gen_subexp(var), gen_op_simple(POP), bind_matcher(matcher, body));
+  if (matchers.first && matchers.first->op == DESTRUCTURE_ALT && !block_is_noop(var)) {
+    block_append(&var, gen_op_simple(DUP));
+    block_append(&matchers, gen_op_simple(POP));
+  }
+
+  return BLOCK(top, gen_op_simple(DUP), gen_subexp(var), gen_op_simple(POP), bind_alternation_matchers(matchers, body));
 }
 
 // Like gen_var_binding(), but bind `break`'s wildcard unbound variable

src/compile.h

@@ -29,6 +29,7 @@ block gen_op_target(opcode op, block target);
 block gen_op_unbound(opcode op, const char* name);
 block gen_op_bound(opcode op, block binder);
 block gen_op_var_fresh(opcode op, const char* name);
+block gen_op_pushk_under(jv constant);
 
 block gen_module(block metadata);
 jv block_module_meta(block b);
@@ -49,11 +50,13 @@ block gen_definedor(block a, block b);
 block gen_condbranch(block iftrue, block iffalse);
 block gen_and(block a, block b);
 block gen_or(block a, block b);
+block gen_dictpair(block k, block v);
 
 block gen_var_binding(block var, const char* name, block body);
 block gen_array_matcher(block left, block curr);
 block gen_object_matcher(block name, block curr);
 block gen_destructure(block var, block matcher, block body);
+block gen_destructure_alt(block matcher);
 
 block gen_cond(block cond, block iftrue, block iffalse);
 block gen_try_handler(block handler);

src/execute.c

@@ -451,6 +451,15 @@ jv jq_next(jq_state *jq) {
       break;
     }
 
+    case PUSHK_UNDER: {
+      jv v = jv_array_get(jv_copy(frame_current(jq)->bc->constants), *pc++);
+      assert(jv_is_valid(v));
+      jv v2 = stack_pop(jq);
+      stack_push(jq, v);
+      stack_push(jq, v2);
+      break;
+    }
+
     case POP: {
       jv_free(stack_pop(jq));
       break;
@@ -548,6 +557,8 @@ jv jq_next(jq_state *jq) {
       break;
     }
 
+    case STOREVN:
+        stack_save(jq, pc - 1, stack_get_pos(jq));
     case STOREV: {
       uint16_t level = *pc++;
       uint16_t v = *pc++;
@@ -563,6 +574,16 @@ jv jq_next(jq_state *jq) {
       break;
     }
 
+    case ON_BACKTRACK(STOREVN): {
+      uint16_t level = *pc++;
+      uint16_t v = *pc++;
+      jv* var = frame_local_var(jq, v, level);
+      jv_free(*var);
+      *var = jv_null();
+      goto do_backtrack;
+      break;
+    }
+
     case STORE_GLOBAL: {
       // Get the constant
       jv val = jv_array_get(jv_copy(frame_current(jq)->bc->constants), *pc++);

src/jv.h

@@ -145,6 +145,15 @@ jv jv_object_iter_value(jv, int);
            : 0;                                                         \
          jv_i__ = jv_object_iter_next(t, jv_i__))                       \
 
+#define jv_object_keys_foreach(t, k)                                 \
+  for (int jv_i__ = jv_object_iter(t), jv_j__ = 1; jv_j__; jv_j__ = 0)  \
+    for (jv k;                                                          \
+         jv_object_iter_valid((t), jv_i__) ?                            \
+           (k = jv_object_iter_key(t, jv_i__),                          \
+            1)                                                          \
+           : 0;                                                         \
+         jv_i__ = jv_object_iter_next(t, jv_i__))
+
 #define JV_OBJECT_1(k1) (jv_object_set(jv_object(),(k1),jv_null()))
 #define JV_OBJECT_2(k1,v1) (jv_object_set(jv_object(),(k1),(v1)))
 #define JV_OBJECT_3(k1,v1,k2) (jv_object_set(JV_OBJECT_2((k1),(v1)),(k2),jv_null()))

src/lexer.l

@@ -71,6 +71,7 @@ struct lexer_param;
 "<=" { return LESSEQ; }
 ">=" { return GREATEREQ; }
 ".." { return REC; }
+"?//" { return ALTERNATION; }
 "."|"?"|"="|";"|","|":"|"|"|"+"|"-"|"*"|"/"|"%"|"\$"|"<"|">" { return yytext[0];}
 
 "["|"{"|"(" {

src/opcode_list.h

@@ -2,6 +2,7 @@ OP(LOADK, CONSTANT, 1, 1)
 OP(DUP,   NONE,     1, 2)
 OP(DUPN,  NONE,     1, 2)
 OP(DUP2,  NONE,     2, 3)
+OP(PUSHK_UNDER, CONSTANT, 1, 2)
 OP(POP,   NONE,     1, 0)
 OP(LOADV, VARIABLE, 1, 1)
 OP(LOADVN, VARIABLE, 1, 1)
@@ -42,3 +43,6 @@ OP(CLOSURE_PARAM_REGULAR, DEFINITION, 0, 0)
 OP(DEPS, CONSTANT, 0, 0)
 OP(MODULEMETA, CONSTANT, 0, 0)
 OP(GENLABEL, NONE, 0, 1)
+
+OP(DESTRUCTURE_ALT, NONE, 0, 0)
+OP(STOREVN, VARIABLE, 1, 0)