[mcclim-devel] BUG in RECORDING.LISP > DEFINE-INVOKE-WITH

[Richard and/or Dorrit]

When compiling with SBCL 1.0.49, discovered the dynamic-extent declaration at the end of this has two typos, where the dynamic extent is declared for #'continuation and #'constructor, rather than for the gensym'd names for them. So the second version of this code is with this issue fixed.

(defmacro define-invoke-with (macro-name func-name record-type doc-string)
  `(defmacro ,macro-name ((stream
			   &optional
			   (record-type '',record-type)
			   (record (gensym))
			   &rest initargs)
			  &body body)
     ,doc-string
     (setq stream (stream-designator-symbol stream '*standard-output*))
     (with-gensyms (constructor continuation)
       (multiple-value-bind (bindings m-i-args)
	   (rebind-arguments initargs)
	 `(let ,bindings
	    (flet ((,constructor ()
		     (make-instance ,record-type , at m-i-args))
		   (,continuation (,stream ,record)
		     ,(declare-ignorable-form* stream record)
		     , at body))
	      (declare (dynamic-extent #'constructor #'continuation))
	      (,',func-name ,stream #',continuation ,record-type #',constructor
			    , at m-i-args)))))))

;;; here's the versioned with the repaired dynamic-extent declaration:

(defmacro define-invoke-with (macro-name func-name record-type doc-string)
  `(defmacro ,macro-name ((stream
			   &optional
			   (record-type '',record-type)
			   (record (gensym))
			   &rest initargs)
			  &body body)
     ,doc-string
     (setq stream (stream-designator-symbol stream '*standard-output*))
     (with-gensyms (constructor continuation)
       (multiple-value-bind (bindings m-i-args)
	   (rebind-arguments initargs)
	 `(let ,bindings
	    (flet ((,constructor ()
		     (make-instance ,record-type , at m-i-args))
		   (,continuation (,stream ,record)
		     ,(declare-ignorable-form* stream record)
		     , at body))
	      (declare (dynamic-extent #',constructor #',continuation))
	      (,',func-name ,stream #',continuation ,record-type #',constructor
			    , at m-i-args)))))))