[Ecls-list] Generic function invocation error with programmatically created methods.

[Mark Cox]

G'day,

I have a library that requires the ability to create methods programatically. To do this I have been using the CLOSER-MOP system to try and achieve portability across lisp implementations. Using the AMOP book [1] and the additional information provided in [2], I think I have managed to produce the correct code (attached) to programmatically create methods. 

When LOADing the code attached and invoking the function CLOSER-MOP-TESTS:MAIN, the code works as expected. i.e. it returns non-NIL. If I compile the code and load the resulting fasl, the code signals the following error:

Condition of type: SIMPLE-TYPE-ERROR
In function CAR, the value of the first argument is
  #<frame 2>
which is not of the expected type LIST

Backtrace:
  > CAR
  > #:g24
  > closer-mop-tests:main
  > si:bytecodes [Evaluation of: (closer-mop-tests:main)]
  > si:bytecodes [Evaluation of: (load "quick")]
  > si:bytecodes [Evaluation of: (si:top-level t)]

I am not sure what the cause of this error is. The code works as expected if I specify CLOSER-MOP:STANDARD-GENERIC-FUNCTION as the generic function class for PERFORM-OPERATION.

The code attached simply defines a macro DEFINE-OPERATION which adds a method to the PERFORM-OPERATION generic function. 

The version of ECL I am using is:
ECL (Embeddable Common-Lisp) 13.5.1 (git:914ce253d1d9e52df684dfacc554167b3f100ce7)

Thanks
Mark

[1] The Art of the Metaobject Protocol by Gregor Kiczales, Jim des Rivieres and Daniel G. Bobrow.
[2] http://www.franz.com/support/documentation/8.2/doc/mop/concepts.html#processing-method-bodies

;; closer-mop-tests.lisp
(defpackage "CLOSER-MOP-TESTS"
  (:use "COMMON-LISP")
  (:export #:main))
(in-package "CLOSER-MOP-TESTS")

(eval-when (:compile-toplevel :load-toplevel :execute)
  (closer-mop:defgeneric perform-operation (task chain))

  (defun make-perform-operation-method-lambda (task-var chain-var body environment)
    (let ((gf #'perform-operation))
      (closer-mop:make-method-lambda gf
				     (closer-mop:class-prototype
				      (closer-mop:generic-function-method-class gf))
				     `(lambda (,task-var ,chain-var)
					, at body)
				     environment)))

  (defun make-perform-operation-method (task-var chain-var task-class chain-class method-lambda initialisation-arguments)
    (assert (listp initialisation-arguments))
    (assert (closer-mop:classp task-class))
    (assert (closer-mop:classp chain-class))
    (let ((gf #'perform-operation))
      (apply #'make-instance (closer-mop:generic-function-method-class gf)
	     :specializers (list task-class chain-class)
	     :lambda-list (list task-var chain-var)
	     :function method-lambda     
	     initialisation-arguments)))

  (defmacro define-operation ((task-var task-class) (chain-var chain-class) &body body &environment environment)
    (multiple-value-bind (method-lambda initialisation-arguments)
	(make-perform-operation-method-lambda task-var chain-var body environment)
      `(let ((m (make-perform-operation-method ',task-var ',chain-var
					       (find-class ',task-class) (find-class ',chain-class)
					       (function ,method-lambda)
					       ',initialisation-arguments)))
	 (add-method #'perform-operation m)))))

(defclass my-task ()
  ())

(let ((object 2))
  (define-operation (task my-task) (chain t)
    (list task chain object)))

(defun main ()
  (let ((task (make-instance 'my-task)))
    (equal (list task 1 2)
	   (perform-operation task 1))))


;;; quick.lisp
(asdf:load-system "closer-mop")
(proclaim '(optimize (speed 0) (safety 3) (debug 3) (space 0)))
(load (compile-file "closer-mop-tests.lisp"))
(print (closer-mop-tests:main))