From bc071e9fe431347832fd424eb327357f38e60bfd Mon Sep 17 00:00:00 2001
From: Sérgio Queiroz <sqmedeiros@gmail.com>
Date: Fri, 15 Dec 2017 13:50:35 -0300
Subject: Updating the recovery mechanism when a label is thrown

---
 lpcode.c      |  37 +++++++++++-----
 lptree.c      |  32 +++++++++-----
 lptree.h      |   1 +
 lptree.o      | Bin 0 -> 35552 bytes
 lpvm.c        |  25 +++++++++--
 lpvm.h        |   3 +-
 lpvm.o        | Bin 0 -> 7760 bytes
 testlabel.lua | 139 ++++++++++++++++++++++++++++------------------------------
 8 files changed, 136 insertions(+), 101 deletions(-)
 create mode 100644 lptree.o
 create mode 100644 lpvm.o

diff --git a/lpcode.c b/lpcode.c
index d67d42f..82b8830 100644
--- a/lpcode.c
+++ b/lpcode.c
@@ -459,7 +459,9 @@ int sizei (const Instruction *i) {
     case IOpenCall: case ICommit: case IPartialCommit: case IBackCommit:
       return 2;
     case IThrow:  /* labeled failure */ 
-			return 1;
+			return 2;
+    case IThrowRec:  /* labeled failure */ 
+			return 3;
     case IRecov: case ILabChoice:
       return (CHARSETINSTSIZE - 1) + 2; /* labeled failure */
 
@@ -519,15 +521,6 @@ static int addinstruction (CompileState *compst, Opcode op, int aux) {
   return i;
 }
 
-/* labeled failure */
-static int addthrowinstruction (CompileState *compst, int aux, int key) {
-  int i = addinstruction(compst, IThrow, aux);
-  getinstr(compst, i).i.key = key;
-  return i;
-}
-
-/* labeled failure */
-
 
 /*
 ** Add an instruction followed by space for an offset (to be set later)
@@ -541,6 +534,22 @@ static int addoffsetinst (CompileState *compst, Opcode op) {
 }
 
 
+/* labeled failure */
+static void codethrow (CompileState *compst, TTree *throw) {
+  int recov, aux;
+  if (throw->u.s.ps != 0) {
+    recov = addoffsetinst(compst, IThrowRec);
+  } else {
+    recov = addinstruction(compst, IThrow, 0);
+  }
+  aux = nextinstruction(compst);
+  getinstr(compst, aux).i.key = throw->key; /* next instruction keeps only rule name */
+  getinstr(compst, recov).i.key = sib2(throw)->cap;  /* rule number */
+  assert(sib2(throw)->tag == TRule);
+}
+/* labeled failure */
+
+
 /*
 ** Set the offset of an instruction
 */
@@ -920,7 +929,13 @@ static void correctcalls (CompileState *compst, int *positions,
       else
         code[i].i.code = ICall;
       jumptothere(compst, i, rule);  /* call jumps to respective rule */
+    } else if (code[i].i.code == IThrowRec) {
+      int n = code[i].i.key;  /* rule number */
+      int rule = positions[n];  /* rule position */
+      assert(rule == from || code[rule - 1].i.code == IRet);
+      jumptothere(compst, i, rule);  /* call jumps to respective rule */
     }
+
   }
   assert(i == to);
 }
