From 96f876e8bfa1df065d9f849a018c98d446d3bbe1 Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Fri, 16 Jan 2004 03:13:10 +0000
Subject: [PATCH] Fix for (pprint '`(lambda ,x)) bug wherein the backquote
 implementation details leaks out.

From SBCL.
---
 code/backq.lisp  |  7 +++++--
 code/pprint.lisp | 12 +++++++++++-
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/code/backq.lisp b/code/backq.lisp
index f16491f8d..f5413ed10 100644
--- a/code/backq.lisp
+++ b/code/backq.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/backq.lisp,v 1.11 2002/10/14 21:37:57 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/backq.lisp,v 1.12 2004/01/16 03:13:09 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -48,7 +48,10 @@
 (defvar *bq-at-flag* '(|,@|))
 (defvar *bq-dot-flag* '(|,.|))
 (defvar *bq-vector-flag* '(|bqv|))
-
+(defvar *bq-tokens*
+  '(backq-comma backq-comma-at backq-comma-dot backq-list
+    backq-list* backq-append backq-nconc backq-cons backq-vector))
+  
 ;; This is the actual character macro.
 (defun backquote-macro (stream ignore)
   (declare (ignore ignore))
diff --git a/code/pprint.lisp b/code/pprint.lisp
index 8612ec1d4..1353baff4 100644
--- a/code/pprint.lisp
+++ b/code/pprint.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/pprint.lisp,v 1.33 2003/01/06 22:27:16 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.34 2004/01/16 03:13:10 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1177,6 +1177,16 @@
 
 (defun pprint-lambda-list (stream lambda-list &rest noise)
   (declare (ignore noise))
+  (when (and (consp lambda-list)
+	     (member (car lambda-list) lisp::*bq-tokens*))
+    ;; if this thing looks like a backquoty thing, then we don't want
+    ;; to destructure it, we want to output it straight away.  [ this
+    ;; is the exception to the normal processing: if we did this
+    ;; generally we would find lambda lists such as (FUNCTION FOO)
+    ;; being printed as #'FOO ]  -- CSR, 2003-12-07
+    (output-object lambda-list stream)
+    (return-from pprint-lambda-list nil))
+
   (pprint-logical-block (stream lambda-list :prefix "(" :suffix ")")
     (let ((state :required)
 	  (first t))
-- 
GitLab