From 94651b3d87d7e76735139f0838261bf927759845 Mon Sep 17 00:00:00 2001
From: liam <liam@a3d8a0fb-c1db-0310-ace7-a616afeb9e30>
Date: Fri, 21 Apr 2006 13:41:25 +0000
Subject: [PATCH] Bind named vector dimension in defun-gsl expansion so that
 e.g. (defun-gsl polynomial-solve-ws     ((coefficients (:double n))
 (workspace poly-complex-workspace))   "gsl_poly_complex_solve"   :return
 ((gsl-complex (1- n)))) expands to (DEFUNX-MAP POLYNOMIAL-SOLVE-WS           
  "gsl_poly_complex_solve"             (COEFFICIENTS WORKSPACE)            
 (LET ((N (FIRST (STORAGE-SIZE COEFFICIENTS))))              
 (WITH-FOREIGN-OBJECTS ((#:RET4113 'GSL-COMPLEX (1- N))) 	... ))) This
 currently works only for a vector; no accomodation is made for matrices.

git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3043 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
---
 interface.lisp  | 140 ++++++++++++++++++++++++++----------------------
 polynomial.lisp |   3 +-
 2 files changed, 78 insertions(+), 65 deletions(-)

diff --git a/interface.lisp b/interface.lisp
index 79777d10..d89c0dbb 100644
--- a/interface.lisp
+++ b/interface.lisp
@@ -3,7 +3,7 @@
 ; description: Macros to interface GSL functions.
 ; date:        Mon Mar  6 2006 - 22:35                   
 ; author:      Liam M. Healy
-; modified:    Wed Apr 19 2006 - 17:06
+; modified:    Fri Apr 21 2006 - 09:26
 ;********************************************************
 
 (in-package :gsl)
@@ -197,7 +197,7 @@ and a scaling exponent e10, such that the value is val*10^e10."
 (defun wrap-form (form wrappers)
   (if wrappers
       (wrap-form
-       `(,@(first wrappers) ,form)
+       (if (first wrappers) `(,@(first wrappers) ,form) form)
        (rest wrappers))
       form))
 
@@ -216,25 +216,33 @@ and a scaling exponent e10, such that the value is val*10^e10."
   "Convert the argument declarations to a list of declarations appropriate
    for foreign-funcall.  If mode is T, a mode argument will be added to the end,
    if it is an integer, it will be put at that position."
-  (flet ((splicearg (spec)
-	   ;; No accomodation for matrices (two indices) yet
-	   (if (rst-arrayp spec)
-	       (values
-		(if (rst-pointer-last-p spec)
-		    `(:size (first (storage-size ,(rst-symbol spec)))
-		      :pointer (gsl-array ,(rst-symbol spec)))
-		    `(:pointer (gsl-array ,(rst-symbol spec))
-		      :size (first (storage-size ,(rst-symbol spec))))))
-	       (values
-		`(,(rst-type spec)
-		  ,(wrap-arg spec))))))
-    (mapcan #'splicearg
-	    (if mode
-		(let ((mode (if (integerp mode) mode (length arguments))))
-		  (append (subseq arguments 0 mode)
-			  '((mode sf-mode))
-			  (subseq arguments mode)))
-		arguments))))
+  (let (sizes)				; save the dimension arg if not '*
+    (flet ((splicearg (spec)
+	     ;; No accomodation for matrices (two indices) yet
+	     (if (rst-arrayp spec)
+		 (let* ((value `(first (storage-size ,(rst-symbol spec))))
+			(use-form
+			 (if (eq (rst-dim spec) '*)
+			     value
+			     (progn
+			       (push `(,(rst-dim spec) ,value) sizes)
+			       (rst-dim spec)))))
+		   (if (rst-pointer-last-p spec)
+		       `(:size ,use-form
+			 :pointer (gsl-array ,(rst-symbol spec)))
+		       `(:pointer (gsl-array ,(rst-symbol spec))
+			 :size ,use-form)))
+		 `(,(rst-type spec)
+		   ,(wrap-arg spec)))))
+      (values
+       (mapcan #'splicearg
+	       (if mode
+		   (let ((mode (if (integerp mode) mode (length arguments))))
+		     (append (subseq arguments 0 mode)
+			     '((mode sf-mode))
+			     (subseq arguments mode)))
+		   arguments))
+       sizes))))
 
 ;;;;****************************************************************************
 ;;;; Checking results
@@ -300,46 +308,50 @@ and a scaling exponent e10, such that the value is val*10^e10."
 	(return-symb-type 
 	 (unless (or (eq c-return-value :return) return-input)
 	   (return-symbol-type return))))
-    `(,@(if (eq cl-name :lambda)
-	    '(lambda)
-	    `(,(if method 'defmethod-map 'defunx-map) ,cl-name ,gsl-name))
-      ,(if mode 
-	   `(,@clargs &optional (mode :double-prec))
-	   `(,@clargs))
-      ,@(when documentation (list documentation))
-      ,(wrap-form 			; with-foreign-object
-	`(let ((creturn
-		(cffi:foreign-funcall
-		 ,gsl-name
-		 ,@(splice-arguments arguments mode)
-		 ,@(mapcan (lambda (r) `(:pointer ,(rst-symbol r)))
-			   return-symb-type)
-		 ,(case c-return-value
-			(:return (first return))
-			(:void :void)
-			(t :int)))))
-	  ,@(case c-return-value
-		  (:void '((declare (ignore creturn))))
-		  (:error-code
-		   (if method
-		       `((check-gsl-status creturn `(,',cl-name))) ; need args
-		       `((check-gsl-status creturn `(,',cl-name ,,@clargs))))))
-	  ,@(check-null-pointers check-null-pointers)
-	  ,@after
-	  (values
-	   ,@return-input
-	   ,@(case c-return-value
-		   (:number-of-answers
-		    (mapcan
-		     (lambda (decl seq)
-		       `((when (> creturn ,seq) ,@(pick-result decl))))
-		     return-symb-type
-		     (loop for i below (length return) collect i)))
-		   (:success-failure
-		    '((success-failure creturn)))
-		   (:return (list (wrap-arg `(creturn ,@return))))
-		   (t
-		    (mapcan #'pick-result return-symb-type)))))
-	(when return-symb-type
-	  `((cffi:with-foreign-objects
-		,(mapcar #'wfo-declare return-symb-type))))))))
+    (multiple-value-bind (cargs dimbind)
+	(splice-arguments arguments mode)
+      `(,@(if (eq cl-name :lambda)
+	      '(lambda)
+	      `(,(if method 'defmethod-map 'defunx-map) ,cl-name ,gsl-name))
+	,(if mode 
+	     `(,@clargs &optional (mode :double-prec))
+	     `(,@clargs))
+	,@(when documentation (list documentation))
+	,(wrap-form 			; with-foreign-object
+	  `(let ((creturn
+		  (cffi:foreign-funcall
+		   ,gsl-name
+		   ,@cargs
+		   ,@(mapcan (lambda (r) `(:pointer ,(rst-symbol r)))
+			     return-symb-type)
+		   ,(case c-return-value
+			  (:return (first return))
+			  (:void :void)
+			  (t :int)))))
+	    ,@(case c-return-value
+		    (:void '((declare (ignore creturn))))
+		    (:error-code
+		     (if method
+			 `((check-gsl-status creturn `(,',cl-name))) ; need args
+			 `((check-gsl-status creturn `(,',cl-name ,,@clargs))))))
+	    ,@(check-null-pointers check-null-pointers)
+	    ,@after
+	    (values
+	     ,@return-input
+	     ,@(case c-return-value
+		     (:number-of-answers
+		      (mapcan
+		       (lambda (decl seq)
+			 `((when (> creturn ,seq) ,@(pick-result decl))))
+		       return-symb-type
+		       (loop for i below (length return) collect i)))
+		     (:success-failure
+		      '((success-failure creturn)))
+		     (:return (list (wrap-arg `(creturn ,@return))))
+		     (t
+		      (mapcan #'pick-result return-symb-type)))))
+	  (list
+	   (when return-symb-type
+	     `(cffi:with-foreign-objects
+	       ,(mapcar #'wfo-declare return-symb-type)))
+	   (when dimbind `(let ,dimbind))))))))
diff --git a/polynomial.lisp b/polynomial.lisp
index 1db16a15..986b4786 100644
--- a/polynomial.lisp
+++ b/polynomial.lisp
@@ -3,7 +3,7 @@
 ; description: Polynomials                               
 ; date:        Tue Mar 21 2006 - 18:33                   
 ; author:      Liam M. Healy                             
-; modified:    Thu Apr 20 2006 - 18:16
+; modified:    Fri Apr 21 2006 - 09:20
 ;********************************************************
 ;;; $Id: $
 
@@ -11,6 +11,7 @@
 
 ;;; To do:
 ;;; Divided difference needs to be checked.
+;;; polynomial-solve-ws awaits complex vectors 
 
 ;;;;****************************************************************************
 ;;;; Polynomial Evaluation
-- 
GitLab