Changeset 36365 in project


Ignore:
Timestamp:
08/24/18 15:42:06 (3 months ago)
Author:
kon
Message:

word stuff use consts & less indirection (explicit), easier read

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/bloom-filter/trunk/bloom-filter.scm

    r36232 r36365  
    7373;;
    7474
    75 (define (machine-word-size)
     75(define-constant MACHINE-WORD-SIZE
    7676  (cond-expand
    7777    (64bit
     
    8282(define (object-data-pointer obj)
    8383  ;skip over the machine-word header
    84   (pointer+ (object->pointer obj) (machine-word-size)) )
    85 
     84  (pointer+ (object->pointer obj) MACHINE-WORD-SIZE) )
     85
     86;
    8687(cond-expand
    8788  (64bit
     89    (: unsigned-integer64-ref (* fixnum --> (or fixnum bignum)))
    8890    (define (unsigned-integer64-ref obj idx)
    8991      (pointer-u64-ref (pointer+ (object-data-pointer obj) idx)) ) )
    9092  (else
     93    (: unsigned-integer32-ref (* fixnum --> (or fixnum bignum)))
    9194    (define (unsigned-integer32-ref obj idx)
    9295      (pointer-u32-ref (pointer+ (object-data-pointer obj) idx)) ) ) )
     
    9497(: unsigned-native-integer-ref (* fixnum --> (or fixnum bignum)))
    9598;
    96 (define (unsigned-native-integer-ref obj idx)
     99(define unsigned-native-integer-ref
    97100  (cond-expand
    98101    (64bit
    99       (unsigned-integer64-ref obj idx) )
     102      unsigned-integer64-ref )
    100103    (else
    101       (unsigned-integer32-ref obj idx) ) ) )
     104      unsigned-integer32-ref ) ) )
    102105
    103106;;; Record Type
     
    157160  (let* (
    158161    (ptr (object->pointer obj))
    159     (bytoff (fx* wrdcnt (machine-word-size)))
     162    (bytoff (fx* wrdcnt MACHINE-WORD-SIZE))
    160163    (ptr (pointer+ ptr bytoff)) )
    161164    (do (
     
    170173(define (make-bloom-filter-hasher mdp m)
    171174  (let (
    172     (len (message-digest-primitive-digest-length mdp))
    173     (siz (machine-word-size)) )
     175    (len (message-digest-primitive-digest-length mdp)) )
    174176    (let (
    175       (wrdcnt (fx/ len siz) )
    176       (bytrem (fxmod len siz) ) )
     177      (wrdcnt (fx/ len MACHINE-WORD-SIZE) )
     178      (bytrem (fxmod len MACHINE-WORD-SIZE) ) )
    177179      ;returns a list of hash values for the supplied object
    178180      (lambda (obj ls)
    179         (let (
    180           (blb (message-digest-object mdp obj 'blob)) )
     181        (let ((blb (message-digest-object mdp obj 'blob)))
    181182          (message-digest-result->integers blb m wrdcnt bytrem ls) ) ) ) ) )
    182183
     
    186187;; Returns the upper-bound
    187188
    188 (: optimum-size (float fixnum --> fixnum fixnum))
    189 ;
    190189;n : capacity, p : probability of false-positive
    191190;=> m : bits, k : hashes
     191(: optimum-size (float fixnum --> fixnum fixnum))
     192;
    192193(define (optimum-size p n)
    193194  (let* (
     
    251252;
    252253(define (actual-k mdps)
    253   (let (
    254     (siz (machine-word-size)) )
    255     (foldl
    256       (lambda (tot len) (fx+ tot (fx/ len siz)))
    257       0
    258       (message-digest-primitive-lengths mdps)) ) )
     254  (let ((wrdcntr (lambda (tot len) (fx+ tot (fx/ len MACHINE-WORD-SIZE)))))
     255    (foldl wrdcntr 0 (message-digest-primitive-lengths mdps)) ) )
    259256
    260257;;; Bloom Filter
     
    330327    (%bloom-filter-m bf)) )
    331328
     329;
     330(define (*bitset bits idx)
     331  (bit-vector-set! bits idx #t)
     332  bits )
     333
    332334(: bloom-filter-set! (bloom-filter * -> void))
    333335;
    334336(define (bloom-filter-set! bf obj)
     337  ;tracks actual pop (n) so cannot "reset"
    335338  (unless (bloom-filter-exists? (check-bloom-filter 'bloom-filter-set! bf) obj)
    336     (let (
    337       (bits
    338         (bloom-filter-foldl
    339           bf
    340           (lambda (bits idx)
    341             (bit-vector-set! bits idx #t)
    342             bits )
    343           (%bloom-filter-bits bf)
    344           obj)) )
     339    ;spray rep bits
     340    (let ((bits (bloom-filter-foldl bf *bitset (%bloom-filter-bits bf) obj)))
    345341      (%bloom-filter-bits-set! bf bits) )
     342    ;bump actual pop
    346343    (%bloom-filter-n-set! bf (fx+ (%bloom-filter-n bf) 1)) ) )
    347344
     
    351348  (let* (
    352349    (bits
    353       (%bloom-filter-bits (check-bloom-filter 'bloom-filter-exists? bf)))
     350      (%bloom-filter-bits (check-bloom-filter 'bloom-filter-exists? bf)) )
     351    (bitcnt
     352      (lambda (cnt idx) (if (bit-vector-ref bits idx) (fx+ cnt 1) cnt)) )
    354353    (refs
    355       (bloom-filter-foldl
    356         bf
    357         (lambda (cnt idx)
    358           (if (bit-vector-ref bits idx)
    359             (fx+ cnt 1)
    360             cnt ) )
    361         0
    362         obj)) )
    363     (fx= (%bloom-filter-k bf) refs) ) )
     354      (bloom-filter-foldl bf bitcnt 0 obj)) )
     355    (fx<= (%bloom-filter-k bf) refs) ) )
    364356
    365357) ;module bloom-filter
Note: See TracChangeset for help on using the changeset viewer.