Question

假设我们有两个包，每个包都定义一个类，并为相同名称的插槽/泛型方法导出符号。

(defpackage pkg1 (:export _class1 _slot _reader _method))
(in-package pkg1)
(defclass _class1 () ((_slot :initform "SLOT111" :initarg :slot :reader _reader)))
(defmethod _method ((self _class1)) (format t "SLOT-: ~a~%" (_reader self)))

(defpackage pkg2 (:export _class2 _slot _reader _method))
(in-package pkg2)
(defclass _class2 () ((_slot :initform "SLOT222" :initarg :slot :reader _reader)))
(defmethod _method ((self _class2)) (format t "SLOT=: ~a~%" (_reader self)))

我们如何在第三个包中导入这些符号，成功合并（而不是阴影）泛型？

(defpackage test)
(in-package test)
... ; here we somehow import symbols _slot, _reader and _method
    ; from both packages, so they get merged (like in 'GNU Guile' or 'Gauche')
(defvar v1 (make-instance '_class1))
(defvar v2 (make-instance '_class2))
(_reader v1) (_method v1) ; both must work
(_reader v2) (_method v2) ; and these too

Answer 1

对于CLOS，我真的是一个菜鸟，所以去年我做了同样的实验。我的发现是CL并不真正导出方法或合并方法。它导出可能具有绑定的符号。因此，您需要创建一个包含它们应该共享的符号的包，并将文档放在那里：

;; common symbols and documantation
(defpackage interface (:export _slot _reader _method))
(in-package interface)
(defgeneric _method (self)
  (:documentation "This does this functionality"))
(defgeneric _reader (self)
  (:documentation "This does that functionality"))

(defpackage pkg1 (:use :cl :interface) (:export _class1 _slot _reader _method))
(in-package pkg1)
(defclass _class1 () ((_slot :initform "SLOT111" :initarg :slot :reader _reader)))
(defmethod _method ((self _class1)) (format t "SLOT-: ~a~%" (_reader self)))

(defpackage pkg2 (:use :cl :interface) (:export _class2 _slot _reader _method))
(in-package pkg2)
(defclass _class2 () ((_slot :initform "SLOT222" :initarg :slot :reader _reader)))
(defmethod _method ((self _class2)) (format t "SLOT=: ~a~%" (_reader self)))

(defpackage test (:use :cl :pkg1 :pkg2))
(in-package test)
(defvar v1 (make-instance '_class1))
(defvar v2 (make-instance '_class2))
(_reader v1) ; ==> "SLOT111"
(_method v1) ; ==> nil (outputs "SLOT-: SLOT111")
(_reader v2) ; ==> "SLOT222"
(_method v2) ; ==> nil (outputs "SLOT-: SLOT222")

您可以通过测试检查发生了什么：

(describe '_method) 

_METHOD is the symbol _METHOD, lies in #<PACKAGE INTERFACE>, is accessible in 
4 packages INTERFACE, PKG1, PKG2, TEST, names a function.
Documentation as a FUNCTION:
This does this functionality

 #<PACKAGE INTERFACE> is the package named INTERFACE.
 It imports the external symbols of 1 package COMMON-LISP and 
 exports 3 symbols to 2 packages PKG2, PKG1.

 #<STANDARD-GENERIC-FUNCTION _METHOD> is a generic function.
 Argument list: (INTERFACE::SELF)
 Methods:
 (_CLASS2)
 (_CLASS1)

(describe '_reader) 

_READER is the symbol _READER, lies in #<PACKAGE INTERFACE>, is accessible in 
 4 packages INTERFACE, PKG1, PKG2, TEST, names a function.
Documentation as a FUNCTION:
This does that functionality

 #<PACKAGE INTERFACE> is the package named INTERFACE.
 It imports the external symbols of 1 package COMMON-LISP and 
 exports 3 symbols to 2 packages PKG2, PKG1.

 #<STANDARD-GENERIC-FUNCTION _READER> is a generic function.
 Argument list: (INTERFACE::SELF)
 Methods:
 (_CLASS2)
 (_CLASS1)

如果从使用pkg1的程序包中获取此类实例，则会产生导致pkg2 _method对pkg2实例起作用的副作用。

现在这个房间里有一头大象。为什么不在interface中定义基类并将其添加为_class1和_class2的父类。只需进行一些更改，您就可以轻松完成此操作，但这并不是您所要求的。

Answer 2

在尝试通过MOP解决此任务后，我提出了一个更简单的解决方法：

(defmacro wrapping-import
          (sym-name &rest sym-list)
  `(defmethod ,sym-name
              (&rest args)
     (loop for sym in '(,@sym-list) do
           (let ((gf (symbol-function sym)))
             (if (compute-applicable-methods gf args)
               (return (apply gf args)))))
     (error "No applicable method found in ~A" ',sym-name)))

示例：

(defpackage p1 (:export say-type))
(in-package p1)
(defmethod say-type ((v integer)) "int")

(defpackage p2 (:export say-type))
(in-package p2)
(defmethod say-type ((v string)) "str")

(in-package cl-user)
(wrapping-import say-type p1:say-type p2:say-type)

(say-type "") ; -> "str"
(say-type 1) ; -> "int"

此外，这是原始解决方案：

(defmacro merging-import
          (sym-name &rest sym-list)
  (let ((gf-args (clos:generic-function-lambda-list
                  (symbol-function (first sym-list)))))
    `(progn
       (defgeneric ,sym-name ,gf-args)
       (loop for sym in '(,@sym-list) do
             (loop for meth
                   in (clos:generic-function-methods (symbol-function sym))
                   do
                   (add-method #',sym-name
                               (make-instance 'clos:standard-method
                                              :lambda-list  (clos:method-lambda-list  meth)
                                              :specializers (clos:method-specializers meth)
                                              :function     (clos:method-function     meth))))))))

请注意，即使通用功能的签名不匹配，wrapping-import 也可以，而merging-import 需要他们的lambda列表平等现在我想知道：为什么我们要在2017年发明这样的东西？为什么那些不在标准中呢？

以防有人需要它 - 一个宏，就像Python中的from pkg import *一样：

(defmacro use-all-from
          (&rest pkg-list)
  `(loop for pkg-name in '(,@pkg-list) do
         (do-external-symbols
          (sym (find-package pkg-name))
          (shadowing-import (read-from-string (format nil "~a:~a"
                                                      pkg-name sym))))))

Common Lisp：CLOS和包/如何导入和合并泛型

2 个答案: