From 32b45a6ac3b0297762c1d5bb85847535d85abedb Mon Sep 17 00:00:00 2001 From: Peter Bex 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