--- layout: ../Site.layout.js --- # [Art of the metaobject protocol](https://cliki.net/AMOP) Exercise 1.1: Memoize Closette `apply-generic-function` - «.exercise 1.1» (to "exercise 1.1") In my attempt to [move towards MOPing up my own `cl-kitten`](/kitten/planning-cl-kitten-mop/), I am going through all of [the art of the metaobject protocol](https://ldbeth.sdf.org/The_Art_of_the_Metaobject_Protocol.pdf) as planned. Remember that at [his OOPSLA keynote in 1997 The Computer Revolution Hasn't Happened Yet](https://dl.acm.org/doi/pdf/10.1145/354384.354390), Kay gives [The Art of the Metaobject Protocol](https://mitpress.mit.edu/9780262111584/the-art-of-the-metaobject-protocol/) as the most important modern book. Without belabouring this context, let us say that I have high aspirations for our `cl-kitten` ([kitten](https://kitten.small-web.org/)). Anyway, to take [AMOP](https://gitlab.common-lisp.net/closer/closer-mop) seriously, I am going through its exercises here seriously. I am using common lisp, emacs, eev and slime, but you can probably get where I'm coming from even if you're not. The gist is to get to know the fundamentals of ANSI CL's object orientation inside and out, where the inside is metacircularly, basically an object oriented program in lisp. Read what Simon Dobson says. I noticed that [Simon Dobson (mastodon)](https://mastodon.scot/@simoninireland) [wrote about the art of the metaobject protocol about a year ago](https://simondobson.org/2024/07/23/the-art-of-the-metaobject-protocol/), though I needed to at least finish chapter one and its one exercise before reading what Simon said. I am very interested in Simon's [annotated lisp bibliography](https://simondobson.org/development/annotated-lisp-bibliography/). # Exercise 1.1 of Art of the MetaObject Protocol - «exercise 1.1» (to ".exercise 1.1") > *Exercise 1.1* The [Closette implementation](https://cliki.net/Closette) of generic function invocation offers numerous possibilities for memoizing meta-level computations. Modify `apply-generic-function` so that it memoizes previous results of `compute-applicable-methods-using-classes`. What are the conditions under which your memoized values remain valid? ## Prev `apply-generic-function` ``` (defun apply-generic-function (gf args) (let ((applicable-methods (compute-applicable-methods-using-classes gf (mapcar #'class-of (required-portion gf args))))) (if (null applicable-methods) (error "No matching method for the ~@ generic function ~S,~@ when called with arguments ~:S." gf args) (apply-methods gf args applicable-methods)))) ``` ## Prev `compute-applicable-methods-using-classes` ``` (defun compute-applicable-methods-using-classes (gf required-classes) (sort (copy-list (remove-if-not #'(lambda (method) (every #'subclassp required-classes (method-specializers method))) (generic-function-methods gf))) #'(lambda (m1 m2) (method-more-specific-p m1 m2 required-classes)))) ``` ## My solution One of closette's simplifications is that method redefinition is defined to be an error, so we only need to check that the required classes are the same. The problem is to rewrite `apply-generic-function` with memoization, not to modify the classes. I guess that `sort` could be avoided. I lexically closed a hash table keyed by [`generic`](https://www.lispworks.com/documentation/HyperSpec/Body/m_defgen.htm)s, containing hash tables using `EQUAL` keyed by lists of classes. ``` (let ((prev-appl-generics (make-hash-table))) (flet ((get-or-create (gf required-classes) (let* ((that-gf (or (gethash gf prev-appl-generics) (setf (gethash gf prev-appl-generics) (make-hash-table :test 'equal)))) (those-methods (or (gethash required-classes that-gf) (setf (gethash required-classes that-gf) (progn (print "memoizing..~%") (compute-applicable-methods-using-classes gf required-classes)))))) (values those-methods)))) (defun apply-generic-function (gf args) (let ((applicable-methods (get-or-create gf (mapcar #'class-of (required-portion gf args))))) (if (null applicable-methods) (error "No matching method for the ~@ generic function ~S,~@ when called with arguments ~:S." gf args) (apply-methods gf args applicable-methods)))) (values (apply-generic-function 'foo '(bar baz)) (apply-generic-function 'foo '(a b c)) (apply-generic-function 'foo '(d e f)) (apply-generic-function 'foo '(1 2 3)) ))) ``` ### Try that. I faked out the actual infrastructure with macros that just tag lists with symbols. ``` (macrolet ((required-portion (gf args) `(values (cons 'required ,args))) (apply-methods (gf args applicable-methods) `(values (cons 'applied ,applicable-methods))) (compute-applicable-methods-using-classes (gf required-classes) `(values (cons 'required ,required-classes)))) (let ((prev-appl-generics (make-hash-table))) (flet ((get-or-create (gf required-classes) (let* ((that-gf (or (gethash gf prev-appl-generics) (setf (gethash gf prev-appl-generics) (make-hash-table :test 'equal)))) (those-methods (or (gethash required-classes that-gf) (setf (gethash required-classes that-gf) (progn (print "memoizing..~%") (compute-applicable-methods-using-classes gf required-classes)))))) (values those-methods)))) (defun apply-generic-function (gf args) (let ((applicable-methods (get-or-create gf (mapcar #'class-of (required-portion gf args))))) (if (null applicable-methods) (error "No matching method for the ~@ generic function ~S,~@ when called with arguments ~:S." gf args) (apply-methods gf args applicable-methods)))) (values (apply-generic-function 'foo (list 'bar 'baz)) (apply-generic-function 'foo (list 'a 'b 'c)) (apply-generic-function 'foo (list 'd 'e 'f)) (apply-generic-function 'bar (list 'd 'e 'f)) (apply-generic-function 'foo (list 1 2 3)) )))) ``` As we might expect, output ``` "memoizing..~%" "memoizing..~%" "memoizing..~%" "memoizing..~%" (APPLIED REQUIRED # # #) (APPLIED REQUIRED # # # #) (APPLIED REQUIRED # # # #) (APPLIED REQUIRED # # # #) (APPLIED REQUIRED # # # #) ``` There were three different method signatures for the five returns: - `(symbol symbol symbol)` for my symbol-tagged `(bar baz)` for `foo` - `(symbol symbol symbol symbol)` for the tagged `(a b c)` and `(d e f)` for `foo` - - For the different hypothetical generic, `bar` `(d e f)`, the class list is memoized separately - `(symbol fixnum fixnum fixnum)` for `foo` for `(1 2 3)` ## Discussion Just memoizing in hash tables is the usual technique I think. Closette has already used hash table lookups in its infrastructure. This "compiler optimization" seems kind of hidden because I thought we should not modify the protocol's classes and generics. The conditions under which my memoization remains valid is for `generic`s to be [`EQ`](https://www.lispworks.com/documentation/HyperSpec/Body/f_eq.htm), and list of classes for the `generic` specialisations to be [`EQUAL`](https://www.lispworks.com/documentation/HyperSpec/Body/f_equal.htm#equal). Closette does not allow redefinitions. To be fair, I just faked the real internals using [`macrolet`](https://www.lispworks.com/documentation/HyperSpec/Body/s_flet_.htm) to just pass on tagged arguement lists so it has not been seen TRULY WORKING. # Fin The first exercise was a simple request for memoization, and I think I fulfilled it, but [let everyone know what you did instead on the Mastodon thread please](https://gamerplus.org/@screwlisp/114690780381305470). Please do share common lisp bits like this whereever and whenever occurs to you, like Dobson's writing. Ignorance of lisp is a particularly pressing problem in the world of computing (also called, *the world*).