From 8b763e87c34d6f0af471f983485c78298e73386e Mon Sep 17 00:00:00 2001
From: lhealy <lhealy@af03a46b-e846-0410-96e5-d5653c316fd0>
Date: Tue, 8 Jul 2008 01:38:32 +0000
Subject: [PATCH] Polynomial functions now function with ffa.  New macro #'a;
 updated documentation.html but it is still incomplete.

git-svn-id: svn+ssh://common-lisp.net/project/gsll/svn/branches/ffa@66 af03a46b-e846-0410-96e5-d5653c316fd0
---
 data/data.lisp                   | 52 ++++++++++++++++++++++++--------
 documentation/documentation.html | 12 +++++---
 gsll.asd                         |  3 +-
 init/number-conversion.lisp      | 22 +++++++-------
 4 files changed, 59 insertions(+), 30 deletions(-)

diff --git a/data/data.lisp b/data/data.lisp
index 76e8fb7d..39609a8c 100644
--- a/data/data.lisp
+++ b/data/data.lisp
@@ -1,6 +1,6 @@
 ;; Data using ffa
 ;; Liam Healy 2008-04-06 21:23:41EDT data-ffa.lisp
-;; Time-stamp: <2008-07-06 09:47:37EDT data.lisp>
+;; Time-stamp: <2008-07-07 21:26:18EDT data.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -46,6 +46,10 @@
     (copy-c-to-cl object)
     (princ (cl-array object) stream)))
 
+(defun dim0 (object)
+  "The first dimension of the object."
+  (first (dimensions object)))
+
 ;;;;****************************************************************************
 ;;;; Definition of specific data classes
 ;;;;****************************************************************************
@@ -146,7 +150,37 @@
       (* 2 (total-size object))
       (total-size object)))
 
