[elpa] externals/dict-tree 1d096b1 141/154: Myriad bug fixes and code refactoring in new fuzzy and ngram completion.

[Stefan Monnier]

branch: externals/dict-tree
commit 1d096b15aacc5ee7eadec4c042fc5c31a8ed494e
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.
---
 dict-tree.el | 240 +++++++++++++++++++++--------------------------------------
 1 file changed, 86 insertions(+), 154 deletions(-)

diff --git a/dict-tree.el b/dict-tree.el
index 97d3e25..eba2a1f 100644
--- a/dict-tree.el
+++ b/dict-tree.el
@@ -320,7 +320,8 @@ If START or END is negative, it counts from the end."
         (,sortfun a b)))))
 
 
-;; return wrapped rankfun to ignore fuzzy query distance data
+;; return wrapped rankfun to deal with data wrapping and ignore fuzzy query
+;; distance data. Note: works for both fuzzy-matching and fuzzy-completion.
 (dictree--if-lexical-binding
     (defun dictree--wrap-fuzzy-rankfun (rankfun)  ; INTERNAL USE ONLY
       (lambda (a b)
@@ -332,6 +333,34 @@ If START or END is negative, it counts from the end."
        (,rankfun (cons (car a) (dictree--cell-data (cdr a)))
                 (cons (car b) (dictree--cell-data (cdr b)))))))
 
