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

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

[elpa] externals/parser-generator 9c30f34 385/434: More work on refactor


From: ELPA Syncer
Subject: [elpa] externals/parser-generator 9c30f34 385/434: More work on refactoring conflict resolution
Date: Mon, 29 Nov 2021 16:00:21 -0500 (EST)

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

    More work on refactoring conflict resolution
---
 parser-generator-lr.el           | 198 ++++++++++++---------------------------
 test/parser-generator-lr-test.el | 101 ++++++--------------
 2 files changed, 88 insertions(+), 211 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 1cd0534..68267f6 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -436,7 +436,7 @@
                                                      t))
                                                 (let ((action-item
                                                        (list
-                                                         eff-item
+                                                        eff-item
                                                         'shift)))
                                                   ;; Add symbol to hash-table 
to
                                                   ;; enable conflict resolution
@@ -444,7 +444,7 @@
                                                          (format
                                                           "%s-%S"
                                                           goto-index
-                                                           eff-item)))
+                                                          eff-item)))
                                                     (unless
                                                         (gethash
                                                          index-hash-key
@@ -541,7 +541,7 @@
                                          (format
                                           "%s-%S"
                                           goto-index
-                                           u)))
+                                          u)))
 
                                     ;; Check if we have an action on this 
symbol already
                                     (when
@@ -551,7 +551,7 @@
                                       (if
                                           (and
                                            
parser-generator-lr--precedence-comparison-function
-                                           
parser-generator-lr--global-precedence-table)
+                                           
parser-generator-lr--global-precedence-attributes)
                                           (let ((a
                                                  (list u 'reduce 
production-number))
                                                 (b
@@ -560,15 +560,14 @@
                                                   index-symbols)))
                                             (if
                                                 
(parser-generator-lr--action-takes-precedence-p
-                                                 (car (last B))
                                                  (car (last u))
                                                  production-number
                                                  (nth 2 b))
                                                 (progn
-                                                   (message
-                                                    "'%s' takes precedence 
over '%s'"
-                                                    a
-                                                    b)
+                                                  (message
+                                                   "'%s' takes precedence over 
'%s'"
+                                                   a
+                                                   b)
                                                   ;; Remove b from 
added-actions
                                                   (let ((new-action-table))
                                                     (dolist (action-item 
action-table)
@@ -583,10 +582,10 @@
                                                      action-table
                                                      (reverse
                                                       new-action-table))))
-                                               (message
-                                                "'%s' takes precedence over 
'%s'"
-                                                b
-                                                a)
+                                              (message
+                                               "'%s' takes precedence over 
'%s'"
+                                               b
+                                               a)
                                               ;; Skip rest of this iteration
                                               (setq
                                                skip-symbol
@@ -624,7 +623,7 @@
                                             (nth (1- (length u)) u)))
                                           (let ((action-item
                                                  (list
-                                                   u
+                                                  u
                                                   'accept)))
                                             (puthash
                                              index-hash-key
@@ -646,7 +645,7 @@
                                         ;; save reduction action in action 
table
                                         (let ((action-item
                                                (list
-                                                 u
+                                                u
                                                 'reduce
                                                 production-number)))
                                           (puthash
@@ -671,12 +670,7 @@
                      nil)))
                   (setq
                    lr-item-index
-                   (1+ lr-item-index)))
-
-                ;; TODO Handle case here were we have a conflict
-                ;; TODO shift/reduce or reduce/reduce
-
-                ))))
+                   (1+ lr-item-index)))))))
         (parser-generator--debug
          (message "%s actions %s" goto-index action-table))
         (when action-table
@@ -1149,7 +1143,8 @@
                        b-production-number)
                       (progn
                         (unless
-                            
(parser-generator-lr--conflict-can-be-resolved-by-context
+                            (parser-generator-lr--action-takes-precedence-p
+                             a-follow
                              a-production-number
                              b-production-number)
                           (when
@@ -1181,132 +1176,61 @@
       (setq set-index (1+ set-index)))
     valid-p))
 
-(defun parser-generator-lr--action-takes-precedence-p (a-symbol b-symbol 
a-production-number &optional b-production-number)
-  "Return t if action of A-SYMBOL at A-PRODUCTION-NUMBER takes precedence over 
B-SYMBOL optionally at B-PRODUCTION-NUMBER."
-  (let ((a-precedence-value
-         (gethash
-          a-symbol
-          parser-generator-lr--global-precedence-table))
-        (b-precedence-value
-         (gethash
-          b-symbol
-          parser-generator-lr--global-precedence-table)))
+(defun parser-generator-lr--action-takes-precedence-p (symbol 
a-production-number &optional b-production-number)
+  "Return t if reduce action of SYMBOL at A-PRODUCTION-NUMBER takes precedence 
over shift action.  Optionally is b is a reduction at at B-PRODUCTION-NUMBER."
+  (let* ((a-precedence-type
+          (parser-generator-lr--get-symbol-precedence-type
+           symbol))
+         (a-precedence-value
+          (parser-generator-lr--get-symbol-precedence-value
+           symbol))
+         (b-precedence-type
+          a-precedence-type)
+         (b-precedence-value
+          a-precedence-value))
 
     ;; Context-sensitive precedence takes precedence over
     ;; global precedence
-    (let ((a-attributes
-           (gethash
-            a-production-number
-            parser-generator--table-productions-attributes)))
-      (when a-attributes
-        (let ((a-precedence-symbol
-               (plist-get
-                a-attributes
-                parser-generator-lr--context-sensitive-precedence-attribute)))
-          (when a-precedence-symbol
-            (setq
-             a-precedence-value
-             (gethash
-              a-precedence-symbol
-              parser-generator-lr--global-precedence-table))))))
+    (let ((a-production-precedence-value
+           (parser-generator-lr--get-production-number-precedence-value
+            a-production-number))
+          (a-production-precedence-type
+           (parser-generator-lr--get-production-number-precedence-type
+            a-production-number)))
+      (when (and
+             a-production-precedence-type
+             a-production-precedence-value)
+        (setq
+         a-precedence-type
+         a-production-precedence-type)
+        (setq
+         a-precedence-value
+         a-production-precedence-value)))
 
     (when b-production-number
-      (let ((b-attributes
-             (gethash
-              b-production-number
-              parser-generator--table-productions-attributes)))
-        (when b-attributes
-          (let ((b-precedence-symbol
-                 (plist-get
-                  b-attributes
-                  
parser-generator-lr--context-sensitive-precedence-attribute)))
-            (when b-precedence-symbol
-              (setq
-               b-precedence-value
-               (gethash
-                b-precedence-symbol
-                parser-generator-lr--global-precedence-table)))))))
+      (let ((b-production-precedence-value
+             (parser-generator-lr--get-production-number-precedence-value
+              b-production-number))
+            (b-production-precedence-type
+             (parser-generator-lr--get-production-number-precedence-type
+              b-production-number)))
+        (when (and
+               b-production-precedence-type
+               b-production-precedence-value)
+          (setq
+           b-precedence-type
+           b-production-precedence-type)
+          (setq
+           b-precedence-value
+           b-production-precedence-value))))
 
     (funcall
      parser-generator-lr--precedence-comparison-function
+     a-precedence-type
      a-precedence-value
+     b-precedence-type
      b-precedence-value)))
 
-(defun parser-generator-lr--conflict-can-be-resolved-by-context 
(a-production-number b-production-number)
-  "Return whether a conflict can be solved by context between 
A-PRODUCTION-NUMBER and B-PRODUCTION-NUMBER."
-  (let ((can-be-resolved)
-        (a-precedence-value)
-        (b-precedence-value))
-    (when
-        ;; Precedence comparison function exists?
-        (and
-         parser-generator-lr--precedence-comparison-function
-         (functionp
-          parser-generator-lr--precedence-comparison-function)
-         parser-generator-lr--global-precedence-attributes
-         parser-generator-lr--context-sensitive-precedence-attribute)
-
-      ;; Try to find precedence data for A
-      (when a-production-number
-        (let ((a-attributes
-               (gethash
-                a-production-number
-                parser-generator--table-productions-attributes)))
-          (when a-attributes
-            (let ((a-precedence-symbol
-                   (plist-get
-                    a-attributes
-                    
parser-generator-lr--context-sensitive-precedence-attribute)))
-              (when a-precedence-symbol
-                (setq
-                 a-precedence-value
-                 (gethash
-                  a-precedence-symbol
-                  parser-generator-lr--global-precedence-table)))))))
-
-      ;; Try to find precedence data for B
-      (when b-production-number
-        (let ((b-attributes
-               (gethash
-                b-production-number
-                parser-generator--table-productions-attributes)))
-          (when b-attributes
-            (let ((b-precedence-symbol
-                   (plist-get
-                    b-attributes
-                    
parser-generator-lr--context-sensitive-precedence-attribute)))
-              (when b-precedence-symbol
-                (setq
-                 b-precedence-value
-                 (gethash
-                  b-precedence-symbol
-                  parser-generator-lr--global-precedence-table)))))))
-
-      (when (or
-             a-precedence-value
-             b-precedence-value)
-        (let (
-              (comparison-a-b
-               (funcall
-                parser-generator-lr--precedence-comparison-function
-                a-precedence-value
-                b-precedence-value))
-              (comparison-b-a
-               (funcall
-                parser-generator-lr--precedence-comparison-function
-                b-precedence-value
-                a-precedence-value)))
-          (unless
-              (equal
-               comparison-a-b
-               comparison-b-a)
-            (setq
-             can-be-resolved
-             t))))
-
-      )
-    can-be-resolved))
-
 ;; Algorithm 5.8, p. 386
 (defun parser-generator-lr--items-for-prefix (γ)
   "Calculate valid LR-items for the viable prefix Γ."
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 50a9e22..677f92d 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -219,85 +219,38 @@
    '%prec)
   (setq
    parser-generator-lr--precedence-comparison-function
-   (lambda(a b)
-     (let ((a-max-op)
-           (a-max-value)
-           (b-max-op)
-           (b-max-value))
-       (message "(parser-generator-lr--precedence-comparison-function %S %S)" 
a b)
-       (when a
-         (let ((a-left (plist-get a '%left))
-               (a-precedence (plist-get a '%precedence))
-               (a-right (plist-get a '%right)))
-           (when (and
-                  a-left
-                  (or
-                   (not a-max-value)
-                   (> a-left a-max-value)))
-             (setq a-max-op '%left)
-             (setq a-max-value a-left))
-           (when (and
-                  a-precedence
-                  (or
-                   (not a-max-value)
-                   (> a-precedence a-max-value)))
-             (setq a-max-op '%precedence)
-             (setq a-max-value a-precedence))
-           (when (and
-                  a-right
-                  (or
-                   (not a-max-value)
-                   (> a-right a-max-value)))
-             (setq a-max-op '%right)
-             (setq a-max-value a-right))))
-       (when b
-         (let ((b-left (plist-get b '%left))
-               (b-precedence (plist-get b '%precedence))
-               (b-right (plist-get b '%right)))
-           (when (and
-                  b-left
-                  (or
-                   (not b-max-value)
-                   (> b-left b-max-value)))
-             (setq b-max-op '%left)
-             (setq b-max-value b-left))
-           (when (and
-                  b-precedence
-                  (or
-                   (not b-max-value)
-                   (> b-precedence b-max-value)))
-             (setq b-max-op '%precedence)
-             (setq b-max-value b-precedence))
-           (when (and
-                  b-right
-                  (or
-                   (not b-max-value)
-                   (> b-right b-max-value)))
-             (setq b-max-op '%right)
-             (setq b-max-value b-right))))
+   (lambda(a-type a-value b-type b-value)
+     (cond
+
+      ((and
+        a-value
+        b-value)
        (cond
-        ((and
-          a-max-value
-          (or
-           (not b-max-value)
-           (> a-max-value b-max-value)))
+        ((> a-value b-value)
          t)
-        ((and
-          b-max-value
-          (or
-           (not a-max-value)
-           (> b-max-value a-max-value)))
+
+        ((< a-value b-value)
          nil)
-        ((and
-          a-max-value
-          b-max-value
-          (= a-max-value b-max-value))
+
+        ((= a-value b-value)
+
          (cond
-          ((or
-            (equal a-max-op '%left)
-            (equal a-max-op '%precedence))
+          ((equal a-type '%left)
            t)
-          (t nil)))))))
+
+          ((equal a-type '%right)
+           nil)
+
+          ((equal a-type '%precedence)
+           t))
+
+         )))
+
+      ((and
+        a-value
+        (not b-value))
+       t))
+     nil))
   (parser-generator-lr-generate-parser-tables)
   (should
    (equal



reply via email to

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