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) ,@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)) ------------------------------------------------------------------------------ This SF.net email is sponsored by Windows: Build for Windows Store. http://p.sf.net/sfu/windows-dev2dev _______________________________________________ Ecls-list mailing list Ecls-list@lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/ecls-list
