guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 01/02: Deprecate bitvector-ref on array slices


From: Andy Wingo
Subject: [Guile-commits] 01/02: Deprecate bitvector-ref on array slices
Date: Sun, 12 Apr 2020 16:31:38 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit 24a34074ef8fd91c111ed9987375f25925f69e26
Author: Andy Wingo <address@hidden>
AuthorDate: Sun Apr 12 21:26:47 2020 +0200

    Deprecate bitvector-ref on array slices
    
    * NEWS: Update.
    * doc/ref/api-data.texi (Bit Vectors): Update documentation on bit-set*!
      and bit-count*.
    * libguile/bitvectors.c: Add a to-do list.
      (scm_c_bitvector_ref, scm_c_bitvector_set_x, scm_bitvector_fill_x)
      (scm_bitvector_to_list, scm_bit_count, scm_bit_position):
      Issue deprecation warnings when used on array slices.
      (scm_list_to_bitvector): Simplify.
      (scm_bit_set_star_x, scm_bit_count_star): Deprecate arrays as target
      bitvectors, and also use of u32vector as selection vector.
    * libguile/bitvectors.h:
    * libguile/deprecated.h:
    * libguile/deprecated.c (scm_istr2bve): Deprecate.
    * test-suite/tests/bitvectors.test ("bit-count*"): Remove test of u32
      selectors.
---
 NEWS                             |  24 ++
 doc/ref/api-data.texi            |  44 +--
 libguile/bitvectors.c            | 571 +++++++++++++++++++--------------------
 libguile/bitvectors.h            |   3 +-
 libguile/deprecated.c            |  53 +++-
 libguile/deprecated.h            |   2 +
 test-suite/tests/bitvectors.test |   5 +-
 7 files changed, 376 insertions(+), 326 deletions(-)

diff --git a/NEWS b/NEWS
index 1ca716a..65cbd1c 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,30 @@ See the end for copying conditions.
 Please send Guile bug reports to address@hidden.
 
 
