~ chicken-core (chicken-5) 45489c1b3d9fb20bacc91fa393ce7330dd61d22f

commit 45489c1b3d9fb20bacc91fa393ce7330dd61d22f
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Tue Aug 8 19:48:07 2017 +0200
Commit:     Kooda <kooda@upyum.com>
CommitDate: Sat Aug 19 23:59:36 2017 +0200

    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.
    
    Signed-off-by: Kooda <kooda@upyum.com>

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 49a95a2a..73561317 100644
--- a/library.scm
+++ b/library.scm
@@ -1186,7 +1186,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 be42b13b..827d151d 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)