steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

remove >r r> from hash2

db4
Doug Coleman 2008-11-29 13:29:00 -06:00
parent d0370a06b0
commit d5f2a00f6d
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/hash2/hash2.factor
View File

@ -14,25 +14,25 @@ IN: hash2
: <hash2> ( size -- hash2 ) f <array> ; : <hash2> ( size -- hash2 ) f <array> ;
: 2= ( a b pair -- ? ) : 2= ( a b pair -- ? )
first2 swapd >r >r = r> r> = and ; inline first2 swapd [ = ] 2dip = and ; inline
: (assoc2) ( a b alist -- {a,b,val} ) : (assoc2) ( a b alist -- {a,b,val} )
[ >r 2dup r> 2= ] find >r 3drop r> ; inline [ [ 2dup ] dip 2= ] find [ 3drop ] dip ; inline
: assoc2 ( a b alist -- value ) : assoc2 ( a b alist -- value )
(assoc2) dup [ third ] when ; inline (assoc2) dup [ third ] when ; inline
: set-assoc2 ( value a b alist -- alist ) : set-assoc2 ( value a b alist -- alist )
>r rot 3array r> ?push ; inline [ rot 3array ] dip ?push ; inline
: hash2@ ( a b hash2 -- a b bucket hash2 ) : hash2@ ( a b hash2 -- a b bucket hash2 )
>r 2dup hashcode2 r> [ length mod ] keep ; inline [ 2dup hashcode2 ] dip [ length mod ] keep ; inline
: hash2 ( a b hash2 -- value/f ) : hash2 ( a b hash2 -- value/f )
hash2@ nth [ assoc2 ] [ 2drop f ] if* ; hash2@ nth [ assoc2 ] [ 2drop f ] if* ;
: set-hash2 ( a b value hash2 -- ) : set-hash2 ( a b value hash2 -- )
>r -rot r> hash2@ [ set-assoc2 ] change-nth ; [ -rot ] dip hash2@ [ set-assoc2 ] change-nth ;
: alist>hash2 ( alist size -- hash2 ) : alist>hash2 ( alist size -- hash2 )
<hash2> [ over >r first3 r> set-hash2 ] reduce ; inline <hash2> [ over [ first3 ] dip set-hash2 ] reduce ; inline