@@ -1008,7 +1023,7 @@ static void codegen (CompileState *compst, TTree *tree, int opt, int tt,
       /*printf("TThrow %s top %d\n", lua_typename(compst->L, -1), lua_gettop(compst->L));*/
       /*lua_rawgeti(compst->L, -1, tree->key);*/
       /*printf("Throw2 lab = %s\n", lua_tostring(compst->L, -1));*/
-      addthrowinstruction(compst, (byte) tree->u.label, tree->key); 
+      codethrow(compst, tree); 
 			break;
 		}
 		case TRecov: { /* labeled failure */
diff --git a/lptree.c b/lptree.c
index fea2ecf..1e8de3e 100644
--- a/lptree.c
+++ b/lptree.c
@@ -52,20 +52,24 @@ static const char *val2str (lua_State *L, int idx) {
 ** translate a key to its rule address in the tree. Raises an
 ** error if key does not exist.
 */
-static void fixonecall (lua_State *L, int postable, TTree *g, TTree *t) {
+static void fixonecall (lua_State *L, int postable, TTree *g, TTree *t, byte tag) { /* labeled failure */
   int n;
   lua_rawgeti(L, -1, t->key);  /* get rule's name */
   lua_gettable(L, postable);  /* query name in position table */
   n = lua_tonumber(L, -1);  /* get (absolute) position */
   lua_pop(L, 1);  /* remove position */
-  if (n == 0) {  /* no position? */
-    lua_rawgeti(L, -1, t->key);  /* get rule's name again */
-    luaL_error(L, "rule '%s' undefined in given grammar", val2str(L, -1));
+  if (tag == TOpenCall) {
+    if (n == 0) {  /* no position? */
+      lua_rawgeti(L, -1, t->key);  /* get rule's name again */
+      luaL_error(L, "rule '%s' undefined in given grammar", val2str(L, -1));
+    }
+    t->tag = TCall;
+    t->u.s.ps = n - (t - g);  /* position relative to node */
+    assert(sib2(t)->tag == TRule);
+    sib2(t)->key = t->key;  /* fix rule's key */
+  } else if (n != 0) { /* labeled failure */
+  	t->u.s.ps = n - (t - g);  /* position relative to node */
   }
-  t->tag = TCall;
-  t->u.s.ps = n - (t - g);  /* position relative to node */
-  assert(sib2(t)->tag == TRule);
-  sib2(t)->key = t->key;  /* fix rule's key */
 }
 
 
@@ -105,13 +109,18 @@ static void finalfix (lua_State *L, int postable, TTree *g, TTree *t) {
       return;
     case TOpenCall: {
       if (g != NULL)  /* inside a grammar? */
-        fixonecall(L, postable, g, t);
+        fixonecall(L, postable, g, t, TOpenCall);
       else {  /* open call outside grammar */
         lua_rawgeti(L, -1, t->key);
         luaL_error(L, "rule '%s' used outside a grammar", val2str(L, -1));
       }
       break;
     }
+    case TThrow: { /* labeled failure */
+      if (g != NULL)  /* inside a grammar? */
+        fixonecall(L, postable, g, t, TThrow);
+      break;
+    }
     case TSeq: case TChoice:
       correctassociativity(t);
       break;
@@ -521,7 +530,7 @@ static TTree *newroot2sib (lua_State *L, int tag) {
 static TTree *newthrowleaf (lua_State *L, int lab) {
   TTree *tree = newtree(L, 1);
   tree->tag = TThrow;
-	tree->u.label = lab;
+	tree->u.s.ps = 0;
   return tree;
 }
 
@@ -726,8 +735,7 @@ static int lp_throw (lua_State *L) {
 	TTree * tree;
   luaL_checkstring(L, -1); 
   tree = newthrowleaf(L, 0);
-  tree->u.label = addtonewktable(L, 0, 1);
-  tree->key = tree->u.label; 
+  tree->key = addtonewktable(L, 0, 1);
   /*printf("lp_throw %d %s\n", tree->key, lua_tostring(L, 1));*/
 	return 1;
 }
diff --git a/lptree.h b/lptree.h
index d89da4d..bb53c84 100644
--- a/lptree.h
+++ b/lptree.h
@@ -36,6 +36,7 @@ typedef enum TTag {
   TRunTime,  /* run-time capture: 'key' is Lua function;
                'sib1' is capture body */
   TThrow,    /* labeled failure: 'label' = l */
+  TThrowRec,    /* labeled failure: 'label' = l */
   TRecov,    /* labed failure: 'sib1' //{labels} 'sib2' */
              /* the set of labels is stored in next CHARSETSIZE bytes */
   TLabChoice /* labed failure: 'sib1' /{labels} 'sib2' */
diff --git a/lptree.o b/lptree.o
new file mode 100644
index 0000000..9e01066
Binary files /dev/null and b/lptree.o differ
diff --git a/lpvm.c b/lpvm.c
index 61d609a..c408e4c 100644
--- a/lpvm.c
+++ b/lpvm.c
@@ -331,15 +331,32 @@ const char *match (lua_State *L, const char *o, const char *s, const char *e,
         continue;
       }
       case IThrow: { /* labeled failure */
-        printf("IThrow here: key=%d aux = %d top = %d\n", p->i.key, p->i.aux, lua_gettop(L));
-        lua_rawgeti(L, ktableidx(ptop), p->i.key); 
+        /*printf("IThrow here: key=%d, key+1=%d aux = %d top = %d\n", p->i.key, (p+1)->i.key, p->i.aux, lua_gettop(L));
+        lua_rawgeti(L, ktableidx(ptop), (p+1)->i.key); 
         printf("IThrow there %s top = %d\n", lua_tostring(L, -1), lua_gettop(L));
-        lua_pop(L, 1);
-        *labelf = p->i.key;
+        lua_pop(L, 1);*/
+        *labelf = (p+1)->i.key;
         pk = p + 1;
 				*sfail = s;
         goto fail;
       }
+      case IThrowRec: { /* labeled failure */
+        /*printf("IThrowRec here: key=%d, key+2=%d aux = %d top = %d\n", p->i.key, (p+2)->i.key, p->i.aux, lua_gettop(L));
+        lua_rawgeti(L, ktableidx(ptop), (p+2)->i.key); 
+        printf("IThrowRec there %s top = %d\n", lua_tostring(L, -1), lua_gettop(L));
+        lua_pop(L, 1);*/
+        *labelf = (p+2)->i.key;
+				*sfail = s;
+        if (stack == stacklimit)
+          stack = doublestack(L, &stacklimit, ptop);
+        stack->s = NULL;
+        stack->p = p + 3;
+        stack->ls = NULL;
+        stack->caplevel = captop;
+        stack++;
+        p += getoffset(p);
+        continue;
+      }
       case IFailTwice:
         assert(stack > getstackbase(L, ptop));
         stack--;
diff --git a/lpvm.h b/lpvm.h
index 713626e..c22e8d7 100644
--- a/lpvm.h
+++ b/lpvm.h
@@ -34,7 +34,8 @@ typedef enum Opcode {
   IOpenCapture,  /* start a capture */
   ICloseCapture,
   ICloseRunTime,
-  IThrow,   /* "fails" with a specific label labeled failure */
+  IThrow,    /* "fails" with a specific label labeled failure */
+  IThrowRec, /* "fails" with a specific label labeled failure */
   IRecov,    /* stack a recovery; next fail with label 'f' will jump to 'offset' */
   ILabChoice /* stack a choice; next fail with label 'f' will jump to 'offset' */
 } Opcode;
diff --git a/lpvm.o b/lpvm.o
new file mode 100644
index 0000000..19a9b1c
Binary files /dev/null and b/lpvm.o differ
diff --git a/testlabel.lua b/testlabel.lua
index 72eb9aa..90a8f9e 100644
--- a/testlabel.lua
+++ b/testlabel.lua
@@ -110,102 +110,95 @@ checklabeq({nil, '11', 1}, p:match("x"))
 checklabeq({nil, '11', 1}, p:match("kx"))
 
 
--- throws a label that is not caught by the recovery operator
-p = m.Rec(m.T(2), m.P"a", 1, 3)
-r, l, poserr = p:match(s)
-print(r, l, poserr)
+-- throws a label without a corresponding recovery rule
+p = m.P{
+  "S",
+  S = m.T("bola"),
+  bolada = m.P"a"
+} 
+r, l, poserr = p:match("abc")
+assert(r == nil and l == 'bola' and poserr == 1)
+
+-- throws a label without a corresponding recovery rule
+-- T(2) indexes key ["2"]
+p = m.P{
+  "S",
+  S = m.T(2),
+  [2] = m.P"a"
+} 
+r, l, poserr = p:match("abc")
 assert(r == nil and l == '2' and poserr == 1)
 
--- wraps the previous pattern with a recovery that catches label "2"
-p = m.Rec(p, m.P"a", 2)
-assert(p:match(s) == 2)
+-- throws a label with a corresponding recovery rule
+p = m.P{
+  "S",
+  S = m.T("bola"),
+  bola = m.P"a"
+} 
+r, l, poserr = p:match("abc")
+assert(r == 2)
 
--- throws a label that is caught by recovery 
-p = m.Rec(m.T(25), m.P"a", 25)
-assert(p:match(s) == 2)
+-- throws a label with a corresponding recovery rule
+-- T(2) indexes key ["2"]
+p = m.P{
+  "S",
+  S = m.T(2),
+  ["2"] = m.P"a"^0
+} 
+r, l, poserr = p:match("aaabc")
+assert(r == 4)
+
+-- regular failure after the recovery
+p = m.P{
+  "S",
+  S = m.T(2),
+  ["2"] = m.P"a"^0 * m.P"c"
+} 
+r, l, poserr = p:match("aaabc")
+assert(r == nil and l == 'fail' and poserr == 4)
 
--- "fail" is label "0"
--- throws the "fail" label after the recovery
 s = "bola"
 r, l, poserr = p:match("bola")
-assert(r == nil and l == 0 and poserr == 1)
+assert(r == nil and l == 'fail' and poserr == 1)
 
--- Recovery does not catch "fail" by default
-p = m.Rec(m.P"b", m.P"a", 1)
+-- Recovery rules do not catch "fail" by default
+p = m.P{
+  "S",
+  S = m.P"b" * m.T(2),
+  ["2"] = m.P"a"^0
+} 
+r, l, poserr = p:match("c")
+assert(r == nil and l == 'fail' and poserr == 1)
 
-r, l, poserr = p:match("abc") 
-assert(r == nil and l == 0 and poserr == 1)
+assert(p:match("baa") == 4)
 
-assert(p:match("bola") == 2)
 
+-- recovery rules for "2" or "3"
+-- when we use V instead of T, a recovery
+-- rule becomes a regular grammar rule
+p = m.P{
+  "S",
+  S = (m.P"a" + m.T(2)) * m.T(3),
+  ["3"] = m.V"2",
+  ["2"] = m.P"a" + m.P"b",
+} 
 
--- recovery operator catches "1" or "3"
-p = m.Rec((m.P"a" + m.T(1)) * m.T(3), (m.P"a" + m.P"b"), 1, 3)
 assert(p:match("aac") == 3)
 assert(p:match("abc") == 3)
 r, l, poserr = p:match("acc")
-assert(r == nil and l == 0 and poserr == 2)
+assert(r == nil and l == 'fail' and poserr == 2)
 
---throws 1, recovery pattern matches 'b', throw 3, and rec pat mathces 'a'
+--throws 2, recovery rule matches 'b', throw 3, and rec rule matches 'a'
 assert(p:match("bac") == 3)
 
 r, l, poserr = p:match("cab")
-assert(r == nil and l == 0 and poserr == 1)
-
-
--- associativity
--- (p1 / %1) //{1} (p2 / %2) //{2} p3
--- left-associativity
--- ("a" //{1}  "b") //{2} "c"
-p = m.Rec(m.Rec(m.P"a" + m.T(1), m.P"b" + m.T(2), 1), m.P"c", 2)
-assert(p:match("abc") == 2)
-assert(p:match("bac") == 2)
-assert(p:match("cab") == 2)
-r, l, poserr = p:match("dab")
-assert(r == nil and l == 0 and poserr == 1)
-
-
--- righ-associativity
--- "a" //{1}  ("b" //{2} "c")
-p = m.Rec(m.P"a" + m.T(1), m.Rec(m.P"b" + m.T(2), m.P"c", 2), 1)
-assert(p:match("abc") == 2)
-assert(p:match("bac") == 2)
-assert(p:match("cab") == 2)
-r, l, poserr = p:match("dab")
-assert(r == nil and l == 0 and poserr == 1)
-
-
--- associativity -> in this case the error thrown by p1 is only
---                  recovered when we have a left-associative operator
--- (p1 / %2) //{1} (p2 / %2) //{2} p3
--- left-associativity
--- ("a" //{1}  "b") //{2} "c"
-p = m.Rec(m.Rec(m.P"a" + m.T(2), m.P"b" + m.T(2), 1), m.P"c", 2)
-assert(p:match("abc") == 2)
-r, l, poserr = p:match("bac")
-assert(r == nil and l == 0 and poserr == 1)
-assert(p:match("cab") == 2)
-r, l, poserr = p:match("dab")
-assert(r == nil and l == 0 and poserr == 1)
-
-
--- righ-associativity
--- "a" //{1}  ("b" //{2} "c")
-p = m.Rec(m.P"a" + m.T(2), m.Rec(m.P"b" + m.T(2), m.P"c", 2), 1)
-assert(p:match("abc") == 2)
-r, l, poserr = p:match("bac")
-assert(r == nil and l == 2 and poserr == 1)
-r, l, poserr = p:match("cab")
-assert(r == nil and l == 2 and poserr == 1)
-r, l, poserr = p:match("dab")
-assert(r == nil and l == 2 and poserr == 1)
-
+assert(r == nil and l == 'fail' and poserr == 1)
 
 
 -- tests related to predicates
 p = #m.T(1) + m.P"a"
 r, l, poserr = p:match("abc")
-assert(r == nil and l == 1 and poserr == 1)
+assert(r == nil and l == '1' and poserr == 1)
 
 p = ##m.T(1) + m.P"a"
 r, l, poserr = p:match("abc")
-- 
cgit v1.2.3-55-g6feb