I have the following problem in a few MOP implementations, including
Allegro Common Lisp and SBCL (also CMUCL afaics).
I would like to be able to automatically add an extra argument on each
generic function call for my own generic function class. I do this by
adding the extra argument in the discriminating function. See the code
below:
#+lispworks (use-package :clos)
#+lispworks (import 'clos::compute-discriminating-function)
#+allegro (use-package :mop)
#+sbcl (use-package :sb-pcl)
(defclass my-generic-function (standard-generic-function)
()
(:metaclass funcallable-standard-class))
(defmethod initialize-instance :around
((gf my-generic-function)
&rest initargs
&key (lambda-list nil lambda-list-p))
(declare (dynamic-extent initargs))
(assert lambda-list-p)
(apply #'call-next-method
gf
:lambda-list `(extra-arg ,@lambda-list)
initargs))
(defmethod reinitialize-instance :around
((gf my-generic-function)
&rest initargs
&key (lambda-list nil lambda-list-p))
(declare (dynamic-extent initargs))
(apply #'call-next-method
gf
`(,@(when lambda-list-p
(list :lambda-list `(extra-arg ,@lambda-list)))
,@initargs)))
(defmethod compute-discriminating-function
((gf my-generic-function))
(let ((dfun (call-next-method)))
(lambda (&rest args)
(declare (dynamic-extent args))
(apply dfun 'extra-value args))))
(defgeneric test (x)
(:generic-function-class my-generic-function))
(defmethod test (extra-arg x)
(print extra-arg)
(print x))
(loop for i from 0 below 5
do (test i))
In LispWorks, I get a warning for the actual function call (saying that
I am not passing enough arguments), but in the end it works just fine.
In Allegro, it works for the very first call of the test function, but
on each subsequent call, I get a runtime error (until I call
reinitialize-instance on the generic function object, after which it
works again just once). In SBCL (and CMUCL), I get strange error
messages during compilation that don't seem to correspond to the actual
source of the problem, and I haven't been able to track this down.
(These error messages even change in unpredictable ways when I change
the source code.)
I am pretty sure that the code above is legal according the AMOP
specification. The simplest workaround would be to let the user pass the
extra argument on each call, but that's what I specifically want to
avoid. Other workarounds I have tried that involve tweaking qualifiers
and/or specializers don't work for one reason or the other.
If the code above is indeed legal, the respective MOP implementations
are not correct. Does anyone see any reason why it may not be legal?
Pascal
--
Tyler: "How's that working out for you?"
Jack: "Great."
Tyler: "Keep it up, then."
Pascal Costanza wrote:
> I have the following problem in a few MOP implementations, including
> Allegro Common Lisp and SBCL (also CMUCL afaics).
>
> I would like to be able to automatically add an extra argument on each
> generic function call for my own generic function class. I do this by
> adding the extra argument in the discriminating function.
In the meantime, I have browsed through the HyperSpec and have found
some sections that indicate that a Common Lisp implementation is allowed
to reject generic function calls that provide less arguments than the
function's lambda list expects. Since there exist good reasons why one
would want this, I can't follow that approach anymore. Luckily I have
found another way to achieve what I want yesterday, and I am pretty sure
that it is more portable than my previous solution. Hopefully, this
means that I will be able to release a new version of AspectL that runs
on a considerable number of implementations soon.
Another remark:
> #+sbcl (use-package :sb-pcl)
This should have been (use-package :sb-mop). I have been told that
:sb-pcl is an internal package of SBCL that shouldn't be used.
Pascal
--
Tyler: "How's that working out for you?"
Jack: "Great."
Tyler: "Keep it up, then."
> Hopefully, this
> means that I will be able to release a new version of AspectL that runs
> on a considerable number of implementations soon.
Great! Looking forward to trying it out.