linked-sets: adding an ordered-set.
(yes, it's an instance of unordered-set, patches to follow).locals-and-roots
parent
2a9c95040c
commit
f5ad868731
|
@ -0,0 +1 @@
|
||||||
|
John Benediktsson
|
|
@ -0,0 +1,42 @@
|
||||||
|
USING: kernel linked-sets sets tools.test ;
|
||||||
|
|
||||||
|
{ V{ 1 2 3 } 3 } [
|
||||||
|
0 <linked-set> 1 over adjoin
|
||||||
|
2 over adjoin
|
||||||
|
3 over adjoin
|
||||||
|
[ members ] [ cardinality ] bi
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ V{ 1 3 } 2 } [
|
||||||
|
0 <linked-set> 1 over adjoin
|
||||||
|
2 over adjoin
|
||||||
|
3 over adjoin
|
||||||
|
2 over delete
|
||||||
|
[ members ] [ cardinality ] bi
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ V{ 1 3 4 } 3 } [
|
||||||
|
0 <linked-set> 1 over adjoin
|
||||||
|
2 over adjoin
|
||||||
|
3 over adjoin
|
||||||
|
2 over delete
|
||||||
|
4 over adjoin
|
||||||
|
[ members ] [ cardinality ] bi
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ V{ } 0 } [
|
||||||
|
0 <linked-set> 1 over adjoin
|
||||||
|
2 over adjoin
|
||||||
|
3 over adjoin
|
||||||
|
dup clear-set
|
||||||
|
[ members ] [ cardinality ] bi
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ V{ 1 2 3 } 3 } [
|
||||||
|
{ 1 2 3 } >linked-set
|
||||||
|
[ members ] [ cardinality ] bi
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ t } [
|
||||||
|
{ 1 2 3 } [ >linked-set ] [ >linked-set ] bi =
|
||||||
|
] unit-test
|
|
@ -0,0 +1,49 @@
|
||||||
|
! Copyright (C) 2016 John Benediktsson
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors arrays assocs deques dlists fry hashtables
|
||||||
|
kernel linked-assocs sets ;
|
||||||
|
IN: linked-sets
|
||||||
|
|
||||||
|
TUPLE: linked-set { assoc hashtable read-only } { dlist dlist read-only } ;
|
||||||
|
|
||||||
|
: <linked-set> ( capacity -- linked-set )
|
||||||
|
<hashtable> <dlist> linked-set boa ;
|
||||||
|
|
||||||
|
M: linked-set in? assoc>> key? ;
|
||||||
|
|
||||||
|
M: linked-set clear-set
|
||||||
|
[ assoc>> clear-assoc ] [ dlist>> clear-deque ] bi ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: (delete-at) ( key assoc dlist -- )
|
||||||
|
'[ at [ _ delete-node ] when* ] [ delete-at ] 2bi ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
M: linked-set delete
|
||||||
|
[ assoc>> ] [ dlist>> ] bi (delete-at) ;
|
||||||
|
|
||||||
|
M: linked-set cardinality assoc>> assoc-size ;
|
||||||
|
|
||||||
|
M: linked-set adjoin
|
||||||
|
[ assoc>> ] [ dlist>> ] bi
|
||||||
|
'[ _ 2over key? [ 3dup (delete-at) ] when nip push-back* ]
|
||||||
|
[ set-at ] 2bi ;
|
||||||
|
|
||||||
|
M: linked-set members
|
||||||
|
dlist>> dlist>sequence ;
|
||||||
|
|
||||||
|
M: linked-set clone
|
||||||
|
[ assoc>> clone ] [ dlist>> clone ] bi linked-set boa ;
|
||||||
|
|
||||||
|
M: linked-set equal?
|
||||||
|
over linked-set? [ [ dlist>> ] bi@ = ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
: >linked-set ( set -- linked-set )
|
||||||
|
[ 0 <linked-set> ] dip union! ;
|
||||||
|
|
||||||
|
INSTANCE: linked-set unordered-set
|
||||||
|
|
||||||
|
M: linked-set set-like
|
||||||
|
drop dup linked-set? [ >linked-set ] unless ;
|
Loading…
Reference in New Issue