[elpa] externals/parser-generator fe94691 048/434: Added hash-table for production RHS

[ELPA Syncer]

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

    Added hash-table for production RHS
---
 parser.el | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 75 insertions(+), 10 deletions(-)

diff --git a/parser.el b/parser.el
index 21af745..8e9c978 100644
--- a/parser.el
+++ b/parser.el
@@ -14,14 +14,18 @@
   nil
   "Whether to print debug messages or not.")
 
-(defvar parser--table-terminal-p
-  nil
-  "Hash-table of non-terminals for quick checking.")
-
 (defvar parser--table-non-terminal-p
   nil
   "Hash-table of terminals for quick checking.")
 
+(defvar parser--table-productions
+  nil
+  "Hash-table of productions for quick retrieving.")
+
+(defvar parser--table-terminal-p
+  nil
+  "Hash-table of non-terminals for quick checking.")
+
 (defvar parser--grammar
   nil
   "Current grammar used in parser.")
@@ -47,6 +51,10 @@
 ;; Helper Functions
 
 
+(defun parser--clear-cache ()
+  "Clear cache."
+  (setq parser--f-sets nil))
+
 (defun parser--distinct (elements)
   "Return distinct of ELEMENTS."
   (let ((processed (make-hash-table :test 'equal))
@@ -65,6 +73,10 @@
       (error "No grammar G defined!")))
   (nth 0 G))
 
+(defun parser--get-grammar-rhs (lhs)
+  "Return right hand sides of LHS if there is any."
+  (gethash lhs parser--table-productions))
+
 (defun parser--get-grammar-productions (&optional G)
   "Return productions of grammar G."
   (unless G
@@ -98,21 +110,32 @@
   (let ((non-terminals (parser--get-grammar-non-terminals)))
     (setq parser--table-non-terminal-p (make-hash-table :test 'equal))
     (dolist (non-terminal non-terminals)
-      (puthash non-terminal t parser--table-non-terminal-p))))
+      (puthash non-terminal t parser--table-non-terminal-p)))
+  (let ((productions (parser--get-grammar-productions)))
+    (setq parser--table-productions (make-hash-table :test 'equal))
+    (dolist (p productions)
+      (let ((lhs (car p))
+            (rhs (cdr p)))
+        (dolist (rhs-element rhs)
+          (unless (listp rhs-element)
+            (setq rhs-element (list rhs-element)))
+          (let ((new-value (gethash lhs parser--table-productions)))
+            (setq new-value (append new-value rhs))
+            (puthash lhs new-value parser--table-productions)))))))
 
 (defun parser--set-look-ahead-number (k)
   "Set look-ahead number K."
   (unless (parser--valid-look-ahead-number-p k)
     (error "Invalid look-ahead number k!"))
   (setq parser--look-ahead-number k)
-  (setq parser--f-sets nil))
+  (parser--clear-cache))
 
 (defun parser--set-grammar (G)
   "Set grammar G.."
   (unless (parser--valid-grammar-p G)
     (error "Invalid grammar G!"))
   (setq parser--grammar G)
-  (setq parser--f-sets nil)
+  (parser--clear-cache)
   (parser--load-symbols))
 
 (defun parser--sort-list (a b)
@@ -622,7 +645,8 @@
       (setq γ (list γ)))
     (unless (parser--valid-sentential-form-p γ)
       (error "Invalid sentential form γ!"))
-    (let ((prefix-length (length γ)))
+    (let ((prefix-length (length γ))
+          (lr-item-exists (make-hash-table :test 'equal)))
 
       ;; 1
 
@@ -642,10 +666,51 @@
                     (setq rhs (list rhs)))
 
                   ;; Add [S -> . α] to V(e)
-                  (push `(,production-lhs ,nil ,rhs) lr-items-e))))))
+                  (push `(,production-lhs nil ,rhs e) lr-items-e)
+                  (puthash `(e ,production-lhs nil ,rhs e) t 
lr-item-exists))))))
 
         ;; b, c
-        ;; TODO 1.b. iterate every item in v-set(e), if [A -> . Bα, u] is an 
item and B -> β is in P, then foreach x in FIRST(αu) add [B -> . β, x] to 
v-set(e), provided it is not already there
+        ;; 1.b. iterate every item in v-set(e), if [A -> . Bα, u] is an item 
and B -> β is in P
+        ;; then foreach x in FIRST(αu) add [B -> . β, x] to v-set(e), provided 
it is not already there
+        (let ((found-new t))
+
+          ;; Repeat this until no new item is found
+          (while found-new
+            (setq found-new nil)
+
+            ;; Iterate every item in V(e)
+            (dolist (item lr-items-e)
+              (let ((lhs (nth 0 item))
+                    (prefix (nth 1 item))
+                    (rhs (nth 2 item))
+                    (suffix (nth 3 item)))
+
+                ;; Without prefix
+                (unless prefix
+
+                  ;; Check if RHS starts with a non-terminal
+                  (let ((rhs-first (car rhs)))
+                    (when (parser--valid-terminal-p rhs-first)
+                      (let ((rhs-rest (append (cdr rhs) suffix)))
+                        (let ((rhs-first (parser--first rhs-rest)))
+                          (message "FIRST(%s) = %s" rhs-rest rhs-first)
+
+                          ;; For each production with B as LHS
+                          (dolist (p productions)
+                            (let ((sub-lhs (car p)))
+                              (when (eq sub-lhs lhs)
+                                (let ((sub-rhs (cdr p)))
+                                  (unless (listp sub-rhs)
+                                    (setq sub-rhs (list sub-rhs)))
+
+                                  ;; For each x in FIRST(αu) add [B -> . β, x] 
to v-set(e)
+                                  (dolist (f rhs-first)
+                                    ;; Provided it is not already there
+                                    (unless (gethash `(e ,lhs nil ,sub-rhs ,f) 
lr-item-exists)
+                                      (push `(,lhs nil ,sub-rhs ,f) lr-items-e)
+                                      (setq found-new t))))))))))))))))
+
+
         ;; TODO 1.c. repeat b until no more items can be added to v-set(e)
         (puthash 'e lr-items-e lr-items))