[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/trie 14fa4ee 075/111: Code cleanup.
From: |
Stefan Monnier |
Subject: |
[elpa] externals/trie 14fa4ee 075/111: Code cleanup. |
Date: |
Mon, 14 Dec 2020 11:35:24 -0500 (EST) |
branch: externals/trie
commit 14fa4ee3a03d4e5a0890ce9b9b7c130d229b5c73
Author: Toby S. Cubitt <toby-predictive@dr-qubit.org>
Commit: Toby S. Cubitt <toby-predictive@dr-qubit.org>
Code cleanup.
Changed many macros to defsubsts. Avoided quoted lambdas wherever
possible. Added cleaner lexical binding versions of some functions. Fixed
mistakes in docstrings and comments. Updated Commentary.
---
trie.el | 361 ++++++++++++++++++++++++++++++++++++----------------------------
1 file changed, 201 insertions(+), 160 deletions(-)
diff --git a/trie.el b/trie.el
index 038e68b..84eb5b6 100644
--- a/trie.el
+++ b/trie.el
@@ -295,16 +295,16 @@
(defsetf trie--node-data (node) (data)
`(setf (trie--node-subtree ,node) ,data))
-(defmacro trie--node-data-p (node)
+(defsubst trie--node-data-p (node)
;; Return t if NODE is a data node, nil otherwise.
- `(eq (trie--node-split ,node) trie--terminator))
+ (eq (trie--node-split node) trie--terminator))
-(defmacro trie--node-p (node)
+(defsubst trie--node-p (node)
;; Return t if NODE is a TRIE trie--node, nil otherwise. Have to
;; define this ourselves, because we created a defstruct without any
;; identifying tags (i.e. (:type vector)) for efficiency, but this
;; means we can only perform a rudimentary and very unreliable test.
- `(and (vectorp ,node) (= (length ,node) 2)))
+ (and (vectorp node) (= (length node) 2)))
(defun trie--node-find (node seq lookupfun)
@@ -322,20 +322,20 @@
node))
-(defmacro trie--find-data-node (node lookupfun)
+(defsubst trie--find-data-node (node lookupfun)
;; Return data node from NODE's subtree, or nil if NODE has no data
;; node in its subtree.
- `(funcall ,lookupfun
- (trie--node-subtree ,node)
- (trie--node-create-dummy trie--terminator)
- nil))
+ (funcall lookupfun
+ (trie--node-subtree node)
+ (trie--node-create-dummy trie--terminator)
+ nil))
-(defmacro trie--find-data (node lookupfun)
+(defsubst trie--find-data (node lookupfun)
;; Return data associated with sequence corresponding to NODE, or nil
;; if sequence has no associated data.
- `(let ((node (trie--find-data-node ,node ,lookupfun)))
- (when node (trie--node-data node))))
+ (let ((node (trie--find-data-node node lookupfun)))
+ (when node (trie--node-data node))))
@@ -360,12 +360,12 @@
(setf (trie--print-form trie) nil))))
-(defmacro trie-transform-from-read-warn (trie)
+(defsubst trie-transform-from-read-warn (trie)
"Transform TRIE from print form, with warning."
- `(when (trie--print-form ,trie)
- (warn (concat "Attempt to operate on trie in print-form;\
+ (when (trie--print-form trie)
+ (warn (concat "Attempt to operate on trie in print-form;\
converting to normal form"))
- (trie-transform-from-read ,trie)))
+ (trie-transform-from-read trie)))
(defun trie--avl-transform-for-print (trie)
@@ -599,29 +599,51 @@ functions must *never* bind any variables with names
commencing
(trie--node-subtree (trie--root trie))))
-(defun trie-construct-sortfun (cmpfun &optional reverse)
- "Construct function to compare key sequences, based on a CMPFUN
+(if (trie-lexical-binding-p)
+ (defun trie-construct-sortfun (cmpfun &optional reverse)
+ "Construct function to compare key sequences, based on a CMPFUN
that compares individual elements of the sequence. Order is
reversed if REVERSE is non-nil."
- (if reverse
- `(lambda (a b)
- (let (cmp)
+ (if reverse
+ (lambda (a b)
+ (catch 'compared
+ (dotimes (i (min (length a) (length b)))
+ (cond ((funcall cmpfun (elt b i) (elt a i))
+ (throw 'compared t))
+ ((funcall cmpfun (elt a i) (elt b i))
+ (throw 'compared nil))))
+ (< (length a) (length b))))
+ (lambda (a b)
+ (catch 'compared
+ (dotimes (i (min (length a) (length b)))
+ (cond ((funcall cmpfun (elt a i) (elt b i))
+ (throw 'compared t))
+ ((funcall cmpfun (elt b i) (elt a i))
+ (throw 'compared nil))))
+ (< (length a) (length b))))))
+
+ (defun trie-construct-sortfun (cmpfun &optional reverse)
+ "Construct function to compare key sequences, based on a CMPFUN
+that compares individual elements of the sequence. Order is
+reversed if REVERSE is non-nil."
+ (if reverse
+ `(lambda (a b)
(catch 'compared
(dotimes (i (min (length a) (length b)))
(cond ((,cmpfun (elt b i) (elt a i))
(throw 'compared t))
((,cmpfun (elt a i) (elt b i))
(throw 'compared nil))))
- (< (length a) (length b)))))
- `(lambda (a b)
- (let (cmp)
+ (< (length a) (length b))))
+ `(lambda (a b)
(catch 'compared
(dotimes (i (min (length a) (length b)))
(cond ((,cmpfun (elt a i) (elt b i))
(throw 'compared t))
((,cmpfun (elt b i) (elt a i))
(throw 'compared nil))))
- (< (length a) (length b)))))))
+ (< (length a) (length b))))))
+)
@@ -1208,98 +1230,100 @@ element stored in the trie.)"
;; haven't done any benchmarking, though, so feel free to do so and let
;; me know the results!)
-(defmacro trie--construct-accumulator (maxnum filter resultfun)
+(defsubst trie--construct-accumulator (maxnum filter resultfun)
;; Does what it says on the tin! | sed -e 's/tin/macro name/'
- `(cond
- ;; filter, maxnum, resultfun
- ((and ,filter ,maxnum ,resultfun)
- (lambda (seq data)
- (when (funcall ,filter seq data)
- (aset trie--accumulate 0
- (cons (funcall ,resultfun seq data)
- (aref trie--accumulate 0)))
- (and (>= (length (aref trie--accumulate 0)) ,maxnum)
- (throw 'trie-accumulate--done nil)))))
- ;; filter, maxnum, !resultfun
- ((and ,filter ,maxnum (not ,resultfun))
- (lambda (seq data)
- (when (funcall ,filter seq data)
- (aset trie--accumulate 0
- (cons (cons seq data)
- (aref trie--accumulate 0)))
- (and (>= (length (aref trie--accumulate 0)) ,maxnum)
- (throw 'trie-accumulate--done nil)))))
- ;; filter, !maxnum, resultfun
- ((and ,filter (not ,maxnum) ,resultfun)
- (lambda (seq data)
- (when (funcall ,filter seq data)
- (aset trie--accumulate 0
- (cons (funcall ,resultfun seq data)
- (aref trie--accumulate 0))))))
- ;; filter, !maxnum, !resultfun
- ((and ,filter (not ,maxnum) (not ,resultfun))
- (lambda (seq data)
- (when (funcall ,filter seq data)
- (aset trie--accumulate 0
- (cons (cons seq data)
- (aref trie--accumulate 0))))))
- ;; !filter, maxnum, resultfun
- ((and (not ,filter) ,maxnum ,resultfun)
- (lambda (seq data)
- (aset trie--accumulate 0
- (cons (funcall ,resultfun seq data)
- (aref trie--accumulate 0)))
- (and (>= (length (aref trie--accumulate 0)) ,maxnum)
- (throw 'trie-accumulate--done nil))))
- ;; !filter, maxnum, !resultfun
- ((and (not ,filter) ,maxnum (not ,resultfun))
- (lambda (seq data)
- (aset trie--accumulate 0
- (cons (cons seq data)
- (aref trie--accumulate 0)))
- (and (>= (length (aref trie--accumulate 0)) ,maxnum)
- (throw 'trie-accumulate--done nil))))
- ;; !filter, !maxnum, resultfun
- ((and (not ,filter) (not ,maxnum) ,resultfun)
- (lambda (seq data)
- (aset trie--accumulate 0
- (cons (funcall ,resultfun seq data)
- (aref trie--accumulate 0)))))
- ;; !filter, !maxnum, !resultfun
- ((and (not ,filter) (not ,maxnum) (not ,resultfun))
- (lambda (seq data)
- (aset trie--accumulate 0
- (cons (cons seq data)
- (aref trie--accumulate 0)))))
- ))
+ (declare (special trie--accumulate))
+ (cond
+ ;; filter, maxnum, resultfun
+ ((and filter maxnum resultfun)
+ (lambda (seq data)
+ (when (funcall filter seq data)
+ (aset trie--accumulate 0
+ (cons (funcall resultfun seq data)
+ (aref trie--accumulate 0)))
+ (and (>= (length (aref trie--accumulate 0)) maxnum)
+ (throw 'trie-accumulate--done nil)))))
+ ;; filter, maxnum, !resultfun
+ ((and filter maxnum (not resultfun))
+ (lambda (seq data)
+ (when (funcall filter seq data)
+ (aset trie--accumulate 0
+ (cons (cons seq data)
+ (aref trie--accumulate 0)))
+ (and (>= (length (aref trie--accumulate 0)) maxnum)
+ (throw 'trie-accumulate--done nil)))))
+ ;; filter, !maxnum, resultfun
+ ((and filter (not maxnum) resultfun)
+ (lambda (seq data)
+ (when (funcall filter seq data)
+ (aset trie--accumulate 0
+ (cons (funcall resultfun seq data)
+ (aref trie--accumulate 0))))))
+ ;; filter, !maxnum, !resultfun
+ ((and filter (not maxnum) (not resultfun))
+ (lambda (seq data)
+ (when (funcall filter seq data)
+ (aset trie--accumulate 0
+ (cons (cons seq data)
+ (aref trie--accumulate 0))))))
+ ;; !filter, maxnum, resultfun
+ ((and (not filter) maxnum resultfun)
+ (lambda (seq data)
+ (aset trie--accumulate 0
+ (cons (funcall resultfun seq data)
+ (aref trie--accumulate 0)))
+ (and (>= (length (aref trie--accumulate 0)) maxnum)
+ (throw 'trie-accumulate--done nil))))
+ ;; !filter, maxnum, !resultfun
+ ((and (not filter) maxnum (not resultfun))
+ (lambda (seq data)
+ (aset trie--accumulate 0
+ (cons (cons seq data)
+ (aref trie--accumulate 0)))
+ (and (>= (length (aref trie--accumulate 0)) maxnum)
+ (throw 'trie-accumulate--done nil))))
+ ;; !filter, !maxnum, resultfun
+ ((and (not filter) (not maxnum) resultfun)
+ (lambda (seq data)
+ (aset trie--accumulate 0
+ (cons (funcall resultfun seq data)
+ (aref trie--accumulate 0)))))
+ ;; !filter, !maxnum, !resultfun
+ ((and (not filter) (not maxnum) (not resultfun))
+ (lambda (seq data)
+ (aset trie--accumulate 0
+ (cons (cons seq data)
+ (aref trie--accumulate 0)))))
+ ))
-(defmacro trie--construct-ranked-accumulator (maxnum filter)
+(defsubst trie--construct-ranked-accumulator (maxnum filter)
;; Does what it says on the tin! | sed -e 's/tin/macro name/'
- `(cond
- ;; filter, maxnum
- ((and ,filter ,maxnum)
- (lambda (seq data)
- (when (funcall ,filter seq data)
- (heap-add trie--accumulate (cons seq data))
- (and (> (heap-size trie--accumulate) ,maxnum)
- (heap-delete-root trie--accumulate)))))
- ;; filter, !maxnum
- ((and ,filter (not ,maxnum))
- (lambda (seq data)
- (when (funcall ,filter seq data)
- (heap-add trie--accumulate (cons seq data)))))
- ;; !filter, maxnum
- ((and (not ,filter) ,maxnum)
- (lambda (seq data)
- (heap-add trie--accumulate (cons seq data))
- (and (> (heap-size trie--accumulate) ,maxnum)
- (heap-delete-root trie--accumulate))))
- ;; !filter, !maxnum
- ((and (not ,filter) (not ,maxnum))
- (lambda (seq data)
- (heap-add trie--accumulate (cons seq data))))))
+ (declare (special trie--accumulate))
+ (cond
+ ;; filter, maxnum
+ ((and filter maxnum)
+ (lambda (seq data)
+ (when (funcall filter seq data)
+ (heap-add trie--accumulate (cons seq data))
+ (and (> (heap-size trie--accumulate) maxnum)
+ (heap-delete-root trie--accumulate)))))
+ ;; filter, !maxnum
+ ((and filter (not maxnum))
+ (lambda (seq data)
+ (when (funcall filter seq data)
+ (heap-add trie--accumulate (cons seq data)))))
+ ;; !filter, maxnum
+ ((and (not filter) maxnum)
+ (lambda (seq data)
+ (heap-add trie--accumulate (cons seq data))
+ (and (> (heap-size trie--accumulate) maxnum)
+ (heap-delete-root trie--accumulate))))
+ ;; !filter, !maxnum
+ ((and (not filter) (not maxnum))
+ (lambda (seq data)
+ (heap-add trie--accumulate (cons seq data))))))
@@ -1316,6 +1340,8 @@ element stored in the trie.)"
;; the query function.
;; rename functions to help avoid dynamic-scoping bugs
+ ;; FIXME: not needed with lexical scoping
+ (declare (special trie--accumulate))
`(let* ((--trie-accumulate--rankfun ,rankfun)
(--trie-accumulate--filter ,filter)
(--trie-accumulate--resultfun ,resultfun)
@@ -1330,7 +1356,7 @@ element stored in the trie.)"
(not (funcall --trie-accumulate--rankfun a b))))
(when ,maxnum (1+ ,maxnum)))
(make-vector 1 nil)))
- ;; construct function to accumulate completions
+ ;; construct function to accumulate results
(,accfun
(if ,rankfun
(trie--construct-ranked-accumulator
@@ -1342,28 +1368,28 @@ element stored in the trie.)"
;; accumulate results
(catch 'trie-accumulate--done ,@body)
- ;; return list of completions
+ ;; return list of results
(cond
- ;; for a ranked query, extract completions from heap
+ ;; for a ranked query, extract results from heap
(,rankfun
- (let (completions)
+ (let (results)
;; check for and delete duplicates if flag is set
(if ,duplicates
(while (not (heap-empty trie--accumulate))
(if (equal (car (heap-root trie--accumulate))
- (caar completions))
+ (caar results))
(heap-delete-root trie--accumulate)
(push (heap-delete-root trie--accumulate)
- completions)))
+ results)))
;; skip duplicate checking if flag is not set
(while (not (heap-empty trie--accumulate))
(if ,resultfun
(let ((res (heap-delete-root trie--accumulate)))
(push (funcall ,resultfun (car res) (cdr res))
- completions))
+ results))
(push (heap-delete-root trie--accumulate)
- completions))))
- completions))
+ results))))
+ results))
;; for lexical query, reverse result list if MAXNUM supplied
(,maxnum (nreverse (aref trie--accumulate 0)))
@@ -1527,8 +1553,8 @@ it is better to use one of those instead."
along with their associated data, in the order defined by
RANKFUN, defauling to \"lexical\" order (i.e. the order defined
by the trie's comparison function). If REVERSE is non-nil, the
-completions are sorted in the reverse order. Returns nil if no
-completions are found.
+results are sorted in the reverse order. Returns nil if no
+results are found.
REGEXP is a regular expression, but it need not necessarily be a
string. It must be a sequence (vector, list, or string) whose
@@ -1580,32 +1606,35 @@ default key-data cons cell."
;; convert trie from print-form if necessary
(trie-transform-from-read-warn trie)
- ;; massage rankfun to cope with grouping data
- ;; FIXME: could skip this if REGEXP contains no grouping constructs
- (when rankfun
- (setq rankfun
- `(lambda (a b)
- ;; if car of argument contains a key+group list rather than
- ;; a straight key, remove group list
- ;; FIXME: the test for straight key, below, will fail if
- ;; the key is a list, and the first element of the
- ;; key is itself a list (there might be no easy way
- ;; to fully fix this...)
- (unless (or (atom (car a))
- (and (listp (car a))
- (not (sequencep (caar a)))))
- (setq a (cons (caar a) (cdr a))))
- (unless (or (atom (car b))
- (and (listp (car b))
- (not (sequencep (caar b)))))
- (setq b (cons (caar b) (cdr b))))
- ;; call rankfun on massaged arguments
- (,rankfun a b))))
-
- ;; accumulate completions
+ ;; rename function to mitigate against dynamic scoping bugs
+ ;; FIXME: not needed with lexical scoping
+ (let ((--trie-regexp-search--rankfun rankfun))
+ ;; massage rankfun to cope with grouping data
+ ;; FIXME: could skip this if REGEXP contains no grouping constructs
+ (when --trie-regexp-search--rankfun
+ (setq --trie-regexp-search--rankfun
+ (lambda (a b)
+ ;; if car of argument contains a key+group list rather than
+ ;; a straight key, remove group list
+ ;; FIXME: the test for straight key, below, will fail if
+ ;; the key is a list, and the first element of the
+ ;; key is itself a list (there might be no easy way
+ ;; to fully fix this...)
+ (unless (or (atom (car a))
+ (and (listp (car a))
+ (not (sequencep (caar a)))))
+ (setq a (cons (caar a) (cdr a))))
+ (unless (or (atom (car b))
+ (and (listp (car b))
+ (not (sequencep (caar b)))))
+ (setq b (cons (caar b) (cdr b))))
+ ;; call rankfun on massaged arguments
+ (funcall --trie-regexp-search--rankfun a b))))
+
+ ;; accumulate results
(declare (special accumulator))
(trie--accumulate-results
- rankfun maxnum reverse filter resultfun accumulator nil
+ --trie-regexp-search--rankfun maxnum reverse filter resultfun accumulator
nil
(trie--do-regexp-search
(trie--root trie)
(tNFA-from-regexp regexp :test (trie--construct-equality-function
@@ -1614,7 +1643,7 @@ default key-data cons cell."
(or (and maxnum reverse) (and (not maxnum) (not reverse)))
(trie--comparison-function trie)
(trie--lookupfun trie)
- (trie--mapfun trie))))
+ (trie--mapfun trie)))))
@@ -1670,10 +1699,16 @@ default key-data cons cell."
reverse)))
(t ;; no wildcard transition: loop over all transitions
- (let (node state)
+ ;; rename function to mitigate against dynamic scoping bugs
+ ;; FIXME: not needed with lexical scoping
+ (let ((--trie--do-regexp-search--cmpfun comparison-function)
+ node state)
(dolist (chr (sort (tNFA-transitions tNFA)
(if reverse
- `(lambda (a b) (,comparison-function b a))
+ (lambda (a b)
+ (funcall
+ --trie--do-regexp-search--cmpfun
+ b a))
comparison-function)))
(when (and (setq node (trie--node-find
--trie--regexp-search--node
@@ -1795,16 +1830,22 @@ elements that matched the corresponding groups, in
order."
store))
(t ;; non-wildcard transition: add all possible next nodes
- (dolist (chr (sort (tNFA-transitions state)
- (if reverse
- comparison-function
- `(lambda (a b)
- (,comparison-function b a)))))
- (when (and (setq n (trie--node-find
- node (vector chr) lookupfun))
- (setq s (tNFA-next-state state chr pos)))
- (push (list (trie--seq-append seq chr) n s (1+ pos))
- store)))
+ ;; rename function to mitigate against lexical scoping bugs
+ ;; FIXME: not needed with lexical scoping
+ (let ((--trie--regexp-stack-repopulate--cmpfun
+ comparison-function))
+ (dolist (chr (sort (tNFA-transitions state)
+ (if reverse
+ --trie--regexp-stack-repopulate--cmpfun
+ (lambda (a b)
+ (funcall
+ --trie--regexp-stack-repopulate--cmpfun
+ b a)))))
+ (when (and (setq n (trie--node-find
+ node (vector chr) lookupfun))
+ (setq s (tNFA-next-state state chr pos)))
+ (push (list (trie--seq-append seq chr) n s (1+ pos))
+ store))))
t))) ; return t to keep looping
;; otherwise, stack element is a node stack...
- [elpa] externals/trie 4f11b37 022/111: Docstring, change log, and version number updates, (continued)
- [elpa] externals/trie 4f11b37 022/111: Docstring, change log, and version number updates, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 510844e 035/111: trivial variable name change, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 4b24754 008/111: Converted function wrapping macros into functions, Stefan Monnier, 2020/12/14
- [elpa] externals/trie a17e6df 056/111: Minor bug-fixes to [trie/dict-tree]--edebug-pretty-print, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 3b61c64 065/111: More minor whitespace and commentary changes., Stefan Monnier, 2020/12/14
- [elpa] externals/trie 19e6dbe 010/111: Make weird variable names used to avoid dynamic scoping bugs more consistent, Stefan Monnier, 2020/12/14
- [elpa] externals/trie ae8bf27 036/111: minor code tidying, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 0c21bf4 073/111: Add note to self to use cust-print pretty-printing instead of advice., Stefan Monnier, 2020/12/14
- [elpa] externals/trie 490c011 025/111: Bug fixes to trie--wildcard-stack-repopulate, Stefan Monnier, 2020/12/14
- [elpa] externals/trie f398b8e 063/111: Updated copyright attribution and license (GPL2 -> GPL3)., Stefan Monnier, 2020/12/14
- [elpa] externals/trie 14fa4ee 075/111: Code cleanup.,
Stefan Monnier <=
- [elpa] externals/trie 1e246d0 009/111: Bug-fix to remove setf inside backquote construct from trie-insert, Stefan Monnier, 2020/12/14
- [elpa] externals/trie ecf872e 061/111: Updated Package-Version, Package-Requires, and Keywords package headers., Stefan Monnier, 2020/12/14
- [elpa] externals/trie d746b4d 017/111: Added safeguards to throw errors if stack operations attempted, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 304b8e9 059/111: Added fboundp guard around ad-define-subr-args (removed in Emacs-24)., Stefan Monnier, 2020/12/14
- [elpa] externals/trie 0ecad1b 016/111: Fixed avl type trie--createfun to accept (and ignore) extra seq argument, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 1b3b473 031/111: Another bug-fix in trie--do-wildcard-search, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 333151b 045/111: Bug-fix in trie--do-regexp-search relating to accumulation of results, Stefan Monnier, 2020/12/14
- [elpa] externals/trie cc94506 070/111: Enable lexical binding, and fix issues it picks up., Stefan Monnier, 2020/12/14
- [elpa] externals/trie 6a449ed 049/111: Improved edebug-prin1 advice, Stefan Monnier, 2020/12/14
- [elpa] externals/trie 7bf9008 100/111: Implement fuzzy-completion with fixed initial prefix segment., Stefan Monnier, 2020/12/14