From 8a9b22e6ecbd394a276b04383f4cde9c17481c49 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 21 Jan 2013 17:04:09 +0100 Subject: [PATCH] deprecate generalized vectors in favor of arrays * libguile/generalized-arrays.h: * libguile/generalized-arrays.c (scm_c_array_length): (scm_array_length): New functions. * module/ice-9/deprecated.scm: * libguile/generalized-vectors.c: * libguile/generalized-vectors.h: * libguile/deprecated.h: * libguile/deprecated.c (scm_generalized_vector_p) (scm_generalized_vector_length, scm_generalized_vector_ref) (scm_generalized_vector_set_x, scm_generalized_vector_to_list): Deprecate. * libguile/uniform.c (scm_uniform_vector_to_list): Use scm_array_to_list. * module/ice-9/boot-9.scm (case): Arrays are generalized vectors. * module/srfi/srfi-4/gnu.scm (define-any->vector): Use the array functions instead of the generalized-vector functions. * test-suite/tests/arrays.test: Remove generalized-vector->list test; covered by array->list test. * test-suite/tests/bitvectors.test: * test-suite/tests/bytevectors.test: * test-suite/tests/srfi-4.test: Adapt to test using array interfaces instead of generalized-vector interfaces. * doc/ref/api-compound.texi: Remove generalized vector docs. * doc/ref/api-data.texi: * doc/ref/srfi-modules.texi: Adapt. --- doc/ref/api-compound.texi | 96 +++++-------------------------------- doc/ref/api-data.texi | 22 +++++---- doc/ref/srfi-modules.texi | 6 +-- libguile/deprecated.c | 84 +++++++++++++++++++++++++++++++- libguile/deprecated.h | 8 ++++ libguile/generalized-arrays.c | 32 ++++++++++++- libguile/generalized-arrays.h | 5 +- libguile/generalized-vectors.c | 68 +------------------------- libguile/generalized-vectors.h | 8 +--- libguile/uniform.c | 4 +- module/ice-9/boot-9.scm | 10 ++-- module/ice-9/deprecated.scm | 9 +++- module/srfi/srfi-4/gnu.scm | 8 ++-- test-suite/tests/arrays.test | 24 +--------- test-suite/tests/bitvectors.test | 3 +- test-suite/tests/bytevectors.test | 36 +++++++------- test-suite/tests/srfi-4.test | 38 +++++++-------- 17 files changed, 212 insertions(+), 249 deletions(-) diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi index be3d65f..9cd5468 100644 --- a/doc/ref/api-compound.texi +++ b/doc/ref/api-compound.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. @c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -@c 2007, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +@c 2007, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node Compound Data Types @@ -22,7 +22,6 @@ values can be looked up within them. * Lists:: Special list functions supported by Guile. * Vectors:: One-dimensional arrays of Scheme objects. * Bit Vectors:: Vectors of bits. -* Generalized Vectors:: Treating all vector-like things uniformly. * Arrays:: Matrices, etc. * VLists:: Vector-like lists. * Record Overview:: Walking through the maze of record APIs. @@ -993,9 +992,8 @@ are displayed as a sequence of @code{0}s and @code{1}s prefixed by #*00000000 @end example -Bit vectors are also generalized vectors, @xref{Generalized -Vectors}, and can thus be used with the array procedures, @xref{Arrays}. -Bit vectors are the special case of one dimensional bit arrays. +Bit vectors are the special case of one dimensional bit arrays, and can +thus be used with the array procedures, @xref{Arrays}. @deffn {Scheme Procedure} bitvector? obj @deffnx {C Function} scm_bitvector_p (obj) @@ -1163,74 +1161,6 @@ Like @code{scm_bitvector_elements}, but the pointer is good for reading and writing. @end deftypefn -@node Generalized Vectors -@subsection Generalized Vectors - -Guile has a number of data types that are generally vector-like: -strings, uniform numeric vectors, bytevectors, bitvectors, and of course -ordinary vectors of arbitrary Scheme values. These types are disjoint: -a Scheme value belongs to at most one of the five types listed above. - -If you want to gloss over this distinction and want to treat all four -types with common code, you can use the procedures in this section. -They work with the @emph{generalized vector} type, which is the union -of the five vector-like types. - -@deffn {Scheme Procedure} generalized-vector? obj -@deffnx {C Function} scm_generalized_vector_p (obj) -Return @code{#t} if @var{obj} is a vector, bytevector, string, -bitvector, or uniform numeric vector. -@end deffn - -@deffn {Scheme Procedure} generalized-vector-length v -@deffnx {C Function} scm_generalized_vector_length (v) -Return the length of the generalized vector @var{v}. -@end deffn - -@deffn {Scheme Procedure} generalized-vector-ref v idx -@deffnx {C Function} scm_generalized_vector_ref (v, idx) -Return the element at index @var{idx} of the -generalized vector @var{v}. -@end deffn - -@deffn {Scheme Procedure} generalized-vector-set! v idx val -@deffnx {C Function} scm_generalized_vector_set_x (v, idx, val) -Set the element at index @var{idx} of the -generalized vector @var{v} to @var{val}. -@end deffn - -@deffn {Scheme Procedure} generalized-vector->list v -@deffnx {C Function} scm_generalized_vector_to_list (v) -Return a new list whose elements are the elements of the -generalized vector @var{v}. -@end deffn - -@deftypefn {C Function} int scm_is_generalized_vector (SCM obj) -Return @code{1} if @var{obj} is a vector, string, -bitvector, or uniform numeric vector; else return @code{0}. -@end deftypefn - -@deftypefn {C Function} size_t scm_c_generalized_vector_length (SCM v) -Return the length of the generalized vector @var{v}. -@end deftypefn - -@deftypefn {C Function} SCM scm_c_generalized_vector_ref (SCM v, size_t idx) -Return the element at index @var{idx} of the generalized vector @var{v}. -@end deftypefn - -@deftypefn {C Function} void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val) -Set the element at index @var{idx} of the generalized vector @var{v} -to @var{val}. -@end deftypefn - -@deftypefn {C Function} void scm_generalized_vector_get_handle (SCM v, scm_t_array_handle *handle) -Like @code{scm_array_get_handle} but an error is signalled when @var{v} -is not of rank one. You can use @code{scm_array_handle_ref} and -@code{scm_array_handle_set} to read and write the elements of @var{v}, -or you can use functions like @code{scm_array_handle__elements} to -deal with specific types of vectors. -@end deftypefn - @node Arrays @subsection Arrays @tpindex Arrays @@ -1239,13 +1169,13 @@ deal with specific types of vectors. number of dimensions. Each cell can be accessed in constant time by supplying an index for each dimension. -In the current implementation, an array uses a generalized vector for -the actual storage of its elements. Any kind of generalized vector -will do, so you can have arrays of uniform numeric values, arrays of -characters, arrays of bits, and of course, arrays of arbitrary Scheme -values. For example, arrays with an underlying @code{c64vector} might -be nice for digital signal processing, while arrays made from a -@code{u8vector} might be used to hold gray-scale images. +In the current implementation, an array uses a vector of some kind for +the actual storage of its elements. Any kind of vector will do, so you +can have arrays of uniform numeric values, arrays of characters, arrays +of bits, and of course, arrays of arbitrary Scheme values. For example, +arrays with an underlying @code{c64vector} might be nice for digital +signal processing, while arrays made from a @code{u8vector} might be +used to hold gray-scale images. The number of dimensions of an array is called its @dfn{rank}. Thus, a matrix is an array of rank 2, while a vector has rank 1. When @@ -1267,9 +1197,9 @@ matrix with zero columns and 3 rows is different from a matrix with 3 columns and zero rows, which again is different from a vector of length zero. -Generalized vectors, such as strings, uniform numeric vectors, -bytevectors, bit vectors and ordinary vectors, are the special case of -one dimensional arrays. +The array procedures are all polymorphic, treating strings, uniform +numeric vectors, bytevectors, bit vectors and ordinary vectors as one +dimensional arrays. @menu * Array Syntax:: diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 21398f4..e74095e 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -4535,7 +4535,7 @@ R6RS (@pxref{R6RS I/O Ports}). * Bytevectors and Integer Lists:: Converting to/from an integer list. * Bytevectors as Floats:: Interpreting bytes as real numbers. * Bytevectors as Strings:: Interpreting bytes as Unicode strings. -* Bytevectors as Generalized Vectors:: Guile extension to the bytevector API. +* Bytevectors as Arrays:: Guile extension to the bytevector API. * Bytevectors as Uniform Vectors:: Bytevectors and SRFI-4. @end menu @@ -4921,25 +4921,27 @@ or UTF-32-decoded contents of bytevector @var{utf}. For UTF-16 and UTF-32, it defaults to big endian. @end deffn -@node Bytevectors as Generalized Vectors -@subsubsection Accessing Bytevectors with the Generalized Vector API +@node Bytevectors as Arrays +@subsubsection Accessing Bytevectors with the Array API As an extension to the R6RS, Guile allows bytevectors to be manipulated -with the @dfn{generalized vector} procedures (@pxref{Generalized -Vectors}). This also allows bytevectors to be accessed using the -generic @dfn{array} procedures (@pxref{Array Procedures}). When using -these APIs, bytes are accessed one at a time as 8-bit unsigned integers: +with the @dfn{array} procedures (@pxref{Arrays}). When using these +APIs, bytes are accessed one at a time as 8-bit unsigned integers: @example (define bv #vu8(0 1 2 3)) -(generalized-vector? bv) +(array? bv) @result{} #t -(generalized-vector-ref bv 2) +(array-rank bv) +@result{} 1 + +(array-ref bv 2) @result{} 2 -(generalized-vector-set! bv 2 77) +;; Note the different argument order on array-set!. +(array-set! bv 77 2) (array-ref bv 2) @result{} 77 diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 70a49c8..dff8ca9 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -1770,8 +1770,8 @@ Like @code{scm_vector_writable_elements} (@pxref{Vector Accessing from C}), but returns a pointer to the elements of a uniform numeric vector. @end deftypefn -Unless you really need to the limited generality of these functions, it is best -to use the type-specific functions, or the generalized vector accessors. +Unless you really need to the limited generality of these functions, it +is best to use the type-specific functions, or the array accessors. @node SRFI-4 and Bytevectors @subsubsection SRFI-4 - Relation to bytevectors diff --git a/libguile/deprecated.c b/libguile/deprecated.c index f0211a5..b5e7cf3 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -2,7 +2,7 @@ deprecate something, move it here when that is feasible. */ -/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 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 @@ -2839,6 +2839,88 @@ SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0, +SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0, + (SCM obj), + "Return @code{#t} if @var{obj} is a vector, string,\n" + "bitvector, or uniform numeric vector.") +#define FUNC_NAME s_scm_generalized_vector_p +{ + scm_c_issue_deprecation_warning + ("generalized-vector? is deprecated. Use array? and check the " + "array-rank instead."); + return scm_from_bool (scm_is_generalized_vector (obj)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0, + (SCM v), + "Return the length of the generalized vector @var{v}.") +#define FUNC_NAME s_scm_generalized_vector_length +{ + scm_c_issue_deprecation_warning + ("generalized-vector-length is deprecated. Use array-length instead."); + return scm_from_size_t (scm_c_generalized_vector_length (v)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0, + (SCM v, SCM idx), + "Return the element at index @var{idx} of the\n" + "generalized vector @var{v}.") +#define FUNC_NAME s_scm_generalized_vector_ref +{ + scm_c_issue_deprecation_warning + ("generalized-vector-ref is deprecated. Use array-ref instead."); + return scm_c_generalized_vector_ref (v, scm_to_size_t (idx)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0, + (SCM v, SCM idx, SCM val), + "Set the element at index @var{idx} of the\n" + "generalized vector @var{v} to @var{val}.") +#define FUNC_NAME s_scm_generalized_vector_set_x +{ + scm_c_issue_deprecation_warning + ("generalized-vector-set! is deprecated. Use array-set! instead. " + "Note the change in argument order!"); + scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0, + (SCM v), + "Return a new list whose elements are the elements of the\n" + "generalized vector @var{v}.") +#define FUNC_NAME s_scm_generalized_vector_to_list +{ + /* FIXME: This duplicates `array_to_list'. */ + SCM ret = SCM_EOL; + long inc; + ssize_t pos, i; + scm_t_array_handle h; + + scm_c_issue_deprecation_warning + ("generalized-vector->list is deprecated. Use array->list instead."); + + scm_generalized_vector_get_handle (v, &h); + + i = h.dims[0].ubnd - h.dims[0].lbnd + 1; + inc = h.dims[0].inc; + pos = (i - 1) * inc; + + for (; i > 0; i--, pos -= inc) + ret = scm_cons (h.impl->vref (&h, h.base + pos), ret); + + scm_array_handle_release (&h); + return ret; +} +#undef FUNC_NAME + + + + void scm_i_init_deprecated () { diff --git a/libguile/deprecated.h b/libguile/deprecated.h index de85c6f..1812dd0 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -847,6 +847,14 @@ SCM_DEPRECATED SCM scm_struct_vtable_tag (SCM handle); +SCM_DEPRECATED SCM scm_generalized_vector_p (SCM v); +SCM_DEPRECATED SCM scm_generalized_vector_length (SCM v); +SCM_DEPRECATED SCM scm_generalized_vector_ref (SCM v, SCM idx); +SCM_DEPRECATED SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val); +SCM_DEPRECATED SCM scm_generalized_vector_to_list (SCM v); + + + void scm_i_init_deprecated (void); #endif diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c index 3a0ce25..11675d4 100644 --- a/libguile/generalized-arrays.c +++ b/libguile/generalized-arrays.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 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 @@ -107,6 +107,36 @@ SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, #undef FUNC_NAME +size_t +scm_c_array_length (SCM array) +{ + scm_t_array_handle handle; + size_t res; + + scm_array_get_handle (array, &handle); + if (scm_array_handle_rank (&handle) < 1) + { + scm_array_handle_release (&handle); + scm_wrong_type_arg_msg (NULL, 0, array, "array of nonzero rank"); + } + res = handle.dims[0].ubnd - handle.dims[0].lbnd + 1; + scm_array_handle_release (&handle); + + return res; +} + +SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0, + (SCM array), + "Return the length of an array: the dimension of its first\n" + "dimension. It is an error to ask for the length of an\n" + "array of rank 0.") +#define FUNC_NAME s_scm_array_rank +{ + return scm_from_size_t (scm_c_array_length (array)); +} +#undef FUNC_NAME + + SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, (SCM ra), "@code{array-dimensions} is similar to @code{array-shape} but replaces\n" diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h index 1f9b6ad..6860cfd 100644 --- a/libguile/generalized-arrays.h +++ b/libguile/generalized-arrays.h @@ -3,7 +3,7 @@ #ifndef SCM_GENERALIZED_ARRAYS_H #define SCM_GENERALIZED_ARRAYS_H -/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 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 @@ -44,6 +44,9 @@ SCM_API SCM scm_typed_array_p (SCM v, SCM type); SCM_API size_t scm_c_array_rank (SCM ra); SCM_API SCM scm_array_rank (SCM ra); +SCM_API size_t scm_c_array_length (SCM ra); +SCM_API SCM scm_array_length (SCM ra); + SCM_API SCM scm_array_dimensions (SCM ra); SCM_API SCM scm_array_type (SCM ra); SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args); diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c index 4da0e88..5e3e552 100644 --- a/libguile/generalized-vectors.c +++ b/libguile/generalized-vectors.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, - * 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + * 2005, 2006, 2009, 2010, 2011, 2012, 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 @@ -83,16 +83,6 @@ scm_is_generalized_vector (SCM obj) return ret; } -SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is a vector, string,\n" - "bitvector, or uniform numeric vector.") -#define FUNC_NAME s_scm_generalized_vector_p -{ - return scm_from_bool (scm_is_generalized_vector (obj)); -} -#undef FUNC_NAME - #define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle) \ scm_generalized_vector_get_handle (val, handle) @@ -119,15 +109,6 @@ scm_c_generalized_vector_length (SCM v) return ret; } -SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0, - (SCM v), - "Return the length of the generalized vector @var{v}.") -#define FUNC_NAME s_scm_generalized_vector_length -{ - return scm_from_size_t (scm_c_generalized_vector_length (v)); -} -#undef FUNC_NAME - SCM scm_c_generalized_vector_ref (SCM v, size_t idx) { @@ -141,16 +122,6 @@ scm_c_generalized_vector_ref (SCM v, size_t idx) return ret; } -SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0, - (SCM v, SCM idx), - "Return the element at index @var{idx} of the\n" - "generalized vector @var{v}.") -#define FUNC_NAME s_scm_generalized_vector_ref -{ - return scm_c_generalized_vector_ref (v, scm_to_size_t (idx)); -} -#undef FUNC_NAME - void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val) { @@ -162,43 +133,6 @@ scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val) scm_array_handle_release (&h); } -SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0, - (SCM v, SCM idx, SCM val), - "Set the element at index @var{idx} of the\n" - "generalized vector @var{v} to @var{val}.") -#define FUNC_NAME s_scm_generalized_vector_set_x -{ - scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0, - (SCM v), - "Return a new list whose elements are the elements of the\n" - "generalized vector @var{v}.") -#define FUNC_NAME s_scm_generalized_vector_to_list -{ - /* FIXME: This duplicates `array_to_list'. */ - SCM ret = SCM_EOL; - long inc; - ssize_t pos, i; - scm_t_array_handle h; - - scm_generalized_vector_get_handle (v, &h); - - i = h.dims[0].ubnd - h.dims[0].lbnd + 1; - inc = h.dims[0].inc; - pos = (i - 1) * inc; - - for (; i > 0; i--, pos -= inc) - ret = scm_cons (h.impl->vref (&h, h.base + pos), ret); - - scm_array_handle_release (&h); - return ret; -} -#undef FUNC_NAME - void scm_init_generalized_vectors () { diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h index 71b58d2..e2acb98 100644 --- a/libguile/generalized-vectors.h +++ b/libguile/generalized-vectors.h @@ -3,7 +3,7 @@ #ifndef SCM_GENERALIZED_VECTORS_H #define SCM_GENERALIZED_VECTORS_H -/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 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 @@ -30,12 +30,6 @@ /* Generalized vectors */ -SCM_API SCM scm_generalized_vector_p (SCM v); -SCM_API SCM scm_generalized_vector_length (SCM v); -SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx); -SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val); -SCM_API SCM scm_generalized_vector_to_list (SCM v); - SCM_API int scm_is_generalized_vector (SCM obj); SCM_API size_t scm_c_generalized_vector_length (SCM v); SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx); diff --git a/libguile/uniform.c b/libguile/uniform.c index d3ecb1b..a58242d 100644 --- a/libguile/uniform.c +++ b/libguile/uniform.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 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 @@ -193,7 +193,7 @@ SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0, { if (!scm_is_uniform_vector (uvec)) scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector"); - return scm_generalized_vector_to_list (uvec); + return scm_array_to_list (uvec); } #undef FUNC_NAME diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index a22ac8b..7936e28 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -532,12 +532,10 @@ If there is no handler at all, Guile prints an error and then exits." datum (syntax->datum clause) (syntax->datum whole-expr))) - (if (memv datum seen) - (warn-datum 'duplicate-case-datum)) - (if (or (pair? datum) - (array? datum) - (generalized-vector? datum)) - (warn-datum 'bad-case-datum)) + (when (memv datum seen) + (warn-datum 'duplicate-case-datum)) + (when (or (pair? datum) (array? datum)) + (warn-datum 'bad-case-datum)) (cons datum seen)) seen (map syntax->datum #'(datums ...))))) diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 3d40193..56b9c04 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010, 2011, 2012, 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 @@ -71,7 +71,12 @@ process-define-module fluid-let-syntax set-system-module! - char-code-limit)) + char-code-limit + generalized-vector? + generalized-vector-length + generalized-vector-ref + generalized-vector-set! + generalized-vector->list)) ;;;; Deprecated definitions. diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm index 39d6350..7f595d6 100644 --- a/module/srfi/srfi-4/gnu.scm +++ b/module/srfi/srfi-4/gnu.scm @@ -1,6 +1,6 @@ ;;; Extensions to SRFI-4 -;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2011, 2012, 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 @@ -101,14 +101,14 @@ `(define (,(symbol-append 'any-> tag 'vector) obj) (cond ((,(symbol-append tag 'vector?) obj) obj) ((pair? obj) (,(symbol-append 'list-> tag 'vector) obj)) - ((generalized-vector? obj) - (let* ((len (generalized-vector-length obj)) + ((and (array? obj) (eqv? 1 (array-rank obj))) + (let* ((len (array-length obj)) (v (,(symbol-append 'make- tag 'vector) len))) (let lp ((i 0)) (if (< i len) (begin (,(symbol-append tag 'vector-set!) - v i (generalized-vector-ref obj i)) + v i (array-ref obj i)) (lp (1+ i))) v)))) (else (scm-error 'wrong-type-arg #f "" '() (list obj)))))) diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test index f13b1a2..adb0b78 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -1,6 +1,6 @@ ;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- ;;;; -;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 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 @@ -228,26 +228,6 @@ (array->list b)))) ;;; -;;; generalized-vector->list -;;; - -(with-test-prefix "generalized-vector->list" - (pass-if-equal '(1 2 3) (generalized-vector->list #s16(1 2 3))) - (pass-if-equal '(1 2 3) (generalized-vector->list #(1 2 3))) - (pass-if-equal '() (generalized-vector->list #())) - - (pass-if-equal "http://bugs.gnu.org/12465 - ok" - '(3 4) - (let* ((a #2((1 2) (3 4))) - (b (make-shared-array a (lambda (j) (list 1 j)) 2))) - (generalized-vector->list b))) - (pass-if-equal "http://bugs.gnu.org/12465 - bad" - '(2 4) - (let* ((a #2((1 2) (3 4))) - (b (make-shared-array a (lambda (i) (list i 1)) 2))) - (generalized-vector->list b)))) - -;;; ;;; array-fill! ;;; @@ -649,6 +629,4 @@ (pass-if (equal? (array-row array 1) #u32(2 3))) (pass-if (equal? (array-ref (array-row array 1) 0) - 2)) - (pass-if (equal? (generalized-vector-ref (array-row array 1) 0) 2)))) diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test index c16fb4d..4e32c61 100644 --- a/test-suite/tests/bitvectors.test +++ b/test-suite/tests/bitvectors.test @@ -1,6 +1,6 @@ ;;;; bitvectors.test --- tests guile's bitvectors -*- scheme -*- ;;;; -;;;; Copyright 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright 2010, 2011, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -22,7 +22,6 @@ (with-test-prefix "predicates" (pass-if (bitvector? #*1010101010)) - (pass-if (generalized-vector? #*1010101010)) (pass-if (uniform-vector? #*1010101010)) (pass-if (array? #*1010101010))) diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test index 4ba5012..67fc680 100644 --- a/test-suite/tests/bytevectors.test +++ b/test-suite/tests/bytevectors.test @@ -1,6 +1,6 @@ ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ;;;; Ludovic Courtès ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -589,42 +589,42 @@ (with-input-from-string "#vu8(0 256)" read))) -(with-test-prefix "Generalized Vectors" +(with-test-prefix "Arrays" - (pass-if "generalized-vector?" - (generalized-vector? #vu8(1 2 3))) + (pass-if "array?" + (array? #vu8(1 2 3))) - (pass-if "generalized-vector-length" + (pass-if "array-length" (equal? (iota 16) - (map generalized-vector-length + (map array-length (map make-bytevector (iota 16))))) - (pass-if "generalized-vector-ref" + (pass-if "array-ref" (let ((bv #vu8(255 127))) - (and (= 255 (generalized-vector-ref bv 0)) - (= 127 (generalized-vector-ref bv 1))))) + (and (= 255 (array-ref bv 0)) + (= 127 (array-ref bv 1))))) - (pass-if-exception "generalized-vector-ref [index out-of-range]" + (pass-if-exception "array-ref [index out-of-range]" exception:out-of-range (let ((bv #vu8(1 2))) - (generalized-vector-ref bv 2))) + (array-ref bv 2))) - (pass-if "generalized-vector-set!" + (pass-if "array-set!" (let ((bv (make-bytevector 2))) - (generalized-vector-set! bv 0 255) - (generalized-vector-set! bv 1 77) + (array-set! bv 255 0) + (array-set! bv 77 1) (equal? '(255 77) (bytevector->u8-list bv)))) - (pass-if-exception "generalized-vector-set! [index out-of-range]" + (pass-if-exception "array-set! [index out-of-range]" exception:out-of-range (let ((bv (make-bytevector 2))) - (generalized-vector-set! bv 2 0))) + (array-set! bv 0 2))) - (pass-if-exception "generalized-vector-set! [value out-of-range]" + (pass-if-exception "array-set! [value out-of-range]" exception:out-of-range (let ((bv (make-bytevector 2))) - (generalized-vector-set! bv 0 256))) + (array-set! bv 256 0))) (pass-if "array-type" (eq? 'vu8 (array-type #vu8()))) diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test index 033e39f..9b76c7a 100644 --- a/test-suite/tests/srfi-4.test +++ b/test-suite/tests/srfi-4.test @@ -1,7 +1,7 @@ ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-06-26 ;;;; -;;;; Copyright (C) 2001, 2006, 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2010, 2011, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -438,24 +438,24 @@ (pass-if "+inf.0, -inf.0, +nan.0 in c32vector" (c32vector? #c32(+inf.0 -inf.0 +nan.0))) - (pass-if "generalized-vector-ref" + (pass-if "array-ref" (let ((v (c32vector 1+1i))) (= (c32vector-ref v 0) - (generalized-vector-ref v 0)))) + (array-ref v 0)))) - (pass-if "generalized-vector-set!" + (pass-if "array-set!" (let ((x 1+1i) (v (c32vector 0))) - (generalized-vector-set! v 0 x) - (= x (generalized-vector-ref v 0)))) + (array-set! v x 0) + (= x (array-ref v 0)))) - (pass-if-exception "generalized-vector-ref, out-of-range" + (pass-if-exception "array-ref, out-of-range" exception:out-of-range - (generalized-vector-ref (c32vector 1.0) 1)) + (array-ref (c32vector 1.0) 1)) - (pass-if-exception "generalized-vector-set!, out-of-range" + (pass-if-exception "array-set!, out-of-range" exception:out-of-range - (generalized-vector-set! (c32vector 1.0) 1 2.0))) + (array-set! (c32vector 1.0) 2.0 1))) (with-test-prefix "c64 vectors" @@ -497,24 +497,24 @@ (pass-if "+inf.0, -inf.0, +nan.0 in c64vector" (c64vector? #c64(+inf.0 -inf.0 +nan.0))) - (pass-if "generalized-vector-ref" + (pass-if "array-ref" (let ((v (c64vector 1+1i))) (= (c64vector-ref v 0) - (generalized-vector-ref v 0)))) + (array-ref v 0)))) - (pass-if "generalized-vector-set!" + (pass-if "array-set!" (let ((x 1+1i) (v (c64vector 0))) - (generalized-vector-set! v 0 x) - (= x (generalized-vector-ref v 0)))) + (array-set! v x 0) + (= x (array-ref v 0)))) - (pass-if-exception "generalized-vector-ref, out-of-range" + (pass-if-exception "array-ref, out-of-range" exception:out-of-range - (generalized-vector-ref (c64vector 1.0) 1)) + (array-ref (c64vector 1.0) 1)) - (pass-if-exception "generalized-vector-set!, out-of-range" + (pass-if-exception "array-set!, out-of-range" exception:out-of-range - (generalized-vector-set! (c64vector 1.0) 1 2.0))) + (array-set! (c64vector 1.0) 2.0 1))) (with-test-prefix "accessing uniform vectors of different types" -- 1.7.10.4