branch: externals/parser-generator
commit 6a7dcdb8dbb480021958ec741e45c96988d839af
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>

    Passing unit tests for LR parsers
---
 parser-generator-ll-export.el           | 134 +++++++++++++++++++++-----------
 parser-generator-lr-export.el           | 134 +++++++++++++++++++++-----------
 test/parser-generator-lr-export-test.el |  22 +++---
 3 files changed, 188 insertions(+), 102 deletions(-)

diff --git a/parser-generator-ll-export.el b/parser-generator-ll-export.el
index 9ac5d78534..349cead0ea 100644
--- a/parser-generator-ll-export.el
+++ b/parser-generator-ll-export.el
@@ -134,10 +134,10 @@
         "(defvar-local\n  %s-lex-analyzer--index\n  0\n  \"The current index 
of the lex-analyzer.\")\n\n"
         namespace))
 
-      ;; Move to index flag
+      ;; State
       (insert
        (format
-        "(defvar-local\n  %s-lex-analyzer--move-to-index-flag\n  nil\n  
\"Non-nil means move index to value.\")\n\n"
+        "(defvar-local\n  %s-lex-analyzer--state\n  nil\n  \"The current state 
of the lex-analyzer.\")\n\n"
         namespace))
 
       (insert "\n;;; Variable Functions:\n\n")
@@ -229,8 +229,12 @@
   ()
   \"Peek next look-ahead number of tokens via lex-analyzer.\"
   (let ((look-ahead)
-        (look-ahead-length 0)
-        (index %s-lex-analyzer--index)
+        (look-ahead-length
+          0)
+        (index
+          %s-lex-analyzer--index)
+        (state
+          %s-lex-analyzer--state)
         (k (max
             1
             %s--look-ahead-number)))
@@ -239,31 +243,60 @@
             k)
       (condition-case error
           (progn
-            (setq-local
-              %s-lex-analyzer--move-to-index-flag
-              nil)
-            (let ((next-look-ahead
+            (let* ((result-list
                    (funcall
                     %s-lex-analyzer--function
-                    index)))
-                  (if %s-lex-analyzer--move-to-index-flag
+                    index
+                    state))
+                   (token
+                    (nth 0 result-list))
+                   (move-to-index-flag
+                    (nth 1 result-list))
+                   (new-index
+                    (nth 2 result-list))
+                   (new-state
+                    (nth 3 result-list)))
+              (if move-to-index-flag
+                  (progn
                     (setq
                      index
-                     %s-lex-analyzer--move-to-index-flag)
-              (if next-look-ahead
-                  (progn
-                    (unless (listp (car next-look-ahead))
-                      (setq next-look-ahead (list next-look-ahead)))
-                    (dolist (next-look-ahead-item next-look-ahead)
-                      (when (<
+                     move-to-index-flag)
+                    (setq
+                     state
+                     new-state))
+
+                (if token
+                    (progn
+                      (setq index new-index)
+                      (unless (listp (car token))
+                        (setq token (list token)))
+                      (let ((token-count (length token))
+                            (token-index 0))
+                        (while
+                            (and
+                             (<
+                              look-ahead-length
+                              k)
+                             (<
+                              token-index
+                              token-count))
+                          (let ((next-look-ahead-item
+                                 (nth token-index token)))
+                            (push
+                             next-look-ahead-item
+                             look-ahead)
+                            (setq
                              look-ahead-length
-                             k)
-                        (push next-look-ahead-item look-ahead)
-                        (setq look-ahead-length (1+ look-ahead-length))
-                        (setq index (cdr (cdr next-look-ahead-item))))))
-                (push (list %s--eof-identifier) look-ahead)
-                (setq look-ahead-length (1+ look-ahead-length))
-                (setq index (1+ index))))))"
+                             (1+ look-ahead-length))
+                            (setq
+                             token-index
+                             (1+ token-index))))))
+
+                  ;; Fill up look-ahead with EOF-identifier if we found nothing
+                  (push (list %s--eof-identifier) look-ahead)
+                  (setq look-ahead-length (1+ look-ahead-length))
+                  (setq index (1+ index))))))"
+               namespace
                namespace
                namespace
                namespace
@@ -275,9 +308,10 @@
       (insert "
         (error
          (error
-          \"Lex-analyze failed to peek next look-ahead at %s, error: %s\"
+          \"Lex-analyze failed to peek next look-ahead at %s, error: %s, 
look-ahead: %S\"
           index
-          error))))
+          error
+          look-ahead))))
     (nreverse look-ahead)))\n")
 
       ;; Lex-Analyzer Pop Token
