Skip to content
Snippets Groups Projects
Commit 1e3e4a57 authored by Liam Healy's avatar Liam Healy
Browse files

Delete early experiment with foreign-friendly arrays

In early experimentation with foreign-friendly arrays, I developed a
way to directly use the foreign-friendly arrays in GSL code using raw
C arrays.  This was successful.  Subsequently, I rewrote the gsl-data
objects to have foreign-friendly arrays underlying them, whether they
create raw C arrays, GSL arrays, or both, so the early experiment is
obsolete and is deleted in this commit.
parent 1518473a
No related branches found
No related tags found
No related merge requests found
;; Use the foreign-friendly arrays package.
;; Liam Healy 2008-03-22 15:40:08EDT ffa.lisp
;; Time-stamp: <2008-11-02 12:20:23EST foreign-friendly.lisp>
;; Time-stamp: <2008-11-11 20:42:01EST foreign-friendly.lisp>
;; $Id$
;;; Use Papp's Foreign-friendly arrays
;;; http://www.princeton.edu/~tpapp/software.html
;;; Make a foreign-friendly array with #'make-array*,
;;; and/or use one in foreign code in a letm binding.
#|
There are five interrelated forms for these vectors:
Native vector
FFA objects made with with-ffa and used in with-pointer-to-array
C array of doubles
gsl-vector-c struct
GSLL class vector-double-float
When to use what:
GSL vectors gsl-vector-c used when GSL needs it.
FFA used when on SBCL
FFA used when C array needed and I don't want to make a
gsl-vector-c. So maybe a good idea is to always have ffa available,
and only optionally make it part of GSL vectors.
Start implementing bare C array, which I don't actually use yet in
GSLL except in sort-vector-smallest-index, sort-vector-largest-index.
This can be written and tested without interfering with current code.
Add an object c-double-float (by analogy to vector-double-float) to letm processing.
This will be set with standard aref; copy-array and the other things
defined in ffa will be usable.
|#
(in-package :gsl)
;;;;****************************************************************************
;;;; A direct C array
;;;; Make arrays for possible foreign use
;;;;****************************************************************************
(export '(make-array*))
......@@ -49,7 +18,7 @@ defined in ffa will be usable.
(dimensions element-type
&key (initial-element nil initial-element-p)
(initial-contents nil initial-contents-p))
"Make an array for possible use in foreign code.
"Make an array of one or two dimensions for possible use in foreign code.
Syntax is similar to make-array, but note that element-type
is mandatory and limited to certain types."
(assert (member element-type *array-element-types* :test 'equal)
......@@ -67,90 +36,3 @@ defined in ffa will be usable.
(if initial-element-p
(ffa:make-ffa dimensions element-type :initial-element initial-element)
(ffa:make-ffa dimensions element-type))))
(defparameter *foreign-array-directions*
'((:in . :copy-in) (:out . :copy-out) (:in-out . :copy-in-out)))
(defmacro with-c-data
((pointer array cl-element-type &optional (direction :in-out))
&body body)
"Use an array made with make-array* in foreign code. The pointer
is either a symbol that will be bound to the foreign pointer, or
a list of (c-pointer cl-object) so that the CL object created
is also accessible."
(let ((cl-name (if (listp pointer) (second pointer) (gensym "ARRAY"))))
`(let ((,cl-name ,array))
(ffa:with-pointer-to-array
(,cl-name
,(if (listp pointer) (first pointer) pointer)
(cl-ffa ',cl-element-type)
(array-total-size ,cl-name)
,(rest (assoc direction *foreign-array-directions*)))
,@body))))
;;;;****************************************************************************
;;;; Expand letm bindings
;;;;****************************************************************************
;;; Modify ffa's array-copy to take type argument
(defun array-copy (array &optional type)
"Copy the elements of array. Does not copy the elements itself
recursively, if you need that, use array-map."
(ffa:make-ffa (array-dimensions array)
(or type (array-element-type array))
:initial-contents (ffa:find-or-displace-to-flat-array array)))
(defun expand-direct-c (symbol cl-element-type init-or-spec body)
"Expand the form for a direct foreign array.
Argument 'symbol can be either a symbol or a list of
two symbols; if the former, it will be bound to the foreign pointer; if
the latter, the first symbol will be bound to the foreign pointer and
the second to the corresponding CL array. The cl-element-type
is a CL element type, init-or-spec is either the
array dimensions or something made by make-array*."
(typecase init-or-spec
(array
`(with-c-data
(,symbol (array-copy ,init-or-spec ',cl-element-type) ,cl-element-type)
,@body))
((or list number)
`(with-c-data
(,symbol
(make-array* ,init-or-spec ',cl-element-type)
,cl-element-type)
,@body))
(t ; unknown at macro expansion time
(cl-utilities:once-only (init-or-spec)
`(with-c-data
(,symbol
(if (typep ,init-or-spec 'array)
,init-or-spec
(make-array* ,init-or-spec ',cl-element-type))
,cl-element-type)
,@body)))))
(defmethod letm-expansion (symbol (type (eql 'c-double-float)) args body)
(expand-direct-c symbol 'double-float (first args) body))
(arglist-only c-double-float
"A direct C vector or matrix of type double."
dimensions-or-init)
#|
;; Example
(letm ((a (c-double-float 3)) ((b cl-b) (c-double-float #(3 4 5 1 2))))
(format t "b: foreign pointer=~a~%" b)
(format t "a: foreign pointer=~a~%" a)
(values (aref cl-b 3) (dcref b 3)))
(LET ((#:ARRAY3416 (MAKE-ARRAY* 3 'DOUBLE-FLOAT)))
(FFA:WITH-POINTER-TO-ARRAY
(#:ARRAY3416 A (CL-FFA 'DOUBLE-FLOAT)
(ARRAY-TOTAL-SIZE #:ARRAY3416) :COPY-IN-OUT)
(LET ((CL-B (ARRAY-COPY #(3 4 5 1 2) 'DOUBLE-FLOAT)))
(FFA:WITH-POINTER-TO-ARRAY
(CL-B B (CL-FFA 'DOUBLE-FLOAT) (ARRAY-TOTAL-SIZE CL-B)
:COPY-IN-OUT)
(FORMAT T "b: foreign pointer=~a~%" B)
(FORMAT T "a: foreign pointer=~a~%" A) (VALUES (AREF CL-B 3) (DCREF B 3))))))
|#
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment