[elpa] externals/parser-generator 3bf81567ac 05/29: Added TODO notes and a failing test for e-free-first

[Christian Johansson]

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

    Added TODO notes and a failing test for e-free-first
---
 TODO.md                          |  16 ++++++
 parser-generator.el              | 117 +++++++++++++++++++++------------------
 test/parser-generator-lr-test.el |  39 +++----------
 test/parser-generator-test.el    |  55 ++++++++++++++++++
 4 files changed, 143 insertions(+), 84 deletions(-)

diff --git a/TODO.md b/TODO.md
new file mode 100644
index 0000000000..b252f75e23
--- /dev/null
+++ b/TODO.md
@@ -0,0 +1,16 @@
+# TODO
+
+## Main
+
+Functions (with validations) to set
+
+* parser-generator--global-attributes
+* parser-generator--context-sensitive-attributes
+* parser-generator--global-declaration
+
+## LR-Parser
+
+Functions (with validations) to set
+
+* parser-generator-lr--global-precedence-attributes
+* parser-generator-lr--context-sensitive-precedence-attribute
diff --git a/parser-generator.el b/parser-generator.el
index 77e5ba28c8..75630bbfd5 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -670,6 +670,14 @@
        t
        parser-generator--table-look-aheads-p))))
 
+(defun parser-generator-set-e-identifier (e-identifier)
+  "Set E-IDENTIFIER."
+  (unless (or
+           (stringp e-identifier)
+           (symbolp e-identifier))
+    (error "E-identifier must be a symbol or string!"))
+  (setq parser-generator--e-identifier e-identifier))
+
 (defun parser-generator-set-look-ahead-number (k)
   "Set look-ahead number K."
   (unless (parser-generator--valid-look-ahead-number-p k)
@@ -1805,68 +1813,69 @@
                                  (message
                                   "stopped looking since non-terminal starts 
with e-identifier: %s"
                                   symbol-f-set))
-                                (setq keep-looking nil))
-                            
+                                (setq
+                                 keep-looking
+                                 nil))
+
                             ;; Handle this scenario here were a non-terminal 
