From 74d8995ac9fbe3ea8213b3f31afe732f9356eb7d Mon Sep 17 00:00:00 2001
From: Liam Healy <liam@thinkpad.local>
Date: Sun, 28 Dec 2008 17:04:09 -0500
Subject: [PATCH] Use class foreign-array

Split off the class definition for foreign-array into its own file
along with applicable definitions.  Make permutations and combinations
direct subclasses of both foreign-array and marray, but not subclasses
of vectors.  All these classes now have initialize-instance :after
methods that allocate and set the pointers and finalizers.  All tests
pass.
---
 data/both.lisp              |  10 +-
 data/combination.lisp       |  54 +++++-----
 data/foreign-array.lisp     | 148 ++++++++++++++++++++++++++
 data/maref.lisp             |  16 +--
 data/marray.lisp            | 201 ++++++------------------------------
 data/matrix.lisp            |  10 +-
 data/permutation.lisp       |  39 ++++---
 data/vector.lisp            |  12 +--
 gsll.asd                    |   8 +-
 init/generate-examples.lisp |   4 +-
 10 files changed, 257 insertions(+), 245 deletions(-)
 create mode 100644 data/foreign-array.lisp

diff --git a/data/both.lisp b/data/both.lisp
index a099d89d..eedc7ee7 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: <2008-11-16 10:23:32EST both.lisp>
+;; Time-stamp: <2008-12-28 16:42:22EST both.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -9,9 +9,9 @@
 ;;;; Administrative (internal use)
 ;;;;****************************************************************************
 
