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

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

[elpa] externals/parser-generator 17c36f8 309/434: Added cache to lr-ite


From: ELPA Syncer
Subject: [elpa] externals/parser-generator 17c36f8 309/434: Added cache to lr-items for prefix function
Date: Mon, 29 Nov 2021 16:00:04 -0500 (EST)

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

    Added cache to lr-items for prefix function
---
 parser-generator-lr.el | 409 +++++++++++++++++++++++++++----------------------
 1 file changed, 225 insertions(+), 184 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 9a4168c..705e77b 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -26,12 +26,20 @@
   nil
   "Goto-tables for grammar.")
 
+(defvar
+  parser-generator-lr--table-lr-items-for-symbol
+  nil
+  "LR-items cache for symbol.")
+
 
 ;; Main Algorithms
 
 (defun parser-generator-lr-generate-parser-tables ()
   "Generate parsing tables for grammar."
   (message "\nStarting generation of parser-tables..\n")
+  (setq
+   parser-generator-lr--table-lr-items-for-symbol
+   (make-hash-table :test 'equal))
   (let ((table-lr-items
          (parser-generator-lr--generate-goto-tables)))
     (parser-generator-lr--generate-action-tables
@@ -368,8 +376,10 @@
                   (when
                       (and
                        (or
-                        (parser-generator--valid-terminal-p next-symbol)
-                        (parser-generator--valid-non-terminal-p next-symbol))
+                        (parser-generator--valid-terminal-p
+                         next-symbol)
+                        (parser-generator--valid-non-terminal-p
+                         next-symbol))
                        (not
                         (gethash
                          temp-hash-key
@@ -413,12 +423,12 @@
 
                   (parser-generator--debug
                    (message
-                    "GOTO(%s, %s) = %s"
+                    "GOTO(%S, %S) = %S"
                     lr-items
                     symbol
                     prefix-lr-items))
 
-                  ;; and is not already in S
+                  ;; and set is not already in S
                   (let ((goto
                          (gethash
                           prefix-lr-items-hash-key
@@ -466,11 +476,10 @@
          (sort
           goto-table-table
           'parser-generator--sort-list))
-        (when goto-table-table
-          (message
-           "GOTO-TABLE (%d): %S\n"
-           lr-item-set-index
-           goto-table-table))
+        (message
+         "GOTO-TABLE (%d): %S\n"
+         lr-item-set-index
+         goto-table-table)
         (push
          `(
            ,lr-item-set-index
@@ -501,18 +510,21 @@
          (car (cdr (nth table-index goto-table)))
          parser-generator-lr--goto-tables)
         (setq table-index (1+ table-index))))
-    (unless
-        (parser-generator-lr--items-valid-p
-         (parser-generator--hash-values-to-list
-          table-lr-items
-          t))
-      (error "Inconsistent grammar!"))
+    (parser-generator-lr--items-valid-p
+     (parser-generator--hash-values-to-list
+      table-lr-items
+      t)
+     t)
     (message "\nCompleted generation of goto-tables.\n")
     table-lr-items))
 
 ;; Algorithm 5.10, p. 391
-(defun parser-generator-lr--items-valid-p (lr-item-sets)
-  "Return whether the set collection LR-ITEM-SETS is valid or not."
+(defun parser-generator-lr--items-valid-p
+    (
+     lr-item-sets
+     &optional signal-on-false
+     )
+  "Return whether the set collection LR-ITEM-SETS is valid or not, optionally 
SIGNAL-ON-FALSE."
   (parser-generator--debug
    (message "lr-item-sets: %s" lr-item-sets))
   (let ((valid-p t)
@@ -589,8 +601,16 @@
 
               (dolist (b-suffix-follow-eff-item b-suffix-follow-eff)
                 (when (equal a-follow b-suffix-follow-eff-item)
-                  (parser-generator--debug
-                   (message "Inconsistent grammar! %s conflicts with %s" a b))
+                  (when
+                      signal-on-false
+                    (signal
+                     'error
+                     (format
+                      "Inconsistent grammar! %s (index: %d) conflicts with %s 
(index: %d)"
+                      a
+                      a-index
+                      b
+                      b-index)))
                   (setq valid-p nil))))
             (setq b-index (1+ b-index))))
         (setq a-index (1+ a-index)))
@@ -795,185 +815,206 @@
            (message "γ: %s" γ))
           prefix-previous)))))
 
-;; TODO Optimize this function 1. first and 2. sort
 (defun parser-generator-lr--items-for-goto (previous-lr-item x)
   "Calculate LR-items for GOTO(PREVIOUS-LR-ITEM, X)."
-  (let ((lr-new-item)
-        (lr-item-exists
-         (make-hash-table :test 'equal))
-        (eof-list
-         (parser-generator--generate-list-of-symbol
-          parser-generator--look-ahead-number
-          parser-generator--eof-identifier)))
-    (parser-generator--debug (message "x: %s" x))
-
-    ;; TODO Use caches to optimize this loop
-    (dolist (lr-item previous-lr-item)
-      (let ((lr-item-lhs (nth 0 lr-item))
-            (lr-item-prefix (nth 1 lr-item))
-            (lr-item-suffix (nth 2 lr-item))
-            (lr-item-look-ahead (nth 3 lr-item))
-            (lr-item-suffix-first)
-            (lr-item-suffix-rest))
-        (setq
-         lr-item-suffix-first
-         (car lr-item-suffix))
+  (let ((lr-items-cache-key
+         (format
+          "%S-%S"
+          previous-lr-item
+          x)))
+    (unless
+        parser-generator-lr--table-lr-items-for-symbol
         (setq
-         lr-item-suffix-rest
-         (cdr lr-item-suffix))
-
+         parser-generator-lr--table-lr-items-for-symbol
+         (make-hash-table :test 'equal)))
+    (unless (gethash
+             lr-items-cache-key
+             parser-generator-lr--table-lr-items-for-symbol)
+      (let ((lr-new-item)
+            (lr-item-exists
+             (make-hash-table :test 'equal))
+            (eof-list
+             (parser-generator--generate-list-of-symbol
+              parser-generator--look-ahead-number
+              parser-generator--eof-identifier)))
         (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-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
+         (message "x: %s" x))
+
+        ;; TODO Use caches to optimize this loop
+        (dolist (lr-item previous-lr-item)
+          (let ((lr-item-lhs (nth 0 lr-item))
+                (lr-item-prefix (nth 1 lr-item))
+                (lr-item-suffix (nth 2 lr-item))
+                (lr-item-look-ahead (nth 3 lr-item))
+                (lr-item-suffix-first)
+                (lr-item-suffix-rest))
+            (setq
              lr-item-suffix-first
-             x)
-
-          ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
-          (let ((combined-prefix
-                 (append
-                  lr-item-prefix
-                  (list x))))
-            (let ((lr-new-item-1))
-              (if
-                  (=
-                   parser-generator--look-ahead-number
-                   0)
-                  ;; Only k >= 1 needs dot look-ahead
-                  (progn
+             (car lr-item-suffix))
+            (setq
+             lr-item-suffix-rest
+             (cdr lr-item-suffix))
+
+            (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-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
+                 x)
+
+              ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
+              (let ((combined-prefix
+                     (append
+                      lr-item-prefix
+                      (list x))))
+                (let ((lr-new-item-1))
+                  (if
+                      (=
+                       parser-generator--look-ahead-number
+                       0)
+                      ;; Only k >= 1 needs dot look-ahead
+                      (progn
+                        (setq
+                         lr-new-item-1
+                         `(,lr-item-lhs
+                           ,combined-prefix
+                           ,lr-item-suffix-rest)))
                     (setq
                      lr-new-item-1
                      `(,lr-item-lhs
                        ,combined-prefix
-                       ,lr-item-suffix-rest)))
-                (setq
-                 lr-new-item-1
-                 `(,lr-item-lhs
-                   ,combined-prefix
-                   ,lr-item-suffix-rest
-                   ,lr-item-look-ahead)))
-              (parser-generator--debug
-               (message
-                "lr-new-item-1: %s"
-                lr-new-item-1))
-              (push
-               lr-new-item-1
-               lr-new-item))))))
-
-    ;; (c) Repeat step (2b) until no more new items can be added to 
V(X1,...,Xi)
-    (when lr-new-item
-      (let ((added-new t))
-        (while added-new
-          (setq added-new nil)
-
-          ;; TODO Use caches to optimize this loop
-          (dolist (lr-item lr-new-item)
-            (let ((lr-item-suffix (nth 2 lr-item)))
-              (let ((lr-item-suffix-first
-                     (car lr-item-suffix))
-                    (lr-item-suffix-rest
-                     (append
-                      (cdr lr-item-suffix)
-                      (nth 3 lr-item))))
-                (parser-generator--debug
-                 (message
-                  "lr-item-suffix-rest: %s from %s + %s"
-                  lr-item-suffix-rest
-                  (cdr lr-item-suffix)
-                  (nth 3 lr-item)))
-
-                ;; (b) If [A -> a . Bb, u] has been placed in V(X1,...,Xi)
-                ;; and B -> D is in P
-                (when
-                    (parser-generator--valid-non-terminal-p
-                     lr-item-suffix-first)
-
-                  (let ((lr-item-suffix-rest-first
-                         (parser-generator--first
-                          lr-item-suffix-rest
-                          nil
-                          t
-                          t)))
+                       ,lr-item-suffix-rest
+                       ,lr-item-look-ahead)))
+                  (parser-generator--debug
+                   (message
+                    "lr-new-item-1: %s"
+                    lr-new-item-1))
+                  (push
+                   lr-new-item-1
+                   lr-new-item))))))
+
+        ;; (c) Repeat step (2b) until no more new items can be added to 
V(X1,...,Xi)
+        (when lr-new-item
+          (let ((added-new t))
+            (while added-new
+              (setq added-new nil)
+
+              ;; TODO Use caches to optimize this loop
+              (dolist (lr-item lr-new-item)
+                (let ((lr-item-suffix (nth 2 lr-item)))
+                  (let ((lr-item-suffix-first
+                         (car lr-item-suffix))
+                        (lr-item-suffix-rest
+                         (append
+                          (cdr lr-item-suffix)
+                          (nth 3 lr-item))))
                     (parser-generator--debug
                      (message
-                      "lr-item-suffix-rest-first (before): %s"
-                      lr-item-suffix-rest-first))
+                      "lr-item-suffix-rest: %s from %s + %s"
+                      lr-item-suffix-rest
+                      (cdr lr-item-suffix)
+                      (nth 3 lr-item)))
 
-                    ;; EOF-markers are always a possible look-ahead
-                    (unless lr-item-suffix-rest-first
-                      (setq
-                       lr-item-suffix-rest-first
-                       (list eof-list)))
+                    ;; (b) If [A -> a . Bb, u] has been placed in V(X1,...,Xi)
+                    ;; and B -> D is in P
+                    (when
+                        (parser-generator--valid-non-terminal-p
+                         lr-item-suffix-first)
+
+                      (let ((lr-item-suffix-rest-first
+                             (parser-generator--first
+                              lr-item-suffix-rest
+                              nil
+                              t
+                              t)))
+                        (parser-generator--debug
+                         (message
+                          "lr-item-suffix-rest-first (before): %s"
+                          lr-item-suffix-rest-first))
 
-                    (parser-generator--debug
-                     (message
-                      "lr-item-suffix-rest-first (after): %s"
-                      lr-item-suffix-rest-first))
-                    (let ((sub-production
-                           (parser-generator--get-grammar-rhs
-                            lr-item-suffix-first)))
-
-                      ;; For each production with B as LHS
-                      (dolist (sub-rhs sub-production)
-
-                        ;; Transform e-productions into nil
-                        (when (and
-                               (= (length sub-rhs) 1)
-                               (parser-generator--valid-e-p
-                                (car sub-rhs)))
-                          (setq sub-rhs nil))
-
-                        ;; For each x in FIRST(αu)
-                        (dolist (f lr-item-suffix-rest-first)
-
-                          ;; then add [B -> . D, x] to V(X1,...,Xi) for each x 
in FIRST(bu)
-                          ;; provided it is not already there
-                          (let ((lr-item-to-add
-                                 `(,(list lr-item-suffix-first) nil ,sub-rhs 
,f)))
-                            ;; Only k >= 1 needs dot a look-ahead
-                            (when
-                                (=
-                                 parser-generator--look-ahead-number
-                                 0)
-                              (setq
-                               lr-item-to-add
-                               `(,(list lr-item-suffix-first) nil ,sub-rhs)))
-                            (let ((temp-hash-key
-                                   (format
-                                    "%S"
-                                    lr-item-to-add)))
-                              (unless
-                                  (gethash
-                                   temp-hash-key
-                                   lr-item-exists)
-                                (setq
-                                 added-new
-                                 t)
-                                (parser-generator--debug
-                                 (message
-                                  "lr-item-to-add: %s"
-                                  lr-item-to-add))
-                                (puthash
-                                 temp-hash-key
-                                 t
-                                 lr-item-exists)
-                                (push
-                                 lr-item-to-add
-                                 lr-new-item))))))))))))))
-      (setq
-       lr-new-item
-       (sort
-        lr-new-item
-        'parser-generator--sort-list))) ;; TODO Optimize this?
+                        ;; EOF-markers are always a possible look-ahead
+                        (unless lr-item-suffix-rest-first
+                          (setq
+                           lr-item-suffix-rest-first
+                           (list eof-list)))
 
-    lr-new-item))
+                        (parser-generator--debug
+                         (message
+                          "lr-item-suffix-rest-first (after): %s"
+                          lr-item-suffix-rest-first))
+                        (let ((sub-production
+                               (parser-generator--get-grammar-rhs
+                                lr-item-suffix-first)))
+
+                          ;; For each production with B as LHS
+                          (dolist (sub-rhs sub-production)
+
+                            ;; Transform e-productions into nil
+                            (when (and
+                                   (= (length sub-rhs) 1)
+                                   (parser-generator--valid-e-p
+                                    (car sub-rhs)))
+                              (setq sub-rhs nil))
+
+                            ;; For each x in FIRST(αu)
+                            (dolist (f lr-item-suffix-rest-first)
+
+                              ;; then add [B -> . D, x] to V(X1,...,Xi) for 
each x in FIRST(bu)
+                              ;; provided it is not already there
+                              (let ((lr-item-to-add
+                                     `(,(list lr-item-suffix-first) nil 
,sub-rhs ,f)))
+                                ;; Only k >= 1 needs dot a look-ahead
+                                (when
+                                    (=
+                                     parser-generator--look-ahead-number
+                                     0)
+                                  (setq
+                                   lr-item-to-add
+                                   `(,(list lr-item-suffix-first) nil 
,sub-rhs)))
+                                (let ((temp-hash-key
+                                       (format
+                                        "%S"
+                                        lr-item-to-add)))
+                                  (unless
+                                      (gethash
+                                       temp-hash-key
+                                       lr-item-exists)
+                                    (setq
+                                     added-new
+                                     t)
+                                    (parser-generator--debug
+                                     (message
+                                      "lr-item-to-add: %s"
+                                      lr-item-to-add))
+                                    (puthash
+                                     temp-hash-key
+                                     t
+                                     lr-item-exists)
+                                    (push
+                                     lr-item-to-add
+                                     lr-new-item))))))))))))))
+
+          ;; Sort result for a more deterministic result
+          (setq
+           lr-new-item
+           (sort
+            lr-new-item
+            'parser-generator--sort-list))) ;; TODO Optimize this?
+
+        (puthash
+         lr-items-cache-key
+         lr-new-item
+         parser-generator-lr--table-lr-items-for-symbol)))
+    (gethash
+     lr-items-cache-key
+     parser-generator-lr--table-lr-items-for-symbol)))
 
 (defun parser-generator-lr-parse
     (&optional



reply via email to

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