在常见的lisp中,如何以便携方式检查对象的类型

时间:2011-05-21 17:12:45

标签: lisp common-lisp

我想定义一个专门用于带有无符号字节8元素的数组类型对象的方法。在sbcl中,当您(make-array x :element-type '(unsigned-byte 8))时,对象类由SB-KERNEL :: SIMPLE-ARRAY-UNSIGNED-BYTE-8实现。是否有一种独立于实现的方式专门研究无符号字节数组类型?

3 个答案:

答案 0 :(得分:11)

使用sharpsign-dot在读取时插入依赖于实现的对象类:

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

sharpsign-dot reader宏在读取时评估表单,确定数组的类。该方法将专门用于特定Common Lisp实现用于该数组的类。

答案 1 :(得分:4)

请注意:ELEMENT-TYPE的{​​{1}}参数做了一些特别的事情,其确切的行为可能有点令人惊讶。

通过使用它,您告诉Common Lisp ARRAY应该能够存储该元素类型或其某些子类型的项目。

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

注意:它不是类型声明,不一定要在编译或运行时检查。

函数MAKE-ARRAY告诉你实际可以升级数组的元素。

LispWorks 64bit:

UPGRADED-ARRAY-ELEMENT-TYPE

因此,Lispworks 64bit具有4位和8位元素的特殊数组。对于12位元素,它分配一个可以存储多达16位元素的数组。

我们生成一个数组,可以存储10个最多12位的数字:

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)

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

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)) 类型的元素及其子类型。 它长10,有一个维度。

答案 2 :(得分:0)

在正常功能中,您可以使用etypecase进行调度:

以下代码不是自包含的,但应该知道如何实现 一个函数,当3D数组的偶数时执行逐点运算:

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