From 8d898b21164116a27c5ffe69aaf9c3832880afd8 Mon Sep 17 00:00:00 2001
From: Liam Healy <liam@thinkpad.local>
Date: Tue, 13 Jul 2010 22:41:05 -0400
Subject: [PATCH] Define get-value and (setf get-value) methods for matrices

Define get-value and (setf get-value) methods for matrices, and
compute two indices when used, by making use of
affi::delinearize-index.  Add &rest to *defmfun-llk* so that it won't
be included in the ignore list.  Minor fixes to make more tests work.
---
 data/both.lisp         | 42 ++++++++++++++++++++++++++++++++++++------
 init/forms.lisp        |  4 ++--
 init/funcallable.lisp  |  9 ++++++---
 tests/combination.lisp |  3 +--
 tests/lu.lisp          |  2 +-
 tests/row.lisp         |  4 ++--
 6 files changed, 48 insertions(+), 16 deletions(-)

diff --git a/data/both.lisp b/data/both.lisp
index 59b119a1..9559ad12 100644
--- a/data/both.lisp
+++ b/data/both.lisp
@@ -1,6 +1,6 @@
 ;; Functions for both vectors and matrices.
 ;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
-;; Time-stamp: <2010-07-12 12:45:15EDT both.lisp>
+;; Time-stamp: <2010-07-13 21:46:11EDT both.lisp>
 ;;
 ;; Copyright 2008, 2009 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -78,10 +78,16 @@
   "Exchange the elements of a and b
    by copying.  The two must have the same dimensions.")
 
-;;; For matrix functions, there should be another index argument
-(defmfun get-value ((class-name (eql vector)) mpointer index)
+;;;;****************************************************************************
+;;;; Array elements; used in callbacks scalarsp=T only
+;;;;****************************************************************************
+;;; Normal foreign array access is with grid:gref, but in order to
+;;; avoid the overhead of instantiating a foreign-array object to
+;;; access components, we use these functions.
+
+(defmfun get-value ((class-name (eql vector)) mpointer &rest indices)
   ("gsl_"  :category :type "_get")
-  ((mpointer :pointer) (index sizet))
+  ((mpointer :pointer) ((first indices) sizet))
   :definition :generic
   :c-return :element-c-type
   :export nil
@@ -89,10 +95,20 @@
   "Get the single element of the GSL vector.  This is used
    in callbacks.")
 
+(defmfun get-value ((class-name (eql matrix)) mpointer &rest indices)
+  ("gsl_"  :category :type "_get")
+  ((mpointer :pointer) ((first indices) sizet) ((second indices) sizet))
+  :definition :methods
+  :c-return :element-c-type
+  :export nil
+  :documentation
+  "Get the single element of the GSL matrix.  This is used
+   in callbacks.")
+
 (defmfun (setf get-value)
-    (value (class-name (eql vector)) mpointer index)
+    (value (class-name (eql vector)) mpointer &rest indices)
   ("gsl_"  :category :type "_set")
-  ((value :element-c-type) (mpointer :pointer) (index sizet))
+  ((value :element-c-type) (mpointer :pointer) ((first indices) sizet))
   :definition :generic
   :element-types #+fsbv t #-fsbv :no-complex
   :c-return :void
@@ -102,6 +118,20 @@
   "Set the single element of the GSL vector to the value.  This is
    used in callbacks.")
 
+(defmfun (setf get-value)
+    (value (class-name (eql matrix)) mpointer &rest indices)
+  ("gsl_"  :category :type "_set")
+  ((value :element-c-type) (mpointer :pointer)
+   ((first indices) sizet) ((second indices) sizet))
+  :definition :methods
+  :element-types #+fsbv t #-fsbv :no-complex
+  :c-return :void
+  :return (value)
+  :export nil
+  :documentation
+  "Set the single element of the GSL vector to the value.  This is
+   used in callbacks.")
+
 ;;;;****************************************************************************
 ;;;; Elementwise arithmetic operations overwriting an array
 ;;;;****************************************************************************
diff --git a/init/forms.lisp b/init/forms.lisp
index da797732..f72054e4 100644
--- a/init/forms.lisp
+++ b/init/forms.lisp
@@ -1,6 +1,6 @@
 ;; Lisp forms
 ;; Liam Healy 2009-03-07 15:49:25EST forms.lisp
-;; Time-stamp: <2010-07-12 12:28:48EDT forms.lisp>
+;; Time-stamp: <2010-07-13 22:32:44EDT forms.lisp>
 ;;
 ;; Copyright 2009 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -24,7 +24,7 @@
 ;;;; Arglists
 ;;;;****************************************************************************
 
-(defparameter *defmfun-llk* '(&optional &key &aux)
+(defparameter *defmfun-llk* '(&optional &key &aux &rest)
   "Possible lambda-list keywords.")
 
 (defparameter *defmfun-optk* '(&optional &key)
diff --git a/init/funcallable.lisp b/init/funcallable.lisp
index 308c4870..a24e66f4 100644
--- a/init/funcallable.lisp
+++ b/init/funcallable.lisp
@@ -1,6 +1,6 @@
 ;; Generate a lambda that calls the user function; will be called by callback.
 ;; Liam Healy 
-;; Time-stamp: <2010-07-13 21:05:37EDT funcallable.lisp>
+;; Time-stamp: <2010-07-13 21:59:01EDT funcallable.lisp>
 ;;
 ;; Copyright 2009, 2010 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -76,7 +76,8 @@
        ,ptr
        ',(parse-callback-argspec argspec 'dimensions)
        ',(grid:cffi-cl (parse-callback-argspec argspec 'element-type))
-       nil))))
+       nil))
+    ((nil) ptr)))
 
 ;;;;****************************************************************************
 ;;;; Reference foreign elements and make multiple-value-bind form
