From 2a26d8e674faab491722b67bf41e9d4e0036728d Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 15 Dec 2004 16:21:58 +0000 Subject: [PATCH] Fix the order of evaluation for REMF, INCF, and DECF, as specified by ANSI 5.1.3. (Based on the fixs in sbcl.) --- code/macros.lisp | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/code/macros.lisp b/code/macros.lisp index 4918550d4..2a17b40c6 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.102 2004/10/14 13:46:30 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.103 2004/12/15 16:21:58 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1011,15 +1011,28 @@ (push (list (car d) (car v)) let-list))))) -(define-modify-macro incf (&optional (delta 1)) + - "The first argument is some location holding a number. This number is - incremented by the second argument, DELTA, which defaults to 1.") - - -(define-modify-macro decf (&optional (delta 1)) - - "The first argument is some location holding a number. This number is - decremented by the second argument, DELTA, which defaults to 1.") - +;;; we can't use DEFINE-MODIFY-MACRO because of ANSI 5.1.3 +(defmacro incf (place &optional (delta 1) &environment env) + "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 decf (place &optional (delta 1) &environment env) + "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)))) (defmacro remf (place indicator &environment env) "Place may be any place expression acceptable to SETF, and is expected @@ -1035,8 +1048,9 @@ (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)) -- GitLab