This means that `merge-class-lists' now needs a CLASS argument, hence
the noise.
\begin{describe}{gf}{compute-cpl @<class> @> @<list>}
\end{describe}
\begin{describe}{gf}{compute-cpl @<class> @> @<list>}
\end{describe}
-\begin{describe}{fun}{merge-class-lists @<lists> @<pick> @> @<list>}
+\begin{describe}{fun}{merge-class-lists @<class> @<lists> @<pick> @> @<list>}
\end{describe}
\begin{describe}{gf}{compute-chains @<class> @> @<list>}
\end{describe}
\begin{describe}{gf}{compute-chains @<class> @> @<list>}
;;; Utilities.
(export 'merge-class-lists)
;;; Utilities.
(export 'merge-class-lists)
-(defun merge-class-lists (lists pick)
- "Merge the LISTS of classes, using PICK to break ties.
+(defun merge-class-lists (class lists pick)
+ "Merge the LISTS of subclasses of CLASS, using PICK to break ties.
This is a convenience wrapper around the main `merge-lists' function.
Given that class linearizations (almost?) always specify a custom
tiebreaker function, this isn't a keyword argument."
This is a convenience wrapper around the main `merge-lists' function.
Given that class linearizations (almost?) always specify a custom
tiebreaker function, this isn't a keyword argument."
- (merge-lists lists :pick pick))
+ (handler-case (merge-lists lists :pick pick)
+ (inconsistent-merge-error ()
+ (error "Failed to compute class precedence list for `~A'"
+ (sod-class-name class)))))
;;; Tiebreaker functions.
;;; Tiebreaker functions.
(remove-duplicates (cons class
(mappend #'superclasses
direct-supers))))))
(remove-duplicates (cons class
(mappend #'superclasses
direct-supers))))))
- (merge-class-lists (mapcar (lambda (c)
+ (merge-class-lists class
+ (mapcar (lambda (c)
(cons c (sod-class-direct-superclasses c)))
(superclasses class))
#'clos-tiebreaker)))
(cons c (sod-class-direct-superclasses c)))
(superclasses class))
#'clos-tiebreaker)))
(let* ((direct-supers (sod-class-direct-superclasses class))
(cpls (mapcar #'sod-class-precedence-list direct-supers)))
(let* ((direct-supers (sod-class-direct-superclasses class))
(cpls (mapcar #'sod-class-precedence-list direct-supers)))
- (merge-class-lists (cons (cons class direct-supers) cpls)
+ (merge-class-lists class
+ (cons (cons class direct-supers) cpls)
#'clos-tiebreaker)))
(export 'c3-cpl)
#'clos-tiebreaker)))
(export 'c3-cpl)
(let* ((direct-supers (sod-class-direct-superclasses class))
(cpls (mapcar #'sod-class-precedence-list direct-supers)))
(let* ((direct-supers (sod-class-direct-superclasses class))
(cpls (mapcar #'sod-class-precedence-list direct-supers)))
- (merge-class-lists (cons (cons class direct-supers) cpls)
+ (merge-class-lists class
+ (cons (cons class direct-supers) cpls)
(lambda (candidates so-far)
(declare (ignore so-far))
(c3-tiebreaker candidates cpls)))))
(lambda (candidates so-far)
(declare (ignore so-far))
(c3-tiebreaker candidates cpls)))))
(let ((dfs (flavors-cpl class)))
(cons class
(let ((dfs (flavors-cpl class)))
(cons class
- (merge-class-lists (mapcar #'sod-class-precedence-list
+ (merge-class-lists class
+ (mapcar #'sod-class-precedence-list
(sod-class-direct-superclasses class))
(lambda (candidates so-far)
(declare (ignore so-far))
(sod-class-direct-superclasses class))
(lambda (candidates so-far)
(declare (ignore so-far))
;;; Default function.
(defmethod compute-cpl ((class sod-class))
;;; Default function.
(defmethod compute-cpl ((class sod-class))
- (handler-case (c3-cpl class)
- (inconsistent-merge-error ()
- (error "Failed to compute class precedence list for `~A'"
- (sod-class-name class)))))
;;;--------------------------------------------------------------------------
;;; Chains.
;;;--------------------------------------------------------------------------
;;; Chains.