can result in different FIRST sets
-                            (when (>
-                                   (length symbol-f-set)
-                                   1)
-                              (let ((symbol-f-set-index
-                                     1)
-                                    (symbol-f-set-length
-                                     (length symbol-f-set)))
-                                (while
-                                    (<
-                                     symbol-f-set-index
-                                     symbol-f-set-length)
-                                  (let ((symbol-f-set-element
-                                         (nth
-                                          symbol-f-set-index
-                                          symbol-f-set)))
-                                    (let ((alternative-first-length
-                                           (+ first-length (length 
symbol-f-set-element)))
-                                          (alternative-first
-                                           (append first symbol-f-set-element))
-                                          (alternative-tape-index
-                                           (1+ input-tape-index)))
+                            (let ((symbol-f-set-index 0)
+                                  (symbol-f-set-length
+                                   (length symbol-f-set))
+                                  (found-e-trail)
+                                  (e-trail-is-viable-p
+                                   (< input-tape-index (1- input-tape-length)))
+                                  (original-first first)
+                                  (original-first-length first-length))
+                              (while (< symbol-f-set-index symbol-f-set-length)
+                                (let ((symbol-f-set-element (nth 
symbol-f-set-index symbol-f-set)))
+                                  (let ((alternative-first-length
+                                         (+ original-first-length (length 
symbol-f-set-element)))
+                                        (alternative-first
+                                         (append original-first 
symbol-f-set-element))
+                                        (alternative-tape-index
+                                         (1+ input-tape-index)))
+                                    (parser-generator--debug
+                                     (message
+                                      "alternative-first: %s"
+                                      alternative-first))
+
+                                    ;; When the e-identifier is an alternative 
trail
+                                    ;; and there a symbols left on stack
+                                    ;; make alternative trail by skipping this 
symbol
+                                    (when (and
+                                           e-trail-is-viable-p
+                                           (not found-e-trail)
+                                           (not disallow-e-first)
+                                           (parser-generator--valid-e-p
+                                            (car alternative-first)))
+                                      (push
+                                       `(,(1+ input-tape-index) 
,original-first-length ,original-first)
+                                       stack)
                                       (parser-generator--debug
                                        (message
-                                        "alternative-first: %s"
-                                        alternative-first))
+                                        "Pushed alternative trail from 
non-terminal expansion to stack since first symbol is the e-identifier: %s"
+                                        `(,(1+ input-tape-index) 
,original-first-length ,original-first)))
+                                      (setq
+                                       found-e-trail
+                                       t))
+
+                                    (if (= symbol-f-set-index 0)
+                                        (progn
+                                          (setq
+                                           first-length
+                                           (+ original-first-length (length 
alternative-first)))
+                                          (setq
+                                           first
+                                           (append original-first 
alternative-first)))
                                       (push
                                        `(
                                          ,alternative-tape-index
                                          ,alternative-first-length
                                          ,alternative-first)
-                                       stack)))
-                                  (setq
-                                   symbol-f-set-index
-                                   (1+ symbol-f-set-index)))))
-
-                            (parser-generator--debug
-                             (message
-                              "main-symbol-f-set: %s"
-                              (car symbol-f-set)))
-
-                            ;; When there a symbols left on stack, make 
alternative trail by skipping this symbol
-                            (when (and
-                                   (parser-generator--valid-e-p (car (car 
symbol-f-set)))
-                                   (not disallow-e-first)
-                                   (< input-tape-index (1- input-tape-length)))
-                              (parser-generator--debug
-                               (message
-                                "Pushed alternative trail from non-terminal 
expansion to stack since first symbol is the e-identifier: %s"
-                                `(,(1+ input-tape-index) ,first-length 
,first)))
-                              (push
-                               `(,(1+ input-tape-index) ,first-length ,first)
-                               stack))
-
-                            (setq
-                             first-length
-                             (+ first-length (length (car symbol-f-set))))
-                            (setq
-                             first
-                             (append first (car symbol-f-set))))))))
+                                       stack))))
+                                (setq
+                                 symbol-f-set-index
+                                 (1+ symbol-f-set-index)))))))))
                     (setq
                      input-tape-index
                      (1+ input-tape-index)))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 6a65c9ee8f..316b1b1f93 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -374,9 +374,7 @@
   (setq
    parser-generator-lr--context-sensitive-precedence-attribute
    nil)
-  (setq
-   parser-generator--e-identifier
-   '%empty)
+  (parser-generator-set-e-identifier '%empty)
   (parser-generator-set-look-ahead-number 1)
   (setq
    parser-generator--global-attributes
@@ -670,9 +668,7 @@
   (message "Passed cyclical grammar")
 
   ;; Test e-identifier in midst of grammar below
-  (setq
-   parser-generator--e-identifier
-   'e)
+  (parser-generator-set-e-identifier 'e)
   (parser-generator-set-grammar
    '((Sp S E) (a b) ((Sp S) (S (S a E b)) (S e) (E e)) Sp))
   (parser-generator-set-look-ahead-number 1)
@@ -691,9 +687,7 @@
   (message "Passed example with e-identifier in middle of rule")
 
   ;; Another test with e-identifier inside rule here
-  (setq
-   parser-generator--e-identifier
-   '%empty)
+  (parser-generator-set-e-identifier '%empty)
   (parser-generator-set-grammar
    '(
      (Sp S A B C)
@@ -935,9 +929,7 @@
   (message "Started tests for (parser-generator-lr-parse)")
 
   (parser-generator-set-look-ahead-number 1)
-  (setq
-   parser-generator--e-identifier
-   'e)
+  (parser-generator-set-e-identifier 'e)
   (parser-generator-set-grammar
    '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
   (parser-generator-set-look-ahead-number 1)
@@ -1049,9 +1041,7 @@
 
   ;; Test left-recursive grammar from PHP 8.0 here
   (parser-generator-set-look-ahead-number 1)
-  (setq
-   parser-generator--e-identifier
-   '%empty)
+  (parser-generator-set-e-identifier '%empty)
   (parser-generator-set-grammar
    '(
      (start expr match match_arm_list non_empty_match_arm_list match_arm 
match_arm_cond_list possible_comma)
@@ -1177,9 +1167,7 @@
 
   ;; TODO Test another left-recursive grammar from PHP 8.0 here
   (parser-generator-set-look-ahead-number 1)
-  (setq
-   parser-generator--e-identifier
-   '%empty)
+  (parser-generator-set-e-identifier '%empty)
   (parser-generator-set-grammar
    '(
      (start inner_statement_list statement switch_case_list case_list 
case_separator)
@@ -1215,13 +1203,6 @@
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
   (parser-generator-lr-generate-parser-tables)
-
-  ;; TODO Make this test pass
-  (should
-   (equal
-    (parser-generator--first '(inner_statement_list T_CASE))
-    '((T_CASE) (T_ECHO) (T_SWITCH))))
-
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)
@@ -1296,11 +1277,11 @@
       (insert "switch\n{\n    case:\n    case:\n    case;\n    case;\n        
echo \"hello\";\n}\n")
       (parser-generator-lr--parse)
       (kill-buffer)
-      (message "Passed test PHP 8.0 switch case grammar 2")
-      ))
+      (message "Passed test PHP 8.0 switch case grammar 2")))
 
   (message "Passed tests for (parser-generator-lr--parse)"))
 
+;; TODO Make these pass again
 (defun parser-generator-lr-test-parse-k-2 ()
   "Test `parser-generator-lr-parse' with k = 2."
   (message "Started tests for (parser-generator-lr-parse) k = 2")
@@ -1914,9 +1895,7 @@
        )
       Sp))
     (parser-generator-set-look-ahead-number 1)
-    (setq
-     parser-generator--e-identifier
-     'e)
+    (parser-generator-set-e-identifier 'e)
     (parser-generator-process-grammar)
     (parser-generator-lr-generate-parser-tables)
 
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index bc19082925..4b5a6e1f98 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -430,6 +430,60 @@
     '((b) (e))))
   (message "Passed first 12 with multiple non-terminals and e-identifiers")
 
+  (parser-generator-set-look-ahead-number 1)
+  (parser-generator-set-e-identifier '%empty)
+  (parser-generator-set-grammar
+   '(
+     (start inner_statement_list statement switch_case_list case_list 
case_separator)
+     (T_SWITCH T_ECHO T_CONSTANT_ENCAPSED_STRING ";" ":" "{" "}" T_CASE)
+     (
+      (start
+       inner_statement_list
+       )
+      (inner_statement_list
+       (inner_statement_list statement)
+       %empty
+       )
+      (statement
+       (T_SWITCH switch_case_list)
+       (T_ECHO T_CONSTANT_ENCAPSED_STRING ";")
+       )
+      (switch_case_list
+       ("{" case_list "}")
+       ("{" ";" case_list "}")
+       )
+      (case_list
+       %empty
+       (case_list T_CASE case_separator inner_statement_list)
+       )
+      (case_separator
+       ":"
+       ";"
+       )
+      )
+     start
+     )
+   )
+  (parser-generator-set-look-ahead-number 1)
+  (parser-generator-process-grammar)
+  (should
+   (equal
+    (parser-generator--first '(inner_statement_list T_CASE))
+    '((%empty) (T_CASE) (T_ECHO) (T_SWITCH))))
+  (should
+   (equal
+    (parser-generator--first '(inner_statement_list inner_statement_list 
T_CASE))
+    '((%empty) (T_CASE) (T_ECHO) (T_SWITCH))))
+  (should
+   (equal
+    (parser-generator--first '(inner_statement_list inner_statement_list 
inner_statement_list T_CASE))
+    '((%empty) (T_CASE) (T_ECHO) (T_SWITCH))))
+  ;; TODO Make this pass
+  (should
+   (equal
+    (parser-generator--e-free-first '(inner_statement_list 
inner_statement_list inner_statement_list T_CASE))
+    '((T_ECHO) (T_SWITCH))))
+
   (message "Passed tests for (parser-generator--first)"))
 
 (defun parser-generator-test--e-free-first ()
@@ -437,6 +491,7 @@
   (message "Starting tests for (parser-generator--e-free-first)")
 
   ;; Example 5.28 p 382
+  (parser-generator-set-e-identifier 'e)
   (parser-generator-set-grammar '((S A B C) (a b c) ((S (A B)) (A (B a) e) (B 
(C b) C) (C c e)) S))
   (parser-generator-set-look-ahead-number 2)
   (parser-generator-process-grammar)