@@ -93,7 +94,9 @@
 	       (length (value-from-dimensions argspec dimension-values))
 	       (grid:cffi-cl (parse-callback-argspec argspec 'element-type)))
 	    ,foreign-variable-name
-	    ,linear-index)
+	    ,@(affi::delinearize-index
+	       (affi:make-affi (value-from-dimensions argspec dimension-values))
+	       linear-index))
 	  `(cffi:mem-aref
 	    ,foreign-variable-name
 	    ',(parse-callback-argspec argspec 'element-type)
diff --git a/tests/combination.lisp b/tests/combination.lisp
index 0958580f..d767ec03 100644
--- a/tests/combination.lisp
+++ b/tests/combination.lisp
@@ -52,6 +52,5 @@
     (LOOP FOR I FROM 0 TO 4 APPEND
 	 (LET ((COMB (MAKE-COMBINATION 4 I)))
 	   (INIT-FIRST COMB)
-	   (LOOP COLLECT (COPY-SEQ (GRID:COPY-TO COMB)) WHILE
+	   (LOOP COLLECT (grid:contents comb) WHILE
 		(COMBINATION-NEXT COMB)))))))
-
diff --git a/tests/lu.lisp b/tests/lu.lisp
index e96bb178..2fd3573c 100644
--- a/tests/lu.lisp
+++ b/tests/lu.lisp
@@ -139,4 +139,4 @@
      (INVERT-MATRIX
       (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :DIMENSIONS '(2 2)
 			       :INITIAL-CONTENTS
-			       '(1.0d0 2.0d0 3.0d0 4.0d0)))))))
+			       '((1.0d0 2.0d0) (3.0d0 4.0d0))))))))
diff --git a/tests/row.lisp b/tests/row.lisp
index d59e66cc..abda2bbb 100644
--- a/tests/row.lisp
+++ b/tests/row.lisp
@@ -79,7 +79,7 @@
     (LET ((M1
 	   (GRID:MAKE-FOREIGN-ARRAY
 	    '(SIGNED-BYTE 8)
-	    :INITIAL-CONTETS
+	    :INITIAL-CONTENTS
 	    '((-64 -68 71)
 	      (-91 52 -10)
 	      (73 -5 123))))
@@ -131,7 +131,7 @@
     (LET ((M1
 	   (GRID:MAKE-FOREIGN-ARRAY
 	    '(SIGNED-BYTE 32)
-	    :INITIAL-CONTETS
+	    :INITIAL-CONTENTS
 	    '((-64 -68 71)
 	      (-91 52 -10)
 	      (73 -5 123))))
-- 
GitLab