From 1ca1159c8a7ae32a4c3184e42bac97bb58efa889 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Sat, 19 Apr 2003 20:52:43 +0000
Subject: [PATCH] 	Add destructuring support to &REST, &BODY, &WHOLE. 
 Detected 	by Paul Dietz' ANSI tests.

	* src/code/defmacro.lisp (parse-defmacro-lambda-list): Add
	&parse-body, replacing &body (<body> <decls> <doc>).  Add
	destructuring support to &rest, &body, &whole.

	* src/code/eval.lisp (lambda-list-keywords): Add &parse-body.

	* src/code/exports.lisp ("EXTENSIONS"): Export &parse-body.

	* src/hemlock/table.lisp (do-words, with-folded-string):
	* src/hemlock/macros.lisp (with-pop-up-display):
	* src/compiler/macros.lisp (deftransform):
	* src/compiler/ir1tran.lisp (symbol-macrolet, let, locally)
	(let*, flet, labels) <ir1-translator>:
	* src/code/package.lisp (do-symbols, do-external-symbols)
	(do-all-symbols):
	* src/code/macros.lisp (defun, prog, prog*, with-open-file)
	(with-open-stream, with-input-from-string)
	(with-output-to-string, do, do*):
	* src/code/mach.lisp (gr-bind):
	* src/code/extensions.lisp (do-anonymous, do-hash, defun-cached):
	Use &parse-body instead of &body.
---
 code/defmacro.lisp    | 87 +++++++++++++++++++++++++++----------------
 code/eval.lisp        |  5 ++-
 code/exports.lisp     |  6 ++-
 code/extensions.lisp  |  8 ++--
 code/mach.lisp        |  4 +-
 code/macros.lisp      | 22 ++++++-----
 code/package.lisp     |  8 ++--
 compiler/ir1tran.lisp | 15 ++++----
 compiler/macros.lisp  |  4 +-
 hemlock/macros.lisp   |  4 +-
 hemlock/table.lisp    |  6 +--
 11 files changed, 98 insertions(+), 71 deletions(-)

