Changeset 35268 in project


Ignore:
Timestamp:
03/09/18 05:49:25 (9 months ago)
Author:
kon
Message:

more types, re-flow

File:
1 edited

Legend:

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

    r35233 r35268  
    5656
    5757(define-type message-digest-primitive (struct message-digest-primitive))
     58
    5859(define-type message-digest-primitives (list-of message-digest-primitive))
     60
     61(define-type bytevector (or blob string))
    5962
    6063;;
     
    6871;;
    6972
     73;FIXME hashes are, mostly, 32-bit & cannot distinguish anyway
     74
     75(: unsigned-native-integer-size (-> number))
     76;
    7077(define (unsigned-native-integer-size)
    71   unsigned-integer32-size
    72   #;
    7378  (cond-expand
    7479    (64bit
    75       unsigned-integer64-size )
     80      unsigned-integer32-size #;unsigned-integer64-size )
    7681    (else
    7782      unsigned-integer32-size ) ) )
    7883
     84(: unsigned-native-integer-ref (bytevector fixnum --> number))
     85;
    7986(define (unsigned-native-integer-ref bv idx)
    80   (unsigned-integer32-ref bv idx)
    81   #;
    8287  (cond-expand
    8388    (64bit
    84       (unsigned-integer64-ref bv idx) )
     89      (unsigned-integer32-ref bv idx) #;(unsigned-integer64-ref bv idx) )
    8590    (else
    8691      (unsigned-integer32-ref bv idx) ) ) )
     
    104109;;
    105110
     111(: message-digest-primitive-lengths (message-digest-primitives --> (list-of fixnum)))
     112;
    106113(define (message-digest-primitive-lengths mdps)
    107114  (map message-digest-primitive-digest-length mdps) )
    108115
     116(: bloom-filter-indices (bloom-filter * --> list))
     117;
    109118(define (bloom-filter-indices bf obj)
    110   (fold
    111     (lambda (hasher ls) (hasher obj ls))
     119  (foldl
     120    (lambda (ls hasher) (hasher obj ls))
    112121    '()
    113122    (%bloom-filter-hashers bf)) )
    114123
     124(: bloom-filter-k-indices ())
     125;
    115126(define (bloom-filter-k-indices bf obj)
    116127  (take! (bloom-filter-indices bf obj) (%bloom-filter-k bf)) )
    117128
    118 (define (bloom-filter-fold bf func init obj)
    119   (fold func init (bloom-filter-k-indices bf obj)) )
    120 
    121 (define-inline (message-digest-result->integers bv m unicnt bytcnt ls)
     129(: bloom-filter-foldl ())
     130;
     131(define (bloom-filter-foldl bf func init obj)
     132  (foldl func init (bloom-filter-k-indices bf obj)) )
     133
     134(define-inline (message-digest-result->integers bv m wrdcnt bytrem ls)
    122135  ;
    123   (define (unis)
     136  (define (words)
    124137    (let loop ((idx 0) (ls ls))
    125       (if (fx= idx unicnt)
     138      (if (fx= idx wrdcnt)
    126139        ls
    127140        (let* (
    128           (num (unsigned-native-integer-ref bv idx) )
    129           (int (inexact->exact (remainder num m)) ) )
     141          (num (unsigned-native-integer-ref bv idx))
     142          (int (inexact->exact (remainder num m))) )
    130143          (loop (fx+ idx 1) (cons int ls)) ) ) ) )
    131144  ;
    132145  (let* (
    133     (ptr (object->pointer bv) )
    134     (bytoff (fx* unicnt (unsigned-native-integer-size)) )
    135     (ptr (pointer+ ptr bytoff) ) )
     146    (ptr (object->pointer bv))
     147    (bytoff (fx* wrdcnt (unsigned-native-integer-size)))
     148    (ptr (pointer+ ptr bytoff)) )
    136149    (do (
    137       (cnt bytcnt (fx- cnt 1) )
    138       (ptr ptr (pointer+ ptr 1) )
    139       (int 0 (+ int (pointer-u8-ref ptr)) ) )
     150      (cnt bytrem (fx- cnt 1))
     151      (ptr ptr (pointer+ ptr 1))
     152      (int 0 (+ int (pointer-u8-ref ptr))) )
    140153      ((fx= 0 cnt)
    141         (reverse! (cons int (unis))) ) ) ) )
     154        (reverse! (cons int (words))) ) ) ) )
    142155
    143156(define (make-bloom-filter-hasher mdp m)
    144157  (let (
    145     (unicnt
    146       (fx/
    147         (message-digest-primitive-digest-length mdp)
    148         (unsigned-native-integer-size)) )
    149     (bytcnt
    150       (fxmod
    151         (message-digest-primitive-digest-length mdp)
    152         (unsigned-native-integer-size)) ) )
    153     ;returns a list of hash values for the supplied object
    154     (lambda (obj ls)
    155       (message-digest-result->integers
    156         (message-digest-object mdp obj 'blob)
    157         m unicnt bytcnt ls) ) ) )
     158    (len (message-digest-primitive-digest-length mdp))
     159    (siz (unsigned-native-integer-size)) )
     160    (let (
     161      (wrdcnt (fx/ len siz) )
     162      (bytrem (fxmod len siz) ) )
     163      ;returns a list of hash values for the supplied object
     164      (lambda (obj ls)
     165        (let (
     166          (blb (message-digest-object mdp obj 'blob)) )
     167          (message-digest-result->integers blb m wrdcnt bytrem ls) ) ) ) ) )
    158168
    159169;;; Calculators
     
    225235(define-check+error-type bloom-filter %bloom-filter?)
    226236
    227 (: bloom-filter-algorithms (bloom-filter -> message-digest-primitives))
     237(: bloom-filter-algorithms (bloom-filter --> message-digest-primitives))
    228238;
    229239(define (bloom-filter-algorithms bf)
     
    232242      (check-bloom-filter 'bloom-filter-algorithms bf))) )
    233243
    234 (: bloom-filter-n (bloom-filter -> fixnum))
     244(: bloom-filter-n (bloom-filter --> fixnum))
    235245;
    236246(define (bloom-filter-n bf)
    237247  (%bloom-filter-n (check-bloom-filter 'bloom-filter-n bf)) )
    238248
    239 (: bloom-filter-m (bloom-filter -> fixnum))
     249(: bloom-filter-m (bloom-filter --> fixnum))
    240250;
    241251(define (bloom-filter-m bf)
    242252  (%bloom-filter-m (check-bloom-filter 'bloom-filter-m bf)) )
    243253
    244 (: bloom-filter-k (bloom-filter -> fixnum))
     254(: bloom-filter-k (bloom-filter --> fixnum))
    245255;
    246256(define (bloom-filter-k bf)
     
    248258
    249259;FIXME make-bloom-filter type is ugh
     260;( p n mdps) | ( m mdps [k])
    250261(: make-bloom-filter ((or fixnum number) (or fixnum message-digest-primitives) #!optional (or fixnum message-digest-primitives) -> bloom-filter))
    251262;
    252 ;( p n mdps) | ( m mdps [k])
    253263(define (make-bloom-filter m mdps #!optional des-k)
    254264  ;processing ( m mdps [k] ) or ( p n mdps ) ?
     
    256266    (check-positive-fixnum 'make-bloom-filter m 'm)
    257267    (let (
    258       (p m)
    259       (n mdps) )
    260       (check-open-interval 'make-bloom-filter (check-flonum 'make-bloom-filter p 'p) 0.0 1.0 'p)
    261       (check-positive-fixnum 'make-bloom-filter n 'n)
     268      (p (check-flonum 'make-bloom-filter m 'p))
     269      (n (check-positive-fixnum 'make-bloom-filter mdps 'n)) )
     270      (check-open-interval 'make-bloom-filter p  0.0 1.0 'p)
    262271      (set! mdps des-k)
    263272      (set!-values (m des-k) (optimum-size p n)) ) )
    264   ;
     273  ;algorithms
    265274  (for-each
    266275    (cut check-message-digest-primitive 'make-bloom-filter <>)
     
    280289    mdps) )
    281290
    282 (: bloom-filter-p-false-positive (bloom-filter -> number))
     291(: bloom-filter-p-false-positive (bloom-filter --> number))
    283292;
    284293(define (bloom-filter-p-false-positive bf . n)
     
    295304  (%bloom-filter-bits-set!
    296305    bf
    297     (bloom-filter-fold
     306    (bloom-filter-foldl
    298307      bf
    299       (lambda (idx bits) (bit-vector-set! bits idx #t))
     308      (lambda (bits idx) (bit-vector-set! bits idx #t))
    300309      (%bloom-filter-bits bf)
    301310      obj))
     
    310319    (fx=
    311320      (%bloom-filter-k bf)
    312       (bloom-filter-fold
     321      (bloom-filter-foldl
    313322        bf
    314         (lambda (idx cnt) (if (bit-vector-ref bits idx) (fx+ cnt 1) cnt))
     323        (lambda (cnt idx) (if (bit-vector-ref bits idx) (fx+ cnt 1) cnt))
    315324        0
    316325        obj)) ) )
Note: See TracChangeset for help on using the changeset viewer.