[clisp-list] using foreign-arrays with sequence functions (was: Making arrays from scratch)

[Hoehle, Joerg-C. <Joe...@t-...>]

Hi,

>> I once wrote the ~50-100 lines required for providing an 
>FFI-based-array
>> <-> Lisp sequence integration via DEFSEQ.
>sweet!

Well, FWIW, here's my 4 year old unfinished code.
My summary of the situation back then was that sequences types are not the best match for foreign arrays. Alas, CLISP does not offer an extension to array types (nor any other CL so it seems).

An important implementation issue is what data structure to choose to hold the state needed by the defseq iterator. I choose a foreign-variable of type (c-array x l) because that embeds both the needed pointer and limits; ffi:element performs boundary checking and I don't need to cope with element size. Other choices may be more performant. Only benchmarking would tell.

(defstruct (foreign-array (:copier nil))
  (pointer nil;; :type ffi:foreign-variable
))

(setq bar (ffi:allocate-shallow '(ffi:c-array ffi:uint16 5)))
(setq foo (make-foreign-array :pointer bar))

(defun unimplemented (&rest args)
  (cerror "Retry" "Unimplemented -- args: ~S" args))

(defconstant +ffi-array-seq+
  (vector
    'foreign-array
    #'unimplemented                     ;init
    #'unimplemented                     ;upd
    #'unimplemented;sys::vector-endtest
    #'unimplemented;sys::vector-fe-init
    #'unimplemented;sys::vector-fe-upd
    #'unimplemented;sys::vector-fe-endtest
    #'unimplemented;char
    #'unimplemented;sys::store
    #'identity;copy pointer
    #'(lambda(seq)(ffi::%sizeof(ffi::foreign-type seq)));sys::vector-length
    #'unimplemented;make-string
    #'unimplemented;char
    #'unimplemented;sys::store
    #'unimplemented;sys::vector-init-start
    #'unimplemented;sys::vector-fe-init-end
))
(assert (= (length +ffi-array-seq+) 16))
(sys::%defseq +ffi-array-seq+)

Back in 2004, there was a bug in CLISP with using own structures and the %DEFSEQ functions. IIRC, I reported it, and Sam Steingold fixed it.
(sys::sequencep foo)

(setf (svref +ffi-array-seq+ 10)
      (lambda(seq)(ffi::%sizeof(ffi::foreign-type (foreign-array-pointer seq)))))
(setf (svref +ffi-array-seq+ 10)	;length
      (lambda(seq)
	(svref (ffi::foreign-type (foreign-array-pointer seq)) 2)))
;(length foo)

(setf (svref +ffi-array-seq+ 12)        ;seq-elt
      (lambda (seq index)
        (ffi:foreign-value (ffi::%element (foreign-array-pointer seq) index))))
;(elt foo 5)
(setf (svref +ffi-array-seq+ 13)        ;seq-set-elt
      (lambda (seq index value)
        (setf (ffi:foreign-value (ffi::%element (foreign-array-pointer seq) index)) value)))
;(setf (elt foo 0) 3)
;(elt foo 0)
;(elt foo 5)


;; seq-pointer: just use Index
;; TODO better: increment offset of #<foreign-address>
;; but a) foreign-offset is not accessible from Lisp
;; and b) end-test would then need more context
(setf (svref +ffi-array-seq+ 14)        ;seq-init-start
      (lambda (seq index) index))
(setf (svref +ffi-array-seq+  1)        ;seq-init
      (lambda (seq) 0))
(setf (svref +ffi-array-seq+  2)        ;seq-upd
      (lambda (seq pointer) (1+ pointer)))
(setf (svref +ffi-array-seq+  3)        ;seq-endtest
      (lambda (seq pointer) (= pointer (length seq))))
(setf (svref +ffi-array-seq+  7)        ;seq-access
      (lambda (seq pointer)
        (ffi:foreign-value (ffi::%element (foreign-array-pointer seq) pointer))))
;(position 0 foo :start 2)

(setf (svref +ffi-array-seq+  8)        ;seq-access-set
      (lambda (seq pointer value)
        (setf (ffi:foreign-value (ffi::%element (foreign-array-pointer seq) pointer)) value)))
;(fill foo 4 :start 2 :end 4)
;(ffi::foreign-value bar)

Well, even if this code is of no general use, it can serve as regression test for the DEFSEQ API.

Regards,
	Jörg Höhle