Editing Visitor pattern (section)

=== Common Lisp ===

==== Sources ====
<syntaxhighlight lang=Lisp>(defclass auto ()
  ((elements :initarg :elements)))

(defclass auto-part ()
  ((name :initarg :name :initform "<unnamed-car-part>")))

(defmethod print-object ((p auto-part) stream)
  (print-object (slot-value p 'name) stream))

(defclass wheel (auto-part) ())

(defclass body (auto-part) ())

(defclass engine (auto-part) ())

(defgeneric traverse (function object other-object))

(defmethod traverse (function (a auto) other-object)
  (with-slots (elements) a
    (dolist (e elements)
      (funcall function e other-object))))

;; do-something visitations

;; catch all
(defmethod do-something (object other-object)
  (format t "don't know how ~s and ~s should interact~%" object other-object))

;; visitation involving wheel and integer
(defmethod do-something ((object wheel) (other-object integer))
  (format t "kicking wheel ~s ~s times~%" object other-object))

;; visitation involving wheel and symbol
(defmethod do-something ((object wheel) (other-object symbol))
  (format t "kicking wheel ~s symbolically using symbol ~s~%" object other-object))

(defmethod do-something ((object engine) (other-object integer))
  (format t "starting engine ~s ~s times~%" object other-object))

(defmethod do-something ((object engine) (other-object symbol))
  (format t "starting engine ~s symbolically using symbol ~s~%" object other-object))

(let ((a (make-instance 'auto
                        :elements `(,(make-instance 'wheel :name "front-left-wheel")
                                    ,(make-instance 'wheel :name "front-right-wheel")
                                    ,(make-instance 'wheel :name "rear-left-wheel")
                                    ,(make-instance 'wheel :name "rear-right-wheel")
                                    ,(make-instance 'body :name "body")
                                    ,(make-instance 'engine :name "engine")))))
  ;; traverse to print elements
  ;; stream *standard-output* plays the role of other-object here
  (traverse #'print a *standard-output*)

  (terpri) ;; print newline

  ;; traverse with arbitrary context from other object
  (traverse #'do-something a 42)

  ;; traverse with arbitrary context from other object
  (traverse #'do-something a 'abc))</syntaxhighlight>

==== Output ====
<pre>"front-left-wheel"
"front-right-wheel"
"rear-left-wheel"
"rear-right-wheel"
"body"
"engine"
kicking wheel "front-left-wheel" 42 times
kicking wheel "front-right-wheel" 42 times
kicking wheel "rear-left-wheel" 42 times
kicking wheel "rear-right-wheel" 42 times
don't know how "body" and 42 should interact
starting engine "engine" 42 times
kicking wheel "front-left-wheel" symbolically using symbol ABC
kicking wheel "front-right-wheel" symbolically using symbol ABC
kicking wheel "rear-left-wheel" symbolically using symbol ABC
kicking wheel "rear-right-wheel" symbolically using symbol ABC
don't know how "body" and ABC should interact
starting engine "engine" symbolically using symbol ABC</pre>

==== Notes ====
The <code>other-object</code> parameter is superfluous in <code>traverse</code>. The reason is that it is possible to use an anonymous function that calls the desired target method with a lexically captured object:

<syntaxhighlight lang=Lisp>(defmethod traverse (function (a auto)) ;; other-object removed
  (with-slots (elements) a
    (dolist (e elements)
      (funcall function e)))) ;; from here too

  ;; ...

  ;; alternative way to print-traverse
  (traverse (lambda (o) (print o *standard-output*)) a)

  ;; alternative way to do-something with
  ;; elements of a and integer 42
  (traverse (lambda (o) (do-something o 42)) a)</syntaxhighlight>

Now, the multiple dispatch occurs in the call issued from the body of the anonymous function, and so <code>traverse</code> is just a mapping function that distributes a function application over the elements of an object. Thus all traces of the Visitor Pattern disappear, except for the mapping function, in which there is no evidence of two objects being involved. All knowledge of there being two objects and a dispatch on their types is in the lambda function.