From 5759e37181ae648cc861656b6c75982851ba93fa Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Mon, 6 Dec 2021 13:38:37 +0100 Subject: [PATCH] New function srfi-4-vector-type-size in (srfi srfi-4 gnu) This patch removes the undocumented function make-srfi-4-vector from (guile). That function is still exported from (srfi srfi-4 gnu). * libguile/srfi-4.h (scm_init_srfi_4): Split into scm_bootstrap_srfi_4() and scm_init_srfi_4(), after the pattern of scm_init_bytevectors() and scm_bootstrap_bytevectors(). * libguile/init.c: Replace scm_init_srfi_4() call by scm_bootstrap_srfi_4(). * module/srfi/srfi-4.scm: Load newly defined srfi-4 extension. This provides undocumented make-srfi-4-vector. * module/srfi/srfi-4/gnu.scm: Export srfi-4-vector-type-size. * doc/ref/srfi-modules.texi: Document srfi-4-vector-type-size. --- NEWS | 6 +++++- doc/ref/srfi-modules.texi | 6 ++++++ libguile/init.c | 2 +- libguile/srfi-4.c | 25 ++++++++++++++++++++++++- libguile/srfi-4.h | 2 ++ module/srfi/srfi-4.scm | 3 +++ module/srfi/srfi-4/gnu.scm | 8 +++++--- test-suite/tests/srfi-4.test | 17 +++++++++++++++++ 8 files changed, 63 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 710b8ddda..a92a9f85d 100644 --- a/NEWS +++ b/NEWS @@ -28,7 +28,7 @@ This function was undocumented. * New interfaces and functionality -** Typed vector copy functions +** Typed vector copy functions in (srfi srfi-4 gnu) The functions `u8vector-copy' `s8vector-copy' `u16vector-copy' `s16vector-copy' `u32vector-copy' `s32vector-copy' `u64vector-copy' @@ -39,6 +39,10 @@ The functions `u8vector-copy' `s8vector-copy' `u16vector-copy' `f64vector-copy!' `c32vector-copy!' `c64vector-copy!' have been added. See SRFI-4 - Guile extensions" in the manual. +** New function srfi-4-vector-type-size in (srfi srfi-4 gnu) + +See SRFI-4 - Guile extensions" in the manual. + ** `bytevector-fill!' supports partial fill through optional arguments This is an extension to the r6rs procedure. See "Manipulating diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 4e29bcbd6..8ff42d82a 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1776,6 +1776,12 @@ module: (use-modules (srfi srfi-4 gnu)) @end example +@deffn {Scheme Procedure} srfi-4-vector-type-size obj +Return the size, in bytes, of each element of SRFI-4 vector +@var{obj}. For example, @code{(srfi-4-vector-type-size #u32())} returns +@code{4}. +@end deffn + @deffn {Scheme Procedure} any->u8vector obj @deffnx {Scheme Procedure} any->s8vector obj @deffnx {Scheme Procedure} any->u16vector obj diff --git a/libguile/init.c b/libguile/init.c index 4f4c65bf3..b0a39e6d4 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -449,7 +449,7 @@ scm_i_init_guile (void *base) scm_init_vectors (); /* Requires array-handle, */ scm_init_uniform (); scm_init_bitvectors (); /* Requires smob_prehistory, array-handle */ - scm_init_srfi_4 (); /* Requires smob_prehistory, array-handle */ + scm_bootstrap_srfi_4 (); /* Requires smob_prehistory, array-handle */ scm_init_arrays (); /* Requires smob_prehistory, array-handle */ scm_init_array_map (); diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c index cb9de9d8f..23896c32c 100644 --- a/libguile/srfi-4.c +++ b/libguile/srfi-4.c @@ -37,6 +37,7 @@ #include "numbers.h" #include "uniform.h" #include "variable.h" +#include "version.h" #include "srfi-4.h" @@ -277,8 +278,21 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 2, 1, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_srfi_4_vector_type_size, "srfi-4-vector-type-size", 1, 0, 0, + (SCM vec), + "Return the size, in bytes, of each element of a srfi-4 vector.") +#define FUNC_NAME s_scm_srfi_4_vector_type_size +{ + SCM_VALIDATE_BYTEVECTOR (1, vec); + return scm_from_size_t (SCM_BYTEVECTOR_TYPE_SIZE (vec)); +} +#undef FUNC_NAME + + +/* Initialization. */ + void -scm_init_srfi_4 (void) +scm_bootstrap_srfi_4 (void) { #define REGISTER(tag, TAG) \ scm_i_register_vector_constructor \ @@ -298,6 +312,15 @@ scm_init_srfi_4 (void) REGISTER (c32, C32); REGISTER (c64, C64); + scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, + "scm_init_srfi_4", + (scm_t_extension_init_func) scm_init_srfi_4, + NULL); +} + +void +scm_init_srfi_4 (void) +{ #include "srfi-4.x" } diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h index c885f7a47..801c2c210 100644 --- a/libguile/srfi-4.h +++ b/libguile/srfi-4.h @@ -25,6 +25,7 @@ #include "libguile/array-handle.h" SCM_API SCM scm_make_srfi_4_vector (SCM type, SCM len, SCM fill); +SCM_API SCM scm_srfi_4_vector_type_size (SCM vec); /* Specific procedures. */ @@ -60,6 +61,7 @@ SCM_SRFI4_DECL (c64, double) #undef SCM_SRFI4_DECL +SCM_INTERNAL void scm_bootstrap_srfi_4 (void); SCM_INTERNAL void scm_init_srfi_4 (void); #endif /* SCM_SRFI_4_H */ diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm index b2e6f4928..9209185f7 100644 --- a/module/srfi/srfi-4.scm +++ b/module/srfi/srfi-4.scm @@ -116,3 +116,6 @@ (define-bytevector-type s64 s64-native 8) (define-bytevector-type f32 ieee-single-native 4) (define-bytevector-type f64 ieee-double-native 8) + +(load-extension (string-append "libguile-" (effective-version)) + "scm_init_srfi_4") diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm index 35e6c4f66..7c5d2c5fb 100644 --- a/module/srfi/srfi-4/gnu.scm +++ b/module/srfi/srfi-4/gnu.scm @@ -33,8 +33,6 @@ c64vector? make-c64vector c64vector c64vector-length c64vector-ref c64vector-set! c64vector->list list->c64vector - make-srfi-4-vector - ;; Somewhat polymorphic conversions. any->u8vector any->s8vector any->u16vector any->s16vector any->u32vector any->s32vector any->u64vector any->s64vector @@ -48,10 +46,14 @@ ;; copy range with destination u8vector-copy! s8vector-copy! u16vector-copy! s16vector-copy! u32vector-copy! s32vector-copy! u64vector-copy! s64vector-copy! - f32vector-copy! f64vector-copy! c32vector-copy! c64vector-copy!)) + f32vector-copy! f64vector-copy! c32vector-copy! c64vector-copy! + + ;; from libguile + srfi-4-vector-type-size make-srfi-4-vector)) (define make-srfi-4-vector (@@ (srfi srfi-4) make-srfi-4-vector)) +(define srfi-4-vector-type-size (@@ (srfi srfi-4) srfi-4-vector-type-size)) (define (bytevector-c32-native-ref v i) (make-rectangular (bytevector-ieee-single-native-ref v i) diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test index 707abee3d..b35c493fb 100644 --- a/test-suite/tests/srfi-4.test +++ b/test-suite/tests/srfi-4.test @@ -564,3 +564,20 @@ (s8vector-copy! v 2 #s8(-1 -2 -3 -4 -5)) (equal? #s8(9 7 -1 -2 -3 -4 -5 8) v)))) +(with-test-prefix "srfi-4 type size" + + (pass-if "c64vector" + (= 16 (srfi-4-vector-type-size #c64()))) + + (pass-if "c32vector" + (= 8 (srfi-4-vector-type-size #c32()))) + + (pass-if "f32vector" + (= 4 (srfi-4-vector-type-size #f32()))) + + (pass-if "u16vector" + (= 2 (srfi-4-vector-type-size #u16()))) + + (pass-if "s8vector" + (= 1 (srfi-4-vector-type-size #s8())))) +