[elpa] externals/trie c2b5e26 105/111: Myriad bug fixes and code refactoring in new fuzzy and ngram completion.

[Stefan Monnier]

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

    Myriad bug fixes and code refactoring in new fuzzy and ngram completion.
---
 trie.el | 194 +++++++++++++++++++++++++++++++++++-----------------------------
 1 file changed, 105 insertions(+), 89 deletions(-)

diff --git a/trie.el b/trie.el
index 428911f..137420f 100644
--- a/trie.el
+++ b/trie.el
@@ -226,74 +226,80 @@
 
 ;; create Lewenstein rank functions from trie comparison function
 (trie--if-lexical-binding
-    (defun trie--construct-fuzzy-match-rankfun (comparison-function)
-      (let ((compfun (trie-construct-sortfun comparison-function)))
+    (defun trie--construct-fuzzy-match-rankfun (rankfun trie)
+      (cond
+       ((or (eq rankfun t) (eq rankfun 'distance))
+       (let ((compfun (trie-construct-sortfun
+                       (trie-comparison-function trie))))
+         (lambda (a b)
+           (cond
+            ((< (cdar a) (cdar b)) t)
+            ((> (cdar a) (cdar b)) nil)
+            (t (funcall compfun (caar a) (caar b)))))))
+       ((or (eq (car-safe rankfun) t) (eq (car-safe rankfun) 'distance))
+       (setq rankfun (cdr rankfun))
        (lambda (a b)
          (cond
           ((< (cdar a) (cdar b)) t)
           ((> (cdar a) (cdar b)) nil)
-          (t (funcall compfun (caar a) (caar b)))))))
-  (defun trie--construct-fuzzy-match-rankfun (comparison-function)
-    `(lambda (a b)
-       (cond
-       ((< (cdar a) (cdar b)) t)
-       ((> (cdar a) (cdar b)) nil)
-       (t ,(trie-construct-sortfun comparison-function)
-          (caar a) (caar b))))))
-
-
-(trie--if-lexical-binding
-    (defun trie--construct-fuzzy-match-dist-rankfun (rankfun)
-      (lambda (a b)
-       (cond
-        ((< (cdar a) (cdar b)) t)
-        ((> (cdar a) (cdar b)) nil)
-        (t (funcall rankfun
-                    (cons (caar a) (cdr a))
-                    (cons (caar b) (cdr b)))))))
-  (defun trie--construct-fuzzy-match-dist-rankfun (rankfun)
-    `(lambda (a b)
-       (cond
-       ((< (cdar a) (cdar b)) t)
-       ((> (cdar a) (cdar b)) nil)
-       (t (,rankfun (cons (caar a) (cdr a))
-                    (cons (caar b) (cdr b))))))))
-
+          (t (funcall rankfun
+                      (cons (caar a) (cdr a))
+                      (cons (caar b) (cdr b)))))))))
+    (defun trie--construct-fuzzy-match-rankfun (rankfun trie)
+      (cond
+       ((or (eq rankfun t) (eq rankfun 'distance))
+       `(lambda (a b)
+          (cond
+           ((< (cdar a) (cdar b)) t)
+           ((> (cdar a) (cdar b)) nil)
+           (t (,(trie-construct-sortfun (trie-comparison-function trie))
+               (caar a) (caar b))))))
+       ((or (eq (car-safe rankfun) t) (eq (car-safe rankfun) 'distance))
+       `(lambda (a b)
+          (cond
+           ((< (cdar a) (cdar b)) t)
+           ((> (cdar a) (cdar b)) nil)
+           (t (,(cdr rankfun)
+               (cons (caar a) (cdr a))
+               (cons (caar b) (cdr b))))))))))
 
 (trie--if-lexical-binding
-    (defun trie--construct-fuzzy-complete-rankfun (comparison-function)
-      (let ((compfun (trie-construct-sortfun comparison-function)))
+    (defun trie--construct-fuzzy-complete-rankfun (rankfun trie)
+      (cond
+       ((or (eq rankfun t) (eq rankfun 'distance))
+       (let ((compfun (trie-construct-sortfun
+                       (trie-comparison-function trie))))
+         (lambda (a b)
+           (cond
+            ((< (nth 1 (car a)) (nth 1 (car b))) t)
+            ((> (nth 1 (car a)) (nth 1 (car b))) nil)
+            (t (funcall compfun (caar a) (caar b)))))))
+       ((or (eq (car-safe rankfun) t) (eq (car-safe rankfun) 'distance))
+       (setq rankfun (cdr rankfun))
        (lambda (a b)
          (cond
           ((< (nth 1 (car a)) (nth 1 (car b))) t)
           ((> (nth 1 (car a)) (nth 1 (car b))) nil)
-          (t (funcall compfun (caar a) (caar b)))))))
-  (defun trie--construct-fuzzy-complete-rankfun (comparison-function)
-    `(lambda (a b)
-       (cond
-       ((< (nth 1 (car a)) (nth 1 (car b))) t)
-       ((> (nth 1 (car a)) (nth 1 (car b))) nil)
-       (t ,(trie-construct-sortfun comparison-function)
-          (caar a) (caar b))))))
-
-
-(trie--if-lexical-binding
-    (defun trie--construct-fuzzy-complete-dist-rankfun (rankfun)
-      (lambda (a b)
-       (cond
-        ((< (nth 1 (car a)) (nth 1 (car b))) t)
-        ((> (nth 1 (car a)) (nth 1 (car b))) nil)
-        (t (funcall rankfun
-                    (cons (caar a) (cdr a))
-                    (cons (caar b) (cdr b)))))))
-  (defun trie--construct-fuzzy-complete-dist-rankfun (rankfun)
-    `(lambda (a b)
-       (cond
-       ((< (nth 1 (car a)) (nth 1 (car b))) t)
-       ((> (nth 1 (car a)) (nth 1 (car b))) nil)
-       (t (,rankfun
-           (cons (caar a) (cdr a))
-           (cons (caar b) (cdr b))))))))
+          (t (funcall rankfun
+                      (cons (caar a) (cdr a))
+                      (cons (caar b) (cdr b)))))))))
+  (defun trie--construct-fuzzy-complete-rankfun (rankfun trie)
+      (cond
+       ((or (eq rankfun t) (eq rankfun 'distance))
+       `(lambda (a b)
+          (cond
+           ((< (nth 1 (car a)) (nth 1 (car b))) t)
+           ((> (nth 1 (car a)) (nth 1 (car b))) nil)
+           (t (,(trie-construct-sortfun (trie-comparison-function trie))
+               (caar a) (caar b))))))
+       ((or (eq (car-safe rankfun) t) (eq (car-safe rankfun) 'distance))
+       `(lambda (a b)
+          (cond
+           ((< (nth 1 (car a)) (nth 1 (car b))) t)
+           ((> (nth 1 (car a)) (nth 1 (car b))) nil)
+           (t (,(cdr rankfun)
+               (cons (caar a) (cdr a))
+               (cons (caar b) (cdr b))))))))))
 
 
 
@@ -2100,7 +2106,7 @@ results\)."
 ;; Basic Lewenstein distance (edit distance) functions
 ;; ---------------------------------------------------
 
-(defun* Lewenstein-distance (str1 str2 &key (test 'equal))
+(defun* Lewenstein-distance (str1 str2 &key (test #'equal))
   "Return the Lewenstein distance between strings STR1 and STR2
 \(a.k.a. edit distance\).
 
@@ -2117,10 +2123,23 @@ to `equal'."
       (setq row (Lewenstein--next-row row str2 (elt str1 i) test)))
     (aref row (1- (length row)))))
 
-
 (defalias 'edit-distance 'Lewenstein-distance)
 
 
+(defun* Lewenstein-prefix-distance (prefix string &key (test #'equal))
+  "Return the Lewenstein prefix distance between PREFIX and STRING,
+i.e. the minimum distance between PREFIX and any prefix of STRING.
+
+See also `Lewenstein-distance'."
+  (let ((min (length prefix))
+       dist pfxlen)
+    (dotimes (i (length string))
+      (setq dist (Lewenstein-distance prefix (cl-subseq string 0 (1+ i))
+                                     :test test))
+      (if (<= dist min) (setq min dist pfxlen (1+ i))))
+    (cons min pfxlen)))
+
+
 (defun Lewenstein--next-row (row string chr equalfun)
   ;; Compute next row of Lewenstein distance matrix.
   (let ((next-row (make-vector (length row) nil))
@@ -2255,29 +2274,28 @@ of the default key-dist-data list."
   (let ((equalfun (trie--construct-equality-function
                   (trie--comparison-function trie)))
        ranked-by-dist stats)
+
     ;; construct rankfun to sort by Lewenstein distance if requested
     (cond
-     ((eq rankfun t)
-      (setq rankfun (trie--construct-fuzzy-match-rankfun
-                    (trie--comparison-function trie))
-           ranked-by-dist 'dist-only))
-     ((eq (car-safe rankfun) t)
-      (setq rankfun (trie--construct-fuzzy-match-dist-rankfun
-                    (cdr rankfun))
-           ranked-by-dist t)))
-
-      ;; FIXME: the test for a list of prefixes, below, will fail if the
-      ;;        PREFIX sequence is a list, and the elements of PREFIX are
-      ;;        themselves lists (there might be no easy way to fully fix
-      ;;        this...)
-      (if (or (atom string)
-             (and (listp string) (not (sequencep (car string)))))
-         (setq string (list string))
-       ;; sort list of prefixes if sorting completions lexicographicly
-       (when (null rankfun)
-         (setq string
-               (sort string (trie-construct-sortfun
-                             (trie--comparison-function trie))))))
+     ((or (eq rankfun t) (eq rankfun 'distance))
+      (setq ranked-by-dist 'dist-only))
+     ((or (eq (car-safe rankfun) t) (eq (car-safe rankfun) 'distance))
+      (setq ranked-by-dist t)))
+    (when ranked-by-dist
+      (setq rankfun (trie--construct-fuzzy-match-rankfun rankfun trie)))
+
+    ;; FIXME: the test for a list of prefixes, below, will fail if the PREFIX
+    ;;        sequence is a list, and the elements of PREFIX are themselves
+    ;;        lists (there might be no easy way to fully fix this...)
+    (if (or (atom string)
+           (and (listp string) (not (sequencep (car string)))))
+       (setq string (list string))
+      ;; sort list of prefixes if sorting completions lexicographicly
+      (when (null rankfun)
+       (setq string
+             (sort string (trie-construct-sortfun
+                           (trie--comparison-function trie))))))
+
     ;; accumulate results
     (trie--accumulate-results
      rankfun maxnum reverse filter resultfun accumulator nil
@@ -2611,14 +2629,12 @@ of the default key-dist-pfxlen-data list."
 
     ;; construct rankfun to sort by Lewenstein distance if requested
     (cond
-     ((eq rankfun t)
-      (setq rankfun (trie--construct-fuzzy-complete-rankfun
-                    (trie--comparison-function trie))
-           ranked-by-dist 'dist-only))
-     ((eq (car-safe rankfun) t)
-      (setq rankfun (trie--construct-fuzzy-complete-dist-rankfun
-                    (cdr rankfun))
-           ranked-by-dist t)))
+     ((or (eq rankfun t) (eq rankfun 'distance))
+      (setq ranked-by-dist 'dist-only))
+     ((or (eq (car-safe rankfun) t) (eq (car-safe rankfun) 'distance))
+      (setq ranked-by-dist t)))
+    (when ranked-by-dist
+      (setq rankfun (trie--construct-fuzzy-complete-rankfun rankfun trie)))
 
     ;; FIXME: the test for a list of prefixes, below, will fail if the
     ;;        PREFIX sequence is a list, and the elements of PREFIX are