diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-extra.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-extra.el | 58 |
1 files changed, 43 insertions, 15 deletions
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 1d2c8bf1f0d..584945dae59 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -69,6 +69,7 @@ TYPE is a Common Lisp type specifier. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively." + (declare (side-effect-free error-free)) (cond ((eq x y) t) ((stringp x) (and (stringp y) (string-equal-ignore-case x y))) @@ -126,10 +127,11 @@ strings case-insensitively." (and acc (nreverse cl-res))))) ;;;###autoload -(defun cl-map (cl-type cl-func cl-seq &rest cl-rest) +(defsubst cl-map (cl-type cl-func cl-seq &rest cl-rest) "Map a FUNCTION across one or more SEQUENCEs, returning a sequence. TYPE is the sequence type to return. \n(fn TYPE FUNCTION SEQUENCE...)" + (declare (important-return-value t)) (let ((cl-res (apply #'cl-mapcar cl-func cl-seq cl-rest))) (and cl-type (cl-coerce cl-res cl-type)))) @@ -139,6 +141,7 @@ TYPE is the sequence type to return. Like `cl-mapcar', except applies to lists and their cdr's rather than to the elements themselves. \n(fn FUNCTION LIST...)" + (declare (important-return-value t)) (if cl-rest (let ((cl-res nil) (cl-args (cons cl-list (copy-sequence cl-rest))) @@ -188,6 +191,7 @@ the elements themselves. (defun cl-mapcan (cl-func cl-seq &rest cl-rest) "Like `cl-mapcar', but nconc's together the values returned by the function. \n(fn FUNCTION SEQUENCE...)" + (declare (important-return-value t)) (if cl-rest (apply #'nconc (apply #'cl-mapcar cl-func cl-seq cl-rest)) (mapcan cl-func cl-seq))) @@ -196,6 +200,7 @@ the elements themselves. (defun cl-mapcon (cl-func cl-list &rest cl-rest) "Like `cl-maplist', but nconc's together the values returned by the function. \n(fn FUNCTION LIST...)" + (declare (important-return-value t)) (apply #'nconc (apply #'cl-maplist cl-func cl-list cl-rest))) ;;;###autoload @@ -206,6 +211,7 @@ same as the first return value of PREDICATE where PREDICATE has a non-nil value. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (if (or cl-rest (nlistp cl-seq)) (catch 'cl-some (apply #'cl-map nil @@ -221,6 +227,7 @@ non-nil value. (defun cl-every (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of every element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (if (or cl-rest (nlistp cl-seq)) (catch 'cl-every (apply #'cl-map nil @@ -232,15 +239,17 @@ non-nil value. (null cl-seq))) ;;;###autoload -(defun cl-notany (cl-pred cl-seq &rest cl-rest) +(defsubst cl-notany (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of every element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (not (apply #'cl-some cl-pred cl-seq cl-rest))) ;;;###autoload -(defun cl-notevery (cl-pred cl-seq &rest cl-rest) +(defsubst cl-notevery (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of some element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (not (apply #'cl-every cl-pred cl-seq cl-rest))) ;;;###autoload @@ -317,6 +326,7 @@ non-nil value. ;;;###autoload (defun cl-gcd (&rest args) "Return the greatest common divisor of the arguments." + (declare (side-effect-free t)) (let ((a (or (pop args) 0))) (dolist (b args) (while (/= b 0) @@ -326,6 +336,7 @@ non-nil value. ;;;###autoload (defun cl-lcm (&rest args) "Return the least common multiple of the arguments." + (declare (side-effect-free t)) (if (memq 0 args) 0 (let ((a (or (pop args) 1))) @@ -336,6 +347,7 @@ non-nil value. ;;;###autoload (defun cl-isqrt (x) "Return the integer square root of the (integer) argument X." + (declare (side-effect-free t)) (if (and (integerp x) (> x 0)) (let ((g (ash 2 (/ (logb x) 2))) g2) @@ -348,6 +360,7 @@ non-nil value. (defun cl-floor (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." + (declare (side-effect-free t)) (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) @@ -355,6 +368,7 @@ With two arguments, return floor and remainder of their quotient." (defun cl-ceiling (x &optional y) "Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient." + (declare (side-effect-free t)) (let ((res (cl-floor x y))) (if (= (car (cdr res)) 0) res (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) @@ -363,6 +377,7 @@ With two arguments, return ceiling and remainder of their quotient." (defun cl-truncate (x &optional y) "Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient." + (declare (side-effect-free t)) (if (eq (>= x 0) (or (null y) (>= y 0))) (cl-floor x y) (cl-ceiling x y))) @@ -370,13 +385,14 @@ With two arguments, return truncation and remainder of their quotient." (defun cl-round (x &optional y) "Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient." + (declare (side-effect-free t)) (if y (if (and (integerp x) (integerp y)) (let* ((hy (/ y 2)) (res (cl-floor (+ x hy) y))) (if (and (= (car (cdr res)) 0) (= (+ hy hy) y) - (/= (% (car res) 2) 0)) + (oddp (car res))) (list (1- (car res)) hy) (list (car res) (- (car (cdr res)) hy)))) (let ((q (round (/ x y)))) @@ -388,16 +404,19 @@ With two arguments, return rounding and remainder of their quotient." ;;;###autoload (defun cl-mod (x y) "The remainder of X divided by Y, with the same sign as Y." + (declare (side-effect-free t)) (nth 1 (cl-floor x y))) ;;;###autoload (defun cl-rem (x y) "The remainder of X divided by Y, with the same sign as X." + (declare (side-effect-free t)) (nth 1 (cl-truncate x y))) ;;;###autoload (defun cl-signum (x) "Return 1 if X is positive, -1 if negative, 0 if zero." + (declare (side-effect-free t)) (cond ((> x 0) 1) ((< x 0) -1) (t 0))) ;;;###autoload @@ -422,8 +441,8 @@ as an integer unless JUNK-ALLOWED is non-nil." (setq start (1+ start))))) (skip-whitespace) (let ((sign (cl-case (and (< start end) (aref string start)) - (?+ (cl-incf start) +1) - (?- (cl-incf start) -1) + (?+ (incf start) +1) + (?- (incf start) -1) (t +1))) digit sum) (while (and (< start end) @@ -441,12 +460,13 @@ as an integer unless JUNK-ALLOWED is non-nil." ;; Random numbers. (defun cl--random-time () - "Return high-precision timestamp from `time-convert'. + "Return high-precision timestamp from `time-convert'. For example, suitable for use as seed by `cl-make-random-state'." - (car (time-convert nil t))) + (car (time-convert nil t))) ;;;###autoload (autoload 'cl-random-state-p "cl-extra") +;;;###autoload (function-put 'cl-random-state-p 'side-effect-free 'error-free) (cl-defstruct (cl--random-state (:copier nil) (:predicate cl-random-state-p) @@ -549,7 +569,8 @@ If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. Signal an error if START or END are outside of the sequence (i.e too large if positive or too small if negative)." - (declare (gv-setter + (declare (side-effect-free t) + (gv-setter (lambda (new) (macroexp-let2 nil new new `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) @@ -568,19 +589,21 @@ too large if positive or too small if negative)." ;;; List functions. ;;;###autoload -(defun cl-revappend (x y) +(defsubst cl-revappend (x y) "Equivalent to (append (reverse X) Y)." (declare (side-effect-free t)) (nconc (reverse x) y)) ;;;###autoload -(defun cl-nreconc (x y) +(defsubst cl-nreconc (x y) "Equivalent to (nconc (nreverse X) Y)." + (declare (important-return-value t)) (nconc (nreverse x) y)) ;;;###autoload (defun cl-list-length (x) "Return the length of list X. Return nil if list is circular." + (declare (side-effect-free t)) (cl-check-type x list) (condition-case nil (length x) @@ -599,7 +622,8 @@ too large if positive or too small if negative)." (defun cl-get (sym tag &optional def) "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \n(fn SYMBOL PROPNAME &optional DEFAULT)" - (declare (compiler-macro cl--compiler-macro-get) + (declare (side-effect-free t) + (compiler-macro cl--compiler-macro-get) (gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store)))) (cl-getf (symbol-plist sym) tag def)) (autoload 'cl--compiler-macro-get "cl-macs") @@ -609,7 +633,8 @@ too large if positive or too small if negative)." "Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. \n(fn PROPLIST PROPNAME &optional DEFAULT)" - (declare (gv-expander + (declare (side-effect-free t) + (gv-expander (lambda (do) (gv-letplace (getter setter) plist (macroexp-let2* nil ((k tag) (d def)) @@ -722,7 +747,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (define-button-type 'cl-type-definition :supertype 'help-function-def - 'help-echo (purecopy "mouse-2, RET: find type definition")) + 'help-echo "mouse-2, RET: find type definition") (declare-function help-fns-short-filename "help-fns" (filename)) @@ -733,6 +758,8 @@ PROPLIST is a list of the sort returned by `symbol-plist'. Call `cl--find-class' to get TYPE's propname `cl--class'" (cl--find-class type)) +(declare-function help-fns--setup-xref-backend "help-fns" ()) + ;;;###autoload (defun cl-describe-type (type &optional _buf _frame) "Display the documentation for type TYPE (a symbol)." @@ -753,6 +780,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" ;; cl-deftype). (user-error "Unknown type %S" type)))) (with-current-buffer standard-output + (help-fns--setup-xref-backend) ;; Return the text we displayed. (buffer-string))))) @@ -880,7 +908,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" `(space :align-to ,(+ col col-space))) "%s") formats) - (cl-incf col (+ col-space (aref cols i)))) + (incf col (+ col-space (aref cols i)))) (let ((format (mapconcat #'identity (nreverse formats)))) (insert (apply #'format format (mapcar (lambda (str) (propertize str 'face 'italic)) |