[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_enable_guile_debug on x86_64-linux

[Hydra Build Daemon]

Hi,

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

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

Go forth and fix it.

Regards,

The Hydra build daemon.

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

[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/48716150

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] 02/03: Remove unnecessary scm_i_string_start_writing calls

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit c38b9625c88f4d1760068926273b6d89ffbd4527
Author: Andy Wingo 
Date:   Thu Feb 16 10:43:23 2017 +0100

Remove unnecessary scm_i_string_start_writing calls

* libguile/strings.c (scm_string, scm_c_make_string):
* libguile/srfi-13.c (scm_reverse_list_to_string, scm_string_map)
  (scm_string_unfold, scm_string_unfold_right, scm_xsubstring)
  (scm_string_filter, scm_string_delete): Remove
  scm_i_string_start_writing / scm_i_string_stop_writing calls around
  fresh strings that aren't visible to other threads.
---
 libguile/read.c|  6 ++
 libguile/srfi-13.c | 30 ++
 libguile/strings.c |  5 -
 3 files changed, 16 insertions(+), 25 deletions(-)

diff --git a/libguile/read.c b/libguile/read.c
index 085cdb9..0946ff3 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1556,7 +1556,8 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
   size_t len = 0;
   SCM buf = scm_i_make_string (1024, NULL, 0);
 
-  buf = scm_i_string_start_writing (buf);
+  /* No need to scm_i_string_start_writing (), as the string isn't
+ visible to any other thread.  */
 
   while ((chr = scm_getc (port)) != EOF)
 {
@@ -1620,16 +1621,13 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
{
  SCM addy;
 
- scm_i_string_stop_writing ();
  addy = scm_i_make_string (1024, NULL, 0);
  buf = scm_string_append (scm_list_2 (buf, addy));
  len = 0;
- buf = scm_i_string_start_writing (buf);
}
 }
 
  done:
-  scm_i_string_stop_writing ();
   if (chr == EOF)
 scm_i_input_error ("scm_read_extended_symbol", port,
"end of file while reading symbol", SCM_EOL);
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 5c30dfe..c77cba9 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -351,7 +351,8 @@ SCM_DEFINE (scm_reverse_list_to_string, 
"reverse-list->string", 1, 0, 0,
   }
 rest = chrs;
 j = i;
-result = scm_i_string_start_writing (result);
+/* No need to scm_i_string_start_writing (), as the string isn't
+   visible to any other thread.  */
 while (j > 0 && scm_is_pair (rest))
   {
 SCM elt = SCM_CAR (rest);
@@ -359,7 +360,6 @@ SCM_DEFINE (scm_reverse_list_to_string, 
"reverse-list->string", 1, 0, 0,
 rest = SCM_CDR (rest);
 j--;
   }
-scm_i_string_stop_writing ();
   }
 
   return result;
@@ -2515,9 +2515,9 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
   if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
   cstart++;
-  result = scm_i_string_start_writing (result);
+  /* No need to scm_i_string_start_writing (), as the string isn't
+ visible to any other thread.  */
   scm_i_string_set_x (result, p, SCM_CHAR (ch));
-  scm_i_string_stop_writing ();
   p++;
 }
   
@@ -2658,9 +2658,9 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0,
   if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
   str = scm_i_make_string (1, NULL, 0);
-  str = scm_i_string_start_writing (str);
+  /* No need to scm_i_string_start_writing (), as the string isn't
+ visible to any other thread.  */
   scm_i_string_set_x (str, i, SCM_CHAR (ch));
-  scm_i_string_stop_writing ();
   i++;
 
   ans = scm_string_append (scm_list_2 (ans, str));
@@ -2724,9 +2724,9 @@ SCM_DEFINE (scm_string_unfold_right, 
"string-unfold-right", 4, 2, 0,
   if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
   str = scm_i_make_string (1, NULL, 0);
-  str = scm_i_string_start_writing (str);
+  /* No need to scm_i_string_start_writing (), as the string isn't
+ visible to any other thread.  */
   scm_i_string_set_x (str, i, SCM_CHAR (ch));
-  scm_i_string_stop_writing ();
   i++;
 
   ans = scm_string_append (scm_list_2 (str, ans));
@@ -2839,7 +2839,6 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
 SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
 
   result = scm_i_make_string (cto - cfrom, NULL, 0);
-  result = scm_i_string_start_writing (result);
 
   p = 0;
   while (cfrom < cto)
@@ -2853,7 +2852,6 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
   cfrom++;
   p++;
 }
-  scm_i_string_stop_writing ();
 
   scm_remember_upto_here_1 (s);
   return result;
