This is SBCL 1.0.6.7, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
* (load "m-m-l-example.lisp")

debugger invoked on a SB-PCL::CPL-PROTOCOL-VIOLATION in thread #<THREAD "initial thread" {100237A011}>:
  Protocol violation: the STANDARD-CLASS class
  #<STANDARD-CLASS MY-GENERIC-FUNCTION> has the class
  #<BUILT-IN-CLASS FUNCTION> in its class precedence list:
  (#<STANDARD-CLASS MY-GENERIC-FUNCTION>
   #<SB-MOP:FUNCALLABLE-STANDARD-CLASS STANDARD-GENERIC-FUNCTION>
   #<SB-MOP:FUNCALLABLE-STANDARD-CLASS GENERIC-FUNCTION>
   #<STANDARD-CLASS SB-PCL::DEPENDENT-UPDATE-MIXIN>
   #<STANDARD-CLASS SB-PCL::PLIST-MIXIN>
   #<STANDARD-CLASS SB-PCL::DEFINITION-SOURCE-MIXIN>
   #<STANDARD-CLASS SB-MOP:METAOBJECT>
   #<SB-MOP:FUNCALLABLE-STANDARD-CLASS SB-MOP:FUNCALLABLE-STANDARD-OBJECT>
   #<BUILT-IN-CLASS FUNCTION> #<STANDARD-CLASS STANDARD-OBJECT>
   #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT> #<BUILT-IN-CLASS T>).
See also:
  The SBCL Manual, Node "Metaobject Protocol"

Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [ABORT] Exit debugger, returning to top level.

(SB-PCL::UPDATE-CPL
 #<STANDARD-CLASS MY-GENERIC-FUNCTION>
 (#<STANDARD-CLASS MY-GENERIC-FUNCTION>
  #<SB-MOP:FUNCALLABLE-STANDARD-CLASS STANDARD-GENERIC-FUNCTION>
  #<SB-MOP:FUNCALLABLE-STANDARD-CLASS GENERIC-FUNCTION>
  #<STANDARD-CLASS SB-PCL::DEPENDENT-UPDATE-MIXIN>
  #<STANDARD-CLASS SB-PCL::PLIST-MIXIN>
  #<STANDARD-CLASS SB-PCL::DEFINITION-SOURCE-MIXIN>
  #<STANDARD-CLASS SB-MOP:METAOBJECT>
  #<SB-MOP:FUNCALLABLE-STANDARD-CLASS SB-MOP:FUNCALLABLE-STANDARD-OBJECT>
  #<BUILT-IN-CLASS FUNCTION> #<STANDARD-CLASS STANDARD-OBJECT>
  #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT> #<BUILT-IN-CLASS T>))
0] 
WARNING: Starting a select without a timeout while interrupts are disabled.

(in-package "CL-USER")

(defclass my-method (standard-method) ())

(defclass my-generic-function (standard-generic-function)
     ()
  (:metaclass sb-mop:funcallable-standard-class))

(defmethod sb-mop:make-method-lambda ((gf my-generic-function)
                                      (method my-method)
                                      lambda-expression
                                      environment)
  (declare (ignore environment))
  `(lambda (args next-methods this-method)
     (,(call-next-method gf method
         `(lambda ,(cadr lambda-expression)
            (flet ((this-method () this-method)
                   (call-next-method (&rest cnm-args)
                     (funcall (method-function (car next-methods))
                              (or cnm-args args)
                              (cdr next-methods)
                              (car next-methods)))
                   (next-method-p () (not (null next-methods))))
              ,@(cddr lambda-expression))) environment) args next-methods)))

(defmethod sb-mop:compute-effective-method ((gf my-generic-function) method-combination methods)
  `(call-method ,(car methods) ,(cdr methods) ,(car methods)))

(defgeneric foo (x) 
  (:generic-function-class my-generic-function)
  (:method-class my-method))
(defmethod foo ((x integer)) (this-method))

(foo 3)

(in-package "CL-USER")

(defclass my-generic-function (standard-generic-function)
     ()
  (:default-initargs :method-class (find-class 'my-method)))


(defclass my-method (standard-method) ())

(defmethod sb-mop:make-method-lambda ((gf my-generic-function)
                                      (method my-method)
                                      lambda-expression
                                      environment)
  (declare (ignore environment))
  `(lambda (args next-methods this-method)
     (,(call-next-method gf method
         `(lambda ,(cadr lambda-expression)
            (flet ((this-method () this-method)
                   (call-next-method (&rest cnm-args)
                     (funcall (method-function (car next-methods))
                              (or cnm-args args)
                              (cdr next-methods)
                              (car next-methods)))
                   (next-method-p () (not (null next-methods))))
              ,@(cddr lambda-expression))) environment) args next-methods)))

(defmethod sb-mop:compute-effective-method ((gf my-generic-function) method-combination methods)
  `(call-method ,(car methods) ,(cdr methods) ,(car methods)))