[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-285-gc3e3e
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-285-gc3e3ef6 |
|
Date: |
Wed, 03 Apr 2013 19:46:41 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c3e3ef6eb6d1487d342389b202b0b00f9385de6a
The branch, stable-2.0 has been updated
via c3e3ef6eb6d1487d342389b202b0b00f9385de6a (commit)
via 3220b080498580586726313ec63db9eaf68334d8 (commit)
via 0d7f3a6d957a3129dc0aa203abc1b6adc82db295 (commit)
via 51a1763f6596d594ebd774e7c3fd9138e6f4d507 (commit)
via 9a68d7b388c610cdbc5689ae9cbadb70ee311f67 (commit)
via 75a1b26c5d06e791afce10be9b1ab4e5272e45b4 (commit)
from 7290de89fb5bf755e2520bd01e977dc132c50c4b (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c3e3ef6eb6d1487d342389b202b0b00f9385de6a
Author: Daniel Llorens <address@hidden>
Date: Tue Apr 2 16:43:37 2013 +0200
Remove double indirection for 1st arg of array-for-each
* libguile/array-map.c: (rafe): factor GVREF out of rank-1 loop for ra0.
commit 3220b080498580586726313ec63db9eaf68334d8
Author: Ludovic Courtès <address@hidden>
Date: Wed Apr 3 21:34:31 2013 +0200
tests: Add `array-for-each' tests for one-dimensional traversals.
* test-suite/tests/ramap.test ("array-for-each")["1 source"]: New test
prefix.
commit 0d7f3a6d957a3129dc0aa203abc1b6adc82db295
Author: Ludovic Courtès <address@hidden>
Date: Wed Apr 3 19:13:23 2013 +0200
tests: Use `pass-if-equal' in ramap.test.
* test-suite/tests/ramap.test ("array-for-each"): Use `pass-if-equal'
instead of `(pass-if ... (equal? ...))'.
commit 51a1763f6596d594ebd774e7c3fd9138e6f4d507
Author: Daniel Llorens <address@hidden>
Date: Tue Apr 2 15:53:22 2013 +0200
Remove double indirection in array-map! with <2 args
* libguile/array-map.c: (ramap): factor GVSET/GVREF out of rank-1 loop
for ra0 and the first element of ras.
commit 9a68d7b388c610cdbc5689ae9cbadb70ee311f67
Author: Daniel Llorens <address@hidden>
Date: Tue Apr 2 15:23:55 2013 +0200
Avoid per-element cons for 1-arg case of array-map!
* libguile/array-map.c: (ramap): special case when ras is a 1-element list.
commit 75a1b26c5d06e791afce10be9b1ab4e5272e45b4
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 3 15:40:48 2013 +0200
Deprecate dead code in array-map.c
* libguile/array-map.c, libguile/array-map.h: deprecate scm_ra_eqp,
scm_ra_lessp, scm_ra_leqp, scm_ra_grp, scm_ra_greqp, scm_ra_sum,
scm_ra_product, scm_ra_difference, scm_ra_divide, scm_array_identity.
Signed-off-by: Ludovic Courtès <address@hidden>
-----------------------------------------------------------------------
Summary of changes:
libguile/array-map.c | 107 ++++++++++++++++++++++++------------------
libguile/array-map.h | 27 ++++++----
test-suite/tests/ramap.test | 58 ++++++++++++++++++-----
3 files changed, 123 insertions(+), 69 deletions(-)
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 00a24f1..b5b8cec 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -396,6 +396,7 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
/* Functions callable by ARRAY-MAP! */
+#if SCM_ENABLE_DEPRECATED == 1
int
scm_ra_eqp (SCM ra0, SCM ras)
@@ -637,37 +638,52 @@ scm_array_identity (SCM dst, SCM src)
return racp (SCM_CAR (src), scm_cons (dst, SCM_EOL));
}
+#endif /* SCM_ENABLE_DEPRECATED */
-
-static int
+static int
ramap (SCM ra0, SCM proc, SCM ras)
{
- long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
- long inc = SCM_I_ARRAY_DIMS (ra0)->inc;
- long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
- long base = SCM_I_ARRAY_BASE (ra0) - i * inc;
- ra0 = SCM_I_ARRAY_V (ra0);
+ ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+ size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
+
+ scm_t_array_handle h0;
+ size_t i0, i0end;
+ ssize_t inc0;
+ scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0);
+ i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc;
+ inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc;
+ i0end = i0 + n*inc0;
if (scm_is_null (ras))
- for (; i <= n; i++)
- GVSET (ra0, i*inc+base, scm_call_0 (proc));
+ for (; i0 < i0end; i0 += inc0)
+ h0.impl->vset (&h0, i0, scm_call_0 (proc));
else
{
SCM ra1 = SCM_CAR (ras);
- SCM args;
- unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
- long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_I_ARRAY_V (ra1);
- ras = scm_vector (SCM_CDR (ras));
-
- for (; i <= n; i++, i1 += inc1)
- {
- args = SCM_EOL;
- for (k = scm_c_vector_length (ras); k--;)
- args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
- args = scm_cons (GVREF (ra1, i1), args);
- GVSET (ra0, i*inc+base, scm_apply_0 (proc, args));
- }
+ scm_t_array_handle h1;
+ size_t i1;
+ ssize_t inc1;
+ scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra1), &h1);
+ i1 = h1.base + h1.dims[0].lbnd + SCM_I_ARRAY_BASE (ra1)*h1.dims[0].inc;
+ inc1 = SCM_I_ARRAY_DIMS (ra1)->inc * h1.dims[0].inc;
+ ras = SCM_CDR (ras);
+ if (scm_is_null (ras))
+ for (; i0 < i0end; i0 += inc0, i1 += inc1)
+ h0.impl->vset (&h0, i0, scm_call_1 (proc, h1.impl->vref (&h1,
i1)));
+ else
+ {
+ ras = scm_vector (ras);
+ for (; i0 < i0end; i0 += inc0, i1 += inc1, ++i)
+ {
+ SCM args = SCM_EOL;
+ unsigned long k;
+ for (k = scm_c_vector_length (ras); k--;)
+ args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
+ h0.impl->vset (&h0, i0, scm_apply_1 (proc, h1.impl->vref (&h1,
i1), args));
+ }
+ }
+ scm_array_handle_release (&h1);
}
+ scm_array_handle_release (&h0);
return 1;
}
@@ -700,36 +716,35 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
static int
rafe (SCM ra0, SCM proc, SCM ras)
{
- long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
- unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
- long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
- long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
- ra0 = SCM_I_ARRAY_V (ra0);
+ ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+ size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
+
+ scm_t_array_handle h0;
+ size_t i0, i0end;
+ ssize_t inc0;
+ scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0);
+ i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc;
+ inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc;
+ i0end = i0 + n*inc0;
if (scm_is_null (ras))
- for (; i <= n; i++, i0 += inc0)
- scm_call_1 (proc, GVREF (ra0, i0));
+ for (; i0 < i0end; i0 += inc0)
+ scm_call_1 (proc, h0.impl->vref (&h0, i0));
else
{
- SCM ra1 = SCM_CAR (ras);
- SCM args;
- unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
- long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_I_ARRAY_V (ra1);
- ras = scm_vector (SCM_CDR (ras));
-
- for (; i <= n; i++, i0 += inc0, i1 += inc1)
- {
- args = SCM_EOL;
- for (k = scm_c_vector_length (ras); k--;)
- args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
- args = scm_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args);
- scm_apply_0 (proc, args);
- }
+ ras = scm_vector (ras);
+ for (; i0 < i0end; i0 += inc0, ++i)
+ {
+ SCM args = SCM_EOL;
+ unsigned long k;
+ for (k = scm_c_vector_length (ras); k--;)
+ args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
+ scm_apply_1 (proc, h0.impl->vref (&h0, i0), args);
+ }
}
+ scm_array_handle_release (&h0);
return 1;
}
-
SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
(SCM proc, SCM ra0, SCM lra),
"Apply @var{proc} to each tuple of elements of @var{ra0} @dots{}\n"
diff --git a/libguile/array-map.h b/libguile/array-map.h
index 43d2a92..eb1aa37 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -4,7 +4,7 @@
#define SCM_ARRAY_MAP_H
/* Copyright (C) 1995, 1996, 1997, 2000, 2006, 2008, 2009, 2010,
- * 2011 Free Software Foundation, Inc.
+ * 2011, 2013 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
@@ -34,22 +34,27 @@ SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM
lra,
SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
-SCM_API int scm_ra_eqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_lessp (SCM ra0, SCM ras);
-SCM_API int scm_ra_leqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_grp (SCM ra0, SCM ras);
-SCM_API int scm_ra_greqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_sum (SCM ra0, SCM ras);
-SCM_API int scm_ra_difference (SCM ra0, SCM ras);
-SCM_API int scm_ra_product (SCM ra0, SCM ras);
-SCM_API int scm_ra_divide (SCM ra0, SCM ras);
-SCM_API int scm_array_identity (SCM src, SCM dst);
SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1);
SCM_INTERNAL void scm_init_array_map (void);
+#if SCM_ENABLE_DEPRECATED == 1
+
+SCM_DEPRECATED int scm_ra_eqp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_lessp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_leqp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_grp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_greqp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_sum (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_difference (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_product (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_divide (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_array_identity (SCM src, SCM dst);
+
+#endif /* SCM_ENABLE_DEPRECATED == 1 */
+
#endif /* SCM_ARRAY_MAP_H */
/*
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index 5b99f72..7c3142d 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -1,6 +1,6 @@
;;;; ramap.test --- test array mapping functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 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
@@ -227,31 +227,65 @@
(with-test-prefix "array-for-each"
+ (with-test-prefix "1 source"
+ (pass-if-equal "noncompact array"
+ '(3 2 1 0)
+ (let* ((a #2((0 1) (2 3)))
+ (l '())
+ (p (lambda (x) (set! l (cons x l)))))
+ (array-for-each p a)
+ l))
+
+ (pass-if-equal "vector"
+ '(3 2 1 0)
+ (let* ((a #(0 1 2 3))
+ (l '())
+ (p (lambda (x) (set! l (cons x l)))))
+ (array-for-each p a)
+ l))
+
+ (pass-if-equal "shared array"
+ '(3 2 1 0)
+ (let* ((a #2((0 1) (2 3)))
+ (a' (make-shared-array a
+ (lambda (x)
+ (list (quotient x 4)
+ (modulo x 4)))
+ 4))
+ (l '())
+ (p (lambda (x) (set! l (cons x l)))))
+ (array-for-each p a')
+ l)))
+
(with-test-prefix "3 sources"
- (pass-if "noncompact arrays 1"
+ (pass-if-equal "noncompact arrays 1"
+ '((3 3 3) (2 2 2))
(let* ((a #2((0 1) (2 3)))
(l '())
(rec (lambda args (set! l (cons args l)))))
(array-for-each rec (array-row a 1) (array-row a 1) (array-row a 1))
- (equal? l '((3 3 3) (2 2 2)))))
-
- (pass-if "noncompact arrays 2"
+ l))
+
+ (pass-if-equal "noncompact arrays 2"
+ '((3 3 3) (2 2 1))
(let* ((a #2((0 1) (2 3)))
(l '())
(rec (lambda args (set! l (cons args l)))))
(array-for-each rec (array-row a 1) (array-row a 1) (array-col a 1))
- (equal? l '((3 3 3) (2 2 1)))))
-
- (pass-if "noncompact arrays 3"
+ l))
+
+ (pass-if-equal "noncompact arrays 3"
+ '((3 3 3) (2 1 1))
(let* ((a #2((0 1) (2 3)))
(l '())
(rec (lambda args (set! l (cons args l)))))
(array-for-each rec (array-row a 1) (array-col a 1) (array-col a 1))
- (equal? l '((3 3 3) (2 1 1)))))
-
- (pass-if "noncompact arrays 4"
+ l))
+
+ (pass-if-equal "noncompact arrays 4"
+ '((3 2 3) (1 0 2))
(let* ((a #2((0 1) (2 3)))
(l '())
(rec (lambda args (set! l (cons args l)))))
(array-for-each rec (array-col a 1) (array-col a 0) (array-row a 1))
- (equal? l '((3 2 3) (1 0 2)))))))
+ l))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-285-gc3e3ef6,
Ludovic Courtès <=