@@ -3191,8 +3189,9 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
 {
   size_t dst = 0;
   result = scm_i_make_string (count, NULL, 0);
- result = scm_i_string_start_writing (result);
 
+  /* No need to scm_i_string_start_writing (), as the string isn't
+ visible to any other thread.  */
   /* decrement "count" in this loop as 

[Guile-commits] branch master updated (4706d69 -> d0934df)

[Andy Wingo]

wingo pushed a change to branch master
in repository guile.

  from  4706d69   Fix accept4 gnulib update.
   new  cd3ff33   Cheaper fluid-ref cache
   new  c38b962   Remove unnecessary scm_i_string_start_writing calls
   new  d0934df   Stringbufs immutable by default

The 3 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:
 libguile/cache-internal.h  |   6 +-
 libguile/fluids.c  |  30 ++--
 libguile/read.c|   6 +-
 libguile/snarf.h   |   2 +-
 libguile/srfi-13.c |  30 ++--
 libguile/strings.c | 330 -
 libguile/strings.h |   2 +-
 module/system/vm/assembler.scm |   7 +-
 test-suite/tests/strings.test  |  34 -
 9 files changed, 195 insertions(+), 252 deletions(-)

[Guile-commits] 01/03: Cheaper fluid-ref cache

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit cd3ff33a31c51612f2247bdb15ecbe92d7da1310
Author: Andy Wingo 
Date:   Thu Feb 16 10:38:15 2017 +0100

Cheaper fluid-ref cache

* libguile/cache-internal.h (struct scm_cache_entry): Add needs_flush
  member.
  (scm_cache_evict_1): Clear needs_flush on newly evicted entry.
  (scm_cache_insert): Propagate needs_flush to new entry.
* libguile/fluids.c (restore_dynamic_state): Mark all restored entries
  as needing a flush.
  (save_dynamic_state): Only cons on "needs_flush" entries to the
  resulting dynamic state.  The result is the same as before but
  avoiding the refq on the weak table.
  (fluid_set_x): Propagate needs_flush down to the cache.
  (fluid_ref): When adding entry to cache, use needs_flush==0.
  (scm_fluid_set_x, scm_fluid_unset_x, scm_swap_fluid, swap_fluid): Use
  needs_flush==1.
---
 libguile/cache-internal.h |  6 +-
 libguile/fluids.c | 30 +-
 2 files changed, 22 insertions(+), 14 deletions(-)

diff --git a/libguile/cache-internal.h b/libguile/cache-internal.h
index fc1e3c1..88bb24a 100644
--- a/libguile/cache-internal.h
+++ b/libguile/cache-internal.h
@@ -37,6 +37,7 @@ struct scm_cache_entry
 {
   scm_t_bits key;
   scm_t_bits value;
+  int needs_flush;
 };
 
 #define SCM_CACHE_SIZE 8
@@ -73,6 +74,7 @@ scm_cache_evict_1 (struct scm_cache *cache, struct 
scm_cache_entry *evicted)
sizeof (cache->entries[0]) * idx);
   cache->entries[0].key = 0;
   cache->entries[0].value = 0;
+  cache->entries[0].needs_flush = 0;
 }
 
 static inline struct scm_cache_entry*
@@ -89,7 +91,7 @@ scm_cache_lookup (struct scm_cache *cache, SCM k)
 
 static inline void
 scm_cache_insert (struct scm_cache *cache, SCM k, SCM v,
-  struct scm_cache_entry *evicted)
+  struct scm_cache_entry *evicted, int needs_flush)
 {
   struct scm_cache_entry *entry;
 
@@ -99,6 +101,7 @@ scm_cache_insert (struct scm_cache *cache, SCM k, SCM v,
   if (entry->key == SCM_UNPACK (k))
 {
   entry->value = SCM_UNPACK (v);
+  entry->needs_flush = needs_flush;
   return;
 }
   memmove (cache->entries,
@@ -106,6 +109,7 @@ scm_cache_insert (struct scm_cache *cache, SCM k, SCM v,
(entry - cache->entries) * sizeof (*entry));
   entry->key = SCM_UNPACK (k);
   entry->value = SCM_UNPACK (v);
+  entry->needs_flush = needs_flush;
 }
 
 #endif /* SCM_CACHE_INTERNAL_H */
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 7daad77..5b42ccb 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -114,10 +114,11 @@ restore_dynamic_state (SCM saved, scm_t_dynamic_state 
*state)
 {
   entry->key = SCM_UNPACK (SCM_CAAR (saved));
   entry->value = SCM_UNPACK (SCM_CDAR (saved));
+  entry->needs_flush = 1;
   saved = scm_cdr (saved);
 }
   else
-entry->key = entry->value = 0;
+entry->key = entry->value = entry->needs_flush = 0;
 }
   state->values = saved;
   state->has_aliased_values = 1;
@@ -133,9 +134,7 @@ save_dynamic_state (scm_t_dynamic_state *state)
   struct scm_cache_entry *entry = >cache.entries[slot];
   SCM key = SCM_PACK (entry->key);
   SCM value = SCM_PACK (entry->value);
-  if (entry->key &&
-  !scm_is_eq (scm_weak_table_refq (state->values, key, SCM_UNDEFINED),
-  value))
+  if (entry->key && entry->needs_flush)
 {
   if (state->has_aliased_values)
 saved = scm_acons (key, value, saved);
@@ -249,7 +248,8 @@ scm_is_fluid (SCM obj)
 }
 
 static void
-fluid_set_x (scm_t_dynamic_state *dynamic_state, SCM fluid, SCM value)
+fluid_set_x (scm_t_dynamic_state *dynamic_state, SCM fluid, SCM value,
+ int needs_flush)
 {
   struct scm_cache_entry *entry;
   struct scm_cache_entry evicted = { 0, 0 };
@@ -257,13 +257,17 @@ fluid_set_x (scm_t_dynamic_state *dynamic_state, SCM 
fluid, SCM value)
   entry = scm_cache_lookup (_state->cache, fluid);
   if (scm_is_eq (SCM_PACK (entry->key), fluid))
 {
-  entry->value = SCM_UNPACK (value);
+  if (SCM_UNPACK (value) != entry->value)
+{
+  entry->needs_flush = 1;
+  entry->value = SCM_UNPACK (value);
+}
   return;
 }
 
-  scm_cache_insert (_state->cache, fluid, value, );
+  scm_cache_insert (_state->cache, fluid, value, , 1);
 
-  if (evicted.key != 0)
+  if (evicted.key != 0 && evicted.needs_flush)
 {
   fluid = SCM_PACK (evicted.key);
   value = SCM_PACK (evicted.value);
@@ -300,7 +304,7 @@ fluid_ref (scm_t_dynamic_state *dynamic_state, SCM fluid)
 val = SCM_I_FLUID_DEFAULT (fluid);
 
   /* Cache this lookup.  */
-  fluid_set_x (dynamic_state, fluid, val);
+  fluid_set_x (dynamic_state, fluid, val, 0);
 }
 
   return val;
@@ -355,7 +359,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
 #define 

[Guile-commits] 03/03: Stringbufs immutable by default

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit d0934df1f2f0e5d3fa9a1a1f15e6f2dec1d15698
Author: Andy Wingo 
Date:   Thu Feb 16 12:57:46 2017 +0100

Stringbufs immutable by default

* libguile/snarf.h (SCM_IMMUTABLE_STRINGBUF): Remove shared flag.
  Stringbufs are immutable by default.
* libguile/strings.c: Rewrite blurb.  Change to have stringbufs be
  immutable by default and mutable only when marked as such.  Going
  mutable means making a private copy.
  (STRINGBUF_MUTABLE, STRINGBUF_F_MUTABLE): New definitions.
  (SET_STRINGBUF_SHARED): Remove.
  (scm_i_print_stringbuf): Simplify to just alias the stringbuf as-is.
  (substring_with_immutable_stringbuf): New helper.
  (scm_i_substring, scm_i_substring_read_only, scm_i_substring_copy):
  use new helper.
  (scm_i_string_ensure_mutable_x): New helper.
  (scm_i_substring_shared): Use scm_i_string_ensure_mutable_x.
  (stringbuf_write_mutex): Remove; yy.
  (scm_i_string_start_writing): Use scm_i_string_ensure_mutable_x.  No
  more mutex.
  (scm_i_string_stop_writing): Now a no-op.
  (scm_i_make_symbol): Use substring/copy.
  (scm_sys_string_dump, scm_sys_symbol_dump): Update.
* libguile/strings.h (SCM_I_STRINGBUF_F_SHARED): Remove.
  (SCM_I_STRINGBUF_F_MUTABLE): Add.
* module/system/vm/assembler.scm (link-data): Don't add shared flag any
  more.  Existing compiled flags are harmless tho.
* test-suite/tests/strings.test ("string internals"): Update.
---
 libguile/snarf.h   |   2 +-
 libguile/strings.c | 325 -
 libguile/strings.h |   2 +-
 module/system/vm/assembler.scm |   7 +-
 test-suite/tests/strings.test  |  34 -
 5 files changed, 157 insertions(+), 213 deletions(-)

diff --git a/libguile/snarf.h b/libguile/snarf.h
index d0b6833..aafd5bd 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -308,7 +308,7 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), 
(opt), (rest));)
   }\
   c_name = \
 {  \
-  scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED,\
+  scm_tc7_stringbuf,\
   sizeof (contents) - 1,   \
   contents \
 }
