[elpa] externals/tNFA c9f0989 04/23: Converted transition hash tables to alists

[Stefan Monnier]

branch: externals/tNFA
commit c9f0989d1070bbcaf1553d2ea7cc6d5b95a22f9f
Author: Toby Cubitt <toby-predictive@dr-qubit.org>
Commit: tsc25 <toby-predictive@dr-qubit.org>

    Converted transition hash tables to alists
---
 tNFA.el | 178 ++++++++++++++++++++++++++++++++++------------------------------
 1 file changed, 96 insertions(+), 82 deletions(-)

diff --git a/tNFA.el b/tNFA.el
index de040f0..964a52e 100644
--- a/tNFA.el
+++ b/tNFA.el
@@ -42,11 +42,25 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
-
 (require 'queue)
 (provide 'tNFA)
 
 
+
+;;; ================================================================
+;;;                  Replcements for CL functions
+
+(defun* tNFA--assoc (item alist &key (test 'eq))
+  ;; Return first cons cell in ALIST whose CAR matches ITEM according to :test
+  ;; function (defaulting to `eq')
+  (while (and alist
+             (or (not (consp (car alist)))
+                 (not (funcall test item (caar alist)))))
+    (setq alist (cdr alist)))
+  (car alist))
+
+
+
 ;;; ================================================================
 ;;;                    Data structures
 
@@ -180,6 +194,81 @@
 
 
 ;;; ----------------------------------------------------------------
+;;;                      DFA states
+
+(defstruct
+  (tNFA--DFA-state
+   :named
+   (:constructor nil)
+   (:constructor tNFA--DFA-state--create
+                (list pool
+                 &key
+                 (test 'eq)
+                 &aux
+                 (transitions ())))
+   (:copier nil))
+  list transitions test wildcard match pool)
+
+
+(defun* tNFA--DFA-state-create (state-list state-pool &key (test 'eq))
+  ;; create DFA state and add it to the state pool
+  (let ((DFA-state (tNFA--DFA-state--create
+                   state-list state-pool :test test))
+       tmp-list)
+    (puthash state-list DFA-state (tNFA--DFA-state-pool DFA-state))
+
+    (dolist (state state-list)
+      ;; if state in state list is...
+      (cond
+       ;; literal state: add literal transition
+       ((eq (tNFA--state-type state) 'literal)
+       (setq tmp-list (tNFA--DFA-state-transitions DFA-state))
+       (add-to-list 'tmp-list (cons (tNFA--state-label state) t))
+       (setf (tNFA--DFA-state-transitions DFA-state) tmp-list))
+
+       ;; character alternative: add transitions for all alternatives
+       ((eq (tNFA--state-type state) 'char-alt)
+       (dolist (c (tNFA--state-label state))
+         (setq tmp-list (tNFA--DFA-state-transitions DFA-state))
+         (add-to-list 'tmp-list (cons c t))
+         (setf (tNFA--DFA-state-transitions DFA-state) tmp-list)))
+
+       ;; wildcard or negated character alternative: add wildcard transistion
+       ((or (eq (tNFA--state-type state) 'wildcard)
+           (eq (tNFA--state-type state) 'neg-char-alt))
+       (setf (tNFA--DFA-state-wildcard DFA-state) t))
+
+       ;; match state: set match tags
+       ((eq (tNFA--state-type state) 'match)
+       (setf (tNFA--DFA-state-match DFA-state)
+             (tNFA--state-tags state)))))
+
+    ;; return constructed state
+    DFA-state))
+
+
+(defun* tNFA--DFA-state-create-initial (state-list &key (test 'eq))
+  ;; create initial DFA state from initial tNFA state INITIAL-STATE
+  (tNFA--DFA-state-create state-list
+                         (make-hash-table :test 'equal)
+                         :test test))
+
+
+(defalias 'tNFA-match-p 'tNFA--DFA-state-match
+  "Return non-nil if STATE is a matching state, otherwise return nil.")
+
+
+(defalias 'tNFA-wildcard-p 'tNFA--DFA-state-wildcard
+  "Return non-nil if STATE has a wildcard transition, otherwise return nil.")
+
+
+(defun tNFA-transitions (state)
+  "Return list of literal transitions from tNFA state STATE."
+  (mapcar 'car (tNFA--DFA-state-transitions state)))
+
+
+
+;;; ----------------------------------------------------------------
 ;;;                      tag tables
 
 (defun tNFA-tags-create (num-tags min-tags max-tags)
@@ -248,81 +337,6 @@
 
 
 
-;;; ----------------------------------------------------------------
-;;;                      DFA states
-
-(defstruct
-  (tNFA--DFA-state
-   :named
-   (:constructor nil)
-   (:constructor tNFA--DFA-state--create
-                (list pool
-                 &key
-                 (test 'eq)
-                 &aux
-                 (transitions (make-hash-table :test test))))
-   (:constructor tNFA--DFA-state-create-failed ())
-   (:copier nil))
-  list transitions wildcard match pool)
-
-
-(defun* tNFA--DFA-state-create (state-list state-pool &key (test 'eq))
-  ;; create DFA state and add it to the state pool
-  (let ((DFA-state (tNFA--DFA-state--create
-                   state-list state-pool :test test)))
-    (puthash state-list DFA-state (tNFA--DFA-state-pool DFA-state))
-
-    (dolist (state state-list)
-      ;; if state in state list is...
-      (cond
-       ;; literal state: add literal transition
-       ((eq (tNFA--state-type state) 'literal)
-       (puthash (tNFA--state-label state) t
-                (tNFA--DFA-state-transitions DFA-state)))
-
-       ;; character alternative: add transitions for all alternatives
-       ((eq (tNFA--state-type state) 'char-alt)
-       (dolist (c (tNFA--state-label state))
-         (puthash c t (tNFA--DFA-state-transitions DFA-state))))
-
-       ;; wildcard or negated character alternative: add wildcard transistion
-       ((or (eq (tNFA--state-type state) 'wildcard)
-           (eq (tNFA--state-type state) 'neg-char-alt))
-       (setf (tNFA--DFA-state-wildcard DFA-state) t))
-
-       ;; match state: set match tags
-       ((eq (tNFA--state-type state) 'match)
-       (setf (tNFA--DFA-state-match DFA-state)
-             (tNFA--state-tags state)))))
-
-    ;; return constructed state
-    DFA-state))
-
-
-(defun* tNFA--DFA-state-create-initial (state-list &key (test 'eq))
-  ;; create initial DFA state from initial tNFA state INITIAL-STATE
-  (tNFA--DFA-state-create state-list
-                         (make-hash-table :test 'equal)
-                         :test test))
-
-
-(defalias 'tNFA-match-p 'tNFA--DFA-state-match
-  "Return non-nil if STATE is a matching state, otherwise return nil.")
-
-
-(defalias 'tNFA-wildcard-p 'tNFA--DFA-state-wildcard
-  "Return non-nil if STATE has a wildcard transition, otherwise return nil.")
-
-
-(defun tNFA-transitions (state)
-  "Return list of literal transitions from tNFA state STATE."
-  (let (transitions)
-    (maphash (lambda (chr ignored) (push chr transitions))
-            (tNFA--DFA-state-transitions state))
-    transitions))
-
-
-
 
 ;;; ================================================================
 ;;;                        Regexp -> tNFA
@@ -644,14 +658,15 @@ individual elements of STRING are identical. The default 
is `eq'."
 (defun tNFA-next-state (tNFA chr pos)
   "Evolve tNFA according to CHR, which corresponds to position
 POS in a string."
-  (let (state)
+  (let (elem state)
     ;; if there is a transition for character CHR...
     (cond
-     ((setq state (gethash chr (tNFA--DFA-state-transitions tNFA)))
+     ((setq elem (tNFA--assoc chr (tNFA--DFA-state-transitions tNFA)
+                              :test (tNFA--DFA-state-test tNFA)))
       ;; if next state has not already been computed, do so
-      (unless (tNFA--DFA-state-p state)
+      (unless (tNFA--DFA-state-p (setq state (cdr elem)))
        (setq state (tNFA--DFA-next-state tNFA chr pos nil))
-       (puthash chr state (tNFA--DFA-state-transitions tNFA))))
+       (setcdr elem state)))
 
      ;; if there's a wildcard transition...
      ((setq state (tNFA--DFA-state-wildcard tNFA))
@@ -696,8 +711,7 @@ POS in a string."
                (tNFA--DFA-state-create
                 state-list
                 (tNFA--DFA-state-pool DFA-state)
-                :test
-                (hash-table-test (tNFA--DFA-state-transitions DFA-state)))))
+                :test (tNFA--DFA-state-test DFA-state))))
       ;; return next state
       state)))