0

我定义了一个带有 2 个参数的通用函数：

(defgeneric interact (a b))

(interact x y)参数的顺序不应该很重要，所以(interact y x)应该是相同的，但是我不想定义两个对不同对象的每个组合都执行相同操作的方法。

这种类型的方法组合应该有助于：

(defmethod interact :around (a b)
  (if (some-function a b)
    ;;some-function has to be true if (eq (class-of a) (class-of b))
    ;;else (some-function a b) is (not (some-function b a))
    ;;similar #'<=
    (call-next method)
    (interact b a))

但是我必须知道#'some-function并且能够知道我必须定义的论点的类型。

4

2 回答 2

1

编辑：两种提议的方法都有一些限制，在下面的评论中讨论。请在使用此答案之前阅读它们！

我可以建议两个选项 - 当你只有两个参数时，一个可行但很老套的选项，以及一个我认为应该可行但我没有写的模糊勾勒出的通用方法：

选项1：

(defparameter *in-interact-generic-call* nil)

(defgeneric interact (x y))

(defmethod interact ((x T) (y T))
  ; this can be called on pretty much anything
  (if *in-interact-generic-call*
    (cause-some-kind-of-error) ; Replace this with a more sensible error call
    (let ((*in-interact-generic-call* T))
      (interact y x))))

(defmethod interact ((x integer) (y string))
  ; example
  (print x )(prin1 y))

(interact 5 "hello") ; should print 5 "hello"
(interact "hello" 5) ; should print 5 "hello"
;(interact "hello" "hello") ; should cause an error

本质上，这个想法是定义一个总是匹配任何东西的通用函数，用它来尝试交换参数（看看是否匹配更好），如果它已经交换了参数然后引发某种错误（我没有真的在这里做到了）。

选项 2

将通用函数定义为类似interact-impl. 实际调用标准函数（由 定义defun）interact。

在interact中，在参数顺序的所有排列上定义一个循环。对于每个排列尝试调用interact-impl（例如使用(apply #'interact-impl current-permutation).）

至少在 sbcl 中，没有匹配的参数给我一个simple-error. 您可能想要更详细地检查它实际上是正确的错误。因此，代码interact看起来像

; completely untested!
(do (all-permutations all-permutations (cdr all-permutations))
   (...) ; some code to detect when all permutations are exhausted and raise an error
   (let (current-permutation (first all-permutations))
      (handler-case
         (return (apply #'interact-impl current-permutation))
         (simple-error () nil)) ; ignore and try the next option
   )
 )
于 2015-03-29T16:07:56.743 回答
0

所以你正在寻找的是类对象上的任意线性顺序。类名的字符串顺序如何？

(defun class-less-p (a b)
  "Lexicographic order on printable representation of class names."
  (let* ((class-a (class-of a))
         (name-a (symbol-name class-a))
         (pack-a (package-name (symbol-package name-a)))
         (class-b (class-of b))
         (name-b (symbol-name class-b))
         (pack-b (package-name (symbol-package name-b))))
    (or (string< pack-a pack-b)
        (and (string= pack-a pack-b)
             (string<= name-a name-b)))))
于 2015-03-29T14:05:49.963 回答