Commit cf3e9c97 authored by liam's avatar liam
Browse files

Fold defclass into #'gsl-data-functions, fix up examples. The

defclass defines new class slots base-type, allocator, callocator,
freer.  These are not yet used.


git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3030 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
parent 7d16dea3
......@@ -3,20 +3,16 @@
; description: Blocks of data
; date: Mon Mar 27 2006 - 12:28
; author: Liam M. Healy
; modified: Mon Mar 27 2006 - 12:34
; modified: Thu Apr 13 2006 - 00:00
;********************************************************
;;; $Id: $
(in-package :gsl)
(defclass gsl-block (data)
()
(:documentation "GSL block."))
;;; Block definition
(cffi:defcstruct block
(size :size)
(data :pointer))
(gsl-data-functions "block")
(gsl-data-functions "block" :double)
......@@ -3,7 +3,7 @@
; description: Combinations
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Tue Apr 11 2006 - 13:15
; modified: Wed Apr 12 2006 - 23:51
;********************************************************
;;; $Id: $
......@@ -19,12 +19,8 @@
(k :size)
(data :pointer))
(defclass gsl-combination (gsl-data)
((base-type :initform :size :reader base-type :allocation :class))
(:documentation "GSL combination."))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "combination" 2)
(gsl-data-functions "combination" :size 2)
(add-wrap-type gsl-combination-c (lambda (x) `(pointer ,x)))
......
......@@ -3,13 +3,13 @@
; description: Using GSL storage.
; date: Sun Mar 26 2006 - 16:32
; author: Liam M. Healy
; modified: Tue Apr 11 2006 - 18:06
; modified: Wed Apr 12 2006 - 23:35
;********************************************************
;;; $Id: $
(in-package :gsl)
(defmacro gsl-data-functions (string &optional (dimensions 1))
(defmacro gsl-data-functions (string base-type &optional (dimensions 1))
"For the type named in the string,
define the allocator (gsl-*-alloc), zero allocator (gsl-*-calloc),
freeing (gsl-*-free), binary writing (binary-*-write) and
......@@ -22,46 +22,54 @@
(let ((indlist
(loop for i from 1 to dimensions
collect `(,(intern (format nil "N~d" i)) :size))))
`(progn
(cffi:defcfun ,(gsl-name "alloc") :pointer ,@indlist)
(cffi:defcfun ,(gsl-name "calloc") :pointer ,@indlist)
(cffi:defcfun ,(gsl-name "free") :void (pointer :pointer))
(defun ,(cl-name 'write 'binary) (object stream)
(check-gsl-status
(cffi:foreign-funcall
,(gsl-name "fwrite")
:pointer stream
:pointer object
:int)
',(cl-name 'write 'binary)))
(defun ,(cl-name 'read 'binary) (object stream)
(check-gsl-status
(cffi:foreign-funcall
,(gsl-name "fread")
:pointer stream
:pointer object
:int)
',(cl-name 'read 'binary)))
(defun ,(cl-name 'write 'formatted) (object stream format)
"Format the block data to a stream; format is a string,
`(progn
(defclass ,(intern (format nil "GSL-~:@(~a~)" string)) (gsl-data)
((base-type :initform ,base-type :reader base-type :allocation :class)
(allocator :initform ,(gsl-name "alloc")
:reader allocator :allocation :class)
(callocator :initform ,(gsl-name "calloc")
:reader callocator :allocation :class)
(freer :initform ,(gsl-name "free")
:reader freer :allocation :class)))
(cffi:defcfun ,(gsl-name "alloc") :pointer ,@indlist)
(cffi:defcfun ,(gsl-name "calloc") :pointer ,@indlist)
(cffi:defcfun ,(gsl-name "free") :void (pointer :pointer))
(defun ,(cl-name 'write 'binary) (object stream)
(check-gsl-status
(cffi:foreign-funcall
,(gsl-name "fwrite")
:pointer stream
:pointer object
:int)
',(cl-name 'write 'binary)))
(defun ,(cl-name 'read 'binary) (object stream)
(check-gsl-status
(cffi:foreign-funcall
,(gsl-name "fread")
:pointer stream
:pointer object
:int)
',(cl-name 'read 'binary)))
(defun ,(cl-name 'write 'formatted) (object stream format)
"Format the block data to a stream; format is a string,
one of %g, %e, %f."
(check-gsl-status
(cffi:foreign-funcall
"gsl_block_fprintf"
:pointer stream
:pointer object
:string format
:int)
',(cl-name 'write 'formatted)))
(defun ,(cl-name 'read 'formatted) (object stream)
"Read the formatted block data from a stream."
(check-gsl-status
(cffi:foreign-funcall
"gsl_block_fscanf"
:pointer stream
:pointer object
:int)
',(cl-name 'read 'formatted)))))))
(check-gsl-status
(cffi:foreign-funcall
"gsl_block_fprintf"
:pointer stream
:pointer object
:string format
:int)
',(cl-name 'write 'formatted)))
(defun ,(cl-name 'read 'formatted) (object stream)
"Read the formatted block data from a stream."
(check-gsl-status
(cffi:foreign-funcall
"gsl_block_fscanf"
:pointer stream
:pointer object
:int)
',(cl-name 'read 'formatted)))))))
(defclass gsl-data ()
((pointer :initarg :pointer :reader pointer)
......@@ -101,6 +109,33 @@
(:documentation "Validate the values in the object."))
(export 'with-data)
(defmacro with-data ((symbol type size &optional zero) &body body)
"Allocate GSL data, bind to pointer,
and then deallocated it when done. If zero is T, zero the
contents when allocating."
(flet ((cl-name (action)
(intern (format nil "GSL-~a-~a" type action))))
(let ((ptr (gensym "PTR")))
`(let* ((,ptr
(,(if zero (cl-name 'calloc) (cl-name 'alloc))
,@(if (listp size) size (list size))))
(,symbol
(make-instance ',(intern (format nil "GSL-~a" type))
:pointer ,ptr)))
(check-null-pointer ,ptr
:ENOMEM
(format nil "For '~a of GSL type ~a." ',symbol ',type))
#+old
(when (cffi:null-pointer-p ,ptr)
(error 'gsl-error
:gsl-errno (cffi:foreign-enum-value 'gsl-errorno :ENOMEM)
:gsl-reason
(format nil "For '~a of GSL type ~a." ',symbol ',type)))
(unwind-protect
(progn ,@body)
(,(cl-name 'free) ,ptr))))))
#+new
(defmacro with-data ((symbol type size &optional init validate) &body body)
"Allocate GSL data, bind to pointer,
and then deallocated it when done. If init is T, init the
......
......@@ -3,7 +3,7 @@
; description: Matrices
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Wed Apr 5 2006 - 22:33
; modified: Wed Apr 12 2006 - 23:51
;********************************************************
;;; $Id: $
......@@ -22,12 +22,8 @@
(block :pointer)
(owner :int))
(defclass gsl-matrix (gsl-data)
()
(:documentation "GSL matrix."))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "matrix" 2)
(gsl-data-functions "matrix" :double 2)
(add-wrap-type gsl-matrix-c (lambda (x) `(pointer ,x)))
......
......@@ -3,7 +3,7 @@
; description: Permutations
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Fri Apr 7 2006 - 18:00
; modified: Wed Apr 12 2006 - 23:51
;********************************************************
;;; $Id: $
......@@ -18,12 +18,8 @@
(size :size)
(data :pointer))
(defclass gsl-permutation (gsl-data)
()
(:documentation "GSL permutation."))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "permutation")
(gsl-data-functions "permutation" :size)
(add-wrap-type gsl-permutation-c (lambda (x) `(pointer ,x)))
......
......@@ -3,7 +3,7 @@
; description: Vectors
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Wed Apr 5 2006 - 23:34
; modified: Wed Apr 12 2006 - 23:51
;********************************************************
;;; $Id: $
......@@ -47,12 +47,8 @@ deallocated with the vector.
(block :pointer)
(owner :int))
(defclass gsl-vector (gsl-data)
()
(:documentation "GSL vector."))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "vector")
(gsl-data-functions "vector" :double)
(add-wrap-type gsl-vector-c (lambda (x) `(pointer ,x)))
......@@ -373,7 +369,7 @@ vector @var{a}, @math{a'_i = a_i + x}.")
(with-data (vec1 vector 3)
(set-vector vec1 -3.21d0 1.0d0 12.8d0) (print-vector vec1)
(vector-swap vec1 0 1) (print-vector vec1)
(vector-swap-elements vec1 0 1) (print-vector vec1)
(vector-reverse vec1) (print-vector vec1)
(vector*c vec1 2.0d0) (print-vector vec1)
(vector+c vec1 2.0d0) (print-vector vec1))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment