[elpa] externals/trie a438b01 090/111: Fix bugs in lexical binding support(?)

[Stefan Monnier]

branch: externals/trie
commit a438b01d2dcb9e7c871c69255ff8d6e36a0c3e57
Author: Toby S. Cubitt <toby-predictive@dr-qubit.org>
Commit: Toby S. Cubitt <toby-predictive@dr-qubit.org>

    Fix bugs in lexical binding support(?)
    
    (declare (special var)) is not documented in the Elisp manual, so seems to 
be
    a no-op. Some code appeard to rely on this form making var dynamically 
scoped.
---
 trie.el | 280 +++++++++++++++++++++++++++++++---------------------------------
 1 file changed, 137 insertions(+), 143 deletions(-)

diff --git a/trie.el b/trie.el
index 33bd60a..abdea89 100644
--- a/trie.el
+++ b/trie.el
@@ -1,6 +1,6 @@
 ;;; trie.el --- Trie data structure  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2008-2015, 2017  Free Software Foundation, Inc
+;; Copyright (C) 2008-2010, 2012, 2014, 2017  Free Software Foundation, Inc
 
 ;; Author: Toby Cubitt <toby-predictive@dr-qubit.org>
 ;; Version: 0.4
@@ -745,68 +745,36 @@ bind any variables with names commencing \"--\"."
 ;; ----------------------------------------------------------------
 ;;                        Deleting data
 