diff --git a/libguile/strings.c b/libguile/strings.c
index a153d29..e460a93 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -54,40 +54,34 @@ SCM_SYMBOL (sym_UTF_8, "UTF-8");
 SCM_SYMBOL (sym_ISO_8859_1, "ISO-8859-1");
 SCM_SYMBOL (sym_error, "error");
 
-/* Stringbufs 
- *
- * XXX - keeping an accurate refcount during GC seems to be quite
- * tricky, so we just keep score of whether a stringbuf might be
- * shared, not whether it definitely is.  
- *
- * The scheme I (mvo) tried to keep an accurate reference count would
- * recount all strings that point to a stringbuf during the mark-phase
- * of the GC.  This was done since one cannot access the stringbuf of
- * a string when that string is freed (in order to decrease the
- * reference count).  The memory of the stringbuf might have been
- * reused already for something completely different.
- *
- * This recounted worked for a small number of threads beating on
- * cow-strings, but it failed randomly with more than 10 threads, say.
- * I couldn't figure out what went wrong, so I used the conservative
- * approach implemented below.
- *
- * There are 2 storage strategies for stringbufs: 8-bit and wide.  8-bit
- * strings are ISO-8859-1-encoded strings; wide strings are 32-bit (UCS-4)
- * strings.
- */
+/* A stringbuf is a linear buffer of characters.  Every string has a
+   stringbuf.  Strings may reference just a slice of a stringbuf; that's
+   often the case for strings made by the "substring" function.
+
+   Stringbufs may hold either 8-bit characters or 32-bit characters.  In
+   either case the characters are Unicode codepoints.  "Narrow"
+   stringbufs thus have the ISO-8859-1 (Latin-1) encoding, and "wide"
+   stringbufs have the UTF-32 (UCS-4) encoding.
+
+   By default, stringbufs are immutable.  This enables an O(1)
+   "substring" operation with no synchronization.  A string-set! will
+   first ensure that the string's stringbuf is mutable, copying the
+   stringbuf if necessary.  This is therefore a copy-on-write
+   representation.  However, taking a substring of a mutable stringbuf
+   is an O(n) operation as it has to create a new immutable stringbuf.
+   There are also mutation-sharing substrings as well.  */
 
 /* The size in words of the stringbuf header (type tag + size).  */
 #define STRINGBUF_HEADER_SIZE   2U
 
 #define STRINGBUF_HEADER_BYTES  (STRINGBUF_HEADER_SIZE * sizeof (SCM))
 
-#define STRINGBUF_F_SHARED  SCM_I_STRINGBUF_F_SHARED
 #define 

[Guile-commits] 04/08: Fix sort, sort! for arrays with nonzero lower bound

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit b049717b31e4bfefd29d2b96970efc0c63d1bfbb
Author: Daniel Llorens 
Date:   Mon Feb 13 12:58:34 2017 +0100

Fix sort, sort! for arrays with nonzero lower bound

* module/ice-9/arrays.scm (array-copy, typed-array-copy): New
  functions. Export.
* module/Makefile.am: Install (ice-9 arrays).
* doc/ref/api-data.texi: Add documentation for (ice-9 arrays).
* libguile/quicksort.i.c: Use signed bounds throughout.
* libguile/sort.c (scm_restricted_vector_sort_x): Fix error calls. Fix
  calls to quicksort.
* test-suite/tests/sort.test: Actually test that the sorted results
  match the original data. Test cases for non-zero base index arrays for
  sort, sort!, and stable-sort!.
---
 doc/ref/api-data.texi  |  38 +
 libguile/quicksort.i.c |  48 
 libguile/sort.c|  43 ++-
 module/Makefile.am |   1 +
 module/ice-9/arrays.scm|  53 +++---
 test-suite/tests/sort.test | 133 -
 6 files changed, 194 insertions(+), 122 deletions(-)

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index f5c8798..bb4b9f7 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -7495,10 +7495,6 @@ same type, and have corresponding elements which are 
either
 @code{equal?} (@pxref{Equality}) in that all arguments must be arrays.
 @end deffn
 
-@c  FIXME: array-map! accepts no source arrays at all, and in that
-@c  case makes calls "(proc)".  Is that meant to be a documented
-@c  feature?
-@c
 @c  FIXME: array-for-each doesn't say what happens if the sources have
 @c  different index ranges.  The code currently iterates over the
 @c  indices of the first and expects the others to cover those.  That
