mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

In DEFINE-METHOD-COMBINATION, the keyword argument :ORDER must be evaluated.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-08-04 22:38:56 +02:00
parent e17bb7a5b6
commit d105c739a1
1 changed files with 8 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/clos/combin.lsp
View file

@ -237,6 +237,7 @@
(when (and (consp x) (eql (first x) :GENERIC-FUNCTION))
(setf body (rest body))
(unless (symbolp (setf generic-function (second x)))
(print 1)
(syntax-error))))
(dolist (group method-groups)
(destructuring-bind (group-name predicate &key description
@ -256,7 +257,7 @@
(if (eql q '*)
`(every #'equal ',p .METHOD-QUALIFIERS.)
`(equal ',p .METHOD-QUALIFIERS.))))))
(t (syntax-error)))))
(t (print 2) (syntax-error)))))
(push `(,condition (push .METHOD. ,group-name)) group-checks))
(when required
(push `(unless ,group-name
@ -267,7 +268,12 @@
(:most-specific-first
(push `(setf ,group-name (nreverse ,group-name)) group-after))
(:most-specific-last)
(otherwise (syntax-error)))))
(otherwise
(let ((order-var (gensym)))
(setf group-names (append group-names (list (list order-var order)))
group-after (list* `(when (eq ,order-var :most-specific-first)
(setf ,group-name (nreverse ,group-name)))
group-after)))))))
`(install-method-combination ',name
(ext::lambda-block ,name (,generic-function .methods-list. ,@lambda-list)
(let (,@group-names)