[elpa] externals/parser-generator 6a7343e 383/434: Started on refactoring precedence table generation

[ELPA Syncer]

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

    Started on refactoring precedence table generation
---
 parser-generator-lr.el           | 149 ++++++++++++++++++++++++--------
 test/parser-generator-lr-test.el | 178 ++++++++++++++++++++++++++++++++-------
 2 files changed, 259 insertions(+), 68 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index ad96718..be88680 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -45,58 +45,135 @@
   "Global precedence attributes.")
 
 (defvar
-  parser-generator-lr--global-precedence-attributes-table
+  parser-generator-lr--precedence-comparison-function
   nil
-  "Table of global precedence attributes.")
+  "Function to calculate precedence.")
 
 (defvar
-  parser-generator-lr--global-precedence-table
+  parser-generator-lr--symbol-precedence-value
   nil
-  "Hash-table for fast look-up of global precedence symbols.")
+  "Table of the precedence value of all symbols.")
 
 (defvar
-  parser-generator-lr--precedence-comparison-function
+  parser-generator-lr--symbol-precedence-type
   nil
-  "Function to calculate precedence.")
+  "Table of the precedence type of all symbols.")
+
+(defvar
+  parser-generator-lr--production-number-precedence-value
+  nil
+  "Table of the precedence value of all production numbers.")
+
+(defvar
+  parser-generator-lr--production-number-precedence-type
+  nil
+  "Table of the precedence type of all production numbers.")
 
 
 ;; Main Algorithms
 
