48 lines
1.6 KiB
Plaintext
48 lines
1.6 KiB
Plaintext
;; TXR Lisp's :delegate implementation is hard delegation: the indicated
|
|
;; delegate object must exist and take the method call. To do soft
|
|
;; delegation, we develop a macro (delegate-or-fallback x y z)
|
|
;; which chooses x if x is an object which supports a z method,
|
|
;; or else chooses y.
|
|
|
|
(defun delegate-or-fallback-impl (del-inst fb-inst required-meth)
|
|
(let (del-type)
|
|
(if (and (structp del-inst)
|
|
(set del-type (struct-type del-inst))
|
|
(static-slot-p del-type required-meth)
|
|
(functionp (static-slot del-type required-meth)))
|
|
del-inst
|
|
fb-inst)))
|
|
|
|
(defmacro delegate-or-fallback (delegate-expr fallback-obj : required-meth)
|
|
^(delegate-or-fallback-impl ,delegate-expr ,fallback-obj ',required-meth))
|
|
|
|
;; With the above, we can use the defstruct delegate clause syntax:
|
|
;;
|
|
;; (:delegate source-method (obj) target-obj target-method)
|
|
;;
|
|
;; which writes a delegate method called source-method, that delegates
|
|
;; to target-method on target-obj. We calculate target-obj using
|
|
;; our macro and ensure that the delegator itself imlpements target-method.
|
|
|
|
(defstruct delegator ()
|
|
delegate
|
|
(:delegate operation (me) (delegate-or-fallback me.delegate me thing) thing)
|
|
|
|
(:method thing (me)
|
|
"default implementation"))
|
|
|
|
(defstruct delegate ()
|
|
(:method thing (me)
|
|
"delegate implementation"))
|
|
|
|
;; Tests:
|
|
|
|
;; no delegate
|
|
(prinl (new delegator).(operation))
|
|
|
|
;; struct delegate, but not with thing method
|
|
(prinl (new delegator delegate (new time)).(operation))
|
|
|
|
;; delegate with thing method
|
|
(prinl (new delegator delegate (new delegate)).(operation))
|