diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 444a424766..8cc91538d6 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -8,7 +8,7 @@ layouts compiler.tree.propagation.info compiler.tree.def-use compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals specialized-arrays system sorting math.libm math.floats.private math.integers.private -math.intervals quotations effects alien alien.data sets ; +math.intervals quotations effects alien alien.data new-sets ; FROM: math => float ; SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: void* diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 0077d0f123..d4e5e25ffe 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -3,12 +3,13 @@ USING: alien.c-types kernel sequences words fry generic accessors classes.tuple classes classes.algebra definitions stack-checker.dependencies quotations classes.tuple.private math -math.partial-dispatch math.private math.intervals sets.private +math.partial-dispatch math.private math.intervals new-sets.private math.floats.private math.integers.private layouts math.order vectors hashtables combinators effects generalizations assocs -sets combinators.short-circuit sequences.private locals growable +new-sets combinators.short-circuit sequences.private locals growable stack-checker namespaces compiler.tree.propagation.info ; FROM: math => float ; +FROM: new-sets => set ; IN: compiler.tree.propagation.transforms \ equal? [ @@ -207,7 +208,7 @@ ERROR: bad-partial-eval quot word ; [ drop f ] swap [ literalize [ t ] ] { } map>assoc linear-case-quot ] [ - unique [ key? ] curry + tester ] if ; \ member? [ @@ -272,14 +273,14 @@ CONSTANT: lookup-table-at-max 256 \ at* [ at-quot ] 1 define-partial-eval : diff-quot ( seq -- quot: ( seq' -- seq'' ) ) - tester '[ [ @ not ] filter ] ; + tester '[ [ [ @ not ] filter ] keep set-like ] ; -\ diff [ diff-quot ] 1 define-partial-eval +M\ set diff [ diff-quot ] 1 define-partial-eval : intersect-quot ( seq -- quot: ( seq' -- seq'' ) ) - tester '[ _ filter ] ; + tester '[ [ _ filter ] keep set-like ] ; -\ intersect [ intersect-quot ] 1 define-partial-eval +M\ set intersect [ intersect-quot ] 1 define-partial-eval : fixnum-bits ( -- n ) cell-bits tag-bits get - ; diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 7482cce048..8527275667 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/core/classes/tuple/parser/parser.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel sets namespaces make sequences parser +USING: accessors kernel new-sets namespaces make sequences parser lexer combinators words classes.parser classes.tuple arrays slots math assocs parser.notes classes classes.algebra ; IN: classes.tuple.parser diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor index 34af2f5c87..3c0acd46c4 100644 --- a/core/hash-sets/hash-sets.factor +++ b/core/hash-sets/hash-sets.factor @@ -22,3 +22,6 @@ M: hash-set clone table>> clone hash-set boa ; M: sequence fast-set ; + +M: sequence duplicates + HS{ } clone [ [ in? ] [ adjoin ] 2bi ] curry filter ; diff --git a/core/new-sets/new-sets-tests.factor b/core/new-sets/new-sets-tests.factor index bd777618a6..18960f86db 100644 --- a/core/new-sets/new-sets-tests.factor +++ b/core/new-sets/new-sets-tests.factor @@ -40,3 +40,12 @@ IN: new-sets.tests [ HS{ 1 2 3 } ] [ { 1 2 3 } fast-set ] unit-test [ { 1 2 3 } ] [ { { 1 } { 2 } { 1 3 } } combine ] unit-test + +[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test +[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test + +[ { 1 2 3 } ] [ { 1 2 2 3 3 } { } set-like ] unit-test +[ { 3 2 1 } ] [ { 3 3 2 2 1 } { } set-like ] unit-test + +[ { 1 2 1 } ] [ { 1 2 3 2 1 2 1 } duplicates ] unit-test +[ f ] [ HS{ 1 2 3 1 2 1 } duplicates ] unit-test diff --git a/core/new-sets/new-sets.factor b/core/new-sets/new-sets.factor index d0541d90df..115e0d404a 100644 --- a/core/new-sets/new-sets.factor +++ b/core/new-sets/new-sets.factor @@ -1,11 +1,8 @@ ! Copyright (C) 2010 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs hashtables kernel +USING: accessors assocs hashtables kernel vectors 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 @@ -21,6 +18,8 @@ GENERIC: intersects? ( set1 set2 -- ? ) GENERIC: diff ( set1 set2 -- set ) GENERIC: subset? ( set1 set2 -- ? ) GENERIC: set= ( set1 set2 -- ? ) +GENERIC: duplicates ( set -- sequence ) +GENERIC: all-unique? ( set -- ? ) ! Defaults for some methods. ! Override them for efficiency @@ -30,8 +29,11 @@ M: set union @@ -52,15 +54,45 @@ M: set set= M: set fast-set ; +M: set duplicates drop f ; + +M: set all-unique? drop t ; + + ] [ length ] tri + [ [ (prune) ] 2curry each ] keep ; + +PRIVATE> + ! 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 ; +M: sequence in? + member? ; inline + +M: sequence adjoin + [ delete ] [ push ] 2bi ; + +M: sequence delete + remove! drop ; inline + +M: sequence set-like + [ members ] dip like ; + +M: sequence members + [ prune ] keep like ; + +M: sequence all-unique? + dup prune sequence= ; + +! Some sequence methods are defined using hash-sets USE: vocabs.loader "hash-sets" require