-(defun parser-generator-lr--prepare-global-declaration ()
-  "Prepare global declaration for parsing."
+
+(defun parser-generator-lr--get-symbol-precedence-value (symbol)
+  "Get the precedence value of SYMBOL."
+  (unless parser-generator-lr--symbol-precedence-value
+    (error "Missing table for symbol precedence value!"))
+  (gethash
+   symbol
+   parser-generator-lr--symbol-precedence-value))
+
+(defun parser-generator-lr--get-symbol-precedence-type (symbol)
+  "Get the precedence type of SYMBOL."
+  (unless parser-generator-lr--symbol-precedence-type
+    (error "Missing table for symbol precedence type!"))
+  (gethash
+   symbol
+   parser-generator-lr--symbol-precedence-type))
+
+(defun parser-generator-lr--get-production-number-precedence-value 
(production-number)
+  "Get the precedence value of PRODUCTION-NUMBER."
+  (unless parser-generator-lr--production-number-precedence-value
+    (error "Missing table for production number precedence value!"))
+  (gethash
+   production-number
+   parser-generator-lr--production-number-precedence-value))
+
+(defun parser-generator-lr--get-production-number-precedence-type 
(production-number)
+  "Get the precedence type of PRODUCTION-NUMBER."
+  (unless parser-generator-lr--production-number-precedence-type
+    (error "Missing table for production number precedence type!"))
+  (gethash
+   production-number
+   parser-generator-lr--production-number-precedence-type))
+
+(defun parser-generator-lr--generate-precedence-tables ()
+  "Generate tables needed to determine precedence."
+
+  ;; Initialize hash-maps for precedence
   (setq
-   parser-generator-lr--global-precedence-table
+   parser-generator-lr--symbol-precedence-value
    (make-hash-table :test 'equal))
   (setq
-   parser-generator-lr--global-precedence-attributes-table
+   parser-generator-lr--symbol-precedence-type
    (make-hash-table :test 'equal))
-  (when parser-generator-lr--global-precedence-attributes
-    (dolist (item parser-generator-lr--global-precedence-attributes)
-      (puthash
-       item
-       t
-       parser-generator-lr--global-precedence-attributes-table))
-    (let ((line-index 0))
-      (dolist (line parser-generator--global-declaration)
-        (let ((attribute (car line))
-              (items (cdr line)))
-          (when
-              (gethash
-               attribute
-               parser-generator-lr--global-precedence-attributes-table)
-            (dolist (item items)
-              (puthash
-               item
-               `(,attribute ,line-index)
-               parser-generator-lr--global-precedence-table))))
-        (setq
-         line-index
-         (1+ line-index))))))
+  (setq
+   parser-generator-lr--production-number-precedence-value
+   (make-hash-table :test 'equal))
+  (setq
+   parser-generator-lr--production-number-precedence-type
+   (make-hash-table :test 'equal))
+
+  (let ((global-precedence-attributes-table
+         (make-hash-table :test 'equal)))
+    (when parser-generator-lr--global-precedence-attributes
+
+      ;; Build hash-map of all precedence attributes
+      (dolist (item parser-generator-lr--global-precedence-attributes)
+        (puthash
+         item
+         t
+         global-precedence-attributes-table))
+
+      ;; Go through global declaration in search of precedence attributes
+      (let ((line-index 0))
+        (dolist (line parser-generator--global-declaration)
+          (let ((attribute (car line))
+                (items (cdr line)))
+
+            ;; Is it a precedence-attribute?
+            (when
+                (gethash
+                 attribute
+                 global-precedence-attributes-table)
+              (dolist (item items)
+
+                ;; Store value
+                (puthash
+                 item
+                 line-index
+                 parser-generator-lr--symbol-precedence-value)
+
+                ;; Store type
+                (puthash
+                 item
+                 attribute
+                 parser-generator-lr--symbol-precedence-type))))
+          (setq
+           line-index
+           (1+ line-index))))
+
+      ;; TODO Go through production-numbers
+      ;; TODO Look for attributes
+      ;; TODO Look for precedence-attributes
+      ;; TODO If none was found, iterate symbols
+      ;; TODO If found a last terminal, use it's precedence type and value
+      ;; TODO for the rule
+
+      )))
 
 (defun parser-generator-lr-generate-parser-tables ()
   "Generate parsing tables for grammar."
   (message "\nStarting generation of parser-tables..\n")
-  (parser-generator-lr--prepare-global-declaration)
+  (parser-generator-lr--generate-precedence-tables)
   (let ((table-lr-items
          (parser-generator-lr--generate-goto-tables)))
     (parser-generator-lr--generate-action-tables
@@ -412,11 +489,10 @@
                                                  production-number
                                                  (nth 2 b))
                                                 (progn
-                                                  (parser-generator--debug
                                                    (message
                                                     "'%s' takes precedence 
over '%s'"
                                                     a
-                                                    b))
+                                                    b)
                                                   ;; Remove b from 
added-actions
                                                   (let ((new-action-table))
                                                     (dolist (action-item 
action-table)
@@ -431,11 +507,10 @@
                                                      action-table
                                                      (reverse
                                                       new-action-table))))
-                                              (parser-generator--debug
                                                (message
                                                 "'%s' takes precedence over 
'%s'"
                                                 b
-                                                a))
+                                                a)
                                               ;; Skip rest of this iteration
                                               (setq
                                                skip-symbol
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 52f1634..d3a7162 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -53,47 +53,114 @@
             (push history iterated-history)
             (setq history-index (1+ history-index))))))))
 
-(defun parser-generator-lr-test--generate-action-tables ()
-  "Test `parser-generator-lr--generate-action-tables'."
-  (message "Starting tests for (parser-generator-lr--generate-action-tables)")
+(defun parser-generator-lr-test--generate-precedence-tables ()
+  "Test `parser-generator-lr--generate-precedence-tables'."
+  (message "Starting tests for 
(parser-generator-lr--generate-precedence-tables)")
 
-  ;; Example 5.32 p. 393
-  (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)
-  (parser-generator-process-grammar)
-  (parser-generator-lr-generate-parser-tables)
-
-  ;; Fig. 5.9 p. 374, replaced e with $
-  (should
-   (equal
-    '((0 ((($) reduce 2) ((a) reduce 2)))
-      (1 ((($) accept) ((a) shift)))
-      (2 (((a) reduce 2) ((b) reduce 2)))
-      (3 (((a) shift) ((b) shift)))
-      (4 (((a) reduce 2) ((b) reduce 2)))
-      (5 ((($) reduce 1) ((a) reduce 1)))
-      (6 (((a) shift) ((b) shift)))
-      (7 (((a) reduce 1) ((b) reduce 1))))
-    (parser-generator-lr--get-expanded-action-tables)))
-  (message "Passed Example 5.32 p. 393")
-
-  ;; Cyclical grammar
+  ;; TODO Test getting token precedence value and type
+  (setq
+   parser-generator--global-attributes
+   '(%left %precedence %right))
+  (setq
+   parser-generator-lr--global-precedence-attributes
+   '(%left %precedence %right))
+  (setq
+   parser-generator--context-sensitive-attributes
+   '(%prec))
+  (setq
+   parser-generator--global-declaration
+   '((%left a)
+     (%right b)
+     (%left c)
+     (%precedence FIRST)))
   (parser-generator-set-grammar
    '(
      (Sp S A B)
      (a b c)
      (
       (Sp S)
-      (S A B)
-      (A (a b A) (a B))
-      (B (c S))
+      (S (A c) B)
+      (A (a b))
+      (B (a b c %prec FIRST))
       )
      Sp))
-  (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
-  (parser-generator-lr-generate-parser-tables)
-  (message "Passed cyclical grammar")
+  (parser-generator-lr--generate-precedence-tables)
+  (should
+   (equal
+    '%left
+    (parser-generator-lr--get-symbol-precedence-type 'a)))
+  (should
+   (equal
+    0
+    (parser-generator-lr--get-symbol-precedence-value 'a)))
+  (should
+   (equal
+    '%right
+    (parser-generator-lr--get-symbol-precedence-type 'b)))
+  (should
+   (equal
+    1
+    (parser-generator-lr--get-symbol-precedence-value 'b)))
+  (should
+   (equal
+    '%left
+    (parser-generator-lr--get-symbol-precedence-type 'c)))
+  (should
+   (equal
+    2
+    (parser-generator-lr--get-symbol-precedence-value 'c)))
+  (message "Passed generation of precedence value and type of symbols.")
+
+  ;; Sp -> S
+  (should
+   (equal
+    nil
+    (parser-generator-lr--get-production-number-precedence-type 0)))
+  (should
+   (equal
+    nil
+    (parser-generator-lr--get-production-number-precedence-value 0)))
+
+  ;; S -> A c
+  (should
+   (equal
+    '%left
+    (parser-generator-lr--get-production-number-precedence-type 1)))
+  (should
+   (equal
+    2
+    (parser-generator-lr--get-production-number-precedence-value 1)))
+
+  ;; S -> B
+  (should
+   (equal
+    nil
+    (parser-generator-lr--get-production-number-precedence-type 2)))
+  (should
+   (equal
+    nil
+    (parser-generator-lr--get-production-number-precedence-value 2)))
+
+  ;; A -> a b
+  (should
+   (equal
+    '%right
+    (parser-generator-lr--get-production-number-precedence-type 3)))
+  (should
+   (equal
+    1
+    (parser-generator-lr--get-production-number-precedence-value 3)))
+
+  ;; B -> a b c %prec FIRST
+  (should
+   (equal
+    '%precedence
+    (parser-generator-lr--get-production-number-precedence-type 4)))
+  (should
+   (equal
+    4
+    (parser-generator-lr--get-production-number-precedence-value 4)))
 
   ;; Grammar with conflicts that can be resolved
   ;; using context-sensitive precedence attributes
@@ -470,6 +537,54 @@
    '%prec)
   (parser-generator-lr-generate-parser-tables)
 
+  ;; TODO Test-cases
+
+  (error "here")
+
+  (message "Passed tests for 
(parser-generator-lr--generate-precedence-tables)"))
+
+(defun parser-generator-lr-test--generate-action-tables ()
+  "Test `parser-generator-lr--generate-action-tables'."
+  (message "Starting tests for (parser-generator-lr--generate-action-tables)")
+
+  ;; Example 5.32 p. 393
+  (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)
+  (parser-generator-process-grammar)
+  (parser-generator-lr-generate-parser-tables)
+
+  ;; Fig. 5.9 p. 374, replaced e with $
+  (should
+   (equal
+    '((0 ((($) reduce 2) ((a) reduce 2)))
+      (1 ((($) accept) ((a) shift)))
+      (2 (((a) reduce 2) ((b) reduce 2)))
+      (3 (((a) shift) ((b) shift)))
+      (4 (((a) reduce 2) ((b) reduce 2)))
+      (5 ((($) reduce 1) ((a) reduce 1)))
+      (6 (((a) shift) ((b) shift)))
+      (7 (((a) reduce 1) ((b) reduce 1))))
+    (parser-generator-lr--get-expanded-action-tables)))
+  (message "Passed Example 5.32 p. 393")
+
+  ;; Cyclical grammar
+  (parser-generator-set-grammar
+   '(
+     (Sp S A B)
+     (a b c)
+     (
+      (Sp S)
+      (S A B)
+      (A (a b A) (a B))
+      (B (c S))
+      )
+     Sp))
+  (parser-generator-set-look-ahead-number 1)
+  (parser-generator-process-grammar)
+  (parser-generator-lr-generate-parser-tables)
+  (message "Passed cyclical grammar")
+
   (message "Passed tests for (parser-generator-lr--generate-action-tables)"))
 
 (defun parser-generator-lr-test--generate-goto-tables ()
@@ -1928,6 +2043,7 @@
   (parser-generator-lr-test--items-valid-p)
   (parser-generator-lr-test--generate-goto-tables)
   (parser-generator-lr-test--generate-action-tables)
+  (parser-generator-lr-test--generate-precedence-tables)
   (parser-generator-lr-test-parse)
   (parser-generator-lr-test-translate)
   (parser-generator-lr-test-parse-k-2)