emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/parser-generator 5a1f09a 369/434: More work on adding s


From: ELPA Syncer
Subject: [elpa] externals/parser-generator 5a1f09a 369/434: More work on adding support for production number related precedence
Date: Mon, 29 Nov 2021 16:00:17 -0500 (EST)

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

    More work on adding support for production number related precedence
---
 parser-generator-lr.el           | 189 ++++++++++++++++++++-------------------
 parser-generator.el              |  20 -----
 test/parser-generator-lr-test.el |   6 ++
 3 files changed, 101 insertions(+), 114 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index ab23621..6727751 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -191,10 +191,6 @@
                             C
                             v))
                           (when Cv
-                            (setq
-                             Cv
-                             (parser-generator--get-symbols-without-attributes
-                              Cv))
                             (let
                                 ((eff
                                   (parser-generator--e-free-first
@@ -262,8 +258,7 @@
                                                   ;; An extra column for '$' 
(end of input) is added to the action table that contains acc for every item 
set that contains an item of the form S → w • eof.
                                                   (let ((action-item
                                                          (list
-                                                          
(parser-generator--get-symbols-without-attributes
-                                                          eff-item)
+                                                          eff-item
                                                           'accept)))
                                                     ;; Add symbol to 
hash-table to
                                                     ;; enable conflict 
resolution
@@ -271,8 +266,7 @@
                                                            (format
                                                             "%s-%S"
                                                             goto-index
-                                                            
(parser-generator--get-symbols-without-attributes
-                                                             eff-item))))
+                                                            eff-item)))
                                                       (unless
                                                           (gethash
                                                            index-hash-key
@@ -289,8 +283,7 @@
                                                      t))
                                                 (let ((action-item
                                                        (list
-                                                        
(parser-generator--get-symbols-without-attributes
-                                                         eff-item)
+                                                         eff-item
                                                         'shift)))
                                                   ;; Add symbol to hash-table 
to
                                                   ;; enable conflict resolution
@@ -298,8 +291,7 @@
                                                          (format
                                                           "%s-%S"
                                                           goto-index
-                                                          
(parser-generator--get-symbols-without-attributes
-                                                           eff-item))))
+                                                           eff-item)))
                                                     (unless
                                                         (gethash
                                                          index-hash-key
@@ -396,8 +388,7 @@
                                          (format
                                           "%s-%S"
                                           goto-index
-                                          
(parser-generator--get-symbols-without-attributes
-                                           u))))
+                                           u)))
 
                                     (when
                                         (gethash
@@ -476,8 +467,7 @@
                                             (nth (1- (length u)) u)))
                                           (let ((action-item
                                                  (list
-                                                  
(parser-generator--get-symbols-without-attributes
-                                                   u)
+                                                   u
                                                   'accept)))
                                             (puthash
                                              index-hash-key
@@ -499,8 +489,7 @@
                                         ;; save reduction action in action 
table
                                         (let ((action-item
                                                (list
-                                                
(parser-generator--get-symbols-without-attributes
-                                                 u)
+                                                 u
                                                 'reduce
                                                 production-number)))
                                           (puthash
@@ -668,8 +657,7 @@
             (when symbols
               ;; Convert symbols in grammar with attributes to simple symbols
               (let ((next-symbol
-                     (parser-generator--get-symbol-without-attributes
-                      (car symbols))))
+                     (car symbols)))
                 (let ((temp-hash-key
                        (format
                         "%S"
@@ -872,13 +860,17 @@
         (a-follow)
         (a-follow-full)
         (a-index 0)
+        (a-production)
+        (a-production-number)
         (b)
         (b-suffix)
         (b-follow)
         (b-suffix-follow)
         (b-suffix-follow-eff)
         (b-suffix-follow-eff-item)
-        (b-index 0))
+        (b-index 0)
+        (b-production)
+        (b-production-number))
 
     ;; Iterate each set
     (while (and
@@ -909,29 +901,39 @@
          (nth 2 a))
 
         (parser-generator--debug
-         (message "a: %s" a)
+         (message "a: %S" a)
          (message "a-look-ahead: %s" a-look-ahead))
 
         ;; The only sets of LR items which need to be tested are those that 
contain a dot at the right end of a production
+        ;; these states are points of reduction
         (when (and
                (nth 1 a)
                (not a-look-ahead))
           (setq
-           a-follow-full
+           a-follow
            (nth 3 a))
           (setq
-           a-follow
-           (parser-generator--get-symbols-without-attributes
-            a-follow-full))
+           a-production
+           (list
+            (nth 0 a)
+            (nth 1 a)))
+          (setq
+           a-production-number
+           (parser-generator--get-grammar-production-number
+            a-production))
 
           (parser-generator--debug
-           (message "a-follow: %s" a-follow))
+           (message "a-follow: %s" a-follow)
+           (message "a-production: %S" a-production)
+           (message "a-production-number: %S" a-production-number))
 
           ;; Iterate each set again
           (while (and
                   valid-p
                   (< b-index set-length))
-            (unless (= a-index b-index)
+            ;; Make sure it's not the same rule
+            (unless
+                (= a-index b-index)
               (setq
                b
                (nth b-index set))
@@ -954,29 +956,65 @@
                (parser-generator--e-free-first
                 b-suffix-follow))
 
+              ;; If b is at a point of reduction,
+              ;; calculate production and production-number
+              (if (not b-suffix)
+                  (progn
+                    (setq
+                     b-production
+                     (list
+                      (nth 0 b)
+                      (nth 1 b)))
+                    (setq
+                     b-production-number
+                     (parser-generator--get-grammar-production-number
+                      b-production)))
+                (setq
+                 b-production
+                 nil)
+                (setq
+                 b-production-number
+                 nil))
+
               (parser-generator--debug
+               (message "b-production: %S" b-production)
+               (message "b-production-number: %S" b-production)
                (message "b-suffix: %s" b-suffix)
                (message "b-follow: %s" b-follow)
                (message "b-suffix-follow: %s" b-suffix-follow)
                (message "b-suffix-follow-eff: %s" b-suffix-follow-eff))
 
               (dolist
-                  (b-suffix-follow-eff-item-full
+                  (b-suffix-follow-eff-item
                    b-suffix-follow-eff)
-                (setq
-                 b-suffix-follow-eff-item
-                 (parser-generator--get-symbols-without-attributes
-                  b-suffix-follow-eff-item-full))
                 (when (equal
                        a-follow
                        b-suffix-follow-eff-item)
-
-                  ;; If it's the same symbol but we have a precedence
-                  ;; attributes on any of them, or both, pass anyway
-                  (unless
-                      
(parser-generator-lr--conflict-can-be-resolved-by-attributes
-                       a-follow-full
-                       b-suffix-follow-eff-item-full)
+                  (if
+                      ;; If it's the same following symbol but we have
+                      ;; any production-number we might be able to continue
+                      ;; if there are precedence rules
+                      (or
+                       a-production-number
+                       b-production-number)
+                      (progn
+                        (unless
+                            
(parser-generator-lr--conflict-can-be-resolved-by-attributes
+                             a-follow-full
+                             a-production-number
+                             b-production-number)
+                          (when
+                              signal-on-false
+                            (error
+                             "Inconsistent grammar! '%S' (index: %d) with 
look-ahead '%S' conflicts with '%S' (index: %d) with look-ahead '%S' in 
sets:\n%S"
+                             a
+                             a-index
+                             a-follow-full
+                             b
+                             b-index
+                             b-suffix-follow-eff-item
+                             lr-item-sets))
+                          (setq valid-p nil)))
                     (when
                         signal-on-false
                       (error
@@ -986,7 +1024,7 @@
                        a-follow-full
                        b
                        b-index
-                       b-suffix-follow-eff-item-full
+                       b-suffix-follow-eff-item
                        lr-item-sets))
                     (setq valid-p nil)))))
             (setq b-index (1+ b-index))))
@@ -995,8 +1033,8 @@
     valid-p))
 
 ;; TODO Need to consider production-numbers as well
-(defun parser-generator-lr--symbol-takes-precedence-p (a b)
-  "Return t if A takes precedence over B, otherwise nil."
+(defun parser-generator-lr--symbol-takes-precedence-p (a b &optional 
a-production-number b-production-number)
+  "Return t if A takes precedence over B, otherwise nil.  Optionally check for 
predence rules related to A-PRODUCTION-NUMBER and B-PRODUCTION-NUMBER."
   (let ((takes-precedence)
         (a-global-reference)
         (a-precedence)
@@ -1076,50 +1114,21 @@
         errors)))
     takes-precedence))
 
-;; TODO Must consider production-numbers
-(defun parser-generator-lr--conflict-can-be-resolved-by-attributes (a b)
-  "Return whether a conflict between A and B can be resolved by attributes."
+(defun parser-generator-lr--conflict-can-be-resolved-by-attributes (symbol 
&optional a-production-number b-production-number)
+  "Return whether a conflict at SYMBOL can be resolved by 
precedence-attributes.  Optionally with A-PRODUCTION-NUMBER and 
B-PRODUCTION-NUMBER."
   (let ((can-be-resolved))
     (when
-        (and
-         parser-generator-lr--precedence-comparison-function
-         (functionp
-          parser-generator-lr--precedence-comparison-function)
-         (or
-          (and
-           parser-generator-lr--global-precedence-attributes
-           (or
-            (and
-             (not
-              (listp a))
-             (gethash
-              a
-              parser-generator-lr--global-precedence-table))
-            (and
-             (not
-              (listp b))
-             (gethash
-              b
-              parser-generator-lr--global-precedence-table))))
-          (and
-           parser-generator-lr--context-sensitive-precedence-attribute
-           (or (listp a)
-               (listp b)))))
-      (if
-          (parser-generator-lr--symbol-takes-precedence-p
-           a
-           b)
-          (setq
-           can-be-resolved
-           t)
-        (when
-            (parser-generator-lr--symbol-takes-precedence-p
-             b
-             a)
-            (setq
-             can-be-resolved
-             t))))
-    can-be-resolved))
+        ;; Precedence comparison function exists?
+        ;; (and
+        ;;  parser-generator-lr--precedence-comparison-function
+        ;;  (functionp
+        ;;   parser-generator-lr--precedence-comparison-function)
+        ;;  parser-generator-lr--global-precedence-attributes
+        ;;  (or
+        ;;   (gethash
+        ;;    symbol
+        ;;    parser-generator-lr--global-precedence-table)
+        can-be-resolved)))
 
 ;; Algorithm 5.8, p. 386
 (defun parser-generator-lr--items-for-prefix (γ)
@@ -1337,7 +1346,6 @@
             (lr-item-suffix (nth 2 lr-item))
             (lr-item-look-ahead (nth 3 lr-item))
             (lr-item-suffix-first)
-            (lr-item-suffix-first-wo-attributes)
             (lr-item-suffix-rest))
         (setq
          lr-item-suffix-first
@@ -1346,25 +1354,18 @@
          lr-item-suffix-rest
          (cdr lr-item-suffix))
 
-        ;; NOTE x is always without attributes
-        (setq
-         lr-item-suffix-first-wo-attributes
-         (parser-generator--get-symbol-without-attributes
-          lr-item-suffix-first))
-
         (parser-generator--debug
          (message "lr-item: %s" lr-item)
          (message "lr-item-prefix: %s" lr-item-prefix)
          (message "lr-item-suffix: %s" lr-item-suffix)
          (message "lr-item-suffix-first: %s" lr-item-suffix-first)
-         (message "lr-item-suffix-first-wo-attributes: %s" 
lr-item-suffix-first-wo-attributes)
          (message "lr-item-suffix-rest: %s" lr-item-suffix-rest)
          (message "lr-item-look-ahead: %s" lr-item-look-ahead))
 
         ;; (a) If [A -> a . XiB, u] is in V(X1,...,Xi-1)
         (when
             (equal
-              lr-item-suffix-first-wo-attributes
+              lr-item-suffix-first
              x)
 
           ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
diff --git a/parser-generator.el b/parser-generator.el
index 34a4b73..e0b8f4f 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -349,22 +349,6 @@
         (setq i (1+ i))))
     (sort permutations 'parser-generator--sort-list)))
 
-(defun parser-generator--get-symbol-without-attributes (symbol)
-  "Get SYMBOL without attributes."
-  (if (listp symbol)
-      (car symbol)
-    symbol))
-
-(defun parser-generator--get-symbols-without-attributes (symbols)
-  "Get list of SYMBOLS without attributes."
-  (let ((new-symbols))
-    (dolist (symbol symbols)
-      (push
-       (parser-generator--get-symbol-without-attributes
-        symbol)
-       new-symbols))
-    (reverse new-symbols)))
-
 (defun parser-generator--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)
@@ -876,10 +860,6 @@
     (error "Table for look-aheads is undefined!"))
   (unless (listp symbol)
     (setq symbol (list symbol)))
-  (setq
-   symbol
-   (parser-generator--get-symbols-without-attributes
-    symbol))
   (gethash
    symbol
    parser-generator--table-look-aheads-p))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 5620b93..df403af 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -164,7 +164,13 @@
        t)
       (t
        nil))))
+  ;; TODO Should add tests for 
(parser-generator-lr--prepare-global-declaration)
+  (parser-generator-lr--prepare-global-declaration)
+  (message "parser-generator-lr--global-precedence-attributes-table: %S" 
parser-generator-lr--global-precedence-attributes-table)
+  (message "parser-generator-lr--global-precedence-attributes: %S" 
parser-generator-lr--global-precedence-attributes)
+  (message "parser-generator-lr--global-precedence-table: %S" 
parser-generator-lr--global-precedence-table)
   (parser-generator-lr-generate-parser-tables)
+  
   (message "Grammar not conflicting anymore")
 
   (let ((table-lr-items



reply via email to

[Prev in Thread] Current Thread [Next in Thread]