From d3e620a34711eaaadde4069d8d8eb46ffbe4151b Mon Sep 17 00:00:00 2001 From: pmai <pmai> Date: Sat, 24 Aug 2002 13:46:52 +0000 Subject: [PATCH] Patch by Gerd Moellmann to remove PCL's variant of once-only, replacing it by the version already present in CMUCL. --- pcl/extensions.lisp | 6 +++--- pcl/macros.lisp | 35 +++-------------------------------- 2 files changed, 6 insertions(+), 35 deletions(-) diff --git a/pcl/extensions.lisp b/pcl/extensions.lisp index f92f46b79..524470cf5 100644 --- a/pcl/extensions.lisp +++ b/pcl/extensions.lisp @@ -18,7 +18,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.3 1999/05/30 23:13:58 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.4 2002/08/24 13:46:52 pmai Exp $") ;;; (in-package 'pcl) @@ -83,7 +83,7 @@ (defmacro slot-value-from-index (instance wrapper slot-name slots index) "Returns instance's slot-value given slot-name's index." - (once-only (index) + (ext:once-only ((index index)) `(if ,index (let ((val (%svref ,slots ,index))) (if (eq val ',*slot-unbound*) @@ -96,7 +96,7 @@ (defmacro set-slot-value-from-index (instance wrapper slot-name slots index new-value) "Sets instance's slot-value to new-value given slot-name's index." - (once-only (index) + (ext:once-only ((index index)) `(if ,index (setf (%svref ,slots ,index) ,new-value) (if *safe-to-use-set-slot-value-wrapper-optimizations-p* diff --git a/pcl/macros.lisp b/pcl/macros.lisp index 3de2e8d84..f19dafd9d 100644 --- a/pcl/macros.lisp +++ b/pcl/macros.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.16 2002/08/19 16:52:09 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.17 2002/08/24 13:46:52 pmai Exp $") ;;; ;;; Macros global variable definitions, and other random support stuff used ;;; by the rest of the system. @@ -98,35 +98,6 @@ (defun remtail (list tail) (if (eq list tail) () (cons (car list) (remtail (cdr list) tail)))) -;;; ONCE-ONLY does the same thing as it does in zetalisp. I should have just -;;; lifted it from there but I am honest. Not only that but this one is -;;; written in Common Lisp. I feel a lot like bootstrapping, or maybe more -;;; like rebuilding Rome. -(defmacro once-only (vars &body body) - (let ((gensym-var (gensym)) - (run-time-vars (gensym)) - (run-time-vals (gensym)) - (expand-time-val-forms ())) - (dolist (var vars) - (push `(if (or (symbolp ,var) - (numberp ,var) - (and (listp ,var) - (member (car ,var) '(quote function)))) - ,var - (let ((,gensym-var (gensym))) - (push ,gensym-var ,run-time-vars) - (push ,var ,run-time-vals) - ,gensym-var)) - expand-time-val-forms)) - `(let* (,run-time-vars - ,run-time-vals - (wrapped-body - (let ,(mapcar #'list vars (reverse expand-time-val-forms)) - ,@body))) - `(let ,(mapcar #'list (reverse ,run-time-vars) - (reverse ,run-time-vals)) - ,wrapped-body)))) - (eval-when (compile load eval) (defun extract-declarations (body &optional environment) ;;(declare (values documentation declarations body)) @@ -184,13 +155,13 @@ (intern (string-append sym1 sym2) package)) (defmacro check-member (place list &key (test #'eql) (pretty-name place)) - (once-only (place list) + (ext:once-only ((place place) (list list)) `(or (member ,place ,list :test ,test) (error "The value of ~A, ~S is not one of ~S." ',pretty-name ,place ,list)))) (defmacro alist-entry (alist key make-entry-fn) - (once-only (alist key) + (ext:once-only ((alist alist) (key key)) `(or (assq ,key ,alist) (progn (setf ,alist (cons (,make-entry-fn ,key) ,alist)) (car ,alist))))) -- GitLab