+(use-modules (oop goops dispatch))
+
+;;;
+;;; Compiling next methods into method bodies
+;;;
+
+;;; So, for the reader: there basic idea is that, given that the
+;;; semantics of `next-method' depend on the concrete types being
+;;; dispatched, why not compile a specific procedure to handle each type
+;;; combination that we see at runtime.
+;;;
+;;; In theory we can do much better than a bytecode compilation, because
+;;; we know the *exact* types of the arguments. It's ideal for native
+;;; compilation. A task for the future.
+;;;
+;;; I think this whole generic application mess would benefit from a
+;;; strict MOP.
+
+(define (compute-cmethod methods types)
+ (match methods
+ ((method . methods)
+ (cond
+ ((is-a? method <accessor-method>)
+ (match types
+ ((class . _)
+ (let* ((name (car (accessor-method-slot-definition method)))
+ (g-n-s (assq name (slot-ref class 'getters-n-setters)))
+ (init-thunk (cadr g-n-s))
+ (g-n-s (cddr g-n-s)))
+ (match types
+ ((class)
+ (cond ((pair? g-n-s)
+ (make-generic-bound-check-getter (car g-n-s)))
+ (init-thunk
+ (standard-get g-n-s))
+ (else
+ (bound-check-get g-n-s))))
+ ((class value)
+ (if (pair? g-n-s)
+ (cadr g-n-s)
+ (standard-set g-n-s))))))))
+ (else
+ (let ((make-procedure (slot-ref method 'make-procedure)))
+ (if make-procedure
+ (make-procedure
+ (if (null? methods)
+ (lambda args
+ (no-next-method (method-generic-function method) args))
+ (compute-cmethod methods types)))
+ (method-procedure method))))))))