[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1 on x86_64-linux

2016-10-13 Thread Hydra Build Daemon 
Hi,

The status of Hydra job ‘gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1’ (on 
x86_64-linux) has changed from "Success" to "Failed with output".  For details, 
see

  https://hydra.nixos.org/build/42025158

Go forth and fix it.

Regards,

The Hydra build daemon.

[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1 on x86_64-linux

2016-10-13 Thread Hydra Build Daemon 
Hi,

The status of Hydra job ‘gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1’ (on 
x86_64-linux) has changed from "Success" to "Failed with output".  For details, 
see

  https://hydra.nixos.org/build/41973356

Go forth and fix it.

Regards,

The Hydra build daemon.

[Guile-commits] Success: Hydra job gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1 on x86_64-linux

2016-10-13 Thread Hydra Build Daemon 
Hi,

The status of Hydra job ‘gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1’ (on 
x86_64-linux) has changed from "Failed with output" to "Success".  For details, 
see

  https://hydra.nixos.org/build/41990204

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_clang.i686-linux

2016-10-13 Thread Hydra Build Daemon 
Hi,

The status of Hydra job ‘gnu:guile-master:build_clang.i686-linux’ has changed 
from "Success" to "Failed with output".  For details, see

  https://hydra.nixos.org/build/41973359

Go forth and fix it.

Regards,

The Hydra build daemon.

[Guile-commits] Success: Hydra job gnu:guile-master:build_clang.i686-linux

2016-10-13 Thread Hydra Build Daemon 
Hi,

The status of Hydra job ‘gnu:guile-master:build_clang.i686-linux’ has changed 
from "Failed with output" to "Success".  For details, see

  https://hydra.nixos.org/build/41990218

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] 01/11: Fix compilation of rank 0 typed array literals

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit f244ae848727ca4c35891150ea19e881aa7db2f1
Author: Daniel Llorens 
Date:   Thu Feb 12 13:02:24 2015 +0100

Fix compilation of rank 0 typed array literals

* module/system/vm/assembler.scm (simple-uniform-vector?): array-length
  fails for rank 0 arrays; fix the shape condition.

* test-suite/tests/arrays.test: Test reading of #0f64(x) in compilation
  context.
---
 module/system/vm/assembler.scm |4 +++-
 test-suite/tests/arrays.test   |8 +++-
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index a2992b4..facec63 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1000,7 +1000,9 @@ immediate, and @code{#f} otherwise."
 (define (simple-uniform-vector? obj)
   (and (array? obj)
(symbol? (array-type obj))
-   (equal? (array-shape obj) (list (list 0 (1- (array-length obj)))
+   (match (array-shape obj)
+ (((0 n)) #t)
+ (else #f
 
 (define (statically-allocatable? x)
   "Return @code{#t} if a non-immediate constant can be allocated
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index e76c699..20cb78b 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -204,7 +204,13 @@
 (with-test-prefix/c "array-equal?"
 
   (pass-if "#s16(...)"
-(array-equal? #s16(1 2 3) #s16(1 2 3
+(array-equal? #s16(1 2 3) #s16(1 2 3)))
+
+  (pass-if "#0f64(...)"
+(array-equal? #0f64(99) (make-typed-array 'f64 99)))
+
+  (pass-if "#0(...)"
+(array-equal? #0(99) (make-array 99
 
 ;;;
 ;;; make-shared-array

[Guile-commits] 02/11: Remove scm_from_contiguous_array, array 'contiguous' flag

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit d8ff1beb59884277a49f6ef97fb89d48761e02a3
Author: Daniel Llorens 
Date:   Mon Feb 9 17:27:33 2015 +0100

Remove scm_from_contiguous_array, array 'contiguous' flag

scm_from_contiguous_array() is undocumented, unused within Guile, and
can be trivially replaced by make-array + array-copy without requiring
contiguity.

The related SCM_I_ARRAY_FLAG_CONTIGUOUS (arrays.h) was set by all
array-creating functions (make-typed-array, transpose-array,
make-shared-array) but it was only used by array-contents, which needed
to traverse the dimensions anyway.

* libguile/arrays.h (scm_from_contiguous_array): Remove declaration.

* libguile/arrays.c (scm_from_contiguous_array): Remove.

  (scm_make_typed_array, scm_from_contiguous_typed_array): Don't set the
  contiguous flag.

  (scm_transpose_array, scm_make_shared_array): Don't call
  scm_i_ra_set_contp.

  (scm_array_contents): Inline scm_i_ra_set_contp() here. Adopt uniform
  type check order. Remove redundant comments.

  (scm_i_ra_set_contp): Remove.

* test-suite/tests/arrays.test: Test array-contents with rank 0 array.
---
 libguile/arrays.c|  112 +++---
 libguile/arrays.h|4 +-
 test-suite/tests/arrays.test |6 +++
 3 files changed, 36 insertions(+), 86 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 52fe90a..3cb547f 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -188,7 +188,6 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 
1,
   SCM ra;
 
   ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
   k = SCM_I_ARRAY_NDIM (ra);
 
@@ -225,7 +224,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
   size_t sz;
 
   ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
   k = SCM_I_ARRAY_NDIM (ra);
 
@@ -270,41 +268,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
 }
 #undef FUNC_NAME
 
-SCM
-scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
-#define FUNC_NAME "scm_from_contiguous_array"
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  SCM ra;
-  scm_t_array_handle h;
-
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-{
-  s[k].inc = rlen;
-  SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-  rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-}
-  if (rlen != len)
-SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
-
-  SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED));
-  scm_array_get_handle (ra, );
-  memcpy (h.writable_elements, elts, rlen * sizeof(SCM));
-  scm_array_handle_release ();
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-if (0 == s->lbnd)
-  return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
(SCM fill, SCM bounds),
"Create and return an array.")
@@ -314,27 +277,6 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
 }
 #undef FUNC_NAME
 
-static void
-scm_i_ra_set_contp (SCM ra)
-{
-  size_t k = SCM_I_ARRAY_NDIM (ra);
-  if (k)
-{
-  ssize_t inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
-  while (k--)
-   {
- if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
-   {
- SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
- return;
-   }
- inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
- - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
-   }
-}
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-}
-
 
 SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
(SCM oldra, SCM mapfunc, SCM dims),
@@ -448,7 +390,6 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 
0, 1,
return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0,
 SCM_UNDEFINED);
 }
-  scm_i_ra_set_contp (ra);
   return ra;
 }
 #undef FUNC_NAME
@@ -547,16 +488,12 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 
1,
}
   if (ndim > 0)
SCM_MISC_ERROR ("bad argument list", SCM_EOL);
-  scm_i_ra_set_contp (res);
   return res;
 }
 }
 #undef FUNC_NAME
 
-/* attempts to unroll an array into a one-dimensional array.
-   returns the unrolled array or #f if it can't be done.  */
-/* if strict is true, return #f if returned array
-   wouldn't have contiguous elements.  */
+
 SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
(SCM ra, SCM strict),
"If @var{ra} may be @dfn{unrolled} into a one dimensional shared\n"
@@ -566,31 +503,38 @@

[Guile-commits] 05/11: Remove deprecated array functions

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit b3b1dd2091122dc4550de671f9ede235bc6e
Author: Daniel Llorens 
Date:   Fri Feb 13 16:45:21 2015 +0100

Remove deprecated array functions

* libguile/array-map.c (scm_array_fill_int, scm_array_fill_int,
scm_ra_eqp, scm_ra_lessp scm_ra_leqp, scm_ra_grp, scm_ra_greqp,
scm_ra_sum, scm_ra_difference, scm_ra_product, scm_ra_divide,
scm_array_identity): Remove deprecated functions.

* libguile/array-map.h: Remove declaration of deprecated functions.

* libguile/generalized-vectors.h, libguile/generalized-vectors.c
  (scm_is_generalized_vector, scm_c_generalized_vector_length,
  scm_c_generalized_vector_ref, scm_c_generalized_vector_set_x): These
  functions were deprecated in 2.0.9. Remove.

* doc/ref/api-compound.texi: Remove uniform-array-read!,
  uniform-array-write from the manual. These procedures where removed in
  fc7bd367ab4b5027a7f80686b1e229c62e43c90b (2011-05-12).
---
 doc/ref/api-compound.texi  |   33 -
 libguile/array-map.c   |  261 
 libguile/array-map.h   |   16 ---
 libguile/generalized-vectors.c |   31 -
 libguile/generalized-vectors.h |4 -
 5 files changed, 345 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 8277b35..97aaba3 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1568,39 +1568,6 @@ $\left(\matrix{%
 @end example
 @end deffn
 
-@deffn {Scheme Procedure} uniform-array-read! ra [port_or_fd [start [end]]]
-@deffnx {C Function} scm_uniform_array_read_x (ra, port_or_fd, start, end)
-Attempt to read all elements of array @var{ra}, in lexicographic order, as
-binary objects from @var{port_or_fd}.
-If an end of file is encountered,
-the objects up to that point are put into @var{ra}
-(starting at the beginning) and the remainder of the array is
-unchanged.
-
-The optional arguments @var{start} and @var{end} allow
-a specified region of a vector (or linearized array) to be read,
-leaving the remainder of the vector unchanged.
-
-@code{uniform-array-read!} returns the number of objects read.
-@var{port_or_fd} may be omitted, in which case it defaults to the value
-returned by @code{(current-input-port)}.
-@end deffn
-
-@deffn {Scheme Procedure} uniform-array-write ra [port_or_fd [start [end]]]
-@deffnx {C Function} scm_uniform_array_write (ra, port_or_fd, start, end)
-Writes all elements of @var{ra} as binary objects to
-@var{port_or_fd}.
-
-The optional arguments @var{start}
-and @var{end} allow
-a specified region of a vector (or linearized array) to be written.
-
-The number of objects actually written is returned.
-@var{port_or_fd} may be
-omitted, in which case it defaults to the value returned by
-@code{(current-output-port)}.
-@end deffn
-
 @node Shared Arrays
 @subsubsection Shared Arrays
 
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 938f0a7..587df02 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -307,267 +307,6 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 #undef FUNC_NAME
 
 
-#if SCM_ENABLE_DEPRECATED == 1
-
-/* to be used as cproc in scm_ramapc to fill an array dimension with
-   "fill". */
-int
-scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
-{
-  unsigned long i;
-  unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd 
+ 1;
-  long inc = SCM_I_ARRAY_DIMS (ra)->inc;
-  unsigned long base = SCM_I_ARRAY_BASE (ra);
-
-  ra = SCM_I_ARRAY_V (ra);
-
-  for (i = base; n--; i += inc)
-ASET (ra, i, fill);
-
-  return 1;
-}
-
-/* Functions callable by ARRAY-MAP! */
-
-int
-scm_ra_eqp (SCM ra0, SCM ras)
-{
-  SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
-  scm_t_array_handle ra0_handle;
-  scm_t_array_dim *ra0_dims;
-  size_t n;
-  ssize_t inc0;
-  size_t i0 = 0;
-  unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
-  long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  ra1 = SCM_I_ARRAY_V (ra1);
-  ra2 = SCM_I_ARRAY_V (ra2);
-
-  scm_array_get_handle (ra0, _handle);
-  ra0_dims = scm_array_handle_dims (_handle);
-  n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1;
-  inc0 = ra0_dims[0].inc;
-
-  {
-for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
-  if (scm_is_true (scm_array_handle_ref (_handle, i0)))
-   if (!scm_is_eq (AREF (ra1, i1), AREF (ra2, i2)))
- scm_array_handle_set (_handle, i0, SCM_BOOL_F);
-  }
-
-  scm_array_handle_release (_handle);
-  return 1;
-}
-
-/* opt 0 means <, nonzero means >= */
-
-static int
-ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
-{
-  scm_t_array_handle ra0_handle;
-  scm_t_array_dim *ra0_dims;
-  size_t n;
-  ssize_t inc0;
-  size_t i0 = 0;
-  unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
-  long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  long

[Guile-commits] 03/11: Avoid unneeded internal use of array handles

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit d4d92b2e2d3c0b5bc115509d7abd53955c0167e7
Author: Daniel Llorens 
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 |   21 
 libguile/generalized-arrays.h |3 --
 test-suite/tests/arrays.test  |   76 ++---
 5 files changed, 109 insertions(+), 59 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, );
-  res = scm_from_size_t (handle.base);
-  scm_array_handle_release ();
-  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, );
-  k = scm_array_handle_rank ();
-  s = scm_array_handle_dims ();
-  while (k--)
-res = scm_cons (scm_from_ssize_t (s[k].inc), res);
-  scm_array_handle_release ();
-  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..fdbdb4a 100644
--- a/libguile/generalized-arrays.c
+++ b/libguile/generalized-arrays.c
@@ -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;
-

[Guile-commits] 09/11: Special case for array-map! with three arguments

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit a3d953d208bbf0007c53d56e7c3a9b517ee5eeaf
Author: Daniel Llorens 
Date:   Wed Dec 9 13:10:48 2015 +0100

Special case for array-map! with three arguments

Benchmark:

(define type #t)
(define A (make-typed-array 's32 0 1 1000))
(define B (make-typed-array 's32 0 1 1000))
(define C (make-typed-array 's32 0 1 1000))

before:

scheme@(guile-user)> ,time (array-map! C + A B)
;; 0.792653s real time, 0.790970s run time.  0.00s spent in GC.

after:

scheme@(guile-user)> ,time (array-map! C + A B)
;; 0.598513s real time, 0.597146s run time.  0.00s spent in GC.

* libguile/array-map.c (ramap): Add special case with 3 arguments.
---
 libguile/array-map.c |   60 --
 1 file changed, 38 insertions(+), 22 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 9caded8..01bebb8 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -322,32 +322,48 @@ ramap (SCM ra0, SCM proc, SCM ras)
   h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1)));
   else
 {
-  scm_t_array_handle *hs;
-  size_t restn = scm_ilength (ras);
-
-  SCM args = SCM_EOL;
-  SCM *p = 
-  SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint);
-  for (size_t k = 0; k < restn; ++k)
+  SCM ra2 = SCM_CAR (ras);
+  size_t i2 = SCM_I_ARRAY_BASE (ra2);
+  ssize_t inc2 = SCM_I_ARRAY_DIMS (ra2)->inc;
+  scm_t_array_handle h2;
+  ra2 = SCM_I_ARRAY_V (ra2);
+  scm_array_get_handle (ra2, );
+  ras = SCM_CDR (ras);
+  if (scm_is_null (ras))
+for (; n--; i0 += inc0, i1 += inc1, i2 += inc2)
+  h0.vset (h0.vector, i0, scm_call_2 (proc, h1.vref (h1.vector, 
i1), h2.vref (h2.vector, i2)));
+  else
 {
-  *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
-  sa[k] = SCM_CARLOC (*p);
-  p = SCM_CDRLOC (*p);
-}
+  scm_t_array_handle *hs;
+  size_t restn = scm_ilength (ras);
+  SCM args = SCM_EOL;
+  SCM *p = 
+  SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint);
+  size_t k;
+  ssize_t i;
+  
+  for (k = 0; k < restn; ++k)
+{
+  *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
+  sa[k] = SCM_CARLOC (*p);
+  p = SCM_CDRLOC (*p);
+}
 
-  hs = scm_gc_malloc (sizeof(scm_t_array_handle) * restn, vi_gc_hint);
-  for (size_t k = 0; k < restn; ++k, ras = scm_cdr (ras))
-scm_array_get_handle (scm_car (ras), hs+k);
+  hs = scm_gc_malloc (sizeof(scm_t_array_handle) * restn, 
vi_gc_hint);
+  for (k = 0; k < restn; ++k, ras = scm_cdr (ras))
+scm_array_get_handle (scm_car (ras), hs+k);
 
-  for (ssize_t i = 0; n--; i0 += inc0, i1 += inc1, ++i)
-{
-  for (size_t k = 0; k < restn; ++k)
-*(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc);
-  h0.vset (h0.vector, i0, scm_apply_1 (proc, h1.vref (h1.vector, 
i1), args));
-}
+  for (i = 0; n--; i0 += inc0, i1 += inc1, i2 += inc2, ++i)
+{
+  for (k = 0; k < restn; ++k)
+*(sa[k]) = scm_array_handle_ref (hs+k, 
i*hs[k].dims[0].inc);
+  h0.vset (h0.vector, i0, scm_apply_2 (proc, h1.vref 
(h1.vector, i1), h2.vref (h2.vector, i2), args));
+}
 
-  for (size_t k = 0; k < restn; ++k)
-scm_array_handle_release (hs+k);
+  for (k = 0; k < restn; ++k)
+scm_array_handle_release (hs+k);
+}
+  scm_array_handle_release ();
 }
   scm_array_handle_release ();
 }

[Guile-commits] 08/11: Speed up for multi-arg cases of scm_ramap functions

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit 9cbd415adbe64505c8c02c5e0b917cbb2faf7745
Author: Daniel Llorens 
Date:   Fri Feb 13 18:42:27 2015 +0100

Speed up for multi-arg cases of scm_ramap functions

This patch results in a 20%-40% speedup in the > 1 argument cases of
the following microbenchmarks:

(define A (make-shared-array #0(1) (const '()) #e1e7))
; 1, 2, 3 arguments.
(define a 0) ,time (array-for-each (lambda (b) (set! a (+ a b))) A)
(define a 0) ,time (array-for-each (lambda (b c) (set! a (+ a b c))) A A)
(define a 0) ,time (array-for-each (lambda (b c d) (set! a (+ a b c d))) A 
A A)

(define A (make-shared-array (make-array 1) (const '()) #e1e7))
(define B (make-shared-array #0(1) (const '()) #e1e7))
; 1, 2, 3 arguments.
,time (array-map! A + B)
,time (array-map! A + B B)
,time (array-map! A + B B B)

* libguile/array-map.c (scm_ramap): Note on cproc arguments.

  (rafill): Assume that dst's lbnd is 0.

  (racp): Assume that src's lbnd is 0.

  (ramap): Assume that ra0's lbnd is 0. When there're more than two
  arguments, compute the array handles before the loop. Allocate the arg
  list once and reuse it in the loop.

  (rafe): Do as in ramap(), when there's more than one argument.

  (AREF, ASET): Remove.
---
 libguile/array-map.c|  136 +++
 libguile/array-map.h|2 +-
 test-suite/tests/ramap.test |4 +-
 3 files changed, 77 insertions(+), 65 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 587df02..9caded8 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009,
- *   2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2010, 2011, 2012, 2013, 2014, 2015 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
@@ -48,18 +48,6 @@
 static const char vi_gc_hint[] = "array-indices";
 
 static SCM
-AREF (SCM v, size_t pos)
-{
-  return scm_c_array_ref_1 (v, pos);
-}
-
-static void
-ASET (SCM v, size_t pos, SCM val)
-{
-  scm_c_array_set_1_x (v, val, pos);
-}
-
-static SCM
 make1array (SCM v, ssize_t inc)
 {
   SCM a = scm_i_make_array (1);
@@ -99,6 +87,10 @@ cindk (SCM ra, ssize_t *ve, int kend)
 #define LBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].lbnd
 #define UBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].ubnd
 
+
+/* scm_ramapc() always calls cproc with rank-1 arrays created by
+   make1array. cproc (rafe, ramap, rafill, racp) can assume that the
+   dims[0].lbnd of these arrays is always 0. */
 int
 scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
 {
@@ -167,7 +159,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, 
const char *what)
 scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 
(ra0));
   va1 = make1array (ra1, 1);
 
-  if (LBND (ra0, 0) < LBND (va1, 0) || UBND (ra0, 0) > UBND (va1, 0))
+  if (LBND (ra0, 0) < 0 /* LBND (va1, 0) */ || UBND (ra0, 0) > UBND 
(va1, 0))
 scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 
(ra0));
 }
   *plva = scm_cons (va1, SCM_EOL);
@@ -224,14 +216,12 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, 
const char *what)
 static int
 rafill (SCM dst, SCM fill)
 {
+  size_t n = SCM_I_ARRAY_DIMS (dst)->ubnd + 1;
+  size_t i = SCM_I_ARRAY_BASE (dst);
+  ssize_t inc = SCM_I_ARRAY_DIMS (dst)->inc;
   scm_t_array_handle h;
-  size_t n, i;
-  ssize_t inc;
-  scm_array_get_handle (SCM_I_ARRAY_V (dst), );
-  i = SCM_I_ARRAY_BASE (dst);
-  inc = SCM_I_ARRAY_DIMS (dst)->inc;
-  n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
   dst = SCM_I_ARRAY_V (dst);
+  scm_array_get_handle (dst, );
 
   for (; n-- > 0; i += inc)
 h.vset (h.vector, i, fill);
@@ -255,19 +245,17 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 static int
 racp (SCM src, SCM dst)
 {
-  scm_t_array_handle h_s, h_d;
-  size_t n, i_s, i_d;
+  size_t i_s, i_d, n;
   ssize_t inc_s, inc_d;
-
+  scm_t_array_handle h_s, h_d;
   dst = SCM_CAR (dst);
   i_s = SCM_I_ARRAY_BASE (src);
   i_d = SCM_I_ARRAY_BASE (dst);
+  n = (SCM_I_ARRAY_DIMS (src)->ubnd + 1);
   inc_s = SCM_I_ARRAY_DIMS (src)->inc;
   inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
-  n = (SCM_I_ARRAY_DIMS (src)->ubnd - SCM_I_ARRAY_DIMS (src)->lbnd + 1);
   src = SCM_I_ARRAY_V (src);
   dst = SCM_I_ARRAY_V (dst);
-
   scm_array_get_handle (src, _s);
   scm_array_get_handle (dst, _d);
 
@@ -310,44 +298,56 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 static int
 ramap (SCM ra0, SCM proc, SCM ras)
 {
+  size_t i0 = SCM_I_ARRAY_BASE (ra0);
+  ssize_t inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+  size_t n = SCM_I_ARRAY_DIMS

[Guile-commits] 07/11: Do not use array handles in scm_vector

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit 89fc5554022bdf177e761374db2fd6eb76fc33ea
Author: Daniel Llorens 
Date:   Wed Feb 25 09:47:40 2015 +0100

Do not use array handles in scm_vector

* libguile/vectors.c (scm_vector): Use SCM_I_VECTOR_WELTS on new vector
  instead of generic scm_vector_elements; cf. scm_vector_copy().

  (scm_vector_elements): Forward to scm_vector_writable_elements().

  (scm_vector_writable_elements): Remove special error message for weak
  vector arg.

* libguile/generalized-vectors.c (SCM_VALIDATE_VECTOR_WITH_HANDLE):
  Remove unused macro.

* libguile/array-handle.c (scm_array_handle_elements): Forward to
  scm_array_handle_writable_elements().
---
 libguile/array-handle.c|4 +---
 libguile/generalized-vectors.c |5 -
 libguile/vectors.c |   20 ++--
 3 files changed, 3 insertions(+), 26 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 3595266..89277d9 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -320,9 +320,7 @@ scm_array_handle_release (scm_t_array_handle *h)
 const SCM *
 scm_array_handle_elements (scm_t_array_handle *h)
 {
-  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
-scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-  return ((const SCM*)h->elements) + h->base;
+  return scm_array_handle_writable_elements (h);
 }
 
 SCM *
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 0fe8b89..276b9d8 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -69,11 +69,6 @@ SCM_DEFINE (scm_make_generalized_vector, 
"make-generalized-vector", 2, 1, 0,
 }
 #undef FUNC_NAME
 
-
-#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
-  scm_generalized_vector_get_handle (val, handle)
-   
-
 void
 scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
 {
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 5dab545..6dcc7eb 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -59,26 +59,13 @@ const SCM *
 scm_vector_elements (SCM vec, scm_t_array_handle *h,
 size_t *lenp, ssize_t *incp)
 {
-  if (SCM_I_WVECTP (vec))
-scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
-
-  scm_generalized_vector_get_handle (vec, h);
-  if (lenp)
-{
-  scm_t_array_dim *dim = scm_array_handle_dims (h);
-  *lenp = dim->ubnd - dim->lbnd + 1;
-  *incp = dim->inc;
-}
-  return scm_array_handle_elements (h);
+  return scm_vector_writable_elements (vec, h, lenp, incp);
 }
 
 SCM *
 scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
  size_t *lenp, ssize_t *incp)
 {
-  if (SCM_I_WVECTP (vec))
-scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
-
   scm_generalized_vector_get_handle (vec, h);
   if (lenp)
 {
@@ -141,12 +128,11 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
   SCM res;
   SCM *data;
   long i, len;
-  scm_t_array_handle handle;
 
   SCM_VALIDATE_LIST_COPYLEN (1, l, len);
 
   res = scm_c_make_vector (len, SCM_UNSPECIFIED);
-  data = scm_vector_writable_elements (res, , NULL, NULL);
+  data = SCM_I_VECTOR_WELTS (res);
   i = 0;
   while (scm_is_pair (l) && i < len) 
 {
@@ -155,8 +141,6 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
   i += 1;
 }
 
-  scm_array_handle_release ();
-
   return res;
 }
 #undef FUNC_NAME

[Guile-commits] 06/11: Support typed arrays in some sort functions

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit 6799359454745d14eb8fd4000cdf89fc4bf3de08
Author: Daniel Llorens 
Date:   Tue Jul 12 18:43:03 2016 +0200

Support typed arrays in some sort functions

* libguile/sort.c (sort!, sort, restricted-vector-sort!, sorted?):
  Support arrays of rank 1, whatever the type.

* libguile/quicksort.i.c: Fix accessors to handle typed arrays.

* test-suite/tests/sort.test: Test also with typed arrays.
---
 libguile/quicksort.i.c |   45 +++
 libguile/sort.c|  131 ++--
 test-suite/tests/sort.test |   32 ++-
 3 files changed, 140 insertions(+), 68 deletions(-)

diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c
index 4e39f82..cf1742e 100644
--- a/libguile/quicksort.i.c
+++ b/libguile/quicksort.i.c
@@ -11,7 +11,7 @@
version but doesn't consume extra memory.
  */
 
-#define SWAP(a, b) do { const SCM _tmp = a; a = b; b = _tmp; } while (0)
+#define SWAP(a, b) do { const SCM _tmp = GET(a); SET(a, GET(b)); SET(b, _tmp); 
} while (0)
 
 
 /* Order using quicksort.  This implementation incorporates four
@@ -54,8 +54,7 @@
 #defineSTACK_NOT_EMPTY  (stack < top)
 
 static void
-NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
-  SCM less)
+NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less)
 {
   /* Stack node declarations used to store unfulfilled partition obligations. 
*/
   typedef struct {
@@ -65,8 +64,6 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 
   static const char s_buggy_less[] = "buggy less predicate used when sorting";
 
-#define ELT(i) base_ptr[(i)*INC]
-
   if (nr_elems == 0)
 /* Avoid lossage with unsigned arithmetic below.  */
 return;
@@ -93,17 +90,17 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 
  SCM_TICK;

- if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo
-   SWAP (ELT(mid), ELT(lo));
- if (scm_is_true (scm_call_2 (less, ELT(hi), ELT(mid
-   SWAP (ELT(mid), ELT(hi));
+  if (scm_is_true (scm_call_2 (less, GET(mid), GET(lo
+SWAP (mid, lo);
+  if (scm_is_true (scm_call_2 (less, GET(hi), GET(mid
+SWAP (mid, hi);
  else
goto jump_over;
- if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo
-   SWAP (ELT(mid), ELT(lo));
+  if (scm_is_true (scm_call_2 (less, GET(mid), GET(lo
+SWAP (mid, lo);
jump_over:;
 
- pivot = ELT(mid);
+ pivot = GET(mid);
  left = lo + 1;
  right = hi - 1;
 
@@ -112,7 +109,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 that this algorithm runs much faster than others. */
  do
{
- while (scm_is_true (scm_call_2 (less, ELT(left), pivot)))
+ while (scm_is_true (scm_call_2 (less, GET(left), pivot)))
{
  left += 1;
  /* The comparison predicate may be buggy */
@@ -120,7 +117,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
scm_misc_error (NULL, s_buggy_less, SCM_EOL);
}
 
- while (scm_is_true (scm_call_2 (less, pivot, ELT(right
+ while (scm_is_true (scm_call_2 (less, pivot, GET(right
{
  right -= 1;
  /* The comparison predicate may be buggy */
@@ -130,7 +127,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 
  if (left < right)
{
- SWAP (ELT(left), ELT(right));
+ SWAP (left, right);
  left += 1;
  right -= 1;
}
@@ -192,11 +189,11 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
and the operation speeds up insertion sort's inner loop. */
 
 for (run = tmp + 1; run <= thresh; run += 1)
-  if (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp
+  if (scm_is_true (scm_call_2 (less, GET(run), GET(tmp
tmp = run;
 
 if (tmp != 0)
-  SWAP (ELT(tmp), ELT(0));
+  SWAP (tmp, 0);
 
 /* Insertion sort, running from left-hand-side up to right-hand-side.  */
 
@@ -206,7 +203,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
SCM_TICK;
 
tmp = run - 1;
-   while (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp
+   while (scm_is_true (scm_call_2 (less, GET(run), GET(tmp
  {
/* The comparison predicate may be buggy */
if (tmp == 0)
@@ -218,12 +215,12 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
tmp += 1;
if (tmp != run)
  {
-SCM to_insert = ELT(run);
+SCM to_insert = GET(run);
 size_t hi, lo;
 
 for (hi = lo = run; --lo >= tmp; hi = lo)
-  ELT(hi) = ELT(lo);
-

[Guile-commits] 04/11: Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit 275ba7d096fb6fb085418c133674bde5ee1db664
Author: Daniel Llorens 
Date:   Wed Feb 11 12:58:01 2015 +0100

Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle

* libguile/bytevectors.h (SCM_BYTEVECTOR_TYPE_SIZE,
  SCM_BYTEVECTOR_TYPED_LENGTH): Moved from libguile/bytevectors.c.

* libguile/array-handle.c (scm_array_get_handle): Reuse
  SCM_BYTEVECTOR_TYPED_LENGTH.
---
 libguile/array-handle.c |6 ++
 libguile/bytevectors.c  |5 -
 libguile/bytevectors.h  |5 +
 3 files changed, 7 insertions(+), 9 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 2252ecc..3595266 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -185,15 +185,13 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
   break;
 case scm_tc7_bytevector:
   {
-size_t byte_length, length, element_byte_size;
+size_t length;
 scm_t_array_element_type element_type;
 scm_t_vector_ref vref;
 scm_t_vector_set vset;
 
-byte_length = scm_c_bytevector_length (array);
 element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (array);
-element_byte_size = scm_i_array_element_type_sizes[element_type] / 8;
-length = byte_length / element_byte_size;
+length = SCM_BYTEVECTOR_TYPED_LENGTH (array);
 
 switch (element_type)
   {
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index e426ae3..cf247dc 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -192,11 +192,6 @@
 #define SCM_BYTEVECTOR_SET_PARENT(_bv, _parent)\
   SCM_SET_CELL_OBJECT_3 ((_bv), (_parent))
 
-#define SCM_BYTEVECTOR_TYPE_SIZE(var)   \
-  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
-#define SCM_BYTEVECTOR_TYPED_LENGTH(var)\
-  (SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var))
-
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index a5eeaea..af4ac1c 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -129,6 +129,11 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 #define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv)   \
   (SCM_BYTEVECTOR_FLAGS (_bv) >> 8UL)
 
+#define SCM_BYTEVECTOR_TYPE_SIZE(var)   \
+  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var)\
+  (SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var))
+
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"

[Guile-commits] branch lloda-squash0 updated (0961c31 -> 8b49ec3)

2016-10-13 Thread Daniel Llorens 
lloda pushed a change to branch lloda-squash0
in repository guile.

  discards  0961c31   New functions (array-for-each-cell, 
array-for-each-cell-in-order)
  discards  62eff47   New functions array-from, array-from*, array-amend!
  discards  d9a7257   Special case for array-map! with three arguments
  discards  612626c   Speed up for multi-arg cases of scm_ramap functions
  discards  a910a02   Do not use array handles in scm_vector
  discards  91a583c   Support typed arrays in some sort functions
  discards  201dfd0   Remove deprecated array functions
  discards  cc71845   Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle
  discards  8748dc3   Avoid unneeded internal use of array handles
  discards  f3901f9   Remove scm_from_contiguous_array, array 'contiguous' flag
  discards  a3f4add   Fix compilation of rank 0 typed array literals
  adds  67a0b7d   Remove .gnuploadrc.
  adds  06e4091   Texinfo serialization: add braces when needed
  adds  8622344   Fix slot allocation for prompts
   new  f244ae8   Fix compilation of rank 0 typed array literals
   new  d8ff1be   Remove scm_from_contiguous_array, array 'contiguous' flag
   new  d4d92b2   Avoid unneeded internal use of array handles
   new  275ba7d   Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle
   new  b3b1dd2   Remove deprecated array functions
   new  6799359   Support typed arrays in some sort functions
   new  89fc555   Do not use array handles in scm_vector
   new  9cbd415   Speed up for multi-arg cases of scm_ramap functions
   new  a3d953d   Special case for array-map! with three arguments
   new  afbb28b   New functions array-from, array-from*, array-amend!
   new  8b49ec3   New functions (array-for-each-cell, 
array-for-each-cell-in-order)

This update added new revisions after undoing existing revisions.
That is to say, some revisions that were in the old version of the
branch are not in the new version.  This situation occurs
when a user --force pushes a change and generates a repository
containing something like this:

 * -- * -- B -- O -- O -- O   (0961c31)
\
 N -- N -- N   refs/heads/lloda-squash0 (8b49ec3)

You should already have received notification emails for all of the O
revisions, and so the following emails describe only the N revisions
from the common base, B.

Any revisions marked "omits" are not gone; other references still
refer to them.  Any revisions marked "discards" are gone forever.

The 11 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "adds" were already present in the repository and have only
been added to this reference.


Summary of changes:
 .gnuploadrc |1 -
 module/language/cps/slot-allocation.scm |   51 
 module/texinfo/serialize.scm|   79 +++
 test-suite/tests/compiler.test  |   25 ++
 test-suite/tests/texinfo.serialize.test |9 +++-
 5 files changed, 113 insertions(+), 52 deletions(-)
 delete mode 100644 .gnuploadrc

[Guile-commits] 11/11: New functions (array-for-each-cell, array-for-each-cell-in-order)

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit 8b49ec31081b37f12c3909801353f6bad4dfaffe
Author: Daniel Llorens 
Date:   Tue Sep 8 16:57:30 2015 +0200

New functions (array-for-each-cell, array-for-each-cell-in-order)

* libguile/array-map.c (scm_i_array_rebase, scm_array_for_each_cell):
  New functions. Export scm_array_for_each_cell() as
  (array-for-each-cell).

  (array-for-each-cell-in-order): Define additional export.

* libguile/array-map.h (scm_i_array_rebase, scm_array_for_each_cell):
  Add prototypes.

* doc/ref/api-compound.texi: New section 'Arrays as arrays of
  arrays'. Move the documentation for (array-from), (array-from*) and
  (array-amend!) in here. Add documentation for (array-for-each-cell).

* test-suite/tests/array-map.test: Renamed from
  test-suite/tests/ramap.test, fix module name. Add tests for
  (array-for-each-cell).

* test-suite/Makefile.am: Apply rename array-map.test -> ramap.test.

* doc/ref/api-compound.texi: Minor documentation fixes.
---
 doc/ref/api-compound.texi   |  169 ++-
 libguile/array-map.c|  260 ++-
 libguile/array-map.h|4 +
 libguile/arrays.c   |5 +-
 test-suite/Makefile.am  |2 +-
 test-suite/tests/{ramap.test => array-map.test} |   35 ++-
 6 files changed, 416 insertions(+), 59 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 6d1e118..936b495 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1203,6 +1203,7 @@ dimensional arrays.
 * Array Syntax::
 * Array Procedures::
 * Shared Arrays::   
+* Arrays as arrays of arrays::
 * Accessing Arrays from C:: 
 @end menu
 
@@ -1682,24 +1683,91 @@ sample points are enough because @var{mapfunc} is 
linear.
 Return the element at @code{(idx @dots{})} in @var{array}.
 @end deffn
 
+
+@deffn {Scheme Procedure} shared-array-increments array
+@deffnx {C Function} scm_shared_array_increments (array)
+For each dimension, return the distance between elements in the root vector.
+@end deffn
+
+@deffn {Scheme Procedure} shared-array-offset array
+@deffnx {C Function} scm_shared_array_offset (array)
+Return the root vector index of the first element in the array.
+@end deffn
+
+@deffn {Scheme Procedure} shared-array-root array
+@deffnx {C Function} scm_shared_array_root (array)
+Return the root vector of a shared array.
+@end deffn
+
+@deffn {Scheme Procedure} array-contents array [strict]
+@deffnx {C Function} scm_array_contents (array, strict)
+If @var{array} may be @dfn{unrolled} into a one dimensional shared array
+without changing their order (last subscript changing fastest), then
+@code{array-contents} returns that shared array, otherwise it returns
+@code{#f}.  All arrays made by @code{make-array} and
+@code{make-typed-array} may be unrolled, some arrays made by
+@code{make-shared-array} may not be.
+
+If the optional argument @var{strict} is provided, a shared array will
+be returned only if its elements are stored internally contiguous in
+memory.
+@end deffn
+
+@deffn {Scheme Procedure} transpose-array array dim1 dim2 @dots{}
+@deffnx {C Function} scm_transpose_array (array, dimlist)
+Return an array sharing contents with @var{array}, but with
+dimensions arranged in a different order.  There must be one
+@var{dim} argument for each dimension of @var{array}.
+@var{dim1}, @var{dim2}, @dots{} should be integers between 0
+and the rank of the array to be returned.  Each integer in that
+range must appear at least once in the argument list.
+
+The values of @var{dim1}, @var{dim2}, @dots{} correspond to
+dimensions in the array to be returned, and their positions in the
+argument list to dimensions of @var{array}.  Several @var{dim}s
+may have the same value, in which case the returned array will
+have smaller rank than @var{array}.
+
+@lisp
+(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))
+(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)
+(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{}
+#2((a 4) (b 5) (c 6))
+@end lisp
+@end deffn
+
+@node Arrays as arrays of arrays
+@subsubsection Arrays as arrays of arrays
+
+The functions in this section allow you to treat an array of rank
+@math{n} as an array of lower rank @math{n-k} where the elements are
+themselves arrays (`cells') of rank @math{k}. This replicates some of
+the functionality of `enclosed arrays', a feature of old Guile that was
+removed before @w{version 2.0}. However, these functions do not require
+a special type and operate on any array.
+
+When we operate on an array in this way, we speak of the first @math{k}
+dimensions of the array as the @math{k}-`frame' of the array, while the

[Guile-commits] 10/11: New functions array-from, array-from*, array-amend!

2016-10-13 Thread Daniel Llorens 
lloda pushed a commit to branch lloda-squash0
in repository guile.

commit afbb28b3b3508c791ec1219e54770cd8f4ddec09
Author: Daniel Llorens 
Date:   Wed Feb 11 16:44:21 2015 +0100

New functions array-from, array-from*, array-amend!

* libguile/arrays.h (scm_array_from, scm_array_from_s,
  scm_array_amend_x): New declarations.

* libguile/arrays.c (scm_array_from, scm_array_from_s,
  scm_array_amend_x): New functions, export as array-from, array-from*,
  array-amend!.

* test-suite/tests/arrays.test: Tests for array-from, array-from*,
  array-amend!.

* doc/ref/api-compound.texi: Document array-from, array-from*,
  array-amend!.
---
 doc/ref/api-compound.texi|  105 
 libguile/arrays.c|  158 ++
 libguile/arrays.h|6 ++
 test-suite/tests/arrays.test |  109 +
 4 files changed, 378 insertions(+)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 97aaba3..6d1e118 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1676,6 +1676,111 @@ base and stride for new array indices in @var{oldarray} 
data.  A few
 sample points are enough because @var{mapfunc} is linear.
 @end deffn
 
+
+@deffn {Scheme Procedure} array-ref array idx @dots{}
+@deffnx {C Function} scm_array_ref (array, idxlist)
+Return the element at @code{(idx @dots{})} in @var{array}.
+@end deffn
+
+@deffn {Scheme Procedure} array-from array idx @dots{}
+@deffnx {C Function} scm_array_from (array, idxlist)
+If the length of @var{idxlist} equals the rank @math{n} of
+@var{array}, return the element at @code{(idx @dots{})}, just like
+@code{(array-ref array idx @dots{})}. If, however, the length @math{k}
+of @var{idxlist} is shorter than @math{n}, then return the shared
+@math{(n-k)}-rank prefix cell of @var{array} given by @var{idxlist}.
+
+For example:
+
+@example
+@lisp
+(array-from #2((a b) (c d)) 0) @result{} #(a b)
+(array-from #2((a b) (c d)) 1) @result{} #(c d)
+(array-from #2((a b) (c d)) 1 1) @result{} d
+(array-from #2((a b) (c d))) @result{} #2((a b) (c d))
+@end lisp
+@end example
+
+@code{(apply array-from array indices)} is equivalent to
+
+@lisp
+(let ((len (length indices)))
+  (if (= (array-rank a) len)
+(apply array-ref a indices)
+(apply make-shared-array a
+   (lambda t (append indices t))
+   (drop (array-dimensions a) len
+@end lisp
+
+The name `from' comes from the J language.
+@end deffn
+
+@deffn {Scheme Procedure} array-from* array idx @dots{}
+@deffnx {C Function} scm_array_from_s (array, idxlist)
+Like @code{(array-from array idx @dots{})}, but return a 0-rank shared
+array if the length of @var{idxlist} matches the rank of
+@var{array}. This can be useful when using @var{ARRAY} as destination
+of copies.
+
+Compare:
+
+@example
+@lisp
+(array-from #2((a b) (c d)) 1 1) @result{} d
+(array-from* #2((a b) (c d)) 1) @result{} #0(d)
+(define a (make-array 'a 2 2))
+(array-fill! (array-from* a 1 1) 'b)
+a @result{} #2((a a) (a b)).
+(array-fill! (array-from a 1 1) 'b) @result{} error: not an array
+@end lisp
+@end example
+
+@code{(apply array-from* array indices)} is equivalent to
+
+@lisp
+(apply make-shared-array a
+  (lambda t (append indices t))
+  (drop (array-dimensions a) (length indices)))
+@end lisp
+@end deffn
+
+
+@deffn {Scheme Procedure} array-amend! array x idx @dots{}
+@deffnx {C Function} scm_array_amend_x (array, x, idxlist)
+If the length of @var{idxlist} equals the rank @math{n} of
+@var{array}, set the element at @code{(idx @dots{})} of @var{array} to
+@var{x}, just like @code{(array-set! array x idx @dots{})}. If,
+however, the length @math{k} of @var{idxlist} is shorter than
+@math{n}, then copy the @math{(n-k)}-rank array @var{x}
+into @math{(n-k)}-rank prefix cell of @var{array} given by
+@var{idxlist}. In this case, the last @math{(n-k)} dimensions of
+@var{array} and the dimensions of @var{x} must match exactly.
+
+This function returns the modified @var{array}.
+
+For example:
+
+@example
+@lisp
+(array-amend! (make-array 'a 2 2) b 1 1) @result{} #2((a a) (a b))
+(array-amend! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y))
+@end lisp
+@end example
+
+@code{(apply array-amend! array x indices)} is equivalent to
+
+@lisp
+(let ((len (length indices)))
+  (if (= (array-rank array) len)
+(apply array-set! array x indices)
+(array-copy! x (apply array-from array indices)))
+  array)
+@end lisp
+
+The name `amend' comes from the J language.
+@end deffn
+
+
 @deffn {Scheme Procedure} shared-array-increments array
 @deffnx {C Function} scm_shared_array_increments (array)
 For each dimension, return the distance between elements in the root vector.
diff --git a/libguile/arrays.c b/libguile/arrays.c
index fb522e1..273c48b 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -416,6 +416,164 @@ SCM_DEFINE