Mercurial > hg > xemacs-beta

comparison lisp/cl.el @ 1983:9c872f33ecbe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-04-05 22:49:31 by james] Add bignum, ratio, and bigfloat support.
author james
date Mon, 05 Apr 2004 22:50:11 +0000
parents 023b83f4e54b
children 0f60caa73962
comparison
equal deleted inserted replaced
1982:a748951fd4fb 1983:9c872f33ecbe
149 ;;; Predicates. 149 ;;; Predicates.
150 150
151 (defun eql (a b) ; See compiler macro in cl-macs.el 151 (defun eql (a b) ; See compiler macro in cl-macs.el
152 "Return t if the two args are the same Lisp object. 152 "Return t if the two args are the same Lisp object.
153 Floating-point numbers of equal value are `eql', but they may not be `eq'." 153 Floating-point numbers of equal value are `eql', but they may not be `eq'."
154 (if (floatp a) 154 (or (eq a b)
155 (equal a b) 155 (and (numberp a) (numberp b) (equal a b))))
156 (eq a b)))
157
158 156
159 ;;; Generalized variables. These macros are defined here so that they 157 ;;; Generalized variables. These macros are defined here so that they
160 ;;; can safely be used in .emacs files. 158 ;;; can safely be used in .emacs files.
161 159
162 (defmacro incf (place &optional x) 160 (defmacro incf (place &optional x)
311 ;;; Symbols. 309 ;;; Symbols.
312 310
313 (defun cl-random-time () 311 (defun cl-random-time ()
314 (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) 312 (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
315 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) 313 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
316 v)) 314 (if (featurep 'number-types)
315 (coerce-number v 'fixnum)
316 v)))
317 317
318 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) 318 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
319 319
320 (defun gensym (&optional arg) 320 (defun gensym (&optional arg)
321 "Generate a new uninterned symbol. 321 "Generate a new uninterned symbol.
362 (if (>= number 0) number (- number))) 362 (if (>= number 0) number (- number)))
363 (or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19 363 (or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19
364 364
365 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) 365 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
366 366
367 ;; These constants are defined in C when 'number-types is provided.
368 (unless (featurep 'number-types)
367 ;;; We use `eval' in case VALBITS differs from compile-time to load-time. 369 ;;; We use `eval' in case VALBITS differs from compile-time to load-time.
368 (defconst most-positive-fixnum (eval '(lsh -1 -1)) 370 (defconst most-positive-fixnum (eval '(lsh -1 -1))
369 "The integer closest in value to positive infinity.") 371 "The integer closest in value to positive infinity.")
370 (defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1))) 372 (defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1)))
371 "The integer closest in value to negative infinity.") 373 "The integer closest in value to negative infinity."))
372 374
373 ;;; The following are set by code in cl-extra.el 375 ;;; The following are set by code in cl-extra.el
374 (defconst most-positive-float nil 376 (defconst most-positive-float nil
375 "The float closest in value to positive infinity.") 377 "The float closest in value to positive infinity.")
376 (defconst most-negative-float nil 378 (defconst most-negative-float nil