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

2016-09-21 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/40891132

Go forth and fix it.

Regards,

The Hydra build daemon.

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

2016-09-21 Thread Hydra Build Daemon 
Hi,

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

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

Yay!

Regards,

The Hydra build daemon.

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

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

commit 62eff47035db83ddf4ffa3505d02c6be6b27b27b
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

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

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

commit cc71845cb5b1459812b569047f0ed27caa569293
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] 09/11: Special case for array-map! with three arguments

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

commit d9a7257bd41cd1f53b49655c0afc2c78f44142aa
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] 05/11: Remove deprecated array functions

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

commit 201dfd09f4b94d563b0f2125181da3e0169ca649
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] branch lloda-squash0 updated (ed383e9 -> 0961c31)

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

  discards  ed383e9   New functions (array-for-each-cell, 
array-for-each-cell-in-order)
  discards  a1e5722   New functions array-from, array-from*, array-amend!
  discards  475b365   Special case for array-map! with three arguments
  discards  068598c   Speed up for multi-arg cases of scm_ramap functions
  discards  a39ed77   Do not use array handles in scm_vector
  discards  82c3a8b   Support typed arrays in some sort functions
  discards  3248c26   Remove deprecated array functions
  discards  a2583cc   Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle
  discards  2d00cf1   Avoid unneeded internal use of array handles
  discards  56deb6a   Remove scm_from_contiguous_array, array 'contiguous' flag
  discards  e657d1f   Fix compilation of rank 0 typed array literals
  adds  147ba05   build: Remove unneeded check for 'unsetenv'.
  adds  abb0b54   Unconditionally include  from Gnulib.
  adds  b505ad9   Add missing 'const' qualifier.
  adds  a9e726e   More robust setuid, setgid, etc detection
  adds  a1cb59c   Provide `kill' only if supported by the host
  adds  9222e05   getaffinity, setaffinity docstring cleanup
  adds  f632d45   More specific status:exit-val et al compilation guards
  adds  10ae9cc   Factor start_child out of open_process
  adds  d32f37e   Ignore meta/build-env
  adds  b2d77c3   Rename win32-uname.[ch] to posix-w32.[ch]
  adds  3231d76   Add POSIX shims for MinGW
  adds  513344e   Add popen feature
  adds  ea223b0   Update NEWS
  adds  a58bfb4   Fix MinGW build error
  adds  da0ee4d   Fix unused static variables in net_db.c
  adds  d87915f   Update uname implementation in posix-w32
  adds  e868fae   doc: Do not gender the programmer.
  adds  aae3561   Allow mkstemp! to have optional "mode" argument
  adds  62843d5   Improve process handling on MS-Windows
  adds  0cf155b   Untabify posix-w32.c
  adds  ad7e806   doc: Add unquote and unquote-splicing examples.
  adds  8868c85   Gnulib: Add dirname-lgpl.
  adds  1f14900   Use gnulib for basename / dirname
  adds  315acd5   Use non-deprecated HAVE_STRUCT_TM_TM_ZONE
  adds  ca2d00a   Reimplement null-threads as inline functions
  adds  4012143   Fix --without-threads against threaded BDW-GC
  adds  d2684fe   Avoid compilation warnings about alloca in read.c
  adds  8da33d9   Fix compilation of `continue' in `while'.
  adds  1a1c3bb   Implement R6RS custom binary input/output ports
  adds  e68dd5c   Manual recommends against SRFI-10
  adds  0f1b567   Fix typo about pattern variables
  adds  978229a   Fix grammar in api-compound.texi
  adds  bcc40bc   Capture full path to GUILE_FOR_BUILD.
  adds  8ad6766   Recognize nios2 as compilation target
  adds  469970d   Let assv/assoc shortcircuit to assq where feasible
  adds  96d3cb3   Documentation fixes
  adds  2450278   Fix typo about variable definitions
  adds  b434ea3   Recognize alpha as compilation target
  adds  8f2f8db   Fix typo about open-pipe
  adds  aa86ae6   Fix exception when running ",help debug"
  adds  af360e5   Tweak to conversion strategy access
  adds  57aff02   Add prebuilt alias for x86_64-pc-linux-gnu
  adds  342bd8d   ETag list headers accept sloppy etags
  adds  ebb8cb7   Remove SCM_I_MAX_PORT_TYPE_COUNT
  adds  4256e06   Remove duplicate documentation
  adds  2fa2e50   Add file descriptor finalizers
  adds  ad4fe88   Move system* to posix.c, impl on open-process
  adds  40c6734   Correct section number for "Input Ports" tests.
  adds  b9b2352   Add tests for make-custom-binary-input/output-port
  adds  9996695   Require C99 to build Guile.
  adds  eeb23e7   Avoid flushing buffers for ftell
  adds  f46cb25   Set rw_random correctly for all custom binary port types
  adds  cc9e72b   Fix example in make-custom-binary-input-port documentation
  adds  b8a53b9   Only ptob->close() after read/write finish
  adds  b733ca4   GC of non-blocking port does not block
  adds  49d77b1   Add unboxed logxor on u64 values
  adds  723efdf   Fabricated expression tweak in CSE
  adds  0f2f594   Better unboxing
  adds  2dbb0e2   GOOPS caches created vtables
  adds  3b2cd09   Better char mkostemp.c}|   12 +-
 libguile.h   |2 +
 libguile/Makefile.am |   15 +-
 libguile/alist.c |   21 +
 libguile/atomic.c|  128 +++
 libguile/atomic.h|   56 ++
 libguile/atomics-internal.h  |  149 
 libguile/fdes-finalizers.c   |  129 +++
 libguile/{trees.h => fdes-finalizers.h}  |   27 +-
 libguile/filesys.c   |  134 +--
 libguile/fports.c|   79 +-

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

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

commit a910a022fd4440ecd323c6203270495ed4857eee
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] 08/11: Speed up for multi-arg cases of scm_ramap functions

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

commit 612626c815d12295f8ff659fea85ca6377713698
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] 02/11: Remove scm_from_contiguous_array, array 'contiguous' flag

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

commit f3901f9439235d20d6cf3090b815b813618e9661
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] 11/11: New functions (array-for-each-cell, array-for-each-cell-in-order)

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

commit 0961c318034e109bb42aba301951496780673936
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] 03/11: Avoid unneeded internal use of array handles

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

commit 8748dc383829d852077b45f98e6de6f7151d0cbb
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] 06/11: Support typed arrays in some sort functions

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

commit 91a583c0d2be842c6d964fb756221809834850cf
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] 01/11: Fix compilation of rank 0 typed array literals

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

commit a3f4addc790b62b2c5418b562e108adaf7add7f2
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