From: Alexey Dejneka Date: Wed, 30 Oct 2002 14:02:11 +0000 (+0000) Subject: 0.7.9.16: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=97406970b74c0213bb6eec93bb1554f1d3125241;p=sbcl.git 0.7.9.16: * fixed bugs, reported by Paul Dietz: DOLIST.5, SET-EXCLUSIVE-OR-17, MULTIPLE-VALUE-SETQ.5. * we are not going to release yet another 0.7.9 :-) --- diff --git a/NEWS b/NEWS index 3abef44..8429f98 100644 --- a/NEWS +++ b/NEWS @@ -1345,7 +1345,7 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8: * 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. @@ -1357,7 +1357,13 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8: 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 diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index d9afbde..aa4c5a7 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -47,22 +47,9 @@ (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)) @@ -336,8 +323,8 @@ (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) @@ -347,18 +334,21 @@ ;; 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))))))) ;;;; miscellaneous @@ -367,7 +357,7 @@ (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." diff --git a/src/code/list.lisp b/src/code/list.lisp index 54dde08..6142e0b 100644 --- a/src/code/list.lisp +++ b/src/code/list.lisp @@ -792,17 +792,28 @@ 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. diff --git a/version.lisp-expr b/version.lisp-expr index 20ec6fd..f0a010f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.9.15" +"0.7.9.16"