Bi-assocs: fast at and value-at

db4
Slava Pestov 2008-07-12 18:52:31 -05:00
parent 50ac09aa9e
commit 0770d50d7b
3 changed files with 63 additions and 3 deletions

View File

@ -144,10 +144,13 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
: extract-keys ( seq assoc -- subassoc )
[ [ dupd at ] curry ] keep map>assoc ;
! M: assoc >alist [ 2array ] { } assoc>map ;
GENERIC: value-at* ( value assoc -- key/f ? )
: value-at ( value assoc -- key/f )
swap [ = nip ] curry assoc-find 2drop ;
M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
: value-at ( value assoc -- key/f ) value-at* drop ;
: value? ( value assoc -- ? ) value-at* nip ;
: push-at ( value key assoc -- )
[ ?push ] change-at ;

View File

@ -0,0 +1,22 @@
IN: biassocs.tests
USING: biassocs assocs namespaces tools.test ;
<bihash> "h" set
[ 0 ] [ "h" get assoc-size ] unit-test
[ ] [ 1 2 "h" get set-at ] unit-test
[ 1 ] [ 2 "h" get at ] unit-test
[ 2 ] [ 1 "h" get value-at ] unit-test
[ 1 ] [ "h" get assoc-size ] unit-test
[ ] [ 1 3 "h" get set-at ] unit-test
[ 1 ] [ 3 "h" get at ] unit-test
[ 2 ] [ 1 "h" get value-at ] unit-test
[ 2 ] [ "h" get assoc-size ] unit-test

View File

@ -0,0 +1,35 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs accessors ;
IN: biassocs
TUPLE: biassoc from to ;
: <biassoc> ( exemplar -- biassoc )
[ clone ] [ clone ] bi biassoc boa ;
: <bihash> ( -- bihashtable )
H{ } <biassoc> ;
M: biassoc assoc-size from>> assoc-size ;
M: biassoc at* from>> at* ;
M: biassoc value-at* to>> at* ;
: once-at ( value key assoc -- )
2dup key? [ 3drop ] [ set-at ] if ;
M: biassoc set-at
[ from>> set-at ] [ swapd to>> once-at ] 3bi ;
M: biassoc delete-at
"biassocs do not support deletion" throw ;
M: biassoc >alist
from>> >alist ;
M: biassoc clear-assoc
[ from>> clear-assoc ] [ to>> clear-assoc ] bi ;
INSTANCE: biassoc assoc