In common lisp, how can I check the type of an obj

问题:

I want to define a method that will specialize on an object of array type with unsigned byte 8 elements. In sbcl, when you (make-array x :element-type '(unsigned-byte 8)) the object class is implemented by SB-KERNEL::SIMPLE-ARRAY-UNSIGNED-BYTE-8. Is there an implementation independent way of specializing on unsigned-byte array types?

回答1:

Use a sharpsign-dot to insert the implementation dependent object class at read-time:

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

The sharpsign-dot reader macro evaluates the form at read-time, determining the class of the array. The method will be specialized on the class the particular Common Lisp implementation uses for the array.

回答2:

Notice that the :ELEMENT-TYPE argument to MAKE-ARRAY does something special and its exact behavior might be a bit surprising.

By using it, you are telling Common Lisp that the ARRAY should be able to store items of that element type or some of its subtypes.

The Common Lisp system then will return an array that can store these elements. It may be a specialized array or an array that can also store more general elements.

Notice: it is not a type declaration and it will not necessarily be checked at compile or runtime.

The function UPGRADED-ARRAY-ELEMENT-TYPE tells you what element an array may actually be upgraded to.

LispWorks 64bit:

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)

So, Lispworks 64bit has special arrays for 4 and 8 bit elements. For 12 bit elements it allocates an array which can store up to 16bit elements.

We generate an array which can store ten numbers of upto 12 bits:

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

Let's check its type:

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

It is a simple array (non-adjustable, no fill pointer). It can store elements of type (UNSIGNED-BYTE 16) and its subtypes. It is of length 10 and has one dimension.

回答3:

In a normal function you could use etypecase to do the dispatch:

The following code isn't self-contained but should give an idea how to implement a function that does point-wise operations when the even for 3D arrays:

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

Here is the code:

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