MasterMastic
MasterMastic

Reputation: 21306

How to write a function that calls a function with its arguments?

I'm trying to write functions that wrap another function but I'm not sure how to pass parameters correctly while maintaining a sensible lambda-list.

E.g. if I have a function

(defun f (x &key y z) ...)

I want to write something like

(defun g (x &key y z)
  (h (f x :y y :z z)))

This isn't satisfactory because I want to call f from g with the exact arguments g was called with, which doesn't happen (e.g. I don't want to supply keyword arguments to f that weren't supplied to g by the caller).

I initially wrote something like:

(defun g (&rest f-args)
  (apply #'f f-args))

And that's the effect I want, however the lambda list for g is now very cryptic and I keep having to navigate to f to see what the arguments should be.

I did come up with a solution (and it's mostly satisfactory so I posted it as an answer), but I need to be explicit with every single key argument, and with large lambda-lists (e.g. if I want to wrap drakma:http-request), it will be a pain. I hope that maybe there's a better way.

Upvotes: 3

Views: 228

Answers (2)

jkiiski
jkiiski

Reputation: 8421

You could write a macro that defines a function by copying the lambda list from another function. The problem is that there isn't a standard way to get the lambda list, but for SBCL you can use SB-INTROSPECT:FUNCTION-LAMBDA-LIST (although that won't work with (declaim (optimize (debug 0)))). You could try reading Swank source code to see how it gets the lambda lists for various implementations.

(defmacro define-wrapper (name lambda-source &body body)
  `(defun ,name ,(sb-introspect:function-lambda-list lambda-source)
     ,@body))

(defun f (x &key (y 3) (z 4))
  (+ x y z))

(define-wrapper g f
  (* 2 (f x :y y :z z)))

(f 2) ;=> 9
(g 2) ;=> 18

That's a bit ugly since the code doesn't show the variable definitions. A bit more complex solution might be to do something like

;; Requires Alexandria.
(defmacro define-wrapper (name lambda-source &body body)
  (let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
    (multiple-value-bind (required optional rest keywords)
        (alexandria:parse-ordinary-lambda-list lambda-list)
      (declare (ignore rest))
      `(defun ,name ,lambda-list
         ,@(sublis `((_ . (,lambda-source ,@(loop for r in required collect r)
                                          ,@(loop for (name init suppliedp)
                                                  in optional collect name)
                                          ,@(loop for ((k-name name) init suppliedp)
                                                  in keywords
                                                append (list k-name name)))))
                   body)))))

(defun f (x &key (y 3) (z 4))
  (+ x y z))

(define-wrapper g f
  (* 2 _))

Where the _ in the wrapper is replaced with a call to the function F with the given arguments. You do still have to remember that the argument variables exist and can conflict with ones you define yourself.

That passes all arguments to the function regardless of whether they were given. That might mess up a function that behaves differently depending on whether an argument was supplied or not. You could avoid that by using APPLY, but it's a bit more complex.

(defmacro define-wrapper (name lambda-source &body body)
  (let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
    (alexandria:with-gensyms (deparsed-arglist-sym
                              key-sym val-sym suppliedp-sym)
      (multiple-value-bind (required optional rest keywords)
          (alexandria:parse-ordinary-lambda-list lambda-list)
        (declare (ignore rest))
        (multiple-value-bind (body declarations docstring)
            (alexandria:parse-body body :documentation t)
          `(defun ,name ,lambda-list
             ,@(when docstring (list docstring))
             ,@declarations
             (let ((,deparsed-arglist-sym
                     (nconc (loop for ,val-sym in (list ,@required) collect ,val-sym)
                            (loop for (,val-sym . ,suppliedp-sym)
                                    in (list ,@(loop for (name init suppliedp)
                                                       in optional
                                                     collect (list 'cons name
                                                                   (or suppliedp t))))
                                  when ,suppliedp-sym collect ,val-sym)
                            (loop for (,key-sym ,val-sym ,suppliedp-sym)
                                    in (list ,@(loop for ((kname name) init suppliedp) 
                                                       in keywords
                                                     collect (list 'list kname name
                                                                   (or suppliedp t))))
                                  when ,suppliedp-sym append (list ,key-sym ,val-sym)))))
               ,@(sublis `((_ . (apply #',lambda-source ,deparsed-arglist-sym)))
                         body))))))))

(define-wrapper bar drakma:http-request
  "Return the length of a response to http-request."
  ;; HTTP-REQUEST has some &aux variables.
  (declare (ignore drakma::unparsed-uri
                   drakma::args))
  (length _))

(bar "http://www.google.com") ;=> 11400 (14 bits, #x2C88)

Upvotes: 3

MasterMastic
MasterMastic

Reputation: 21306

I came up with this:

(defun g (x &rest f-keys &key y z)
  (declare (ignorable y z)) 
  (apply #'f x f-keys))

It's great for small lambda-lists but I hope I could do better.
I also can't see default values unless I type them explicitly.

Upvotes: 2

Related Questions