(eq (car clause) 'ignore))))
(cdr decl))))
decls))
-
;;; just like DOLIST, but with one-dimensional arrays
(defmacro dovector ((elt vector &optional result) &body body)
(multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
`(with-locked-system-table (,n-table)
,iter-form)
iter-form))))))
+
+;;; Executes BODY for all entries of PLIST with KEY and VALUE bound to
+;;; the respective keys and values.
+(defmacro doplist ((key val) plist &body body)
+ (with-unique-names (tail)
+ `(let ((,tail ,plist) ,key ,val)
+ (loop (when (null ,tail) (return nil))
+ (setq ,key (pop ,tail))
+ (when (null ,tail)
+ (error "malformed plist, odd number of elements"))
+ (setq ,val (pop ,tail))
+ (progn ,@body)))))
+
\f
;;;; hash cache utility
(let* ((name (first spec))
(exp-temp (gensym "ONCE-ONLY")))
`(let ((,exp-temp ,(second spec))
- (,name (gensym ,(symbol-name name))))
+ (,name (sb!xc:gensym ,(symbol-name name))))
`(let ((,,name ,,exp-temp))
,,(frob (rest specs) body))))))))
\f
;;; - SB-C::MERGE-TAIL-CALLS (policy), since 1.0.53.74 (11/2011) -> Late: 11/2012
;;; - SB-EXT:QUIT, since 1.0.56.55 (05/2012) -> Late: 05/2013
;;; - SB-UNIX:UNIX-EXIT, since 1.0.56.55 (05/2012) -> Late: 05/2013
+;;; - SB-DEBUG:*SHOW-ENTRY-POINT-DETAILS*, since 1.1.4.9 (02/2013) -> Late: 02/2014
;;;
;;; LATE:
;;; - SB-SYS:OUTPUT-RAW-BYTES, since 1.0.8.16 (06/2007) -> Final: anytime
+;;; Note: make sure CLX doesn't use it anymore!
;;; - SB-C::STACK-ALLOCATE-DYNAMIC-EXTENT (policy), since 1.0.19.7 -> Final: anytime
;;; - SB-C::STACK-ALLOCATE-VECTOR (policy), since 1.0.19.7 -> Final: anytime
;;; - SB-C::STACK-ALLOCATE-VALUE-CELLS (policy), since 1.0.19.7 -> Final: anytime
(defmacro define-deprecated-function (state since name replacements lambda-list &body body)
(let* ((replacements (normalize-deprecation-replacements replacements))
- (doc (let ((*package* (find-package :keyword)))
- (apply #'format nil
- "~@<~S has been deprecated as of SBCL ~A.~
- ~#[~; Use ~S instead.~; ~
- Use ~S or ~S instead.~:; ~
- Use~@{~#[~; or~] ~S~^,~} instead.~]~@:>"
- name since replacements))))
+ (doc
+ (let ((*package* (find-package :keyword))
+ (*print-pretty* nil))
+ (apply #'format nil
+ "~S has been deprecated as of SBCL ~A.~
+ ~#[~;~2%Use ~S instead.~;~2%~
+ Use ~S or ~S instead.~:;~2%~
+ Use~@{~#[~; or~] ~S~^,~} instead.~]"
+ name since replacements))))
`(progn
,(ecase state
((:early :late)
- `(defun ,name ,lambda-list
- ,doc
- ,@body))
+ `(progn
+ (defun ,name ,lambda-list
+ ,doc
+ ,@body)))
((:final)
`(progn
(declaim (ftype (function * nil) ,name))
(setf (compiler-macro-function ',name)
(deprecation-compiler-macro ,state ,since ',name ',replacements)))))
+(defun check-deprecated-variable (name)
+ (let ((info (info :variable :deprecated name)))
+ (when info
+ (deprecation-warning (car info) (cdr info) name nil))))
+
+(defmacro define-deprecated-variable (state since name &key (value nil valuep) replacement)
+ `(progn
+ (setf (info :variable :deprecated ',name) (cons ,state ,since))
+ ,@(when (member state '(:early :late))
+ `((defvar ,name ,@(when valuep (list value))
+ ,(let ((*package* (find-package :keyword)))
+ (format nil
+ "~@<~S has been deprecated as of SBCL ~A~@[, use ~S instead~].~:>"
+ name since replacement)))))))
+
;;; Anaphoric macros
(defmacro awhen (test &body body)
`(let ((it ,test))
;;; Returns a list of members of LIST. Useful for dealing with circular lists.
;;; For a dotted list returns a secondary value of T -- in which case the
;;; primary return value does not include the dotted tail.
-(defun list-members (list)
+;;; If the maximum length is reached, return a secondary value of :MAYBE.
+(defun list-members (list &key max-length)
(when list
(do ((tail (cdr list) (cdr tail))
- (members (list (car list)) (cons (car tail) members)))
- ((or (not (consp tail)) (eq tail list))
- (values members (not (listp tail)))))))
+ (members (list (car list)) (cons (car tail) members))
+ (count 0 (1+ count)))
+ ((or (not (consp tail)) (eq tail list)
+ (and max-length (>= count max-length)))
+ (values members (or (not (listp tail))
+ (and (>= count max-length) :maybe)))))))
;;; Default evaluator mode (interpeter / compiler)
(make-unportable-float :long-float-negative-zero)
0.0l0))))
-;;; Like DEFUN, but replaces &REST with &MORE while hiding that from the
-;;; lambda-list.
-(defmacro define-more-fun (name lambda-list &body body)
- (let* ((p (position '&rest lambda-list))
- (head (subseq lambda-list 0 p))
- (tail (subseq lambda-list p))
- (more-context (gensym "MORE-CONTEXT"))
- (more-count (gensym "MORE-COUNT")))
- (aver (= 2 (length tail)))
- `(progn
- (macrolet ((more-count ()
- `(truly-the index ,',more-count))
- (more-p ()
- `(not (eql 0 ,',more-count)))
- (more-arg (n)
- `(sb!c:%more-arg ,',more-context ,n))
- (do-more ((arg &optional (start 0)) &body body)
- (let ((i (gensym "I")))
- `(do ((,i (the index ,start) (truly-the index (1+ ,i))))
- ((>= ,i (more-count)))
- (declare (index ,i))
- (let ((,arg (sb!c:%more-arg ,',more-context ,i)))
- ,@body)))))
- (defun ,name (,@head &more ,more-context ,more-count)
- ,@body))
- (setf (%simple-fun-arglist #',name) ',lambda-list))))
-
;;; Signalling an error when trying to print an error condition is
;;; generally a PITA, so whatever the failure encountered when
;;; wondering about FILE-POSITION within a condition printer, 'tis