+++ /dev/null
-! Copyright (C) 2010 Daniel Ehrenberg
-! See http://factorcode.org/license.txt for BSD license.
-USING: new-sets tools.test kernel prettyprint hash-sets sorting ;
-IN: new-sets.tests
-
-[ { } ] [ { } { } intersect ] unit-test
-[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
-
-[ { } ] [ { } { } diff ] unit-test
-[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
-
-[ { } ] [ { } { } union ] unit-test
-[ { 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
-
-[ t ] [ { 1 2 } { 1 3 } intersects? ] unit-test
-
-[ f ] [ { 4 2 } { 1 3 } intersects? ] unit-test
-
-[ f ] [ { } { 1 } intersects? ] unit-test
-
-[ f ] [ { 1 } { } intersects? ] unit-test
-
-[ t ] [ 4 { 2 4 5 } in? ] unit-test
-[ f ] [ 1 { 2 4 5 } in? ] unit-test
-
-[ V{ 1 2 3 } ] [ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
-[ V{ 1 2 } ] [ 2 V{ 1 2 } clone [ adjoin ] keep ] unit-test
-[ V{ 1 2 } ] [ 3 V{ 1 2 } clone [ delete ] keep ] unit-test
-[ V{ 2 } ] [ 1 V{ 1 2 } clone [ delete ] keep ] unit-test
-
-[ t ] [ { 1 2 3 } { 2 1 3 } set= ] unit-test
-[ f ] [ { 2 3 } { 1 2 3 } set= ] unit-test
-[ f ] [ { 1 2 3 } { 2 3 } set= ] unit-test
-
-[ { 1 } ] [ { 1 } members ] unit-test
-
-[ { 1 2 3 } ] [ { 1 1 1 2 2 3 3 3 3 3 } dup set-like natural-sort ] unit-test
-[ { 1 2 3 } ] [ HS{ 1 2 3 } { } set-like natural-sort ] unit-test
-
-[ HS{ 1 2 3 } ] [ { 1 2 3 } fast-set ] unit-test
-
-[ { 1 2 3 } ] [ { { 1 } { 2 } { 1 3 } } combine ] unit-test
+++ /dev/null
-! Copyright (C) 2010 Daniel Ehrenberg
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs hashtables kernel
-math sequences parser prettyprint.custom ;
-FROM: sets => prune ;
-IN: new-sets
-! The vocab is called new-sets for now, but only until it gets into core
-! All the code here is in the style that could be put in core
-
-! Set protocol
-MIXIN: set
-GENERIC: adjoin ( elt set -- )
-GENERIC: in? ( elt set -- ? )
-GENERIC: delete ( elt set -- )
-GENERIC: set-like ( set exemplar -- set' )
-GENERIC: fast-set ( set -- set' )
-GENERIC: members ( set -- sequence )
-GENERIC: union ( set1 set2 -- set )
-GENERIC: intersect ( set1 set2 -- set )
-GENERIC: intersects? ( set1 set2 -- ? )
-GENERIC: diff ( set1 set2 -- set )
-GENERIC: subset? ( set1 set2 -- ? )
-GENERIC: set= ( set1 set2 -- ? )
-
-! Defaults for some methods.
-! Override them for efficiency
-
-M: set union
- [ [ members ] bi@ append ] keep set-like ;
-
-<PRIVATE
-
-: sequence/tester ( set1 set2 -- set1' quot )
- [ members ] [ fast-set [ in? ] curry ] bi* ; inline
-
-PRIVATE>
-
-M: set intersect
- [ sequence/tester filter ] keep set-like ;
-
-M: set diff
- [ sequence/tester [ not ] compose filter ] keep set-like ;
-
-M: set intersects?
- sequence/tester any? ;
-
-M: set subset?
- sequence/tester all? ;
-
-M: set set=
- 2dup subset? [ swap subset? ] [ 2drop f ] if ;
-
-M: set fast-set ;
-
-! Sequences are sets
-INSTANCE: sequence set
-M: sequence in? member? ; inline
-M: sequence adjoin [ delete ] [ push ] 2bi ;
-M: sequence delete remove! drop ; inline
-M: sequence set-like
- [ dup sequence? [ prune ] [ members ] if ] dip like ;
-M: sequence members fast-set members ;
-
-USE: vocabs.loader
-"hash-sets" require
-
-: combine ( sets -- set )
- f [ union ] reduce ;
io.pathnames io.styles kernel make math math.order math.parser
namespaces prettyprint.config prettyprint.custom
prettyprint.sections prettyprint.stylesheet quotations sbufs
-sequences strings vectors words words.symbol ;
+sequences strings vectors words words.symbol hash-sets ;
+FROM: new-sets => members ;
IN: prettyprint.backend
M: effect pprint* effect>string "(" ")" surround text ;
M: tuple pprint-delims drop \ T{ \ } ;
M: wrapper pprint-delims drop \ W{ \ } ;
M: callstack pprint-delims drop \ CS{ \ } ;
+M: hash-set pprint-delims drop \ HS{ \ } ;
M: object >pprint-sequence ;
M: vector >pprint-sequence ;
M: hashtable >pprint-sequence >alist ;
M: wrapper >pprint-sequence wrapped>> 1array ;
M: callstack >pprint-sequence callstack>array ;
+M: hash-set >pprint-sequence members ;
: class-slot-sequence ( class slots -- sequence )
[ 1array ] [ [ f 2array ] dip append ] if-empty ;
M: hashtable pprint* pprint-object ;
M: curry pprint* pprint-object ;
M: compose pprint* pprint-object ;
+M: hash-set pprint* pprint-object ;
M: wrapper pprint*
{
"HEX:"
"HOOK:"
"H{"
+ "HS{"
"IN:"
"INSTANCE:"
"M:"
--- /dev/null
+! Copyright (C) 2010 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: new-sets tools.test kernel sorting prettyprint hash-sets ;
+IN: hash-sets.tests
+
+[ { 1 2 3 } ] [ HS{ 1 2 3 } members natural-sort ] unit-test
+
+[ "HS{ 1 2 3 4 }" ] [ HS{ 1 2 3 4 } unparse ] unit-test
+
+[ t ] [ 1 HS{ 0 1 2 } in? ] unit-test
+[ f ] [ 3 HS{ 0 1 2 } in? ] unit-test
+[ HS{ 1 2 3 } ] [ 3 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
+[ HS{ 1 2 } ] [ 2 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
+[ HS{ 1 2 3 } ] [ 4 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
+[ HS{ 1 2 } ] [ 3 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
+[ HS{ 1 2 } ] [ HS{ 1 2 } fast-set ] unit-test
+[ { 1 2 } ] [ HS{ 1 2 } members natural-sort ] unit-test
+
+[ HS{ 1 2 3 4 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } union ] unit-test
+[ HS{ 2 3 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersect ] unit-test
+[ t ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersects? ] unit-test
+[ f ] [ HS{ 1 } HS{ 2 3 4 } intersects? ] unit-test
+[ f ] [ HS{ 1 } HS{ 2 3 4 } subset? ] unit-test
+[ f ] [ HS{ 1 2 3 } HS{ 2 3 4 } subset? ] unit-test
+[ t ] [ HS{ 2 3 } HS{ 2 3 4 } subset? ] unit-test
+[ t ] [ HS{ } HS{ 2 3 4 } subset? ] unit-test
+[ HS{ 1 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } diff ] unit-test
+[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } set= ] unit-test
+[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } = ] unit-test
+[ f ] [ HS{ 2 3 } HS{ 2 1 3 } set= ] unit-test
+[ f ] [ HS{ 1 2 3 } HS{ 2 3 } set= ] unit-test
+
+[ HS{ 1 2 } HS{ 1 2 3 } ] [ HS{ 1 2 } clone dup clone [ 3 swap adjoin ] keep ] unit-test
--- /dev/null
+! Copyright (C) 2010 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs hashtables kernel new-sets
+sequences parser ;
+QUALIFIED: sets
+IN: hash-sets
+
+! In a better implementation, less memory would be used
+TUPLE: hash-set { table hashtable read-only } ;
+
+: <hash-set> ( members -- hash-set )
+ [ dup ] H{ } map>assoc hash-set boa ;
+
+INSTANCE: hash-set set
+M: hash-set in? table>> key? ; inline
+M: hash-set adjoin table>> dupd set-at ; inline
+M: hash-set delete table>> delete-at ; inline
+M: hash-set members table>> keys ; inline
+M: hash-set set-like
+ drop dup hash-set? [ members <hash-set> ] unless ;
+M: hash-set clone
+ table>> clone hash-set boa ;
+
+M: sequence fast-set <hash-set> ;
--- /dev/null
+! Copyright (C) 2010 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: new-sets tools.test kernel prettyprint hash-sets sorting ;
+IN: new-sets.tests
+
+[ { } ] [ { } { } intersect ] unit-test
+[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
+
+[ { } ] [ { } { } diff ] unit-test
+[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
+
+[ { } ] [ { } { } union ] unit-test
+[ { 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
+
+[ t ] [ { 1 2 } { 1 3 } intersects? ] unit-test
+
+[ f ] [ { 4 2 } { 1 3 } intersects? ] unit-test
+
+[ f ] [ { } { 1 } intersects? ] unit-test
+
+[ f ] [ { 1 } { } intersects? ] unit-test
+
+[ t ] [ 4 { 2 4 5 } in? ] unit-test
+[ f ] [ 1 { 2 4 5 } in? ] unit-test
+
+[ V{ 1 2 3 } ] [ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
+[ V{ 1 2 } ] [ 2 V{ 1 2 } clone [ adjoin ] keep ] unit-test
+[ V{ 1 2 } ] [ 3 V{ 1 2 } clone [ delete ] keep ] unit-test
+[ V{ 2 } ] [ 1 V{ 1 2 } clone [ delete ] keep ] unit-test
+
+[ t ] [ { 1 2 3 } { 2 1 3 } set= ] unit-test
+[ f ] [ { 2 3 } { 1 2 3 } set= ] unit-test
+[ f ] [ { 1 2 3 } { 2 3 } set= ] unit-test
+
+[ { 1 } ] [ { 1 } members ] unit-test
+
+[ { 1 2 3 } ] [ { 1 1 1 2 2 3 3 3 3 3 } dup set-like natural-sort ] unit-test
+[ { 1 2 3 } ] [ HS{ 1 2 3 } { } set-like natural-sort ] unit-test
+
+[ HS{ 1 2 3 } ] [ { 1 2 3 } fast-set ] unit-test
+
+[ { 1 2 3 } ] [ { { 1 } { 2 } { 1 3 } } combine ] unit-test
--- /dev/null
+! Copyright (C) 2010 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs hashtables kernel
+math sequences ;
+FROM: sets => prune ;
+IN: new-sets
+! The vocab is called new-sets for now, but only until it gets into core
+! All the code here is in the style that could be put in core
+
+! Set protocol
+MIXIN: set
+GENERIC: adjoin ( elt set -- )
+GENERIC: in? ( elt set -- ? )
+GENERIC: delete ( elt set -- )
+GENERIC: set-like ( set exemplar -- set' )
+GENERIC: fast-set ( set -- set' )
+GENERIC: members ( set -- sequence )
+GENERIC: union ( set1 set2 -- set )
+GENERIC: intersect ( set1 set2 -- set )
+GENERIC: intersects? ( set1 set2 -- ? )
+GENERIC: diff ( set1 set2 -- set )
+GENERIC: subset? ( set1 set2 -- ? )
+GENERIC: set= ( set1 set2 -- ? )
+
+! Defaults for some methods.
+! Override them for efficiency
+
+M: set union
+ [ [ members ] bi@ append ] keep set-like ;
+
+<PRIVATE
+
+: sequence/tester ( set1 set2 -- set1' quot )
+ [ members ] [ fast-set [ in? ] curry ] bi* ; inline
+
+PRIVATE>
+
+M: set intersect
+ [ sequence/tester filter ] keep set-like ;
+
+M: set diff
+ [ sequence/tester [ not ] compose filter ] keep set-like ;
+
+M: set intersects?
+ sequence/tester any? ;
+
+M: set subset?
+ sequence/tester all? ;
+
+M: set set=
+ 2dup subset? [ swap subset? ] [ 2drop f ] if ;
+
+M: set fast-set ;
+
+! Sequences are sets
+INSTANCE: sequence set
+M: sequence in? member? ; inline
+M: sequence adjoin [ delete ] [ push ] 2bi ;
+M: sequence delete remove! drop ; inline
+M: sequence set-like
+ [ dup sequence? [ prune ] [ members ] if ] dip like ;
+M: sequence members fast-set members ;
+
+USE: vocabs.loader
+"hash-sets" require
+
+: combine ( sets -- set )
+ f [ union ] reduce ;
io.pathnames vocabs vocabs.parser classes.parser classes.union
classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple.parser compiler.units
-combinators effects.parser slots ;
+combinators effects.parser slots hash-sets ;
IN: bootstrap.syntax
! These words are defined as a top-level form, instead of with
"H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax
"T{" [ parse-tuple-literal suffix! ] define-core-syntax
"W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax
+ "HS{" [ \ } [ <hash-set> ] parse-literal ] define-core-syntax
"POSTPONE:" [ scan-word suffix! ] define-core-syntax
"\\" [ scan-word <wrapper> suffix! ] define-core-syntax