Changeset 31510 in project


Ignore:
Timestamp:
09/26/14 21:58:18 (5 years ago)
Author:
sjamaan
Message:

numbers: Implement eqv? as an inlineable C function. It's only C_regparm, not C_inline right now due us being able to hide the ratnum/compnum tag (should that be done?)

Location:
release/4/numbers/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/numbers-c.c

    r31507 r31510  
    269269}
    270270
     271#define ratnum_type_tag C_block_item(CHICKEN_gc_root_ref(tags), RAT_TAG)
     272#define compnum_type_tag C_block_item(CHICKEN_gc_root_ref(tags), COMP_TAG)
     273
     274C_inline C_word basic_eqvp(C_word x, C_word y)
     275{
     276  return (x == y ||
     277
     278          (!C_immediatep(x) && !C_immediatep(y) &&
     279           C_block_header(x) == C_block_header(y) &&
     280           
     281           ((C_block_header(x) == C_FLONUM_TAG &&
     282             C_flonum_magnitude(x) == C_flonum_magnitude(y)) ||
     283           
     284            (C_IS_BIGNUM_TYPE(x) && C_u_i_bignum_cmp(x, y) == C_fix(0)))));
     285}
     286
     287/* TODO: Rename to C_i_eqvp */
     288C_regparm C_word C_fcall
     289C_word C_i_numbers_eqvp(C_word x, C_word y)
     290{
     291  return
     292    C_mk_bool(basic_eqvp(x, y) ||
     293              !C_immediatep(x) && !C_immediatep(y) &&
     294              (C_block_header(x) == C_block_header(y) &&
     295               C_header_bits(x) == C_STRUCTURE_TYPE &&
     296               C_block_item(x, 0) == C_block_item(y, 0) &&
     297               (C_block_item(x, 0) == ratnum_type_tag ||
     298                C_block_item(x, 0) == compnum_type_tag) &&
     299               basic_eqvp(C_block_item(x, 1), C_block_item(y, 1)) &&
     300               basic_eqvp(C_block_item(x, 2), C_block_item(y, 2))));
     301}
     302
    271303/* Copy all the digits from source to target, obliterating what was
    272304 * there.  If target is larger than source, the most significant
  • release/4/numbers/trunk/numbers-c.h

    r31507 r31510  
    9292C_word C_ccall C_bignum_normalize(C_word big);
    9393C_regparm double C_bignum_to_double(C_word bignum);
     94C_regparm C_word C_fcall C_word C_i_numbers_eqvp(C_word x, C_word y);
     95
    9496
    9597void C_ccall C_2_basic_gcd(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y) C_noret;
  • release/4/numbers/trunk/numbers.scm

    r31504 r31510  
    511511                    (loop h (##sys#slot xs 1)) ) ) ) ) ))
    512512
    513 (define (eqv? a b)
    514   (let ((ta (%check-number a))
    515         (tb (%check-number b)))
    516     ;; If both are numbers of the same type and exactness, compare.
    517     ;; Otherwise use eq? Characters are already compared correctly by eq?
    518     (and (eq? ta tb)
    519          (switchq ta
    520            (NONE (eq? a b))
    521            (FLO  (fp= a b))
    522            (FIX  (fx= a b))
    523            (BIG  (fx= (%big-cmp a b) 0))
    524            ;; TODO: Use integer= here, when we write it
    525            (RAT  (and (%= (ratnum-numerator a) (ratnum-numerator b))
    526                       (%= (ratnum-denominator a) (ratnum-denominator b))))
    527            ;; We use eqv? here because exactness of components needs to match
    528            (COMP (and (eqv? (compnum-real a) (compnum-real b))
    529                       (eqv? (compnum-imag a) (compnum-imag b))))
    530            (else (error "This should not happen"))))))
     513(define (eqv? a b) (##core#inline "C_i_numbers_eqvp" a b))
    531514
    532515(define (@extended-2-> loc x y)
Note: See TracChangeset for help on using the changeset viewer.