Common Lisp：CLOSとパッケージ/ジェネリックをインポートしてマージする方法

Question

2つのパッケージがあり、それぞれがスロット/ジェネリックメソッドのクラスとエクスポートシンボルを定義し、の同名の名前とします。

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

第3のパッケージでこれらのシンボルをインポートすると、どのようにして正常にマージされます（シャドーイングではありません）。

(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

MOPを経由して、このタスクを解決しようとした後、私はずっとsimplierの回避策を思い付いた：

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

例：

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

：

また

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

、ここではオリジナルのソリューションです

wrapping-import作品汎用関数のシグネチャが一致しない場合でも、merging-importの場合は、ラムダリストが等しくなるようにが必要です。
今私はなぜ2017年にこのようなことを発明しなければならないのでしょうか？なぜそれらはまだ標準にないのですか？

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

Answer 2

私は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に定義し、それを_class1と_class2の親クラスとして追加するのはなぜでしょうか。しかし、それはあなたが求めていたものではありませんでした。