-(defun trie-delete (trie key &optional test)
-  "Delete KEY and its associated data from TRIE.
-
-If KEY was deleted, a cons cell containing KEY and its
-association is returned. Returns nil if KEY does not exist in
-TRIE.
-
-If TEST is supplied, it should be a function that accepts two
-arguments: the key being deleted, and its associated data. The
-key will then only be deleted if TEST returns non-nil.
-
-Note: to avoid nasty dynamic scoping bugs, TEST must *not* bind
-any variables with names commencing \"--\"."
-  ;; convert trie from print-form if necessary
-  (trie-transform-from-read-warn trie)
-  ;; set up deletion (real work is done by `trie--do-delete'
-  (let (--trie-deleted--node
-       (--trie-delete--key key))
-    (declare (special --trie-deleted--node)
-            (special --trie-delete--key))
-    (trie--do-delete (trie--root trie) key test
-                    (trie--deletefun trie)
-                    (trie--emptyfun trie)
-                    (trie--cmpfun trie))
-    (when --trie-deleted--node
-      (cons key (trie--node-data --trie-deleted--node)))))
-
-
+;; The absurd argument names are to lessen the likelihood of dynamical scoping
+;; bugs caused by a supplied function binding a variable with the same name as
+;; one of the arguments, which would cause a nasty bug when the lambda's
+;; (below) are called.
+'; FIXME: not needed with lexical binding
 (defun trie--do-delete (node --trie--do-delete--seq
                             --trie--do-delete--test
                             --trie--do-delete--deletefun
                             --trie--do-delete--emptyfun
-                            --trie--do-delete--cmpfun)
+                            --trie--do-delete--cmpfun
+                            --trie--do-delete--key)
   ;; Delete --TRIE--DO-DELETE--SEQ starting from trie node NODE, and
   ;; return non-nil if we deleted a node. If --TRIE--DO-DELETE--TEST is
   ;; supplied, it is called with two arguments, the key being deleted
   ;; and the associated data, and the deletion is only carried out if it
   ;; returns non-nil.
 
-  ;; The absurd argument names are to lessen the likelihood of dynamical
-  ;; scoping bugs caused by a supplied function binding a variable with
-  ;; the same name as one of the arguments, which would cause a nasty
-  ;; bug when the lambda's (below) are called.
-  (declare (special --trie-deleted--node)
-          (special --trie-delete--key))
   ;; if --TRIE--DO-DELETE--SEQ is empty, try to delete data node and
-  ;; return non-nil if we did (return value of
-  ;; --TRIE--DO-DELETE--DELETEFUN is the deleted data, which is always
-  ;; non-nil for a trie)
+  ;; return non-nil if we did (return value of a trie's deletefun is the
+  ;; deleted data, which is always non-nil for a trie)
   (if (= (length --trie--do-delete--seq) 0)
-      (setq --trie-deleted--node
-           (funcall --trie--do-delete--deletefun
-                    (trie--node-subtree node)
-                    (trie--node-create-dummy trie--terminator)
-                    (when --trie--do-delete--test
-                      (lambda (n)
-                        (funcall --trie--do-delete--test
-                                 --trie-delete--key (trie--node-data n))))
-                    nil))
-    ;; otherwise, delete on down (return value of
-    ;; --TRIE--DO-DELETE--DELETEFUN is the deleted data, which is always
-    ;; non-nil for a trie)
+      (funcall --trie--do-delete--deletefun
+              (trie--node-subtree node)
+              (trie--node-create-dummy trie--terminator)
+              (when --trie--do-delete--test
+                (lambda (n)
+                  (funcall --trie--do-delete--test
+                           --trie-delete--key (trie--node-data n)))))
+    ;; otherwise, delete on down (return value of trie's deletion function is
+    ;; the deleted data, which is always non-nil for a trie)
     (funcall --trie--do-delete--deletefun
             (trie--node-subtree node)
             (trie--node-create-dummy (elt --trie--do-delete--seq 0))
@@ -816,10 +784,35 @@ any variables with names commencing \"--\"."
                     --trie--do-delete--test
                     --trie--do-delete--deletefun
                     --trie--do-delete--emptyfun
-                    --trie--do-delete--cmpfun)
+                    --trie--do-delete--cmpfun
+                    --trie--do-delete--key)
                    (funcall --trie--do-delete--emptyfun
-                            (trie--node-subtree n))))
-            nil)))
+                            (trie--node-subtree n)))))))
+
+
+(defun trie-delete (trie key &optional test)
+  "Delete KEY and its associated data from TRIE.
+
+If KEY was deleted, a cons cell containing KEY and its
+association is returned. Returns nil if KEY does not exist in
+TRIE.
+
+If TEST is supplied, it should be a function that accepts two
+arguments: the key being deleted, and its associated data. The
+key will then only be deleted if TEST returns non-nil.
+
+Note: to avoid nasty dynamic scoping bugs, TEST must *not* bind
+any variables with names commencing \"--\"."
+  ;; convert trie from print-form if necessary
+  (trie-transform-from-read-warn trie)
+  ;; set up deletion (real work is done by `trie--do-delete'
+  (let ((deleted-node
+        (trie--do-delete (trie--root trie) key test
+                         (trie--deletefun trie)
+                         (trie--emptyfun trie)
+                         (trie--cmpfun trie)
+                         key)))
+    (when deleted-node (cons key (trie--node-data deleted-node)))))
 
 
 
@@ -1329,105 +1322,106 @@ results\)."
 ;; would be highly non-trivial. (I haven't done any benchmarking, though, so
 ;; feel free to do so and let me know the results!)
 
-(defun trie--construct-accumulator (maxnum filter resultfun)
+(defmacro trie--construct-accumulator (maxnum filter resultfun)
   ;; Does what it says on the tin! | sed -e 's/tin/macro name/'
-  (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)))))
-   ))
+  (declare (debug t))
+  `(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)))))
+    ))
 
 
 
-(defun trie--construct-ranked-accumulator (maxnum filter)
+(defmacro trie--construct-ranked-accumulator (maxnum filter)
   ;; Does what it says on the tin! | sed -e 's/tin/macro name/'
-  (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))))))
+  (declare (debug t))
+  `(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))))))
 
 
 
 (defmacro trie--accumulate-results
   (rankfun maxnum reverse filter resultfun accfun duplicates &rest body)
+  (declare (debug t))
   ;; Accumulate results of running BODY code, and return them in appropriate
   ;; order. BODY should call ACCFUN to accumulate a result, passing it two
   ;; arguments: a trie key and its associated data. BODY can throw