[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_clang.x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_clang.x86_64-linux’ has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/51772866 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_clang.i686-linux
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/51772871 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_disable_deprecated_disable_discouraged on x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_disable_deprecated_disable_discouraged’ (on x86_64-linux) has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/51772852 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_enable_guile_debug on x86_64-linux
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/51772856 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] branch master updated (f344ad6 -> 886ac3e)
civodul pushed a change to branch master in repository guile. from f344ad6 Bump version to 2.2.2. new 886ac3e SRFI-19: Swap seconds and nanoseconds in 'current-time-monotonic'. The 1 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: module/srfi/srfi-19.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-)
[Guile-commits] 01/01: SRFI-19: Swap seconds and nanoseconds in 'current-time-monotonic'.
civodul pushed a commit to branch master in repository guile. commit 886ac3e2abce89bd3f47f957c36bcec16613c509 Author: Ludovic Courtès Date: Sat Apr 22 00:58:10 2017 +0200 SRFI-19: Swap seconds and nanoseconds in 'current-time-monotonic'. * module/srfi/srfi-19.scm (current-time-monotonic): Swap the 2nd and 3rd arguments. Fixes a regression introduced in commit b11e2922c36c4105797c269c7e616535b702698a. --- module/srfi/srfi-19.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm index c6a55a2..9cf9a2e 100644 --- a/module/srfi/srfi-19.scm +++ b/module/srfi/srfi-19.scm @@ -336,8 +336,8 @@ ;; Guile monotonic and TAI times are the same. (let ((tai (current-time-tai))) (make-time time-monotonic - (time-second tai) - (time-nanosecond tai + (time-nanosecond tai) + (time-second tai (define (current-time-thread) (time-error 'current-time 'unsupported-clock-type 'time-thread))
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build.x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:build.x86_64-linux’ has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/51772879 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build.i686-linux
Hi, The status of Hydra job ‘gnu:guile-master:build.i686-linux’ has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/51772843 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_without_threads.x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_without_threads.x86_64-linux’ has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/51772869 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_without_threads.i686-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_without_threads.i686-linux’ has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/51772836 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:tarball on x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:tarball’ (on x86_64-linux) has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/51772859 This may be due to 5 commits by Andy Wingo . Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] 02/02: Bump version to 2.2.2.
wingo pushed a commit to branch master
in repository guile.
commit f344ad631d5c76c76e5e7aa0f3e355b968ab7273
Author: Andy Wingo
Date: Fri Apr 21 15:41:58 2017 +0200
Bump version to 2.2.2.
* GUILE-VERSION: Bump to 2.2.2.
---
GUILE-VERSION | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/GUILE-VERSION b/GUILE-VERSION
index 98618c6..223a293 100644
--- a/GUILE-VERSION
+++ b/GUILE-VERSION
@@ -3,7 +3,7 @@
# Note: `GUILE_VERSION' is defined in `configure.ac' using `git-version-gen'.
GUILE_MAJOR_VERSION=2
GUILE_MINOR_VERSION=2
-GUILE_MICRO_VERSION=1
+GUILE_MICRO_VERSION=2
GUILE_EFFECTIVE_VERSION=2.2
@@ -16,7 +16,7 @@ GUILE_EFFECTIVE_VERSION=2.2
# See libtool info pages for more information on how and when to
# change these.
-LIBGUILE_INTERFACE_CURRENT=2
+LIBGUILE_INTERFACE_CURRENT=3
LIBGUILE_INTERFACE_REVISION=0
-LIBGUILE_INTERFACE_AGE=1
+LIBGUILE_INTERFACE_AGE=2
LIBGUILE_INTERFACE="${LIBGUILE_INTERFACE_CURRENT}:${LIBGUILE_INTERFACE_REVISION}:${LIBGUILE_INTERFACE_AGE}"
[Guile-commits] 01/02: Update NEWS some more
wingo pushed a commit to branch master in repository guile. commit fbaf8e98ff02503c077bc3bf55b48028c53cbeff Author: Andy Wingo Date: Fri Apr 21 15:41:25 2017 +0200 Update NEWS some more * NEWS: More updates. --- NEWS | 5 + 1 file changed, 5 insertions(+) diff --git a/NEWS b/NEWS index 663ba9f..d2c6197 100644 --- a/NEWS +++ b/NEWS @@ -23,6 +23,11 @@ relied on an interface that was added to our garbage collector (BDW-GC) after its 7.2 release. Guile 2.2.2 adds a workaround to allow Guile to continue be used with libgc as old as 7.2. +** SRFI-37 bug fix to not error on empty-string arguments. + +Thanks to Thomas Danckaert for fixing this long-standing bug. + + Changes in 2.2.1 (since 2.2.0):
[Guile-commits] annotated tag v2.2.2 created (now 5bd1bbc)
wingo pushed a change to annotated tag v2.2.2 in repository guile. at 5bd1bbc (tag) tagging f344ad631d5c76c76e5e7aa0f3e355b968ab7273 (commit) replaces v2.2.1 tagged by Andy Wingo on Fri Apr 21 15:42:18 2017 +0200 - Log - GNU Guile 2.2.2. -BEGIN PGP SIGNATURE- iQIzBAABCAAdFiEE/0ePsmTeMuwpZyWj3cD1NYgS+PIFAlj6DDoACgkQ3cD1NYgS +PIUCA//dPLd1rCKN2O8M2pDPg5JiBbj7KmgRSV+QO5zH5nxFbfIEdZIIQ4B2And ffMHyIlPTgcHQAc29owZebcEiPEQ0565y/AVQyrLas3bJUTqVv88JgR5x4QYE2e2 qfW8DqVBzMsOFFGz/7EPJBfHdGrjLejwBgKUYHrn86EMvbV/qeZaYy5WmHljUWkY e8QHoezVM6RcWMvm7l/ozajRrueZ7Ik4I5cQTNtJQBlqqUH/oSSlguj+oDokpyTs hb7nrjwHeMS8p1cEW2eFjBU3cqIC2DRpBfks+dwJIDK3NkyqkR+QZ4UcqnKwGXp3 hFvsSD28noWdwH58ioUPhi4b46e1ZvneOMtb+RR0/unTrU5sK/7hCW5WCeyRrQrV s0q0Y52PTCXxlyPGjA123wjD/cKpX5xTdH0s31h9oPe+9mKP7yrp3KxBydF8qT18 pmWyGy2n6UBj/W9Dm7YkZS/TH98KT0nUTMJVWUg2I3dF4GAOqK250vBwnnuLwnhm eqcesE6qwbgNyinaacdm/FVCVLBASech1OpNJsdXktDl6hxso3BL52+TiJ20kHu/ tJ+ayUuTmjkAI3P23QFzNKDjxx5AIcJSkbQGZcjUqx9VtXDBfMZH+NFT/B7QtCVQ neIJvlkkzHWwkcMniearYW+nC0oSJkE1TwslMAOO4Je1+rv3G8o= =1M0G -END PGP SIGNATURE- --- No new revisions were added by this update.
[Guile-commits] branch master updated (7e1d830 -> f344ad6)
wingo pushed a change to branch master in repository guile. from 7e1d830 Update NEWS. new fbaf8e9 Update NEWS some more new f344ad6 Bump version to 2.2.2. The 2 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: GUILE-VERSION | 6 +++--- NEWS | 5 + 2 files changed, 8 insertions(+), 3 deletions(-)
[Guile-commits] 01/08: Replace uniform-vector-read benchmark with bytevector-io benchmark
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit 50443b2c935bc2eae96ddd36ebdb0e9cedfe9e0e
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] 05/08: Fix bitvectors and non-zero lower bound arrays in truncated-print
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit e820bbbcae4ead9a616220e85e603502549ab499
Author: Daniel Llorens
Date: Tue Feb 21 12:23:35 2017 +0100
Fix bitvectors and non-zero lower bound arrays in truncated-print
* module/ice-9/arrays.scm (array-print-prefix): New private function.
* 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 | 40 -
module/ice-9/pretty-print.scm | 24 --
test-suite/tests/arrays.test | 55 +++-
test-suite/tests/print.test | 58 +--
5 files changed, 169 insertions(+), 56 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, &h);
- 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 (&h), 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 (&h, 0, 0, port, pstate);
scm_putc (')', port);
- return 1;
+ d = 1;
}
else
-return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+d = scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+
+ scm_array_handle_release (&h);
+ return d;
}
void
diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm
index 2c04b2e..f03eb35 100644
--- a/module/ice-9/arrays.scm
+++ b/module/ice-9/arrays.scm
@@ -17,9 +17,13 @@
;;; 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))
-; This is actually defined in boot-9.scm, apparently for b.c.
+;; This is actually defined in boot-9.scm, apparently for backwards
+;; compatibility.
+
;; (define (array-shape a)
;; (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
;;(array-dimensions a)))
@@ -30,3 +34,37 @@
(array-copy! a b)
b))
+
+;; Printing arrays
+
+;; The dimensions aren't printed out unless they cannot be deduced from
+;; the content, which happens only when certain axes are empty. #:dims?
+;; can be used to force this printing. An array with all the dimensions
+;; printed out is still readable syntax, this can be useful for
+;; truncated-print.
+
+(define* (array-print-prefix a port #:key dims?)
+ (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? dims?))
+ (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] 07/08: Support general arrays in random:hollow-sphere!
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit f4d7038255ab721142334096bcf3c820e63c38d5
Author: Daniel Llorens
Date: Thu Mar 30 14:29:59 2017 +0200
Support general arrays in random:hollow-sphere!
* libguile/random.c (vector_scale_x, vector_sum_squares): Handle general
rank-1 #t or 'f64 arrays.
* test-suite/tests/random.test: Add tests for random:hollow-sphere!.
---
libguile/random.c| 105 ---
test-suite/tests/random.test | 37 ++-
2 files changed, 94 insertions(+), 48 deletions(-)
diff --git a/libguile/random.c b/libguile/random.c
index a8ad075..58791af 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -498,66 +498,77 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
}
#undef FUNC_NAME
+/* FIXME see scm_array_handle_ref for handling possible overflow */
static void
vector_scale_x (SCM v, double c)
{
- size_t n;
- if (scm_is_vector (v))
-{
- n = SCM_SIMPLE_VECTOR_LENGTH (v);
- while (n-- > 0)
- SCM_REAL_VALUE (SCM_SIMPLE_VECTOR_REF (v, n)) *= c;
-}
- else
-{
- /* must be a f64vector. */
- scm_t_array_handle handle;
- size_t i, len;
- ssize_t inc;
- double *elts;
-
- elts = scm_f64vector_writable_elements (v, &handle, &len, &inc);
+ scm_t_array_handle handle;
+ scm_t_array_dim const * dims;
+ ssize_t i, inc, ubnd;
- for (i = 0; i < len; i++, elts += inc)
- *elts *= c;
-
- scm_array_handle_release (&handle);
+ scm_array_get_handle (v, &handle);
+ dims = scm_array_handle_dims (&handle);
+ if (1 == scm_array_handle_rank (&handle))
+{
+ ubnd = dims[0].ubnd;
+ inc = dims[0].inc;
+ if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_F64)
+{
+ double *elts = (double *)(handle.writable_elements) + handle.base;
+ for (i = dims[0].lbnd; i <= ubnd; ++i, elts += inc)
+*elts *= c;
+ return;
+}
+ else if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM)
+{
+ SCM *elts = (SCM *)(handle.writable_elements) + handle.base;
+ for (i = dims[0].lbnd; i <= ubnd; ++i, elts += inc)
+SCM_REAL_VALUE (*elts) *= c;
+ return;
+}
}
+ scm_array_handle_release (&handle);
+ scm_misc_error (NULL, "must be a rank-1 array of type #t or 'f64",
scm_list_1 (v));
}
+/* FIXME see scm_array_handle_ref for handling possible overflow */
static double
vector_sum_squares (SCM v)
{
double x, sum = 0.0;
- size_t n;
- if (scm_is_vector (v))
-{
- n = SCM_SIMPLE_VECTOR_LENGTH (v);
- while (n-- > 0)
- {
- x = SCM_REAL_VALUE (SCM_SIMPLE_VECTOR_REF (v, n));
- sum += x * x;
- }
-}
- else
-{
- /* must be a f64vector. */
- scm_t_array_handle handle;
- size_t i, len;
- ssize_t inc;
- const double *elts;
-
- elts = scm_f64vector_elements (v, &handle, &len, &inc);
-
- for (i = 0; i < len; i++, elts += inc)
- {
- x = *elts;
- sum += x * x;
- }
+ scm_t_array_handle handle;
+ scm_t_array_dim const * dims;
+ ssize_t i, inc, ubnd;
- scm_array_handle_release (&handle);
+ scm_array_get_handle (v, &handle);
+ dims = scm_array_handle_dims (&handle);
+ if (1 == scm_array_handle_rank (&handle))
+{
+ ubnd = dims[0].ubnd;
+ inc = dims[0].inc;
+ if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_F64)
+{
+ const double *elts = (const double *)(handle.elements) + handle.base;
+ for (i = dims[0].lbnd; i <= ubnd; ++i, elts += inc)
+{
+ x = *elts;
+ sum += x * x;
+}
+ return sum;
+}
+ else if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM)
+{
+ const SCM *elts = (const SCM *)(handle.elements) + handle.base;
+ for (i = dims[0].lbnd; i <= ubnd; ++i, elts += inc)
+{
+ x = SCM_REAL_VALUE (*elts);
+ sum += x * x;
+}
+ return sum;
+}
}
- return sum;
+ scm_array_handle_release (&handle);
+ scm_misc_error (NULL, "must be an array of type #t or 'f64", scm_list_1 (v));
}
/* For the uniform distribution on the solid sphere, note that in
diff --git a/test-suite/tests/random.test b/test-suite/tests/random.test
index ab20b58..1492651 100644
--- a/test-suite/tests/random.test
+++ b/test-suite/tests/random.test
@@ -20,7 +20,8 @@
#:use-module ((system base compile) #:select (compile))
#:use-module (test-suite lib)
#:use-module (srfi srfi-4)
- #:use-module (srfi srfi-4 gnu))
+ #:use-module (srfi srfi-4 gnu)
+ #:use-module ((ice-9 control) #:select (let/ec)))
; see strings.test, arrays.test.
(define exception:wrong-type-arg
@@ -53,3 +54,37 @@
(random:normal-vector! b (random-state-from-platform))
(random:normal-vector! c (random-state
[Guile-commits] 06/08: Remove scm_generalized_vector_get_handle
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit 69f4e4ed9566201f9d7195ca71a81c1b693c4467
Author: Daniel Llorens
Date: Mon Feb 13 13:41:45 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 | 15 ---
6 files changed, 27 insertions(+), 30 deletions(-)
diff --git a/NEWS b/NEWS
index f1c9c23..ffa8ef5 100644
--- a/NEWS
+++ b/NEWS
@@ -787,6 +787,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 cfca4ab..a6527f5 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.
@@ -205,7 +202,12 @@ scm_bitvector_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 (scm_var_random_state);
SCM_VALIDATE_RSTATE (2, stat
[Guile-commits] 02/08: Remove documentation on uniform-vector-read!, uniform-vector-write
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit 3860357074daaa8c9a85466854e1757c6da9b5c3
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 663ba9f..f1c9c23 100644
--- a/NEWS
+++ b/NEWS
@@ -780,6 +780,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 7b10d34..c243b94 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -7568,39 +7568,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] 04/08: Support non-zero lower bounds in array-slice-for-each
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit c6b3620ee21e60d5388d1fc3679b9f7fd860d7aa
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-map.c| 22 +-
test-suite/tests/array-map.test | 8
2 files changed, 17 insertions(+), 13 deletions(-)
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 7938396..d2cd651 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -679,6 +679,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;
@@ -742,9 +743,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);
@@ -752,29 +753,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] branch wip-exception-truncate updated (e100132 -> 2ca7955)
lloda pushed a change to branch wip-exception-truncate in repository guile. discards e100132 (wip) give a handle into format used in exceptions discards c36113d Support general arrays in random:hollow-sphere! discards 2454115 Remove scm_generalized_vector_get_handle discards fd01113 Fix bitvectors and non-zero lower bound arrays in truncated-print discards ac3b000 Support non-zero lower bounds in array-slice-for-each discards 09aed64 Fix sort, sort! for arrays with nonzero lower bound discards 2b93eab Remove documentation on uniform-vector-read!, uniform-vector-write discards 56ccf0f Replace uniform-vector-read benchmark with bytevector-io benchmark adds 7e218d3 i18n: rename locale-monetary-digit-grouping to locale-monetary-grouping adds 7c7cc11 i18n: add tests for locale AM/PM adds 7268048 i18n: add tests for locale-digit-grouping adds c818684 i18n: add debugging helper procedure for locales adds dc9d147 i18n: locale-positive-separated-by-space? should return bool, not string adds 5d2aa5f i18n: add international sign positions to %locale-dump adds bcfc3f2 Git ignore .exe files adds 6ba3f35 Plumbing changes to rename "syntax-module" adds 64c5cc5 Add disjoint syntax object type adds eb84c2f Beginnings of psyntax switch to new syntax objects adds a42bfae Psyntax generates new syntax objects adds ce934bc Add allow-legacy-syntax-objects? parameter adds cee0e3f fix repl server test to allow for ECONNABORTED adds 39339c9 Speed up procedure-minimum-arity for fixed arity adds 685ca33 Only run tests that require fork if it is provided adds d7778b3 types: Hide one of the 'bytevector->string' procedures. adds 6e573a0 Attempt to mutate residualized literal pair throws exception adds 7ed54fd All literal constants are read-only adds 622abec Update NEWS adds 7c71be0 Add sandboxed evaluation facility adds e0502f3 Bump objcode version in a compatible way adds 5c6b3c5 Fix test suite for constant literals change adds 6010792 Avoid causing GC when lookup up exception handler adds b11e292 SRFI-19 current-time-monotonic returns time of right type adds 1978085 Fixed bug: ~N mishandles small nanoseconds value adds 4b39c1a Fix date->string ~f operator to not emit leading zeros adds e264860 Add srfi-19 ~f regression test adds 0aa0281 Fix typo in fold-layout documentation adds 18cac76 Add --with-bdw-gc and update README adds 93b2bfd Document guile-2.2 cond-expand feature. adds a7428a3 Fixed bug: statprof flat display wasn't writing summary lines to port adds 5d5d3d7 Fix spurious warnings in net_db.c adds 410bb56 Documentation typo tweak adds e0933b5 api-procedures.texi: typo: 'an' -> 'on' adds f775ab3 guile-snarf: skip -g* arguments to avoid build failure adds 0065945 Update NEWS adds 7029243 Update release docs adds 3db21f5 GNU Guile 2.2.1. adds 40df57a Restore libgc 7.2 compatibility adds 02cf385 SRFI-37: Account for zero-length arguments. adds 2e5f7d8 Syntax objects are comparable with equal? adds 7e1d830 Update NEWS. new 50443b2 Replace uniform-vector-read benchmark with bytevector-io benchmark new 3860357 Remove documentation on uniform-vector-read!, uniform-vector-write new 4b570e0 Fix sort, sort! for arrays with nonzero lower bound new c6b3620 Support non-zero lower bounds in array-slice-for-each new e820bbb Fix bitvectors and non-zero lower bound arrays in truncated-print new 69f4e4e Remove scm_generalized_vector_get_handle new f4d7038 Support general arrays in random:hollow-sphere! new 2ca7955 (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 (e100132) \ N -- N -- N refs/heads/wip-exception-truncate (2ca7955) 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
[Guile-commits] 03/08: Fix sort, sort! for arrays with nonzero lower bound
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit 4b570e0f52c93bb1a05af5d133dee842c83e237f
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): New function, 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 | 32 +++
libguile/quicksort.i.c | 48
libguile/sort.c| 44 ++-
module/Makefile.am | 1 +
module/ice-9/arrays.scm| 50 ++---
test-suite/tests/sort.test | 133 -
6 files changed, 186 insertions(+), 122 deletions(-)
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index c243b94..2e087c3 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -7498,10 +7498,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
@@ -7509,14 +7505,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
@@ -7568,6 +7565,21 @@ $\left(\matrix{%
@end example
@end deffn
+An additional array function is available in the module
+@code{(ice-9 arrays)}. It 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
+
@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;
} stack_node;
static const char s_buggy_less[] = "buggy less predicate used when sorting";
- if (nr_elems == 0)
-/* Avoid lossage with unsigned arithmetic below. */
-return;
-
- if (nr_elems > MAX_THRESH)
+ if (ubnd-lbnd+1 > MAX_THRESH)
{
- size_t lo = 0;
- size_t hi = nr_elems
[Guile-commits] 08/08: (wip) give a handle into format used in exceptions
lloda pushed a commit to branch wip-exception-truncate
in repository guile.
commit 2ca7955983cb2475fbee1cebba5eb1ac48faced3
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 a70cd11..a090013 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -333,6 +333,7 @@ If returning early, return the return value of F."
;; 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)))
(def
[Guile-commits] branch master updated (02cf385 -> 7e1d830)
wingo pushed a change to branch master in repository guile. from 02cf385 SRFI-37: Account for zero-length arguments. new 2e5f7d8 Syntax objects are comparable with equal? new 7e1d830 Update NEWS. The 2 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: NEWS | 18 ++ libguile/eq.c| 11 +++ libguile/hash.c | 9 + test-suite/tests/syntax.test | 33 + 4 files changed, 71 insertions(+)
[Guile-commits] 02/02: Update NEWS.
wingo pushed a commit to branch master in repository guile. commit 7e1d830698950e373454a07dd514bce78c9bea33 Author: Andy Wingo Date: Fri Apr 21 11:20:35 2017 +0200 Update NEWS. * NEWS: Update. --- NEWS | 18 ++ 1 file changed, 18 insertions(+) diff --git a/NEWS b/NEWS index 1103fcb..663ba9f 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,24 @@ Please send Guile bug reports to bug-gu...@gnu.org. +Changes in 2.2.2 (since 2.2.1): + +* Bug fixes + +** Syntax objects are once more comparable with 'equal?' + +The syntax object change in 2.2.1 had the unintended effect of making +syntax objects no longer comparable with equal?. This release restores +the previous behavior. + +** Restore libgc dependency + +The change to throw exceptions when mutating literal constants partly +relied on an interface that was added to our garbage collector (BDW-GC) +after its 7.2 release. Guile 2.2.2 adds a workaround to allow Guile to +continue be used with libgc as old as 7.2. + + Changes in 2.2.1 (since 2.2.0): * Notable changes
[Guile-commits] 01/02: Syntax objects are comparable with equal?
wingo pushed a commit to branch master
in repository guile.
commit 2e5f7d8f6d8e0e66a964ec69ccdca4f737b0b018
Author: Andy Wingo
Date: Fri Apr 21 11:04:08 2017 +0200
Syntax objects are comparable with equal?
* libguile/eq.c (scm_equal_p, scm_raw_ihash): Add cases for syntax
objects, which should be comparable with equal?.
* test-suite/tests/syntax.test ("syntax objects"): Add tests.
---
libguile/eq.c| 11 +++
libguile/hash.c | 9 +
test-suite/tests/syntax.test | 33 +
3 files changed, 53 insertions(+)
diff --git a/libguile/eq.c b/libguile/eq.c
index bbb0616..4680de7 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -33,6 +33,7 @@
#include "libguile/vectors.h"
#include "libguile/hashtab.h"
#include "libguile/bytevectors.h"
+#include "libguile/syntax.h"
#include "libguile/struct.h"
#include "libguile/goops.h"
@@ -362,6 +363,16 @@ scm_equal_p (SCM x, SCM y)
case scm_tc7_vector:
case scm_tc7_wvect:
return scm_i_vector_equal_p (x, y);
+case scm_tc7_syntax:
+ if (scm_is_false (scm_equal_p (scm_syntax_wrap (x),
+ scm_syntax_wrap (y
+return SCM_BOOL_F;
+ if (scm_is_false (scm_equal_p (scm_syntax_module (x),
+ scm_syntax_module (y
+return SCM_BOOL_F;
+ x = scm_syntax_expression (x);
+ y = scm_syntax_expression (y);
+ goto tailrecurse;
}
/* Otherwise just return false. Dispatching to the generic is the wrong thing
diff --git a/libguile/hash.c b/libguile/hash.c
index d6ddb6b..6047084 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -35,6 +35,7 @@
#include "libguile/ports.h"
#include "libguile/strings.h"
#include "libguile/symbols.h"
+#include "libguile/syntax.h"
#include "libguile/vectors.h"
#include "libguile/validate.h"
@@ -333,6 +334,14 @@ scm_raw_ihash (SCM obj, size_t depth)
h ^= scm_raw_ihash (scm_c_vector_ref (obj, h % len), i);
return h;
}
+case scm_tc7_syntax:
+ {
+unsigned long h;
+h = scm_raw_ihash (scm_syntax_expression (obj), depth);
+h ^= scm_raw_ihash (scm_syntax_wrap (obj), depth);
+h ^= scm_raw_ihash (scm_syntax_module (obj), depth);
+return h;
+ }
case scm_tcs_cons_imcar:
case scm_tcs_cons_nimcar:
if (depth)
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index ffe8099..883004a 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -20,6 +20,7 @@
(define-module (test-suite test-syntax)
#:use-module (ice-9 regex)
#:use-module (ice-9 local-eval)
+ #:use-module ((system syntax) #:select (syntax?))
#:use-module (test-suite lib))
@@ -1617,6 +1618,38 @@
(length #'(x …
env
+(with-test-prefix "syntax objects"
+ (let ((interpreted (eval '#'(foo bar baz) (current-module)))
+(interpreted-bis (eval '#'(foo bar baz) (current-module)))
+(compiled ((@ (system base compile) compile) '#'(foo bar baz)
+ #:env (current-module
+;; Guile's expander doesn't wrap lists.
+(pass-if "interpreted syntax object?"
+ (and (list? interpreted)
+ (and-map syntax? interpreted)))
+(pass-if "compiled syntax object?"
+ (and (list? compiled)
+ (and-map syntax? compiled)))
+
+(pass-if "interpreted syntax objects are not vectors"
+ (not (vector? interpreted)))
+(pass-if "compiled syntax objects are not vectors"
+ (not (vector? compiled)))
+
+(pass-if-equal "syntax objects comparable with equal? (eval/eval)"
+interpreted interpreted-bis)
+(pass-if-equal "syntax objects comparable with equal? (eval/compile)"
+interpreted compiled)
+
+(pass-if-equal "syntax objects hash the same (eval/eval)"
+(hash interpreted most-positive-fixnum)
+ (hash interpreted-bis most-positive-fixnum))
+
+(pass-if-equal "syntax objects hash the same (eval/compile)"
+(hash interpreted most-positive-fixnum)
+ (hash compiled most-positive-fixnum
+
+
;;; Local Variables:
;;; eval: (put 'pass-if-syntax-error 'scheme-indent-function 1)
;;; eval: (put 'with-ellipsis 'scheme-indent-function 1)
