- #'(lambda (methods known-types)
- (if (or sorted-p
- (block one-order-p
- (let ((sorted-methods nil))
- (map-all-orders
- (copy-list methods) precedence
- #'(lambda (methods)
- (when sorted-methods (return-from one-order-p nil))
- (setq sorted-methods methods)))
- (setq methods sorted-methods))
- t))
- `(methods ,methods ,known-types)
- `(unordered-methods ,methods ,known-types)))
- #'(lambda (position type true-value false-value)
- (let ((arg (dfun-arg-symbol position)))
- (if (eq (car type) 'eql)
- (let* ((false-case-p (and (consp false-value)
- (or (eq (car false-value) 'scase)
- (eq (car false-value) 'mcase))
- (eq arg (cadr false-value))))
- (false-clauses (if false-case-p
- (cddr false-value)
- `((t ,false-value))))
- (case-sym (if (and (dnet-methods-p true-value)
- (if false-case-p
- (eq (car false-value) 'mcase)
- (dnet-methods-p false-value)))
- 'mcase
- 'scase))
- (type-sym `(,(cadr type))))
- `(,case-sym ,arg
- (,type-sym ,true-value)
- ,@false-clauses))
- `(if ,(let ((arg (dfun-arg-symbol position)))
- (case (car type)
- (class `(class-test ,arg ,(cadr type)))
- (class-eq `(class-eq-test ,arg ,(cadr type)))))
- ,true-value
- ,false-value))))
+ (lambda (methods known-types)
+ (if (or sorted-p
+ (block one-order-p
+ (let ((sorted-methods nil))
+ (map-all-orders
+ (copy-list methods) precedence
+ (lambda (methods)
+ (when sorted-methods (return-from one-order-p nil))
+ (setq sorted-methods methods)))
+ (setq methods sorted-methods))
+ t))
+ `(methods ,methods ,known-types)
+ `(unordered-methods ,methods ,known-types)))
+ (lambda (position type true-value false-value)
+ (let ((arg (dfun-arg-symbol position)))
+ (if (eq (car type) 'eql)
+ (let* ((false-case-p (and (consp false-value)
+ (or (eq (car false-value) 'scase)
+ (eq (car false-value) 'mcase))
+ (eq arg (cadr false-value))))
+ (false-clauses (if false-case-p
+ (cddr false-value)
+ `((t ,false-value))))
+ (case-sym (if (and (dnet-methods-p true-value)
+ (if false-case-p
+ (eq (car false-value) 'mcase)
+ (dnet-methods-p false-value)))
+ 'mcase
+ 'scase))
+ (type-sym `(,(cadr type))))
+ `(,case-sym ,arg
+ (,type-sym ,true-value)
+ ,@false-clauses))
+ `(if ,(let ((arg (dfun-arg-symbol position)))
+ (case (car type)
+ (class `(class-test ,arg ,(cadr type)))
+ (class-eq `(class-eq-test ,arg ,(cadr type)))))
+ ,true-value
+ ,false-value))))