make-call-arguments

[mcvax!delphi!stefano@seismo.CSS.GOV (Stefano Diomedi)]

In PCL version 4/29/87 prime April 29, 1987 I had to change the
function make-call-arguments (file "fixup.lsp") because:

1. it seemed not able to manage properly the supplied-p parameter
optionally present in a keyword parameter.

This is the actual change:

	     (when key
	       ;; &key appears in the lambda list.  Remove &key from the
	       ;; lambda list then replace all the keywords with pairs of
	       ;; the actual keyword followed by the value variable.
	       ;; Have to parse the hairy triple case of &key.
	       (let ((key-args
		       (iterate ((arg in (cdr key)))
			 (until (eq arg '&allow-other-keys))
			 (cond ((symbolp arg)
				(collect (make-keyword arg))
				(collect arg))

; it seems a bug when there is a supplied-p parameter
;			       ((cddr arg)
;				(collect (caddr arg))
;				(collect (car arg)))

; a possible solution - DELPHI 23 Jul 87
			       ((listp (car arg))
				(collect (caar arg))
				(collect (cadar arg)))

			       (t
				(collect (make-keyword (car arg)))
				(collect (car arg)))))))
		 (if key-args
		     (setf (car key) (car key-args)
			   (cdr key) (cdr key-args))
		     (setf (cdr key) nil
			   lambda-list (remove '&key lambda-list)))))

This is the example I used:
------------------------------------------------------------
;;;
;;; testing the supplied-p parameters in defmethod
;;;

(in-package 'pcl)

(defclass point ()
  (x y)
  (:accessor-prefix point-))

(defmethod move ((p point)
		 &key newx newy &allow-other-keys)
  (with-slots (p)
	      (setf x newx y newy))
)

(defclass 3d-point (point)
v  (z)
  (:accessor-prefix point-))

(defmethod move ((p 3d-point) &key newx newy (newz 0 newz-p))
  (run-super)
  (with-slots (p)
	      (setf z newz))
  (when newz-p (print "newz-p")))

(setq pp (make-3d-point))

(move pp :newx 4 :newy 5 :newz 6)
------------------------------------------------------------


2. it doesn't manage properly the optional variables

This is the actual change:

  (let ((optional (memq '&optional lambda-list)))
    (when optional
      ;; The &optional keyword appears in the lambda list.
      ;; Get rid of it, by moving the rest of the lambda list
      ;; up, then go through the optional arguments, replacing
      ;; them with the real symbol.
      (setf (car optional) (cadr optional)
	    (cdr optional) (cddr optional))
      (iterate ((loc on optional))
#|
	(when (memq (car loc) lambda-list-keywords)
	  (unless (memq (car loc) '(&rest &key &allow-other-keys))
	    (error
	      "The non-standard lambda list keyword ~S appeared in the~%~
               lambda list of a method in which CALL-NEXT-METHOD is used.~%~
               PCL can only deal with standard lambda list keywords."))
	  (when (listp (car loc)) (setf (car loc) (caar loc))))
|#
; a possible solution - DELPHI 23 Jul 87

	(if (memq (car loc) lambda-list-keywords)
	 (progn
	  (unless (memq (car loc) '(&rest &key &allow-other-keys))
	    (error
	      "The non-standard lambda list keyword ~S appeared in the~%~
               lambda list of a method in which CALL-NEXT-METHOD is used.~%~
               PCL can only deal with standard lambda list keywords."))
	  (setq loc nil))
	 (when (listp (car loc)) (setf (car loc) (caar loc))))
	)))


Stefano Diomedi
DELPHI - Italy