Changeset 9028 in project
 Timestamp:
 02/26/08 15:44:28 (13 years ago)
 Location:
 release/3/perfecthash
 Files:

 2 added
 4 copied
 10 moved
Legend:
 Unmodified
 Added
 Removed

release/3/perfecthash/trunk/perfecthashrecordmacros.scm
r9024 r9028 13 13 14 14 ;; 2^(fxlog2 n) for positive n 15 #;(defineinline (fxpow2log2 n) 15 #; 16 (defineinline (fxpow2log2 n) 16 17 (let loop ([ncnt 1]) 17 18 (if (fx< ncnt n) 18 (loop (fxshl ncnt 1))19 ncnt ) ) )19 (loop (fxshl ncnt 1)) 20 ncnt ) ) ) 20 21 21 22 (definemacro (%constantly X) … … 31 32 (vec phtvector phtvectorset!) 32 33 (siz phtsize phtsizeset!) 33 #;(a phta phtaset!) 34 #;(b phtb phtbset!) 35 #;(mask phtmask phtmaskset!)) 34 #; 35 (a phta phtaset!) 36 #; 37 (b phtb phtbset!) 38 #; 39 (mask phtmask phtmaskset!)) 36 40 37 41 (defineinline (phtemptymark? val) … … 44 48 (fxshr (phtlength pht) 1) ) 45 49 46 #;(defineinline (checkvectorlimit cnt) 50 #; 51 (defineinline (checkvectorlimit cnt) 47 52 (when (fx> cnt (perfecthashtablecountmaximum)) 48 53 (error "perfect hash table limit reached" cnt)) ) 
release/3/perfecthash/trunk/perfecthashsupport.scm
r9024 r9028 5 5 6 6 (definemacro (statsexpand!? FORM #!optional (OTHER '(begin))) 7 #;FORM OTHER ) 7 #; 8 FORM 9 OTHER ) 8 10 9 11 (definemacro (stats!? FORM #!optional (OTHER '(begin))) … … 61 63 ((phtequivalenceprocedure pht) key1 key2) ) 62 64 63 #;(defineinline (phtmaskforcount cnt) 65 #; 66 (defineinline (phtmaskforcount cnt) 64 67 (fxshr mostpositivefixnum (fx fixnumprecision (fxlog2 cnt))) ) 65 68 66 #;(defineinline (newphtmask! pht cnt) 69 #; 70 (defineinline (newphtmask! pht cnt) 67 71 (phtmaskset! pht (phtmaskforcount cnt)) ) 68 72 69 #;(defineinline (%phthashindex h a b m) 73 #; 74 (defineinline (%phthashindex h a b m) 70 75 (let ([h (fxand (fxxor (fxshr h a) (fxshr h b)) m)]) 71 76 (fx+ h h) ) ) 72 77 73 #;(define %phthashindex 78 #; 79 (define %phthashindex 74 80 (foreignlambda* unsignedint 75 81 ((unsignedinteger h) (unsignedint a) (unsignedint b) (unsignedint m)) 76 82 "unsigned int c = ((h >> a) ^ (h >> b)) & m; return(c + c);") ) 77 83 78 #;(defineinline (phthashindex pht key) 84 #; 85 (defineinline (phthashindex pht key) 79 86 (%phthashindex (phthashvalue pht key) (phta pht) (phtb pht) (phtmask pht)) ) 80 87 … … 88 95 (defineinline (phtvectorupdate! pht vec #;cnt) 89 96 (phtvectorset! pht vec) 90 #;(newphtmask! pht cnt) ) 97 #; 98 (newphtmask! pht cnt) ) 91 99 92 100 (defineinline (phtclearvector! vec) … … 94 102 95 103 (defineinline (phtvecref idx vec) 96 #;(vectorref vec idx) 104 #; 105 (vectorref vec idx) 97 106 (##sys#slot vec idx) ) 98 107 99 108 (defineinline (phtvecset! idx obj vec) 100 #;(vectorset! vec idx obj) 109 #; 110 (vectorset! vec idx obj) 101 111 (##sys#setslot vec idx obj) ) 102 112 … … 140 150 (not (phtkeyempty? idx vec)) ) 141 151 142 #;(defineinline (phtusedslot? idx vec) 152 #; 153 (defineinline (phtusedslot? idx vec) 143 154 (and (not (phtkeyempty? idx vec)) 144 155 (not (phtvalueempty? idx vec))) ) … … 153 164 (phtkeyequal? pht key keyat)) ) ) 154 165 155 #;(defineinline (phtkeyslotequal? pht key idx vec) 166 #; 167 (defineinline (phtkeyslotequal? pht key idx vec) 156 168 (and (phtusedslot? idx vec) 157 169 (phtkeyequal? pht key (phtkeyref idx vec))) ) … … 207 219 (vectorloop (fx+ idx 2))] ) ) ) ) ) 208 220 209 #;(defineinline (phtneededcount pht extra) 221 #; 222 (defineinline (phtneededcount pht extra) 210 223 (fxpow2log2 (fx+ extra (phtsize pht))) ) 211 224 212 #;(defineinline (phtinitrehash pht) 225 #; 226 (defineinline (phtinitrehash pht) 213 227 (phtaset! pht 1) 214 228 (phtbset! pht 0) 215 229 (copyphtvector pht (phtneededcount pht 1)) ) 216 230 217 #;(defineinline (phtnextrehash pht) 231 #; 232 (defineinline (phtnextrehash pht) 218 233 (let ([nb (fx++ (phtb pht))] 219 234 [a (phta pht)]) … … 232 247 (copyphtvector! pht (fxmax (phtcount pht) (phtsize pht))) ) 233 248 234 #;(defineinline (phtnextrehash pht) 249 #; 250 (defineinline (phtnextrehash pht) 235 251 (newphtvector! pht 236 252 (fx+ (perfecthashtablegrowbias) … … 315 331 [vec (phtvector pht)] 316 332 [cnt (phtcount pht)] 317 #;[a (phta pht)] 318 #;[b (phtb pht)] 319 #;[m (phtmask pht)]) 333 #; 334 [a (phta pht)] 335 #; 336 [b (phtb pht)] 337 #; 338 [m (phtmask pht)]) 320 339 (lambda (key) 321 340 (let ([idx (%phthashindex (hf key) cnt #;a #;b #;m)]) 
release/3/perfecthash/trunk/perfecthash.scm
r9024 r9028 51 51 (error loc "not a list" obj)) ) 52 52 53 (define (checkproc obj kind loc)53 (define (checkprocedure obj kind loc) 54 54 (unless (procedure? obj) 55 55 (errorf loc "~S argument not a procedure: ~A" kind obj)) ) … … 62 62 63 63 (define (makeperfecthashtable #!optional (eqp equal?) (hshp hash) (size 1)) 64 (checkproc eqp "equal" 'makeperfecthashtable)65 (checkproc hshp "hash" 'makeperfecthashtable)64 (checkprocedure eqp "equal" 'makeperfecthashtable) 65 (checkprocedure hshp "hash" 'makeperfecthashtable) 66 66 (unless (and (fixnum? size) (fxpos? size)) 67 67 (error 'makeperfecthashtable "size is not a positive fixnum" size)) … … 69 69 70 70 (define (alist>perfecthashtable alist #!optional (eqp equal?) (hshp hash)) 71 (checkproc eqp "equal" 'makeperfecthashtable)72 (checkproc hshp "hash" 'makeperfecthashtable)71 (checkprocedure eqp "equal" 'makeperfecthashtable) 72 (checkprocedure hshp "hash" 'makeperfecthashtable) 73 73 (checklist alist 'makeperfecthashtable) 74 74 (let ([pht (makepht hshp eqp (length alist))]) … … 96 96 (define (makeperfecthashtableaccessor pht #!optional (thunk (%constantly (error 'perfecthashaccessor "not found")))) 97 97 (checkpht pht 'makeperfecthashtableaccessor) 98 (checkproc thunk "thunk" 'makeperfecthashtableaccessor)98 (checkprocedure thunk "thunk" 'makeperfecthashtableaccessor) 99 99 (*makephtref pht thunk) ) 100 100 … … 109 109 (checkpht pht 'perfecthashtableref) 110 110 (checkkey key 'perfecthashtableref) 111 (checkproc thunk "thunk" 'perfecthashtableref)111 (checkprocedure thunk "thunk" 'perfecthashtableref) 112 112 (*phtref pht key thunk) ) 113 113 perfecthashtableset!) ) … … 130 130 (checkpht pht 'perfecthashtableupdate!) 131 131 (checkkey key 'perfecthashtableupdate!) 132 (checkproc func "function" 'perfecthashtableupdate!)133 (checkproc thunk "thunk" 'perfecthashtableupdate!)132 (checkprocedure func "function" 'perfecthashtableupdate!) 133 (checkprocedure thunk "thunk" 'perfecthashtableupdate!) 134 134 (*phtset! pht key (func (*phtref pht key thunk))) ) 135 135 … … 137 137 (checkpht pht 'perfecthashtableupdate!/default) 138 138 (checkkey key 'perfecthashtableupdate!/default) 139 (checkproc func "function" 'perfecthashtableupdate!/default)139 (checkprocedure func "function" 'perfecthashtableupdate!/default) 140 140 (*phtset! pht key (func (*phtref pht key (%constantly default)))) ) 141 141 … … 146 146 (define (perfecthashtablefold pht proc accum) 147 147 (checkpht pht 'perfecthashtablefold) 148 (checkproc proc "function" 'perfecthashtablefold)148 (checkprocedure proc "function" 'perfecthashtablefold) 149 149 (*phtfold proc pht accum) ) 150 150 … … 159 159 (define (perfecthashtablewalk pht proc) 160 160 (checkpht pht 'perfecthashtablewalk) 161 (checkproc proc "procedure" 'perfecthashtablewalk)161 (checkprocedure proc "procedure" 'perfecthashtablewalk) 162 162 (*phtwalk proc pht) ) 163 163 … … 173 173 (vectorcopy (phtvector pht)) 174 174 (phtsize pht) 175 #;(phta pht) 176 #;(phtb pht) 177 #;(phtmask pht)) ) 175 #; 176 (phta pht) 177 #; 178 (phtb pht) 179 #; 180 (phtmask pht)) ) 178 181 179 182 (define (perfecthashtablemerge! pht1 pht2) 
release/3/perfecthash/trunk/perfecthash.setup
r9024 r9028 7 7 'miscmacros "2.4") 8 8 9 (installdynld perfecthashparameters "0.1") ; O3 d010 (installdynld perfecthashsupport "0.1") ; O3 d011 (installdynld+docu perfecthash "0.1"9 (installdynld perfecthashparameters *version*) ; O3 d0 10 (installdynld perfecthashsupport *version*) ; O3 d0 11 (installdynld+docu perfecthash *version* 12 12 (requiresatruntime perfecthashsupport)) 13 13
Note: See TracChangeset
for help on using the changeset viewer.