Contextl patch: make ensure-layered-method work with function objects as well as names.

[Drew Crampsie]

Hello,

In lol i use ensure-layered-method directly on generic functions. I've
been using this modified version of ensure-layered-method and thought
i'd try and sneak it in :).

(defun ensure-layered-method
(layered-function-designator
lambda-expression
&key
(layered-function
(if (functionp layered-function-designator)
layered-function-designator
(fdefinition (lf-definer-name layered-function-designator))))
#-(or allegro clisp cmu ecl mcl openmcl)
(method-class
(generic-function-method-class
layered-function))
(in-layer 't)
(qualifiers ())
(lambda-list (cadr lambda-expression))
(specializers (required-args lambda-list (constantly (find-class 't)))))
(let ((layer-arg (gensym "LAYER-ARG-")))
(destructuring-bind
(lambda (&rest args) &body body)
lambda-expression
(unless (eq lambda 'lambda)
(error "Incorrect lambda expression: ~S." lambda-expression))
(ensure-method layered-function
`(lambda (,layer-arg ,@args) ,@body)
#-(or allegro clisp cmu ecl mcl openmcl) :method-class
#-(or allegro clisp cmu ecl mcl openmcl) method-class
:qualifiers qualifiers
:lambda-list `(,layer-arg ,@lambda-list)
:specializers (cons (find-layer-class in-layer)
specializers)))))

Cheers,

drewc

[Pascal Costanza]

Hi Drew,

Thanks a lot for this patch, this is indeed an improvement. I will
include it in the repository ASAP.


Best,
Pascal

Post by Drew Crampsie
Hello,
In lol i use ensure-layered-method directly on generic functions. I've
been using this modified version of ensure-layered-method and thought
i'd try and sneak it in :).
(defun ensure-layered-method
(layered-function-designator
lambda-expression
&key
(layered-function
(if (functionp layered-function-designator)
layered-function-designator
(fdefinition (lf-definer-name layered-function-designator))))
#-(or allegro clisp cmu ecl mcl openmcl)
(method-class
(generic-function-method-class
layered-function))
(in-layer 't)
(qualifiers ())
(lambda-list (cadr lambda-expression))
(specializers (required-args lambda-list (constantly (find-
class 't)))))
(let ((layer-arg (gensym "LAYER-ARG-")))
(destructuring-bind
(lambda (&rest args) &body body)
lambda-expression
(unless (eq lambda 'lambda)
(error "Incorrect lambda expression: ~S." lambda-expression))
(ensure-method layered-function
#-(or allegro clisp cmu ecl mcl openmcl) :method-
class
#-(or allegro clisp cmu ecl mcl openmcl) method-
class
:qualifiers qualifiers
:specializers (cons (find-layer-class in-layer)
specializers)))))
Cheers,
drewc
_______________________________________________
closer-devel mailing list
http://common-lisp.net/cgi-bin/mailman/listinfo/closer-devel

[Pascal Costanza]

Hi,

OK, I have added a slightly modified version to the repository. Thanks
a lot again for this patch.

Best,
Pascal

Post by Drew Crampsie
Hello,
In lol i use ensure-layered-method directly on generic functions. I've
been using this modified version of ensure-layered-method and thought
i'd try and sneak it in :).
(defun ensure-layered-method
(layered-function-designator
lambda-expression
&key
(layered-function
(if (functionp layered-function-designator)
layered-function-designator
(fdefinition (lf-definer-name layered-function-designator))))
#-(or allegro clisp cmu ecl mcl openmcl)
(method-class
(generic-function-method-class
layered-function))
(in-layer 't)
(qualifiers ())
(lambda-list (cadr lambda-expression))
(specializers (required-args lambda-list (constantly (find-
class 't)))))
(let ((layer-arg (gensym "LAYER-ARG-")))
(destructuring-bind
(lambda (&rest args) &body body)
lambda-expression
(unless (eq lambda 'lambda)
(error "Incorrect lambda expression: ~S." lambda-expression))
(ensure-method layered-function
#-(or allegro clisp cmu ecl mcl openmcl) :method-
class
#-(or allegro clisp cmu ecl mcl openmcl) method-
class
:qualifiers qualifiers
:specializers (cons (find-layer-class in-layer)
specializers)))))
Cheers,
drewc
_______________________________________________
closer-devel mailing list
http://common-lisp.net/cgi-bin/mailman/listinfo/closer-devel