;;; cl.el --- Common Lisp extensions for Emacs
-;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
"Increment PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The return value is the incremented value of PLACE."
+ (declare (debug (place &optional form)))
(if (symbolp place)
(list 'setq place (if x (list '+ place x) (list '1+ place)))
(list 'callf '+ place (or x 1))))
"Decrement PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The return value is the decremented value of PLACE."
+ (declare (debug incf))
(if (symbolp place)
(list 'setq place (if x (list '- place x) (list '1- place)))
(list 'callf '- place (or x 1))))
Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
careful about evaluating each argument only once and in the right order.
PLACE may be a symbol, or any generalized variable allowed by `setf'."
+ (declare (debug (place)))
(if (symbolp place)
(list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))
(cl-do-pop place)))
Analogous to (setf PLACE (cons X PLACE)), though more careful about
evaluating each argument only once and in the right order. PLACE may
be a symbol, or any generalized variable allowed by `setf'."
+ (declare (debug (form place)))
(if (symbolp place) (list 'setq place (list 'cons x place))
(list 'callf2 'cons x place)))
an element already on the list.
\nKeywords supported: :test :test-not :key
\n(fn X PLACE [KEYWORD VALUE]...)"
+ (declare (debug
+ (form place &rest
+ &or [[&or ":test" ":test-not" ":key"] function-form]
+ [keywordp form])))
(if (symbolp place)
(if (null keys)
`(let ((x ,x))
- (if (memql x ,place) ,place (setq ,place (cons x ,place))))
+ (if (memql x ,place)
+ ;; This symbol may later on expand to actual code which then
+ ;; trigger warnings like "value unused" since pushnew's return
+ ;; value is rarely used. It should not matter that other
+ ;; warnings may be silenced, since `place' is used earlier and
+ ;; should have triggered them already.
+ (with-no-warnings ,place)
+ (setq ,place (cons x ,place))))
(list 'setq place (list* 'adjoin x place keys)))
(list* 'callf2 'adjoin x place keys)))
(defvar cl-compiling-file nil)
(defun cl-compiling-file ()
(or cl-compiling-file
- (and (boundp 'bytecomp-outbuffer)
- (bufferp (symbol-value 'bytecomp-outbuffer))
- (equal (buffer-name (symbol-value 'bytecomp-outbuffer))
+ (and (boundp 'byte-compile--outbuffer)
+ (bufferp (symbol-value 'byte-compile--outbuffer))
+ (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
" *Compiler Output*"))))
(defvar cl-proclaims-deferred nil)
(while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
v))
-(defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
+(defvar cl--gensym-counter (* (logand (cl-random-time) 1023) 100))
;;; Numbers.
"Return t if INTEGER is even."
(eq (logand integer 1) 0))
-(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
-
-;; The following are actually set by cl-float-limits.
-(defconst most-positive-float nil)
-(defconst most-negative-float nil)
-(defconst least-positive-float nil)
-(defconst least-negative-float nil)
-(defconst least-positive-normalized-float nil)
-(defconst least-negative-normalized-float nil)
-(defconst float-epsilon nil)
-(defconst float-negative-epsilon nil)
+(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl-random-time)))
+
+(defconst most-positive-float nil
+ "The largest value that a Lisp float can hold.
+If your system supports infinities, this is the largest finite value.
+For IEEE machines, this is approximately 1.79e+308.
+Call `cl-float-limits' to set this.")
+
+(defconst most-negative-float nil
+ "The largest negative value that a Lisp float can hold.
+This is simply -`most-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst least-positive-float nil
+ "The smallest value greater than zero that a Lisp float can hold.
+For IEEE machines, it is about 4.94e-324 if denormals are supported,
+or 2.22e-308 if they are not.
+Call `cl-float-limits' to set this.")
+
+(defconst least-negative-float nil
+ "The smallest value less than zero that a Lisp float can hold.
+This is simply -`least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst least-positive-normalized-float nil
+ "The smallest normalized Lisp float greater than zero.
+This is the smallest value for which IEEE denormalization does not lose
+precision. For IEEE machines, this value is about 2.22e-308.
+For machines that do not support the concept of denormalization
+and gradual underflow, this constant equals `least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst least-negative-normalized-float nil
+ "The smallest normalized Lisp float less than zero.
+This is simply -`least-positive-normalized-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst float-epsilon nil
+ "The smallest positive float that adds to 1.0 to give a distinct value.
+Adding a number less than this to 1.0 returns 1.0 due to roundoff.
+For IEEE machines, epsilon is about 2.22e-16.
+Call `cl-float-limits' to set this.")
+
+(defconst float-negative-epsilon nil
+ "The smallest positive float that subtracts from 1.0 to give a distinct value.
+For IEEE machines, it is about 1.11e-16.
+Call `cl-float-limits' to set this.")
;;; Sequence functions.
(if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
((or (equal cl-keys '(:test equal)) (null cl-keys))
(if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
- (t (apply 'cl-adjoin cl-item cl-list cl-keys))))
+ (t (apply 'cl--adjoin cl-item cl-list cl-keys))))
(defun subst (cl-new cl-old cl-tree &rest cl-keys)
"Substitute NEW for OLD everywhere in TREE (non-destructively).
;;; Miscellaneous.
-;; Define data for indentation and edebug.
-(dolist (entry
- '(((defun* defmacro*) 2)
- ((function*) nil
- (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
- ((eval-when) 1 (sexp &rest form))
- ((declare) nil (&rest sexp))
- ((the) 1 (sexp &rest form))
- ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
- ((block return-from) 1 (sexp &rest form))
- ((return) nil (&optional form))
- ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
- (form &rest form)
- &rest form))
- ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
- ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
- ((psetq setf psetf) nil edebug-setq-form)
- ((progv) 2 (&rest form))
- ((flet labels macrolet) 1
- ((&rest (sexp sexp &rest form)) &rest form))
- ((symbol-macrolet lexical-let lexical-let*) 1
- ((&rest &or symbolp (symbolp form)) &rest form))
- ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
- ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
- ((incf decf remf pushnew shiftf rotatef) nil (&rest form))
- ((letf letf*) 1 ((&rest (&rest form)) &rest form))
- ((callf destructuring-bind) 2 (sexp form &rest form))
- ((callf2) 3 (sexp form form &rest form))
- ((loop) nil (&rest &or symbolp form))
- ((ignore-errors) 0 (&rest form))))
- (dolist (func (car entry))
- (put func 'lisp-indent-function (nth 1 entry))
- (put func 'lisp-indent-hook (nth 1 entry))
- (or (get func 'edebug-form-spec)
- (put func 'edebug-form-spec (nth 2 entry)))))
-
;; Autoload the other portions of the package.
;; We want to replace the basic versions of dolist, dotimes, declare below.
(fmakunbound 'dolist)
(fmakunbound 'dotimes)
(fmakunbound 'declare)
+;;;###autoload
+(progn
+ ;; Autoload, so autoload.el and font-lock can use it even when CL
+ ;; is not loaded.
+ (put 'defun* 'doc-string-elt 3)
+ (put 'defmacro* 'doc-string-elt 3)
+ (put 'defsubst 'doc-string-elt 3)
+ (put 'defstruct 'doc-string-elt 2))
+
(load "cl-loaddefs" nil 'quiet)
;; This goes here so that cl-macs can find it if it loads right now.
;; byte-compile-warnings: (not cl-functions)
;; End:
-;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
;;; cl.el ends here
HCoop / bpt / emacs.git / blobdiff