+
+(defun dictree--construct-fuzzy-trie-rankfun (rankfun &optional dict)
+  (cond
+   ((eq rankfun 'distance) t)
+   ((and (or (eq (car-safe rankfun) t)
+            (eq (car-safe rankfun) 'distance))
+        (or (eq (cdr-safe rankfun) t)
+            (eq (cdr-safe rankfun) 'ranked)))
+    (cons t (dictree--wrap-rankfun (dictree-rank-function dict))))
+   ((or (eq (car-safe rankfun) t)
+       (eq (car-safe rankfun) 'distance))
+    (cons t (dictree--wrap-fuzzy-rankfun (cdr rankfun))))
+   ((or (eq rankfun t)
+       (eq rankfun 'ranked))
+    (dictree--wrap-fuzzy-rankfun (dictree-rank-function dict)))
+   (rankfun (dictree--wrap-fuzzy-rankfun rankfun))))
+
+(defun dictree--construct-fuzzy-match-rankfun (rankfun dict)
+  (trie--construct-fuzzy-match-rankfun
+   (dictree--construct-fuzzy-trie-rankfun rankfun dict)
+   (dictree--trie dict)))
+
+(defun dictree--construct-fuzzy-complete-rankfun (rankfun dict)
+  (trie--construct-fuzzy-complete-rankfun
+   (dictree--construct-fuzzy-trie-rankfun rankfun dict)
+   (dictree--trie dict)))
+
+
 ;; return wrapped sortfun to ignore fuzzy query distance data
 (dictree--if-lexical-binding
     (defun dictree--wrap-fuzzy-sortfun (cmpfun &optional reverse)
@@ -378,16 +407,18 @@ If START or END is negative, it counts from the end."
     `(lambda (res) (,resultfun (car res) (dictree--cell-data (cdr res))))))
 
 
-;; construct lexicographic sort function from DICT's comparison function
-(dictree--if-lexical-binding
-    (defun dictree--construct-sortfun (dict)  ; INTERNAL USE ONLY
-      (let ((sortfun (trie-construct-sortfun
-                     (dictree-comparison-function dict))))
-       (lambda (a b) (funcall sortfun (car a) (car b)))))
-    (defun dictree--construct-sortfun (dict)  ; INTERNAL USE ONLY
-      `(lambda (a b)
-        (,(trie-construct-sortfun (dictree-comparison-function (car dict)))
-         (car a) (car b)))))
+;; construct lexicographic sort function from DICT's comparison function.
+;; ACCESSOR is used to obtain the sort key, defaulting to `car'.
+;;(dictree--if-lexical-binding
+(defun dictree--construct-sortfun (comparison-function &optional accessor)  ; 
INTERNAL USE ONLY
+  (unless accessor (setq accessor #'car))
+  (let ((sortfun (trie-construct-sortfun comparison-function)))
+    (lambda (a b)
+      (funcall sortfun (funcall accessor a) (funcall accessor b)))))
+    ;; (defun dictree--construct-sortfun (dict &optional accessor)  ; INTERNAL 
USE ONLY
+    ;;   `(lambda (a b)
+    ;;          (,(trie-construct-sortfun (dictree-comparison-function dict))
+    ;;           (,accessor a) (,accessor b)))))
 
 
 
@@ -541,12 +572,10 @@ If START or END is negative, it counts from the end."
     (list (dictree--trie dict))))
 
 
-(defun dictree--merge (list1 list2 cmpfun &optional combfun maxnum)
+(defun dictree--merge (list1 list2 cmpfun &optional maxnum)
   ;; Destructively merge together sorted lists LIST1 and LIST2, sorting
   ;; elements according to CMPFUN. For non-null MAXNUM, only the first
-  ;; MAXNUM are kept. For non-null COMBFUN, duplicate elements will be
-  ;; merged by passing the two elements as arguments to COMBFUN, and
-  ;; using the return value as the merged element.
+  ;; MAXNUM are kept.
   (or (listp list1) (setq list1 (append list1 nil)))
   (or (listp list2) (setq list2 (append list2 nil)))
   (let (res (i 0))
@@ -554,23 +583,9 @@ If START or END is negative, it counts from the end."
     ;; build up result list backwards
     (while (and list1 list2 (or (null maxnum) (< (incf i) maxnum)))
       ;; move smaller element to result list
-      (if (funcall cmpfun (car list1) (car list2))
-         (push (pop list1) res)
-       (if (funcall cmpfun (car list2) (car list1))
-           (push (pop list2) res)
-         ;; if elements are equal, merge them for non-null COMBFUN
-         ;; !!!!!!!!!!!!!!!!!!!!!!!!!!! FIXME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-         ;; Doesn't combine duplicate completions, combines things that
-         ;; happen to compare equal. Depending on CMPFUN, this could combine
-         ;; things that shouldn't be combined, or fail to combine things that
-         ;; should be.
-         ;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-         (if combfun
-             (push (funcall combfun (pop list1) (pop list2))
-                   res)
-           ;; otherwise, add both to result list, in order
-           (push (pop list1) res)
-           (push (pop list2) res)))))
+      (if (funcall cmpfun (car list2) (car list1))
+         (push (pop list2) res)
+       (push (pop list1) res)))
 
     ;; return result if we already have MAXNUM entries
     (if (and maxnum (= i maxnum))
@@ -602,7 +617,7 @@ If START or END is negative, it counts from the end."
 ;;     (dictree--merge
 ;;      (dictree--do-merge-sort list1 (/ len 2) sortfun combfun)
 ;;      (dictree--do-merge-sort list2 (/ len 2) sortfun combfun)
-;;      sortfun combfun)))
+;;      sortfun)))
 
 
 
@@ -1281,11 +1296,17 @@ PREFIX is a prefix of STR."
                 (dictree-fuzzy-match-cache
                  dictree--synchronize-fuzzy-match-cache
                  (lambda (string dist key)
-                   (<= (Lewenstein-distance string key) dist)))
+                   (if (consp dist)
+                       (<= (Lewenstein-distance (substring string (car dist)) 
key)
+                           (cdr dist))
+                     (<= (Lewenstein-distance string key) dist))))
                 (dictree-fuzzy-complete-cache
-                 dictree--synchronize-fuzzy-completion-cache
+                 dictree--synchronize-fuzzy-complete-cache
                  (lambda (prefix dist key)
-                   (<= (Lewenstein-distance prefix key) dist)))
+                   (if (consp dist)
+                       (<= (Lewenstein-distance (substring prefix (car dist)) 
key)
+                           (cdr dist))
+                     (<= (Lewenstein-distance prefix key) dist))))
                 ))
        (when (funcall (nth 0 cachefuns) dict)
          (maphash
@@ -1346,14 +1367,7 @@ PREFIX is a prefix of STR."
          (setf (dictree--cache-results cache-entry)
                (dictree--merge
                 (list (cons key newdata)) completions
-                (or rankfun
-                    `(lambda (a b)
-                       (,(trie-construct-sortfun
-                          (dictree-comparison-function dict))
-                        (car a) (car b))))
-                (when (dictree--meta-dict-p dict)
-                  (dictree--wrap-combfun
-                   (dictree--meta-dict-combine-function dict)))
+                (or rankfun (dictree--construct-sortfun dict))
                 maxnum))))
 
        ;; modified and in the cached result
@@ -1430,15 +1444,7 @@ PREFIX is a prefix of STR."
          (setf (dictree--cache-results cache-entry)
                (dictree--merge
                 (list (cons key newdata)) completions
-                (or rankfun
-                    `(lambda (a b)
-                       (,(trie-construct-sortfun
-                          (dictree-comparison-function dict))
-                        ,(if group-data '(caar a) '(car a))
-                        ,(if group-data '(caar b) '(car b)))))
-                (when (dictree--meta-dict-p dict)
-                  (dictree--wrap-combfun
-                   (dictree--meta-dict-combine-function dict)))
+                (or rankfun (dictree--construct-sortfun dict #'caar))
                 maxnum))))
 
        ;; modified and in the cached result
@@ -1475,16 +1481,9 @@ PREFIX is a prefix of STR."
         (cmpl (catch 'found
                 (dolist (c completions)
                   (when (equal key (caar c)) (throw 'found c)))))
-        (distance (Lewenstein-distance key arg))
-        (rankfun (cond ((eq rank-function t)
-                        (dictree--wrap-fuzzy-rankfun
-                         (dictree-rank-function dict)))
-                       ((eq rank-function 'distance)
-                        (dictree--wrap-fuzzy-rankfun
-                         (trie--construct-fuzzy-match-rankfun
-                          (dictree-comparison-function dict))))
-                       (rank-function
-                        (dictree--wrap-fuzzy-rankfun rank-function)))))
+        (distance (Lewenstein-distance arg key))
+        (rankfun (dictree--construct-fuzzy-match-rankfun
+                  rank-function dict)))
     ;; for meta-dict, get old data from cache instead of OLDDATA
     (when (dictree--meta-dict-p dict) (setq olddata (cdr cmpl)))
     ;; skip cache update if key/data pair doesn't pass FILTER
@@ -1509,14 +1508,7 @@ PREFIX is a prefix of STR."
          (setf (dictree--cache-results cache-entry)
                (dictree--merge
                 (list (cons (cons key distance) newdata)) completions
-                (or rankfun
-                    `(lambda (a b)
-                       (,(trie-construct-sortfun
-                          (dictree-comparison-function dict))
-                        (caar a) (caar b))))
-                (when (dictree--meta-dict-p dict)
-                  (dictree--wrap-combfun
-                   (dictree--meta-dict-combine-function dict)))
+                (or rankfun (dictree--construct-sortfun dict #'caar))
                 maxnum))))
 
        ;; modified and in the cached result
@@ -1553,16 +1545,11 @@ PREFIX is a prefix of STR."
         (cmpl (catch 'found
                 (dolist (c completions)
                   (when (equal key (caar c)) (throw 'found c)))))
-        (distance (Lewenstein-distance key arg))
-        (rankfun (cond ((eq rank-function t)
-                        (dictree--wrap-fuzzy-rankfun
-                         (dictree-rank-function dict)))
-                       ((eq rank-function 'distance)
-                        (dictree--wrap-fuzzy-rankfun
-                         (trie--construct-fuzzy-complete-rankfun
-                          (dictree-comparison-function dict))))
-                       (rank-function
-                        (dictree--wrap-fuzzy-rankfun rank-function)))))
+        (distance (Lewenstein-prefix-distance arg key))
+        (pfxlen (cdr distance))
+        (distance (car distance))
+        (rankfun (dictree--construct-fuzzy-complete-rankfun
+                  rank-function dict)))
     ;; for meta-dict, get old data from cache instead of OLDDATA
     (when (dictree--meta-dict-p dict) (setq olddata (cdr cmpl)))
     ;; skip cache update if key/data pair doesn't pass FILTER
@@ -1586,15 +1573,9 @@ PREFIX is a prefix of STR."
        (when (or (null filter) (funcall filter key newdata))
          (setf (dictree--cache-results cache-entry)
                (dictree--merge
-                (list (cons key (cons distance newdata))) completions
-                (or rankfun
-                    `(lambda (a b)
-                       (,(trie-construct-sortfun
-                          (dictree-comparison-function dict))
-                        (car a) (car b))))
-                (when (dictree--meta-dict-p dict)
-                  (dictree--wrap-combfun
-                   (dictree--meta-dict-combine-function dict)))
+                (list (cons (list key distance pfxlen) newdata))
+                completions
+                (or rankfun (dictree--construct-sortfun dict #'caar))
                 maxnum))))
 
        ;; modified and in the cached result
@@ -2549,8 +2530,7 @@ to its constituent dicts."
 
   ;; map over all dictionaries in list
   (when (dictree-p dict) (setq dict (list dict)))
-  (let ((sort-function (dictree--construct-sortfun (car dict)))
-       cache results res cache-entry)
+  (let (cache results res cache-entry)
     (dolist (dic dict)
 
       ;; if there's a cache entry with enough results, use it
@@ -2603,8 +2583,10 @@ to its constituent dicts."
 
       ;; merge new result into results list
       (setq results
-           (dictree--merge results res (or rankfun sort-function)
-                           nil maxnum)))
+           (dictree--merge
+            results res
+            (or rankfun (dictree--construct-sortfun (car dict)))
+            maxnum)))
 
 
     ;; return results list, applying RESULTFUN if specified, otherwise just
@@ -2945,38 +2927,14 @@ of the default key-dist-data list."
    t no-cache  ; cache long STRINGs
    string (list distance)
    rank-function
-   (when rank-function
-     (cond
-      ((eq rank-function 'distance) t)
-      ((and (eq (car-safe rank-function) t)
-           (eq (cdr-safe rank-function) 'ranked))
-       (cons t (dictree--wrap-rankfun
-               (dictree-rank-function (if (listp dict) (car dict) dict)))))
-      ((eq (car-safe rank-function) t)
-       (cons t (dictree--wrap-fuzzy-rankfun (cdr rank-function))))
-      ((eq rank-function t)
-       (dictree--wrap-fuzzy-rankfun
-       (dictree-rank-function (if (listp dict) (car dict) dict))))
-      (t (dictree--wrap-fuzzy-rankfun rank-function))
-      ))
+   (dictree--construct-fuzzy-trie-rankfun
+    rank-function (if (listp dict) (car dict) dict))
    maxnum
    reverse
    filter
    resultfun
-   (when rank-function
-     (cond
-      ((eq rank-function 'distance)
-       (trie--construct-fuzzy-match-rankfun
-       (dictree--comparison-function (if (listp dict) (car dict) dict))))
-      ((and (eq (car-safe rank-function) t)
-           (eq (cdr-safe rank-function) 'ranked))
-       (trie--construct-fuzzy-match-dist-rankfun
-       (dictree--wrap-rankfun
-        (dictree-rank-function (if (listp dict) (car dict) dict)))))
-      ((eq (car-safe rank-function) t)
-       (trie--construct-fuzzy-match-dist-rankfun
-       (dictree--wrap-rankfun (cdr rank-function))))
-      ))))
+   (dictree--construct-fuzzy-match-rankfun
+    rank-function  (if (listp dict) (car dict) dict))))
 
 
 (defun dictree-fuzzy-complete
@@ -3084,38 +3042,14 @@ of the default key-dist-pfxlen-data list."
    nil no-cache  ; cache short PREFIXes
    prefix (list distance)
    rank-function
-   (when rank-function
-     (cond
-      ((eq rank-function 'distance) t)
-      ((and (eq (car-safe rank-function) t)
-           (eq (cdr-safe rank-function) 'ranked))
-       (cons t (dictree--wrap-rankfun
-               (dictree-rank-function (if (listp dict) (car dict) dict)))))
-      ((eq (car-safe rank-function) t)
-       (cons t (dictree--wrap-fuzzy-rankfun (cdr rank-function))))
-      ((eq rank-function t)
-       (dictree--wrap-fuzzy-rankfun
-       (dictree-rank-function (if (listp dict) (car dict) dict))))
-      (t (dictree--wrap-fuzzy-rankfun rank-function))
-      ))
+   (dictree--construct-fuzzy-trie-rankfun
+    rank-function (if (listp dict) (car dict) dict))
    maxnum
    reverse
    filter
    resultfun
-   (when rank-function
-     (cond
-      ((eq rank-function 'distance)
-       (trie--construct-fuzzy-complete-rankfun
-       (dictree--comparison-function (if (listp dict) (car dict) dict))))
-      ((and (eq (car-safe rank-function) t)
-           (eq (cdr-safe rank-function) 'ranked))
-       (trie--construct-fuzzy-complete-dist-rankfun
-       (dictree--wrap-rankfun
-        (dictree-rank-function (if (listp dict) (car dict) dict)))))
-      ((eq (car-safe rank-function) t)
-       (trie--construct-fuzzy-complete-dist-rankfun
-       (dictree--wrap-rankfun (cdr rank-function))))
-      ))))
+   (dictree--construct-fuzzy-complete-rankfun
+    rank-function (if (listp dict) (car dict) dict))))
 
 
 
@@ -3236,10 +3170,8 @@ and OVERWRITE is the prefix argument."
              ;; destination
              (unless (eq compilation 'uncompiled)
                (if (save-window-excursion
-                     (let ((byte-compile-disable-print-circle t)
-                           err)
-                       (setq err (byte-compile-file tmpfile))
-                       err))
+                     (let ((byte-compile-disable-print-circle t))
+                       (byte-compile-file tmpfile)))
                    (rename-file (concat tmpfile ".elc")
                                 (concat filename ".elc") t)
                  (error ""))))