[Guile-commits] branch main updated: New function srfi-4-vector-type-size in (srfi srfi-4 gnu)

[Daniel Llorens]

This is an automated email from the git hooks/post-receive script.

lloda pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 5759e37  New function srfi-4-vector-type-size in (srfi srfi-4 gnu)
5759e37 is described below

commit 5759e37181ae648cc861656b6c75982851ba93fa
Author: Daniel Llorens <lloda@sarc.name>
AuthorDate: Mon Dec 6 13:38:37 2021 +0100

    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 710b8dd..a92a9f8 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 4e29bcb..8ff42d8 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 4f4c65b..b0a39e6 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 cb9de9d..23896c3 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 c885f7a..801c2c2 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 b2e6f49..9209185 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 35e6c4f..7c5d2c5 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 707abee..b35c493 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()))))
+