From a22840979bfab0586b34440ff35002a98bbb2eed Mon Sep 17 00:00:00 2001
From: "Liam M. Healy" <lnp@healy.washington.dc.us>
Date: Wed, 24 Nov 2010 15:27:01 -0500
Subject: [PATCH] New macro access-value

New macro access-value to call gsl_*_set and gsl_*_get, as yet unused.
It will eventually replace get-value and (setf get-value) as used in
reference-foreign-element, but has the arguments in the right order
and because it's a macro, expands immediately to a
cffi:foreign-funcall instead of doing a generic function dispatch on
an eql spcializer of the class name.
---
 data/both.lisp | 31 +++++++++++++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

diff --git a/data/both.lisp b/data/both.lisp
index 9559ad12..f97a3086 100644
--- a/data/both.lisp
+++ b/data/both.lisp
@@ -1,8 +1,8 @@
 ;; Functions for both vectors and matrices.
 ;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
-;; Time-stamp: <2010-07-13 21:46:11EDT both.lisp>
+;; Time-stamp: <2010-11-24 15:12:33EST both.lisp>
 ;;
-;; Copyright 2008, 2009 Liam M. Healy
+;; Copyright 2008, 2009, 2010 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
 ;;
 ;; This program is free software: you can redistribute it and/or modify
@@ -85,6 +85,33 @@
 ;;; avoid the overhead of instantiating a foreign-array object to
 ;;; access components, we use these functions.
 
+(defmacro access-value (mpointer class-name value &rest indices)
+  "Access the GSL array value from the mpointer.  If value is not nil,
+   set the value; otherwise, get the value."
+  ;; (access-value ptr grid:vector-unsigned-byte-16 45 3)
+  ;; (FOREIGN-FUNCALL "gsl_vector_ushort_set" :POINTER PTR SIZET 3 :UNSIGNED-SHORT 45 :VOID)
+  ;; (access-value ptr grid:matrix-unsigned-byte-16 nil 45 3)
+  ;; (FOREIGN-FUNCALL "gsl_matrix_ushort_get" :POINTER PTR SIZET 45 SIZET 3 :UNSIGNED-SHORT)
+  ;; (access-value ptr grid:matrix-unsigned-byte-16 45 3)
+  ;; => error
+  (let ((element-type (grid::farray-element-type class-name))
+	(matrixp (subtypep class-name 'grid:matrix)))
+    (unless (or (and matrixp (eql 2 (length indices)))
+		(and (not matrixp) (eql 1 (length indices))))
+      (error "The number of indices, ~a, is not correct for an array of class ~a"
+	     (length indices)
+	     class-name))
+    `(cffi:foreign-funcall
+      ,(actual-gsl-function-name
+	`("gsl_" :category :type ,(if value "_set" "_get"))
+	(if matrixp 'matrix 'vector)
+	element-type)
+      :pointer ,mpointer
+      sizet ,(first indices)
+      ,@(when matrixp (list 'sizet (second indices)))
+      ,(grid:cl-cffi element-type)
+      ,@(when value `(,value :void)))))
+
 (defmfun get-value ((class-name (eql vector)) mpointer &rest indices)
   ("gsl_"  :category :type "_get")
   ((mpointer :pointer) ((first indices) sizet))
-- 
GitLab