diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e415b5edde2..b08fc3d708a 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -186,8 +186,10 @@ (eval-when-compile (require 'cl)) (defun byte-compile-log-lap-1 (format &rest args) -;; (if (aref byte-code-vector 0) -;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well")) + ;; Newer byte codes for stack-ref make the slot 0 non-nil again. + ;; But the "old disassembler" is *really* ancient by now. + ;; (if (aref byte-code-vector 0) + ;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well")) (byte-compile-log-1 (apply 'format format (let (c a) @@ -1512,50 +1514,12 @@ ;; The variable `byte-boolean-vars' is now primitive and updated ;; automatically by DEFVAR_BOOL. -(defmacro byte-opt-update-stack-params (stack-adjust stack-depth lap0 rest lap) - "...macro used by byte-optimize-lapcode..." - `(progn - (byte-compile-log-lap "Before %s [depth = %s]" ,lap0 ,stack-depth) - (cond ((eq (car ,lap0) 'TAG) - ;; A tag can encode the expected stack depth. - (when (cddr ,lap0) - ;; First, check to see if our notion of the current stack - ;; depth agrees with this tag. We don't check at the - ;; beginning of the function, because the presence of - ;; lexical arguments means the first tag will have a - ;; non-zero offset. - (when (and (not (eq ,rest ,lap)) ; not at first insn - ,stack-depth ; not just after a goto - (not (= (cddr ,lap0) ,stack-depth))) - (error "Compiler error: optimizer is confused about %s: - %s != %s at lapcode %s" ',stack-depth (cddr ,lap0) ,stack-depth ,lap0)) - ;; Now set out current depth from this tag - (setq ,stack-depth (cddr ,lap0))) - (setq ,stack-adjust 0)) - ((memq (car ,lap0) '(byte-goto byte-return)) - ;; These insns leave us in an unknown state - (setq ,stack-adjust nil)) - ((car ,lap0) - ;; Not a no-op, set ,stack-adjust for lap0. ,stack-adjust will - ;; be added to ,stack-depth at the end of the loop, so any code - ;; that modifies the instruction sequence must adjust this too. - (setq ,stack-adjust - (byte-compile-stack-adjustment (car ,lap0) (cdr ,lap0))))) - (byte-compile-log-lap "Before %s [depth => %s, adj = %s]" ,lap0 ,stack-depth ,stack-adjust) - )) - (defun byte-optimize-lapcode (lap &optional for-effect) "Simple peephole optimizer. LAP is both modified and returned. If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (let (lap0 lap1 lap2 - stack-adjust - stack-depth - (initial-stack-depth - (if (and lap (eq (car (car lap)) 'TAG)) - (cdr (cdr (car lap))) - 0)) (keep-going 'first-time) (add-depth 0) rest tmp tmp2 tmp3 @@ -1566,15 +1530,12 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (or (eq keep-going 'first-time) (byte-compile-log-lap " ---- next pass")) (setq rest lap - stack-depth initial-stack-depth keep-going nil) (while rest (setq lap0 (car rest) lap1 (nth 1 rest) lap2 (nth 2 rest)) - (byte-opt-update-stack-params stack-adjust stack-depth lap0 rest lap) - ;; You may notice that sequences like "dup varset discard" are ;; optimized but sequences like "dup varset TAG1: discard" are not. ;; You may be tempted to change this; resist that temptation. @@ -1588,22 +1549,22 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ((and (eq 'byte-discard (car lap1)) (memq (car lap0) side-effect-free)) (setq keep-going t) + (setq tmp (aref byte-stack+-info (symbol-value (car lap0)))) (setq rest (cdr rest)) - (cond ((= stack-adjust 1) + (cond ((= tmp 1) (byte-compile-log-lap " %s discard\t-->\t" lap0) (setq lap (delq lap0 (delq lap1 lap)))) - ((= stack-adjust 0) + ((= tmp 0) (byte-compile-log-lap " %s discard\t-->\t discard" lap0) (setq lap (delq lap0 lap))) - ((= stack-adjust -1) + ((= tmp -1) (byte-compile-log-lap " %s discard\t-->\tdiscard discard" lap0) (setcar lap0 'byte-discard) (setcdr lap0 0)) - ((error "Optimizer error: too much on the stack"))) - (setq stack-adjust (1- stack-adjust))) + ((error "Optimizer error: too much on the stack")))) ;; ;; goto*-X X: --> X: ;; @@ -1673,8 +1634,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." byte-stack-set))) (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) (setq keep-going t - rest (cdr rest) - stack-adjust -1) + rest (cdr rest)) (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1))) (setq lap (delq lap0 (delq lap2 lap)))) ;; @@ -1697,8 +1657,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." 'byte-goto-if-not-nil 'byte-goto-if-nil)) (setq lap (delq lap0 lap)) - (setq keep-going t - stack-adjust 0)) + (setq keep-going t)) ;; ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: @@ -1714,8 +1673,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (byte-compile-log-lap " %s %s %s:\t-->\t%s %s:" lap0 lap1 lap2 (cons inverse (cdr lap1)) lap2) - (setq lap (delq lap0 lap) - stack-adjust 0) + (setq lap (delq lap0 lap)) (setcar lap1 inverse) (setq keep-going t))) ;; @@ -1738,8 +1696,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (when (memq (car lap1) byte-goto-always-pop-ops) (setq lap (delq lap0 lap))) (setcar lap1 'byte-goto))) - (setq keep-going t - stack-adjust 0)) + (setq keep-going t)) ;; ;; varref-X varref-X --> varref-X dup ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup @@ -1772,8 +1729,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setq keep-going t) (setcar (car tmp) 'byte-dup) (setcdr (car tmp) 0) - (setq rest tmp - stack-adjust (+ 2 tmp2))) + (setq rest tmp)) ;; ;; TAG1: TAG2: --> TAG1: ;; (and other references to TAG2 are replaced with TAG1) @@ -1840,8 +1796,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) (setcar rest lap1) (setcar (cdr rest) lap0) - (setq keep-going t - stack-adjust 0)) + (setq keep-going t)) ;; ;; varbind-X unbind-N --> discard unbind-(N-1) ;; save-excursion unbind-N --> unbind-(N-1) @@ -1943,8 +1898,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (cdr tmp)))) (setcdr lap1 (car (cdr tmp))) (setq lap (delq lap0 lap)))) - (setq keep-going t - stack-adjust 0)) + (setq keep-going t)) ;; ;; X: varref-Y ... varset-Y goto-X --> ;; X: varref-Y Z: ... dup varset-Y goto-Z @@ -1960,12 +1914,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (eq (car lap2) 'byte-goto) (not (memq (cdr lap2) rest)) ;Backwards jump (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) - (if (eq (car lap1) 'byte-varset) 'byte-varref - ;; 'byte-stack-ref - )) + 'byte-varref) (eq (cdr (car tmp)) (cdr lap1)) - (not (and (eq (car lap1) 'byte-varref) - (memq (car (cdr lap1)) byte-boolean-vars)))) + (not (memq (car (cdr lap1)) byte-boolean-vars))) ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp)) (let ((newtag (byte-compile-make-tag))) (byte-compile-log-lap @@ -2022,15 +1973,10 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." byte-goto-if-not-nil byte-goto byte-goto)))) ) - (setq keep-going t - stack-adjust (and (not (eq (car lap0) 'byte-goto)) -1))) + (setq keep-going t)) ) - - (setq stack-depth - (and stack-depth stack-adjust (+ stack-depth stack-adjust))) (setq rest (cdr rest))) ) - ;; Cleanup stage: ;; Rebuild byte-compile-constants / byte-compile-variables. ;; Simple optimizations that would inhibit other optimizations if they @@ -2038,13 +1984,11 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; need to do more than once. (setq byte-compile-constants nil byte-compile-variables nil) - (setq rest lap - stack-depth initial-stack-depth) + (setq rest lap) (byte-compile-log-lap " ---- final pass") (while rest (setq lap0 (car rest) lap1 (nth 1 rest)) - (byte-opt-update-stack-params stack-adjust stack-depth lap0 rest lap) (if (memq (car lap0) byte-constref-ops) (if (or (eq (car lap0) 'byte-constant) (eq (car lap0) 'byte-constant2)) @@ -2127,7 +2071,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." 'byte-discardN)) (setcdr lap1 (1+ tmp3)) (setcdr (cdr rest) tmp) - (setq stack-adjust 0) (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s" lap0 lap1)) @@ -2148,8 +2091,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) - (setcar lap1 'byte-discardN) - (setq stack-adjust 0)) + (setcar lap1 'byte-discardN)) ;; ;; discardN-preserve-tos-X discardN-preserve-tos-Y --> @@ -2159,7 +2101,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (eq (car lap1) 'byte-discardN-preserve-tos)) (setq lap (delq lap0 lap)) (setcdr lap1 (+ (cdr lap0) (cdr lap1))) - (setq stack-adjust 0) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (car rest))) ;; @@ -2174,14 +2115,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; The byte-code interpreter will pop the stack for us, so ;; we can just leave stuff on it. (setq lap (delq lap0 lap)) - (setq stack-adjust 0) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1)) ) - - (setq stack-depth - (and stack-depth stack-adjust (+ stack-depth stack-adjust))) (setq rest (cdr rest))) - (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth))) lap) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 885424ec726..12dafe274b9 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -771,10 +771,11 @@ This also does some trivial optimizations to make the form prettier." (sublis sub (nreverse decls)) (list (list* 'list '(quote apply) - (list 'function - (list* 'lambda - (append new (cadadr form)) - (sublis sub body))) + (list 'quote + (list 'function + (list* 'lambda + (append new (cadadr form)) + (sublis sub body)))) (nconc (mapcar (function (lambda (x) (list 'list '(quote quote) x))) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index a13e46ccc59..4f2d5df1f54 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -10,7 +10,7 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "60f6b85256416c5f2a0a3954a11523b6") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "2bfbae6523c842d511b8c8d88658825a") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1b42ee1f2ce..94ba46069d5 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1,4 +1,4 @@ -;;; minibuffer.el --- Minibuffer completion functions +;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*- ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. @@ -133,8 +133,8 @@ the closest directory separators." "Apply FUN to each element of XS in turn. Return the first non-nil returned value. Like CL's `some'." - (lexical-let ((firsterror nil) - res) + (let ((firsterror nil) + res) (while (and (not res) xs) (condition-case err (setq res (funcall fun (pop xs))) @@ -171,12 +171,11 @@ FUN will be called in the buffer from which the minibuffer was entered. The result of the `completion-table-dynamic' form is a function that can be used as the COLLECTION argument to `try-completion' and `all-completions'. See Info node `(elisp)Programmed Completion'." - (lexical-let ((fun fun)) - (lambda (string pred action) - (with-current-buffer (let ((win (minibuffer-selected-window))) - (if (window-live-p win) (window-buffer win) - (current-buffer))) - (complete-with-action action (funcall fun string) string pred))))) + (lambda (string pred action) + (with-current-buffer (let ((win (minibuffer-selected-window))) + (if (window-live-p win) (window-buffer win) + (current-buffer))) + (complete-with-action action (funcall fun string) string pred)))) (defmacro lazy-completion-table (var fun) "Initialize variable VAR as a lazy completion table. @@ -201,19 +200,18 @@ You should give VAR a non-nil `risky-local-variable' property." ;; Notice that `pred' may not be a function in some abusive cases. (when (functionp pred) (setq pred - (lexical-let ((pred pred)) - ;; Predicates are called differently depending on the nature of - ;; the completion table :-( - (cond - ((vectorp table) ;Obarray. - (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) - ((hash-table-p table) - (lambda (s v) (funcall pred (concat prefix s)))) - ((functionp table) - (lambda (s) (funcall pred (concat prefix s)))) - (t ;Lists and alists. - (lambda (s) - (funcall pred (concat prefix (if (consp s) (car s) s))))))))) + ;; Predicates are called differently depending on the nature of + ;; the completion table :-( + (cond + ((vectorp table) ;Obarray. + (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) + ((hash-table-p table) + (lambda (s v) (funcall pred (concat prefix s)))) + ((functionp table) + (lambda (s) (funcall pred (concat prefix s)))) + (t ;Lists and alists. + (lambda (s) + (funcall pred (concat prefix (if (consp s) (car s) s)))))))) (if (eq (car-safe action) 'boundaries) (let* ((len (length prefix)) (bound (completion-boundaries string table pred (cdr action)))) @@ -288,11 +286,10 @@ Note: TABLE needs to be a proper completion table which obeys predicates." (t (or (complete-with-action action table string (if (null pred2) pred1 - (lexical-let ((pred1 pred2) (pred2 pred2)) - (lambda (x) - ;; Call `pred1' first, so that `pred2' - ;; really can't tell that `x' is in table. - (if (funcall pred1 x) (funcall pred2 x)))))) + (lambda (x) + ;; Call `pred1' first, so that `pred2' + ;; really can't tell that `x' is in table. + (if (funcall pred1 x) (funcall pred2 x))))) ;; If completion failed and we're not applying pred1 strictly, try ;; again without pred1. (and (not strict) @@ -302,11 +299,10 @@ Note: TABLE needs to be a proper completion table which obeys predicates." "Create a completion table that tries each table in TABLES in turn." ;; FIXME: the boundaries may come from TABLE1 even when the completion list ;; is returned by TABLE2 (because TABLE1 returned an empty list). - (lexical-let ((tables tables)) - (lambda (string pred action) - (completion--some (lambda (table) - (complete-with-action action table string pred)) - tables)))) + (lambda (string pred action) + (completion--some (lambda (table) + (complete-with-action action table string pred)) + tables))) ;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b)) ;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun)) @@ -548,16 +544,15 @@ E = after completion we now have an Exact match. 101 5 ??? impossible 110 6 some completion happened 111 7 completed to an exact completion" - (lexical-let* - ((beg (field-beginning)) - (end (field-end)) - (string (buffer-substring beg end)) - (comp (funcall (or try-completion-function - 'completion-try-completion) - string - minibuffer-completion-table - minibuffer-completion-predicate - (- (point) beg)))) + (let* ((beg (field-beginning)) + (end (field-end)) + (string (buffer-substring beg end)) + (comp (funcall (or try-completion-function + 'completion-try-completion) + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) beg)))) (cond ((null comp) (minibuffer-hide-completions) @@ -572,13 +567,12 @@ E = after completion we now have an Exact match. ;; `completed' should be t if some completion was done, which doesn't ;; include simply changing the case of the entered string. However, ;; for appearance, the string is rewritten if the case changes. - (lexical-let* - ((comp-pos (cdr comp)) - (completion (car comp)) - (completed (not (eq t (compare-strings completion nil nil - string nil nil t)))) - (unchanged (eq t (compare-strings completion nil nil - string nil nil nil)))) + (let* ((comp-pos (cdr comp)) + (completion (car comp)) + (completed (not (eq t (compare-strings completion nil nil + string nil nil t)))) + (unchanged (eq t (compare-strings completion nil nil + string nil nil nil)))) (if unchanged (goto-char end) ;; Insert in minibuffer the chars we got. @@ -759,8 +753,8 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', `minibuffer-confirm-exit-commands', and accept the input otherwise." (interactive) - (lexical-let ((beg (field-beginning)) - (end (field-end))) + (let ((beg (field-beginning)) + (end (field-end))) (cond ;; Allow user to specify null string ((= beg end) (exit-minibuffer)) @@ -1137,14 +1131,14 @@ variables.") "Display a list of possible completions of the current minibuffer contents." (interactive) (message "Making completion list...") - (lexical-let* ((start (field-beginning)) - (end (field-end)) - (string (field-string)) - (completions (completion-all-completions - string - minibuffer-completion-table - minibuffer-completion-predicate - (- (point) (field-beginning))))) + (let* ((start (field-beginning)) + (end (field-end)) + (string (field-string)) + (completions (completion-all-completions + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) (field-beginning))))) (message nil) (if (and completions (or (consp (cdr completions)) @@ -1619,8 +1613,8 @@ and `read-file-name-function'." ;; just use `default-directory', but in order to avoid ;; changing `default-directory' in the current buffer, ;; we don't let-bind it. - (lexical-let ((dir (file-name-as-directory - (expand-file-name dir)))) + (let ((dir (file-name-as-directory + (expand-file-name dir)))) (minibuffer-with-setup-hook (lambda () (setq default-directory dir) @@ -1719,7 +1713,7 @@ and `read-file-name-function'." "Perform completion on all buffers excluding BUFFER. BUFFER nil or omitted means use the current buffer. Like `internal-complete-buffer', but removes BUFFER from the completion list." - (lexical-let ((except (if (stringp buffer) buffer (buffer-name buffer)))) + (let ((except (if (stringp buffer) buffer (buffer-name buffer)))) (apply-partially 'completion-table-with-predicate 'internal-complete-buffer (lambda (name) @@ -1791,10 +1785,9 @@ Return the new suffix." (substring afterpoint 0 (cdr bounds))))) (defun completion-basic-try-completion (string table pred point) - (lexical-let* - ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) - (bounds (completion-boundaries beforepoint table pred afterpoint))) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint))) (if (zerop (cdr bounds)) ;; `try-completion' may return a subtly different result ;; than `all+merge', so try to use it whenever possible. @@ -1805,30 +1798,28 @@ Return the new suffix." (concat completion (completion--merge-suffix completion point afterpoint)) (length completion)))) - (lexical-let* - ((suffix (substring afterpoint (cdr bounds))) - (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) - (all (completion-pcm--all-completions prefix pattern table pred))) + (let* ((suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (pattern (delete + "" (list (substring beforepoint (car bounds)) + 'point + (substring afterpoint 0 (cdr bounds))))) + (all (completion-pcm--all-completions prefix pattern table pred))) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) (completion-pcm--merge-try pattern all prefix suffix))))) (defun completion-basic-all-completions (string table pred point) - (lexical-let* - ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) - (bounds (completion-boundaries beforepoint table pred afterpoint)) - (suffix (substring afterpoint (cdr bounds))) - (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) - (all (completion-pcm--all-completions prefix pattern table pred))) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (pattern (delete + "" (list (substring beforepoint (car bounds)) + 'point + (substring afterpoint 0 (cdr bounds))))) + (all (completion-pcm--all-completions prefix pattern table pred))) (completion-hilit-commonality all point (car bounds)))) ;;; Partial-completion-mode style completion. @@ -1991,13 +1982,12 @@ POINT is a position inside STRING. FILTER is a function applied to the return value, that can be used, e.g. to filter out additional entries (because TABLE migth not obey PRED)." (unless filter (setq filter 'identity)) - (lexical-let* - ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) - (bounds (completion-boundaries beforepoint table pred afterpoint)) - (prefix (substring beforepoint 0 (car bounds))) - (suffix (substring afterpoint (cdr bounds))) - firsterror) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (prefix (substring beforepoint 0 (car bounds))) + (suffix (substring afterpoint (cdr bounds))) + firsterror) (setq string (substring string (car bounds) (+ point (cdr bounds)))) (let* ((relpoint (- point (car bounds))) (pattern (completion-pcm--string->pattern string relpoint))