1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors bit-arrays kernel math math.bitwise sequences
4 sequences.private sets ;
7 TUPLE: bit-set { table bit-array read-only } ;
9 : <bit-set> ( capacity -- bit-set )
10 <bit-array> bit-set boa ; inline
15 over integer? [ table>> ?nth ] [ 2drop f ] if ; inline
18 ! This is allowed to throw an error when the elt couldn't
20 [ t ] 2dip table>> set-nth ;
23 ! This isn't allowed to throw an error if the elt wasn't
25 over integer? [ [ f ] 2dip table>> ?set-nth ] [ 2drop ] if ;
27 ! If you do binary set operations with a bit-set, it's expected
28 ! that the other thing can also be represented as a bit-set
32 ERROR: check-bit-set-failed ;
34 : check-bit-set ( bit-set -- bit-set )
35 dup bit-set? [ check-bit-set-failed ] unless ; inline
37 : bit-set-map ( seq1 seq2 quot -- seq )
38 [ drop [ length ] bi@ [ assert= ] keep ]
39 [ [ [ underlying>> ] bi@ ] dip 2map ] 3bi
40 bit-array boa ; inline
42 : (bit-set-op) ( set1 set2 -- table1 table2 )
43 [ set-like ] keep [ table>> ] bi@ ; inline
45 : bit-set-op ( set1 set2 quot: ( a b -- c ) -- bit-set )
46 [ (bit-set-op) ] dip bit-set-map bit-set boa ; inline
51 [ bitor ] bit-set-op ;
54 [ bitand ] bit-set-op ;
57 [ bitnot bitand ] bit-set-op ;
60 [ intersect ] keep = ;
63 table>> [ length <iota> ] keep '[ _ nth-unsafe ] filter ;
67 : bit-set-like ( set bit-set -- bit-set' )
68 ! Throws an error if there are keys that can't be put
70 over bit-set? [ 2dup [ table>> length ] same? ] [ f ] if
72 [ members ] dip table>> length <bit-set>
79 bit-set-like check-bit-set ; inline
82 table>> clone bit-set boa ;
84 M: bit-set cardinality