From 8bd60d49918995fb9640cfbc2dd149299e7756a8 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Sun, 28 May 2023 13:10:15 +0200 Subject: [PATCH 01/20] Remove redundant (> i 0) check when highlighting --- hotfuzz.el | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/hotfuzz.el b/hotfuzz.el index 900d6b5..8b649c0 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -70,7 +70,7 @@ Emacs `completion-styles' interface." (defun hotfuzz--calc-bonus (haystack) "Precompute all potential bonuses for matching certain characters in HAYSTACK." - (cl-loop for ch across haystack and i = 0 then (1+ i) and lastch = ?/ then ch do + (cl-loop for ch across haystack and i from 0 and lastch = ?/ then ch do (aset hotfuzz--bonus i (aref (aref hotfuzz--bonus-prev-luts (aref hotfuzz--bonus-cur-lut ch)) lastch)))) @@ -121,20 +121,18 @@ HAYSTACK has to be a match according to `hotfuzz-filter'." (hotfuzz--calc-bonus haystack) (cl-loop with rows = (cl-loop - with nc and nd - for i below n and pc = c then nc and pd = d then nd with res do + with nc and nd and res + for i below n and pc = c then nc and pd = d then nd do (setq nc (make-vector m 0) nd (make-vector m 0)) (hotfuzz--match-row haystack needle i nc nd pc pd) (push (cons nc nd) res) finally return res) ;; Backtrack to find matching positions - for j from (1- m) downto 0 with i = n do - (when (<= (aref (cdar rows) j) (aref (caar rows) j)) - (while (cl-destructuring-bind (_c . d) (pop rows) - (cl-decf i) - (and (> i 0) (< (aref (cdar rows) j) (aref d j)))))) - (pop rows) - (cl-decf i) + for j from (1- m) downto 0 and i downfrom (1- n) do + (cl-destructuring-bind (c . d) (pop rows) + (when (<= (aref d j) (aref c j)) + (while (progn (cl-decf i) + (> (aref d j) (aref (setq d (cdr (pop rows))) j)))))) (add-face-text-property i (1+ i) 'completions-common-part nil haystack)))) haystack) @@ -173,7 +171,7 @@ list before passing it to `display-sort-function' or (bounds (completion-boundaries beforepoint table pred afterpoint)) (prefix (substring beforepoint 0 (car bounds))) (needle (substring beforepoint (car bounds))) - (completion-regexp-list nil) + completion-regexp-list (all (hotfuzz-filter needle (if (and (listp table) (not (consp (car table))) From 17c0413af30ed249650535369d4d4f7abef70a8c Mon Sep 17 00:00:00 2001 From: sashimacs <130169373+sashimacs@users.noreply.github.com> Date: Thu, 4 May 2023 13:31:55 -0400 Subject: [PATCH 02/20] Cross-platform support in native module --- CMakeLists.txt | 2 +- hotfuzz-module.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 376e5db..bbd5541 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -25,7 +25,7 @@ find_package(Threads REQUIRED) add_library(hotfuzz-module MODULE hotfuzz-module.c) set_target_properties(hotfuzz-module PROPERTIES - C_STANDARD 99 + C_STANDARD 11 POSITION_INDEPENDENT_CODE ON PREFIX "" LIBRARY_OUTPUT_DIRECTORY ${CMAKE_SOURCE_DIR}) diff --git a/hotfuzz-module.c b/hotfuzz-module.c index a8c8b1e..99a5efb 100644 --- a/hotfuzz-module.c +++ b/hotfuzz-module.c @@ -10,7 +10,7 @@ #include #include #include -#include +#include #define MIN(a, b) ({ __typeof__(a) _a = (a), _b = (b); _a < _b ? _a : _b; }) #define MAX(a, b) ({ __typeof__(a) _a = (a), _b = (b); _a > _b ? _a : _b; }) @@ -369,7 +369,7 @@ int emacs_module_init(struct emacs_runtime *rt) { return 2; static struct Data data; - data.max_workers = get_nprocs(); + data.max_workers = sysconf(_SC_NPROCESSORS_ONLN); if (!(data.workers = malloc(data.max_workers * sizeof *data.workers))) return 1; From b7e1fabfccbecc68e7e6ce3b5d9e292fe3c5921d Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Wed, 23 Aug 2023 20:15:36 +0200 Subject: [PATCH 03/20] Remove Selectrum integration Selectrum has been deprecated in favor of Vertico, see radian-software/selectrum#601. --- README.md | 14 +++++--------- hotfuzz.el | 36 ------------------------------------ test/tests.el | 10 ---------- 3 files changed, 5 insertions(+), 55 deletions(-) diff --git a/README.md b/README.md index 0e94ed1..619bdfe 100644 --- a/README.md +++ b/README.md @@ -13,16 +13,11 @@ To use hotfuzz, add it to the `completion-styles` list: ```elisp (setq completion-styles '(hotfuzz)) ``` - -Or, if using -[Fido](https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html), -add hotfuzz to the `completion-styles` list this way: - +Or, if using [Fido], add hotfuzz to the `completion-styles` list this way: ```elisp (add-hook 'icomplete-minibuffer-setup-hook (lambda () (setq-local completion-styles '(hotfuzz)))) ``` -or, if using [Selectrum], enable `hotfuzz-selectrum-mode`. **Note:** Highlighting of the matched characters is only applied to the first `hotfuzz-max-highlighted-completions` completions, out of @@ -36,8 +31,8 @@ using ``` provided you are completing small enough lists and/or do not encounter performance problems. -This is a non-issue when using `hotfuzz-selectrum-mode` since -Selectrum supports lazy highlighting. +This is a non-issue when using `hotfuzz-vertico-mode` since +Vertico supports lazy highlighting. ## Customization @@ -106,7 +101,8 @@ but does no sorting and allows the individual sub-patterns to overlap Hotfuzz on the other hand tries to be more *clever* about sorting, and so users who dislike that may prefer orderless. -[Selectrum]: https://github.com/raxod502/selectrum +[Vertico]: https://github.com/minad/vertico +[Fido]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html [flx]: https://github.com/lewang/flx [Ido]: https://www.gnu.org/software/emacs/manual/html_node/ido/index.html [orderless]: https://github.com/oantolin/orderless diff --git a/hotfuzz.el b/hotfuzz.el index 8b649c0..cc26a5a 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -215,42 +215,6 @@ list before passing it to `display-sort-function' or '(hotfuzz completion-flex-try-completion hotfuzz-all-completions "Fuzzy completion."))) -;;; Selectrum integration - -(defun hotfuzz--highlight-all (string candidates) - "Highlight where STRING matches in the elements of CANDIDATES." - (mapcar (lambda (candidate) - (hotfuzz-highlight string (copy-sequence candidate))) - candidates)) - -(defvar selectrum-refine-candidates-function) -(defvar selectrum-highlight-candidates-function) - -(defvar hotfuzz--prev-selectrum-functions nil - "Previous values of the Selectrum sort/filter/highlight API endpoints.") - -;;;###autoload -(define-minor-mode hotfuzz-selectrum-mode - "Minor mode that enables hotfuzz in Selectrum menus." - :global t - (if hotfuzz-selectrum-mode - (setq hotfuzz--prev-selectrum-functions - `(,(when (boundp 'selectrum-refine-candidates-function) - selectrum-refine-candidates-function) - . ,(when (boundp 'selectrum-highlight-candidates-function) - selectrum-highlight-candidates-function)) - selectrum-refine-candidates-function #'hotfuzz-filter - selectrum-highlight-candidates-function #'hotfuzz--highlight-all) - (cl-flet ((restore - (sym old our &aux (standard (car (get sym 'standard-value)))) - (cond ((not (eq (symbol-value sym) our))) - (old (set sym old)) - (standard (set sym (eval standard t))) - (t (makunbound sym))))) - (cl-destructuring-bind (old-rcf . old-hcf) hotfuzz--prev-selectrum-functions - (restore 'selectrum-refine-candidates-function old-rcf #'hotfuzz-filter) - (restore 'selectrum-highlight-candidates-function old-hcf #'hotfuzz--highlight-all))))) - ;;; Vertico integration (declare-function vertico--all-completions "ext:vertico") diff --git a/test/tests.el b/test/tests.el index 4b86e74..601ee63 100644 --- a/test/tests.el +++ b/test/tests.el @@ -98,16 +98,6 @@ 6) ; Point as in "/usr/s|/man" '("share/" . 5))))) -;;; Selectrum integration - -(ert-deftest hotfuzz-selectrum-mode-toggle-test () - (hotfuzz-selectrum-mode) - (hotfuzz-selectrum-mode -1) - ;; Have to unbind variables when disabling for them to be set to - ;; their standard values when Selectrum is loaded. - (should-not (or (boundp 'selectrum-refine-candidates-function) - (boundp 'selectrum-highlight-candidates-function)))) - ;;; Vertico integration (ert-deftest vertico--all-completions-advice-test () From 0ab20e263697619b47f25e73209fc7978c55c20c Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Thu, 24 Aug 2023 16:51:27 +0200 Subject: [PATCH 04/20] Add advice on corfu--all-completions as well --- hotfuzz.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/hotfuzz.el b/hotfuzz.el index cc26a5a..bab78bd 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -218,6 +218,7 @@ list before passing it to `display-sort-function' or ;;; Vertico integration (declare-function vertico--all-completions "ext:vertico") +(declare-function corfu--all-completions "ext:corfu") (defun hotfuzz--vertico--all-completions-advice (fun &rest args) "Advice for FUN `vertico--all-completions' to defer hotfuzz highlighting." @@ -235,14 +236,16 @@ list before passing it to `display-sort-function' or ;;;###autoload (define-minor-mode hotfuzz-vertico-mode - "Toggle Hotfuzz compatibility code for the Vertico completion system. -Contrary to what the name might suggest, this mode does not -automatically enable Hotfuzz. You still have to choose when it gets -used by customizing e.g. `completion-styles'." + "Toggle hotfuzz compatibility code for the Vertico&Corfu completion systems. +Contrary to what the name might suggest, this mode does not enable +hotfuzz. You still have to customize e.g. `completion-styles'." :global t (if hotfuzz-vertico-mode - (advice-add #'vertico--all-completions :around #'hotfuzz--vertico--all-completions-advice) - (advice-remove #'vertico--all-completions #'hotfuzz--vertico--all-completions-advice))) + (progn + (advice-add #'vertico--all-completions :around #'hotfuzz--vertico--all-completions-advice) + (advice-add #'corfu--all-completions :around #'hotfuzz--vertico--all-completions-advice)) + (advice-remove #'vertico--all-completions #'hotfuzz--vertico--all-completions-advice) + (advice-remove #'corfu--all-completions #'hotfuzz--vertico--all-completions-advice))) (provide 'hotfuzz) ;;; hotfuzz.el ends here From 3076cb250d0cb7ac6c3ec746dc4ccfea09ccdb25 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Thu, 24 Aug 2023 14:36:20 +0200 Subject: [PATCH 05/20] Use completion-regexp-list Delegate filtering to the built-in function all-completions by adding the regexp to completion-regexp-list, instead of doing it in Lisp with string-match-p. This brings a speedup of almost 10x, making the dynamic module only ~1000% faster. --- hotfuzz.el | 125 ++++++++++++++++++++++---------------------------- test/tests.el | 19 ++++---- 2 files changed, 64 insertions(+), 80 deletions(-) diff --git a/hotfuzz.el b/hotfuzz.el index bab78bd..4b37af0 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -1,8 +1,8 @@ -;;; hotfuzz.el --- Fuzzy completion style -*- lexical-binding: t; -*- +;;; hotfuzz.el --- Fuzzy completion style -*- lexical-binding: t -*- -;; Copyright 2021 Axel Forsman +;; Copyright (C) 2021 Axel Forsman -;; Author: Axel Forsman +;; Author: Axel Forsman ;; Version: 0.1 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: matching @@ -28,16 +28,14 @@ (defgroup hotfuzz nil "Fuzzy completion style." - :group 'minibuffer - :link '(url-link :tag "GitHub" "https://github.com/axelf4/hotfuzz")) + :group 'minibuffer) (defcustom hotfuzz-max-highlighted-completions 25 "The number of top-ranking completions that should be highlighted. -Large values will decrease performance. Only applies when using the -Emacs `completion-styles' interface." +Large values will decrease performance." :type 'integer) -;; Since we pre-allocate the vectors the common optimization where +;; Since the vectors are pre-allocated the optimization where ;; symmetricity w.r.t. to insertions/deletions means it suffices to ;; allocate min(#needle, #haystack) for C/D when only calculating the ;; cost does not apply. @@ -71,8 +69,8 @@ Emacs `completion-styles' interface." (defun hotfuzz--calc-bonus (haystack) "Precompute all potential bonuses for matching certain characters in HAYSTACK." (cl-loop for ch across haystack and i from 0 and lastch = ?/ then ch do - (aset hotfuzz--bonus i - (aref (aref hotfuzz--bonus-prev-luts (aref hotfuzz--bonus-cur-lut ch)) lastch)))) + (let ((lut (aref hotfuzz--bonus-prev-luts (aref hotfuzz--bonus-cur-lut ch)))) + (aset hotfuzz--bonus i (aref lut lastch))))) ;; Aᵢ denotes the prefix a₀,...,aᵢ₋₁ of A (defun hotfuzz--match-row (a b i nc nd pc pd) @@ -82,11 +80,11 @@ the minimum cost when aᵢ is deleted. The costs for row I are written into NC/ND, using the costs for row I-1 in PC/PD. The vectors NC/PC and ND/PD respectively may alias." (cl-loop - with m = (length b) and oldc + with m = (length b) and g = 100 and h = 5 ; Every k-symbol gap is penalized by g+hk ;; s threads the old value C[i-1][j-1] throughout the loop - for j below m and s = (if (zerop i) 0 (+ g (* h i))) then oldc do - (setq oldc (aref pc j)) + for j below m and s = (if (zerop i) 0 (+ g (* h i))) then oldc + for oldc = (aref pc j) do ;; Either extend optimal conversion of (i) Aᵢ₋₁ to Bⱼ₋₁, by ;; matching bⱼ (C[i-1,j-1]-bonus); or (ii) Aᵢ₋₁ to Bⱼ, by deleting ;; aᵢ and opening a new gap (C[i-1,j]+g+h) or enlarging the @@ -99,19 +97,17 @@ and ND/PD respectively may alias." (defun hotfuzz--cost (needle haystack) "Return the difference score of NEEDLE and the match HAYSTACK." - (let ((n (length haystack)) (m (length needle)) - (c hotfuzz--c) (d hotfuzz--d)) + (let ((n (length haystack)) (m (length needle))) (if (> n hotfuzz--max-haystack-len) 10000 - (fillarray c 10000) - (fillarray d 10000) (hotfuzz--calc-bonus haystack) - (dotimes (i n) (hotfuzz--match-row haystack needle i c d c d)) - (aref c (1- m))))) ; Final cost + (let ((c (fillarray hotfuzz--c 10000)) (d (fillarray hotfuzz--d 10000))) + (dotimes (i n) (hotfuzz--match-row haystack needle i c d c d)) + (aref c (1- m)))))) ; Final cost (defun hotfuzz-highlight (needle haystack) "Highlight the characters that NEEDLE matched in HAYSTACK. -HAYSTACK has to be a match according to `hotfuzz-filter'." +HAYSTACK has to be a match according to `hotfuzz-all-completions'." (let ((n (length haystack)) (m (length needle)) (c hotfuzz--c) (d hotfuzz--d) (case-fold-search completion-ignore-case)) @@ -120,71 +116,62 @@ HAYSTACK has to be a match according to `hotfuzz-filter'." (fillarray d 10000) (hotfuzz--calc-bonus haystack) (cl-loop - with rows = (cl-loop - with nc and nd and res - for i below n and pc = c then nc and pd = d then nd do - (setq nc (make-vector m 0) nd (make-vector m 0)) - (hotfuzz--match-row haystack needle i nc nd pc pd) - (push (cons nc nd) res) - finally return res) + with rows initially + (cl-loop for i below n and pc = c then nc and pd = d then nd + and nc = (make-vector m 0) and nd = (make-vector m 0) do + (hotfuzz--match-row haystack needle i nc nd pc pd) + (push (cons nc nd) rows)) ;; Backtrack to find matching positions for j from (1- m) downto 0 and i downfrom (1- n) do (cl-destructuring-bind (c . d) (pop rows) (when (<= (aref d j) (aref c j)) - (while (progn (cl-decf i) + (while (progn (setq i (1- i)) (> (aref d j) (aref (setq d (cdr (pop rows))) j)))))) (add-face-text-property i (1+ i) 'completions-common-part nil haystack)))) haystack) -;;;###autoload -(defun hotfuzz-filter (string candidates) - "Filter CANDIDATES that match STRING and sort by the match costs. -CANDIDATES should be a list of strings." - (cond - ((string= string "") candidates) - ((require 'hotfuzz-module nil t) - (hotfuzz--filter-c string candidates completion-ignore-case)) - ((let ((re (concat - "\\`" - (mapconcat - (lambda (ch) (format "[^%c]*%s" ch (regexp-quote (char-to-string ch)))) - string ""))) - (case-fold-search completion-ignore-case)) - (if (> (length string) hotfuzz--max-needle-len) - (cl-loop for x in candidates if (string-match-p re x) collect x) - (cl-loop - for x in candidates if (string-match-p re x) - collect (cons (hotfuzz--cost string x) x) into xs - finally return (mapcar #'cdr (cl-sort xs #'car-less-than-car)))))))) - ;;; Completion style implementation ;;;###autoload -(defun hotfuzz-all-completions (string table pred point) +(defun hotfuzz-all-completions (string table &optional pred point) "Get hotfuzz-completions of STRING in TABLE. See `completion-all-completions' for the semantics of PRED and POINT. This function prematurely sorts the completions; mutating the returned list before passing it to `display-sort-function' or `cycle-sort-function' will lead to inaccuracies." + (unless point (setq point (length string))) (let* ((beforepoint (substring string 0 point)) (afterpoint (substring string point)) (bounds (completion-boundaries beforepoint table pred afterpoint)) (prefix (substring beforepoint 0 (car bounds))) (needle (substring beforepoint (car bounds))) - completion-regexp-list - (all (hotfuzz-filter - needle - (if (and (listp table) (not (consp (car table))) - (not (functionp table)) (not pred)) - table - (all-completions prefix table pred))))) + (use-module-p (require 'hotfuzz-module nil t)) + (case-fold-search completion-ignore-case) + (completion-regexp-list + (if use-module-p completion-regexp-list + (let ((re (mapconcat + (lambda (ch) (let ((s (char-to-string ch))) + (concat "[^" s "]*" (regexp-quote s)))) + needle ""))) + (cons (concat "\\`" re) completion-regexp-list)))) + (all (if (and (string= prefix "") (or (stringp (car-safe table)) (null table)) + (not (or pred completion-regexp-list (string= needle "")))) + table + (all-completions prefix table pred)))) + ;; `completion-pcm--all-completions' tests completion-regexp-list + ;; again with functional tables even though they should handle it. + (cond + ((or (null all) (string= needle ""))) + (use-module-p (setq all (hotfuzz--filter-c needle all completion-ignore-case))) + ((> (length needle) hotfuzz--max-needle-len)) + (t (cl-loop for x in-ref all do (setf x (cons (hotfuzz--cost needle x) x)) + finally (setq all (mapcar #'cdr (sort all #'car-less-than-car)))))) (when all (unless (string= needle "") - ;; Highlighting all completions without deferred highlighting - ;; (bug#47711) would take too long. - (cl-loop - repeat hotfuzz-max-highlighted-completions and for x in-ref all do - (setf x (hotfuzz-highlight needle (copy-sequence x)))) + ;; Without deferred highlighting (bug#47711) only highlight + ;; the top completions. + (cl-loop repeat hotfuzz-max-highlighted-completions and for x in-ref all + do (setf x (hotfuzz-highlight needle (copy-sequence x)))) (when (zerop hotfuzz-max-highlighted-completions) (setcar all (copy-sequence (car all)))) (put-text-property 0 1 'completion-sorted t (car all))) @@ -194,14 +181,12 @@ list before passing it to `display-sort-function' or "Adjust completion METADATA for hotfuzz sorting." (let ((existing-dsf (completion-metadata-get metadata 'display-sort-function)) (existing-csf (completion-metadata-get metadata 'cycle-sort-function))) - (cl-flet - ((compose-sort-fn - (existing-sort-fn) - (lambda (completions) - (if (or (null completions) - (get-text-property 0 'completion-sorted (car completions))) - completions - (funcall existing-sort-fn completions))))) + (cl-flet ((compose-sort-fn (existing-sort-fn) + (lambda (completions) + (if (or (null completions) + (get-text-property 0 'completion-sorted (car completions))) + completions + (funcall existing-sort-fn completions))))) `(metadata (display-sort-function . ,(compose-sort-fn (or existing-dsf #'identity))) (cycle-sort-function . ,(compose-sort-fn (or existing-csf #'identity))) diff --git a/test/tests.el b/test/tests.el index 601ee63..62fb3bf 100644 --- a/test/tests.el +++ b/test/tests.el @@ -45,18 +45,18 @@ (ert-deftest case-sensitivity-test () (let ((xs '("aa" "aA " "Aa " "AA "))) (let ((completion-ignore-case nil)) - (should (equal (hotfuzz-filter "a" xs) '("aa" "aA " "Aa "))) - (should (equal (hotfuzz-filter "A" xs) '("Aa " "AA " "aA ")))) + (should (equal (hotfuzz-all-completions "a" xs) '("aa" "aA " "Aa "))) + (should (equal (hotfuzz-all-completions "A" xs) '("Aa " "AA " "aA ")))) (let ((completion-ignore-case t)) - (should (equal (hotfuzz-filter "a" xs) xs)) - (should (equal (hotfuzz-filter "A" xs) xs))))) + (should (equal (hotfuzz-all-completions "a" xs) xs)) + (should (equal (hotfuzz-all-completions "A" xs) xs))))) (ert-deftest long-candidates-test () (let ((a (make-string 4096 ?x)) (b (concat (make-string 2047 ?y) "x" (make-string 2048 ?y)))) ;; Too long candidates should still be filtered with matches ;; lumped together at the end in their original order. - (should (equal (hotfuzz-filter "x" (list (make-string 4096 ?y) b a "x")) + (should (equal (hotfuzz-all-completions "x" (list (make-string 4096 ?y) b a "x")) (list "x" b a))))) (ert-deftest filter-long-needle-test () @@ -64,7 +64,7 @@ (a (concat needle "y"))) ;; With a too long search string candidates should only be ;; filtered but not sorted. - (should (equal (hotfuzz-filter needle (list a "y" needle)) + (should (equal (hotfuzz-all-completions needle (list a "y" needle)) (list a needle))))) (ert-deftest all-completions-test () @@ -87,13 +87,12 @@ (completion-all-completions "/usr/s/man" (lambda (string _pred action) - (let ((prefix-len (length (file-name-directory string)))) + (let ((dir (file-name-directory string))) (pcase action ('metadata '(metadata (category . file))) (`(boundaries . ,suffix) - `(boundaries ,prefix-len . ,(string-match-p "/" suffix))) - ('t (mapcar (lambda (x) (substring x prefix-len)) - (list "/usr/bin/" "/usr/share/" "/usr/local/")))))) + `(boundaries ,(length dir) . ,(string-match-p "/" suffix))) + ('t (all-completions "" '("bin/" "share/" "local/")))))) nil 6) ; Point as in "/usr/s|/man" '("share/" . 5))))) From 822c93648c1a7fdfe4316e996554a1ad89763285 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Wed, 8 Nov 2023 09:18:20 +0100 Subject: [PATCH 06/20] Simplify bonus LUTs Storing indices into a vector of references uses no less space than simply storing the references directly. --- hotfuzz.el | 34 ++++++++++++++-------------------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/hotfuzz.el b/hotfuzz.el index 4b37af0..6628c77 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -45,32 +45,26 @@ Large values will decrease performance." (defvar hotfuzz--d (make-vector hotfuzz--max-needle-len 0)) (defvar hotfuzz--bonus (make-vector hotfuzz--max-haystack-len 0)) -(defconst hotfuzz--bonus-prev-luts +(defconst hotfuzz--bonus-lut (eval-when-compile - (let ((bonus-state-special (make-char-table 'hotfuzz-bonus-lut 0)) - (bonus-state-upper (make-char-table 'hotfuzz-bonus-lut 0)) - (bonus-state-lower (make-char-table 'hotfuzz-bonus-lut 0)) + (let ((state-special (make-char-table 'hotfuzz-bonus-lut 0)) + (state-upper (make-char-table 'hotfuzz-bonus-lut 0)) + (state-lower (make-char-table 'hotfuzz-bonus-lut 0)) (word-bonus 80)) - (cl-loop for (ch . bonus) in `((?/ . 90) (?. . 60) - (?- . ,word-bonus) (?_ . ,word-bonus) - (?\ . ,word-bonus)) - do (aset bonus-state-upper ch bonus) (aset bonus-state-lower ch bonus)) - (cl-loop for ch from ?a to ?z do (aset bonus-state-upper ch word-bonus)) - (vector bonus-state-special bonus-state-upper bonus-state-lower))) - "LUTs of the bonus associated with the previous character.") -(defconst hotfuzz--bonus-cur-lut - (eval-when-compile - (let ((bonus-cur-lut (make-char-table 'hotfuzz-bonus-lut 0))) - (cl-loop for ch from ?A to ?Z do (aset bonus-cur-lut ch 1)) - (cl-loop for ch from ?a to ?z do (aset bonus-cur-lut ch 2)) - bonus-cur-lut)) - "LUT of the `hotfuzz--bonus-prev-luts' index based on the current character.") + (set-char-table-range state-upper '(?a . ?z) word-bonus) + (cl-loop for (ch . bonus) in `((?/ . 90) (?. . 60) (?\ . ,word-bonus) + (?- . ,word-bonus) (?_ . ,word-bonus)) + do (aset state-upper ch bonus) (aset state-lower ch bonus)) + (let ((lut (make-char-table 'hotfuzz-bonus-lut state-special))) + (set-char-table-range lut '(?A . ?Z) state-upper) + (set-char-table-range lut '(?a . ?z) state-lower) + lut))) + "LUT of the bonus associated with the current/previous characters.") (defun hotfuzz--calc-bonus (haystack) "Precompute all potential bonuses for matching certain characters in HAYSTACK." (cl-loop for ch across haystack and i from 0 and lastch = ?/ then ch do - (let ((lut (aref hotfuzz--bonus-prev-luts (aref hotfuzz--bonus-cur-lut ch)))) - (aset hotfuzz--bonus i (aref lut lastch))))) + (aset hotfuzz--bonus i (aref (aref hotfuzz--bonus-lut ch) lastch)))) ;; Aᵢ denotes the prefix a₀,...,aᵢ₋₁ of A (defun hotfuzz--match-row (a b i nc nd pc pd) From a7563c9d08ae23abc05f8a184911ff803e52a54b Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Wed, 8 Nov 2023 10:59:36 +0100 Subject: [PATCH 07/20] Use completion-lazy-hilit Closes #17 --- README.md | 20 ++++++++++---------- hotfuzz.el | 46 +++++++--------------------------------------- test/tests.el | 16 ---------------- 3 files changed, 17 insertions(+), 65 deletions(-) diff --git a/README.md b/README.md index 619bdfe..aba81c4 100644 --- a/README.md +++ b/README.md @@ -19,20 +19,19 @@ Or, if using [Fido], add hotfuzz to the `completion-styles` list this way: (lambda () (setq-local completion-styles '(hotfuzz)))) ``` -**Note:** Highlighting of the matched characters is only applied to +**Note:** Unless the completion UI supports the +`completion-lazy-hilit` variable, as i.a. [Vertico] and [Corfu] do, +then highlighting of the matched characters will only be applied to the first `hotfuzz-max-highlighted-completions` completions, out of -performance concerns. The default value is large enough so that -generally you will need to scroll the list of completions beyond the -second page to first see non-highlighted completions. If you are -annoyed by this you can make it highlight all completions instead -using +performance concerns. The default value is large enough that generally +the list of completions will need to be scrolled beyond the second +page to reach non-highlighted completions. If you are annoyed by this +you can make it highlight all completions instead using ```elisp (setq hotfuzz-max-highlighted-completions most-positive-fixnum) ``` provided you are completing small enough lists and/or do not encounter performance problems. -This is a non-issue when using `hotfuzz-vertico-mode` since -Vertico supports lazy highlighting. ## Customization @@ -98,11 +97,12 @@ to match according to any other completion style. It is very customizable, but does no sorting and allows the individual sub-patterns to overlap (`"foo foo"` filters no additional items compared to `"foo"`). -Hotfuzz on the other hand tries to be more *clever* about sorting, +Hotfuzz on the other hand tries to be more clever about sorting, and so users who dislike that may prefer orderless. [Vertico]: https://github.com/minad/vertico +[Corfu]: https://github.com/minad/corfu +[Ido]: https://www.gnu.org/software/emacs/manual/html_node/ido/index.html [Fido]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html [flx]: https://github.com/lewang/flx -[Ido]: https://www.gnu.org/software/emacs/manual/html_node/ido/index.html [orderless]: https://github.com/oantolin/orderless diff --git a/hotfuzz.el b/hotfuzz.el index 6628c77..bce35da 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -124,8 +124,6 @@ HAYSTACK has to be a match according to `hotfuzz-all-completions'." (add-face-text-property i (1+ i) 'completions-common-part nil haystack)))) haystack) -;;; Completion style implementation - ;;;###autoload (defun hotfuzz-all-completions (string table &optional pred point) "Get hotfuzz-completions of STRING in TABLE. @@ -162,13 +160,12 @@ list before passing it to `display-sort-function' or finally (setq all (mapcar #'cdr (sort all #'car-less-than-car)))))) (when all (unless (string= needle "") - ;; Without deferred highlighting (bug#47711) only highlight - ;; the top completions. - (cl-loop repeat hotfuzz-max-highlighted-completions and for x in-ref all - do (setf x (hotfuzz-highlight needle (copy-sequence x)))) - (when (zerop hotfuzz-max-highlighted-completions) - (setcar all (copy-sequence (car all)))) - (put-text-property 0 1 'completion-sorted t (car all))) + (defvar completion-lazy-hilit-fn) ; Introduced in Emacs 30 (bug#47711) + (if (bound-and-true-p completion-lazy-hilit) + (setq completion-lazy-hilit-fn (apply-partially #'hotfuzz-highlight needle)) + (cl-loop repeat hotfuzz-max-highlighted-completions and for x in-ref all + do (setf x (hotfuzz-highlight needle (copy-sequence x))))) + (setcar all (propertize (car all) 'completion-sorted t))) (if (string= prefix "") all (nconc all (length prefix)))))) (defun hotfuzz--adjust-metadata (metadata) @@ -194,37 +191,8 @@ list before passing it to `display-sort-function' or '(hotfuzz completion-flex-try-completion hotfuzz-all-completions "Fuzzy completion."))) -;;; Vertico integration - -(declare-function vertico--all-completions "ext:vertico") -(declare-function corfu--all-completions "ext:corfu") - -(defun hotfuzz--vertico--all-completions-advice (fun &rest args) - "Advice for FUN `vertico--all-completions' to defer hotfuzz highlighting." - (cl-letf* ((hl nil) - ((symbol-function #'hotfuzz-highlight) - (lambda (pattern cand) - (setq hl (apply-partially - #'mapcar - (lambda (x) (hotfuzz-highlight pattern (copy-sequence x))))) - cand)) - (hotfuzz-max-highlighted-completions 1) - (result (apply fun args))) - (when hl (setcdr result hl)) - result)) - ;;;###autoload -(define-minor-mode hotfuzz-vertico-mode - "Toggle hotfuzz compatibility code for the Vertico&Corfu completion systems. -Contrary to what the name might suggest, this mode does not enable -hotfuzz. You still have to customize e.g. `completion-styles'." - :global t - (if hotfuzz-vertico-mode - (progn - (advice-add #'vertico--all-completions :around #'hotfuzz--vertico--all-completions-advice) - (advice-add #'corfu--all-completions :around #'hotfuzz--vertico--all-completions-advice)) - (advice-remove #'vertico--all-completions #'hotfuzz--vertico--all-completions-advice) - (advice-remove #'corfu--all-completions #'hotfuzz--vertico--all-completions-advice))) +(define-obsolete-function-alias 'hotfuzz-vertico-mode #'ignore "0.1") (provide 'hotfuzz) ;;; hotfuzz.el ends here diff --git a/test/tests.el b/test/tests.el index 62fb3bf..5f5322e 100644 --- a/test/tests.el +++ b/test/tests.el @@ -96,19 +96,3 @@ nil 6) ; Point as in "/usr/s|/man" '("share/" . 5))))) - -;;; Vertico integration - -(ert-deftest vertico--all-completions-advice-test () - (cl-flet ((f (apply-partially - #'hotfuzz--vertico--all-completions-advice - (lambda (&rest args) (cons (apply #'completion-all-completions args) nil))))) - ;; If hotfuzz was not tried or produced no matches: Do not set highlighting fn - (let ((completion-styles '(basic hotfuzz))) - (should (equal (f "x" '("x") nil 1) '(("x" . 0) . nil)))) - (let ((completion-styles '(hotfuzz))) - (should (equal (f "y" '("x") nil 1) '(nil . nil))) - (cl-destructuring-bind (xs . hl) (f "x" '("x") nil 1) - ;; Highlighting should not yet have been applied - (should (equal-including-properties xs '(#("x" 0 1 (completion-sorted t))))) - (should (functionp hl)))))) From e568d338e8e22a343c8785bac0a04925fa4cc743 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Wed, 8 Nov 2023 13:06:17 +0100 Subject: [PATCH 08/20] Add test for completion-lazy-hilit --- test/tests.el | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/test/tests.el b/test/tests.el index 5f5322e..f3a2700 100644 --- a/test/tests.el +++ b/test/tests.el @@ -29,8 +29,7 @@ (ert-deftest tighter-match-cost-test () "Test that matches spanning fewer characters are better." - (should (< (hotfuzz--cost "ab" "xaxbxx") - (hotfuzz--cost "ab" "xaxxbx")))) + (should (< (hotfuzz--cost "ab" "xaxbxx") (hotfuzz--cost "ab" "xaxxbx")))) ;;; Highlighting tests @@ -77,7 +76,12 @@ (last (last candidates))) (when (numberp (cdr last)) (setcdr last nil)) (when sortfun (setq candidates (funcall sortfun candidates))) - (should (equal candidates '("fb" "foo-baz" "foobar"))))) + ;; Completions should be eagerly fontified by default + (should (equal-including-properties + candidates + '(#("fb" 0 2 (completion-sorted t face completions-common-part)) + #("foo-baz" 0 1 (face completions-common-part) 4 5 (face completions-common-part)) + #("foobar" 0 1 (face completions-common-part) 3 4 (face completions-common-part))))))) (ert-deftest boundaries-test () "Test completion on a single field of a filename." @@ -96,3 +100,13 @@ nil 6) ; Point as in "/usr/s|/man" '("share/" . 5))))) + +(defvar completion-lazy-hilit) +(defvar completion-lazy-hilit-fn) +(ert-deftest lazy-hilit-test () + "Test lazy fontification." + (let ((completion-lazy-hilit t) completion-lazy-hilit-fn) + (should (equal-including-properties (hotfuzz-all-completions "x" '("x")) + '(#("x" 0 1 (completion-sorted t))))) + (should (equal-including-properties (funcall completion-lazy-hilit-fn "x") + #("x" 0 1 (face completions-common-part)))))) From 2a4d9d32b3e4ae41b78bdf538352b85b88b39187 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Wed, 8 Nov 2023 13:30:29 +0100 Subject: [PATCH 09/20] Add comparison with fussy --- README.md | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index aba81c4..3297a69 100644 --- a/README.md +++ b/README.md @@ -84,11 +84,20 @@ there is a contiguous match later in the string. The [flx] package - which out-of-the-box only supports [Ido] - has scoring criteria similar to those used by hotfuzz, but works a little differently. -Its bountiful use of caching -means it can be faster at scoring long candidates. +Its bountiful use of caching means it can be faster at scoring long candidates. Since the ordering of completions differs between flx and hotfuzz you are encouraged to try both. +### fussy + +The [fussy] completion style is generic over different fuzzy scoring backends, +flx and the Emacs Lisp implementation of hotfuzz being two of them. +fussy also implements caching of filtered candidates. +Although some of the scoring backends are implemented as dynamic modules, +hotfuzz has the advantage of passing all completion candidates +to its dynamic module en masse, +allowing sorting and filtering to be parallelized. + ### orderless The [orderless] completion style allows @@ -105,4 +114,5 @@ and so users who dislike that may prefer orderless. [Ido]: https://www.gnu.org/software/emacs/manual/html_node/ido/index.html [Fido]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html [flx]: https://github.com/lewang/flx +[fussy]: https://github.com/jojojames/fussy [orderless]: https://github.com/oantolin/orderless From f91c0972cc8887f8e2a123feb96bb5120d2b77c3 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Tue, 5 Dec 2023 20:05:17 +0100 Subject: [PATCH 10/20] Check copy_string_contents return value It can fail if the Lisp string cannot be UTF-8 encoded. --- hotfuzz-module.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/hotfuzz-module.c b/hotfuzz-module.c index 99a5efb..e55af5e 100644 --- a/hotfuzz-module.c +++ b/hotfuzz-module.c @@ -177,7 +177,8 @@ static void bump_free(struct Bump *head) { static struct EmacsStr *copy_emacs_string(emacs_env *env, struct Bump **bump, emacs_value value) { ptrdiff_t len; // Determine the size of the string (including null-terminator) - env->copy_string_contents(env, value, NULL, &len); + if (!env->copy_string_contents(env, value, NULL, &len)) + return NULL; struct EmacsStr *result; // Note: Since only EmacsStr:s are allocated with bump_alloc we From 0d89041ca494432d79e85b0454f21a75c6e21925 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Mon, 4 Dec 2023 18:36:21 +0100 Subject: [PATCH 11/20] Autoload hotfuzz--adjust-metadata An all-completions operation will call the autoloaded function hotfuzz-all-completions, and as such hotfuzz--adjust-metadata gets defined before it is subsequently called. However, for try-completion operations hotfuzz piggybacks on the built-in function completion-flex-try-completion, and so will not be automatically loaded. This commit fixes this by also autoloading hotfuzz--adjust-metadata. An alternative would have been defining an autoloaded alias for completion-flex-try-completion, which, though exposing a redundant symbol, would avoid autoloading a "private" function. --- hotfuzz.el | 1 + 1 file changed, 1 insertion(+) diff --git a/hotfuzz.el b/hotfuzz.el index bce35da..1dfcbcf 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -168,6 +168,7 @@ list before passing it to `display-sort-function' or (setcar all (propertize (car all) 'completion-sorted t))) (if (string= prefix "") all (nconc all (length prefix)))))) +;;;###autoload (defun hotfuzz--adjust-metadata (metadata) "Adjust completion METADATA for hotfuzz sorting." (let ((existing-dsf (completion-metadata-get metadata 'display-sort-function)) From 44d0c23e9cba734c3d65fa1c4d174ca584940b75 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Fri, 12 Apr 2024 21:47:10 +0200 Subject: [PATCH 12/20] Remove the deprecated hotfuzz-vertico-mode --- hotfuzz.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/hotfuzz.el b/hotfuzz.el index 1dfcbcf..bfa39c6 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -24,6 +24,7 @@ ;; linear space." Bioinformatics 4.1 (1988): 11-17. (eval-when-compile (require 'cl-lib)) +(require 'hotfuzz-module nil t) (declare-function hotfuzz--filter-c "hotfuzz-module") (defgroup hotfuzz nil @@ -137,7 +138,7 @@ list before passing it to `display-sort-function' or (bounds (completion-boundaries beforepoint table pred afterpoint)) (prefix (substring beforepoint 0 (car bounds))) (needle (substring beforepoint (car bounds))) - (use-module-p (require 'hotfuzz-module nil t)) + (use-module-p (fboundp 'hotfuzz--filter-c)) (case-fold-search completion-ignore-case) (completion-regexp-list (if use-module-p completion-regexp-list @@ -192,8 +193,5 @@ list before passing it to `display-sort-function' or '(hotfuzz completion-flex-try-completion hotfuzz-all-completions "Fuzzy completion."))) -;;;###autoload -(define-obsolete-function-alias 'hotfuzz-vertico-mode #'ignore "0.1") - (provide 'hotfuzz) ;;; hotfuzz.el ends here From 4dcc70c7840af5475dbd3ba81c5cd5ec09cb0f3d Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Wed, 10 Apr 2024 22:05:46 +0200 Subject: [PATCH 13/20] Add display-sort-function test --- test/tests.el | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/test/tests.el b/test/tests.el index f3a2700..238593b 100644 --- a/test/tests.el +++ b/test/tests.el @@ -1,4 +1,4 @@ -;;; tests.el --- The hotfuzz test suite -*- lexical-binding: t; -*- +;;; tests.el --- The hotfuzz test suite -*- lexical-binding: t -*- (require 'ert) (require 'hotfuzz) @@ -72,10 +72,10 @@ (table '("foobar" "fxxx" "foo-baz" "" "fb")) (meta (completion-metadata s table nil)) (candidates (completion-all-completions s table nil (length s) meta)) - (sortfun (alist-get 'display-sort-function meta)) + (sort-fn (alist-get 'display-sort-function meta)) (last (last candidates))) (when (numberp (cdr last)) (setcdr last nil)) - (when sortfun (setq candidates (funcall sortfun candidates))) + (when sort-fn (setq candidates (funcall sort-fn candidates))) ;; Completions should be eagerly fontified by default (should (equal-including-properties candidates @@ -83,6 +83,19 @@ #("foo-baz" 0 1 (face completions-common-part) 4 5 (face completions-common-part)) #("foobar" 0 1 (face completions-common-part) 3 4 (face completions-common-part))))))) +(ert-deftest display-sort-function-test () + "Test that empty strings apply the completion function `display-sort-function'." + (cl-flet ((sorted-completions (string) + (let* ((completion-styles '(hotfuzz)) + (table '("xbbx" "xx" "xax")) + (md `(metadata (display-sort-function + . ,(lambda (xs) (sort xs #'string<))))) + (all (completion-all-completions + string table nil (length string) md))) + (funcall (alist-get 'display-sort-function md) all)))) + (should (equal (sorted-completions "") '("xax" "xbbx" "xx"))) ; Lexicographically sorted + (should (equal (sorted-completions "xx") '("xx" "xax" "xbbx"))))) + (ert-deftest boundaries-test () "Test completion on a single field of a filename." (let ((completion-styles '(hotfuzz))) @@ -90,13 +103,12 @@ (equal (completion-all-completions "/usr/s/man" - (lambda (string _pred action) + (lambda (string pred action) (let ((dir (file-name-directory string))) (pcase action - ('metadata '(metadata (category . file))) (`(boundaries . ,suffix) `(boundaries ,(length dir) . ,(string-match-p "/" suffix))) - ('t (all-completions "" '("bin/" "share/" "local/")))))) + ('t (all-completions "" '("bin/" "share/" "local/") pred))))) nil 6) ; Point as in "/usr/s|/man" '("share/" . 5))))) From 6236c30cfcc3dc16f99dbb396e0349527bdc44b0 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Wed, 10 Apr 2024 22:06:15 +0200 Subject: [PATCH 14/20] Upgrade GitHub Actions actions --- .github/workflows/test.yml | 8 +++++--- README.md | 2 +- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index e3cbee8..508b4d8 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -10,15 +10,17 @@ jobs: emacs_version: ['27.1', '28.1', 'snapshot'] steps: - name: Set up Emacs - uses: purcell/setup-emacs@master + uses: purcell/setup-emacs@v6.0 with: version: ${{ matrix.emacs_version }} - name: Install Eldev run: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev | sh - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - name: Run tests run: | eldev --trace --color=always compile --warnings-as-errors eldev --loading=built-source --trace --color=always test --undercover codecov,dontsend - name: Upload coverage - uses: codecov/codecov-action@v2 + uses: codecov/codecov-action@v4 + with: + token: ${{ secrets.CODECOV_TOKEN }} diff --git a/README.md b/README.md index 3297a69..ff09d2b 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # hotfuzz [![test](https://github.com/axelf4/hotfuzz/actions/workflows/test.yml/badge.svg)](https://github.com/axelf4/hotfuzz/actions/workflows/test.yml) -[![codecov](https://codecov.io/gh/axelf4/hotfuzz/branch/master/graph/badge.svg?token=OV1BqTB7QL)](https://codecov.io/gh/axelf4/hotfuzz) +[![codecov](https://codecov.io/gh/axelf4/hotfuzz/graph/badge.svg?token=OV1BqTB7QL)](https://codecov.io/gh/axelf4/hotfuzz) [![MELPA](https://melpa.org/packages/hotfuzz-badge.svg)](https://melpa.org/#/hotfuzz) This is a fuzzy Emacs completion style similar to the built-in `flex` style, From 188e2c6c23774614054f8168fca0bb1199c03e0a Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Sun, 7 Apr 2024 21:58:29 +0200 Subject: [PATCH 15/20] Simplify the C implementation * Use conventional fat pointer string slices instead of prepending the string data with the Emacs Lisp value and length. * Try to copy_string_contents into the remaining buffer instead of always calling it once initially to get the required capacity. * Always pad copied Emacs strings to 8 bytes boundaries to remove the strtolower special cases. * Use a signed atomic counter instead of protecting it with a mutex. This makes the worker routine infallible. Also, skip assigning an initial batch to each worker and let them fetch it themselves. --- hotfuzz-module.c | 348 +++++++++++++++++------------------------------ hotfuzz.el | 36 ++--- 2 files changed, 143 insertions(+), 241 deletions(-) diff --git a/hotfuzz-module.c b/hotfuzz-module.c index e55af5e..145f1de 100644 --- a/hotfuzz-module.c +++ b/hotfuzz-module.c @@ -12,8 +12,7 @@ #include #include -#define MIN(a, b) ({ __typeof__(a) _a = (a), _b = (b); _a < _b ? _a : _b; }) -#define MAX(a, b) ({ __typeof__(a) _a = (a), _b = (b); _a > _b ? _a : _b; }) +#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) #define MAX_NEEDLE_LEN 128 #define MAX_HAYSTACK_LEN 512 @@ -21,52 +20,25 @@ int plugin_is_GPL_compatible; -/** An Emacs string made accessible by copying. */ -struct EmacsStr { - emacs_value value; ///< The original string value. - size_t len; ///< The length of the string minus the null byte. - char b[]; ///< The null-terminated copied string. -}; - -static char tolower_utf8(char c) { - return *u8"A" <= c && c <= *u8"Z" ? c + (*u8"a" - *u8"A") : c; -} +struct Str { char *b; size_t len; }; static char toupper_utf8(char c) { return *u8"a" <= c && c <= *u8"z" ? c - (*u8"a" - *u8"A") : c; } - -static uint64_t tolower8(uint64_t x) { - uint64_t ones = 0x0101010101010101, - is_gt_Z = (0x7f * ones & x) + (0x7f - *u8"Z") * ones, - is_ge_A = (0x7f * ones & x) + (0x80 - *u8"A") * ones, - is_upper = 0x80 * ones & ~x & (is_ge_A ^ is_gt_Z); - return x | is_upper >> 2; -} - -static void strtolower(struct EmacsStr *s) { - // Complicated in order to optimize out the calls to tolower_utf8 - // on AMD64 System V with GCC 11.3.0. - - size_t i = 0; - if ((alignof(struct EmacsStr) + offsetof(struct EmacsStr, b)) % alignof(uint64_t)) - for (; ((uintptr_t) s->b + i) % alignof(uint64_t) && i < s->len; ++i) - s->b[i] = tolower_utf8(s->b[i]); - - size_t pad = alignof(struct EmacsStr) - - offsetof(struct EmacsStr, b) % alignof(struct EmacsStr); - for (; i + 8 < s->len + MIN(pad, 8); i += 8) { - uint64_t *x = (uint64_t *) (s->b + i); - *x = tolower8(*x); +static void strtolower(struct Str s) { + uint64_t ones = ~UINT64_C(0) / 0xff, x; + for (size_t i = 0; i < s.len; i += sizeof x) { + memcpy(&x, s.b, sizeof x); + uint64_t is_gt_Z = (0x7f * ones & x) + (0x7f - *u8"Z") * ones, + is_ge_A = (0x7f * ones & x) + (0x80 - *u8"A") * ones, + is_upper = 0x80 * ones & ~x & (is_ge_A ^ is_gt_Z); + x |= is_upper >> 2; + memcpy(s.b, &x, sizeof x); } - - if (pad < 8 - 1) for (; i < s->len; ++i) s->b[i] = tolower_utf8(s->b[i]); } -typedef int cost; - -static cost char_bonus(char prev, char ch) { - cost word_bonus = 80; +static int char_bonus(char prev, char ch) { + int word_bonus = 80; switch (ch) { case 'A' ... 'Z': if ('a' <= prev && prev <= 'z') return word_bonus; @@ -83,86 +55,59 @@ static cost char_bonus(char prev, char ch) { } } -static void calc_bonus(struct EmacsStr *haystack, cost *out) { - char ch, lastch = '/'; - for (size_t i = 0; i < haystack->len; ++i, lastch = ch) - out[i] = char_bonus(lastch, ch = haystack->b[i]); -} - -static void match_row(struct EmacsStr *a, struct EmacsStr *b, cost *bonuses, unsigned i, - cost *nc, cost *nd, cost *pc, cost *pd) { - cost g = 100, h = 5; - size_t m = b->len; - cost oldc, s = i ? g + h * i : 0; +static void match_row(struct Str a, struct Str b, int *bonuses, unsigned i, int *c, int *d) { + int g = 100, h = 5; + size_t m = b.len; + int oldc, s = i ? g + h * i : 0; for (size_t j = 0; j < m; ++j, s = oldc) { - oldc = pc[j]; - nc[j] = MIN(nd[j] = MIN(pd[j], oldc + g) + (j == m - 1 ? h : 2 * h), - a->b[i] == b->b[j] ? s - bonuses[i] : 100000); + oldc = c[j]; + d[j] = MIN(d[j], oldc + g) + (j == m - 1 ? h : 2 * h); + c[j] = MIN(d[j], a.b[i] == b.b[j] ? s - bonuses[i] : 100000); } } -static cost get_cost(struct EmacsStr *needle, struct EmacsStr *haystack, bool ignore_case) { - unsigned n = haystack->len, m = needle->len; - if (n > MAX_HAYSTACK_LEN || m > MAX_NEEDLE_LEN) return 10000; - cost c[MAX_NEEDLE_LEN], d[MAX_NEEDLE_LEN]; - for (unsigned j = 0; j < m; ++j) c[j] = d[j] = 10000; +static int calc_cost(struct Str needle, struct Str haystack, bool ignore_case) { + unsigned n = haystack.len, m = needle.len; + if (n > MAX_HAYSTACK_LEN || m > MAX_NEEDLE_LEN) return 100000; + int c[MAX_NEEDLE_LEN], d[MAX_NEEDLE_LEN]; + for (unsigned j = 0; j < m; ++j) c[j] = d[j] = 100000; - cost bonuses[MAX_HAYSTACK_LEN]; - calc_bonus(haystack, bonuses); + int bonuses[MAX_HAYSTACK_LEN]; + char ch, lastch = '/'; + for (size_t i = 0; i < n; ++i, lastch = ch) + bonuses[i] = char_bonus(lastch, ch = haystack.b[i]); if (ignore_case) strtolower(haystack); for (unsigned i = 0; i < n; ++i) - match_row(haystack, needle, bonuses, i, c, d, c, d); + match_row(haystack, needle, bonuses, i, c, d); return c[m - 1]; } /** - * Returns whether @p haystack matches @p needle. + * Returns whether @a haystack matches @a needle. * * @param needle Null-terminated search string. * @param haystack Null-terminated completion candidate. * @param ignore_case Whether to match case-insensitively. */ static bool is_match(char *needle, char *haystack, bool ignore_case) { - while (*needle) { + while (*needle) if (ignore_case ? (haystack = strpbrk(haystack, (char[]) { *needle, toupper_utf8(*needle), '\0' })) : (haystack = strchr(haystack, *needle))) ++needle, ++haystack; // Skip past matched character else return false; - } return true; } /** Intrusive linked list of bump allocation blocks. */ struct Bump { struct Bump *next; - size_t index, capacity; - char b[]; + char *cursor, *limit, b[]; }; -/** - * Allocates the specified number of bytes. - * - * Returns NULL on failure. - */ -static void *bump_alloc(struct Bump **head, size_t len) { - if (!*head || (*head)->capacity - (*head)->index < len) { - size_t capacity = MAX(*head ? 2 * (*head)->capacity : 1024, len); - struct Bump *new_head; - if (!(new_head = malloc(sizeof *new_head + capacity))) - return NULL; - *new_head = (struct Bump) { .next = *head, .index = 0, .capacity = capacity }; - *head = new_head; - } - - void *p = (*head)->b + (*head)->index; - (*head)->index += len; - return p; -} - static void bump_free(struct Bump *head) { while (head) { struct Bump *next = head->next; @@ -171,31 +116,43 @@ static void bump_free(struct Bump *head) { } } -/** - * Copies the Emacs string to make its lifetime that of the allocator. - */ -static struct EmacsStr *copy_emacs_string(emacs_env *env, struct Bump **bump, emacs_value value) { - ptrdiff_t len; +/** Copies the Emacs string to make its contents accessible. */ +static struct Str copy_emacs_string(emacs_env *env, struct Bump **bump, emacs_value value) { + char *buf = NULL; + ptrdiff_t origlen, len; + if (*bump) { + // Opportunistically try to copy into remaining space + buf = (*bump)->cursor; + len = origlen = (*bump)->limit - (*bump)->cursor; + } // Determine the size of the string (including null-terminator) - if (!env->copy_string_contents(env, value, NULL, &len)) - return NULL; - - struct EmacsStr *result; - // Note: Since only EmacsStr:s are allocated with bump_alloc we - // may use its smaller alignment rather than the scalar maximum. - if (!(result = bump_alloc(bump, sizeof *result + len - + alignof(struct EmacsStr) - 1 & ~(alignof(struct EmacsStr) - 1)))) - return NULL; - - result->value = value; - result->len = len - 1; - env->copy_string_contents(env, value, result->b, &len); - return result; + if (env->copy_string_contents(env, value, buf, &len)) { + if (buf) goto success; + } else { + if (!buf || len == origlen) return (struct Str) { 0 }; + env->non_local_exit_clear(env); + } + + size_t capacity = *bump ? 2 * ((*bump)->limit - (*bump)->b) : 2048; + if (capacity < (size_t) len) capacity = len + alignof(uint64_t) - 1; + struct Bump *new; + if (!(new = malloc(sizeof *new + capacity))) return (struct Str) { 0 }; + *new = (struct Bump) { .next = *bump, .cursor = new->b, .limit = new->b + capacity }; + *bump = new; + + env->copy_string_contents(env, value, buf = new->cursor, &len); +success: + (*bump)->cursor = (char *) (((uintptr_t) (*bump)->cursor + len + + alignof(uint64_t) - 1) & ~(alignof(uint64_t) - 1)); + return (struct Str) { buf, len - 1 }; } struct Candidate { - struct EmacsStr *s; - cost key; + emacs_value value; + union { + struct Str s; + int key; + }; }; static int cmp_candidate(const void *a, const void *b) { @@ -208,139 +165,95 @@ struct Batch { }; struct Shared { - pthread_mutex_t mutex; - bool ignore_case; - struct EmacsStr *needle; - struct Batch *batches, *batches_end; -}; - -struct Worker { - pthread_t thread; - struct Shared *shared; - struct Batch *batch; ///< The initial batch to work on. + const bool ignore_case; + const struct Str needle; + struct Batch *const batches; + _Atomic ssize_t remaining; }; -static enum JobRetVal { - JOB_FINISHED, - JOB_FAILED -} job_finished = JOB_FINISHED, job_failed = JOB_FAILED; - static void *worker_routine(void *ptr) { - struct Worker *worker = ptr; - struct Shared *shared = worker->shared; - struct EmacsStr *needle = shared->needle; - struct Batch *batch = worker->batch; + struct Shared *shared = ptr; + struct Str needle = shared->needle; - do { - unsigned num_matches = 0; + ssize_t batch_idx; + while ((batch_idx = --shared->remaining) >= 0) { + struct Batch *batch = shared->batches + batch_idx; + unsigned n = 0; for (unsigned i = 0; i < batch->len; ++i) { - struct Candidate *candidate = batch->xs + i; - if (!is_match(needle->b, candidate->s->b, shared->ignore_case)) continue; - batch->xs[num_matches++] = (struct Candidate) { - .s = candidate->s, - .key = get_cost(needle, candidate->s, shared->ignore_case), - }; + struct Candidate x = batch->xs[i]; + if (!is_match(needle.b, x.s.b, shared->ignore_case)) continue; + x.key = calc_cost(needle, x.s, shared->ignore_case); + batch->xs[n++] = x; } - batch->len = num_matches; - - // Try to fetch a new batch - if (pthread_mutex_lock(&shared->mutex)) return &job_failed; - batch = shared->batches < shared->batches_end ? shared->batches++ : NULL; - pthread_mutex_unlock(&shared->mutex); - } while (batch); + batch->len = n; + } - return &job_finished; + return NULL; } -/** Module userdata that gets allocated once at initialization. */ +/** Module userdata allocated at initialization. */ struct Data { unsigned max_workers; - struct Worker *workers; + pthread_t threads[]; }; -emacs_value hotfuzz_filter(emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data_ptr) { +static emacs_value hotfuzz_filter(emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data_ptr) { struct Data *data = data_ptr; - emacs_value fcar = env->intern(env, "car"), - fcdr = env->intern(env, "cdr"), - fcons = env->intern(env, "cons"), - nil = env->intern(env, "nil"); + emacs_value fcar = env->intern(env, "car"), fcdr = env->intern(env, "cdr"), + fcons = env->intern(env, "cons"), nil = env->intern(env, "nil"); struct Bump *bump = NULL; int success = false; emacs_value result = nil; // Collect all candidates - emacs_value list = args[1]; struct Batch *batches = NULL; - size_t batch_idx = 0, capacity = 0; - while (env->is_not_nil(env, list)) { - if ((batches && batches[batch_idx].len >= BATCH_SIZE ? ++batch_idx : batch_idx) - >= capacity) { - capacity = capacity ? 2 * capacity : 1; + size_t batch_idx = 0, capacity; + for (emacs_value list = args[1]; env->is_not_nil(env, list); + list = env->funcall(env, fcdr, 1, (emacs_value[]) { list })) { + if (!batches || (batches[batch_idx].len >= BATCH_SIZE && ++batch_idx >= capacity)) { + capacity = batches ? 2 * capacity : 1; struct Batch *new_batches; - if (!(new_batches = realloc(batches, capacity * sizeof *batches))) - goto error; + if (!(new_batches = realloc(batches, capacity * sizeof *batches))) goto err; batches = new_batches; - for (size_t i = batch_idx; i < capacity; ++i) - batches[i].len = 0; + for (size_t i = batch_idx; i < capacity; ++i) batches[i].len = 0; } - emacs_value value = env->funcall(env, fcar, 1, (emacs_value[]) {list}); - struct Batch *b = batches + batch_idx; - if (!(b->xs[b->len++].s = copy_emacs_string(env, &bump, value))) - goto error; - list = env->funcall(env, fcdr, 1, (emacs_value[]) {list}); + emacs_value value = env->funcall(env, fcar, 1, (emacs_value[]) { list }); + struct Batch *batch = batches + batch_idx; + struct Candidate *x = batch->xs + batch->len++; + if (!(x->s = copy_emacs_string(env, &bump, x->value = value)).b) goto err; } if (!batches) return nil; - bool ignore_case = nargs >= 3 && env->is_not_nil(env, args[2]); - struct EmacsStr *needle = copy_emacs_string(env, &bump, args[0]); - if (!needle) goto error; - if (ignore_case) - for (size_t i = 0; i < needle->len; ++i) - needle->b[i] = tolower_utf8(needle->b[i]); + bool ignore_case = env->is_not_nil(env, args[2]); + struct Str needle = copy_emacs_string(env, &bump, args[0]); + if (!needle.b) goto err; + if (ignore_case) strtolower(needle); struct Shared shared = { .ignore_case = ignore_case, .needle = needle, .batches = batches, - .batches_end = batches + batch_idx + 1, + .remaining = batch_idx + 1, }; - if (pthread_mutex_init(&shared.mutex, NULL)) goto error; - if (pthread_mutex_lock(&shared.mutex)) goto mutex_error; - enum JobRetVal res = job_finished; - unsigned worker_count; - - struct Worker *workers = data->workers; - for (worker_count = 0; worker_count < data->max_workers - && shared.batches < shared.batches_end; ++worker_count) { - struct Worker *worker = workers + worker_count; - *worker = (struct Worker) { - .shared = &shared, - .batch = shared.batches++, - }; - - if (pthread_create(&worker->thread, NULL, worker_routine, worker)) { - // Join all workers in order to at least safely destroy mutex - res = job_failed; - break; - } - } - pthread_mutex_unlock(&shared.mutex); + unsigned num_workers = 0; + for (; num_workers < MIN(data->max_workers, batch_idx + 1); ++num_workers) + if (pthread_create(data->threads + num_workers, NULL, worker_routine, &shared)) + // Join all workers in order to at least safely free memory + goto err_join_threads; + success = true; + +err_join_threads: // Wait for all worker threads - for (unsigned i = 0; i < worker_count; ++i) { - enum JobRetVal *retval; - pthread_join(workers[i].thread, (void **) &retval); - res |= *retval; - } - if (res != job_finished) goto mutex_error; + for (unsigned i = 0; i < num_workers; ++i) pthread_join(data->threads[i], NULL); + if (!success) goto err; - success = true; - if (env->process_input(env) == emacs_process_input_quit) goto mutex_error; + if (env->process_input(env) == emacs_process_input_quit) goto err; // Compact all batches size_t len = batches[0].len; struct Candidate *xs = batches[0].xs; - for (struct Batch *b = batches + 1; b < shared.batches_end; ++b) { + for (struct Batch *b = batches + 1; b <= batches + batch_idx; ++b) { unsigned n = b->len; memmove(xs + len, b->xs, n * sizeof *b->xs); len += n; @@ -348,11 +261,9 @@ emacs_value hotfuzz_filter(emacs_env *env, ptrdiff_t nargs, emacs_value args[], qsort(xs, len, sizeof *xs, cmp_candidate); // Sort the completions for (size_t i = len; i-- > 0;) - result = env->funcall(env, fcons, 2, (emacs_value[]) {xs[i].s->value, result}); + result = env->funcall(env, fcons, 2, (emacs_value[]) { xs[i].value, result }); -mutex_error: - pthread_mutex_destroy(&shared.mutex); -error: +err: free(batches); bump_free(bump); @@ -362,27 +273,24 @@ emacs_value hotfuzz_filter(emacs_env *env, ptrdiff_t nargs, emacs_value args[], } int emacs_module_init(struct emacs_runtime *rt) { - // Verify compatability with Emacs executable loading this module - if ((size_t) rt->size < sizeof *rt) - return 1; + // Verify compatibility with the Emacs executable loading this module + if ((size_t) rt->size < sizeof *rt) return 1; emacs_env *env = rt->get_environment(rt); - if ((size_t) env->size < sizeof *env) - return 2; + if ((size_t) env->size < sizeof *env) return 2; - static struct Data data; - data.max_workers = sysconf(_SC_NPROCESSORS_ONLN); - if (!(data.workers = malloc(data.max_workers * sizeof *data.workers))) - return 1; + long max_workers = sysconf(_SC_NPROCESSORS_ONLN); + struct Data *data; + if (!(data = malloc(max_workers * sizeof *data->threads))) return 1; + *data = (struct Data) { max_workers }; env->funcall(env, env->intern(env, "defalias"), 2, (emacs_value[]) { env->intern(env, "hotfuzz--filter-c"), - env->make_function(env, 2, 3, hotfuzz_filter, + env->make_function(env, 3, 3, hotfuzz_filter, "Filter and sort CANDIDATES that match STRING.\n" "\n" - "\(fn STRING CANDIDATES &optional IGNORE-CASE)", - &data), + "\(fn STRING CANDIDATES IGNORE-CASE)", + data), }); - env->funcall(env, env->intern(env, "provide"), 1, (emacs_value[]) { env->intern(env, "hotfuzz-module") }); diff --git a/hotfuzz.el b/hotfuzz.el index bfa39c6..6a9d7f7 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -20,26 +20,23 @@ ;;; Code: -;; See: Myers, Eugene W., and Webb Miller. "Optimal alignments in -;; linear space." Bioinformatics 4.1 (1988): 11-17. +;; See: GOTOH, Osamu. An improved algorithm for matching biological +;; sequences. Journal of molecular biology, 1982, 162.3: 705-708. (eval-when-compile (require 'cl-lib)) (require 'hotfuzz-module nil t) (declare-function hotfuzz--filter-c "hotfuzz-module") -(defgroup hotfuzz nil - "Fuzzy completion style." - :group 'minibuffer) +(defgroup hotfuzz nil "Fuzzy completion style." :group 'minibuffer) (defcustom hotfuzz-max-highlighted-completions 25 "The number of top-ranking completions that should be highlighted. Large values will decrease performance." :type 'integer) -;; Since the vectors are pre-allocated the optimization where -;; symmetricity w.r.t. to insertions/deletions means it suffices to -;; allocate min(#needle, #haystack) for C/D when only calculating the -;; cost does not apply. +;; Pre-allocated vectors make the cost-only calulation optimization +;; where symmetricity w.r.t. insertions/deletions means it suffices to +;; allocate min(#needle, #haystack) for C/D inapplicable. (defconst hotfuzz--max-needle-len 128) (defconst hotfuzz--max-haystack-len 512) (defvar hotfuzz--c (make-vector hotfuzz--max-needle-len 0)) @@ -101,14 +98,12 @@ and ND/PD respectively may alias." (aref c (1- m)))))) ; Final cost (defun hotfuzz-highlight (needle haystack) - "Highlight the characters that NEEDLE matched in HAYSTACK. + "Highlight destructively the characters NEEDLE matched in HAYSTACK. HAYSTACK has to be a match according to `hotfuzz-all-completions'." (let ((n (length haystack)) (m (length needle)) - (c hotfuzz--c) (d hotfuzz--d) + (c (fillarray hotfuzz--c 10000)) (d (fillarray hotfuzz--d 10000)) (case-fold-search completion-ignore-case)) (unless (or (> n hotfuzz--max-haystack-len) (> m hotfuzz--max-needle-len)) - (fillarray c 10000) - (fillarray d 10000) (hotfuzz--calc-bonus haystack) (cl-loop with rows initially @@ -129,12 +124,11 @@ HAYSTACK has to be a match according to `hotfuzz-all-completions'." (defun hotfuzz-all-completions (string table &optional pred point) "Get hotfuzz-completions of STRING in TABLE. See `completion-all-completions' for the semantics of PRED and POINT. -This function prematurely sorts the completions; mutating the returned -list before passing it to `display-sort-function' or -`cycle-sort-function' will lead to inaccuracies." - (unless point (setq point (length string))) +This function prematurely sorts the completions; mutating the result +before passing it to `display-sort-function' or `cycle-sort-function' +will lead to inaccuracies." (let* ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) + (afterpoint (if point (substring string point) "")) (bounds (completion-boundaries beforepoint table pred afterpoint)) (prefix (substring beforepoint 0 (car bounds))) (needle (substring beforepoint (car bounds))) @@ -187,11 +181,11 @@ list before passing it to `display-sort-function' or ;;;###autoload (progn - ;; Why is the Emacs completions API so cursed? - (put 'hotfuzz 'completion--adjust-metadata #'hotfuzz--adjust-metadata) (add-to-list 'completion-styles-alist '(hotfuzz completion-flex-try-completion hotfuzz-all-completions - "Fuzzy completion."))) + "Fuzzy completion.")) + ;; Why is the Emacs completions API so cursed? + (put 'hotfuzz 'completion--adjust-metadata #'hotfuzz--adjust-metadata)) (provide 'hotfuzz) ;;; hotfuzz.el ends here From 1b54d7a6bec39edeafe73796e82944ff75d243fe Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Fri, 5 Apr 2024 20:49:32 +0200 Subject: [PATCH 16/20] Stop defaulting to the "RelWithDebInfo" build type The Nixpkgs build environment i.a. expects CMAKE_BUILD_TYPE to be an empty string (which would set no optimization flags). --- .gitignore | 3 +++ CMakeLists.txt | 19 ++++++------------- README.md | 4 ++-- 3 files changed, 11 insertions(+), 15 deletions(-) diff --git a/.gitignore b/.gitignore index 53f9fce..8c72fed 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,5 @@ /.eldev /Eldev-local + +/build +/hotfuzz-module.so diff --git a/CMakeLists.txt b/CMakeLists.txt index bbd5541..c2f2710 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,17 +1,10 @@ cmake_minimum_required(VERSION 3.19) project(hotfuzz C) -if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) - message(STATUS "Setting build type to 'RelWithDebInfo' as none was specified.") - set(CMAKE_BUILD_TYPE "RelWithDebInfo" CACHE - STRING "Choose the type of build." FORCE) -endif() - -find_program(EMACS_PROGRAM emacs) -if(EMACS_PROGRAM) - get_filename_component(EMACS_PROGRAM ${EMACS_PROGRAM} REALPATH) - get_filename_component(EMACS_PROGRAM_DIR ${EMACS_PROGRAM} DIRECTORY) - get_filename_component(EMACS_PROGRAM_DIR ${EMACS_PROGRAM_DIR} DIRECTORY) +find_program(EMACS_EXECUTABLE emacs) +if(EMACS_EXECUTABLE) + file(REAL_PATH ${EMACS_EXECUTABLE} EMACS_EXECUTABLE) + set(EMACS_PROGRAM_DIR ${EMACS_EXECUTABLE}/../..) endif() find_path(EMACS_INCLUDE_DIR emacs-module.h @@ -26,8 +19,8 @@ find_package(Threads REQUIRED) add_library(hotfuzz-module MODULE hotfuzz-module.c) set_target_properties(hotfuzz-module PROPERTIES C_STANDARD 11 - POSITION_INDEPENDENT_CODE ON + C_STANDARD_REQUIRED ON PREFIX "" LIBRARY_OUTPUT_DIRECTORY ${CMAKE_SOURCE_DIR}) -target_include_directories(hotfuzz-module PRIVATE ${EMACS_INCLUDE_DIR}) +target_include_directories(hotfuzz-module SYSTEM PRIVATE ${EMACS_INCLUDE_DIR}) target_link_libraries(hotfuzz-module PRIVATE Threads::Threads) diff --git a/README.md b/README.md index ff09d2b..bb7be2d 100644 --- a/README.md +++ b/README.md @@ -55,8 +55,8 @@ and run ```sh mkdir build cd build -cmake -DCMAKE_C_FLAGS='-O3 -march=native' .. \ - && cmake --build . +cmake -DCMAKE_BUILD_TYPE=Release -DCMAKE_C_FLAGS=-march=native .. && + cmake --build . ``` and place the resulting shared library somewhere in `load-path`. From ff9d8c047d3911ea3f29677bb61e36b49bccd4db Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Sat, 13 Apr 2024 12:08:42 +0200 Subject: [PATCH 17/20] Reference the -B flag in CMake build instructions This avoids the mkdir/cd dance. --- README.md | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index bb7be2d..aab8a81 100644 --- a/README.md +++ b/README.md @@ -53,10 +53,8 @@ To compile, make sure GCC, CMake and GNU Make or similar are present, and run ```sh -mkdir build -cd build -cmake -DCMAKE_BUILD_TYPE=Release -DCMAKE_C_FLAGS=-march=native .. && - cmake --build . +cmake -B build -DCMAKE_BUILD_TYPE=Release -DCMAKE_C_FLAGS=-march=native . && + cmake --build build ``` and place the resulting shared library somewhere in `load-path`. From 864d07cadb0ecbbf6c296db6ecfbb38358436e21 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Sun, 14 Apr 2024 09:19:48 +0200 Subject: [PATCH 18/20] Specify expected POSIX standard --- hotfuzz-module.c | 9 +++++---- hotfuzz.el | 6 +++--- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/hotfuzz-module.c b/hotfuzz-module.c index 145f1de..a11289c 100644 --- a/hotfuzz-module.c +++ b/hotfuzz-module.c @@ -3,6 +3,7 @@ * * See the Lisp source for an explanation of the algorithm. */ +#define _POSIX_C_SOURCE 200809L #include #include #include @@ -62,7 +63,7 @@ static void match_row(struct Str a, struct Str b, int *bonuses, unsigned i, int for (size_t j = 0; j < m; ++j, s = oldc) { oldc = c[j]; d[j] = MIN(d[j], oldc + g) + (j == m - 1 ? h : 2 * h); - c[j] = MIN(d[j], a.b[i] == b.b[j] ? s - bonuses[i] : 100000); + c[j] = a.b[i] == b.b[j] ? MIN(d[j], s - bonuses[i]) : d[j]; } } @@ -93,9 +94,9 @@ static int calc_cost(struct Str needle, struct Str haystack, bool ignore_case) { */ static bool is_match(char *needle, char *haystack, bool ignore_case) { while (*needle) - if (ignore_case - ? (haystack = strpbrk(haystack, (char[]) { *needle, toupper_utf8(*needle), '\0' })) - : (haystack = strchr(haystack, *needle))) + if (haystack = ignore_case + ? strpbrk(haystack, (char[]) { *needle, toupper_utf8(*needle), '\0' }) + : strchr(haystack, *needle)) ++needle, ++haystack; // Skip past matched character else return false; diff --git a/hotfuzz.el b/hotfuzz.el index 6a9d7f7..50ceaa5 100644 --- a/hotfuzz.el +++ b/hotfuzz.el @@ -34,7 +34,7 @@ Large values will decrease performance." :type 'integer) -;; Pre-allocated vectors make the cost-only calulation optimization +;; Pre-allocated vectors make the cost-only calculation optimization ;; where symmetricity w.r.t. insertions/deletions means it suffices to ;; allocate min(#needle, #haystack) for C/D inapplicable. (defconst hotfuzz--max-needle-len 128) @@ -101,13 +101,13 @@ and ND/PD respectively may alias." "Highlight destructively the characters NEEDLE matched in HAYSTACK. HAYSTACK has to be a match according to `hotfuzz-all-completions'." (let ((n (length haystack)) (m (length needle)) - (c (fillarray hotfuzz--c 10000)) (d (fillarray hotfuzz--d 10000)) (case-fold-search completion-ignore-case)) (unless (or (> n hotfuzz--max-haystack-len) (> m hotfuzz--max-needle-len)) (hotfuzz--calc-bonus haystack) (cl-loop with rows initially - (cl-loop for i below n and pc = c then nc and pd = d then nd + (cl-loop for i below n and pc = (fillarray hotfuzz--c 10000) then nc + and pd = (fillarray hotfuzz--d 10000) then nd and nc = (make-vector m 0) and nd = (make-vector m 0) do (hotfuzz--match-row haystack needle i nc nd pc pd) (push (cons nc nd) rows)) From d8976c48e333ab79911bf368e6604266f0b5c4f6 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Tue, 16 Apr 2024 22:15:08 +0200 Subject: [PATCH 19/20] Fix too small memory allocation --- hotfuzz-module.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/hotfuzz-module.c b/hotfuzz-module.c index a11289c..f5fc27a 100644 --- a/hotfuzz-module.c +++ b/hotfuzz-module.c @@ -94,9 +94,9 @@ static int calc_cost(struct Str needle, struct Str haystack, bool ignore_case) { */ static bool is_match(char *needle, char *haystack, bool ignore_case) { while (*needle) - if (haystack = ignore_case - ? strpbrk(haystack, (char[]) { *needle, toupper_utf8(*needle), '\0' }) - : strchr(haystack, *needle)) + if ((haystack = ignore_case + ? strpbrk(haystack, (char[]) { *needle, toupper_utf8(*needle), '\0' }) + : strchr(haystack, *needle))) ++needle, ++haystack; // Skip past matched character else return false; @@ -281,7 +281,8 @@ int emacs_module_init(struct emacs_runtime *rt) { long max_workers = sysconf(_SC_NPROCESSORS_ONLN); struct Data *data; - if (!(data = malloc(max_workers * sizeof *data->threads))) return 1; + if (!(data = malloc(sizeof *data + max_workers * sizeof *data->threads))) + return 1; *data = (struct Data) { max_workers }; env->funcall(env, env->intern(env, "defalias"), 2, (emacs_value[]) { From 622329477d893a9fc2528a75935cfe1f8614f4bc Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Sun, 21 Apr 2024 09:59:57 +0200 Subject: [PATCH 20/20] Add Consult and dynamic module compatibility note Closes #12 --- README.md | 65 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 29 deletions(-) diff --git a/README.md b/README.md index aab8a81..f11c576 100644 --- a/README.md +++ b/README.md @@ -13,44 +13,35 @@ To use hotfuzz, add it to the `completion-styles` list: ```elisp (setq completion-styles '(hotfuzz)) ``` -Or, if using [Fido], add hotfuzz to the `completion-styles` list this way: +If using [Fido], its insistence on using `flex` needs to be thwarted: ```elisp (add-hook 'icomplete-minibuffer-setup-hook - (lambda () (setq-local completion-styles '(hotfuzz)))) + (lambda () (kill-local-variable 'completion-styles))) ``` -**Note:** Unless the completion UI supports the -`completion-lazy-hilit` variable, as i.a. [Vertico] and [Corfu] do, -then highlighting of the matched characters will only be applied to -the first `hotfuzz-max-highlighted-completions` completions, out of -performance concerns. The default value is large enough that generally -the list of completions will need to be scrolled beyond the second -page to reach non-highlighted completions. If you are annoyed by this -you can make it highlight all completions instead using +## Customization + +The following ordinary Emacs completion options are adhered to: +* `completion-ignore-case` specifies whether matching is case-insignificant. +* The `completions-common-part` face is used to highlight + what characters of a candidate the search string matched. + +Unless the completion UI supports `completion-lazy-hilit`, as i.a. +[Vertico] and [Corfu] do, only the first +`hotfuzz-max-highlighted-completions` completions will be +highlighted out of performance concerns. The default value is large +enough that generally the list of completions will need to be +scrolled beyond the second page to reach non-highlighted +completions, but this optimization may be disabled with: ```elisp (setq hotfuzz-max-highlighted-completions most-positive-fixnum) ``` -provided you are completing small enough lists and/or do not encounter -performance problems. - -## Customization - -Hotfuzz adheres to a few of the default Emacs completion configuration options: -* `completion-ignore-case` specifies whether case should be considered - significant when matching. -* The face `completions-common-part` is used for highlighting the - characters of a candidate that the search string matched. ## Dynamic module Optionally, you may compile the bundled dynamic module -to greatly improve the performance of filtering. -Once the shared object is available in `load-path` -it will automatically be picked up when hotfuzz is loaded, -or you may evaluate `(require 'hotfuzz-module)` -if hotfuzz already has been loaded. -To compile, make sure GCC, CMake and GNU Make or similar are present, -and run +for improved performance. +Ensure GCC, CMake and GNU Make or similar are present, and run ```sh cmake -B build -DCMAKE_BUILD_TYPE=Release -DCMAKE_C_FLAGS=-march=native . && @@ -58,10 +49,26 @@ cmake -B build -DCMAKE_BUILD_TYPE=Release -DCMAKE_C_FLAGS=-march=native . && ``` and place the resulting shared library somewhere in `load-path`. +It will be automatically picked up, +or you may evaluate `(require 'hotfuzz-module)` +if hotfuzz has already been loaded. Unlike the Lisp implementation, the dynamic module uses an unstable sorting algorithm. +> [!NOTE] +> Dynamic modules are unable to access invalid Unicode strings. +> +> [Consult] appends invisible so-called *tofus* to disambiguate +> completions and encode line numbers. Problematically, characters +> outside the Unicode range, unlikely to be matched by a search +> string, are used. Using e.g. the Supplementary Private Use Area-B +> instead circumvents the encoding issues: +> ```elisp +> (setq consult--tofu-char #x100000 +> consult--tofu-range #x00fffe) +> ``` + ## Related projects ### The `flex` completion style @@ -74,8 +81,7 @@ the matched characters in a candidate could look like > x**f**xxx**o**xxx**o**xfoox -which would score low even though -there is a contiguous match later in the string. +which would score low despite the later contiguous match. ### flx @@ -111,6 +117,7 @@ and so users who dislike that may prefer orderless. [Corfu]: https://github.com/minad/corfu [Ido]: https://www.gnu.org/software/emacs/manual/html_node/ido/index.html [Fido]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html +[Consult]: https://github.com/minad/consult [flx]: https://github.com/lewang/flx [fussy]: https://github.com/jojojames/fussy [orderless]: https://github.com/oantolin/orderless