diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-extra.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-extra.el | 30 |
1 files changed, 14 insertions, 16 deletions
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index b0f9cfdcfa0..3a6def733f3 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -48,6 +48,8 @@ TYPE is a Common Lisp type specifier. \n(fn OBJECT TYPE)" (cond ((eq type 'list) (if (listp x) x (append x nil))) ((eq type 'vector) (if (vectorp x) x (vconcat x))) + ((eq type 'bool-vector) + (if (bool-vector-p x) x (apply #'bool-vector (cl-coerce x 'list)))) ((eq type 'string) (if (stringp x) x (concat x))) ((eq type 'array) (if (arrayp x) x (vconcat x))) ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) @@ -332,10 +334,9 @@ If so, return the true (non-nil) value returned by PREDICATE. ;;;###autoload (defun cl-isqrt (x) - "Return the integer square root of the argument." + "Return the integer square root of the (integer) argument." (if (and (integerp x) (> x 0)) - (let ((g (cond ((<= x 100) 10) ((<= x 10000) 100) - ((<= x 1000000) 1000) (t x))) + (let ((g (ash 2 (/ (logb x) 2))) g2) (while (< (setq g2 (/ (+ g (/ x g)) 2)) g) (setq g g2)) @@ -438,9 +439,7 @@ as an integer unless JUNK-ALLOWED is non-nil." ;; Random numbers. (defun cl--random-time () - (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) - (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) - v)) + (car (time-convert nil t))) ;;;###autoload (autoload 'cl-random-state-p "cl-extra") (cl-defstruct (cl--random-state @@ -472,7 +471,7 @@ Optional second arg STATE is a random-state object." (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) (if (integerp lim) (if (<= lim 512) (% n lim) - (if (> lim 8388607) (setq n (+ (lsh n 9) (cl-random 512 state)))) + (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state)))) (let ((mask 1023)) (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) (if (< (setq n (logand n mask)) lim) n (cl-random lim state)))) @@ -576,9 +575,9 @@ too large if positive or too small if negative)." "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. \n(fn TYPE SEQUENCE...)" (pcase type - (`vector (apply #'vconcat sequences)) - (`string (apply #'concat sequences)) - (`list (apply #'append (append sequences '(nil)))) + ('vector (apply #'vconcat sequences)) + ('string (apply #'concat sequences)) + ('list (apply #'append (append sequences '(nil)))) (_ (error "Not a sequence type name: %S" type)))) ;;; List functions. @@ -596,10 +595,10 @@ too large if positive or too small if negative)." ;;;###autoload (defun cl-list-length (x) "Return the length of list X. Return nil if list is circular." - (let ((n 0) (fast x) (slow x)) - (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) - (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) - (if fast (if (cdr fast) nil (1+ n)) n))) + (cl-check-type x list) + (condition-case nil + (length x) + (circular-list))) ;;;###autoload (defun cl-tailp (sublist list) @@ -742,7 +741,7 @@ including `cl-block' and `cl-eval-when'." (with-eval-after-load 'find-func (defvar find-function-regexp-alist) (add-to-list 'find-function-regexp-alist - `(define-type . cl--typedef-regexp))) + '(define-type . cl--typedef-regexp))) (define-button-type 'cl-help-type :supertype 'help-function-def @@ -940,7 +939,6 @@ Outputs to the current buffer." (run-hooks 'cl-extra-load-hook) ;; Local variables: -;; byte-compile-dynamic: t ;; generated-autoload-file: "cl-loaddefs.el" ;; End: |