From a5ff565d68aafcd6e781d467dd9e7580e0638f88 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Date: Fri, 19 Jun 2009 11:30:14 +0200
Subject: [PATCH] Simplify WITH-STANDARD-IO-SYNTAX

---
 src/lsp/iolib.lsp | 48 ++++++++++++++++++++++++++---------------------
 1 file changed, 27 insertions(+), 21 deletions(-)

diff --git a/src/lsp/iolib.lsp b/src/lsp/iolib.lsp
index b56591142..1e2643c53 100644
--- a/src/lsp/iolib.lsp
+++ b/src/lsp/iolib.lsp
@@ -231,32 +231,38 @@ is not given, ends the recording."
 
 ;(provide 'iolib)
 
+(defconstant +io-syntax-progv-list+
+    (let ((a (append '((*print-array* . t)
+                       (*print-base* . 10)
+                       (*print-case* . :upcase)
+                       (*print-circle* . nil)
+                       (*print-escape* . t)
+                       (*print-gensym* . t)
+                       (*print-length* . nil)
+                       (*print-level* . nil)
+                       (*print-lines* . nil)
+                       (*print-miser-width* . nil)
+                       (*print-pretty* . nil)
+                       (*print-radix* . nil)
+                       (*print-readably* . t)
+                       (*print-right-margin* . nil)
+                       (*read-base* . 10)
+                       (*read-default-float-format* . 'single-float)
+                       (*read-eval* . t)
+                       (*read-suppress* . nil))
+                     (cons *package* #.(find-package :cl-user))
+                     (cons *readtable* #.(si::standard-readtable)))))
+      (cons (mapcar #'car a)
+            (mapcar #'cdr a))))
+
 (defmacro with-standard-io-syntax (&body body)
   "Syntax: ({forms}*)
 The forms of the body are executed in a print environment that corresponds to
 the one defined in the ANSI standard. *print-base* is 10, *print-array* is t,
 *package* is \"CL-USER\", etc."
-  `(let*((*package* (find-package :cl-user))
-	 (*print-array* t)
-	 (*print-base* 10)
-	 (*print-case* :upcase)
-	 (*print-circle* nil)
-	 (*print-escape* t)
-	 (*print-gensym* t)
-	 (*print-length* nil)
-	 (*print-level* nil)
-	 (*print-lines* nil)
-	 (*print-miser-width* nil)
-	 (*print-pretty* nil)
-	 (*print-radix* nil)
-	 (*print-readably* t)
-	 (*print-right-margin* nil)
-	 (*read-base* 10)
-	 (*read-default-float-format* 'single-float)
-	 (*read-eval* t)
-	 (*read-suppress* nil)
-	 (*readtable* (si::standard-readtable)))
-    ,@body))
+  `(progv (car +io-syntax-progv-list+)
+       (cdr +io-syntax-progv-list+)
+     ,@body))
 
 #-formatter
 (defmacro formatter (control-string)