How to implement the primitive procedure "apply"

Question

I've been reading SICP and getting into lisps / clojure more and more, and I found myself wondering how apply would actually be implemented. Of course there are some silly ways like (defn apply [f xs] (eval (cons f xs))), but I can't find an example to look at covering the real implementation. I figured once I got to 4.1 in SICP it would be covered, but was disappointed to find out that they define apply in terms of the already existing underlying scheme implementation.

How would one go about implementing this from the ground up?

EDIT:

I think the way I asked this is a bit unclear. I know how apply is implemented in terms of the eval/apply interaction mentioned in SICP. What I'm referring to is the underlying apply in scheme that they fall back on within the definition of the metacircular version of apply. Basically ... how to call a function with a list of args, each passed individually, if you don't already have apply implemented in some base language.

Answer 1

The way you implement apply is directly tied to how you implement function calls. If you compile your code, you have a protocol at runtime where you know how values are exchanged between function calls, and apply can emit code that satisfy to this protocol. We could do the same in a quick and dirty interpreter. Let's define a package:

(defpackage :interpreter (:use :cl))
(in-package :interpreter)

We define a function object, which has an optional name, a list of parameters, the code as well as a set of bindings being closed-over:

(defstruct fn name parameters code closed)

We also define a frame, which has a set of bindings and an optional parent frame:

(defstruct frame bindings parent)

Here we have a simple interpreter, and we put the current frame within the evaluation environment:

(defstruct env frame)

Bindings are either objects of type FN, or cons pairs. We write generic functions to manipulate them with a uniform API. Functions and variables share the same namespace:

(defgeneric name (object)
  (:method ((fn fn)) (fn-name fn))
  (:method ((pair cons)) (car pair)))

(defgeneric value (object)
  (:method ((c cons)) (cdr c))
  (:method ((fn fn)) fn))

We define two functions, my-apply and my-eval

(declaim (ftype function my-apply my-eval))

There is a global environment, which is simply:

