[Openmcl-devel] Problem with ccl:macroexpand-all and flet of setf functions.

[David Brown]

I ran into this last night using slime.  The following signals a
condition:

  (ccl:macroexpand-all '(flet (((setf foo) (value) bar)) body))

> Error: Malformed :FUNCTION list: #1=(SETF FOO) is not a symbol in (#1#).
> While executing: (:INTERNAL CCL::CHECK-ALL-SYMBOLS CCL::CHECK-ENVIRONMENT-ARGS), in process listener(1).

Using a macro with this expansion works with the compiler, it just fails
when expanding using Slime.

Should I create a ticket for this?

The macro I was writing is below.

;;; Inspired by ASIF from the Anaphora package, but disappointed that
;;; ASIF evaluates the insides of the test for each test.  This macro
;;; is used like LET*, but the names of the bindings can be used with
;;; SETF and friends.  The components of the init-forms are only
;;; evaluated once.
(defmacro place-let (bindings &body body &environment env)
  "Similar to LET*, but the names in BINDINGS are bound in such a way
that SETF/SETQ will work on them."
  (if bindings
      (let ((accessor (gensym "ACCESS"))
	    (value (gensym "VALUE")))
	(multiple-value-bind (dummies vals new setter getter)
	    (get-setf-expansion (cadar bindings) env)
	  `(let* (,@(mapcar #'list dummies vals)
		  (,(car new) ,getter))
	     (flet ((,accessor ()
		      ,(car new))
		    ((setf ,accessor) (,value)
		      (setf ,(car new) ,value)
		     ,setter
		     ,value))
	       (symbol-macrolet ((,(caar bindings) (,accessor)))
		 (setq ,(car new) ,getter)
		 (place-let ,(cdr bindings) , at body))))))
      `(progn , at body)))

;;; Test demonstrating the macro.  Expanding the place-let in Slime
;;; signals the condition.
(defparameter *table* (make-hash-table))
(defun get-item (key)
  (place-let ((entry (gethash key *table*)))
    (or entry
	(let ((new-entry (cons key (gensym))))
	  (setf entry new-entry)
	  new-entry))))

Thanks,
David