[Small-cl-src] apply in terms of funcall

[Andreas Fuchs]

On 2004-05-15, Andreas Fuchs <asf at boinkor.net> wrote:
> ;;; A few months ago, there was a thread about FUNCALL and APPLY on
> ;;; c.l.l. I wrote this code to show how APPLY might be defined in
> ;;; terms of FUNCALL.

;;; As some of you noted, this version is buggy: it doesn't do the
;;; list-as-last-arg magick correctly. Let's fix that:

;;; This code fixes that:

(defun apply-definer (max-args)
  `(defun apply-1 (f args)
     (case (length args)
       ,@(loop for arg-count from 0 to max-args
	       collect `((,arg-count)
			 (funcall
			   f
			   ,@(loop for arg-idx from 0 to (1- arg-count)
				   collect `(nth ,arg-idx args)))))
       (otherwise
	(error ,(format nil "Can't apply to more than ~A args" max-args))))))

(defmacro define-apply (max-args)
  (apply-definer (etypecase max-args
		   (symbol (symbol-value max-args))
		   (number max-args))))

(defun my-apply (f &rest args)
	   (let ((last-arg (first (last args))))
	     (apply-1 f 
		      (if (listp last-arg)
			  (append (butlast args) last-arg)
			  args))))

(define-apply ; call-arguments-limit  ; might be a bit much for the poor impl
              20                      ; let's be humane
	      )

;;; example:

#|
CL-USER> (defun print-all (&rest args) (loop for arg in args  do (print arg)))

CL-USER> (my-apply #'print-all 1 2 3 '(1 2 3))

1 
2 
3 
1 
2 
3 

NIL
|#

> ;;; License: BSD-sans-advertising.

-- 
Andreas Fuchs, <asf at boinkor.net>, asf at jabber.at, antifuchs