@@ -291,28 +325,37 @@
     (while continue
       (condition-case error
           (progn
-            (setq-local
-              %s-lex-analyzer--move-to-index-flag
-              nil)
-            (let ((token
-                   (funcall
-                    %s-lex-analyzer--function
-                    %s-lex-analyzer--index)))
-              (if %s-lex-analyzer--move-to-index-flag
+            (let* ((result-list
+                    (funcall
+                     %s-lex-analyzer--function
+                     %s-lex-analyzer--index
+                     %s-lex-analyzer--state))
+                   (token
+                    (nth 0 result-list))
+                   (move-to-index-flag
+                    (nth 1 result-list))
+                   (new-index
+                    (nth 2 result-list))
+                   (new-state
+                    (nth 3 result-list)))
+              (if move-to-index-flag
                   (progn
                     (setq-local
                      %s-lex-analyzer--index
-                     %s-lex-analyzer--move-to-index-flag))
-              (when token
-                (unless (listp (car token))
-                  (setq token (list token)))
-                (let ((first-token (car token)))
-                  (setq
-                   %s-lex-analyzer--index
-                   (cdr (cdr first-token)))
-                  (push 
-                   first-token 
-                   tokens)))
+                     move-to-index-flag)
+                    (setq-local
+                     %s-lex-analyzer--state
+                     new-state))
+                (setq
+                 %s-lex-analyzer--index
+                 new-index)
+                (when token
+                  (unless (listp (car token))
+                    (setq token (list token)))
+                  (let ((first-token (car token)))
+                    (push
+                     first-token
+                     tokens)))
                 (setq
                  continue
                  nil))))"
@@ -322,7 +365,6 @@
                namespace
                namespace
                namespace
-               namespace
                namespace))
       (insert "
         (error (error
diff --git a/parser-generator-lr-export.el b/parser-generator-lr-export.el
index 97df7f5361..b7589a8e18 100644
--- a/parser-generator-lr-export.el
+++ b/parser-generator-lr-export.el
@@ -155,10 +155,10 @@
         "(defvar-local\n  %s-lex-analyzer--index\n  0\n  \"The current index 
of the lex-analyzer.\")\n\n"
         namespace))
 
-      ;; Move to index flag
+      ;; State
       (insert
        (format
-        "(defvar-local\n  %s-lex-analyzer--move-to-index-flag\n  nil\n  
\"Non-nil means move index to value.\")\n\n"
+        "(defvar-local\n  %s-lex-analyzer--state\n  nil\n  \"The current state 
of the lex-analyzer.\")\n\n"
         namespace))
 
       (insert "\n;;; Variable Functions:\n\n")
@@ -250,8 +250,12 @@
   ()
   \"Peek next look-ahead number of tokens via lex-analyzer.\"
   (let ((look-ahead)
-        (look-ahead-length 0)
-        (index %s-lex-analyzer--index)
+        (look-ahead-length
+          0)
+        (index
+          %s-lex-analyzer--index)
+        (state
+          %s-lex-analyzer--state)
         (k (max
             1
             %s--look-ahead-number)))
@@ -260,31 +264,60 @@
             k)
       (condition-case error
           (progn
-            (setq-local
-              %s-lex-analyzer--move-to-index-flag
-              nil)
-            (let ((next-look-ahead
+            (let* ((result-list
                    (funcall
                     %s-lex-analyzer--function
-                    index)))
-                  (if %s-lex-analyzer--move-to-index-flag
+                    index
+                    state))
+                   (token
+                    (nth 0 result-list))
+                   (move-to-index-flag
+                    (nth 1 result-list))
+                   (new-index
+                    (nth 2 result-list))
+                   (new-state
+                    (nth 3 result-list)))
+              (if move-to-index-flag
+                  (progn
                     (setq
                      index
-                     %s-lex-analyzer--move-to-index-flag)
-              (if next-look-ahead
-                  (progn
-                    (unless (listp (car next-look-ahead))
-                      (setq next-look-ahead (list next-look-ahead)))
-                    (dolist (next-look-ahead-item next-look-ahead)
-                      (when (<
+                     move-to-index-flag)
+                    (setq
+                     state
+                     new-state))
+
+                (if token
+                    (progn
+                      (setq index new-index)
+                      (unless (listp (car token))
+                        (setq token (list token)))
+                      (let ((token-count (length token))
+                            (token-index 0))
+                        (while
+                            (and
+                             (<
+                              look-ahead-length
+                              k)
+                             (<
+                              token-index
+                              token-count))
+                          (let ((next-look-ahead-item
+                                 (nth token-index token)))
+                            (push
+                             next-look-ahead-item
+                             look-ahead)
+                            (setq
                              look-ahead-length
-                             k)
-                        (push next-look-ahead-item look-ahead)
-                        (setq look-ahead-length (1+ look-ahead-length))
-                        (setq index (cdr (cdr next-look-ahead-item))))))
-                (push (list %s--eof-identifier) look-ahead)
-                (setq look-ahead-length (1+ look-ahead-length))
-                (setq index (1+ index))))))"
+                             (1+ look-ahead-length))
+                            (setq
+                             token-index
+                             (1+ token-index))))))
+
+                  ;; Fill up look-ahead with EOF-identifier if we found nothing
+                  (push (list %s--eof-identifier) look-ahead)
+                  (setq look-ahead-length (1+ look-ahead-length))
+                  (setq index (1+ index))))))"
+               namespace
                namespace
                namespace
                namespace
