From d1caae1ac6f393d0bc8cbcf62804dbac0033d133 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 23 Dec 2021 07:59:18 -0800 Subject: new feature: :mass-delegate struct clause macro. With :mass-delegate, it is possible to generate delegation methods in bulk. All of the methods of a struct type can be mirrored by delegates in another struct type just by writing a single :mass-delegate clause. * stdlib/struct.tlk (:mass-delegate): New struct clause macro. * tests/012/oop.tl: New tests. * txr.1: Documented. * stdlib/doc-syms.tl: Updated. --- stdlib/struct.tl | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'stdlib/struct.tl') diff --git a/stdlib/struct.tl b/stdlib/struct.tl index cb79aad2..e7c39fb9 100644 --- a/stdlib/struct.tl +++ b/stdlib/struct.tl @@ -417,3 +417,30 @@ ,*(if opt (cons : (mapcar (lop list :) opt))) ,*pp.rest) (qref ,delegate-expr (,target-method ,*args)))))) + +(define-struct-clause :mass-delegate (:form form self-var delegate-expr + from-struct . methods) + (let ((from-type (find-struct-type from-struct))) + (flet ((is-meth (slot) + (and (static-slot-p from-type slot) + (let ((f (static-slot from-type slot))) + (and (functionp f) + (plusp (fun-fixparam-count f))))))) + (unless from-type + (compile-error form "~s doesn't name a struct type" from-struct)) + (if (starts-with '(*) methods) + (set methods + (diff [keep-if is-meth (slots from-type)] + (cdr methods))) + (iflet ((badmeth [remove-if is-meth methods])) + (compile-error form "~s aren't methods of type ~s" badmeth from-struct))) + (collect-each ((m methods)) + (let* ((f (static-slot from-type m)) + (fix (fun-fixparam-count f)) + (opt (fun-optparam-count f)) + (var (fun-variadic f)) + (parms ^(,*(take (- fix opt) (cons self-var (gun (gensym)))) + ,*(if (plusp opt) + ^(: ,*(take opt (gun (gensym))))) + ,*(if var (gensym))))) + ^(:delegate ,m ,parms ,delegate-expr)))))) -- cgit v1.2.3