[elpa] externals/parser-generator 31c7ba7 098/434: Work on function that generates all possible look-aheads

[ELPA Syncer]

branch: externals/parser-generator
commit 31c7ba7d7099c597d93dc3bf49db0c5958b01c34
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    Work on function that generates all possible look-aheads
---
 parser-lr.el        |  3 ++-
 parser.el           | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/parser-test.el | 35 ++++++++++++++++++++++++
 3 files changed, 113 insertions(+), 1 deletion(-)

diff --git a/parser-lr.el b/parser-lr.el
index 25799ad..a0ed709 100644
--- a/parser-lr.el
+++ b/parser-lr.el
@@ -50,7 +50,8 @@
               (gotos (car (cdr goto-table))))
           (let ((lr-items (gethash goto-index parser-lr--items)))
             (dolist (lr-item lr-items)
-              ;; TODO (a) f(u) = shift if [A -> B . C, v] is in a, C != e and 
u is in EFF(Cv)
+              ;; TODO Iterate all possible 
+              ;; TODO (a) f(u) = shift if [A -> B . C, v] is in LR-items, C != 
e and u is in EFF(Cv)
               ;; TODO (b) f(u) = reduce i if [A -> B ., u] is in a and A -> B 
is product i in P, i > 1
               ;; TODO (c) f(e) = accept if [S' -> S ., e] is in a
               ;; TODO (d) f(u) = error otherwise
diff --git a/parser.el b/parser.el
index 8b25813..dc962f6 100644
--- a/parser.el
+++ b/parser.el
@@ -105,6 +105,82 @@
       (error "No grammar G defined!")))
   (nth 1 G))
 
+(defun parser--get-possible-look-aheads (&optional include-e)
+  "Return all possible look-ahead set which optionally INCLUDE-E."
+  (let ((terminals (parser--get-grammar-terminals))
+        (look-aheads)
+        (k parser--look-ahead-number)
+        (stack '((0 0 nil)))
+        (marked-paths (make-hash-table :test 'equal))
+        (added-look-aheads (make-hash-table :test 'equal)))
+    (let ((terminals-max-index (1- (length terminals)))
+          (terminal-index)
+          (look-ahead-length)
+          (look-ahead))
+      (while stack
+        (message "stack 1: %s" stack)
+        (let ((item (pop stack)))
+          (setq terminal-index (nth 0 item))
+          (setq look-ahead-length (nth 1 item))
+          (setq look-ahead (nth 2 item))
+
+          (message "Popped")
+          (message "item: %s" item)
+          (message "look-ahead-length: %s" look-ahead-length)
+          (message "look-ahead: %s" look-ahead)
+
+          (while (and
+                  (< look-ahead-length k)
+                  (<= terminal-index terminals-max-index))
+            (message "stack 2: %s" stack)
+            (let ((potential-look-ahead look-ahead)
+                  (next-terminal (nth terminal-index terminals)))
+              (push next-terminal potential-look-ahead)
+              (unless (gethash (format "%s" potential-look-ahead) marked-paths)
+                (message "potential-look-ahead: %s gethash: %s" 
potential-look-ahead (gethash potential-look-ahead marked-paths))
+                (puthash (format "%s" potential-look-ahead) t marked-paths)
+
+                (let ((stack-item (list terminal-index look-ahead-length 
look-ahead)))
+                  (push stack-item stack)
+                  (message "Added old path to stack: %s %s" stack-item stack))
+
+                (setq look-ahead-length (1+ look-ahead-length))
+                (setq look-ahead potential-look-ahead)
+
+                (message "Added-terminal: %s" next-terminal)
+                (message "look-ahead-length: %s" look-ahead-length)
+                (message "look-ahead: %s" look-ahead)
+                (message "Stack 3: %s" stack)))
+            (setq terminal-index (1+ terminal-index)))
+
+          (message "Stack 5: %s" stack)
+          (let ((look-ahead-to-add))
+            (if look-ahead
+                (progn
+
+                  (when (= look-ahead-length k)
+                    (setq look-ahead-to-add (reverse look-ahead)))
+
+                  (when (and
+                         include-e
+                         (= look-ahead-length (1- k)))
+                    (push parser--e-identifier look-aheads)
+                    (setq look-ahead-to-add (reverse look-ahead))))
+
+              (when (and
+                     include-e
+                     (= k 1))
+                (setq look-ahead-to-add `(,parser--e-identifier))))
+
+            (message "look-ahead-to-add: %s" look-ahead-to-add)
+            (when (and look-ahead-to-add
+                       (not (gethash look-ahead-to-add added-look-aheads)))
+              (puthash look-ahead-to-add t added-look-aheads)
+              (push look-ahead-to-add look-aheads))))
+        (message "Stack 4: %s" stack)))
+
+    (sort look-aheads 'parser--sort-list)))
+
 (defun parser--hash-to-list (hash-table &optional un-sorted)
   "Return a list that represent the HASH-TABLE.  Each element is a list: (list 
key value), optionally UN-SORTED."
   (let (result)
diff --git a/test/parser-test.el b/test/parser-test.el
index bfe3f07..ef4d41c 100644
--- a/test/parser-test.el
+++ b/test/parser-test.el
@@ -9,6 +9,40 @@
 (require 'parser)
 (require 'ert)
 
+(defun parser-test--get-possible-look-aheads ()
+  "Test `parser--get-possible-look-aheads'."
+  (message "Starting tests for (parser--get-possible-look-aheads)")
+
+  (parser--set-grammar '((S A) ("a" "b") ((S A) (A ("b" "a"))) S))
+  (parser--set-look-ahead-number 1)
+
+  (should
+   (equal
+    '(("a") ("b"))
+    (parser--get-possible-look-aheads)))
+  (message "Passed ((a) (b))")
+
+  (should
+   (equal
+    '(("a") ("b") (e))
+    (parser--get-possible-look-aheads t)))
+  (message "Passed ((a) (b) (e))")
+
+  (parser--set-look-ahead-number 2)
+
+  (should
+   (equal
+    '((a a) (a b) (b a) (b b))
+    (parser--get-possible-look-aheads)))
+  (message "Passed ((a a) (a b) (b a) (b b))")
+
+  (should
+   (equal
+    '((a a) (a b) (a e) (b a) (b b) (b e))
+    (parser--get-possible-look-aheads t)))
+
+  (message "Passed tests for (parser--get-possible-look-aheads)"))
+
 (defun parser-test--sort-list ()
   "Test `parser--sort-list'."
   (message "Starting tests for (parser-test--sort-list)")
@@ -353,6 +387,7 @@
   (parser-test--distinct)
   (parser-test--sort-list)
   (parser-test--get-grammar-rhs)
+  (parser-test--get-possible-look-aheads)
 
   ;; Algorithms
   (parser-test--first)