在common lisp中，如何以可移植的方式检查对象的类型

我想定义一个方法，专门处理具有无符号字节8元素的数组类型的对象。在sbcl中，当您

（生成数组x:element type'（无符号字节8））

时，对象类由SB-KERNEL:：SIMPLE-array-unsigned-byte-8实现。是否有一种独立于实现的方法专门处理无符号字节数组类型

在读取时使用锐符号点插入依赖于实现的对象类：

(defmethod foo ((v #.(class-of (make-array 0 :element-type '(unsigned-byte 8)))))
  :unsigned-byte-8-array)

---

reader宏在读取时计算窗体，确定数组的类。该方法将专用于特定公共Lisp实现用于数组的类

注意，

MAKE-ARRAY

的

：ELEMENT-TYPE

参数做了一些特殊的事情，它的确切行为可能有点令人惊讶

通过使用它，您告诉Common Lisp数组应该能够存储该元素类型或其某些子类型的项

然后，公共Lisp系统将返回一个可以存储这些元素的数组。它可以是一个专用数组，也可以是一个可以存储更多通用元素的数组

注意：它不是一个类型声明，也不一定在编译或运行时进行检查

函数

UPGRADED-ARRAY-ELEMENT-TYPE

告诉您阵列实际上可以升级到哪个元素

LispWorks 64位：

CL-USER 10 > (upgraded-array-element-type '(unsigned-byte 8))
(UNSIGNED-BYTE 8)

CL-USER 11 > (upgraded-array-element-type '(unsigned-byte 4))
(UNSIGNED-BYTE 4)

CL-USER 12 > (upgraded-array-element-type '(unsigned-byte 12))
(UNSIGNED-BYTE 16)

因此，Lispworks 64位具有用于4位和8位元素的特殊阵列。对于12位元素，它分配一个最多可存储16位元素的数组

我们生成一个数组，可以存储10个数字，最多12位：

CL-USER 13 > (make-array 10
                         :element-type '(unsigned-byte 12)
                         :initial-element 0)
#(0 0 0 0 0 0 0 0 0 0)

让我们检查一下它的类型：

CL-USER 14 > (type-of *)
(SIMPLE-ARRAY (UNSIGNED-BYTE 16) (10))

它是一个简单的数组（不可调，无填充指针）。 它可以存储

（无符号字节16）

类型的元素及其子类型。

---

它的长度为10，有一个维度。

在正常函数中，您可以使用etypecase进行调度：

下面的代码不是自包含的，但应该给出如何实现的想法 当三维阵列的偶数为时，执行逐点操作的函数：

(.* (make-array 3 :element-type 'single-float
                :initial-contents '(1s0 2s0 3s0))
    (make-array 3 :element-type 'single-float
                :initial-contents '(2s0 2s0 3s0)))

代码如下：

(def-generator (point-wise (op rank type) :override-name t)
  (let ((name (format-symbol ".~a-~a-~a" op rank type)))
    (store-new-function name)
    `(defun ,name (a b &optional (b-start (make-vec-i)))
       (declare ((simple-array ,long-type ,rank) a b)
                (vec-i b-start)
                (values (simple-array ,long-type ,rank) &optional))
       (let ((result (make-array (array-dimensions b)
                                 :element-type ',long-type)))
         ,(ecase rank
            (1 `(destructuring-bind (x)
                   (array-dimensions b)
                 (let ((sx (vec-i-x b-start)))
                   (do-region ((i) (x))
                     (setf (aref result i)
                           (,op (aref a (+ i sx))
                              (aref b i)))))))
            (2 `(destructuring-bind (y x)
                   (array-dimensions b)
                 (let ((sx (vec-i-x b-start))
                       (sy (vec-i-y b-start)))
                   (do-region ((j i) (y x))
                     (setf (aref result j i)
                           (,op (aref a (+ j sy) (+ i sx))
                              (aref b j i)))))))
            (3 `(destructuring-bind (z y x)
                   (array-dimensions b)
                 (let ((sx (vec-i-x b-start))
                       (sy (vec-i-y b-start))
                       (sz (vec-i-z b-start)))
                   (do-region ((k j i) (z y x))
                     (setf (aref result k j i)
                         (,op (aref a (+ k sz) (+ j sy) (+ i sx))
                            (aref b k j i))))))))
         result))))
#+nil
(def-point-wise-op-rank-type * 1 sf)

(defmacro def-point-wise-functions (ops ranks types)
  (let ((specific-funcs nil)
        (generic-funcs nil))
    (loop for rank in ranks do
         (loop for type in types do
              (loop for op in ops do
                   (push `(def-point-wise-op-rank-type ,op ,rank ,type)
                         specific-funcs))))
    (loop for op in ops do
         (let ((cases nil))
           (loop for rank in ranks do
                (loop for type in types do
                     (push `((simple-array ,(get-long-type type) ,rank)
                             (,(format-symbol  ".~a-~a-~a" op rank type) 
                               a b b-start))
                           cases)))
           (let ((name (format-symbol ".~a" op)))
             (store-new-function name)
            (push `(defun ,name (a b &optional (b-start (make-vec-i)))
                       (etypecase a
                         ,@cases
                         (t (error "The given type can't be handled with a generic
                 point-wise function."))))  
                  generic-funcs))))
    `(progn ,@specific-funcs
            ,@generic-funcs)))

(def-point-wise-functions (+ - * /) (1 2 3) (ub8 sf df csf cdf))