From 8350d9d9165f1c70bfc2371ab939c217b496b2d3 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Sat, 26 Jul 2003 19:21:24 +0000 Subject: [PATCH] * src/compiler/srctran.lisp (format): Don't define deftransforms for the same types but differing :policies because one overwrites the other. --- compiler/srctran.lisp | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index f2cbde4b7..8c8d8cdb2 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.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/compiler/srctran.lisp,v 1.123 2003/07/03 17:11:21 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.124 2003/07/26 19:21:24 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -3375,31 +3375,32 @@ "Too many args (~d) to FORMAT, wants at most ~d" nargs max-args))))))) -(deftransform format ((dest control &rest args) (t simple-string &rest t) * - :policy (> speed space)) - (unless (constant-continuation-p control) - (give-up "Control string is not a constant.")) - (let ((string (continuation-value control))) - (check-format-args string args) - (let ((arg-names (mapcar (lambda (x) (declare (ignore x)) (gensym)) args))) - `(lambda (dest control ,@arg-names) - (declare (ignore control)) - (format dest (formatter ,string) ,@arg-names))))) - -(deftransform format ((dest control &rest args) (t simple-string &rest t) * - :policy (<= speed space)) - (when (constant-continuation-p control) - (check-format-args (continuation-value control) args)) - (give-up)) - ;;; +;;; Note that two DEFTRANSFORMs differing in their :POLICY only cannot +;;; be defined; one replaces the other. +;;; +(deftransform format ((dest control &rest args) (t simple-string &rest t) *) + (cond ((policy nil (> speed space)) + (unless (constant-continuation-p control) + (give-up "Control string is not a constant.")) + (let ((string (continuation-value control))) + (check-format-args string args) + (let ((arg-names (loop repeat (length args) collect (gensym)))) + `(lambda (dest control ,@arg-names) + (declare (ignore control)) + (format dest (formatter ,string) ,@arg-names))))) + (t + (when (constant-continuation-p control) + (check-format-args (continuation-value control) args)) + (give-up)))) + (deftransform format ((stream control &rest args) (stream function &rest t) * :policy (> speed space)) (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args))) `(lambda (stream control ,@arg-names) (funcall control stream ,@arg-names) nil))) -;;; + (deftransform format ((tee control &rest args) ((member t) function &rest t) * :policy (> speed space)) (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args))) -- GitLab