(defparameter *global-frame*
  (make-frame
   :bindings (list (make-fn :name '+
                            :parameters '(x y)
                            ;; built-in
                            :code (lambda (x y) (+ x y)))
                   (make-fn :name 'addition
                            :parameters '(x y)
                            :code '(+ x y)))
   :parent nil))

The empty environment implicitly holds to the global frame:

(defgeneric frame (env)
  (:method ((empty null)) *global-frame*)
  (:method ((env env)) (env-frame env)))

Resolving a binding involves visiting parent frames:

(defun resolve (name frame &optional (on-error :error))
  (labels ((recurse (frame)
             (cond
               (frame (or (find name (frame-bindings frame) :key #'name)
                          (recurse (frame-parent frame))))
               ((eql :error on-error) (error "Unknown: ~a" name)))))
    (recurse frame)))

The evaluation function is the following one:

(defun my-eval (code env &aux (frame (frame env)))
  (flet ((ev (exp) (my-eval exp env)))
    (typecase code
      (symbol (value (resolve code frame)))
      (atom code)
      (cons
       (destructuring-bind (head . tail) code
         (case head
           (list (mapcar #'ev tail))
           (let (destructuring-bind ((var val) expr) tail
                  (my-eval expr
                           (make-env :frame (make-frame :bindings `((,var . ,(ev val)))
                                                        :parent frame)))))
           (thunk (make-fn :name nil
                           :parameters nil
                           :code (first tail)
                           :closed (frame-bindings frame)))
           (apply (my-apply (ev (first tail))
                            (ev (second tail))
                            env))
           (t (my-apply (resolve head (frame env))
                        (mapcar #'ev tail)
                        env))))))))

The evaluation functions accept the following terms:

• (list <...>) builds a list containing the result of evaluation of its arguments
• (apply <fn-expr> <arg-expr>), evaluate all arguments and call the my-apply primitive.
• (let (<var> <val>) <expr>), local binding
• (thunk <expr>) closes over current environment and produce an anonymous closure with no parameters which returns the value of <expr>
• (<f> . <args>) function call
• symbols are resolved for values, and other values are returned as-is.

The built-in my-apply knows how to bind parameters to values dynamically:

(defun my-apply (fn arguments env)
  (assert (= (length arguments)
             (length (fn-parameters fn)))
          ()
          "Length mismatch when calling ~S with argsuments ~S"
          fn
          arguments)
  (let ((code (fn-code fn)))
    (typecase code
      (function (apply code arguments))
      (t (my-eval code
                  (make-env :frame
                            (make-frame :bindings (append (fn-closed fn)
                                                          (mapcar #'cons
                                                                  (fn-parameters fn)
                                                                  arguments))
                                        :parent (frame env))))))))

For example:

(my-eval '(let (f (let (x 10) (thunk (addition x 5))))
           (let (x 20) (apply f (list)))) nil)
=> 15

In the above example, f is a function that closes over the binding of x to 10, and calls addition. The binding that is made later is not seen by the closure. The call to apply resolves f and builds an empty list. The call to addition resolves to (+ 10 5), which itself eventually calls the CL function +. You can (trace my-eval) to see how things are evaluated. The above code is a bit messy.

Answer 2

I don't think you can define it from the ground up in the language: at some point your language needs a mechanism of actually calling a function on a bunch of arguments, and apply is pretty much that point.

That's why it's a primitive: asking how you implement apply is like asking how you implement cons or +: sooner or later the thing needs to bottom out and you call a function which is not defined in the language, or is only partly defined in the language: + for instance can probably be partly implemented in terms of checking types and extracting the actual machine numbers from them, but sooner or later you are going to ask the machine to add some machine numbers for you (or, OK, some equivalent operation if your machine does not support addition directly).

Answer 3

I made a dynamic lisp language a while ago and I didn't expose apply. I did supply rest arguments and thus since I had eval and macros in the language I made several attempts to do this. I found out quickly that macros are useless so eval is the only solution. Your example has a flaw:

(defn mapply [f xs] (eval (cons f xs)))
(mapply cons '(1 (3)))
; ClassCastException java.lang.Long cannot be cast to clojure.lang.IFn  

The reason is that the resulting expression being evaluated by eval becomes:

(cons 1 (3))

Instead of

(cons '1 '(3))

Thus to mimic it you need to make sure the already evaluated values doesn't get evaluates a second time around. We could fix that by quoting the values:

(defn m2apply [f xs] (eval (cons f (map #(list 'quote %) xs))))
(m2apply cons '(1 (3)))
; ==> (1 3)

Yey.. But you really are doing a lot more computing than you need. For a lexical interpreter that does have apply you only need to leak that as a primitive into the environment. And yes, it is the unimpressive apply whose only purpose is to call internals (primitives) and to evaluate user function bodies in an extended environment. In a language not already a lisp the apply and a whole set of primitives and data structures would be implemented in the implementation language and it would just expose that instead.

Answer 4

Due to Clojure being hosted on the JVM platform (and being designed to have great Java interop), the peculiarities of the underlying platform shine through.

You can see in the source code for apply on JVM here: https://github.com/clojure/clojure/blob/clojure-1.9.0/src/clj/clojure/core.clj#L652

Notice how there is specific code for arities up to 4, for efficiency reasons. Arities 5 and above are treated in a less efficient way.

(defn apply
  "Applies fn f to the argument list formed by prepending intervening arguments to args."
  {:added "1.0"
   :static true}
  ([^clojure.lang.IFn f args]
     (. f (applyTo (seq args))))
  ([^clojure.lang.IFn f x args]
     (. f (applyTo (list* x args))))
  ([^clojure.lang.IFn f x y args]
     (. f (applyTo (list* x y args))))
  ([^clojure.lang.IFn f x y z args]
     (. f (applyTo (list* x y z args))))
  ([^clojure.lang.IFn f a b c d & args]
     (. f (applyTo (cons a (cons b (cons c (cons d (spread args)))))))))

The ClojureScript implementation does the same, but looks quite different from the JVM implementation above:

(defn apply
  "Applies fn f to the argument list formed by prepending intervening arguments to args."
  ([f args]
   (if (.-cljs$lang$applyTo f)
     (let [fixed-arity (.-cljs$lang$maxFixedArity f)
           bc (bounded-count (inc fixed-arity) args)]
       (if (<= bc fixed-arity)
         (apply-to f bc args)
         (.cljs$lang$applyTo f args)))
     (apply-to-simple f (seq args))))
  ([f x args]
   (if (.-cljs$lang$applyTo f)
     (let [arglist (list* x args)
           fixed-arity (.-cljs$lang$maxFixedArity f)
           bc (inc (bounded-count fixed-arity args))]
       (if (<= bc fixed-arity)
         (apply-to f bc arglist)
         (.cljs$lang$applyTo f arglist)))
     (apply-to-simple f x (seq args))))
  ([f x y args]
   (if (.-cljs$lang$applyTo f)
     (let [arglist (list* x y args)
           fixed-arity (.-cljs$lang$maxFixedArity f)
           bc (+ 2 (bounded-count (dec fixed-arity) args))]
       (if (<= bc fixed-arity)
         (apply-to f bc arglist)
         (.cljs$lang$applyTo f arglist)))
     (apply-to-simple f x y (seq args))))
  ([f x y z args]
   (if (.-cljs$lang$applyTo f)
     (let [arglist (list* x y z args)
           fixed-arity (.-cljs$lang$maxFixedArity f)
           bc (+ 3 (bounded-count (- fixed-arity 2) args))]
       (if (<= bc fixed-arity)
         (apply-to f bc arglist)
         (.cljs$lang$applyTo f arglist)))
     (apply-to-simple f x y z (seq args))))
  ([f a b c d & args]
   (if (.-cljs$lang$applyTo f)
     (let [spread-args (spread args)
           arglist (cons a (cons b (cons c (cons d spread-args))))
           fixed-arity (.-cljs$lang$maxFixedArity f)
           bc (+ 4 (bounded-count (- fixed-arity 3) spread-args))]
       (if (<= bc fixed-arity)
         (apply-to f bc arglist)
         (.cljs$lang$applyTo f arglist)))
     (apply-to-simple f a b c d (spread args)))))