* compiler no longer signals WARNING on unknown keyword
:ALLOW-OTHER-KEYS
-changes in sbcl-0.7.9 relative to sbcl-0.7.8:
+changes in sbcl-0.7.10 relative to sbcl-0.7.9:
* minor incompatible change: PCL now records the pathname of a file
in which methods and the like are defined, rather than its
truename.
primary methods with no specializers;
** the MOP generic function GENERIC-FUNCTION-DECLARATIONS is now
implemented;
-
+ * fixed some bugs, shown by Paul Dietz' test suite:
+ ** DOLIST puts its body in TAGBODY
+ ** SET-EXCLUSIVE-OR sends arguments to :TEST function in the
+ correct order
+ ** MULTIPLE-VALUE-SETQ evaluates side-effectful places before
+ value producing form
+
planned incompatible changes in 0.7.x:
* When the profiling interface settles down, maybe in 0.7.x, maybe
later, it might impact TRACE. They both encapsulate functions, and
(error "Vars is not a list of symbols: ~S" vars)))
(defmacro-mundanely multiple-value-setq (vars value-form)
- (cond ((null vars)
- ;; The ANSI spec says that the primary value of VALUE-FORM must be
- ;; returned. The general-case-handling code below doesn't do this
- ;; correctly in the special case when there are no vars bound, so we
- ;; handle this special case separately here.
- (let ((g (gensym)))
- `(multiple-value-bind (,g) ,value-form
- ,g)))
- ((list-of-symbols-p vars)
- (let ((temps (make-gensym-list (length vars))))
- `(multiple-value-bind ,temps ,value-form
- ,@(mapcar (lambda (var temp)
- `(setq ,var ,temp))
- vars temps)
- ,(car temps))))
- (t (error "Vars is not a list of symbols: ~S" vars))))
+ (unless (list-of-symbols-p vars)
+ (error "Vars is not a list of symbols: ~S" vars))
+ `(values (setf (values ,@vars) ,value-form)))
(defmacro-mundanely multiple-value-list (value-form)
`(multiple-value-call #'list ,value-form))
(declare (type unsigned-byte ,var))
,@body))))))
(defmacro-mundanely dolist (var-list-result &body body)
- (multiple-value-bind ; to roll our own destructuring
- (var list result)
+ (multiple-value-bind ; to roll our own destructuring
+ (var list result)
(apply (lambda (var list &optional (result nil))
(values var list result))
var-list-result)
;; form, we introduce a gratuitous binding of the variable to NIL
;; without the declarations, then evaluate the result form in that
;; environment. We spuriously reference the gratuitous variable,
- ;; since since we don't want to use IGNORABLE on what might be a
- ;; special var.
- (let ((n-list (gensym)))
- `(do ((,n-list ,list (cdr ,n-list)))
- ((endp ,n-list)
- ,@(if result
- `((let ((,var nil))
- ,var
- ,result))
- '(nil)))
- (let ((,var (car ,n-list)))
- ,@body)))))
+ ;; since we don't want to use IGNORABLE on what might be a special
+ ;; var.
+ (multiple-value-bind (forms decls) (parse-body body nil)
+ (let ((n-list (gensym)))
+ `(do* ((,n-list ,list (cdr ,n-list)))
+ ((endp ,n-list)
+ ,@(if result
+ `((let ((,var nil))
+ ,var
+ ,result))
+ '(nil)))
+ (let ((,var (car ,n-list)))
+ ,@decls
+ (tagbody
+ ,@forms)))))))
\f
;;;; miscellaneous
(defmacro-mundanely psetq (&rest pairs)
#!+sb-doc
- "SETQ {var value}*
+ "PSETQ {var value}*
Set the variables to the values, like SETQ, except that assignments
happen in parallel, i.e. no assignments take place until all the
forms have been evaluated."
res))
(defun set-exclusive-or (list1 list2 &key key
- (test #'eql testp) (test-not nil notp))
+ (test #'eql testp) (test-not nil notp))
#!+sb-doc
"Return new list of elements appearing exactly once in LIST1 and LIST2."
(declare (inline member))
- (let ((result nil))
+ (let ((result nil)
+ (key (when key (coerce key 'function)))
+ (test (coerce test 'function))
+ (test-not (if test-not (coerce test-not 'function) #'eql)))
+ (declare (type (or function null) key)
+ (type function test test-not))
(dolist (elt list1)
(unless (with-set-keys (member (apply-key key elt) list2))
(setq result (cons elt result))))
- (dolist (elt list2)
- (unless (with-set-keys (member (apply-key key elt) list1))
- (setq result (cons elt result))))
+ (let ((test (if testp
+ (lambda (x y) (funcall test y x))
+ test))
+ (test-not (if notp
+ (lambda (x y) (funcall test-not y x))
+ test-not)))
+ (dolist (elt list2)
+ (unless (with-set-keys (member (apply-key key elt) list1))
+ (setq result (cons elt result)))))
result))
;;; The outer loop examines list1 while the inner loop examines list2.
projects / sbcl.git / commitdiff