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

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

[elpa] externals/parser-generator 36701c0 238/434: Optimized closure alg


From: ELPA Syncer
Subject: [elpa] externals/parser-generator 36701c0 238/434: Optimized closure algorithm to only use possible next-symbols instead of iterating all symbols
Date: Mon, 29 Nov 2021 15:59:49 -0500 (EST)

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

    Optimized closure algorithm to only use possible next-symbols instead of 
iterating all symbols
---
 parser-generator-lr.el           | 292 +++++++++++++++++++++++----------------
 test/parser-generator-lr-test.el |  22 ++-
 2 files changed, 195 insertions(+), 119 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index a050204..21e166f 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -186,14 +186,10 @@
         (unmarked-lr-item-sets)
         (marked-lr-item-sets
          (make-hash-table :test 'equal))
-        (symbols
-         (append
-          (parser-generator--get-grammar-non-terminals)
-          (parser-generator--get-grammar-terminals)))
+        (next-symbols)
+        (next-symbols-found (make-hash-table :test 'equal))
         (table-lr-items (make-hash-table :test 'equal))
         (e-list parser-generator--e-identifier))
-    (parser-generator--debug
-     (message "symbols: %s" symbols))
 
     (let ((e-set
            (parser-generator-lr--items-for-prefix
@@ -224,56 +220,94 @@
         (puthash lr-item-set-index lr-items table-lr-items)
         (setq goto-table-table nil)
 
-        ;; (2) By computing for each X in N u E, GOTO (a, X). (Algorithm 5.8 
can be used here.)
-        ;; V(X1,...,Xi) = GOTO(V(X1,...,Xi-1), Xi)
-        (dolist (symbol symbols)
-          (parser-generator--debug
-           (message "goto-symbol: %s" symbol))
+        ;; Build list of possible next-symbols here that follows lr-items set
+        (setq next-symbols nil)
+        (dolist (lr-item lr-items)
+          (let ((symbols (nth 2 lr-item)))
+            (when symbols
+              (let ((next-symbol (car symbols)))
+                (when (and
+                       (or
+                        (parser-generator--valid-terminal-p next-symbol)
+                        (parser-generator--valid-non-terminal-p next-symbol))
+                       (not
+                        (gethash
+                         (list
+                          lr-item-set-index
+                          next-symbol)
+                         next-symbols-found)))
+                  (push
+                   next-symbol
+                   next-symbols)
+                  (puthash
+                   (list
+                    lr-item-set-index
+                    next-symbol)
+                   t
+                   next-symbols-found))))
+
+            ;; Sort next-symbols for a more deterministic result
+            (when next-symbols
+              (setq
+               next-symbols
+               (sort
+                next-symbols
+                'string-lessp)))))
 
-          (let ((prefix-lr-items
-                 (parser-generator-lr--items-for-goto
-                  lr-items
-                  symbol)))
+        (parser-generator--debug
+         (message "next-symbols: %s" next-symbols))
 
-            ;; If a' = GOTO(a, X) is nonempty
-            (when prefix-lr-items
+        ;; (2) By computing for each X in N u E, GOTO (a, X). (Algorithm 5.8 
can be used here.)
+        ;; V(X1,...,Xi) = GOTO(V(X1,...,Xi-1), Xi)
+        (when next-symbols
+          (dolist (symbol next-symbols)
+            (parser-generator--debug
+             (message "goto-symbol: %s" symbol))
 
-              (parser-generator--debug
-               (message
-                "GOTO(%s, %s) = %s"
-                lr-items
-                symbol
-                prefix-lr-items))
-
-              ;; and is not already in S
-              (let ((goto
-                     (gethash
-                      prefix-lr-items
-                      marked-lr-item-sets)))
-                (if goto
-                    (progn
-                      (parser-generator--debug
-                       (message "Set already exists in: %s" goto))
-                      (push
-                       `(,symbol ,goto)
-                       goto-table-table))
+            (let ((prefix-lr-items
+                   (parser-generator-lr--items-for-goto
+                    lr-items
+                    symbol)))
 
-                  (parser-generator--debug
-                   (message "Set is new"))
+              ;; If a' = GOTO(a, X) is nonempty
+              (when prefix-lr-items
 
-                  ;; Note that GOTO(a, X) will always be empty if all items in 
a
-                  ;; have the dot at the right end of the production
+                (parser-generator--debug
+                 (message
+                  "GOTO(%s, %s) = %s"
+                  lr-items
+                  symbol
+                  prefix-lr-items))
+
+                ;; and is not already in S
+                (let ((goto
+                       (gethash
+                        prefix-lr-items
+                        marked-lr-item-sets)))
+                  (if goto
+                      (progn
+                        (parser-generator--debug
+                         (message "Set already exists in: %s" goto))
+                        (push
+                         `(,symbol ,goto)
+                         goto-table-table))
 
-                  ;; then add a' to S as an unmarked set of items
-                  (push
-                   `(,symbol ,lr-item-set-new-index)
-                   goto-table-table)
-                  (push
-                   `(,lr-item-set-new-index ,prefix-lr-items)
-                   unmarked-lr-item-sets)
-                  (setq
-                   lr-item-set-new-index
-                   (1+ lr-item-set-new-index)))))))
+                    (parser-generator--debug
+                     (message "Set is new"))
+
+                    ;; Note that GOTO(a, X) will always be empty if all items 
in a
+                    ;; have the dot at the right end of the production
+
+                    ;; then add a' to S as an unmarked set of items
+                    (push
+                     `(,symbol ,lr-item-set-new-index)
+                     goto-table-table)
+                    (push
+                     `(,lr-item-set-new-index ,prefix-lr-items)
+                     unmarked-lr-item-sets)
+                    (setq
+                     lr-item-set-new-index
+                     (1+ lr-item-set-new-index))))))))
 
         (setq
          goto-table-table
@@ -284,8 +318,14 @@
          `(,lr-item-set-index ,goto-table-table)
          goto-table)))
 
-    (setq goto-table (sort goto-table 'parser-generator--sort-list))
-    (setq parser-generator-lr--goto-tables (make-hash-table :test 'equal))
+    (setq
+     goto-table
+     (sort
+      goto-table
+      'parser-generator--sort-list))
+    (setq
+     parser-generator-lr--goto-tables
+     (make-hash-table :test 'equal))
     (let ((table-length (length goto-table))
           (table-index 0))
       (while (< table-index table-length)
@@ -598,74 +638,94 @@
              lr-new-item)))))
 
     ;; (c) Repeat step (2b) until no more new items can be added to 
V(X1,...,Xi)
-    (let ((added-new t))
-      (while added-new
-        (setq added-new nil)
-        (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
-                   (cdr lr-item-suffix)))
-
-              ;; (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)))
-                  (unless lr-item-suffix-rest-first
-                    (setq lr-item-suffix-rest-first (list eof-list)))
-
-                  ;; TODO Verify this
-                  (parser-generator--debug
-                   (message
-                    "lr-item-suffix-rest-first: %s"
-                    lr-item-suffix-rest-first))
+    (when lr-new-item
+      (let ((added-new t))
+        (while added-new
+          (setq added-new nil)
+          (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
+                     (cdr lr-item-suffix)))
+
+                ;; (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)))
+                    (unless lr-item-suffix-rest-first
+                      (setq
+                       lr-item-suffix-rest-first
+                       (list eof-list)))
+
+                    ;; When |FIRST| < k add EOF symbols
+                    (when (
+                           <
+                           (length lr-item-suffix-rest-first)
+                           parser-generator--look-ahead-number)
+                      (setq
+                       lr-item-suffix-rest-first
+                       (reverse lr-item-suffix-rest-first))
+                      (while (<
+                              (length lr-item-suffix-rest-first)
+                              parser-generator--look-ahead-number)
+                        (push
+                         parser-generator--eof-identifier
+                         lr-item-suffix-rest-first))
+                      (setq
+                       lr-item-suffix-rest-first
+                       (reverse lr-item-suffix-rest-first)))
+
+                    (parser-generator--debug
+                     (message
+                      "lr-item-suffix-rest-first: %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)))
-                          (unless
-                              (gethash
+                           (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)))
+                            (unless
+                                (gethash
+                                 lr-item-to-add
+                                 lr-item-exists)
+                              (setq added-new t)
+                              (parser-generator--debug
+                               (message
+                                "lr-item-to-add: %s"
+                                lr-item-to-add))
+                              (puthash
                                lr-item-to-add
+                               t
                                lr-item-exists)
-                            (setq added-new t)
-                            (parser-generator--debug
-                             (message
-                              "lr-item-to-add: %s"
-                              lr-item-to-add))
-                            (puthash
-                             lr-item-to-add
-                             t
-                             lr-item-exists)
-                            (push
-                             lr-item-to-add
-                             lr-new-item)))))))))))))
+                              (push
+                               lr-item-to-add
+                               lr-new-item)))))))))))))
+      (setq
+       lr-new-item
+       (sort lr-new-item 'parser-generator--sort-list)))
 
-    (setq
-     lr-new-item
-     (sort lr-new-item 'parser-generator--sort-list))
     lr-new-item))
 
 (defun parser-generator-lr-parse
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 524300d..251b6ff 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -424,9 +424,25 @@
     (should
      (equal
       '(
-        (0 (((R) nil (a b T) ($ $))((R) nil (a b T) (a b))((S) nil (R) ($ 
$))((S) nil (R S) ($ $))((Sp) nil (S) ($ $))))
-        (1 (((R) (a) (b T) ($ $)) ((R) (a) (b T) (a b))))
-        (2 (((R) (a b) (T) ($ $)) ((R) (a b) (T) (a b)) ((T) nil (a T) ($ $)) 
((T) nil (a T) (a b)) ((T) nil (c) ($ $)) ((T) nil (c) (a b)) ((T) nil nil ($ 
$)) ((T) nil nil (a b)))))
+        (0 (
+            ((R) nil (a b T) ($ $))
+            ((R) nil (a b T) (a b))
+            ((S) nil (R) ($ $))
+            ((S) nil (R S) ($ $))
+            ((Sp) nil (S) ($ $)))
+         )
+        (1 (
+            ((R) (a) (b T) ($ $))
+            ((R) (a) (b T) (a b))))
+        (2 (
+            ((R) (a b) (T) ($ $))
+            ((R) (a b) (T) (a b))
+            ((T) nil (a T) ($ $))
+            ((T) nil (a T) (a b))
+            ((T) nil (c) ($ $))
+            ((T) nil (c) (a b))
+            ((T) nil nil ($ $))
+            ((T) nil nil (a b)))))
       (parser-generator--hash-to-list
        lr-items)))
     (message "Passed LR-items k = 2")



reply via email to

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