我们开始吧:我的问题的部分答案/解决方案(为什么是部分的?见下文)。非常感谢 sds 帮助我解决这个问题!
让我首先澄清一下。当我最初提出问题时,我不准确地使用了“参数类型”这个术语,只考虑了一个模糊的定义,即“依赖于参数的类型”。我基本上想要一些小工具,让我可以编写以下伪代码(用伪语言):
class List<T> {
//implementation
};
l = new List<string>;
l.push("Hello World!");
理解上述伪代码非常简单(参见 sds 的回答)。然而,如果人们开始怀疑表达式List<T>
及其List
本身是否应该有意义,就会产生歧义。实际上,例如在 C++ 中,表达式将是未定义的,因为模板定义的效果
template <typename T>
class List {
public:
T car;
List<T> *cdr;
};
好像为每个 type 单独定义T
一个 type List<T>
。相比之下,在像 Java 这样实现泛型类型的语言中,表达式List<T>
(其中T
是一个自由变量)是有意义的并表示一个类型,即某个类型的列表的泛型类型,因此T
可以编写一个多态函数,例如
T car(List<T> l) {
return l.car;
}
简而言之,在 C++ 中,我们只有所有类型的(无限)集合,所有类型都运行在所有类型List<T>
上T
,而在 Java 中,这个集合本身作为语言中的对象存在,作为泛型类型List<T>
。
现在来看看我提出的部分解决方案,在编写实际的 Lisp 代码之前,我将用文字简要介绍一下。解决方案是基于类型族和这些族的依赖总和,即我们将像List<T>
上面的类型这样的参数类型解释为一个参数的函数List
,其值是类型,我们将 Java 风格的泛型类型伪装List<T>
成依赖总和类型 DepSum(List)
,它只是由对(a,b)
where a
is some type 和b
is of type组成List(b)
。
回到在集合上定义一个实向量空间的例子X
,我想写一些类似的东西
(defclassfamily RealVectorSpaceOver (X) ()
((add :initarg :add
:reader add
:type (function (X X) X))
(s-mult :initarg :s-mult
:reader s-mult
:type (function (real X) X)))
为我定义一个函数 RealVectorSpaceOver ,给定一个 class A
,将返回一个类,就像手动定义的一样
(defclass RealVectorSpaceOverA ()
((add :initarg :add
:reader add
:type (function (A A) A))
(s-mult :initarg :s-mult
:reader s-mult
:type (function (real A) A)))
基本上,我可以在这里复制粘贴 sds 的解决方案,但这有两个问题。首先,结果不会是(无副作用的)函数,例如表单
(typep (make-instance (RealVectorSpaceOver A)
:add (lambda (x y) nil)
:s-mult (lambda (x y) nil))
(RealVectorSpaceOver A))
将评估为,nil
因为这里有两个调用RealVectorSpaceOver
,每个调用都会创建一个新的(因此不同的)类。因此,我们需要将这个函数包装在一些代码中,以便在第一次调用它时缓存结果。
另一个问题是使用defclass
以编程方式创建类具有更改类名称空间的效果,可能会重新定义现有类。为了避免这种情况,可以通过实例化元类来直接创建新类standard-class
。例如
(make-instance 'standard-class
:name (intern "B")
:direct-superclasses '(A)
:direct-slots '((x :initargs (:x) :readers (x))))
相当于
(defclass B (A)
((x :initarg :x :reader x)))
但不会重新定义任何预先存在的类B
。请注意,参数的格式与定义插槽的格式:direct-slots
略有不同。defclass
使用canonicalize-direct-slot-defs
将后者转换为前者的辅助函数(取自“元对象协议的艺术”一书),宏defclassfamily
可以实现如下:
(defmacro defclassfamily (name variables superclasses slot-defs)
(let ((stripped-variables (strip-variables variables))
(variable-types (types-of-variables variables))
(type-decls (type-decls-from-variables variables)))
`(flet ((f ,stripped-variables
(make-instance 'standard-class
:name (intern (format nil "~S<~S>" ',name (list ,@stripped-variables)))
:direct-superclasses ,superclasses
:direct-slots ,(canonicalize-direct-slots slot-defs))))
(let ((g (cache-function #'f)))
(defun ,name ,stripped-variables
,@type-decls
(the standard-class (funcall g ,@stripped-variables)))
(defmethod argument-signature ((x (eql #',name)))
',variable-types)))))
上面的代码首先定义了一个f
表示所需类型族的函数,然后g
使用辅助函数cache-function
(插入您自己的实现)创建它的缓存版本,然后使用在名称空间中定义一个新函数defun
,强制参数的类型(defclassfamily
接受类似于 的类型化参数defmethod
,因此(defclassfamily F ((X Set) Y) ...
将定义一个F
由两个参数组成的系列,第一个是 type Set
)和类系列的返回值。此外,还有一些简单的辅助函数strip-variables
, types-of-variables
, 和type-decls-from-variables
在给定类型族变量的情况下转换表达式((X Set) Y
在前面的示例中)。它们定义如下:
(defun strip-variables (specialized-lambda-list)
(mapcar (lambda (x)
(if (consp x)
(car x)
x))
specialized-lambda-list))
(defun types-of-variables (var-declarations)
(mapcar (lambda (var-declaration) (if (consp var-declaration) (second var-declaration) t)) var-declarations))
(defun type-decls-from-variables (var-declarations)
(mapcar (lambda (var-declaration)
(if (consp var-declaration)
`(declare (type ,(second var-declaration) ,(first var-declaration)))
`(declare (type t ,var-declaration))))
var-declarations))
最后,我们用一个方法记录我们家的参数类型argument-signature
,这样
(argument-signature (defclassfamily F ((X Set) Y) ... ))
将评估为(Set t)
.
一个参数的类型族的依赖和由以下代码实现:
(defclass DepSum (standard-class)
((family :initarg :family :reader family)
(arg-type :initarg :arg-type :reader arg-type)))
(defmethod make-instance :before ((sum-class DepSum) &key pr1 pr2)
(assert (and (typep pr1 (arg-type sum-class))
(typep pr2 (funcall (family sum-class) pr1)))))
(defmethod sb-mop:validate-superclass ((class DepSum) (super-class standard-class))
t)
(defun depsum (f)
(let ((arg-type (car (argument-signature f))))
(make-instance 'DepSum
:name (intern (format nil "DepSum_{x:~A} ~A(x)" arg-type f))
:direct-superclasses ()
:direct-slots `((:name pr1 :initargs (:pr1) :readers (pr1) :type ,arg-type)
(:name pr2 :initargs (:pr2) :readers (pr2)))
:direct-slots `((:name pr1 :initargs (:pr1) :readers (pr1)))
:family f
:arg-type arg-type)))
这样我们就可以RealVectorSpace
使用
(let ((rvs-type (depsum #'RealVectorSpaceOver)))
(deftype RealVectorSpace ()
rvs-type))
和写
(make-instance (depsum #'RealVectorSpaceOver) :pr1 X :pr2 some-rvs-over-X)
创建一个类型的对象RealVectorSpace
。上面的代码通过创建一个元类(即 的子类standard-class
)来工作DepSum
,它表示所有依赖和的类型,其实例是特定家族的依赖和。类型安全是通过挂接到诸如(make-instance (depsum #'RealVectorSpaceOver) ...)
via之类的调用来强制执行的(defmethod make-instance :before ((sum-class DepSum ...
。不幸的是,我们似乎不得不依赖assert
这种类型检查(我无法弄清楚如何使它与declare
. 最后,代码(defmethod sb-mop:validate-superclass ...
是依赖于实现的(在这种情况下是 SBCL)并且是必要的,以便能够实例化DepSum
like的实例(depsum #'RealVectorSpaceOver)
。
为什么这只是部分答案?因为我没有使向量空间公理成为RealVectorSpaceOver
(或RealVectorSpace
)类型的一部分。事实上,这样的事情需要在调用(make-instance (RealVectorSpaceOver X) ...
. 这样的事情在像 Coq 这样的花哨语言中当然是可能的,但在 Common Lisp 那个古老但可爱的混乱中似乎完全遥不可及。