@@ -7506,14 +7502,15 @@ same type, and have corresponding elements which are 
either
 @c  documented feature?
 
 @deffn {Scheme Procedure} array-map! dst proc src @dots{}
-@deffnx {Scheme Procedure} array-map-in-order! dst proc src1 @dots{} srcN
+@deffnx {Scheme Procedure} array-map-in-order! dst proc src @dots{}
 @deffnx {C Function} scm_array_map_x (dst, proc, srclist)
-Set each element of the @var{dst} array to values obtained from calls
-to @var{proc}.  The value returned is unspecified.
+Set each element of the @var{dst} array to values obtained from calls to
+@var{proc}.  The list of @var{src} arguments may be empty.  The value
+returned is unspecified.
 
-Each call is @code{(@var{proc} @var{elem1} @dots{} @var{elemN})},
-where each @var{elem} is from the corresponding @var{src} array, at
-the @var{dst} index.  @code{array-map-in-order!} makes the calls in
+Each call is @code{(@var{proc} @var{elem} @dots{})}, where each
+@var{elem} is from the corresponding @var{src} array, at the
+@var{dst} index.  @code{array-map-in-order!} makes the calls in
 row-major order, @code{array-map!} makes them in an unspecified order.
 
 The @var{src} arrays must have the same number of dimensions as
