Mercurial > hg > xemacs-beta

comparison lisp/cl.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 3ecd8885ac67
children 1ccc32a20af4
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
267 "Return result of expanding macros at top level of FORM. 267 "Return result of expanding macros at top level of FORM.
268 If FORM is not a macro call, it is returned unchanged. 268 If FORM is not a macro call, it is returned unchanged.
269 Otherwise, the macro is expanded and the expansion is considered 269 Otherwise, the macro is expanded and the expansion is considered
270 in place of FORM. When a non-macro-call results, it is returned. 270 in place of FORM. When a non-macro-call results, it is returned.
271 271
272 The second optional arg ENVIRONMENT species an environment of macro 272 The second optional arg ENVIRONMENT specifies an environment of macro
273 definitions to shadow the loaded ones for use in file byte-compilation." 273 definitions to shadow the loaded ones for use in file byte-compilation."
274 (let ((cl-macro-environment cl-env)) 274 (let ((cl-macro-environment cl-env))
275 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) 275 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
276 (and (symbolp cl-macro) 276 (and (symbolp cl-macro)
277 (cdr (assq (symbol-name cl-macro) cl-env)))) 277 (cdr (assq (symbol-name cl-macro) cl-env))))
315 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) 315 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
316 v)) 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)
321 "Generate a new uninterned symbol.
322 The name is made by appending a number to PREFIX, default \"G\"."
323 (let ((prefix (if (stringp arg) arg "G"))
324 (num (if (integerp arg) arg
325 (prog1 *gensym-counter*
326 (setq *gensym-counter* (1+ *gensym-counter*))))))
327 (make-symbol (format "%s%d" prefix num))))
328
329 (defun gentemp (&optional arg)
330 "Generate a new interned symbol with a unique name.
331 The name is made by appending a number to PREFIX, default \"G\"."
332 (let ((prefix (if (stringp arg) arg "G"))
333 name)
334 (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*)))
335 (setq *gensym-counter* (1+ *gensym-counter*)))
336 (intern name)))
320 337
321 ;;; Numbers. 338 ;;; Numbers.
322 339
323 (defun floatp-safe (x) 340 (defun floatp-safe (x)
324 "Return t if OBJECT is a floating point number. 341 "Return t if OBJECT is a floating point number.
731 748
732 (defvar cl-hacked-flag nil) 749 (defvar cl-hacked-flag nil)
733 (defun cl-hack-byte-compiler () 750 (defun cl-hack-byte-compiler ()
734 (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)) 751 (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
735 (progn 752 (progn
753 (when (not (fboundp 'cl-compile-time-init))
754 (load "cl-macs" nil t))
736 (cl-compile-time-init) ; in cl-macs.el 755 (cl-compile-time-init) ; in cl-macs.el
737 (setq cl-hacked-flag t)))) 756 (setq cl-hacked-flag t))))
738 757
739 ;;; Try it now in case the compiler has already been loaded. 758 ;;; Try it now in case the compiler has already been loaded.
740 (cl-hack-byte-compiler) 759 (cl-hack-byte-compiler)