anchor.diff:    (symbolicate var "-PTR"))
   
   
  -;;; module-info
  +;;;
  +;;; Definition of Kernel Manager
  +;;;
  +
  +;;; module info
  +;;; <module-info> ::= (<module-handle> <module-path> <module-compilation-needed)
   
   (defun make-module-info ()
     (list nil nil t))
  
positive.code: (in-package :cl-cuda)
  
  
  ;;; defcufun
  
  (defmacro defcufun (name-and-options return-type &body args)
    (let* ((name (car name-and-options))
  
negative.code:       `(progn ,@body)))
  
  
  ;;;
  ;;; Definition of Built-in Vector Types
  ;;;
  
  (defstruct (float3 (:constructor make-float3 (x y z)))
    (x 0.0 :type single-float)
    (y 0.0 :type single-float)
    (z 0.0 :type single-float))
  
  (defun float3-= (a b)
    (and (= (float3-x a) (float3-x b))
         (= (float3-y a) (float3-y b))
         (= (float3-z a) (float3-z b))))
  
  (cffi:defcstruct float3
    (x :float)
    (y :float)
    (z :float))
  
  (defstruct (float4 (:constructor make-float4 (x y z w)))
    (x 0.0 :type single-float)
    (y 0.0 :type single-float)
    (z 0.0 :type single-float)
    (w 0.0 :type single-float))
  
  (defun float4-= (a b)
    (and (= (float4-x a) (float4-x b))
         (= (float4-y a) (float4-y b))
         (= (float4-z a) (float4-z b))
         (= (float4-w a) (float4-w b))))
  
  (cffi:defcstruct float4
    (x :float)
    (y :float)
    (z :float)
    (w :float))
  
  
  ;;;
  ;;; Definition of cl-cuda types
  ;;;
  
  (defvar +basic-types+ '(void 0
                          int 4
                          float 4))
  
  (defvar +vector-type-table+ '(float3 float4))
  
  (defvar +vector-type-elements+ '(x y z w))
  
  (defun basic-type-p (type)
    (and (getf +basic-types+ type)
         t))
  
  (defun vector-type-p (type)
    (and (find type +vector-type-table+)
         t))
  
  (defun vector-type-length (type)
    ;; e.g. float3 => 3
    (unless (vector-type-p type)
      (error (format nil "invalid type: ~A" type)))
    (let ((str (symbol-name type)))
      (parse-integer (subseq str (1- (length str))))))
  
  (defun vector-type-base-type (type)
    ;; e.g. float3 => float
    (unless (vector-type-p type)
      (error (format nil "invalid type: ~A" type)))
    (cl-cuda-symbolicate (reverse (subseq (reverse (princ-to-string type)) 1))))
  
  (defun vector-type-selector-symbol (type elm)
    ;; e.g. float3 x => float3-x
    (unless (vector-type-p type)
      (error (format nil "invalid type: ~A" type)))
    (unless (find elm +vector-type-elements+)
      (error (format nil "invalid element: ~A" elm)))
    (cl-cuda-symbolicate (princ-to-string type) "-" (princ-to-string elm)))
  
  (defun vector-type-selector-return-type (selector)
    ;; e.g. float3-x => float
    (unless (find selector (vector-type-selector-symbols))
      (error (format nil "invalid selector: ~A" selector)))
    (cl-cuda-symbolicate
      (reverse (subseq (reverse (princ-to-string selector)) 3))))
  
  (defun vector-type-selector-symbols ()
    (labels ((aux (type)
               (loop repeat (vector-type-length type)
                     for elm in +vector-type-elements+
                  collect (vector-type-selector-symbol type elm))))
      (flatten
        (mapcar #'aux +vector-type-table+))))
  
  (defun non-pointer-type-p (type)
    (or (basic-type-p type)
        (vector-type-p type)))
  
  (defun pointer-type-p (type)
    (let ((type-str (symbol-name type)))
      (let ((last (aref type-str (1- (length type-str)))))
        (and (eq last #\*)
             (non-pointer-type-p (remove-star type))
             t))))
  
  (defun valid-type-p (type)
    (or (pointer-type-p type)
        (non-pointer-type-p type)))
  
  (defun add-star (type n)
    (labels ((aux (str n2)
               (if (< n2 1)
                   str
                   (aux (concatenate 'string str "*") (1- n2)))))
      (cl-cuda-symbolicate (aux (princ-to-string type) n))))
  
  (defun remove-star (type)
    (let ((rev (reverse (princ-to-string type))))
      (if (string= (subseq rev 0 1) "*")
          (remove-star (cl-cuda-symbolicate (reverse (subseq rev 1))))
          type)))
  
  (defun type-dimension (type)
    (unless (valid-type-p type)
      (error (format nil "invalid type: ~A" type)))
    (count #\* (princ-to-string type)))
  
  (defvar +cffi-type-table+ '(int :int
                              float :float))
  
  (defun cffi-type (type)
    (acond
      ((pointer-type-p type) 'cu-device-ptr)
      ((getf +cffi-type-table+ type) it)
      ((vector-type-p type) type)
      (t (error (format nil "invalid type: ~A" type)))))
  
  (defun basic-type-size (type)
    (getf +basic-types+ type))
  
  (defun vector-type-size (type)
    (* (vector-type-length type)
       (size-of (vector-type-base-type type))))
  
  (defun size-of (type)
    (cond
      ((pointer-type-p type) 4)
      ((basic-type-p type) (basic-type-size type))
      ((vector-type-p type) (vector-type-size type))
      (t (error (format nil "invalid type: ~A" type)))))
  
  
  ;;;
  ;;; Definition of Memory Block
  ;;;
  
  (defun alloc-memory-block (type n)
    (unless (non-pointer-type-p type)
      (error (format nil "invalid type: ~A" type)))
    (let ((cffi-ptr (cffi:foreign-alloc (cffi-type type) :count n))
          (device-ptr (cffi:foreign-alloc 'cu-device-ptr)))
      (cu-mem-alloc device-ptr (* n (size-of type)))
      (list cffi-ptr device-ptr type n)))
  
  (defun free-memory-block (blk)
    (if blk
        (let ((device-ptr (memory-block-device-ptr blk))
              (cffi-ptr (memory-block-cffi-ptr blk)))
          (cu-mem-free (cffi:mem-ref device-ptr 'cu-device-ptr))
          (cffi:foreign-free device-ptr)
          (cffi:foreign-free cffi-ptr)
          (setf device-ptr nil)
          (setf cffi-ptr nil))))
  
  (defun memory-block-cffi-ptr (blk)
    (car blk))
  
  (defun memory-block-device-ptr (blk)
    (cadr blk))
  
  (defun memory-block-type (blk)
    (caddr blk))
  
  (defun memory-block-cffi-type (blk)
    (cffi-type (memory-block-type blk)))
  
  (defun memory-block-length (blk)
    (cadddr blk))
  
  (defun memory-block-bytes (blk)
    (* (memory-block-element-bytes blk)
       (memory-block-length blk)))
  
  (defun memory-block-element-bytes (blk)
    (size-of (memory-block-type blk)))
  
  (defun memory-block-binding-var (binding)
    (match binding
      ((var _ _) var)
      (_ (error (format nil "invalid memory block binding: ~A" binding)))))
  
  (defun memory-block-binding-type (binding)
    (match binding
      ((_ type _) type)
      (_ (error (format nil "invalid memory block binding: ~A" binding)))))
  
  (defun memory-block-binding-size (binding)
    (match binding
      ((_ _ size) size)
      (_ (error (format nil "invalid memory block binding: ~A" binding)))))
  
  (defun alloc-memory-block-form (binding)
    (let ((var (memory-block-binding-var binding))
          (type (memory-block-binding-type binding))
          (size (memory-block-binding-size binding)))
      `(setf ,var (alloc-memory-block ,type ,size))))
  
  (defun free-memory-block-form (binding)
    `(free-memory-block ,(memory-block-binding-var binding)))
  
  (defmacro with-memory-blocks (bindings &body body)
    `(let ,(mapcar #'memory-block-binding-var bindings)
       (unwind-protect
            (progn
              ,@(mapcar #'alloc-memory-block-form bindings)
              ,@body)
         (progn
           ,@(mapcar #'free-memory-block-form bindings)))))
  
  (defun basic-type-mem-aref (blk idx)
    ;; give type as constant explicitly for better performance
    (case (memory-block-type blk)
      (int (cffi:mem-aref (memory-block-cffi-ptr blk) :int idx))
      (float (cffi:mem-aref (memory-block-cffi-ptr blk) :float idx))
      (t (error "must not be reached"))))
  
  (defun float3-mem-aref (blk idx)
    ;; give type and slot names as constant explicitly for better performance
    (let ((ptr (cffi:mem-aref (memory-block-cffi-ptr blk) 'float3 idx)))
      (make-float3 (cffi:foreign-slot-value ptr 'float3 'x)
                   (cffi:foreign-slot-value ptr 'float3 'y)
                   (cffi:foreign-slot-value ptr 'float3 'z))))
  
  (defun float4-mem-aref (blk idx)
    ;; give type and slot names as constant explicitly for better performance
    (let ((ptr (cffi:mem-aref (memory-block-cffi-ptr blk) 'float4 idx)))
      (make-float4 (cffi:foreign-slot-value ptr 'float4 'x)
                   (cffi:foreign-slot-value ptr 'float4 'y)
                   (cffi:foreign-slot-value ptr 'float4 'z)
                   (cffi:foreign-slot-value ptr 'float4 'w))))
                   
  (defun vector-type-mem-aref (blk idx)
    (case (memory-block-type blk)
      (float3 (float3-mem-aref blk idx))
      (float4 (float4-mem-aref blk idx))
      (t (error "must not be reached"))))
  
  (defun mem-aref (blk idx)
    (unless (and (<= 0 idx) (< idx (memory-block-length blk)))
      (error (format nil "invalid index: ~A" idx)))
    (let ((type (memory-block-type blk)))
      (cond
        ((basic-type-p type) (basic-type-mem-aref blk idx))
        ((vector-type-p type) (vector-type-mem-aref blk idx))
        (t (error "must not be reached")))))
  
  (defun basic-type-setf-mem-aref (blk idx val)
    ;; give type as constant explicitly for better performance
    (case (memory-block-type blk)
      (int (setf (cffi:mem-aref (memory-block-cffi-ptr blk) :int idx) val))
      (float (setf (cffi:mem-aref (memory-block-cffi-ptr blk) :float idx) val))
      (t (error "must not be reached"))))
  
  (defun float3-setf-mem-aref (blk idx val)
    ;; give type and slot names as constant explicitly for better performance
    (let ((ptr (cffi:mem-aref (memory-block-cffi-ptr blk) 'float3 idx)))
      (setf (cffi:foreign-slot-value ptr 'float3 'x) (float3-x val))
      (setf (cffi:foreign-slot-value ptr 'float3 'y) (float3-y val))
      (setf (cffi:foreign-slot-value ptr 'float3 'z) (float3-z val))))
  
  (defun float4-setf-mem-aref (blk idx val)
    ;; give type and slot names as constant explicitly for better performance
    (let ((ptr (cffi:mem-aref (memory-block-cffi-ptr blk) 'float4 idx)))
      (setf (cffi:foreign-slot-value ptr 'float4 'x) (float4-x val))
      (setf (cffi:foreign-slot-value ptr 'float4 'y) (float4-y val))
      (setf (cffi:foreign-slot-value ptr 'float4 'z) (float4-z val))
      (setf (cffi:foreign-slot-value ptr 'float4 'w) (float4-w val))))
  
  (defun vector-type-setf-mem-aref (blk idx val)
    (case (memory-block-type blk)
      (float3 (float3-setf-mem-aref blk idx val))
      (float4 (float4-setf-mem-aref blk idx val))
      (t (error "must not be unreached"))))
  
  (defun (setf mem-aref) (val blk idx)
    (unless (and (<= 0 idx) (< idx (memory-block-length blk)))
      (error (format nil "invalid index: ~A" idx)))
    (let ((type (memory-block-type blk)))
      (cond
        ((basic-type-p type) (basic-type-setf-mem-aref blk idx val))
        ((vector-type-p type) (vector-type-setf-mem-aref blk idx val))
        (t (error "must not be reached")))))
  
  (defun memcpy-host-to-device (&rest blks)
    (dolist (blk blks)
      (let ((device-ptr (memory-block-device-ptr blk))
            (cffi-ptr (memory-block-cffi-ptr blk))
            (bytes (memory-block-bytes blk)))
        (cu-memcpy-host-to-device (cffi:mem-ref device-ptr 'cu-device-ptr)
                                  cffi-ptr
                                  bytes))))
  
  (defun memcpy-device-to-host (&rest blks)
    (dolist (blk blks)
      (let ((device-ptr (memory-block-device-ptr blk))
            (cffi-ptr (memory-block-cffi-ptr blk))
            (bytes (memory-block-bytes blk)))
        (cu-memcpy-device-to-host cffi-ptr
                                  (cffi:mem-ref device-ptr 'cu-device-ptr)
                                  bytes))))
  
  
  ;;;
  ;;; Definition of defkernel macro
  ;;;
  
  (defmacro with-module-and-function (args &body body)
    (destructuring-bind (hfunc module function) args
  