Add error special form in Peg to allow construction of grammar errors

for more useful grammars that could eventually be used in a compiler.

doc/Peg.md

@@ -144,7 +144,8 @@ Most captures specials will match the same text as their first argument pattern.
 | `(substitute patt)` | Replace the text matched by all captures in patt with the capture values. Pushes the substituted text matched by patt to the capture stack. |
 | `(% patt)` | Alias for `(substitute patt)`
 | `(cmt patt fun)` | Invokes fun with all of the captures of patt as arguments (if patt matches). If the result is truthy, then captures the result. The whole expression fails if fun returns false or nil. |
-| `(backref n)` | Duplicates the nth last capture and pushes it to the stack again (0 is the previous capture). If n is negative, pushes the nth capture value to the stack (-1 pushes the first captured value to the stack). If n is out of range for the stack, say if the stack is empty, then the match fails. |
+| `(backref n)` | Duplicates the nth capture and pushes it to the stack again (0 is the first capture). If n is negative, indexes from the top of the stack (-1 pushes the previously captured value to the stack). If n does not map to a valid stack index then the match fails. |
+| `(error patt)` | Throws a Janet error if patt matches. The error thrown will be the last capture ofpatt, or a generic error if patt produces no captures. |
 
 ## Grammars and Recursion
 

src/core/peg.c

@@ -47,12 +47,12 @@ typedef enum {
     RULE_POSITION,     /* [] */
     RULE_ARGUMENT,     /* [argument-index] */
     RULE_REPINDEX,     /* [capture-index] */
-    RULE_BACKINDEX,    /* [capture-index] */
     RULE_CONSTANT,     /* [constant] */
     RULE_SUBSTITUTE,   /* [rule] */
     RULE_GROUP,        /* [rule] */
     RULE_REPLACE,      /* [rule, constant] */
     RULE_MATCHTIME,    /* [rule, constant] */
+    RULE_ERROR,        /* [rule] */
 } Opcode;
 
 /* Hold captured patterns and match state */
@@ -269,19 +269,12 @@ tail:
         case RULE_REPINDEX:
             {
                 int32_t index = ((int32_t *)rule)[1];
-                if (index >= s->captures->count) return NULL;
+                if (index < 0) index += s->captures->count;
+                if (index >= s->captures->count || index < 0) return NULL;
                 Janet capture = s->captures->data[index];
                 pushcap(s, capture, text, text);
                 return text;
             }
-        case RULE_BACKINDEX:
-            {
-                int32_t index = ((int32_t *)rule)[1];
-                if (index >= s->captures->count) return NULL;
-                Janet capture = s->captures->data[s->captures->count - 1 - index];
-                pushcap(s, capture, text, text);
-                return text;
-            }
         case RULE_CONSTANT:
             {
                 pushcap(s, s->constants[rule[1]], text, text);
@@ -418,6 +411,27 @@ tail:
 
                 return result;
             }
+        case RULE_ERROR:
+            {
+                int oldmode = s->mode;
+                s->mode = PEG_MODE_NORMAL;
+                int32_t old_cap = s->captures->count;
+                down1(s);
+                const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
+                up1(s);
+                s->mode = oldmode;
+                if (!result) return NULL;
+                if (s->captures->count > old_cap) {
+                    /* Throw last capture */
+                    janet_panicv(s->captures->data[s->captures->count - 1]);
+                } else {
+                    /* Throw generic error */
+                    int32_t start = (int32_t)(text - s->text_start);
+                    int32_t end = (int32_t)(result - s->text_start);
+                    janet_panicf("match error in range (%d:%d)", start, end);
+                }
+                return NULL;
+            }
     }
 }
 
@@ -664,6 +678,9 @@ static void spec_substitute(Builder *b, int32_t argc, const Janet *argv) {
 static void spec_group(Builder *b, int32_t argc, const Janet *argv) {
     spec_onerule(b, argc, argv, RULE_GROUP);
 }
+static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
+    spec_onerule(b, argc, argv, RULE_ERROR);
+}
 
 static void spec_between(Builder *b, int32_t argc, const Janet *argv) {
     peg_fixarity(b, argc, 3);
@@ -685,11 +702,7 @@ static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
     peg_fixarity(b, argc, 1);
     Reserve r = reserve(b, 2);
     int32_t index = peg_getinteger(b, argv[0]);
-    if (index < 0) {
-        emit_1(r, RULE_REPINDEX, -index - 1);
-    } else {
-        emit_1(r, RULE_BACKINDEX, index);
-    }
+    emit_1(r, RULE_REPINDEX, index);
 }
 
 static void spec_argument(Builder *b, int32_t argc, const Janet *argv) {
@@ -770,6 +783,7 @@ typedef struct {
     Special special;
 } SpecialPair;
 
+/* Keep in lexical order (vim :sort works well) */
 static const SpecialPair specials[] = {
     {"!", spec_not},
     {"$", spec_position},
@@ -790,6 +804,7 @@ static const SpecialPair specials[] = {
     {"choice", spec_choice},
     {"cmt", spec_matchtime},
     {"constant", spec_constant},
+    {"error", spec_error},
     {"group", spec_group},
     {"if", spec_if},
     {"if-not", spec_ifnot},