Commit 8d5cd4a5 authored by Liam Healy's avatar Liam Healy
Browse files

Split off grid directory

Eventually, the definitions used for dealing with types and foreign
arrays that aren't specific to GSL will be split off into another
system, so that it will be easier to build other foreign library
interfaces using these definitions.  As a start, the grid/ directory
defines a package 'c-array and some of the type definitions formerly
in init/.  Everything compiles and tests as before, on SBCL
TOTAL: 1627 assertions passed, 6 failed, 0 execution errors.
parent 1dec7a06
;; Foreign arrays (usually in C) ;; Foreign arrays (usually in C)
;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp ;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp
;; Time-stamp: <2009-03-18 14:45:50EDT foreign-array.lisp> ;; Time-stamp: <2009-12-06 21:56:58EST foreign-array.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :gsl)
...@@ -60,7 +60,7 @@ ...@@ -60,7 +60,7 @@
total-size (array-total-size cl-array)) total-size (array-total-size cl-array))
#-native #-native
(let ((cptr (cffi:foreign-alloc (let ((cptr (cffi:foreign-alloc
(cl-cffi (element-type object)) (c-array:cl-cffi (element-type object))
:count (total-size object)))) :count (total-size object))))
(setf (c-pointer object) cptr) (setf (c-pointer object) cptr)
(tg:finalize object (lambda () (cffi:foreign-free cptr)))) (tg:finalize object (lambda () (cffi:foreign-free cptr))))
...@@ -71,7 +71,7 @@ ...@@ -71,7 +71,7 @@
(setf original-array oa (setf original-array oa
offset offset
(* index-offset (* index-offset
(cffi:foreign-type-size (cl-cffi (element-type object)))))))) (cffi:foreign-type-size (c-array:cl-cffi (element-type object))))))))
(defparameter *print-contents* t (defparameter *print-contents* t
"Print the contents of the foreign-array.") "Print the contents of the foreign-array.")
...@@ -96,7 +96,7 @@ ...@@ -96,7 +96,7 @@
(defun element-size (object) (defun element-size (object)
"The size of each element as stored in C." "The size of each element as stored in C."
(cffi:foreign-type-size (cl-cffi (element-type object)))) (cffi:foreign-type-size (c-array:cl-cffi (element-type object))))
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Syncronize C and CL ;;;; Syncronize C and CL
...@@ -138,7 +138,7 @@ ...@@ -138,7 +138,7 @@
"Copy length elements from array (starting at index-offset) of type "Copy length elements from array (starting at index-offset) of type
lisp-type to the memory area that starts at pointer, coercing the lisp-type to the memory area that starts at pointer, coercing the
elements if necessary." elements if necessary."
(let ((cffi-type (component-type lisp-type))) (let ((cffi-type (c-array:component-type lisp-type)))
(loop :repeat length (loop :repeat length
for array-index :from index-offset for array-index :from index-offset
for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1) for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1)
...@@ -156,7 +156,7 @@ ...@@ -156,7 +156,7 @@
"Copy length elements from array (starting at index-offset) of type "Copy length elements from array (starting at index-offset) of type
lisp-type from the memory area that starts at pointer, coercing the lisp-type from the memory area that starts at pointer, coercing the
elements if necessary." elements if necessary."
(let ((cffi-type (component-type lisp-type))) (let ((cffi-type (c-array:component-type lisp-type)))
(loop :repeat length (loop :repeat length
for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1) for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1)
for array-index :from index-offset for array-index :from index-offset
......
;; Get/set array or elements: cl-array, maref ;; Get/set array or elements: cl-array, maref
;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp ;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp
;; Time-stamp: <2009-01-17 17:15:19EST maref.lisp> ;; Time-stamp: <2009-12-06 19:51:39EST maref.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :gsl)
...@@ -101,8 +101,8 @@ ...@@ -101,8 +101,8 @@
category tp) category tp)
,@ffrestargs ,@ffrestargs
,@(if value-symbol ,@(if value-symbol
(list (cl-cffi tp) value-symbol) (list (c-array:cl-cffi tp) value-symbol)
(list (cl-cffi tp)))))) (list (c-array:cl-cffi tp))))))
*array-element-types*))) *array-element-types*)))
(defmethod maref (defmethod maref
......
;; A "marray" is an array in both GSL and CL ;; A "marray" is an array in both GSL and CL
;; Liam Healy 2008-04-06 21:23:41EDT ;; Liam Healy 2008-04-06 21:23:41EDT
;; Time-stamp: <2009-06-06 09:58:56EDT marray.lisp> ;; Time-stamp: <2009-12-06 19:50:09EST marray.lisp>
(in-package :gsl) (in-package :gsl)
...@@ -88,7 +88,7 @@ ...@@ -88,7 +88,7 @@
;; e.g. (data-class-name 'vector '(unsigned-byte 8)) ;; e.g. (data-class-name 'vector '(unsigned-byte 8))
;; -> VECTOR-UNSIGNED-BYTE-8 ;; -> VECTOR-UNSIGNED-BYTE-8
(if (member category '(vector matrix)) (if (member category '(vector matrix))
(intern (format nil "~a-~a" category (cl-single element-type)) (intern (format nil "~a-~a" category (c-array:cl-single element-type))
:gsl) :gsl)
category)) category))
...@@ -216,7 +216,7 @@ ...@@ -216,7 +216,7 @@
(contents-from-pointer (contents-from-pointer
pointer pointer
(if (subtypep class-name 'matrix) 'gsl-matrix-c 'gsl-vector-c) (if (subtypep class-name 'matrix) 'gsl-matrix-c 'gsl-vector-c)
(lookup-type class-name *class-element-type*))))) (c-array:lookup-type class-name *class-element-type*)))))
;; Some functions in solve-minimize-fit return a pointer to a GSL ;; Some functions in solve-minimize-fit return a pointer to a GSL
;; vector of double-floats. This function turns that into a ;; vector of double-floats. This function turns that into a
......
;; Example FFT: transform a pulse (using the "clean" fft interface) ;; Example FFT: transform a pulse (using the "clean" fft interface)
;; Sumant Oemrawsingh, Sat Oct 31 2009 - 00:24 ;; Sumant Oemrawsingh, Sat Oct 31 2009 - 00:24
;; Time-stamp: <2009-11-19 23:18:31EST example.lisp> ;; Time-stamp: <2009-12-06 22:05:01EST example.lisp>
(in-package :gsl) (in-package :gsl)
...@@ -60,7 +60,7 @@ ...@@ -60,7 +60,7 @@
;; (make-urand-vector '(complex double-float) 5) ;; (make-urand-vector '(complex double-float) 5)
(defun make-urand-vector (element-type dimension &key (stride 1)) (defun make-urand-vector (element-type dimension &key (stride 1))
"Make a vector with random elements." "Make a vector with random elements."
(let ((vec (make-marray `(complex ,(component-float-type element-type)) (let ((vec (make-marray `(complex ,(c-array:component-float-type element-type))
:dimensions (list (* stride dimension))))) :dimensions (list (* stride dimension)))))
(loop for i from 0 below (* stride dimension) by stride (loop for i from 0 below (* stride dimension) by stride
do do
...@@ -74,7 +74,7 @@ ...@@ -74,7 +74,7 @@
"The real vector consisting of the real part of the complex vector." "The real vector consisting of the real part of the complex vector."
(let ((real-vector (let ((real-vector
(make-marray (make-marray
(component-float-type (element-type complex-vector)) (c-array:component-float-type (element-type complex-vector))
:dimensions (dimensions complex-vector)))) :dimensions (dimensions complex-vector))))
(loop for i below (total-size complex-vector) do (loop for i below (total-size complex-vector) do
(setf (maref real-vector i) (setf (maref real-vector i)
......
;; Complex number types ;; Complex number types
;; Liam Healy 2009-01-13 21:24:05EST complex-types.lisp ;; Liam Healy 2009-01-13 21:24:05EST complex-types.lisp
;; Time-stamp: <2009-11-16 12:35:49EST complex-types.lisp> ;; Time-stamp: <2009-12-06 22:05:59EST complex-types.lisp>
(in-package :gsl) (in-package :c-array)
(export '(complex-double-c complex-float-c component-float-type component-type))
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Complex types ;;;; Complex types
...@@ -48,3 +50,4 @@ ...@@ -48,3 +50,4 @@
(defun component-type (eltype) (defun component-type (eltype)
(cl-cffi (component-float-type eltype))) (cl-cffi (component-float-type eltype)))
;; Declaration of package
;; Liam Healy 2009-12-06 19:41:09EST pkgdcl.lisp
;; Time-stamp: <2009-12-06 19:41:51EST pkgdcl.lisp>
(in-package :cl-user)
(defpackage c-array
(:use :common-lisp :cffi))
;; Number types used by GSL functions, and specification conversion ;; Number types used by GSL functions, and specification conversion
;; Liam Healy 2008-12-31 21:06:34EST types.lisp ;; Liam Healy 2008-12-31 21:06:34EST types.lisp
;; Time-stamp: <2009-12-06 10:55:10EST types.lisp> ;; Time-stamp: <2009-12-07 22:26:05EST types.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :c-array)
;;;;**************************************************************************** (export '(*cstd-integer-types*
;;;; Unsigned address types size_t *cstd-cl-type-mapping* floating-point-association all-types
;;;;**************************************************************************** lookup-type cl-single cl-cffi cffi-cl number-class))
(case (cffi:foreign-type-size :long)
(8
(push :int64 *features*)
#+fsbv (fsbv:defsynonym sizet :uint64))
(4
(push :int32 *features*)
#+fsbv (fsbv:defsynonym sizet :uint32)))
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Type specification conversion ;;;; Type specification conversion
...@@ -106,20 +98,6 @@ ...@@ -106,20 +98,6 @@
(mapcar #'first *fp-type-mapping*) (mapcar #'first *fp-type-mapping*)
(subseq ,splice-list 0 (length *fp-type-mapping*)))) (subseq ,splice-list 0 (length *fp-type-mapping*))))
(defparameter *blas-splice-fp-types*
;; Ordered by: real shortest to longest, then complex shortest to longest.
;; Must match *fp-type-mapping*.
'("s" "d" #+long-double nil
"c" "z" #+long-double nil)
"The list of floating point types that can be spliced into BLAS function names.")
(defparameter *cstd-blas-mapping*
;; The floating types are associated by order, so it is important that
;; order of *fp-type-mapping* and *blas-splice-fp-types* match,
;; though the latter may be longer.
(floating-point-association *blas-splice-fp-types*)
"Mapping the C standard types to the BLAS splice name.")
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Conversions ;;;; Conversions
;;;;**************************************************************************** ;;;;****************************************************************************
...@@ -137,6 +115,15 @@ ...@@ -137,6 +115,15 @@
;;(error "Did not find ~a in ~a" symbol (mapcar #'first alist)) ;;(error "Did not find ~a in ~a" symbol (mapcar #'first alist))
)) ))
;;; (cl-single '(unsigned-byte 8))
;;; UNSIGNED-BYTE-8
(defun cl-single (cl-type)
"The element type name as a single symbol."
(intern (if (atom cl-type)
(princ-to-string cl-type)
(format nil "~{~a~^-~}" cl-type))
:gsl))
(defun cl-cffi (cl-type) (defun cl-cffi (cl-type)
"The CFFI element type from the CL type." "The CFFI element type from the CL type."
(lookup-type (clean-type cl-type) *cstd-cl-type-mapping* t)) (lookup-type (clean-type cl-type) *cstd-cl-type-mapping* t))
...@@ -151,3 +138,4 @@ ...@@ -151,3 +138,4 @@
(defun number-class (type) (defun number-class (type)
"Find the class corresponding to the numeric type." "Find the class corresponding to the numeric type."
(find-if (lambda (class) (subtypep type class)) *cl-numeric-classes*)) (find-if (lambda (class) (subtypep type class)) *cl-numeric-classes*))
;; Definition of GSLL system ;; Definition of GSLL system
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2009-11-09 16:04:42EST gsll.asd> ;; Time-stamp: <2009-12-06 22:14:49EST gsll.asd>
(when (asdf:find-system :fsbv nil) (when (asdf:find-system :fsbv nil)
(pushnew :fsbv *features*)) (pushnew :fsbv *features*))
...@@ -16,7 +16,13 @@ ...@@ -16,7 +16,13 @@
:licence "LLGPL v3, FDL" :licence "LLGPL v3, FDL"
:depends-on (cffi cffi-grovel trivial-garbage cl-utilities #+fsbv fsbv) :depends-on (cffi cffi-grovel trivial-garbage cl-utilities #+fsbv fsbv)
:components :components
((:module init ((:module grid ; temporary
:components
((:file "pkgdcl")
(:file "types" :depends-on ("pkgdcl"))
(:file "complex-types" :depends-on ("types"))))
(:module init
:depends-on (grid)
:components :components
((:file "init") ((:file "init")
(cffi-grovel:grovel-file "libgsl" :pathname #+unix "libgsl-unix") (cffi-grovel:grovel-file "libgsl" :pathname #+unix "libgsl-unix")
...@@ -35,8 +41,7 @@ ...@@ -35,8 +41,7 @@
(cffi-grovel:grovel-file "callback-struct" (cffi-grovel:grovel-file "callback-struct"
:depends-on ("types" "libgsl")) :depends-on ("types" "libgsl"))
(:file "funcallable" :depends-on ("utility")) (:file "funcallable" :depends-on ("utility"))
(:file "complex-types" :depends-on ("types")) (:file "element-types" :depends-on ("init"))
(:file "element-types" :depends-on ("init" "complex-types"))
(:file "interface" (:file "interface"
:depends-on ("init" "conditions" "element-types" :depends-on ("init" "conditions" "element-types"
"number-conversion")) "number-conversion"))
...@@ -74,7 +79,7 @@ ...@@ -74,7 +79,7 @@
(:file "array-tests" :depends-on ("both")) (:file "array-tests" :depends-on ("both"))
(:file "permutation" :depends-on ("marray" "array-structs")) (:file "permutation" :depends-on ("marray" "array-structs"))
(:file "combination" :depends-on ("marray" "array-structs")))) (:file "combination" :depends-on ("marray" "array-structs"))))
(:file "polynomial" :depends-on (init data)) (:file "polynomial" :depends-on (grid init data))
(:module special-functions (:module special-functions
:depends-on (init) :depends-on (init)
:components :components
......
;; Helpers for defining GSL functions on arrays ;; Helpers for defining GSL functions on arrays
;; Liam Healy 2009-01-07 22:01:16EST defmfun-array.lisp ;; Liam Healy 2009-01-07 22:01:16EST defmfun-array.lisp
;; Time-stamp: <2009-11-30 16:13:13EST defmfun-array.lisp> ;; Time-stamp: <2009-12-06 22:05:00EST defmfun-array.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :gsl)
...@@ -80,9 +80,9 @@ ...@@ -80,9 +80,9 @@
gsl-function-name))) gsl-function-name)))
(remf key-args :documentation) (remf key-args :documentation)
(when (eq c-return :element-c-type) (when (eq c-return :element-c-type)
(setf (getf key-args :c-return) (cl-cffi eltype))) (setf (getf key-args :c-return) (c-array:cl-cffi eltype)))
(when (eq c-return :component-float-type) (when (eq c-return :component-float-type)
(setf (getf key-args :c-return) (component-type eltype))) (setf (getf key-args :c-return) (c-array:component-type eltype)))
(if (optional-args-to-switch-gsl-functions arglist gsl-name) (if (optional-args-to-switch-gsl-functions arglist gsl-name)
;; The methods have optional argument(s) and ;; The methods have optional argument(s) and
;; multiple GSL functions for presence/absence of ;; multiple GSL functions for presence/absence of
...@@ -115,7 +115,7 @@ ...@@ -115,7 +115,7 @@
(if (listp base-name) (if (listp base-name)
(if (symbolp (first base-name)) (if (symbolp (first base-name))
;; An explicit listing of types with function names ;; An explicit listing of types with function names
(getf base-name (cl-single type)) (getf base-name (c-array:cl-single type))
(let ((blas (search "blas" (first base-name) :test 'string-equal))) (let ((blas (search "blas" (first base-name) :test 'string-equal)))
(apply #'concatenate 'string (apply #'concatenate 'string
(substitute (substitute
...@@ -126,7 +126,7 @@ ...@@ -126,7 +126,7 @@
(cl-gsl type (not blas) blas) :type (cl-gsl type (not blas) blas) :type
(substitute (substitute
(if (subtypep type 'complex) (if (subtypep type 'complex)
(cl-gsl (component-float-type type) nil blas) (cl-gsl (c-array:component-float-type type) nil blas)
"") :component-float-type "") :component-float-type
(substitute (substitute
(string-downcase (symbol-name category)) :category (string-downcase (symbol-name category)) :category
...@@ -145,9 +145,9 @@ ...@@ -145,9 +145,9 @@
(if (and replacing (listp arg)) (if (and replacing (listp arg))
(list (first arg) (list (first arg)
(case (second arg) (case (second arg)
(:element-type (number-class element-type)) (:element-type (c-array:number-class element-type))
(:component-float-type (:component-float-type
(number-class (component-float-type element-type))) (c-array:number-class (c-array:component-float-type element-type)))
(otherwise (otherwise
(data-class-name (data-class-name
(if (and (eq (second arg) 'both) replace-both) (if (and (eq (second arg) 'both) replace-both)
...@@ -158,7 +158,7 @@ ...@@ -158,7 +158,7 @@
;; specially for array methods. ;; specially for array methods.
(if (and (listp arg) (numberp (second arg))) (if (and (listp arg) (numberp (second arg)))
(let ((actual-type (let ((actual-type
(cffi-cl (c-array:cffi-cl
(st-type (find (first arg) carg-actual :key 'st-symbol))))) (st-type (find (first arg) carg-actual :key 'st-symbol)))))
(list (first arg) ; Optional arg default numerical value (list (first arg) ; Optional arg default numerical value
(if actual-type (if actual-type
...@@ -198,6 +198,6 @@ ...@@ -198,6 +198,6 @@
actual element type." actual element type."
(mapcar (mapcar
(lambda (v) (lambda (v)
(subst (cl-cffi element-type) :element-c-type (subst (c-array:cl-cffi element-type) :element-c-type
(subst (component-type element-type) :component-float-type v))) (subst (c-array:component-type element-type) :component-float-type v)))
c-arguments)) c-arguments))
;; Mapping of element type names ;; Mapping of element type names
;; Liam Healy 2008-04-13 11:22:46EDT element-types.lisp ;; Liam Healy 2008-04-13 11:22:46EDT element-types.lisp
;; Time-stamp: <2009-01-13 21:31:12EST element-types.lisp> ;; Time-stamp: <2009-12-06 19:50:12EST element-types.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -10,7 +10,7 @@ ...@@ -10,7 +10,7 @@
;;;;**************************************************************************** ;;;;****************************************************************************
(defparameter *array-element-types* (defparameter *array-element-types*
(remove-duplicates (all-types *cstd-cl-type-mapping* t) :test 'equal) (remove-duplicates (c-array:all-types c-array:*cstd-cl-type-mapping* t) :test 'equal)
"All the array element types supported.") "All the array element types supported.")
(defparameter *array-element-types-no-complex* (defparameter *array-element-types-no-complex*
......
;; Generate a lambda that calls the user function; will be called by callback. ;; Generate a lambda that calls the user function; will be called by callback.
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2009-04-04 21:45:11EDT funcallable.lisp> ;; Time-stamp: <2009-12-06 19:52:32EST funcallable.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -64,7 +64,7 @@ ...@@ -64,7 +64,7 @@
(floor linear-index (floor linear-index
(first dims))) (first dims)))
(list linear-index nil))) (list linear-index nil)))
',(cffi-cl (parse-callback-argspec argspec 'element-type))) ',(c-array:cffi-cl (parse-callback-argspec argspec 'element-type)))
`(cffi:mem-aref `(cffi:mem-aref
,foreign-variable-name ,foreign-variable-name
',(parse-callback-argspec argspec 'element-type) ',(parse-callback-argspec argspec 'element-type)
......
;; Define examples. ;; Define examples.
;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
;; Time-stamp: <2009-11-14 10:22:05EST generate-examples.lisp> ;; Time-stamp: <2009-12-06 22:05:00EST generate-examples.lisp>
;; $Id: $ ;; $Id: $
;;; Define examples that can be displayed by users with the function ;;; Define examples that can be displayed by users with the function
...@@ -80,7 +80,7 @@ ...@@ -80,7 +80,7 @@
length using the pool data for the type and starting at the length using the pool data for the type and starting at the
specified point in the pool." specified point in the pool."
(mapcar (mapcar
(lambda (num) (coerce num (component-float-type type))) (lambda (num) (coerce num (c-array:component-float-type type)))
(subseq (subseq
(cond ((subtypep type 'unsigned-byte) *unsigned-byte-pool*) (cond ((subtypep type 'unsigned-byte) *unsigned-byte-pool*)
((subtypep type 'signed-byte) *signed-byte-pool*) ((subtypep type 'signed-byte) *signed-byte-pool*)
...@@ -127,7 +127,7 @@ ...@@ -127,7 +127,7 @@
(if float-type (if float-type
(first (first
(make-list-from-pool (make-list-from-pool
(component-float-type default-element-type) 1 starting-element)) (c-array:component-float-type default-element-type) 1 starting-element))
(apply (apply
#'complex #'complex
(make-list-from-pool default-element-type 1 starting-element))) (make-list-from-pool default-element-type 1 starting-element)))
......
;; Macros to interface GSL functions, including definitions necessary for defmfun. ;; Macros to interface GSL functions, including definitions necessary for defmfun.
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2009-11-12 18:11:41EST interface.lisp> ;; Time-stamp: <2009-12-06 19:52:33EST interface.lisp>
(in-package :gsl) (in-package :gsl)
...@@ -102,7 +102,7 @@ ...@@ -102,7 +102,7 @@
(defun cl-argument-types (cl-arguments c-arguments-types) (defun cl-argument-types (cl-arguments c-arguments-types)
"Create CL argument and types from the C arguments." "Create CL argument and types from the C arguments."
(loop for sd in c-arguments-types (loop for sd in c-arguments-types
for cl-type = (cffi-cl (st-type sd)) for cl-type = (c-array:cffi-cl (st-type sd))
append append
(when (and cl-type (member (st-symbol sd) (cl-symbols cl-arguments))) (when (and cl-type (member (st-symbol sd) (cl-symbols cl-arguments)))
(list (list (st-symbol sd) cl-type))))) (list (list (st-symbol sd) cl-type)))))
......
;; Conversion of numbers C->CL ;; Conversion of numbers C->CL
;; Liam Healy, Sun May 28 2006 - 22:04 ;; Liam Healy, Sun May 28 2006 - 22:04
;; Time-stamp: <2009-04-27 21:24:36EDT number-conversion.lisp> ;; Time-stamp: <2009-12-07 22:30:23EST number-conversion.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -25,14 +25,14 @@ ...@@ -25,14 +25,14 @@
;;; GSL complex struct is defined in init/complex-types.lisp. ;;; GSL complex struct is defined in init/complex-types.lisp.
(defun complex-to-cl (defun complex-to-cl
(gsl-complex &optional (index 0) (complex-type 'complex-double-c)) (gsl-complex &optional (index 0) (complex-type 'c-array:complex-double-c))
"Make a CL complex number from the GSL pointer to a complex struct or "Make a CL complex number from the GSL pointer to a complex struct or
an array of complex structs and an index into the array." an array of complex structs and an index into the array."
(let ((carr (cffi:foreign-slot-value (let ((carr (cffi:foreign-slot-value
(cffi:inc-pointer (cffi:inc-pointer
gsl-complex gsl-complex
(* index (cffi:foreign-type-size complex-type))) (* index (cffi:foreign-type-size complex-type)))
complex-type 'dat))) complex-type 'c-array::dat)))
(complex (dcref carr 0) (complex (dcref carr 0)
(dcref carr 1)))) (dcref carr 1))))
...@@ -50,8 +50,8 @@ ...@@ -50,8 +50,8 @@
`((val ,(st-symbol decl) 'sf-result-e10) `((val ,(st-symbol decl) 'sf-result-e10)
(e10 ,(st-symbol decl)) (e10 ,(st-symbol decl))
(err ,(st-symbol decl) 'sf-result-e10))) (err ,(st-symbol decl) 'sf-result-e10)))
(complex-double-c (c-array:complex-double-c
`((complex-to-cl ,(st-symbol decl) 0 'complex-double-c))) `((complex-to-cl ,(st-symbol decl) 0 'c-array:complex-double-c)))
(complex-float-c (c-array:complex-float-c