Question

我定义了一个带有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并且能够知道我必须定义的参数的类型。

Answer 1

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

我可以建议两个选项 - 当你只有两个参数时，一个工作但是hacky选项，以及一个模糊概述的通用方法，我认为应该有效，但我还没写过：

选项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
   )
 )

Answer 2

所以你要找的是类对象上的任意linear order。类名的字符串顺序怎么样？

(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)))))

通用函数允许不同的参数顺序

2 个答案: