>From 4c092b8610583d182bf2106a11b180b4d483333a Mon Sep 17 00:00:00 2001
From: tpapp <tkpapp@gmail.com>
Date: Sat, 21 Jan 2012 14:06:06 +0100
Subject: [PATCH] Modified syntax of displace-array, added flatten-array for
 the previous default.

Making the contents of an array available as a vector is a useful operation, and
this was the reason for flatten-array to do this when no keyword arguments were
supplied.  But otherwise one rarely if ever needs to displace an array without
specifying the dimensions, so it makes sense to separate the two cases.
---
 arrays.lisp  |    9 ++++++---
 numbers.lisp |    7 ++++---
 package.lisp |    2 +-
 tests.lisp   |   15 ++++++++++-----
 4 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/arrays.lisp b/arrays.lisp
index 1f30150..fc77194 100644
--- a/arrays.lisp
+++ b/arrays.lisp
@@ -18,12 +18,15 @@ arguments."
    new-array))
 
 (declaim (inline displace-array))
-(defun displace-array (array &key (offset 0)
-                                  (dimensions (- (array-total-size array)
-                                               offset)))
+(defun displace-array (array dimensions &optional (offset 0))
   "Return an array displaced to ARRAY with the given OFFSET and DIMENSIONS.
 Default arguments displace to a vector."
   (make-array dimensions
               :displaced-to array
               :displaced-index-offset offset
               :element-type (array-element-type array)))
+
+(declaim (inline flatten-array))
+(defun flatten-array (array)
+  "Return a vector displaced to the contents of ARRAY."
+  (displace-array array (array-total-size array)))
diff --git a/numbers.lisp b/numbers.lisp
index 7340f26..0440491 100644
--- a/numbers.lisp
+++ b/numbers.lisp
@@ -129,9 +129,10 @@ define new methods.")
   (:method ((object list))
     (median-in-place (copy-sequence 'vector object)))
   (:method ((object array))
-    (median-in-place (copy-sequence 'vector (if (vectorp object)
-                                                object
-                                                (displace-array object)))))
+    (median-in-place (copy-sequence 'vector
+                                    (if (vectorp object)
+                                        object
+                                        (flatten-array object)))))
   (:method ((object sequence))
     ;; For implementations supporting custom sequence types.
     (median-in-place (copy-sequence 'vector object))))
diff --git a/package.lisp b/package.lisp
index 8bdf060..935c698 100644
--- a/package.lisp
+++ b/package.lisp
@@ -239,4 +239,4 @@
    #:destructuring-case
    #:destructuring-ccase
    #:destructuring-ecase
-   ))
+   #:flatten-array))
diff --git a/tests.lisp b/tests.lisp
index 7d7d1ca..7338b83 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -49,22 +49,27 @@
 
 (deftest displace-array.1
     (displace-array #2A((1 2)
-                        (3 4)))
+                        (3 4))
+                    4)
   #(1 2 3 4))
 
 (deftest displace-array.2
     (displace-array #2A((1 2)
                         (3 4))
-                    :offset 1)
+                    3 1)
   #(2 3 4))
 
 (deftest displace-array.3
     (displace-array #2A((1 2)
                         (3 4))
-                    :offset 1
-                    :dimensions '(3 1))
+                    '(3 1) 1)
   #2A((2) (3) (4)))
 
+(deftest flatten-array.1
+    (flatten-array #2A((1 2)
+                       (3 4)))
+  #(1 2 3 4))
+
 (deftest array-index.1
     (typep 0 'array-index)
   t)
@@ -1460,7 +1465,7 @@
 
 (deftest sequences.passing-improper-lists
     (macrolet ((signals-error-p (form)
-		 `(handler-case 
+		 `(handler-case
                       (progn ,form nil)
 		    (type-error (e)
                       t)))
-- 
1.7.8.3