+Changes in 3.0.3 (since 3.0.2)
+
+* New deprecations
+
+** Passing a u32vector to 'bit-set*!' and 'bit-count*' deprecated
+
+These functions had an interface that allowed the second bit-selection
+argument to be a u32vector of bit indices to select.  This added only
+complexity and no efficiency compared to just calling 'bitvector-set!'
+or 'bitvector-ref' in a loop.
+
+** Accessing generic arrays using the bitvector procedures deprecated
+
+For the same efficiency reasons that use of 'vector-ref' on generic
+arrays was deprecated in Guile 2.0.10, using 'bitvector-ref' and similar
+procedures on 1-dimensional boolean-typed arrays is now deprecated.  Use
+'array-ref' and similar procedures on arrays.
+
+** scm_istr2bve deprecated
+
+This C-only procedure to parse a bitvector from a string should be
+replaced by calling `read' on a string port instead, if needed.
+
+
 Changes in 3.0.2 (since 3.0.1)
 
 * New interfaces and functionality
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index a6b09c4..32d94e6 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -6641,17 +6641,15 @@ entry between @var{start} and the end of 
@var{bitvector}, then return
 Modify @var{bitvector} by replacing each element with its negation.
 @end deffn
 
-@deffn {Scheme Procedure} bit-set*! bitvector uvec bool
-@deffnx {C Function} scm_bit_set_star_x (bitvector, uvec, bool)
-Set entries of @var{bitvector} to @var{bool}, with @var{uvec}
-selecting the entries to change.  The return value is unspecified.
-
-If @var{uvec} is a bit vector, then those entries where it has
-@code{#t} are the ones in @var{bitvector} which are set to @var{bool}.
-@var{uvec} and @var{bitvector} must be the same length.  When
-@var{bool} is @code{#t} it's like @var{uvec} is OR'ed into
-@var{bitvector}.  Or when @var{bool} is @code{#f} it can be seen as an
-ANDNOT.
+@deffn {Scheme Procedure} bit-set*! bitvector bits bool
+@deffnx {C Function} scm_bit_set_star_x (bitvector, bits, bool)
+Set entries of @var{bitvector} to @var{bool}, with @var{bits} selecting
+the entries to change.  The return value is unspecified.  Those bits in
+the bitvector @var{bits} which are set to one indicate the bits in
+@var{bitvector} to set to @var{bool}.  @var{bitvector} must be at least
+as long as @var{bits}.  When @var{bool} is @code{#t} it is as if
+@var{bits} is OR'ed into @var{bitvector}, whereas when @var{bool} is
+@code{#f} is like an ANDNOT.
 
 @example
 (define bv #*01000010)
@@ -6659,34 +6657,18 @@ ANDNOT.
 bv
 @result{} #*11010011
 @end example
-
-If @var{uvec} is a uniform vector of unsigned long integers, then
-they're indexes into @var{bitvector} which are set to @var{bool}.  
-
-@example
-(define bv #*01000010)
-(bit-set*! bv #u(5 2 7) #t)
-bv
-@result{} #*01100111
-@end example
 @end deffn
 
-@deffn {Scheme Procedure} bit-count* bitvector uvec bool
-@deffnx {C Function} scm_bit_count_star (bitvector, uvec, bool)
+@deffn {Scheme Procedure} bit-count* bitvector bits bool
+@deffnx {C Function} scm_bit_count_star (bitvector, bits, bool)
 Return a count of how many entries in @var{bitvector} are equal to
-@var{bool}, with @var{uvec} selecting the entries to consider.
-
-@var{uvec} is interpreted in the same way as for @code{bit-set*!}
-above.  Namely, if @var{uvec} is a bit vector then entries which have
-@code{#t} there are considered in @var{bitvector}.  Or if @var{uvec}
-is a uniform vector of unsigned long integers then it's the indexes in
-@var{bitvector} to consider.
+@var{bool}, with the bitvector @var{bits} selecting the entries to
+consider.  @var{bitvector} must be at least as long as @var{bits}.
 
 For example,
 
 @example
 (bit-count* #*01110111 #*11001101 #t) @result{} 3
-(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2
 @end example
 @end deffn
 
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 0bb4c1f..f771b77 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2006,2009-2014,2018
+/* Copyright 1995-1998,2000-2006,2009-2014,2018,2020
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -29,6 +29,7 @@
 #include "array-handle.h"
 #include "arrays.h"
 #include "boolean.h"
+#include "deprecation.h"
 #include "generalized-vectors.h"
 #include "gsubr.h"
 #include "list.h"
@@ -40,12 +41,15 @@
 #include "bitvectors.h"
 
 
-/* Bit vectors. Would be nice if they were implemented on top of bytevectors,
- * but alack, all we have is this crufty C.
- */
-
 #define SCM_F_BITVECTOR_IMMUTABLE (0x80)
 
+/* To do in Guile 3.1.x:
+    - Allocate bits inline with bitvector, starting from &SCM_CELL_WORD_2.
+    - Use uintptr_t for bitvector component instead of uint32_t.
+    - Remove deprecated support for bitvector-ref et al on arrays.
+    - Replace primitives that operator on bitvectors but don't have
+      bitvector- prefix.
+    - Add Scheme compiler support for bitvector primitives.  */
 #define IS_BITVECTOR(obj)         SCM_HAS_TYP7  ((obj), scm_tc7_bitvector)
 #define IS_MUTABLE_BITVECTOR(x)                                 \
   (SCM_NIMP (x) &&                                              \
@@ -246,7 +250,6 @@ scm_bitvector_writable_elements (SCM vec,
 SCM
 scm_c_bitvector_ref (SCM vec, size_t idx)
 {
-  scm_t_array_handle handle;
   const uint32_t *bits;
 
   if (IS_BITVECTOR (vec))
@@ -259,10 +262,14 @@ scm_c_bitvector_ref (SCM vec, size_t idx)
   else
     {
       SCM res;
+      scm_t_array_handle handle;
       size_t len, off;
       ssize_t inc;
   
       bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
+      scm_c_issue_deprecation_warning
+        ("Using bitvector-ref on arrays is deprecated.  "
+         "Use array-ref instead.");
       if (idx >= len)
        scm_out_of_range (NULL, scm_from_size_t (idx));
       idx = idx*inc + off;
@@ -300,6 +307,9 @@ scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
       ssize_t inc;
   
       bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+      scm_c_issue_deprecation_warning
+        ("Using bitvector-set! on arrays is deprecated.  "
+         "Use array-set! instead.");
       if (idx >= len)
        scm_out_of_range (NULL, scm_from_size_t (idx));
       idx = idx*inc + off;
@@ -332,40 +342,46 @@ SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 
0, 0,
            "@var{vec} when @var{val} is true, else clear them.")
 #define FUNC_NAME s_scm_bitvector_fill_x
 {
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  uint32_t *bits;
-
-  bits = scm_bitvector_writable_elements (vec, &handle,
-                                         &off, &len, &inc);
-
-  if (off == 0 && inc == 1 && len > 0)
+  if (IS_MUTABLE_BITVECTOR (vec))
     {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
-
-      if (scm_is_true (val))
-       {
-         memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1));
-         bits[word_len-1] |= last_mask;
-       }
-      else
-       {
-         memset (bits, 0x00, sizeof(uint32_t)*(word_len-1));
-         bits[word_len-1] &= ~last_mask;
-       }
+      size_t len = BITVECTOR_LENGTH (vec);
+
+      if (len > 0)
+        {
+          uint32_t *bits = BITVECTOR_BITS (vec);
+          size_t word_len = (len + 31) / 32;
+          uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
+
+          if (scm_is_true (val))
+            {
+              memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1));
+              bits[word_len-1] |= last_mask;
+            }
+          else
+            {
+              memset (bits, 0x00, sizeof(uint32_t)*(word_len-1));
+              bits[word_len-1] &= ~last_mask;
+            }
+        }
     }
   else
     {
+      scm_t_array_handle handle;
+      size_t off, len;
+      ssize_t inc;
+
+      scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+
+      scm_c_issue_deprecation_warning
+        ("Using bitvector-fill! on arrays is deprecated.  "
+         "Use array-set! instead.");
+
       size_t i;
       for (i = 0; i < len; i++)
        scm_array_handle_set (&handle, i*inc, val);
-    }
 
-  scm_array_handle_release (&handle);
+      scm_array_handle_release (&handle);
+    }
 
   return SCM_UNSPECIFIED;
 }
@@ -380,9 +396,7 @@ SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 
0,
   size_t bit_len = scm_to_size_t (scm_length (list));
   SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
   size_t word_len = (bit_len+31)/32;
-  scm_t_array_handle handle;
-  uint32_t *bits = scm_bitvector_writable_elements (vec, &handle,
-                                                       NULL, NULL, NULL);
+  uint32_t *bits = BITVECTOR_BITS (vec);
   size_t i, j;
 
   for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
@@ -395,8 +409,6 @@ SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 
0,
          bits[i] |= mask;
     }
 
-  scm_array_handle_release (&handle);
-
   return vec;
 }
 #undef FUNC_NAME
@@ -407,37 +419,40 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 
0, 0,
            "of the bitvector @var{vec}.")
 #define FUNC_NAME s_scm_bitvector_to_list
 {
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  const uint32_t *bits;
   SCM res = SCM_EOL;
 
-  bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
-
-  if (off == 0 && inc == 1)
+  if (IS_BITVECTOR (vec))
     {
-      /* the usual case
-       */
+      const uint32_t *bits = BITVECTOR_BITS (vec);
+      size_t len = BITVECTOR_LENGTH (vec);
       size_t word_len = (len + 31) / 32;
-      size_t i, j;
 
-      for (i = 0; i < word_len; i++, len -= 32)
+      for (size_t i = 0; i < word_len; i++, len -= 32)
        {
          uint32_t mask = 1;
-         for (j = 0; j < 32 && j < len; j++, mask <<= 1)
+         for (size_t j = 0; j < 32 && j < len; j++, mask <<= 1)
            res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
        }
     }
   else
     {
-      size_t i;
-      for (i = 0; i < len; i++)
+      scm_t_array_handle handle;
+      size_t off, len;
+      ssize_t inc;
+
+      scm_bitvector_elements (vec, &handle, &off, &len, &inc);
+
+      scm_c_issue_deprecation_warning
+        ("Using bitvector->list on arrays is deprecated.  "
+         "Use array->list instead.");
+
+      for (size_t i = 0; i < len; i++)
        res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
-    }
 
-  scm_array_handle_release (&handle);
+      scm_array_handle_release (&handle);
   
+    }
+
   return scm_reverse_x (res, SCM_EOL);
 }
 #undef FUNC_NAME
@@ -470,38 +485,45 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
            "@var{bitvector}.")
 #define FUNC_NAME s_scm_bit_count
 {
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  const uint32_t *bits;
   int bit = scm_to_bool (b);
-  size_t count = 0;
-
-  bits = scm_bitvector_elements (bitvector, &handle, &off, &len, &inc);
+  size_t count = 0, len;
 
-  if (off == 0 && inc == 1 && len > 0)
+  if (IS_BITVECTOR (bitvector))
     {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
-      size_t i;
-
-      for (i = 0; i < word_len-1; i++)
-       count += count_ones (bits[i]);
-      count += count_ones (bits[i] & last_mask);
+      len = BITVECTOR_LENGTH (bitvector);
+
+      if (len > 0)
+        {
+          const uint32_t *bits = BITVECTOR_BITS (bitvector);
+          size_t word_len = (len + 31) / 32;
+          uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
+
+          size_t i;
+          for (i = 0; i < word_len-1; i++)
+            count += count_ones (bits[i]);
+          count += count_ones (bits[i] & last_mask);
+        }
     }
   else
     {
-      size_t i;
-      for (i = 0; i < len; i++)
+      scm_t_array_handle handle;
+      size_t off;
+      ssize_t inc;
+
+      scm_bitvector_elements (bitvector, &handle, &off, &len, &inc);
+
+      scm_c_issue_deprecation_warning
+        ("Using bit-count on arrays is deprecated.  "
+         "Use array->list instead.");
+
+      for (size_t i = 0; i < len; i++)
        if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
          count++;
+
+      scm_array_handle_release (&handle);
     }
   
-  scm_array_handle_release (&handle);
-
-  return scm_from_size_t (bit? count : len-count);
+  return scm_from_size_t (bit ? count : len-count);
 }
 #undef FUNC_NAME
 
@@ -538,43 +560,48 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_bit_position
 {
-  scm_t_array_handle handle;
-  size_t off, len, first_bit;
-  ssize_t inc;
-  const uint32_t *bits;
   int bit = scm_to_bool (item);
   SCM res = SCM_BOOL_F;
   
-  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
-  first_bit = scm_to_unsigned_integer (k, 0, len);
-
-  if (off == 0 && inc == 1 && len > 0)
+  if (IS_BITVECTOR (v))
     {
-      size_t i, word_len = (len + 31) / 32;
-      uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
-      size_t first_word = first_bit / 32;
-      uint32_t first_mask =
-       ((uint32_t)-1) << (first_bit - 32*first_word);
-      uint32_t w;
+      size_t len = BITVECTOR_LENGTH (v);
+      if (len > 0)
+        {
+          size_t first_bit = scm_to_unsigned_integer (k, 0, len);
+          const uint32_t *bits = BITVECTOR_BITS (v);
+          size_t word_len = (len + 31) / 32;
+          uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
+          size_t first_word = first_bit / 32;
+          uint32_t first_mask =
+            ((uint32_t)-1) << (first_bit - 32*first_word);
       
-      for (i = first_word; i < word_len; i++)
-       {
-         w = (bit? bits[i] : ~bits[i]);
-         if (i == first_word)
-           w &= first_mask;
-         if (i == word_len-1)
-           w &= last_mask;
-         if (w)
-           {
-             res = scm_from_size_t (32*i + find_first_one (w));
-             break;
-           }
-       }
+          for (size_t i = first_word; i < word_len; i++)
+            {
+              uint32_t w = bit ? bits[i] : ~bits[i];
+              if (i == first_word)
+                w &= first_mask;
+              if (i == word_len-1)
+                w &= last_mask;
+              if (w)
+                {
+                  res = scm_from_size_t (32*i + find_first_one (w));
+                  break;
+                }
+            }
+        }
     }
   else
     {
-      size_t i;
-      for (i = first_bit; i < len; i++)
+      scm_t_array_handle handle;
+      size_t off, len;
+      ssize_t inc;
+      scm_bitvector_elements (v, &handle, &off, &len, &inc);
+      scm_c_issue_deprecation_warning
+        ("Using bit-position on arrays is deprecated.  "
+         "Use array-ref in a loop instead.");
+      size_t first_bit = scm_to_unsigned_integer (k, 0, len);
+      for (size_t i = first_bit; i < len; i++)
        {
          SCM elt = scm_array_handle_ref (&handle, i*inc);
          if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
@@ -583,10 +610,9 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
              break;
            }
        }
+      scm_array_handle_release (&handle);
     }
 
-  scm_array_handle_release (&handle);
-
   return res;
 }
 #undef FUNC_NAME
@@ -621,82 +647,89 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_bit_set_star_x
 {
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  uint32_t *v_bits;
-  int bit;
-
   /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  bit = scm_to_bool (obj);
+     need BIT.  */
+  int bit = scm_to_bool (obj);
 
-  v_bits = scm_bitvector_writable_elements (v, &v_handle,
-                                           &v_off, &v_len, &v_inc);
-
-  if (scm_is_bitvector (kv))
+  if (IS_MUTABLE_BITVECTOR (v) && IS_BITVECTOR (kv))
     {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const uint32_t *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (kv, &kv_handle,
-                                       &kv_off, &kv_len, &kv_inc);
+      size_t v_len = BITVECTOR_LENGTH (v);
+      uint32_t *v_bits = BITVECTOR_BITS (v);
+      size_t kv_len = BITVECTOR_LENGTH (kv);
+      const uint32_t *kv_bits = BITVECTOR_BITS (kv);
 
       if (v_len < kv_len)
-       scm_misc_error (NULL,
-                       "bit vectors must have equal length",
-                       SCM_EOL);
-
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-       {
-         size_t word_len = (kv_len + 31) / 32;
-         uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
-         size_t i;
- 
-         if (bit == 0)
-           {
-             for (i = 0; i < word_len-1; i++)
-               v_bits[i] &= ~kv_bits[i];
-             v_bits[i] &= ~(kv_bits[i] & last_mask);
-           }
-         else
-           {
-             for (i = 0; i < word_len-1; i++)
-               v_bits[i] |= kv_bits[i];
-             v_bits[i] |= kv_bits[i] & last_mask;
-           }
-       }
-      else
-       {
-         size_t i;
-         for (i = 0; i < kv_len; i++)
-           if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
-             scm_array_handle_set (&v_handle, i*v_inc, obj);
-       }
+        scm_misc_error (NULL,
+                        "selection bitvector longer than target bitvector",
+                        SCM_EOL);
       
-      scm_array_handle_release (&kv_handle);
-
+      if (kv_len > 0)
+        {
+          size_t word_len = (kv_len + 31) / 32;
+          uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
+          size_t i;
+
+          if (bit == 0)
+            {
+              for (i = 0; i < word_len-1; i++)
+                v_bits[i] &= ~kv_bits[i];
+              v_bits[i] &= ~(kv_bits[i] & last_mask);
+            }
+          else
+            {
+              for (i = 0; i < word_len-1; i++)
+                v_bits[i] |= kv_bits[i];
+              v_bits[i] |= kv_bits[i] & last_mask;
+            }
+        }
     }
-  else if (scm_is_true (scm_u32vector_p (kv)))
+  else
     {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const uint32_t *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-       scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+      scm_t_array_handle v_handle;
+      size_t v_off, v_len;
+      ssize_t v_inc;
+      scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc);
+
+      if (!IS_MUTABLE_BITVECTOR (v))
+        scm_c_issue_deprecation_warning
+          ("Using bit-set*! on arrays is deprecated.  "
+           "Use array-set! in a loop instead.");
+
+      if (IS_BITVECTOR (kv))
+        {
+          size_t kv_len = BITVECTOR_LENGTH (kv);
+
+          if (v_len < kv_len)
+            scm_misc_error (NULL,
+                            "selection bitvector longer than target bitvector",
+                            SCM_EOL);
+
+         for (size_t i = 0; i < kv_len; i++)
+           if (scm_is_true (scm_c_bitvector_ref (kv, i)))
+             scm_array_handle_set (&v_handle, i*v_inc, obj);
+        }
+      else if (scm_is_true (scm_u32vector_p (kv)))
+        {
+          scm_c_issue_deprecation_warning
+            ("Passing a u32vector to bit-set*! is deprecated.  "
+             "Use bitvector-set! in a loop instead.");
+
+          scm_t_array_handle kv_handle;
+          size_t kv_len;
+          ssize_t kv_inc;
+          const uint32_t *kv_elts;
+
+          kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+          for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc)
+            scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+
+          scm_array_handle_release (&kv_handle);
+        }
+      else
+        scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
 
-      scm_array_handle_release (&kv_handle);
+      scm_array_handle_release (&v_handle);
     }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
 
   return SCM_UNSPECIFIED;
 }
@@ -724,82 +757,84 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_bit_count_star
 {
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  const uint32_t *v_bits;
   size_t count = 0;
-  int bit;
 
   /* Validate that OBJ is a boolean so this is done even if we don't
      need BIT.
   */
-  bit = scm_to_bool (obj);
-
-  v_bits = scm_bitvector_elements (v, &v_handle,
-                                  &v_off, &v_len, &v_inc);
+  int bit = scm_to_bool (obj);
 
-  if (scm_is_bitvector (kv))
+  if (IS_BITVECTOR (v) && IS_BITVECTOR (kv))
     {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const uint32_t *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (kv, &kv_handle,
-                                       &kv_off, &kv_len, &kv_inc);
-
-      if (v_len != kv_len)
-       scm_misc_error (NULL,
-                       "bit vectors must have equal length",
-                       SCM_EOL);
+      size_t v_len = BITVECTOR_LENGTH (v);
+      const uint32_t *v_bits = BITVECTOR_BITS (v);
+      size_t kv_len = BITVECTOR_LENGTH (kv);
+      const uint32_t *kv_bits = BITVECTOR_BITS (kv);
 
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-       {
-         size_t i, word_len = (kv_len + 31) / 32;
-         uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
-         uint32_t xor_mask = bit? 0 : ((uint32_t)-1);
-
-         for (i = 0; i < word_len-1; i++)
-           count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
-         count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
-       }
-      else
-       {
-         size_t i;
-         for (i = 0; i < kv_len; i++)
-           if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
-             {
-               SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
-               if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-                 count++;
-             }
-       }
+      if (v_len < kv_len)
+        scm_misc_error (NULL,
+                        "selection bitvector longer than target bitvector",
+                        SCM_EOL);
       
-      scm_array_handle_release (&kv_handle);
+      size_t i, word_len = (kv_len + 31) / 32;
+      uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
+      uint32_t xor_mask = bit? 0 : ((uint32_t)-1);
 
+      for (i = 0; i < word_len-1; i++)
+        count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
+      count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
     }
-  else if (scm_is_true (scm_u32vector_p (kv)))
+  else
     {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const uint32_t *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-       {
-         SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
-         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-           count++;
-       }
+      scm_t_array_handle v_handle;
+      size_t v_off, v_len;
+      ssize_t v_inc;
+
+      scm_bitvector_elements (v, &v_handle, &v_off, &v_len, &v_inc);
+
+      if (!IS_BITVECTOR (v))
+        scm_c_issue_deprecation_warning
+          ("Using bit-count* on arrays is deprecated.  "
+           "Use array-set! in a loop instead.");
+
+      if (IS_BITVECTOR (kv))
+        {
+          size_t kv_len = BITVECTOR_LENGTH (kv);
+          for (size_t i = 0; i < kv_len; i++)
+            if (scm_is_true (scm_c_bitvector_ref (kv, i)))
+              {
+                SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
+                if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+                  count++;
+              }
+        }
+      else if (scm_is_true (scm_u32vector_p (kv)))
+        {
+          scm_t_array_handle kv_handle;
+          size_t i, kv_len;
+          ssize_t kv_inc;
+          const uint32_t *kv_elts;
+
+          scm_c_issue_deprecation_warning
+            ("Passing a u32vector to bit-count* is deprecated.  "
+             "Use bitvector-ref in a loop instead.");
+
+          kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+
+          for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+            {
+              SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
+              if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+                count++;
+            }
+
+          scm_array_handle_release (&kv_handle);
+        }
+      else
+        scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
 
-      scm_array_handle_release (&kv_handle);
+      scm_array_handle_release (&v_handle);
     }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
 
   return scm_from_size_t (count);
 }
@@ -811,15 +846,10 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
            "its negation.")
 #define FUNC_NAME s_scm_bit_invert_x
 {
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  uint32_t *bits;
-
-  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
-  
-  if (off == 0 && inc == 1 && len > 0)
+  if (IS_MUTABLE_BITVECTOR (v))
     {
+      size_t len = BITVECTOR_LENGTH (v);
+      uint32_t *bits = BITVECTOR_BITS (v);
       size_t word_len = (len + 31) / 32;
       uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
       size_t i;
@@ -830,61 +860,24 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
     }
   else
     {
-      size_t i;
-      for (i = 0; i < len; i++)
+      size_t off, len;
+      ssize_t inc;
+      scm_t_array_handle handle;
+
+      scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
+      scm_c_issue_deprecation_warning
+        ("Using bit-invert! on arrays is deprecated.  "
+         "Use scalar array accessors in a loop instead.");
+      for (size_t i = 0; i < len; i++)
        scm_array_handle_set (&handle, i*inc,
                              scm_not (scm_array_handle_ref (&handle, i*inc)));
+      scm_array_handle_release (&handle);
     }
 
-  scm_array_handle_release (&handle);
-
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-
-SCM
-scm_istr2bve (SCM str)
-{
-  scm_t_array_handle handle;
-  size_t len = scm_i_string_length (str);
-  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
-  SCM res = vec;
-
-  uint32_t mask;
-  size_t k, j;
-  const char *c_str;
-  uint32_t *data;
-
-  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
-  c_str = scm_i_string_chars (str);
-
-  for (k = 0; k < (len + 31) / 32; k++)
-    {
-      data[k] = 0L;
-      j = len - k * 32;
-      if (j > 32)
-       j = 32;
-      for (mask = 1L; j--; mask <<= 1)
-       switch (*c_str++)
-         {
-         case '0':
-           break;
-         case '1':
-           data[k] |= mask;
-           break;
-         default:
-           res = SCM_BOOL_F;
-           goto exit;
-         }
-    }
-  
- exit:
-  scm_array_handle_release (&handle);
-  scm_remember_upto_here_1 (str);
-  return res;
-}
-
 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector)
 
 void
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index c3b0b43..3a00bf2 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -1,7 +1,7 @@
 #ifndef SCM_BITVECTORS_H
 #define SCM_BITVECTORS_H
 
-/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2014,2018
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2014,2018,2020
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -47,7 +47,6 @@ SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
 SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
 SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
 SCM_API SCM scm_bit_invert_x (SCM v);
-SCM_API SCM scm_istr2bve (SCM str);
 
 SCM_API int scm_is_bitvector (SCM obj);
 SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index cc8e78b..60459c6 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1,4 +1,4 @@
-/* Copyright 2003-2004,2006,2008-2018
+/* Copyright 2003-2004,2006,2008-2018,2020
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -27,8 +27,10 @@
 
 #define SCM_BUILDING_DEPRECATED_CODE
 
+#include "bitvectors.h"
 #include "deprecation.h"
 #include "gc.h"
+#include "strings.h"
 
 #include "deprecated.h"
 
@@ -83,6 +85,55 @@ scm_find_executable (const char *name)
 
 
 
+SCM
+scm_istr2bve (SCM str)
+{
+  scm_t_array_handle handle;
+  size_t len = scm_i_string_length (str);
+  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
+  SCM res = vec;
+
+  uint32_t mask;
+  size_t k, j;
+  const char *c_str;
+  uint32_t *data;
+
+  scm_c_issue_deprecation_warning
+    ("scm_istr2bve is deprecated.  "
+     "Read from a string instead, prefixed with `#*'.");
+
+  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
+  c_str = scm_i_string_chars (str);
+
+  for (k = 0; k < (len + 31) / 32; k++)
+    {
+      data[k] = 0L;
+      j = len - k * 32;
+      if (j > 32)
+       j = 32;
+      for (mask = 1L; j--; mask <<= 1)
+       switch (*c_str++)
+         {
+         case '0':
+           break;
+         case '1':
+           data[k] |= mask;
+           break;
+         default:
+           res = SCM_BOOL_F;
+           goto exit;
+         }
+    }
+  
+ exit:
+  scm_array_handle_release (&handle);
+  scm_remember_upto_here_1 (str);
+  return res;
+}
+
+
+
+
 void
 scm_i_init_deprecated ()
 {
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index ba249da..fb88543 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -115,6 +115,8 @@ typedef struct scm_thread scm_i_thread SCM_DEPRECATED_TYPE;
 
 SCM_DEPRECATED char* scm_find_executable (const char *name);
 
+SCM_DEPRECATED SCM scm_istr2bve (SCM str);
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
index d9dfa13..2b59e92 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, 2013, 2014 Free Software Foundation, Inc.
+;;;; Copyright 2010, 2011, 2013, 2014, 2020 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
@@ -72,5 +72,4 @@
       (equal? v #*0100))))
 
 (with-test-prefix "bit-count*"
-  (pass-if-equal 3 (bit-count* #*01110111 #*11001101 #t))
-  (pass-if-equal 2 (bit-count* #*01110111 #u32(7 0 4) #f)))
+  (pass-if-equal 3 (bit-count* #*01110111 #*11001101 #t)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]