Hi all,

I've discussed #1385 with Felix, and after some consideration we agreed
the lesser of three evils is to rename the procedure to something
completely nonstandard.  Swapping the argument order in CHICKEN 5 will
almost certainly introduce insidious bugs when porting existing programs
from CHICKEN 4 or from other Schemes.  And keeping the argument order is
bad too, because we will pay the price for having a nonstandard argument
order for the rest of all time.

Keeping the old procedure and adding a new one just moves the problem of
how to rectify this into the future, so that's not an option either.
Renaming it to a completely nonstandard name should make it easy to port,
and later on (CHICKEN 5.1 or even 5.2) we can re-introduce the bit-set?
procedure with the correct argument order, and deprecate the new procedure.

The name of the nonstandard procedure is not very relevant since it is
going to disappear anyway, but I think bit->boolean is a relatively clean
name.  Luckily, core itself doesn't use bit-set? anywhere, so we can
just rename it with impunity, no need to keep the OBSOLETE name around.

If nobody disagrees, let's get this over with!

Cheers,
Peter
From 32b45a6ac3b0297762c1d5bb85847535d85abedb Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Tue, 8 Aug 2017 19:48:07 +0200
Subject: [PATCH] Rename bit-set? to bit->boolean to avoid confusion (fixes
 #1385)

The problem with bit-set? is that our definition has the argument
order swapped when compared to SRFI-33 and SRFI-60.  Given that all
our other procedures follow the definitions given in these SRFIs, it
is extra confusing that this one procedure has a different argument
order.  This may result in very subtle bugs.

To make matters worse, swapping the argument to match the SRFIs would
be downright evil, because it would make porting bugs harder to
find: (bit-set? 1 2) for example will return different values
depending on which argument indicates the number and which the bit
position, but the result is still a boolean and in other cases it
might "accidentally" return the expected result, making it very very
difficult to figure out why a program is failing.

So this is why we rename it: When porting any program from CHICKEN 4
to CHICKEN 5 (or from another Scheme), it will immediately error out,
and after a quick search one will be able to find the CHICKEN 5
procedure bit->boolean (and curse us for deviating from the SRFI, not
knowing our alternatives were even worse).

The new bit->boolean procedure immediately has a sort of deprecated
status.  Later on, after enough time has passed to have ported all
CHICKEN 4 code, bit-set? may be re-introduced with the
correct (SRFI-compliant) argument order, and we can then officially
deprecate bit->boolean.  Even later still we can finally get rid of
this ugly temporary procedure.
---
 NEWS                          |  3 +++
 c-platform.scm                |  6 +++---
 chicken.h                     | 10 ++++++----
 library.scm                   |  4 +++-
 runtime.c                     |  9 +++++----
 tests/numbers-test-ashinn.scm |  4 ++--
 tests/numbers-test.scm        | 26 +++++++++++++-------------
 types.db                      |  8 ++++----
 8 files changed, 39 insertions(+), 31 deletions(-)

diff --git a/NEWS b/NEWS
index a7622b9b..6c0b6487 100644
--- a/NEWS
+++ b/NEWS
@@ -50,6 +50,9 @@
   - Added the `glob->sre` procedure to the irregex library.
   - Removed the `get-host-name' and `system-information' procedures.
     These are available in the "system-information" egg.
+  - Renamed bit-set? to bit->boolean because of swapped argument order
+    with respect to SRFI-33 and SRFI-60, which was confusing (fixes
+    #1385, thanks to Lemonboy).
 
 - Module system
   - The compiler has been modularised, for improved namespacing.  This
diff --git a/c-platform.scm b/c-platform.scm
index 100cccb9..f94dcfd4 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -157,7 +157,7 @@
     chicken.bitwise#integer-length
     chicken.bitwise#bitwise-and chicken.bitwise#bitwise-not
     chicken.bitwise#bitwise-ior chicken.bitwise#bitwise-xor
-    chicken.bitwise#arithmetic-shift chicken.bitwise#bit-set?
+    chicken.bitwise#arithmetic-shift chicken.bitwise#bit->boolean
     add1 sub1 exact-integer? nan? finite? infinite?
     void flush-output print print* error call/cc chicken.blob#blob-size
     identity chicken.blob#blob=? equal=? make-polar make-rectangular
@@ -1013,7 +1013,7 @@
 		      (list arg)) ) ) ) ) ) ) )
 
 (rewrite
- 'chicken.bitwise#bit-set? 8
+ 'chicken.bitwise#bit->boolean 8
  (lambda (db classargs cont callargs)
    (and (= 2 (length callargs))
 	(make-node
@@ -1021,7 +1021,7 @@
 	 (list cont
 	       (make-node
 		'##core#inline 
-		(list (if (eq? number-type 'fixnum) "C_u_i_bit_setp" "C_i_bit_setp"))
+		(list (if (eq? number-type 'fixnum) "C_u_i_bit_to_bool" "C_i_bit_to_bool"))
 		callargs) ) ) ) ) )
 
 (rewrite
diff --git a/chicken.h b/chicken.h
index 443565d3..6d72fcea 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1488,7 +1488,8 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 #define C_u_i_u64vector_set(x, i, v)    ((((C_u64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_uint64(v)), C_SCHEME_UNDEFINED)
 #define C_u_i_s64vector_set(x, i, v)    ((((C_s64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_int64(v)), C_SCHEME_UNDEFINED)
 
-#define C_u_i_bit_setp(x, i)            C_mk_bool((C_unfix(x) & (1 << C_unfix(i))) != 0)
+/* DEPRECATED */
+#define C_u_i_bit_to_bool(x, i)         C_mk_bool((C_unfix(x) & (1 << C_unfix(i))) != 0)
 
 #define C_u_i_pointer_u8_ref(ptr)         C_fix(*((unsigned char *)C_block_item(ptr, 0)))
 #define C_u_i_pointer_s8_ref(ptr)         C_fix(*((signed char *)C_block_item(ptr, 0)))
@@ -2058,7 +2059,7 @@ C_fctexport C_word C_fcall C_a_i_locative_ref(C_word **a, int c, C_word loc) C_r
 C_fctexport C_word C_fcall C_i_locative_set(C_word loc, C_word x) C_regparm;
 C_fctexport C_word C_fcall C_i_locative_to_object(C_word loc) C_regparm;
 C_fctexport C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_word object, C_word index, C_word weak) C_regparm;
-C_fctexport C_word C_fcall C_i_bit_setp(C_word n, C_word i) C_regparm;
+C_fctexport C_word C_fcall C_i_bit_to_bool(C_word n, C_word i) C_regparm; /* DEPRECATED */
 C_fctexport C_word C_fcall C_i_integer_length(C_word x) C_regparm;
 C_fctexport C_word C_fcall C_a_i_exp(C_word **a, int c, C_word n) C_regparm;
 C_fctexport C_word C_fcall C_a_i_log(C_word **a, int c, C_word n) C_regparm;
@@ -2986,10 +2987,11 @@ inline static C_word C_s_a_u_i_integer_abs(C_word **ptr, C_word n, C_word x)
   }
 }
 
-inline static C_word C_i_fixnum_bit_setp(C_word n, C_word i)
+/* DEPRECATED */
+inline static C_word C_i_fixnum_bit_to_bool(C_word n, C_word i)
 {
     if (i & C_INT_SIGN_BIT) {
-      C_not_an_uinteger_error(C_text("bit-set?"), i);
+      C_not_an_uinteger_error(C_text("bit->boolean"), i);
     } else {
       i = C_unfix(i);
       if (i >= C_WORD_SIZE) return C_mk_bool(n & C_INT_SIGN_BIT);
diff --git a/library.scm b/library.scm
index 99c32b7a..83706334 100644
--- a/library.scm
+++ b/library.scm
@@ -1187,7 +1187,9 @@ EOF
 (define bitwise-ior (##core#primitive "C_bitwise_ior"))
 (define bitwise-xor (##core#primitive "C_bitwise_xor"))
 (define (bitwise-not n) (##core#inline_allocate ("C_s_a_i_bitwise_not" 5) n))
-(define (bit-set? n i) (##core#inline "C_i_bit_setp" n i))
+(define (bit->boolean n i) (##core#inline "C_i_bit_to_bool" n i)) ; DEPRECATED
+;; XXX NOT YET! Reintroduce at a later time.  See #1385:
+;; (define (bit-set? i n) (##core#inline "C_i_bit_setp" i n))
 (define (integer-length x) (##core#inline "C_i_integer_length" x))
 (define (arithmetic-shift n m)
   (##core#inline_allocate ("C_s_a_i_arithmetic_shift" 5) n m)))
diff --git a/runtime.c b/runtime.c
index b40e3ba4..a2ccfd4e 100644
--- a/runtime.c
+++ b/runtime.c
@@ -6021,18 +6021,19 @@ inline static C_word maybe_negate_bignum_for_bitwise_op(C_word x, C_word size)
   return nx;
 }
 
-C_regparm C_word C_fcall C_i_bit_setp(C_word n, C_word i)
+/* DEPRECATED */
+C_regparm C_word C_fcall C_i_bit_to_bool(C_word n, C_word i)
 {
   if (!C_truep(C_i_exact_integerp(n))) {
-    barf(C_BAD_ARGUMENT_TYPE_NO_EXACT_INTEGER_ERROR, "bit-set?", n);
+    barf(C_BAD_ARGUMENT_TYPE_NO_EXACT_INTEGER_ERROR, "bit->boolean", n);
   } else if (!(i & C_FIXNUM_BIT)) {
     if (!C_immediatep(i) && C_truep(C_bignump(i)) && !C_bignum_negativep(i)) {
       return C_i_integer_negativep(n); /* A bit silly, but strictly correct */
     } else {
-      barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, "bit-set?", i);
+      barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, "bit->boolean", i);
     }
   } else if (i & C_INT_SIGN_BIT) {
-    barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, "bit-set?", i);
+    barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, "bit->boolean", i);
   } else {
     i = C_unfix(i);
     if (n & C_FIXNUM_BIT) {
diff --git a/tests/numbers-test-ashinn.scm b/tests/numbers-test-ashinn.scm
index 16913566..ca39f2eb 100644
--- a/tests/numbers-test-ashinn.scm
+++ b/tests/numbers-test-ashinn.scm
@@ -140,7 +140,7 @@
   (test-equal (arithmetic-shift #x100000000000000010000000000000000 64)
 	      #x1000000000000000100000000000000000000000000000000)
 
-  (test-assert (not (bit-set? 1 64)))
-  (test-assert (bit-set? #x10000000000000000 64)))
+  (test-assert (not (bit->boolean 1 64)))
+  (test-assert (bit->boolean #x10000000000000000 64)))
 
 (test-end)
diff --git a/tests/numbers-test.scm b/tests/numbers-test.scm
index d494f8f6..83222cb3 100644
--- a/tests/numbers-test.scm
+++ b/tests/numbers-test.scm
@@ -916,19 +916,19 @@
  (test-error (bitwise-and 1 'x))
  (test-error (bitwise-xor 1 'x))
  (test-error (bitwise-ior 1 'x))
- (test-error (bit-set? 1 -1))
- (test-error (bit-set? b1 -1))
- (test-error (bit-set? 1 1.0))
- (test-error (bit-set? 1.0 1))
- (test-equal (bit-set? -1 b1) #t)
- (test-equal (bit-set? 0 b1) #f)
- (test-equal (bit-set? 5 2) #t)
- (test-equal (bit-set? 5 0) #t)
- (test-equal (bit-set? 5 1) #f)
- (test-equal (bit-set? -2 0) #f)
- (test-equal (bit-set? -2 1) #t)
- (test-equal (bit-set? (expt -2 63) 256) #t)
- (test-equal (bit-set? (expt 2 63) 256) #f)
+ (test-error (bit->boolean 1 -1))
+ (test-error (bit->boolean b1 -1))
+ (test-error (bit->boolean 1 1.0))
+ (test-error (bit->boolean 1.0 1))
+ (test-equal (bit->boolean -1 b1) #t)
+ (test-equal (bit->boolean 0 b1) #f)
+ (test-equal (bit->boolean 5 2) #t)
+ (test-equal (bit->boolean 5 0) #t)
+ (test-equal (bit->boolean 5 1) #f)
+ (test-equal (bit->boolean -2 0) #f)
+ (test-equal (bit->boolean -2 1) #t)
+ (test-equal (bit->boolean (expt -2 63) 256) #t)
+ (test-equal (bit->boolean (expt 2 63) 256) #f)
  (test-equal (arithmetic-shift 15 2) 60)
  (test-equal (arithmetic-shift 15 -2) 3)
  (test-equal (arithmetic-shift -15 2) -60)
diff --git a/types.db b/types.db
index 9ac85708..c3f71c18 100644
--- a/types.db
+++ b/types.db
@@ -901,10 +901,10 @@
 (ratnum? (#(procedure #:pure #:predicate ratnum) ratnum? (*) boolean))
 (cplxnum? (#(procedure #:pure #:predicate cplxnum) cplxnum? (*) boolean))
 
-(chicken.bitwise#bit-set?
- (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bit-set? (integer integer) boolean)
-	  ((fixnum fixnum) (##core#inline "C_i_fixnum_bit_setp" #(1) #(2)))
-	  ((* *) (##core#inline "C_i_bit_setp" #(1) #(2))))
+(chicken.bitwise#bit->boolean
+ (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bit->boolean (integer integer) boolean)
+	  ((fixnum fixnum) (##core#inline "C_i_fixnum_bit_to_bool" #(1) #(2)))
+	  ((* *) (##core#inline "C_i_bit_to_bool" #(1) #(2))))
 
 (chicken.bitwise#bitwise-and
  (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-and (#!rest integer) integer)
-- 
2.11.0

Attachment: signature.asc
Description: PGP signature

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to