Common Lisp：CLOS 和包/如何导入和合并泛型
Common Lisp: CLOS and packages / how to import and merge generics
假设我们有两个包，每个包定义一个 class 并为 slots/generic 方法导出符号 相同的名称.
(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
我对 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)
如果您从使用 pkg2 的包中获取这样的实例，那么导入 pkg1 _method 将在 pkg2 个实例上起作用的副作用。
现在这个房间里有一头大象。为什么不在 interface 中定义基数 class 并将其添加为 _class1 和 _class2 的父 class。只需进行一些更改即可轻松做到这一点，但这不是您所要求的。
在尝试通过 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))))))
假设我们有两个包，每个包定义一个 class 并为 slots/generic 方法导出符号 相同的名称.
(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
我对 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)
如果您从使用 pkg2 的包中获取这样的实例，那么导入 pkg1 _method 将在 pkg2 个实例上起作用的副作用。
现在这个房间里有一头大象。为什么不在 interface 中定义基数 class 并将其添加为 _class1 和 _class2 的父 class。只需进行一些更改即可轻松做到这一点，但这不是您所要求的。
在尝试通过 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))))))