-(export 'els)
+(defun numtypespec (sexp)
+  "The sexp is a type specification for a numerical type."
+  (ignore-errors (subtypep sexp 'number)))
+
+(defun abody (&rest type-contents)
+  "Make an array of a specific element type from the literal contents supplied.
+   If no type is given, it is assumed to be 'double-float."
+  (let* ((firsttype (numtypespec (first type-contents)))
+	 (element-type
+	  (if firsttype
+	      (first type-contents)
+	      'double-float))
+	 (cont
+	  (if firsttype
+	      (rest type-contents)
+	      type-contents)))
+    (make-array*
+     (if (listp (first cont))		; make a matrix
+	 (list (length cont) (length (first cont)))
+	 (list (length cont)))		; make a vector
+     element-type
+     :initial-contents
+     (if (listp (first cont))
+	 (apply #'append cont)		; flatten lists
+	 cont))))
+
+(export 'a)
+(defmacro a (&rest type-contents)
+  "Create an array (vector or matrix) from the literal contents."
+  `(abody ,@(mapcar (lambda (e) `(quote ,e)) type-contents)))
+
 (defun expand-data (symbol type init-or-spec sync-exit body)
   "Expand the form for a gsl-data object.  The symbol is bound
    within the body to the object.  The argument
@@ -155,17 +189,9 @@
   (cl-utilities:with-unique-names (cptr eltype)
     `(macrolet
       ;; #'els is a convenience macro to define the make-array*
-      ((els (&rest contents)
-	`(let ((cont ',contents))
-	  (make-array*
-	   (if (listp (first cont))	; make a matrix
-	       (list (length cont) (length (first cont)))
-	       (list (length cont)))	; make a vector
-	   ',',(lookup-type type *class-element-type*)
-	   :initial-contents
-	   (if (listp (first cont))
-	       (apply #'append cont)	; flatten lists
-	       cont)))))
+      ((a (&rest contents)
+	`(abody ',',(lookup-type type *class-element-type*)
+	  ,@(mapcar (lambda (e) `(quote ,e)) contents))))
       (let* ((,symbol (make-data ',type ,init-or-spec))
 	     (,eltype (element-type ,symbol)))
 	(ffa:with-pointer-to-array
diff --git a/documentation/documentation.html b/documentation/documentation.html
index d96b52c6..1c5a9c8f 100644
--- a/documentation/documentation.html
+++ b/documentation/documentation.html
@@ -90,17 +90,21 @@ let binding.
  supported by GSL, but GSLL has implemented only a few of these:
  complex, double-float, single-float, and fixnum, because those types
  are defined by the Common Lisp standard.
- <p>Vectors and matrices can be converted to and from their Lisp
+ <p>FIXME Vectors and matrices can be converted to and from their Lisp
  counterparts with <code>data</code> and <code>(setf data)</code>.
  Setting the GSL value to a Lisp value at initialization
  can be done within the <code>letm</code> by giving the Lisp value as
  the first argument after the type, for example
 <pre>
-(letm ((vec (vector-double-float #(-3.21d0 1.0d0 12.8d0))))
-   (data vec))
+(letm ((vec (vector-double-float (a -3.21d0 1.0d0 12.8d0))))
+   (???? vec))
 </pre>
+<p>
  Individual elements of data may be accessed with <code>maref</code>,
  either directly or in a <code>setf</code>.
+ The macro #'a is a convenience for the specification of an array
+ with literal content.
+</p>
 
  <h3>Status</h3>
  <div class="content">
@@ -150,7 +154,7 @@ gamma-randist, negative-binomial.
     <address><a href="mailto:gsll-devel@common-lisp.net">Liam Healy</a></address>
 <!-- hhmts start -->
     <small>
-       Time-stamp: <2008-03-20 19:09:57EDT documentation.html>
+       Time-stamp: <2008-07-07 21:30:48EDT documentation.html>
        </small>
 <!-- hhmts end -->
  </div>
diff --git a/gsll.asd b/gsll.asd
index 418832fa..b3006b24 100644
--- a/gsll.asd
+++ b/gsll.asd
@@ -1,6 +1,6 @@
 ;; Definition of GSLL system 
 ;; Liam Healy
-;; Time-stamp: <2008-07-06 10:27:21EDT gsll.asd>
+;; Time-stamp: <2008-07-07 20:29:37EDT gsll.asd>
 ;; $Id$
 
 (asdf:defsystem "gsll"
@@ -42,7 +42,6 @@
 	     (:file "combination"
 		    :depends-on (data matrix both permutation))	; preload defgeneric
 	     ))
-   #+no
    (:file "polynomial" :depends-on (init data))
    #+no
    (:module special-functions
diff --git a/init/number-conversion.lisp b/init/number-conversion.lisp
index d498370f..d888a001 100644
--- a/init/number-conversion.lisp
+++ b/init/number-conversion.lisp
@@ -1,6 +1,6 @@
 ;; Conversion of numbers C->CL
 ;; Liam Healy, Sun May 28 2006 - 22:04
-;; Time-stamp: <2008-05-10 22:12:21EDT number-conversion.lisp>
+;; Time-stamp: <2008-07-06 16:33:06EDT number-conversion.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -17,28 +17,24 @@
 
 (defmacro scref (size &optional (index 0))
   "Reference C size(s)."
-  `(cffi:mem-aref ,size 'size ,index))
+  `(cffi:mem-aref ,size 'sizet ,index))
 
 ;;;;****************************************************************************
 ;;;; Complex numbers
 ;;;;****************************************************************************
 
-#|
-(cffi:defcstruct gsl-complex
-  "A complex number in GSL."
-  (dat :double :count 2))
-
-(defun complex-to-cl (gsl-complex &optional (index 0))
+;;; GSL complex struct is defined in init/element-types.lisp.
+(defun complex-to-cl
+    (gsl-complex &optional (index 0) (complex-type 'complex-double-c))
   "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." 
   (let ((carr (cffi:foreign-slot-value
 	       (cffi:inc-pointer
 		gsl-complex
-		(* index (cffi:foreign-type-size 'gsl-complex)))
-	       'gsl-complex 'dat)))
+		(* index (cffi:foreign-type-size complex-type)))
+	       complex-type 'dat)))
     (complex (dcref carr 0)
 	     (dcref carr 1))))
-|#
 
 ;;;;****************************************************************************
 ;;;; Conversion form
@@ -54,4 +50,8 @@
      `((val ,(st-symbol decl) 'sf-result-e10)
        (e10 ,(st-symbol decl))
        (err ,(st-symbol decl) 'sf-result-e10)))
+    (complex-double-c
+     `((complex-to-cl ,(st-symbol decl) 0 'complex-double-c)))
+    (complex-float-c
+     `((complex-to-cl ,(st-symbol decl) 0 'complex-float-c)))
     (t `((cffi:mem-aref ,(st-symbol decl) ',(st-type decl))))))	
-- 
GitLab