diff --git a/code/defmacro.lisp b/code/defmacro.lisp
index b974be5dc..be6c9ed47 100644
--- a/code/defmacro.lisp
+++ b/code/defmacro.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/defmacro.lisp,v 1.24 2003/02/24 10:04:10 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defmacro.lisp,v 1.25 2003/04/19 20:52:43 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -123,6 +123,15 @@
 			  `(progn
 			    (setf ,arg-list-name (cdr ,arg-list-name)))))
 		      (push-let-binding (car rest-of-args) arg-list-name nil))
+		     ((and (cdr rest-of-args) (consp (cadr rest-of-args)))
+		      (pop rest-of-args)
+		      (let* ((destructuring-lambda-list (car rest-of-args))
+			     (sub (gensym "WHOLE-SUBLIST")))
+			(push-sub-list-binding
+			 sub arg-list-name destructuring-lambda-list
+			 name error-kind error-fun)
+			(parse-defmacro-lambda-list
+			 destructuring-lambda-list sub name error-kind error-fun)))
 		     (t
 		      (defmacro-error "&WHOLE" error-kind name))))
 	      ((eq var '&environment)
@@ -138,7 +147,41 @@
 		      (setf env-arg-used t))
 		     (t
 		      (defmacro-error "&ENVIRONMENT" error-kind name))))
-	      ((or (eq var '&rest) (eq var '&body))
+	      ;;
+	      ;; This branch implements an extension to Common Lisp
+	      ;; that was formerly implemented for &body.  In place of
+	      ;; a symbol following &body, there could be a list of up
+	      ;; to three elements which will be bound to the body,
+	      ;; declarations, and doc-string of the body.
+	      ((eq var '&parse-body)
+	       (unless (and (cdr rest-of-args)
+			    (consp (cadr rest-of-args))
+			    (symbolp (caadr rest-of-args)))
+		 (simple-program-error "Invalid ~a" '&parse-body))
+		(setf rest-of-args (cdr rest-of-args))
+		(setf restp t)
+		(let ((body-name (caar rest-of-args))
+		      (declarations-name (cadar rest-of-args))
+		      (doc-string-name (caddar rest-of-args))
+		      (parse-body-values (gensym)))
+		  (push-let-binding
+		   parse-body-values
+		   `(multiple-value-list
+		     (parse-body ,path ,env-arg-name
+				 ,(not (null doc-string-name))))
+		   t)
+		  (setf env-arg-used t)
+		  (when body-name
+		    (push-let-binding body-name
+				      `(car ,parse-body-values) nil))
+		  (when declarations-name
+		    (push-let-binding declarations-name
+				      `(cadr ,parse-body-values) nil))
+		  (when doc-string-name
+		    (push-let-binding doc-string-name
+				      `(caddr ,parse-body-values) nil))))
+	      ;;
+	      ((member var '(&rest &body))
 	       (cond ((and (cddr rest-of-args)
 			   (not (member (caddr rest-of-args) lambda-list-keywords)))
 		      (defmacro-error (symbol-name var) error-kind name))
@@ -146,37 +189,15 @@
 		      (setf rest-of-args (cdr rest-of-args))
 		      (setf restp t)
 		      (push-let-binding (car rest-of-args) path nil))
-		     ;;
-		     ;; This branch implements an incompatible extension to
-		     ;; Common Lisp.  In place of a symbol following &body,
-		     ;; there may be a list of up to three elements which will
-		     ;; be bound to the body, declarations, and doc-string of
-		     ;; the body.
-		     ((and (cdr rest-of-args)
-			   (consp (cadr rest-of-args))
-			   (symbolp (caadr rest-of-args)))
-		      (setf rest-of-args (cdr rest-of-args))
-		      (setf restp t)
-		      (let ((body-name (caar rest-of-args))
-			    (declarations-name (cadar rest-of-args))
-			    (doc-string-name (caddar rest-of-args))
-			    (parse-body-values (gensym)))
-			(push-let-binding
-			 parse-body-values
-			 `(multiple-value-list
-			   (parse-body ,path ,env-arg-name
-				       ,(not (null doc-string-name))))
-			 t)
-			(setf env-arg-used t)
-			(when body-name
-			  (push-let-binding body-name
-					    `(car ,parse-body-values) nil))
-			(when declarations-name
-			  (push-let-binding declarations-name
-					    `(cadr ,parse-body-values) nil))
-			(when doc-string-name
-			  (push-let-binding doc-string-name
-					    `(caddr ,parse-body-values) nil))))
+		     ((and (cdr rest-of-args) (consp (cadr rest-of-args)))
+		      (pop rest-of-args)
+		      (setq restp t)
+		      (let* ((destructuring-lambda-list (car rest-of-args))
+			     (sub (gensym "REST-SUBLIST")))
+			(push-sub-list-binding sub path destructuring-lambda-list
+			 name error-kind error-fun)
+			(parse-defmacro-lambda-list
+			 destructuring-lambda-list sub name error-kind error-fun)))
 		     (t
 		      (defmacro-error (symbol-name var) error-kind name))))
 	      ((eq var '&optional)
diff --git a/code/eval.lisp b/code/eval.lisp
index 9815d47c4..a3398d41f 100644
--- a/code/eval.lisp
+++ b/code/eval.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/eval.lisp,v 1.37 2003/03/22 01:25:43 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.38 2003/04/19 20:52:43 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -60,7 +60,8 @@
 
 
 (defconstant lambda-list-keywords
-  '(&optional &rest &key &aux &body &whole &allow-other-keys &environment)
+  '(&optional &rest &key &aux &body &whole &allow-other-keys &environment
+    &parse-body)
   "Keywords that you can put in a lambda-list, supposing you should want
   to do such a thing.")
 
diff --git a/code/exports.lisp b/code/exports.lisp
index 19f03c26f..e5253d80a 100644
--- a/code/exports.lisp
+++ b/code/exports.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/exports.lisp,v 1.205 2003/04/13 11:57:17 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.206 2003/04/19 20:52:43 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1064,7 +1064,9 @@
 	     "STREAM-READ-CHAR" "STREAM-READ-CHAR-NO-HANG" "STREAM-READ-LINE"
 	     "STREAM-START-LINE-P" "STREAM-TERPRI" "STREAM-UNREAD-CHAR"
 	     "STREAM-WRITE-BYTE" "STREAM-WRITE-CHAR" "STREAM-WRITE-STRING"
-	     "STREAM-READ-SEQUENCE" "STREAM-WRITE-SEQUENCE"))
+	     "STREAM-READ-SEQUENCE" "STREAM-WRITE-SEQUENCE"
+
+	     "&PARSE-BODY"))
 
 (defpackage "LOOP")
 (dolist
diff --git a/code/extensions.lisp b/code/extensions.lisp
index 5dfb5798a..70b0c0871 100644
--- a/code/extensions.lisp
+++ b/code/extensions.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/extensions.lisp,v 1.26 2002/09/19 17:48:17 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extensions.lisp,v 1.27 2003/04/19 20:52:43 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -364,7 +364,7 @@
 	 (return-from ,BLOCK (progn ,@(cdr endlist))))))))
 
 
-(defmacro do-anonymous (varlist endlist &body (body decls))
+(defmacro do-anonymous (varlist endlist &parse-body (body decls))
   "DO-ANONYMOUS ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
   Like DO, but has no implicit NIL block.  Each Var is initialized in parallel
   to the value of the specified Init form.  On subsequent iterations, the Vars
@@ -376,7 +376,7 @@
 		    'do-anonymous (gensym)))
 
 (defmacro do-hash ((key-var value-var table &optional result)
-		   &body (body decls))
+		   &parse-body (body decls))
   "DO-HASH (Key-Var Value-Var Table [Result]) Declaration* Form*
    Iterate over the entries in a hash-table."
   (let ((gen (gensym))
@@ -572,7 +572,7 @@
 ;;;
 (defmacro defun-cached ((name &rest options &key (values 1) default
 			      &allow-other-keys)
-			args &body (body decls doc))
+			args &parse-body (body decls doc))
   "DEFUN-CACHED (Name {Key Value}*) ({(Arg-Name Test-Function)}*) Form*
   Some syntactic sugar for defining a function whose values are cached by
   DEFINE-HASH-CACHE."
diff --git a/code/mach.lisp b/code/mach.lisp
index cbdc271d9..21c03e0d2 100644
--- a/code/mach.lisp
+++ b/code/mach.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/mach.lisp,v 1.4 1994/10/31 04:11:27 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/mach.lisp,v 1.5 2003/04/19 20:52:43 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -91,7 +91,7 @@
 
 ;;; GR-Bind  --  Public
 ;;;
-(defmacro gr-bind (vars (fun . args) &body (body decls))
+(defmacro gr-bind (vars (fun . args) &parse-body (body decls))
   "GR-Bind ({Var}*) (Function {Arg}*) {Form}*
   Call the function with the specified Args and signal an error if the
   first value returned is not mach:Kern-Success.  If the call succeeds,
diff --git a/code/macros.lisp b/code/macros.lisp
index 006165bba..343f15b53 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.91 2003/03/22 16:15:21 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.92 2003/04/19 20:52:43 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -300,7 +300,7 @@
 ;;;    Very similar to Defmacro, but simpler.  We don't have to parse the
 ;;; lambda-list.
 ;;;
-(defmacro defun (&whole source name lambda-list &body (body decls doc))
+(defmacro defun (&whole source name lambda-list &parse-body (body decls doc))
   (multiple-value-bind (valid block-name)
       (valid-function-name-p name)
     (declare (ignore valid))
@@ -416,13 +416,13 @@
 (defmacro return (&optional (value nil))
   `(return-from nil ,value))
 
-(defmacro prog (varlist &body (body decls))
+(defmacro prog (varlist &parse-body (body decls))
   `(block nil
      (let ,varlist
        ,@decls
        (tagbody ,@body))))
 
-(defmacro prog* (varlist &body (body decls))
+(defmacro prog* (varlist &parse-body (body decls))
   `(block nil
      (let* ,varlist
        ,@decls
@@ -1469,7 +1469,7 @@
 
 
 ;;;; With-XXX
-(defmacro with-open-file ((var &rest open-args) &body (forms decls))
+(defmacro with-open-file ((var &rest open-args) &parse-body (forms decls))
   "Bindspec is of the form (Stream File-Name . Options).  The file whose
    name is File-Name is opened using the Options and bound to the variable
    Stream. If the call to open is unsuccessful, the forms are not
@@ -1487,7 +1487,7 @@
 	   (close ,var :abort ,abortp))))))
 
 
-(defmacro with-open-stream ((var stream) &body (forms decls))
+(defmacro with-open-stream ((var stream) &parse-body (forms decls))
   "The form stream should evaluate to a stream.  VAR is bound
    to the stream and the forms are evaluated as an implicit
    progn.  The stream is closed upon exit."
@@ -1503,7 +1503,8 @@
 	   (close ,var :abort ,abortp))))))
 
 