@@ -7565,6 +7562,27 @@ $\left(\matrix{%
 @end example
 @end deffn
 
+A few additional array functions are available in the module
+@code{(ice-9 arrays)}. They can be used with:
+
+@example
+(use-modules (ice-9 arrays))
+@end example
+
+@deffn {Scheme Procedure} array-copy src
+Return a new array with the same elements, type and shape as
+@var{src}. However, the array increments may not be the same as those of
+@var{src}. In the current implementation, the returned array will be in
+row-major order, but that might change in the future. Use
+@code{array-copy!} on an array of known order if that is a concern.
+@end deffn
+
+@deffn {Scheme Procedure} typed-array-copy type src
+Return a new array with the same elements and shape as @var{src}, but
+with the type given. This operation may fail if @var{type} is not
+compatible with the values in @var{src}.
+@end deffn
+
 @node Shared Arrays
 @subsubsection Shared Arrays
 
diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c
index cf1742e..5982672 100644
--- a/libguile/quicksort.i.c
+++ b/libguile/quicksort.i.c
@@ -27,7 +27,7 @@
reduces the probability of selecting a bad pivot value and eliminates
certain extraneous comparisons.
 
-   3. Only quicksorts NR_ELEMS / MAX_THRESH partitions, leaving insertion sort
+   3. Only quicksorts (UBND-LBND+1) / MAX_THRESH partitions, leaving insertion 
sort
to order the MAX_THRESH items within each partition.  This is a big win,
since insertion sort is faster for small, mostly sorted array segments.
 
@@ -54,33 +54,29 @@
 #defineSTACK_NOT_EMPTY  (stack < top)
 
 static void
-NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less)
+NAME (VEC_PARAM ssize_t lbnd, ssize_t ubnd, INC_PARAM SCM less)
 {
   /* Stack node declarations used to store unfulfilled partition obligations. 
*/
   typedef struct {
-size_t lo;
-size_t hi;
+ssize_t lo;
+ssize_t hi;
   } 

[Guile-commits] 02/08: Replace uniform-vector-read benchmark with bytevector-io benchmark

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit 433161f8dc2f0c0d5835807201b1ddbe9f9b2ebc
Author: Daniel Llorens 
Date:   Mon Feb 13 12:11:50 2017 +0100

Replace uniform-vector-read benchmark with bytevector-io benchmark

* benchmark-suite/benchmarks/uniform-vector-read.bm:
  Remove; uniform-vector-read! and uniform-vector-write were deprecated
  in 2.0 and are have been removed in 2.1.
* benchmark-suite/benchmarks/bytevector-io.bm: New benchmark.
* benchmark-suite/Makefile.am: Run the new benchmark.
---
 benchmark-suite/Makefile.am|  2 +-
 .../{uniform-vector-read.bm => bytevector-io.bm}   | 29 +++---
 2 files changed, 15 insertions(+), 16 deletions(-)

diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index 1222121..47bd036 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -1,5 +1,6 @@
 SCM_BENCHMARKS = benchmarks/0-reference.bm \
 benchmarks/arithmetic.bm   \
+benchmarks/bytevector-io.bm\
 benchmarks/bytevectors.bm  \
 benchmarks/chars.bm\
 benchmarks/continuations.bm\
@@ -13,7 +14,6 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm\
 benchmarks/srfi-13.bm  \
 benchmarks/structs.bm  \
 benchmarks/subr.bm \
-benchmarks/uniform-vector-read.bm  \
 benchmarks/vectors.bm  \
 benchmarks/vlists.bm   \
 benchmarks/write.bm\
diff --git a/benchmark-suite/benchmarks/uniform-vector-read.bm 
b/benchmark-suite/benchmarks/bytevector-io.bm
similarity index 64%
rename from benchmark-suite/benchmarks/uniform-vector-read.bm
rename to benchmark-suite/benchmarks/bytevector-io.bm
index 01b7478..7ae7c0e 100644
--- a/benchmark-suite/benchmarks/uniform-vector-read.bm
+++ b/benchmark-suite/benchmarks/bytevector-io.bm
@@ -1,6 +1,6 @@
-;;; uniform-vector-read.bm --- Exercise binary I/O primitives.  -*- Scheme -*-
+;;; bytevector-io.bm --- Exercise bytevector I/O primitives.  -*- Scheme -*-
 ;;;
-;;; Copyright (C) 2008 Free Software Foundation, Inc.
+;;; Copyright (C) 2008, 2017 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -17,9 +17,10 @@
 ;;; not, write to the Free Software Foundation, Inc., 51 Franklin
 ;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(define-module (benchmarks uniform-vector-read)
+(define-module (benchmarks bytevector-io)
   :use-module (benchmark-suite lib)
-  :use-module (srfi srfi-4))
+  :use-module (rnrs io ports)
+  :use-module (rnrs bytevectors))
 
 (define file-name
   (tmpnam))
@@ -30,24 +31,22 @@
 (define buf
   (make-u8vector %buffer-size))
 
-(define str
-  (make-string %buffer-size))
-
 
-(with-benchmark-prefix "uniform-vector-read!"
+(with-benchmark-prefix "bytevector i/o"
 
-  (benchmark "uniform-vector-write" 4000
+  (benchmark "put-bytevector" 4000
 (let ((output (open-output-file file-name)))
-  (uniform-vector-write buf output)
+  (put-bytevector output buf)
   (close output)))
 
-  (benchmark "uniform-vector-read!" 2
+  (benchmark "get-bytevector-n!" 2
 (let ((input (open-input-file file-name)))
   (setvbuf input 'none)
-  (uniform-vector-read! buf input)
+  (get-bytevector-n! input buf 0 (bytevector-length buf))
   (close input)))
 
-  (benchmark "string port" 5000
-(let ((input (open-input-string str)))
-  (uniform-vector-read! buf input)
+  (benchmark "get-bytevector-n" 2
+(let ((input (open-input-file file-name)))
+  (setvbuf input 'none)
+  (get-bytevector-n input (bytevector-length buf))
   (close input

[Guile-commits] 03/08: Remove documentation on uniform-vector-read!, uniform-vector-write

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit 11ba42324c69ecbe9afd6fd302308f556d0b9e1b
Author: Daniel Llorens 
Date:   Mon Feb 13 13:21:59 2017 +0100

Remove documentation on uniform-vector-read!, uniform-vector-write

* NEWS: Add specific removal notice.
* doc/ref/api-data.texi: Remove documentation on uniform-vector-read!,
  uniform-vector-write.
---
 NEWS  |  7 +++
 doc/ref/api-data.texi | 33 -
 2 files changed, 7 insertions(+), 33 deletions(-)

diff --git a/NEWS b/NEWS
index 46b09b9..ec7184c 100644
--- a/NEWS
+++ b/NEWS
@@ -701,6 +701,13 @@ All code deprecated in Guile 2.0 has been removed.  See 
older NEWS, and
 check that your programs can compile without linker warnings and run
 without runtime warnings.  See "Deprecation" in the manual.
 
+In particular, the following functions, which were deprecated in 2.0.10
+but not specifically mentioned earlier in this file, have been removed:
+
+*** `uniform-vector-read!' and `uniform-vector-write' have been
+removed. Use `get-bytevector-n!' and `put-bytevector' from (rnrs io
+ports) instead.
+
 ** Remove miscellaneous unused interfaces
 
 We have removed accidentally public, undocumented interfaces that we
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 1b3170e..f5c8798 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -7565,39 +7565,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
 

[Guile-commits] 07/08: Remove scm_generalized_vector_get_handle

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit 2ed22db06479ef84a553be969c24eea0824a9007
Author: Daniel Llorens 
Date:   Mon Feb 13 18:17:11 2017 +0100

Remove scm_generalized_vector_get_handle

This was deprecated in 2.0.9 (118ff892be199f0af359d1b027645d4783a364ec).

* libguile/bitvectors.c (scm_bitvector_writable_elements): Replace
  scm_generalized_vector_get_handle.
  Remove unnecessary #includes.
* libguile/vectors.c (scm_vector_writable_elements): Replace
  scm_generalized_vector_get_handle.
  Remove unnecessary #includes.
* libguile/random.c (scm_random_normal_vector_x): Replace
  scm_generalized_vector_get_handle.
* libguile/generalized-vectors.h, libguile/generalized-vectors.c
  (scm_generalized_vector_get_handle): Remove.
  Remove unnecessary #includes.
* NEWS: Add removal notice.
---
 NEWS   |  4 
 libguile/bitvectors.c  | 10 ++
 libguile/generalized-vectors.c | 13 -
 libguile/generalized-vectors.h |  7 ++-
 libguile/random.c  |  8 +++-
 libguile/vectors.c | 14 --
 6 files changed, 27 insertions(+), 29 deletions(-)

diff --git a/NEWS b/NEWS
index ec7184c..898f1dd 100644
--- a/NEWS
+++ b/NEWS
@@ -708,6 +708,10 @@ but not specifically mentioned earlier in this file, have 
been removed:
 removed. Use `get-bytevector-n!' and `put-bytevector' from (rnrs io
 ports) instead.
 
+*** `scm_generalized_vector_get_handle' has been removed. Use
+`scm_array_get_handle' to get a handle and `scm_array_handle_rank'
+to check the rank.
+
 ** Remove miscellaneous unused interfaces
 
 We have removed accidentally public, undocumented interfaces that we
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 7a4ed9b..0dde67b 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -27,12 +27,9 @@
 
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
-#include "libguile/strings.h"
 #include "libguile/array-handle.h"
 #include "libguile/bitvectors.h"
 #include "libguile/arrays.h"
-#include "libguile/generalized-vectors.h"
-#include "libguile/srfi-4.h"
 
 /* Bit vectors. Would be nice if they were implemented on top of bytevectors,
  * but alack, all we have is this crufty C.
@@ -204,7 +201,12 @@ scm_bitvector_writable_elements (SCM vec,
 size_t *lenp,
 ssize_t *incp)
 {
-  scm_generalized_vector_get_handle (vec, h);
+  scm_array_get_handle (vec, h);
+  if (1 != scm_array_handle_rank (h))
+{
+  scm_array_handle_release (h);
+  scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 bit array");
+}
   if (offp)
 {
   scm_t_array_dim *dim = scm_array_handle_dims (h);
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 276b9d8..68c1042 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -27,8 +27,6 @@
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
 
-#include "libguile/array-handle.h"
-#include "libguile/generalized-arrays.h"
 #include "libguile/generalized-vectors.h"
 
 
@@ -70,17 +68,6 @@ SCM_DEFINE (scm_make_generalized_vector, 
"make-generalized-vector", 2, 1, 0,
 #undef FUNC_NAME
 
 void
-scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
-{
-  scm_array_get_handle (vec, h);
-  if (scm_array_handle_rank (h) != 1)
-{
-  scm_array_handle_release (h);
-  scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
-}
-}
-
-void
 scm_init_generalized_vectors ()
 {
 #include "libguile/generalized-vectors.x"
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
index 77d6272..9df8a0c 100644
--- a/libguile/generalized-vectors.h
+++ b/libguile/generalized-vectors.h
@@ -3,7 +3,8 @@
 #ifndef SCM_GENERALIZED_VECTORS_H
 #define SCM_GENERALIZED_VECTORS_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013
+ * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -24,15 +25,11 @@
 
 
 #include "libguile/__scm.h"
-#include "libguile/array-handle.h"
 
 
 
 /* Generalized vectors */
 
-SCM_API void scm_generalized_vector_get_handle (SCM vec,
-   scm_t_array_handle *h);
-
 SCM_API SCM scm_make_generalized_vector (SCM type, SCM len, SCM fill);
 SCM_INTERNAL void scm_i_register_vector_constructor (SCM type, SCM 
(*ctor)(SCM, SCM));
 
diff --git a/libguile/random.c b/libguile/random.c
index 1ee0459..a8ad075 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -621,7 +621,13 @@ SCM_DEFINE (scm_random_normal_vector_x, 
"random:normal-vector!", 1, 1, 0,
 state = SCM_VARIABLE_REF 

[Guile-commits] 05/08: Support non-zero lower bounds in array-slice-for-each

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit 592d6aa32dfdfbaa0c0130a4017201c761a6
Author: Daniel Llorens 
Date:   Mon Feb 13 13:49:35 2017 +0100

Support non-zero lower bounds in array-slice-for-each

* libguile/array-handle.c (scm_array_handle_writable_elements): Fix
  error message.
* libguile/array-map.c (scm_array_slice_for_each): Support non-zero
  lower bounds. Fix error messages.
* test-suite/tests/array-map.test: Test scm_array_slice_for_each with
  non-zero lower bound argument.
---
 libguile/array-handle.c |  2 +-
 libguile/array-map.c| 22 +-
 test-suite/tests/array-map.test |  8 
 3 files changed, 18 insertions(+), 14 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 89277d9..4c2fe0e 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -327,7 +327,7 @@ SCM *
 scm_array_handle_writable_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");
+scm_wrong_type_arg_msg (NULL, 0, h->array, "array of Scheme values");
   return ((SCM*)h->elements) + h->base;
 }
 
diff --git a/libguile/array-map.c b/libguile/array-map.c
index c2825bc..b6529c0 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -677,6 +677,7 @@ SCM_DEFINE (scm_array_slice_for_each, 
"array-slice-for-each", 2, 0, 1,
 "@end lisp")
 #define FUNC_NAME s_scm_array_slice_for_each
 {
+  SCM xargs = args;
   int const N = scm_ilength (args);
   int const frank = scm_to_int (frame_rank);
   int ocd;
@@ -740,9 +741,9 @@ SCM_DEFINE (scm_array_slice_for_each, 
"array-slice-for-each", 2, 0, 1,
   assert((pool0+pool_size==pool) && "internal error");
 #undef AFIC_ALLOC_ADVANCE
 
-  for (n=0; scm_is_pair(args); args=scm_cdr(args), ++n)
+  for (n=0, xargs=args; scm_is_pair(xargs); xargs=scm_cdr(xargs), ++n)
 {
-  args_[n] = scm_car(args);
+  args_[n] = scm_car(xargs);
   scm_array_get_handle(args_[n], ah+n);
   as[n] = scm_array_handle_dims(ah+n);
   rank[n] = scm_array_handle_rank(ah+n);
@@ -750,29 +751,24 @@ SCM_DEFINE (scm_array_slice_for_each, 
"array-slice-for-each", 2, 0, 1,
   /* checks */
   msg = NULL;
   if (frank<0)
-msg = "bad frame rank";
+msg = "bad frame rank ~S, ~S";
   else
 {
   for (n=0; n!=N; ++n)
 {
   if (rank[n]typed-array 'f64 2 '((9 1) (7 8

[Guile-commits] 06/08: Fix bitvectors and non-zero lower bound arrays in truncated-print

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit 954c741c7a24924d632eb2ae91c76988f96732a0
Author: Daniel Llorens 
Date:   Mon Feb 13 14:03:30 2017 +0100

Fix bitvectors and non-zero lower bound arrays in truncated-print

* module/ice-9/arrays.scm (array-print-prefix, array-print): New private
  functions.
* libguile/arrays.c (scm_i_print_array): Reuse (array-print-prefix) from
  (ice-9 arrays). Make sure to release the array handle.
* module/ice-9/pretty-print.scm (truncated-print): Support
  bitvectors.
  Don't try to guess the array prefix but call array-print-prefix from
  (ice-9 arrays) instead.
  Fix call to print-sequence to support non-zero lower bound arrays.
* test-suite/tests/arrays.test: Test that arrays print properly.
* test-suite/tests/print.test: Test truncated-print with bitvectors,
  non-zero lower bound arrays.
---
 libguile/arrays.c | 48 ++-
 module/ice-9/arrays.scm   | 66 ++-
 module/ice-9/pretty-print.scm | 26 +++--
 test-suite/tests/arrays.test  | 55 +++-
 test-suite/tests/print.test   | 58 +++--
 5 files changed, 196 insertions(+), 57 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 8b8bc48..682fbf6 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -908,50 +908,17 @@ scm_i_print_array_dimension (scm_t_array_handle *h, int 
dim, int pos,
   return 1;
 }
 
-/* Print an array.
-*/
-
 int
 scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
 {
   scm_t_array_handle h;
-  size_t i;
-  int print_lbnds = 0, zero_size = 0, print_lens = 0;
+  int d;
 
+  scm_call_2 (scm_c_private_ref ("ice-9 arrays", "array-print-prefix"),
+  array, port);
+  
   scm_array_get_handle (array, );
 
-  scm_putc ('#', port);
-  if (SCM_I_ARRAYP (array))
-scm_intprint (h.ndims, 10, port);
-  if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
-scm_write (scm_array_handle_element_type (), port);
-
-  for (i = 0; i < h.ndims; i++)
-{
-  if (h.dims[i].lbnd != 0)
-   print_lbnds = 1;
-  if (h.dims[i].ubnd - h.dims[i].lbnd + 1 == 0)
-   zero_size = 1;
-  else if (zero_size)
-   print_lens = 1;
-}
-
-  if (print_lbnds || print_lens)
-for (i = 0; i < h.ndims; i++)
-  {
-   if (print_lbnds)
- {
-   scm_putc ('@', port);
-   scm_intprint (h.dims[i].lbnd, 10, port);
- }
-   if (print_lens)
- {
-   scm_putc (':', port);
-   scm_intprint (h.dims[i].ubnd - h.dims[i].lbnd + 1,
- 10, port);
- }
-  }
-
   if (h.ndims == 0)
 {
   /* Rank zero arrays, which are really just scalars, are printed
@@ -977,10 +944,13 @@ scm_i_print_array (SCM array, SCM port, scm_print_state 
*pstate)
   scm_putc ('(', port);
   scm_i_print_array_dimension (, 0, 0, port, pstate);
   scm_putc (')', port);
-  return 1;
+  d = 1;
 }
   else
-return scm_i_print_array_dimension (, 0, 0, port, pstate);
+d = scm_i_print_array_dimension (, 0, 0, port, pstate);
+
+  scm_array_handle_release ();
+  return d;
 }
 
 void
diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm
index 5d5276c..4850522 100644
--- a/module/ice-9/arrays.scm
+++ b/module/ice-9/arrays.scm
@@ -17,6 +17,8 @@
 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
 (define-module (ice-9 arrays)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
   #:export (array-copy typed-array-copy))
 
 ; This is actually defined in boot-9.scm, apparently for b.c.
@@ -24,7 +26,7 @@
 ;;   (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
 ;;(array-dimensions a)))
 
-; FIXME writes over the array twice if (array-type) is #t
+;; FIXME writes over the array twice if (array-type) is #t
 (define (typed-array-copy t a)
   (let ((b (apply make-typed-array t *unspecified* (array-shape a
 (array-copy! a b)
@@ -33,3 +35,65 @@
 (define (array-copy a)
   (typed-array-copy (array-type a) a))
 
+
+;; Printing arrays
+;; FIXME replace scm_i_print_array() when performance allows.
+
+(define (array-print-prefix a port)
+  (put-char port #\#)
+  (display (array-rank a) port)
+  (let ((t (array-type a)))
+(unless (eq? #t t)
+  (display t port)))
+  (let ((ss (array-shape a)))
+(let loop ((s ss) (slos? #f) (szero? #f) (slens? #f))
+  (define lo caar)
+  (define hi cadar)
+  (if (null? s)
+(when (or slos? slens?)
+  (pair-for-each (lambda (s)
+   (when slos?
+ (put-char port #\@)
+ (display (lo s) port))
+   (when slens?
+ (put-char port #\:)
+ 

[Guile-commits] 08/08: (wip) give a handle into format used in exceptions

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit b0d9386a43709c1859c41ab31747c0d3ed58dabc
Author: Daniel Llorens 
Date:   Tue Feb 7 12:42:20 2017 +0100

(wip) give a handle into format used in exceptions
---
 module/ice-9/boot-9.scm | 43 +++
 1 file changed, 23 insertions(+), 20 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 229d917..5e1b98f 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -339,6 +339,7 @@ a-cont
 ;; let format alias simple-format until the more complete version is loaded
 
 (define format simple-format)
+(define exception-format simple-format)
 
 ;; this is scheme wrapping the C code so the final pred call is a tail call,
 ;; per SRFI-13 spec
@@ -770,7 +771,7 @@ information is unavailable."
((not (car args)) 1)
(else 0
  (else
-  (format (current-error-port) "guile: uncaught throw to ~a: ~a\n"
+  (exception-format (current-error-port) "guile: uncaught throw to ~a: 
~a\n"
   key args)
   (primitive-exit 1
 
@@ -873,8 +874,8 @@ for key @var{k}, then invoke @var{thunk}."
   (let ((filename (or (cadr source) ""))
 (line (caddr source))
 (col (cdddr source)))
-(format port "~a:~a:~a: " filename (1+ line) col))
-  (format port "ERROR: "
+(exception-format port "~a:~a:~a: " filename (1+ line) col))
+  (exception-format port "ERROR: "
 
   (set! set-exception-printer!
 (lambda (key proc)
@@ -883,7 +884,7 @@ for key @var{k}, then invoke @var{thunk}."
   (set! print-exception
 (lambda (port frame key args)
   (define (default-printer)
-(format port "Throw to key `~a' with args `~s'." key args))
+(exception-format port "Throw to key `~a' with args `~s'." key 
args))
 
   (when frame
 (print-location frame port)
@@ -892,7 +893,7 @@ for key @var{k}, then invoke @var{thunk}."
   (lambda () (frame-procedure-name frame))
   (lambda _ #f
   (when name
-(format port "In procedure ~a:\n" name
+(exception-format port "In procedure ~a:\n" name
 
   (print-location frame port)
   (catch #t
@@ -902,7 +903,9 @@ for key @var{k}, then invoke @var{thunk}."
 (printer port key args default-printer)
 (default-printer
 (lambda (k . args)
-  (format port "Error while printing exception.")))
+  (exception-format
+   port "Error while printing exception `~a`: `~a' with args [~s]"
+   key k args)))
   (newline port)
   (force-output port
 
@@ -916,38 +919,38 @@ for key @var{k}, then invoke @var{thunk}."
 (apply (case-lambda
  ((subr msg args . rest)
   (if subr
-  (format port "In procedure ~a: " subr))
-  (apply format port msg (or args '(
+  (exception-format port "In procedure ~a: " subr))
+  (apply exception-format port msg (or args '(
  (_ (default-printer)))
args))
 
   (define (syntax-error-printer port key args default-printer)
 (apply (case-lambda
  ((who what where form subform . extra)
-  (format port "Syntax error:\n")
+  (exception-format port "Syntax error:\n")
   (if where
   (let ((file (or (assq-ref where 'filename) "unknown file"))
 (line (and=> (assq-ref where 'line) 1+))
 (col (assq-ref where 'column)))
-(format port "~a:~a:~a: " file line col))
-  (format port "unknown location: "))
+(exception-format port "~a:~a:~a: " file line col))
+  (exception-format port "unknown location: "))
   (if who
-  (format port "~a: " who))
-  (format port "~a" what)
+  (exception-format port "~a: " who))
+  (exception-format port "~a" what)
   (if subform
-  (format port " in subform ~s of ~s" subform form)
+  (exception-format port " in subform ~s of ~s" subform form)
   (if form
-  (format port " in form ~s" form
+  (exception-format port " in form ~s" form
  (_ (default-printer)))
args))
 
   (define (keyword-error-printer port key args default-printer)
 (let ((message (cadr args))
   (faulty  (car (cadddr args ; I won't do it again, I promise.
-  (format port "~a: ~s" message faulty)))
+  (exception-format port "~a: ~s" message faulty)))
 
   (define 

[Guile-commits] 01/08: Remove unnecessary #include

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit 954646c6b5349f3a588b89b849e6e1a9bfb077d3
Author: Daniel Llorens 
Date:   Mon Feb 13 13:41:45 2017 +0100

Remove unnecessary #include

* libguile/vectors.c: Don't include arrays.h.
---
 libguile/vectors.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index b9613c5..5e53bf4 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -29,7 +29,6 @@
 
 #include "libguile/validate.h"
 #include "libguile/vectors.h"
-#include "libguile/arrays.h" /* Hit me with the ugly stick */
 #include "libguile/generalized-vectors.h"
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"

[Guile-commits] branch wip-exception-truncate updated (9652532 -> b0d9386)

[Daniel Llorens]

lloda pushed a change to branch wip-exception-truncate
in repository guile.

  discards  9652532   (wip) give a handle into format used in exceptions
  discards  a6b52c0   Remove scm_generalized_vector_get_handle
  discards  1053ee0   Fix bitvectors and non-zero lower bound arrays in 
truncated-print
  discards  88b249d   Support non-zero lower bounds in array-slice-for-each
  discards  dbf4a2f   Fix sort, sort! for arrays with nonzero lower bound
  discards  0a43c48   Remove documentation on uniform-vector-read!, 
uniform-vector-write
  discards  aa477f2   Replace uniform-vector-read benchmark with bytevector-io 
benchmark
  discards  86b172b   Remove unnecessary #include
  adds  7e64159   Update Gnulib to v0.1-1157-gb03f418.
  adds  9399c13   Switch to accept4
  adds  6e09651   Add accept4 support
  adds  4706d69   Fix accept4 gnulib update.
   new  954646c   Remove unnecessary #include
   new  433161f   Replace uniform-vector-read benchmark with bytevector-io 
benchmark
   new  11ba423   Remove documentation on uniform-vector-read!, 
uniform-vector-write
   new  b049717   Fix sort, sort! for arrays with nonzero lower bound
   new  592d6aa   Support non-zero lower bounds in array-slice-for-each
   new  954c741   Fix bitvectors and non-zero lower bound arrays in 
truncated-print
   new  2ed22db   Remove scm_generalized_vector_get_handle
   new  b0d9386   (wip) give a handle into format used in exceptions

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   (9652532)
\
 N -- N -- N   refs/heads/wip-exception-truncate (b0d9386)

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 8 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:
 .gitignore |   2 +
 GNUmakefile|   2 +-
 build-aux/announce-gen |   2 +-
 build-aux/config.rpath |   2 +-
 build-aux/gendocs.sh   |   6 +-
 build-aux/git-version-gen  |   6 +-
 build-aux/gitlog-to-changelog  |   2 +-
 build-aux/gnu-web-doc-update   |   2 +-
 build-aux/gnupload |   2 +-
 build-aux/snippet/arg-nonnull.h|   2 +-
 build-aux/snippet/c++defs.h|  89 +++--
 build-aux/snippet/warn-on-use.h|   2 +-
 build-aux/useless-if-before-free   |   7 +-
 build-aux/vc-list-files|   2 +-
 doc/gendocs_template   |   2 +-
 doc/gendocs_template_min   |   2 +-
 doc/ref/posix.texi |   6 +-
 lib/Makefile.am|  80 +++-
 lib/accept.c   |   2 +-
 lib/accept4.c  | 128 +++
 lib/alignof.h  |   2 +-
 lib/alloca.in.h|   4 +-
 lib/arpa_inet.in.h |   2 +-
 lib/asnprintf.c|   2 +-
 lib/assure.h   |   2 +-
 lib/basename-lgpl.c|   2 +-
 lib/binary-io.h|   2 +-
 lib/bind.c |   2 +-
 lib/btowc.c|   2 +-
 lib/byteswap.in.h  |   2 +-
 lib/c-ctype.h  |  22 +-
 lib/c-strcase.h|   2 +-
 lib/c-strcasecmp.c |   2 +-
 lib/c-strcaseeq.h  |   2 +-
 lib/c-strncasecmp.c|   2 +-
 lib/canonicalize-lgpl.c|  39 +-
 lib/ceil.c |   2 +-
 lib/close.c|   2 +-
 lib/config.charset |   2 +-
 lib/connect.c  |   2 +-
 lib/copysign.c |   2 +-
 lib/dirent.in.h|   2 +-
 lib/dirfd.c|   2 +-
 lib/dirname-lgpl.c |   2 +-
 lib/dirname.h  |   2 +-
 lib/dosname.h  |   2 +-
 lib/dup2.c |   2 +-
 lib/duplocale.c|   2 +-
 lib/errno.in.h |   2 +-
 lib/fcntl.in.h |   2 +-
 lib/fd-hook.c  |   2 +-
 lib/fd-hook.h  |   2 +-
 lib/flexmember.h   |  42 ++
 lib/float+.h   |   2 +-
 lib/float.c|   2 +-
 lib/float.in.h |   2 +-
 lib/flock.c