Changeset 35268 in project
 Timestamp:
 03/09/18 05:49:25 (13 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/bloomfilter/trunk/bloomfilter.scm
r35233 r35268 56 56 57 57 (definetype messagedigestprimitive (struct messagedigestprimitive)) 58 58 59 (definetype messagedigestprimitives (listof messagedigestprimitive)) 60 61 (definetype bytevector (or blob string)) 59 62 60 63 ;; … … 68 71 ;; 69 72 73 ;FIXME hashes are, mostly, 32bit & cannot distinguish anyway 74 75 (: unsignednativeintegersize (> number)) 76 ; 70 77 (define (unsignednativeintegersize) 71 unsignedinteger32size72 #;73 78 (condexpand 74 79 (64bit 75 unsignedinteger 64size )80 unsignedinteger32size #;unsignedinteger64size ) 76 81 (else 77 82 unsignedinteger32size ) ) ) 78 83 84 (: unsignednativeintegerref (bytevector fixnum > number)) 85 ; 79 86 (define (unsignednativeintegerref bv idx) 80 (unsignedinteger32ref bv idx)81 #;82 87 (condexpand 83 88 (64bit 84 (unsignedinteger 64ref bv idx) )89 (unsignedinteger32ref bv idx) #;(unsignedinteger64ref bv idx) ) 85 90 (else 86 91 (unsignedinteger32ref bv idx) ) ) ) … … 104 109 ;; 105 110 111 (: messagedigestprimitivelengths (messagedigestprimitives > (listof fixnum))) 112 ; 106 113 (define (messagedigestprimitivelengths mdps) 107 114 (map messagedigestprimitivedigestlength mdps) ) 108 115 116 (: bloomfilterindices (bloomfilter * > list)) 117 ; 109 118 (define (bloomfilterindices bf obj) 110 (fold 111 (lambda ( hasher ls) (hasher obj ls))119 (foldl 120 (lambda (ls hasher) (hasher obj ls)) 112 121 '() 113 122 (%bloomfilterhashers bf)) ) 114 123 124 (: bloomfilterkindices ()) 125 ; 115 126 (define (bloomfilterkindices bf obj) 116 127 (take! (bloomfilterindices bf obj) (%bloomfilterk bf)) ) 117 128 118 (define (bloomfilterfold bf func init obj) 119 (fold func init (bloomfilterkindices bf obj)) ) 120 121 (defineinline (messagedigestresult>integers bv m unicnt bytcnt ls) 129 (: bloomfilterfoldl ()) 130 ; 131 (define (bloomfilterfoldl bf func init obj) 132 (foldl func init (bloomfilterkindices bf obj)) ) 133 134 (defineinline (messagedigestresult>integers bv m wrdcnt bytrem ls) 122 135 ; 123 (define ( unis)136 (define (words) 124 137 (let loop ((idx 0) (ls ls)) 125 (if (fx= idx unicnt)138 (if (fx= idx wrdcnt) 126 139 ls 127 140 (let* ( 128 (num (unsignednativeintegerref bv idx) 129 (int (inexact>exact (remainder num m)) 141 (num (unsignednativeintegerref bv idx)) 142 (int (inexact>exact (remainder num m))) ) 130 143 (loop (fx+ idx 1) (cons int ls)) ) ) ) ) 131 144 ; 132 145 (let* ( 133 (ptr (object>pointer bv) 134 (bytoff (fx* unicnt (unsignednativeintegersize)))135 (ptr (pointer+ ptr bytoff) 146 (ptr (object>pointer bv)) 147 (bytoff (fx* wrdcnt (unsignednativeintegersize))) 148 (ptr (pointer+ ptr bytoff)) ) 136 149 (do ( 137 (cnt byt cnt (fx cnt 1))138 (ptr ptr (pointer+ ptr 1) 139 (int 0 (+ int (pointeru8ref ptr)) 150 (cnt bytrem (fx cnt 1)) 151 (ptr ptr (pointer+ ptr 1)) 152 (int 0 (+ int (pointeru8ref ptr))) ) 140 153 ((fx= 0 cnt) 141 (reverse! (cons int ( unis))) ) ) ) )154 (reverse! (cons int (words))) ) ) ) ) 142 155 143 156 (define (makebloomfilterhasher mdp m) 144 157 (let ( 145 (unicnt 146 (fx/ 147 (messagedigestprimitivedigestlength mdp) 148 (unsignednativeintegersize)) ) 149 (bytcnt 150 (fxmod 151 (messagedigestprimitivedigestlength mdp) 152 (unsignednativeintegersize)) ) ) 153 ;returns a list of hash values for the supplied object 154 (lambda (obj ls) 155 (messagedigestresult>integers 156 (messagedigestobject mdp obj 'blob) 157 m unicnt bytcnt ls) ) ) ) 158 (len (messagedigestprimitivedigestlength mdp)) 159 (siz (unsignednativeintegersize)) ) 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 (messagedigestobject mdp obj 'blob)) ) 167 (messagedigestresult>integers blb m wrdcnt bytrem ls) ) ) ) ) ) 158 168 159 169 ;;; Calculators … … 225 235 (definecheck+errortype bloomfilter %bloomfilter?) 226 236 227 (: bloomfilteralgorithms (bloomfilter  > messagedigestprimitives))237 (: bloomfilteralgorithms (bloomfilter > messagedigestprimitives)) 228 238 ; 229 239 (define (bloomfilteralgorithms bf) … … 232 242 (checkbloomfilter 'bloomfilteralgorithms bf))) ) 233 243 234 (: bloomfiltern (bloomfilter  > fixnum))244 (: bloomfiltern (bloomfilter > fixnum)) 235 245 ; 236 246 (define (bloomfiltern bf) 237 247 (%bloomfiltern (checkbloomfilter 'bloomfiltern bf)) ) 238 248 239 (: bloomfilterm (bloomfilter  > fixnum))249 (: bloomfilterm (bloomfilter > fixnum)) 240 250 ; 241 251 (define (bloomfilterm bf) 242 252 (%bloomfilterm (checkbloomfilter 'bloomfilterm bf)) ) 243 253 244 (: bloomfilterk (bloomfilter  > fixnum))254 (: bloomfilterk (bloomfilter > fixnum)) 245 255 ; 246 256 (define (bloomfilterk bf) … … 248 258 249 259 ;FIXME makebloomfilter type is ugh 260 ;( p n mdps)  ( m mdps [k]) 250 261 (: makebloomfilter ((or fixnum number) (or fixnum messagedigestprimitives) #!optional (or fixnum messagedigestprimitives) > bloomfilter)) 251 262 ; 252 ;( p n mdps)  ( m mdps [k])253 263 (define (makebloomfilter m mdps #!optional desk) 254 264 ;processing ( m mdps [k] ) or ( p n mdps ) ? … … 256 266 (checkpositivefixnum 'makebloomfilter m 'm) 257 267 (let ( 258 (p m) 259 (n mdps) ) 260 (checkopeninterval 'makebloomfilter (checkflonum 'makebloomfilter p 'p) 0.0 1.0 'p) 261 (checkpositivefixnum 'makebloomfilter n 'n) 268 (p (checkflonum 'makebloomfilter m 'p)) 269 (n (checkpositivefixnum 'makebloomfilter mdps 'n)) ) 270 (checkopeninterval 'makebloomfilter p 0.0 1.0 'p) 262 271 (set! mdps desk) 263 272 (set!values (m desk) (optimumsize p n)) ) ) 264 ; 273 ;algorithms 265 274 (foreach 266 275 (cut checkmessagedigestprimitive 'makebloomfilter <>) … … 280 289 mdps) ) 281 290 282 (: bloomfilterpfalsepositive (bloomfilter  > number))291 (: bloomfilterpfalsepositive (bloomfilter > number)) 283 292 ; 284 293 (define (bloomfilterpfalsepositive bf . n) … … 295 304 (%bloomfilterbitsset! 296 305 bf 297 (bloomfilterfold 306 (bloomfilterfoldl 298 307 bf 299 (lambda ( idx bits) (bitvectorset! bits idx #t))308 (lambda (bits idx) (bitvectorset! bits idx #t)) 300 309 (%bloomfilterbits bf) 301 310 obj)) … … 310 319 (fx= 311 320 (%bloomfilterk bf) 312 (bloomfilterfold 321 (bloomfilterfoldl 313 322 bf 314 (lambda ( idx cnt) (if (bitvectorref bits idx) (fx+ cnt 1) cnt))323 (lambda (cnt idx) (if (bitvectorref bits idx) (fx+ cnt 1) cnt)) 315 324 0 316 325 obj)) ) )
Note: See TracChangeset
for help on using the changeset viewer.