@@ -296,9 +329,10 @@
       (insert "
         (error
          (error
-          \"Lex-analyze failed to peek next look-ahead at %s, error: %s\"
+          \"Lex-analyze failed to peek next look-ahead at %s, error: %s, 
look-ahead: %S\"
           index
-          error))))
+          error
+          look-ahead))))
     (nreverse look-ahead)))\n")
 
       ;; Lex-Analyzer Pop Token
@@ -312,28 +346,37 @@
     (while continue
       (condition-case error
           (progn
-            (setq-local
-              %s-lex-analyzer--move-to-index-flag
-              nil)
-            (let ((token
-                   (funcall
-                    %s-lex-analyzer--function
-                    %s-lex-analyzer--index)))
-              (if %s-lex-analyzer--move-to-index-flag
+            (let* ((result-list
+                    (funcall
+                     %s-lex-analyzer--function
+                     %s-lex-analyzer--index
+                     %s-lex-analyzer--state))
+                   (token
+                    (nth 0 result-list))
+                   (move-to-index-flag
+                    (nth 1 result-list))
+                   (new-index
+                    (nth 2 result-list))
+                   (new-state
+                    (nth 3 result-list)))
+              (if move-to-index-flag
                   (progn
                     (setq-local
                      %s-lex-analyzer--index
-                     %s-lex-analyzer--move-to-index-flag))
-              (when token
-                (unless (listp (car token))
-                  (setq token (list token)))
-                (let ((first-token (car token)))
-                  (setq
-                   %s-lex-analyzer--index
-                   (cdr (cdr first-token)))
-                  (push 
-                   first-token 
-                   tokens)))
+                     move-to-index-flag)
+                    (setq-local
+                     %s-lex-analyzer--state
+                     new-state))
+                (setq
+                 %s-lex-analyzer--index
+                 new-index)
+                (when token
+                  (unless (listp (car token))
+                    (setq token (list token)))
+                  (let ((first-token (car token)))
+                    (push
+                     first-token
+                     tokens)))
                 (setq
                  continue
                  nil))))"
@@ -343,7 +386,6 @@
                namespace
                namespace
                namespace
-               namespace
                namespace))
       (insert "
         (error (error
diff --git a/test/parser-generator-lr-export-test.el 
b/test/parser-generator-lr-export-test.el
index 88bad1b8db..eb35f2bc46 100644
--- a/test/parser-generator-lr-export-test.el
+++ b/test/parser-generator-lr-export-test.el
@@ -38,13 +38,13 @@
 
     (setq
      parser-generator-lex-analyzer--function
-     (lambda (index)
+     (lambda (index _state)
        (with-current-buffer "*a*"
          (when (<= (+ index 1) (point-max))
            (let ((start index)
                  (end (+ index 1)))
              (let ((token (buffer-substring-no-properties start end)))
-               `(,token ,start . ,end)))))))
+               (list `(,token ,start . ,end) nil end nil)))))))
 
     (setq
      parser-generator-lex-analyzer--get-function
@@ -165,9 +165,10 @@
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
   (parser-generator-lr-generate-parser-tables)
+
   (setq
    parser-generator-lex-analyzer--function
-   (lambda (index)
+   (lambda (index _state)
      (let* ((string '((a 1 . 2) (a 2 . 3) (b 3 . 4) (b 4 . 5)))
             (string-length (length string))
             (max-index index)
@@ -177,7 +178,7 @@
                (< (1- index) max-index))
          (push (nth (1- index) string) tokens)
          (setq index (1+ index)))
-       (nreverse tokens))))
+       (list (nreverse tokens) nil index nil))))
 
   (setq
    parser-generator-lex-analyzer--get-function
@@ -232,13 +233,13 @@
 
     (setq
      parser-generator-lex-analyzer--function
-     (lambda (index)
+     (lambda (index _state)
        (with-current-buffer "*a*"
          (when (<= (+ index 1) (point-max))
            (let ((start index)
                  (end (+ index 1)))
              (let ((token (buffer-substring-no-properties start end)))
-               `(,token ,start . ,end)))))))
+               (list `(,token ,start . ,end) nil end nil)))))))
 
     (setq
      parser-generator-lex-analyzer--get-function
@@ -303,13 +304,14 @@
   ;; Setup lex-analyzer
   (setq
    parser-generator-lex-analyzer--function
-   (lambda (index)
+   (lambda (index _state)
      (with-current-buffer "*a*"
        (when (<= (+ index 1) (point-max))
          (let ((start index)
                (end (+ index 1)))
            (let ((token (buffer-substring-no-properties start end)))
-             `(,token ,start . ,end)))))))
+             (list `(,token ,start . ,end) nil end nil)))))))
+
   (setq
    parser-generator-lex-analyzer--get-function
    (lambda (token)
@@ -373,13 +375,13 @@
 
     (setq
      parser-generator-lex-analyzer--function
-     (lambda (index)
+     (lambda (index _state)
        (with-current-buffer "*a*"
          (when (<= (+ index 1) (point-max))
            (let ((start index)
                  (end (+ index 1)))
              (let ((token (buffer-substring-no-properties start end)))
-               `(,token ,start . ,end)))))))
+               (list `(,token ,start . ,end) nil end nil)))))))
 
     (setq
      parser-generator-lex-analyzer--get-function

Reply via email to