-(defmfun alloc-from-block ((object vector))
+(defmfun alloc-from-block ((object vector) blockptr)
   ("gsl_" :category :type "_alloc_from_block")
-  (((block-pointer object) :pointer)	
+  ((blockptr :pointer)
    (0 sizet)				; offset
    ((total-size object) sizet)			; number of elements
    (1 sizet))				; stride
@@ -20,9 +20,9 @@
   :export nil
   :documentation "Allocate memory for the GSL struct given a block pointer.")
 
-(defmfun alloc-from-block ((object matrix))
+(defmfun alloc-from-block ((object matrix) blockptr)
   ("gsl_" :category :type "_alloc_from_block")
-  (((block-pointer object) :pointer)
+  ((blockptr :pointer)
    (0 sizet)				; offset
    ((first (dimensions object)) sizet)	; number of rows
    ((second (dimensions object)) sizet)	; number of columns
diff --git a/data/combination.lisp b/data/combination.lisp
index b1b3a24d..cdc915f7 100644
--- a/data/combination.lisp
+++ b/data/combination.lisp
@@ -1,6 +1,6 @@
 ;; Combinations
 ;; Liam Healy, Sun Mar 26 2006 - 11:51
-;; Time-stamp: <2008-12-06 18:57:42EST combination.lisp>
+;; Time-stamp: <2008-12-28 16:36:24EST combination.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -9,18 +9,33 @@
 ;;;; Combination structure and CL object
 ;;;;****************************************************************************
 
-;;; GSL-combination definition
-(cffi:defcstruct gsl-combination-c
-  (n sizet)
-  (k sizet)
+(defclass combination (mobject foreign-array)
+  ((element-type
+    :initform
+    #+sizet-64 '(unsigned-byte 64)
+    #+sizet-32 '(unsigned-byte 32)
+    :reader element-type :allocation :class)
+   (choice-of :initarg :choice-of :reader choice-of :type (integer 0)
+	      :documentation "Maximum possible value; n in the (n k) notation."))
+  (:documentation "GSL combinations."))
+
+(cffi:defcstruct gsl-combination-c	; The GSL struct
+  (choice-of sizet)			; n
+  (size sizet)				; k
   (data :pointer))
 
-(defclass combination
-    (#+sizet-64 vector-unsigned-byte-64
-     #+sizet-32 vector-unsigned-byte-32)
-  ((choice-of :initarg :choice-of :reader choice-of :type integer
-	      :documentation "Maximum possible value; n in the (n k) notation."))
-  (:documentation "GSL permutations."))
+(defmethod initialize-instance :after
+    ((object combination) &key choice-of dimensions &allow-other-keys)
+  (let ((mptr (cffi:foreign-alloc 'gsl-combination-c)))
+    (setf (slot-value object 'mpointer)
+	  mptr
+	  (cffi:foreign-slot-value mptr 'gsl-combination-c 'data)
+	  (c-pointer object)
+	  (cffi:foreign-slot-value mptr 'gsl-combination-c 'choice-of)
+	  choice-of
+	  (cffi:foreign-slot-value mptr 'gsl-combination-c 'size)
+	  dimensions)
+    (tg:finalize object (lambda () (cffi:foreign-free mptr)))))
 
 (export 'make-combination)
 
@@ -40,23 +55,6 @@
 	  (init-first comb)))
     comb))
 
-(defmethod alloc-gsl-struct ((object combination))
-  (unless (and (slot-boundp object 'mpointer) (slot-value object 'mpointer))
-    (let ((blockptr (cffi:foreign-alloc 'gsl-combination-c)))
-      (setf (block-pointer object)
-	    blockptr
-	    (cffi:foreign-slot-value blockptr 'gsl-combination-c 'data)
-	    (c-pointer object)
-	    (cffi:foreign-slot-value blockptr 'gsl-combination-c 'n)
-	    (choice-of object)
-	    (cffi:foreign-slot-value blockptr 'gsl-combination-c 'k)
-	    (first (dimensions object))
-	    (slot-value object 'mpointer)
-	    (block-pointer object))
-      (tg:finalize
-       object
-       (lambda () (cffi:foreign-free blockptr))))))
-
 ;;;;****************************************************************************
 ;;;; Setting values
 ;;;;****************************************************************************
diff --git a/data/foreign-array.lisp b/data/foreign-array.lisp
new file mode 100644
index 00000000..1d204b74
--- /dev/null
+++ b/data/foreign-array.lisp
@@ -0,0 +1,148 @@
+;; Foreign arrays (usually in C)
+;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp
+;; Time-stamp: <2008-12-28 15:53:06EST foreign-array.lisp>
+;; $Id: $
+
+(in-package :gsl)
+
+;;;;****************************************************************************
+;;;; Object and methods
+;;;;****************************************************************************
+
+(export '(dimensions total-size element-type))
+
+(defclass foreign-array ()
+  ((cl-array :documentation "The Lisp array.")
+   #-native
+   (c-pointer :accessor c-pointer :documentation "A pointer to the C array.")
+   (dimensions :reader dimensions)
+   (total-size :reader total-size)
+   (element-type :reader element-type)
+   (original-array :reader original-array)
+   (offset :reader offset)
+   #-native
+   (cl-invalid
+    :initform t :accessor cl-invalid
+    :documentation
+    "An indication of whether the Lisp object (slot 'data) agrees with the
+     C data.  If NIL, they agree.  If T, they disagree in an unspecified
+     way.  If a list of index sets, those indices disagree and the remainder
+     are correct.")
+   #-native
+   (c-invalid
+    :initform t :accessor c-invalid
+    :documentation
+    "An indication of whether the C data agrees with the
+     Lisp object (slot 'data).  If NIL, they agree.  If T,
+     they disagree in an unspecified
+     way.  If a list of index sets, those indices disagree and the remainder
+     are correct."))
+  (:documentation
+   "A superclass for arrays represented in C and CL."))
+
+;;; Allowable keys: :dimensions, :initial-contents, :initial-element.
+(defmethod initialize-instance :after
+    ((object foreign-array) &rest initargs &key dimensions initial-contents initial-element)
+  (declare (ignore dimensions initial-contents initial-element))
+  (with-slots (cl-array dimensions original-array offset total-size) object
+    (let ((ffa (apply #'make-ffa (element-type object) initargs)))
+      (setf cl-array ffa
+	    dimensions (array-dimensions ffa)
+	    total-size (array-total-size ffa)))
+    #-native (setf (cl-invalid object) nil)
+    (multiple-value-bind  (oa index-offset)
+	(find-original-array (cl-array object))
+      (setf original-array oa
+	    offset
+	    (* index-offset
+	       (cffi:foreign-type-size (cl-cffi (element-type object))))))))
+
+(defmethod print-object ((object foreign-array) stream)
+  (print-unreadable-object (object stream :type t) 
+    #-native (copy-c-to-cl object)
+    (princ (cl-array object) stream)))
+
+(defun dim0 (object)
+  "The first dimension of the object."
+  (first (dimensions object)))
+
+(defun dim1 (object)
+  "The first dimension of the object."
+  (second (dimensions object)))
+
+(defun element-size (object)
+  "The size of each element as stored in C."
+  (cffi:foreign-type-size (cl-cffi (element-type object))))
+
+;;;;****************************************************************************
+;;;; Syncronize C and CL
+;;;;****************************************************************************
+
+;;; For implementations with separate C and CL storage (non-native),
+;;; the two arrays must match when one side has updated and the other
+;;; side wishes to refer to the values.  For native implementations,
+;;; these don't do anything because they will always match.
+
+;;; Called in defmfun expansion right before GSL function is entered.
+#-native
+(defun copy-cl-to-c (object)
+  "Copy the CL array to the C array."
+  (when (c-invalid object)
+    (copy-array-to-pointer
+     (cl-array object)
+     (c-pointer object)
+     (component-type (element-type object))
+     0
+     (component-size object))
+    (setf (c-invalid object) nil)))
+
+;;; Called right before maref
+#-native
+(defun copy-c-to-cl (object)
+  "Copy the C array to the CL array."
+  (when (cl-invalid object)
+    (copy-array-from-pointer
+     (cl-array object)
+     (c-pointer object)
+     (component-type (element-type object))
+     0
+     (component-size object))
+    (setf (cl-invalid object) nil)))
+
+#-native
+(defun copy-array-to-pointer (array pointer lisp-type index-offset length)
+  "Copy length elements from array (starting at index-offset) of type
+   lisp-type to the memory area that starts at pointer, coercing the
+   elements if necessary."
+  (let ((cffi-type (component-type lisp-type)))
+    (loop
+       for pointer-index :from 0
+       :below (if (subtypep lisp-type 'complex) (* 2 length) length)
+       :by (if (subtypep lisp-type 'complex) 2 1)
+       for array-index :from index-offset
+       do
+       (if (subtypep lisp-type 'complex)
+	   (setf (cffi:mem-aref pointer cffi-type pointer-index)
+		 (realpart (row-major-aref array array-index))
+		 (cffi:mem-aref pointer cffi-type (1+ pointer-index))
+		 (imagpart (row-major-aref array array-index)))
+	   (setf (cffi:mem-aref pointer cffi-type pointer-index)
+		 (row-major-aref array array-index))))))
+
+#-native
+(defun copy-array-from-pointer (array pointer lisp-type index-offset length)
+  "Copy length elements from array (starting at index-offset) of type
+   lisp-type from the memory area that starts at pointer, coercing the
+   elements if necessary."
+  (let ((cffi-type (component-type lisp-type)))
+    (loop
+       for pointer-index :from 0
+       :below (if (subtypep lisp-type 'complex) (* 2 length) length)
+       :by (if (subtypep lisp-type 'complex) 2 1)
+       for array-index :from index-offset
+       do
+       (setf (row-major-aref array array-index)
+	     (complex 
+	      (cffi:mem-aref pointer cffi-type pointer-index)
+	      (cffi:mem-aref pointer cffi-type (1+ pointer-index)))))))
+
diff --git a/data/maref.lisp b/data/maref.lisp
index 0e4b75db..94bdd65a 100644
--- a/data/maref.lisp
+++ b/data/maref.lisp
@@ -1,6 +1,6 @@
 ;; Get/set array or elements: cl-array, maref
 ;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp
-;; Time-stamp: <2008-12-27 17:07:28EST maref.lisp>
+;; Time-stamp: <2008-12-28 16:32:54EST maref.lisp>
 ;; $Id: $
 
 (in-package :gsl)
@@ -18,7 +18,7 @@
 
 ;;; Both these functions take one of the following class arguments for
 ;;; the array:
-;;; - a marray
+;;; - a foreign-array
 ;;; - a Common Lisp array
 ;;; - a pointer to a GSL vector or matrix structure
 
@@ -28,11 +28,11 @@
 
 (defgeneric cl-array (object &optional array-rank element-type)
   (:documentation
-   "The array as a CL native array.  The object may be a marray object,
+   "The array as a CL native array.  The object may be a foreign-array object,
     a pointer to a GSL vector or matrix, or an ordinary CL array of one
     or two dimensions.  Optional arguments array-rank and element-type
     are used only for pointers.")
-  (:method ((object marray) &optional array-rank element-type)
+  (:method ((object foreign-array) &optional array-rank element-type)
     (declare (ignore array-rank element-type))
     #-native (copy-c-to-cl object)
     (slot-value object 'cl-array))
@@ -73,9 +73,9 @@
 
 (defgeneric maref (object index &optional index2 type)
   (:documentation
-   "An element of the data.  The object may be a marray object, a pointer to
+   "An element of the data.  The object may be a foreign-array object, a pointer to
     a GSL vector or matrix, or an ordinary CL array of one or two dimensions.")
-  (:method ((object marray) index &optional index2 type)
+  (:method ((object foreign-array) index &optional index2 type)
     (declare (ignore type))
     #-native (copy-c-to-cl object)
     (if index2
@@ -93,10 +93,10 @@
 
 (defgeneric (setf maref) (value object index &optional index2 type)
   (:documentation
-   "Set an element of the data.  The object may be a marray object,
+   "Set an element of the data.  The object may be a foreign-array object,
     a pointer to a GSL vector or matrix, or an ordinary CL array
     of one or two dimensions.")
-  (:method (value (object marray) index &optional index2 type)
+  (:method (value (object foreign-array) index &optional index2 type)
     (declare (ignore type))
     (if index2
 	(setf (aref (slot-value object 'cl-array) index index2) value)
diff --git a/data/marray.lisp b/data/marray.lisp
index 6c06b9a9..ee1640b6 100644
--- a/data/marray.lisp
+++ b/data/marray.lisp
@@ -1,72 +1,47 @@
 ;; A "marray" is an array in both GSL and CL
 ;; Liam Healy 2008-04-06 21:23:41EDT
-;; Time-stamp: <2008-12-27 16:54:11EST marray.lisp>
+;; Time-stamp: <2008-12-28 16:43:44EST marray.lisp>
 ;; $Id$
 
 (in-package :gsl)
 
 ;;;;****************************************************************************
-;;;; The class marray and element types that make subclasses
+;;;; The class marray and its construction
 ;;;;****************************************************************************
 
-(defclass foreign-array ()
-  ((cl-array :documentation "The Lisp array.")
-   #-native
-   (c-pointer :accessor c-pointer :documentation "A pointer to the C array.")
-   (dimensions :reader dimensions)
-   (total-size :reader total-size)
-   (element-type :reader element-type)
-   (original-array :reader original-array)
-   (offset :reader offset)
-   #-native
-   (cl-invalid
-    :initform t :accessor cl-invalid
-    :documentation
-    "An indication of whether the Lisp object (slot 'data) agrees with the
-     GSL C data.  If NIL, they agree.  If T, they disagree in an unspecified
-     way.  If a list of index sets, those indices disagree and the remainder
-     are correct.")
-   #-native
-   (c-invalid
-    :initform t :accessor c-invalid
-    :documentation
-    "An indication of whether the GSL C data agrees with the
-     Lisp object (slot 'data).  If NIL, they agree.  If T,
-     they disagree in an unspecified
-     way.  If a list of index sets, those indices disagree and the remainder
-     are correct."))
-  (:documentation
-   "A superclass for arrays represented in C and CL."))
-
 (defclass marray (mobject foreign-array)
-  ((block-pointer :initform nil :accessor block-pointer
-		  :documentation "A pointer to the gsl-block-c."))
+  ()
   (:documentation
    "A superclass for arrays represented in GSL and CL."))
 
-(export '(dimensions total-size element-type))
-
-;;; Allowable keys: :dimensions, :initial-contents, :initial-element.
-(defmethod initialize-instance :after
-    ((object marray) &rest initargs &key &allow-other-keys)
-  (with-slots (cl-array dimensions original-array offset total-size) object
-    (let ((ffa (apply #'make-ffa (element-type object) initargs)))
-      (setf cl-array ffa
-	    dimensions (array-dimensions ffa)
-	    total-size (array-total-size ffa)))
-    #-native (setf (cl-invalid object) nil)
-    (multiple-value-bind  (oa index-offset)
-	(find-original-array (cl-array object))
-      (setf original-array oa
-	    offset
-	    (* index-offset
-	       (cffi:foreign-type-size (cl-cffi (element-type object)))))))
-  (alloc-gsl-struct object))
+(cffi:defcstruct gsl-block-c		; The GSL struct
+  (size sizet)
+  (data :pointer))
 
-(defmethod print-object ((object marray) stream)
-  (print-unreadable-object (object stream :type t) 
-    #-native (copy-c-to-cl object)
-    (princ (cl-array object) stream)))
+;;; We don't allocate or free the C array data, because that is
+;;; handled by foreign-array.  We can use the GSL functions
+;;; *_alloc_from_block because they will allocate only the structure,
+;;; but we must use CFFI to allocate the block structure; otherwise
+;;; GSL would try to allocate the C array.  We do not use any of the
+;;; GSL free functions because they would free the C array data.
+
+(defmethod initialize-instance :after ((object marray) &rest initargs)
+  (declare (ignore initargs)) ; required by &rest arg for foreign-array?
+  ;; Need to check that all allocations succeeded.
+  ;; Don't do anything if mpointer has been assigned (shouldn't happen)
+  ;; or this is a permutation or combination (they have their own methods).
+  (unless (and (slot-boundp object 'mpointer) (mpointer object))
+    (let ((blockptr (cffi:foreign-alloc 'gsl-block-c)))
+      (setf (cffi:foreign-slot-value blockptr 'gsl-block-c 'size)
+	    (total-size object)
+	    (cffi:foreign-slot-value blockptr 'gsl-block-c 'data)
+	    (c-pointer object))
+      (let ((array-struct (alloc-from-block object blockptr)))
+	(setf (slot-value object 'mpointer) array-struct)
+	(tg:finalize object
+		     (lambda ()
+		       (cffi:foreign-free blockptr)
+		       (cffi:foreign-free array-struct)))))))
 
 (defmethod make-load-form ((object marray) &optional env)
   (declare (ignore env))
@@ -79,18 +54,6 @@
 		   (+ (offset object) (total-size object)))
 	   collect elt)))
 
-(defun dim0 (object)
-  "The first dimension of the object."
-  (first (dimensions object)))
-
-(defun dim1 (object)
-  "The first dimension of the object."
-  (second (dimensions object)))
-
-(defun element-size (object)
-  "The size of each element as stored in C."
-  (cffi:foreign-type-size (cl-cffi (element-type object))))
-
 ;;;;****************************************************************************
 ;;;; Definition of specific data classes
 ;;;;****************************************************************************
@@ -175,112 +138,8 @@
       (* 2 (total-size object))
       (total-size object)))
 
-;;;;****************************************************************************
-;;;; Syncronize C and CL
-;;;;****************************************************************************
-
-;;; For implementations with separate C and CL storage (non-native),
-;;; the two arrays must match when one side has updated and the other
-;;; side wishes to refer to the values.  For native implementations,
-;;; these don't do anything because they will always match.
-
-;;; Called in defmfun expansion right before GSL function is entered.
-#-native
-(defun copy-cl-to-c (object)
-  "Copy the CL array to the C array."
-  (when (c-invalid object)
-    (copy-array-to-pointer
-     (cl-array object)
-     (c-pointer object)
-     (component-type (element-type object))
-     0
-     (component-size object))
-    (setf (c-invalid object) nil)))
-
-;;; Called right before maref
-#-native
-(defun copy-c-to-cl (object)
-  "Copy the C array to the CL array."
-  (when (cl-invalid object)
-    (copy-array-from-pointer
-     (cl-array object)
-     (c-pointer object)
-     (component-type (element-type object))
-     0
-     (component-size object))
-    (setf (cl-invalid object) nil)))
-
-#-native
-(defun copy-array-to-pointer (array pointer lisp-type index-offset length)
-  "Copy length elements from array (starting at index-offset) of type
-   lisp-type to the memory area that starts at pointer, coercing the
-   elements if necessary."
-  (let ((cffi-type (component-type lisp-type)))
-    (loop
-       for pointer-index :from 0
-       :below (if (subtypep lisp-type 'complex) (* 2 length) length)
-       :by (if (subtypep lisp-type 'complex) 2 1)
-       for array-index :from index-offset
-       do
-       (if (subtypep lisp-type 'complex)
-	   (setf (cffi:mem-aref pointer cffi-type pointer-index)
-		 (realpart (row-major-aref array array-index))
-		 (cffi:mem-aref pointer cffi-type (1+ pointer-index))
-		 (imagpart (row-major-aref array array-index)))
-	   (setf (cffi:mem-aref pointer cffi-type pointer-index)
-		 (row-major-aref array array-index))))))
-
-#-native
-(defun copy-array-from-pointer (array pointer lisp-type index-offset length)
-  "Copy length elements from array (starting at index-offset) of type
-   lisp-type from the memory area that starts at pointer, coercing the
-   elements if necessary."
-  (let ((cffi-type (component-type lisp-type)))
-    (loop
-       for pointer-index :from 0
-       :below (if (subtypep lisp-type 'complex) (* 2 length) length)
-       :by (if (subtypep lisp-type 'complex) 2 1)
-       for array-index :from index-offset
-       do
-       (setf (row-major-aref array array-index)
-	     (complex 
-	      (cffi:mem-aref pointer cffi-type pointer-index)
-	      (cffi:mem-aref pointer cffi-type (1+ pointer-index)))))))
-
 ;;;;****************************************************************************
 ;;;; C structures
 ;;;;****************************************************************************
 
-;;; We don't allocate or free the C array data, because that is handled by ffa. 
-;;; We can use the GSL functions *_alloc_from_block because they will allocate 
-;;; only the structure, but we must use CFFI to allocate the block
-;;; structure; otherwise it would try to allocate the C array.
-;;; We do not use any of the GSL free functions because they would
-;;; free the C array data.
-
-(cffi:defcstruct gsl-block-c
-  (size sizet)
-  (data :pointer))
-
-(defgeneric alloc-gsl-struct (object)
-  (:documentation "Allocate the GSL structure.")
-  (:method ((object marray))
-    ;; Need to check that all allocations succeeded.
-    (unless (block-pointer object)
-      (let ((blockptr (cffi:foreign-alloc 'gsl-block-c)))
-	(setf (block-pointer object)
-	      blockptr
-	      (cffi:foreign-slot-value blockptr 'gsl-block-c 'size)
-	      (total-size object)
-	      (cffi:foreign-slot-value (block-pointer object) 'gsl-block-c 'data)
-	      (c-pointer object))
-	(let ((array-struct (alloc-from-block object)))
-	  (tg:finalize
-	   object
-	   (lambda ()
-	     (unless (eq blockptr array-struct)
-	       (cffi:foreign-free blockptr))
-	     (cffi:foreign-free array-struct)))
-	  (setf (slot-value object 'mpointer) array-struct))))))
-
 ;;; For #-native, do the whole thing using _alloc, _free functions.
diff --git a/data/matrix.lisp b/data/matrix.lisp
index 1da0e0ba..4912990e 100644
--- a/data/matrix.lisp
+++ b/data/matrix.lisp
@@ -1,6 +1,6 @@
 ;; Matrices
 ;; Liam Healy 2008-04-15 21:57:52EDT matrix.lisp
-;; Time-stamp: <2008-12-26 10:10:38EST matrix.lisp>
+;; Time-stamp: <2008-12-28 16:55:04EST matrix.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -9,6 +9,10 @@
 ;;;; Matrix structure and CL object
 ;;;;****************************************************************************
 
+(defclass matrix (marray)
+  ()
+  (:documentation "GSL matrices."))
+
 ;;; GSL-matrix definition
 (cffi:defcstruct gsl-matrix-c
   (size1 sizet)
@@ -18,10 +22,6 @@
   (block :pointer)
   (owner :int))
 
-(defclass matrix (marray)
-  ()
-  (:documentation "GSL matrices."))
-
 ;;; Define all supported matrix subclasses
 #.(data-defclass 'matrix 'matrix)
 
diff --git a/data/permutation.lisp b/data/permutation.lisp
index 91b0808d..7099d58d 100644
--- a/data/permutation.lisp
+++ b/data/permutation.lisp
@@ -1,6 +1,6 @@
 ;; Permutations
 ;; Liam Healy, Sun Mar 26 2006 - 11:51
-;; Time-stamp: <2008-12-07 18:17:57EST permutation.lisp>
+;; Time-stamp: <2008-12-28 16:40:35EST permutation.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -8,15 +8,31 @@
 ;;;;****************************************************************************
 ;;;; Permutation structure and CL object
 ;;;;****************************************************************************
-
-(defclass permutation
-    (#+sizet-64 vector-unsigned-byte-64
-     #+sizet-32 vector-unsigned-byte-32)
-  ()
+   
+(defclass permutation (mobject foreign-array)
+  ((element-type
+    :initform
+    #+sizet-64 '(unsigned-byte 64)
+    #+sizet-32 '(unsigned-byte 32)
+    :reader element-type :allocation :class))
   (:documentation "GSL permutations."))
 
-(pushnew (cons 'permutation *sizet-type*)
-	 *class-element-type* :test #'equal)
+;;(pushnew (cons 'permutation *sizet-type*) *class-element-type* :test #'equal)
+
+(cffi:defcstruct gsl-permutation-c	; The GSL struct
+  (size sizet)
+  (data :pointer))
+
+(defmethod initialize-instance :after
+    ((object permutation) &key dimensions &allow-other-keys)
+  (let ((mptr (cffi:foreign-alloc 'gsl-permutation-c)))
+    (setf (slot-value object 'mpointer)
+	  mptr
+	  (cffi:foreign-slot-value mptr 'gsl-permutation-c 'data)
+	  (c-pointer object)
+	  (cffi:foreign-slot-value mptr 'gsl-permutation-c 'size)
+	  dimensions)
+    (tg:finalize object (lambda () (cffi:foreign-free mptr)))))
 
 (export 'make-permutation)
 (defun make-permutation (n &optional (initialize t))
@@ -34,13 +50,6 @@
 	  (set-identity perm)))
     perm))
 
-(defmethod alloc-from-block ((perm permutation))
-  ;; GSL permutations are not based on blocks, but a gsl_permutation
-  ;; struct is identical to the gsl_block struct, so return the
-  ;; "block" (permutation) itself, as if a gsl_permutation was just
-  ;; "allocated."
-  (block-pointer perm))
-
 ;;;;****************************************************************************
 ;;;; Setting values
 ;;;;****************************************************************************
diff --git a/data/vector.lisp b/data/vector.lisp
index b78d4a8c..6fb40a67 100644
--- a/data/vector.lisp
+++ b/data/vector.lisp
@@ -1,6 +1,6 @@
 ;; Vectors
 ;; Liam Healy 2008-04-13 09:39:02EDT vector.lisp
-;; Time-stamp: <2008-12-26 10:10:39EST vector.lisp>
+;; Time-stamp: <2008-12-28 16:55:05EST vector.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -9,6 +9,10 @@
 ;;;; Vector structure, CL object, and allocation
 ;;;;****************************************************************************
 
+(defclass mvector (marray)
+  ()
+  (:documentation "GSL vectors."))
+
 ;;; GSL-vector definition
 (cffi:defcstruct gsl-vector-c
   (size sizet)
@@ -17,15 +21,9 @@
   (block :pointer)
   (owner :int))
 
-(defclass mvector (marray)
-  ()
-  (:documentation "GSL vectors."))
-
 ;;; Define all supported mvector subclasses
 #.(data-defclass 'vector 'mvector)
 
-(defun make-vector-from-pointer ())
-
 ;;;;****************************************************************************
 ;;;; Function definitions
 ;;;;****************************************************************************
diff --git a/gsll.asd b/gsll.asd
index 1fecd59f..3398ec8c 100644
--- a/gsll.asd
+++ b/gsll.asd
@@ -1,6 +1,6 @@
 ;; Definition of GSLL system 
 ;; Liam Healy
-;; Time-stamp: <2008-12-26 17:26:28EST gsll.asd>
+;; Time-stamp: <2008-12-28 16:46:47EST gsll.asd>
 ;; $Id$
 
 (asdf:defsystem "gsll"
@@ -33,15 +33,15 @@
 	    :depends-on (init)
 	    :components
 	    ((:file "foreign-friendly")
+	     (:file "foreign-array" :depends-on (foreign-friendly))
 	     (:file "marray" :depends-on (foreign-friendly))
 	     (:file "vector" :depends-on (marray))
 	     (:file "matrix" :depends-on (marray vector))
 	     (:file "maref" :depends-on (marray vector matrix))
 	     (:file "both" :depends-on (marray vector matrix))
 	     (:file "array-tests" :depends-on (both))
-	     (:file "permutation" :depends-on (marray))
-	     (:file "combination"	; preload defgeneric
-		    :depends-on (marray matrix both permutation))))
+	     (:file "permutation" :depends-on (foreign-array))
+	     (:file "combination" :depends-on (foreign-array))))
    (:file "polynomial" :depends-on (init data))
    (:module special-functions
 	    :depends-on (init)
diff --git a/init/generate-examples.lisp b/init/generate-examples.lisp
index eb965c7b..70ff063f 100644
--- a/init/generate-examples.lisp
+++ b/init/generate-examples.lisp
@@ -1,6 +1,6 @@
 ;; Define examples.
 ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
-;; Time-stamp: <2008-12-26 10:25:47EST generate-examples.lisp>
+;; Time-stamp: <2008-12-28 15:27:28EST generate-examples.lisp>
 ;; $Id: $
 
 ;;; Define examples that can be displayed by users with the function
@@ -103,7 +103,7 @@
 ;;;;****************************************************************************
 
 (defun array-default (spec &optional no-init)
-  "Make an array of the current type and intialize from the pool."
+  "Make an array of the current type and initialize from the pool."
   (declare (special default-element-type starting-element))
   (let ((matrixp (listp spec)))
     (if no-init
-- 
GitLab