From adb5564117ed08b67dc3cfca6475c818f67e8181 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 1 Dec 2004 13:07:37 +0000 Subject: [PATCH] 0.8.17.5: Fix INCF, DECF and REMF for CLHS 5.1.3 evaluation order. --- NEWS | 3 +++ src/code/early-setf.lisp | 38 +++++++++++++++++++++++++++----------- version.lisp-expr | 2 +- 3 files changed, 31 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index f411ace..7404654 100644 --- a/NEWS +++ b/NEWS @@ -5,6 +5,9 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17: DEFSTRUCT forms are now created eagerly. * bug fix: lambda-list parsing is now stricter vrt. order and number of lambda-list keywords. + * fixed some bugs revealed by Paul Dietz' test suite: + ** INCF, DECF and REMF evaluate their place form as specified in + CLtS 5.1.3. changes in sbcl-0.8.17 relative to sbcl-0.8.16: * new feature: a build-time option (controlled by the :SB-UNICODE diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp index 5727b61..e829b6a 100644 --- a/src/code/early-setf.lisp +++ b/src/code/early-setf.lisp @@ -257,8 +257,9 @@ GET-SETF-EXPANSION directly." (local1 (gensym)) (local2 (gensym))) ((null d) - (push (list (car newval) getter) let-list) + ;; See ANSI 5.1.3 for why we do out-of-order evaluation (push (list ind-temp indicator) let-list) + (push (list (car newval) getter) let-list) `(let* ,(nreverse let-list) (do ((,local1 ,(car newval) (cddr ,local1)) (,local2 nil ,local1)) @@ -273,6 +274,31 @@ GET-SETF-EXPANSION directly." ,setter (return t)))))))) (push (list (car d) (car v)) let-list)))) + +;;; we can't use DEFINE-MODIFY-MACRO because of ANSI 5.1.3 +(defmacro-mundanely incf (place &optional (delta 1) &environment env) + #!+sb-doc + "The first argument is some location holding a number. This number is + incremented by the second argument, DELTA, which defaults to 1." + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-method place env) + (let ((d (gensym))) + `(let* (,@(mapcar #'list dummies vals) + (,d ,delta) + (,(car newval) (+ ,getter ,d))) + ,setter)))) + +(defmacro-mundanely decf (place &optional (delta 1) &environment env) + #!+sb-doc + "The first argument is some location holding a number. This number is + decremented by the second argument, DELTA, which defaults to 1." + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-method place env) + (let ((d (gensym))) + `(let* (,@(mapcar #'list dummies vals) + (,d ,delta) + (,(car newval) (- ,getter ,d))) + ,setter)))) ;;;; DEFINE-MODIFY-MACRO stuff @@ -321,16 +347,6 @@ GET-SETF-EXPANSION directly." let-list) `(let* ,(nreverse let-list) ,setter))))))) - -(sb!xc:define-modify-macro incf (&optional (delta 1)) + - #!+sb-doc - "The first argument is some location holding a number. This number is - incremented by the second argument, DELTA, which defaults to 1.") - -(sb!xc:define-modify-macro decf (&optional (delta 1)) - - #!+sb-doc - "The first argument is some location holding a number. This number is - decremented by the second argument, DELTA, which defaults to 1.") ;;;; DEFSETF diff --git a/version.lisp-expr b/version.lisp-expr index 2bd7e11..1ac8d12 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.17.4" +"0.8.17.5" -- 1.7.10.4