-(defmacro with-input-from-string ((var string &key index start end) &body (forms decls))
+(defmacro with-input-from-string ((var string &key index start end)
+				  &parse-body (forms decls))
   "Binds the Var to an input stream that returns characters from String and
   executes the body.  See manual for details."
   ;; The once-only inhibits compiler note for unreachable code when 'end' is true.
@@ -1524,7 +1525,8 @@
 	 ,@(if index `((setf ,index (string-input-stream-current ,var))))))))
 
 
-(defmacro with-output-to-string ((var &optional string) &body (forms decls))
+(defmacro with-output-to-string ((var &optional string)
+				 &parse-body (forms decls))
   "If STRING is specified, it must be a string with a fill pointer;
    the output is incrementally appended to the string (as if by use of
    VECTOR-PUSH-EXTEND)."
@@ -1582,7 +1584,7 @@
 	     ,@forms))))))
 
 
-(defmacro do (varlist endlist &body (body decls))
+(defmacro do (varlist endlist &parse-body (body decls))
   "DO ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
   Iteration construct.  Each Var is initialized in parallel to the value of the
   specified Init form.  On subsequent iterations, the Vars are assigned the
@@ -1595,7 +1597,7 @@
   (do-do-body varlist endlist body decls 'let 'psetq 'do nil))
 
 
-(defmacro do* (varlist endlist &body (body decls))
+(defmacro do* (varlist endlist &parse-body (body decls))
   "DO* ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
   Iteration construct.  Each Var is initialized sequentially (like LET*) to the
   value of the specified Init form.  On subsequent iterations, the Vars are
diff --git a/code/package.lisp b/code/package.lisp
index a98e5278e..9f26de0bc 100644
--- a/code/package.lisp
+++ b/code/package.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/package.lisp,v 1.62 2003/03/22 16:15:20 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.63 2003/04/19 20:52:42 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -547,7 +547,7 @@
 ;;;; Iteration macros.
 
 (defmacro do-symbols ((var &optional (package '*package*) result-form)
-		      &body (body decls))
+		      &parse-body (body decls))
   "DO-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECLARATION}* {TAG | FORM}*
    Executes the FORMs at least once for each symbol accessible in the given
    PACKAGE with VAR bound to the current symbol."
@@ -581,7 +581,7 @@
 	 ,result-form))))
 
 (defmacro do-external-symbols ((var &optional (package '*package*) result-form)
-			       &body (body decls))
+			       &parse-body (body decls))
   "DO-EXTERNAL-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECL}* {TAG | FORM}*
    Executes the FORMs once for each external symbol in the given PACKAGE with
    VAR bound to the current symbol."
@@ -605,7 +605,7 @@
 	 ,@decls
 	 ,result-form))))
 
-(defmacro do-all-symbols ((var &optional result-form) &body (body decls))
+(defmacro do-all-symbols ((var &optional result-form) &parse-body (body decls))
   "DO-ALL-SYMBOLS (VAR [RESULT-FORM]) {DECLARATION}* {TAG | FORM}*
    Executes the FORMs once for each symbol in every package with VAR bound
    to the current symbol."
diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index c46064beb..f985397e9 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.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/ir1tran.lisp,v 1.145 2003/04/16 13:31:18 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.146 2003/04/19 20:52:42 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2538,7 +2538,8 @@
 
 ;;;; Symbol macros:
 
-(def-ir1-translator symbol-macrolet ((specs &body (body decls)) start cont)
+(def-ir1-translator symbol-macrolet ((specs &parse-body (body decls))
+				     start cont)
   "SYMBOL-MACROLET ({(Name Expansion)}*) Decl* Form*
   Define the Names as symbol macros with the given Expansions.  Within the
   body, references to a Name will effectively be replaced with the Expansion."
@@ -2828,7 +2829,7 @@
     (values (vars) (vals) (names))))
 
 
-(def-ir1-translator let ((bindings &body (body decls))
+(def-ir1-translator let ((bindings &parse-body (body decls))
 			 start cont)
   "LET ({(Var [Value]) | Var}*) Declaration* Form*
   During evaluation of the Forms, Bind the Vars to the result of evaluating the
@@ -2842,7 +2843,7 @@
       (reference-leaf start fun-cont fun)
       (ir1-convert-combination-args fun-cont cont values))))
 
-(def-ir1-translator locally ((&body (body decls))
+(def-ir1-translator locally ((&parse-body (body decls))
                             start cont)
   "LOCALLY Declaration* Form*
    Sequentially evaluates a body of Form's in a lexical environment
@@ -2852,7 +2853,7 @@
         
 
 
-(def-ir1-translator let* ((bindings &body (body decls))
+(def-ir1-translator let* ((bindings &parse-body (body decls))
 			  start cont)
   "LET* ({(Var [Value]) | Var}*) Declaration* Form*
   Similar to LET, but the variables are bound sequentially, allowing each Value
@@ -2905,7 +2906,7 @@
        (values (names) (defs)))))
 
 
-(def-ir1-translator flet ((definitions &body (body decls))
+(def-ir1-translator flet ((definitions &parse-body (body decls))
 			  start cont)
   "FLET ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
   Evaluate the Body-Forms with some local function definitions.   The bindings
@@ -2928,7 +2929,7 @@
 ;;; leaves.  We also backpatch the FENV so that if the lexical environment is
 ;;; used for inline expansion we will get the right functions.
 ;;;
-(def-ir1-translator labels ((definitions &body (body decls)) start cont)
+(def-ir1-translator labels ((definitions &parse-body (body decls)) start cont)
   "LABELS ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
   Evaluate the Body-Forms with some local function definitions.  The bindings
   enclose the new definitions, so the defined functions can call themselves or
diff --git a/compiler/macros.lisp b/compiler/macros.lisp
index 754864309..d23e84afe 100644
--- a/compiler/macros.lisp
+++ b/compiler/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/compiler/macros.lisp,v 1.50 2003/04/11 15:28:11 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.51 2003/04/19 20:52:42 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -341,7 +341,7 @@
 					  (result-type '*)
 					  &key result policy node defun-only
 					  eval-name important (when :native))
-			     &body (body decls doc))
+			     &parse-body (body decls doc))
   "Deftransform Name (Lambda-List [Arg-Types] [Result-Type] {Key Value}*)
                Declaration* [Doc-String] Form*
   Define an IR1 transformation for Name.  An IR1 transformation computes a
diff --git a/hemlock/macros.lisp b/hemlock/macros.lisp
index 7d685ab09..3047b2f37 100644
--- a/hemlock/macros.lisp
+++ b/hemlock/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/hemlock/macros.lisp,v 1.8 2001/03/13 15:49:56 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/macros.lisp,v 1.9 2003/04/19 20:52:42 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -521,7 +521,7 @@
 
 
 (defmacro with-pop-up-display ((var &key height (buffer-name "Random Typeout"))
-			       &body (body decls))
+			       &parse-body (body decls))
   "Execute body in a context with var bound to a stream.  Output to the stream
    appears in the buffer named buffer-name.  The pop-up display appears after
    the body completes, but if you supply :height, the output is line buffered,
diff --git a/hemlock/table.lisp b/hemlock/table.lisp
index bea8f6edd..214a15af5 100644
--- a/hemlock/table.lisp
+++ b/hemlock/table.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/hemlock/table.lisp,v 1.4 2001/03/13 15:50:00 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/table.lisp,v 1.5 2003/04/19 20:52:42 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -243,7 +243,7 @@
 
 (eval-when (compile eval)
 
-(defmacro do-words ((start-var end-var) &body (body decls))
+(defmacro do-words ((start-var end-var) &parse-body (body decls))
   (let ((sep-pos (gensym)))
     `(dolist (,sep-pos *separator-positions*)
        (let ((,start-var (car ,sep-pos))
@@ -252,7 +252,7 @@
 	 ,@body))))
 
 (defmacro with-folded-string ((str-var len-var orig-str separator)
-			      &body (body decls))
+			      &parse-body (body decls))
   `(let ((,str-var *string-buffer*))
      (declare (simple-string ,str-var))
      ;; make the string simple if it isn't already
-- 
GitLab