--- Raymond Toy <[EMAIL PROTECTED]:
>
> >>>>> "Wendall" == Wendall Marvel
> <wmwmarvelahoo.com> writes:
>
> Wendall> If I found the time and actually
> figured out a patch
> Wendall> for pcpcluch that the above example
> works as I think
> Wendall> it should, is that something that the
> cmcmucl> Wendall> maintainers would be
interested in
> accepting?
>
> Patches are always welcome. I don't know enough
> about CLCLOSo say
> what the correct behavior is or even what the
> desired behavior should
> be.
>
> Ray
>
>
Here's a patch that makes PCPCLo what I think it
ought.
Of course, there's no guarantee that it's correct
behavior, but I think it's sane, and I desire it. :)
It's a patch against the 18e source, since that's the
cmucl I'm using, but I'm willing to pull down newer
source and create a patch against that if a patch
against 18e isn't good enough.
It's sort of a long patch, although it's really not a
huge change.
*** bak/defcombin.lisp Tue Dec 2 01:20:24 2003
--- defcombin.lisp Tue Dec 2 02:06:38 2003
***************
*** 331,337 ****
(defun wrap-method-group-specifier-bindings
(method-group-specifiers declarations
real-body)
(let ((names ())
- (specializer-caches ())
(cond-clauses ())
(required-checks ())
(order-cleanups ()))
--- 331,336 ----
***************
*** 339,375 ****
(multiple-value-bind (name tests description
order required)
(parse-method-group-specifier
method-group-specifier)
(declare (ignore description))
! (let ((specializer-cache (gensym)))
! (push name names)
! (push specializer-cache specializer-caches)
! (push `((or ,@tests)
! (if (and (equal ,specializer-cache
.specializers.)
! (not (null .specializers.)))
! (return-from
.long-method-combination-function.
! '(error "More than one method of type ~S ~
! with the same
specializers."
! ',name))
! (setq ,specializer-cache .specializers.))
! (push .method. ,name))
! cond-clauses)
! (when required
! (push `(when (null ,name)
! (return-from
.long-method-combination-function.
! '(error "No ~S methods." ',name)))
! required-checks))
! (loop (unless (and (constantp order)
! (neq order (setq order (eval order))))
! (return t)))
! (push (cond ((eq order :most-specific-first)
! `(setq ,name (nreverse ,name)))
! ((eq order :most-specific-last) ())
! (t
! `(ecase ,order
! (:most-specific-first
! (setq ,name (nreverse ,name)))
! (:most-specific-last))))
! order-cleanups))))
! `(let (,@(nreverse names) ,@(nreverse
specializer-caches))
,@declarations
(dolist (.method. .applicable-methods.)
(let ((.qualifiers. (method-qualifiers .method.))
--- 338,363 ----
(multiple-value-bind (name tests description
order required)
(parse-method-group-specifier
method-group-specifier)
(declare (ignore description))
! (push name names)
! (push `((or ,@tests) (push .method. ,name))
cond-clauses)
! (when required
! (push `(when (null ,name)
! (return-from
.long-method-combination-function.
! '(error "No ~S methods."
',name)))
! required-checks))
! (loop (unless (and (constantp order)
! (neq order (setq order
(eval order))))
! (return t)))
! (push (cond ((eq order :most-specific-first)
! `(setq ,name (nreverse ,name)))
! ((eq order :most-specific-last)
())
! (t
! `(ecase ,order
! (:most-specific-first
! (setq ,name (nreverse
,name)))
! (:most-specific-last))))
! order-cleanups)))
! `(let (,@(nreverse names))
,@declarations
(dolist (.method. .applicable-methods.)
(let ((.qualifiers. (method-qualifiers .method.))
__________________________________
Do you Yahoo!?
Free Pop-Up Blocker - Get it now
http://companion.yahoo.com/
