[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/13: Avoid unneeded internal use of array handles
From: |
Daniel Llorens |
Subject: |
[Guile-commits] 04/13: Avoid unneeded internal use of array handles |
Date: |
Tue, 12 Jul 2016 07:30:50 +0000 (UTC) |
lloda pushed a commit to branch lloda-squash0
in repository guile.
commit 23e0dd92326bdcc9b67d770c9df4cf9c997015fd
Author: Daniel Llorens <address@hidden>
Date: Mon Feb 9 12:11:52 2015 +0100
Avoid unneeded internal use of array handles
* libguile/arrays.c (scm_shared_array_root): Adopt uniform check order.
(scm_shared_array_offset, scm_shared_array_increments): Use the array
fields directly just as scm_shared_array_root does.
(scm_c_array_rank): Moved from libguile/generalized-arrays.c. Don't
use array handles, but follow the same type check sequence as the
other array functions (shared-array-root, etc).
(scm_array_rank): Moved from libguile/generalized-arrays.h.
* libguile/arrays.h: Move prototypes here.
* test-suite/tests/arrays.test: Tests for shared-array-offset,
shared-array-increments.
---
libguile/arrays.c | 65 +++++++++++++++++++++++------------
libguile/arrays.h | 3 ++
libguile/generalized-arrays.c | 43 ++++++-----------------
libguile/generalized-arrays.h | 3 --
test-suite/tests/arrays.test | 76 ++++++++++++++++++++++++++++++++++-------
5 files changed, 120 insertions(+), 70 deletions(-)
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 3cb547f..fb522e1 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -64,6 +64,27 @@
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) &
~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
+size_t
+scm_c_array_rank (SCM array)
+{
+ if (SCM_I_ARRAYP (array))
+ return SCM_I_ARRAY_NDIM (array);
+ else if (scm_is_array (array))
+ return 1;
+ else
+ scm_wrong_type_arg_msg ("array-rank", SCM_ARG1, array, "array");
+}
+
+SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0,
+ (SCM array),
+ "Return the number of dimensions of the array @var{array.}\n")
+#define FUNC_NAME s_scm_array_rank
+{
+ return scm_from_size_t (scm_c_array_rank (array));
+}
+#undef FUNC_NAME
+
+
SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
(SCM ra),
"Return the root vector of a shared array.")
@@ -71,10 +92,10 @@ SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1,
0, 0,
{
if (SCM_I_ARRAYP (ra))
return SCM_I_ARRAY_V (ra);
- else if (!scm_is_array (ra))
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
- else
+ else if (scm_is_array (ra))
return ra;
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
}
#undef FUNC_NAME
@@ -84,13 +105,12 @@ SCM_DEFINE (scm_shared_array_offset,
"shared-array-offset", 1, 0, 0,
"Return the root vector index of the first element in the array.")
#define FUNC_NAME s_scm_shared_array_offset
{
- scm_t_array_handle handle;
- SCM res;
-
- scm_array_get_handle (ra, &handle);
- res = scm_from_size_t (handle.base);
- scm_array_handle_release (&handle);
- return res;
+ if (SCM_I_ARRAYP (ra))
+ return scm_from_size_t (SCM_I_ARRAY_BASE (ra));
+ else if (scm_is_array (ra))
+ return scm_from_size_t (0);
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
}
#undef FUNC_NAME
@@ -100,18 +120,19 @@ SCM_DEFINE (scm_shared_array_increments,
"shared-array-increments", 1, 0, 0,
"For each dimension, return the distance between elements in the
root vector.")
#define FUNC_NAME s_scm_shared_array_increments
{
- scm_t_array_handle handle;
- SCM res = SCM_EOL;
- size_t k;
- scm_t_array_dim *s;
-
- scm_array_get_handle (ra, &handle);
- k = scm_array_handle_rank (&handle);
- s = scm_array_handle_dims (&handle);
- while (k--)
- res = scm_cons (scm_from_ssize_t (s[k].inc), res);
- scm_array_handle_release (&handle);
- return res;
+ if (SCM_I_ARRAYP (ra))
+ {
+ size_t k = SCM_I_ARRAY_NDIM (ra);
+ SCM res = SCM_EOL;
+ scm_t_array_dim *dims = SCM_I_ARRAY_DIMS (ra);
+ while (k--)
+ res = scm_cons (scm_from_ssize_t (dims[k].inc), res);
+ return res;
+ }
+ else if (scm_is_array (ra))
+ return scm_list_1 (scm_from_ssize_t (1));
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
}
#undef FUNC_NAME
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 4baa51e..d3e409f 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -50,6 +50,9 @@ SCM_API SCM scm_array_contents (SCM ra, SCM strict);
SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
+SCM_API size_t scm_c_array_rank (SCM ra);
+SCM_API SCM scm_array_rank (SCM ra);
+
/* internal. */
#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) /* currently unused */
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
index 9a001eb..99125f2 100644
--- a/libguile/generalized-arrays.c
+++ b/libguile/generalized-arrays.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006,
2009, 2010, 2013, 2014 Free Software Foundation, Inc.
- *
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -104,27 +104,6 @@ SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
}
#undef FUNC_NAME
-size_t
-scm_c_array_rank (SCM array)
-{
- scm_t_array_handle handle;
- size_t res;
-
- scm_array_get_handle (array, &handle);
- res = scm_array_handle_rank (&handle);
- scm_array_handle_release (&handle);
- return res;
-}
-
-SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0,
- (SCM array),
- "Return the number of dimensions of the array @var{array.}\n")
-#define FUNC_NAME s_scm_array_rank
-{
- return scm_from_size_t (scm_c_array_rank (array));
-}
-#undef FUNC_NAME
-
size_t
scm_c_array_length (SCM array)
@@ -144,7 +123,7 @@ scm_c_array_length (SCM array)
return res;
}
-SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0,
+SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0,
(SCM array),
"Return the length of an array: its first dimension.\n"
"It is an error to ask for the length of an array of rank 0.")
@@ -155,7 +134,7 @@ SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0,
+SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0,
(SCM ra),
"@code{array-dimensions} is similar to @code{array-shape} but
replaces\n"
"elements with a @code{0} minimum with one greater than the
maximum. So:\n"
@@ -168,7 +147,7 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0,
0,
scm_t_array_dim *s;
SCM res = SCM_EOL;
size_t k;
-
+
scm_array_get_handle (ra, &handle);
s = scm_array_handle_dims (&handle);
k = scm_array_handle_rank (&handle);
@@ -186,7 +165,7 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0,
0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
+SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
(SCM ra),
"")
#define FUNC_NAME s_scm_array_type
@@ -197,7 +176,7 @@ SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
scm_array_get_handle (ra, &h);
type = scm_array_handle_element_type (&h);
scm_array_handle_release (&h);
-
+
return type;
}
#undef FUNC_NAME
@@ -220,7 +199,7 @@ SCM_DEFINE (scm_array_type_code,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
+SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
(SCM ra, SCM args),
"Return @code{#t} if its arguments would be acceptable to\n"
"@code{array-ref}.")
@@ -376,7 +355,7 @@ SCM_DEFINE (scm_i_array_set_x, "array-set!", 2, 2, 1,
#undef FUNC_NAME
-static SCM
+static SCM
array_to_list (scm_t_array_handle *h, size_t dim, unsigned long pos)
{
if (dim == scm_array_handle_rank (h))
@@ -397,7 +376,7 @@ array_to_list (scm_t_array_handle *h, size_t dim, unsigned
long pos)
}
}
-SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
+SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
(SCM array),
"Return a list representation of @var{array}.\n\n"
"It is easiest to specify the behavior of this function by\n"
@@ -410,8 +389,8 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
#define FUNC_NAME s_scm_array_to_list
{
scm_t_array_handle h;
- SCM res;
-
+ SCM res;
+
scm_array_get_handle (array, &h);
res = array_to_list (&h, 0, 0);
scm_array_handle_release (&h);
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
index dfdb8bd..cfa6905 100644
--- a/libguile/generalized-arrays.h
+++ b/libguile/generalized-arrays.h
@@ -41,9 +41,6 @@ SCM_INTERNAL SCM scm_array_p_2 (SCM);
SCM_API int scm_is_typed_array (SCM obj, SCM type);
SCM_API SCM scm_typed_array_p (SCM v, SCM type);
-SCM_API size_t scm_c_array_rank (SCM ra);
-SCM_API SCM scm_array_rank (SCM ra);
-
SCM_API size_t scm_c_array_length (SCM ra);
SCM_API SCM scm_array_length (SCM ra);
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 6f37196..c40457b 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -23,9 +23,13 @@
#:use-module (srfi srfi-4)
#:use-module (srfi srfi-4 gnu))
-;;;
-;;; array?
-;;;
+(define (array-row a i)
+ (make-shared-array a (lambda (j) (list i j))
+ (cadr (array-dimensions a))))
+
+(define (array-col a j)
+ (make-shared-array a (lambda (i) (list i j))
+ (car (array-dimensions a))))
(define exception:wrong-num-indices
(cons 'misc-error "^wrong number of indices.*"))
@@ -33,6 +37,15 @@
(define exception:length-non-negative
(cons 'read-error ".*array length must be non-negative.*"))
+(define exception:wrong-type-arg
+ (cons #t "Wrong type"))
+
+(define exception:mapping-out-of-range
+ (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
+
+;;;
+;;; array?
+;;;
(with-test-prefix "array?"
@@ -216,9 +229,6 @@
;;; make-shared-array
;;;
-(define exception:mapping-out-of-range
- (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
-
(with-test-prefix/c&e "make-shared-array"
;; this failed in guile 1.8.0
@@ -404,13 +414,57 @@
(eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
;;;
+;;; shared-array-offset
+;;;
+
+(with-test-prefix/c&e "shared-array-offset"
+
+ (pass-if "plain vector"
+ (zero? (shared-array-offset (make-vector 4 0))))
+
+ (pass-if "plain array rank 2"
+ (zero? (shared-array-offset (make-array 0 4 4))))
+
+ (pass-if "row of rank-2 array, I"
+ (= 0 (shared-array-offset (array-row (make-array 0 5 3) 0))))
+
+ (pass-if "row of rank-2 array, II"
+ (= 4 (shared-array-offset (array-row (make-array 0 6 4) 1))))
+
+ (pass-if "col of rank-2 array, I"
+ (= 0 (shared-array-offset (array-col (make-array 0 5 3) 0))))
+
+ (pass-if "col of rank-2 array, II"
+ (= 1 (shared-array-offset (array-col (make-array 0 6 4) 1)))))
+
+
+;;;
+;;; shared-array-increments
+;;;
+
+(with-test-prefix/c&e "shared-array-increments"
+
+ (pass-if "plain vector"
+ (equal? '(1) (shared-array-increments (make-vector 4 0))))
+
+ (pass-if "plain array rank 2"
+ (equal? '(4 1) (shared-array-increments (make-array 0 3 4))))
+
+ (pass-if "plain array rank 3"
+ (equal? '(20 5 1) (shared-array-increments (make-array 0 3 4 5))))
+
+ (pass-if "row of rank-2 array"
+ (equal? '(1) (shared-array-increments (array-row (make-array 0 5 3) 0))))
+
+ (pass-if "col of rank-2 array"
+ (equal? '(3) (shared-array-increments (array-col (make-array 0 5 3) 0)))))
+
+
+;;;
;;; transpose-array
;;;
; see strings.test.
-(define exception:wrong-type-arg
- (cons #t "Wrong type"))
-
(with-test-prefix/c&e "transpose-array"
(pass-if-exception "non array argument" exception:wrong-type-arg
@@ -821,10 +875,6 @@
;;; slices as generalized vectors
;;;
-(define (array-row a i)
- (make-shared-array a (lambda (j) (list i j))
- (cadr (array-dimensions a))))
-
(with-test-prefix/c&e "generalized vector slices"
(pass-if (equal? (array-row #2u32((0 1) (2 3)) 1)
#u32(2 3)))
- [Guile-commits] branch lloda-squash0 created (now 9e06cd7), Daniel Llorens, 2016/07/12
- [Guile-commits] 02/13: Fix compilation of rank 0 typed array literals, Daniel Llorens, 2016/07/12
- [Guile-commits] 01/13: Compile in C99 mode, Daniel Llorens, 2016/07/12
- [Guile-commits] 07/13: Remove deprecated array functions, Daniel Llorens, 2016/07/12
- [Guile-commits] 08/13: Do not use array handles in scm_vector, Daniel Llorens, 2016/07/12
- [Guile-commits] 04/13: Avoid unneeded internal use of array handles,
Daniel Llorens <=
- [Guile-commits] 13/13: Support typed arrays in some sort functions, Daniel Llorens, 2016/07/12
- [Guile-commits] 03/13: Remove scm_from_contiguous_array, array 'contiguous' flag, Daniel Llorens, 2016/07/12
- [Guile-commits] 10/13: Special case for array-map! with three arguments, Daniel Llorens, 2016/07/12
- [Guile-commits] 12/13: Remove uniform-array-read!, uniform-array-write from the manual, Daniel Llorens, 2016/07/12
- [Guile-commits] 05/13: Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle, Daniel Llorens, 2016/07/12
- [Guile-commits] 06/13: New functions array-from, array-from*, array-set-from!, Daniel Llorens, 2016/07/12
- [Guile-commits] 09/13: Speed up for multi-arg cases of scm_ramap functions, Daniel Llorens, 2016/07/12
- [Guile-commits] 11/13: New functions (array-for-each-cell, array-for-each-cell-in-order), Daniel Llorens, 2016/07/12