diff --git a/basis/bit-sets/bit-sets-docs.factor b/basis/bit-sets/bit-sets-docs.factor new file mode 100644 index 0000000000..a2792d3213 --- /dev/null +++ b/basis/bit-sets/bit-sets-docs.factor @@ -0,0 +1,18 @@ +USING: help.markup help.syntax sequences math ; +IN: bit-sets + +ARTICLE: "bit-sets" "Bit sets" +"The " { $vocab-link "bit-sets" } " vocabulary implements bit-array-backed sets. Bitsets are efficient for implementing relatively dense sets whose members are in a contiguous range of integers starting from 0. One bit is required for each integer in this range in the underlying representation." +"Bit sets are of the class" +{ $subsection bit-set } +"They can be instantiated with the word" +{ $subsection } ; + +ABOUT: "bit-sets" + +HELP: bit-set +{ $class-description "The class of bit-array-based sets. These implement the " { $link "sets" } "." } ; + +HELP: +{ $values { "capacity" integer } { "bit-set" bit-set } } +{ $description "Creates a new bit set with the given capacity. This set is initially empty and can contain as members integers between 0 and " { $snippet "capacity" } "-1." } ; diff --git a/basis/bit-sets/bit-sets-tests.factor b/basis/bit-sets/bit-sets-tests.factor index 6a1366a1ea..4e97e703d0 100644 --- a/basis/bit-sets/bit-sets-tests.factor +++ b/basis/bit-sets/bit-sets-tests.factor @@ -1,17 +1,63 @@ -USING: bit-sets tools.test bit-arrays ; +USING: bit-sets tools.test sets kernel bit-arrays ; IN: bit-sets.tests -[ ?{ t f t f t f } ] [ - ?{ t f f f t f } - ?{ f f t f t f } bit-set-union +[ T{ bit-set f ?{ t f t f t f } } ] [ + T{ bit-set f ?{ t f f f t f } } + T{ bit-set f ?{ f f t f t f } } union ] unit-test -[ ?{ f f f f t f } ] [ - ?{ t f f f t f } - ?{ f f t f t f } bit-set-intersect +[ T{ bit-set f ?{ f f f f t f } } ] [ + T{ bit-set f ?{ t f f f t f } } + T{ bit-set f ?{ f f t f t f } } intersect ] unit-test -[ ?{ t f t f f f } ] [ - ?{ t t t f f f } - ?{ f t f f t t } bit-set-diff +[ T{ bit-set f ?{ t f t f f f } } ] [ + T{ bit-set f ?{ t t t f f f } } + T{ bit-set f ?{ f t f f t t } } diff ] unit-test + +[ f ] [ + T{ bit-set f ?{ t t t f f f } } + T{ bit-set f ?{ f t f f t t } } subset? +] unit-test + +[ t ] [ + T{ bit-set f ?{ t t t f f f } } + T{ bit-set f ?{ f t f f f f } } subset? +] unit-test + +[ t ] [ + { 0 1 2 } + T{ bit-set f ?{ f t f f f f } } subset? +] unit-test + +[ f ] [ + T{ bit-set f ?{ f t f f f f } } + T{ bit-set f ?{ t t t f f f } } subset? +] unit-test + +[ f ] [ + { 1 } + T{ bit-set f ?{ t t t f f f } } subset? +] unit-test + +[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } members ] unit-test + +[ t V{ 1 2 3 } ] [ + { 1 2 } 5 set-like + [ bit-set? ] keep + 3 over adjoin + members +] unit-test + +[ V{ 0 1 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap adjoin ] keep members ] unit-test +[ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap adjoin ] keep members ] must-fail +[ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap adjoin ] keep members ] must-fail + +[ V{ 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 0 swap delete ] keep members ] unit-test +[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap delete ] keep members ] unit-test +[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap delete ] keep members ] unit-test +[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap delete ] keep members ] unit-test + +[ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } ] +[ 1 dup clone 0 over adjoin ] unit-test diff --git a/basis/bit-sets/bit-sets.factor b/basis/bit-sets/bit-sets.factor index 34b7f13dc2..9d3d09ec1b 100644 --- a/basis/bit-sets/bit-sets.factor +++ b/basis/bit-sets/bit-sets.factor @@ -1,8 +1,33 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors sequences byte-arrays bit-arrays math hints ; +USING: kernel accessors sequences byte-arrays bit-arrays math hints sets ; IN: bit-sets +TUPLE: bit-set { table bit-array read-only } ; + +: ( capacity -- bit-set ) + bit-set boa ; + +INSTANCE: bit-set set + +M: bit-set in? + over integer? [ table>> ?nth ] [ 2drop f ] if ; inline + +M: bit-set adjoin + ! This is allowed to crash when the elt couldn't go in the set + [ t ] 2dip table>> set-nth ; + +M: bit-set delete + ! This isn't allowed to crash if the elt wasn't in the set + over integer? [ + table>> 2dup bounds-check? [ + [ f ] 2dip set-nth + ] [ 2drop ] if + ] [ 2drop ] if ; + +! If you do binary set operations with a bitset, it's expected +! that the other thing can also be represented as a bitset +! of the same length. > ] bi@ ; inline + +: bit-set-op ( set1 set2 quot: ( a b -- c ) -- bit-set ) + [ (bit-set-op) ] dip bit-set-map bit-set boa ; inline + PRIVATE> -: bit-set-union ( seq1 seq2 -- seq ) [ bitor ] bit-set-map ; +M: bit-set union + [ bitor ] bit-set-op ; -HINTS: bit-set-union bit-array bit-array ; +M: bit-set intersect + [ bitand ] bit-set-op ; -: bit-set-intersect ( seq1 seq2 -- seq ) [ bitand ] bit-set-map ; +M: bit-set diff + [ bitnot bitand ] bit-set-op ; -HINTS: bit-set-intersect bit-array bit-array ; +M: bit-set subset? + [ intersect ] keep = ; -: bit-set-diff ( seq1 seq2 -- seq ) [ bitnot bitand ] bit-set-map ; +M: bit-set members + [ table>> length iota ] keep [ in? ] curry filter ; -HINTS: bit-set-diff bit-array bit-array ; +M: bit-set set-like + ! This crashes if there are keys that can't be put in the bit set + over bit-set? [ 2dup [ table>> ] bi@ length = ] [ f ] if + [ drop ] [ + [ members ] dip table>> length + [ [ adjoin ] curry each ] keep + ] if ; -: bit-set-subset? ( seq1 seq2 -- ? ) dupd bit-set-intersect = ; \ No newline at end of file +M: bit-set clone + table>> clone bit-set boa ; diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index 9fffa0eed2..24433ad594 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -12,6 +12,7 @@ compiler.cfg.registers compiler.cfg.comparisons compiler.cfg.instructions compiler.cfg.representations.preferred ; +FROM: namespaces => set ; IN: compiler.cfg.alias-analysis ! We try to eliminate redundant slot operations using some simple heuristics. @@ -297,14 +298,14 @@ SYMBOL: live-stores histories get values [ values [ [ store? ] filter [ insn#>> ] map ] map concat - ] map concat unique + ] map concat fast-set live-stores set ; GENERIC: eliminate-dead-stores* ( insn -- insn' ) : (eliminate-dead-stores) ( insn -- insn' ) dup insn-slot# [ - insn# get live-stores get key? [ + insn# get live-stores get in? [ drop f ] unless ] when ; diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor index 03a43d0ab7..b4fcd018f4 100644 --- a/basis/compiler/cfg/dce/dce.factor +++ b/basis/compiler/cfg/dce/dce.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs sets kernel namespaces sequences +USING: accessors assocs kernel namespaces sequences compiler.cfg.instructions compiler.cfg.def-use -compiler.cfg.rpo compiler.cfg.predecessors ; +compiler.cfg.rpo compiler.cfg.predecessors hash-sets sets ; +FROM: namespaces => set ; IN: compiler.cfg.dce ! Maps vregs to sequences of vregs @@ -12,18 +13,18 @@ SYMBOL: liveness-graph SYMBOL: live-vregs : live-vreg? ( vreg -- ? ) - live-vregs get key? ; + live-vregs get in? ; ! vregs which are the result of an allocation SYMBOL: allocations : allocation? ( vreg -- ? ) - allocations get key? ; + allocations get in? ; : init-dead-code ( -- ) H{ } clone liveness-graph set - H{ } clone live-vregs set - H{ } clone allocations set ; + HS{ } clone live-vregs set + HS{ } clone allocations set ; GENERIC: build-liveness-graph ( insn -- ) @@ -46,7 +47,7 @@ M: ##write-barrier-imm build-liveness-graph dup src>> setter-liveness-graph ; M: ##allot build-liveness-graph - [ dst>> allocations get conjoin ] [ call-next-method ] bi ; + [ dst>> allocations get adjoin ] [ call-next-method ] bi ; M: insn build-liveness-graph dup defs-vreg dup [ add-edges ] [ 2drop ] if ; @@ -55,8 +56,8 @@ GENERIC: compute-live-vregs ( insn -- ) : (record-live) ( vregs -- ) [ - dup live-vregs get key? [ drop ] [ - [ live-vregs get conjoin ] + dup live-vreg? [ drop ] [ + [ live-vregs get adjoin ] [ liveness-graph get at (record-live) ] bi ] if diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index 54cff2ccaa..87758fafcd 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -5,6 +5,8 @@ compiler.units fry generalizations generic kernel locals namespaces quotations sequences sets slots words compiler.cfg.instructions compiler.cfg.instructions.syntax compiler.cfg.rpo ; +FROM: namespaces => set ; +FROM: sets => members ; IN: compiler.cfg.def-use GENERIC: defs-vreg ( insn -- vreg/f ) @@ -94,9 +96,9 @@ SYMBOLS: defs insns uses ; cfg [| block | block instructions>> [ dup ##phi? - [ inputs>> [ use conjoin-at ] assoc-each ] - [ uses-vregs [ block swap use conjoin-at ] each ] + [ inputs>> [ use adjoin-at ] assoc-each ] + [ uses-vregs [ block swap use adjoin-at ] each ] if ] each ] each-basic-block - use [ keys ] assoc-map uses set ; + use [ members ] assoc-map uses set ; diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor index d21e81526e..71dc12f6a1 100644 --- a/basis/compiler/cfg/dominance/dominance.factor +++ b/basis/compiler/cfg/dominance/dominance.factor @@ -3,6 +3,7 @@ USING: accessors assocs combinators sets math fry kernel math.order dlists deques vectors namespaces sequences sorting locals compiler.cfg.rpo compiler.cfg.predecessors ; +FROM: namespaces => set ; IN: compiler.cfg.dominance ! Reference: @@ -103,4 +104,4 @@ PRIVATE> [ accum push ] [ dom-children work-list push-all-front ] bi ] slurp-deque - accum ; \ No newline at end of file + accum ; diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index f69db1deea..6acb9169ec 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -13,6 +13,7 @@ compiler.cfg.linearization.order compiler.cfg.linear-scan.allocation compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.live-intervals ; +FROM: namespaces => set ; IN: compiler.cfg.linear-scan.assignment ! This contains both active and inactive intervals; any interval diff --git a/basis/compiler/cfg/linear-scan/debugger/debugger.factor b/basis/compiler/cfg/linear-scan/debugger/debugger.factor index fa248dd4e8..d93ebcccf0 100644 --- a/basis/compiler/cfg/linear-scan/debugger/debugger.factor +++ b/basis/compiler/cfg/linear-scan/debugger/debugger.factor @@ -3,6 +3,7 @@ USING: accessors kernel sequences sets arrays math strings fry namespaces prettyprint compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.allocation compiler.cfg assocs ; +FROM: namespaces => set ; IN: compiler.cfg.linear-scan.debugger : check-linear-scan ( live-intervals machine-registers -- ) diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index c144b5f07f..dcf2e743ec 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1,4 +1,3 @@ -IN: compiler.cfg.linear-scan.tests USING: tools.test random sorting sequences sets hashtables assocs kernel fry arrays splitting namespaces math accessors vectors locals math.order grouping strings strings.private classes layouts @@ -21,6 +20,8 @@ compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.allocation.splitting compiler.cfg.linear-scan.allocation.spilling compiler.cfg.linear-scan.debugger ; +FROM: namespaces => set ; +IN: compiler.cfg.linear-scan.tests check-allocation? on check-numbering? on diff --git a/basis/compiler/cfg/linearization/order/order.factor b/basis/compiler/cfg/linearization/order/order.factor index 1fcc137c60..166a0f0d50 100644 --- a/basis/compiler/cfg/linearization/order/order.factor +++ b/basis/compiler/cfg/linearization/order/order.factor @@ -2,8 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs deques dlists kernel make sorting namespaces sequences combinators combinators.short-circuit -fry math sets compiler.cfg.rpo compiler.cfg.utilities -compiler.cfg.loop-detection compiler.cfg.predecessors ; +fry math compiler.cfg.rpo compiler.cfg.utilities +compiler.cfg.loop-detection compiler.cfg.predecessors +sets hash-sets ; +FROM: namespaces => set ; IN: compiler.cfg.linearization.order ! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp @@ -12,16 +14,16 @@ IN: compiler.cfg.linearization.order SYMBOLS: work-list loop-heads visited ; -: visited? ( bb -- ? ) visited get key? ; +: visited? ( bb -- ? ) visited get in? ; : add-to-work-list ( bb -- ) - dup visited get key? [ drop ] [ + dup visited? [ drop ] [ work-list get push-back ] if ; : init-linearization-order ( cfg -- ) work-list set - H{ } clone visited set + HS{ } clone visited set entry>> add-to-work-list ; : (find-alternate-loop-head) ( bb -- bb' ) @@ -58,7 +60,7 @@ SYMBOLS: work-list loop-heads visited ; : process-block ( bb -- ) dup visited? [ drop ] [ [ , ] - [ visited get conjoin ] + [ visited get adjoin ] [ sorted-successors [ process-successor ] each ] tri ] if ; @@ -76,4 +78,4 @@ PRIVATE> dup linear-order>> [ ] [ dup (linearization-order) >>linear-order linear-order>> - ] ?if ; \ No newline at end of file + ] ?if ; diff --git a/basis/compiler/cfg/liveness/ssa/ssa.factor b/basis/compiler/cfg/liveness/ssa/ssa.factor index 81263c8e9a..5215c9c487 100644 --- a/basis/compiler/cfg/liveness/ssa/ssa.factor +++ b/basis/compiler/cfg/liveness/ssa/ssa.factor @@ -4,6 +4,7 @@ USING: kernel namespaces deques accessors sets sequences assocs fry hashtables dlists compiler.cfg.def-use compiler.cfg.instructions compiler.cfg.rpo compiler.cfg.liveness compiler.cfg.utilities compiler.cfg.predecessors ; +FROM: namespaces => set ; IN: compiler.cfg.liveness.ssa ! TODO: merge with compiler.cfg.liveness @@ -59,4 +60,4 @@ SYMBOL: work-list : live-in? ( vreg bb -- ? ) live-in key? ; -: live-out? ( vreg bb -- ? ) live-out key? ; \ No newline at end of file +: live-out? ( vreg bb -- ? ) live-out key? ; diff --git a/basis/compiler/cfg/loop-detection/loop-detection.factor b/basis/compiler/cfg/loop-detection/loop-detection.factor index 73b99ee132..2e2dab00f1 100644 --- a/basis/compiler/cfg/loop-detection/loop-detection.factor +++ b/basis/compiler/cfg/loop-detection/loop-detection.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators deques dlists fry kernel namespaces sequences sets compiler.cfg compiler.cfg.predecessors ; +FROM: namespaces => set ; IN: compiler.cfg.loop-detection TUPLE: natural-loop header index ends blocks ; diff --git a/basis/compiler/cfg/representations/preferred/preferred.factor b/basis/compiler/cfg/representations/preferred/preferred.factor index 9ba78dbf46..ffb8f9a390 100644 --- a/basis/compiler/cfg/representations/preferred/preferred.factor +++ b/basis/compiler/cfg/representations/preferred/preferred.factor @@ -5,6 +5,7 @@ words sets combinators generalizations cpu.architecture compiler.units compiler.cfg.utilities compiler.cfg compiler.cfg.rpo compiler.cfg.instructions compiler.cfg.def-use ; FROM: compiler.cfg.instructions.syntax => insn-def-slot insn-use-slots insn-temp-slots scalar-rep ; +FROM: namespaces => set ; IN: compiler.cfg.representations.preferred GENERIC: defs-vreg-rep ( insn -- rep/f ) diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor index b14390e980..05e365e5e4 100644 --- a/basis/compiler/cfg/representations/representations.factor +++ b/basis/compiler/cfg/representations/representations.factor @@ -15,6 +15,7 @@ compiler.cfg.utilities compiler.cfg.loop-detection compiler.cfg.renaming.functor compiler.cfg.representations.preferred ; +FROM: namespaces => set ; IN: compiler.cfg.representations ! Virtual register representation selection. diff --git a/basis/compiler/cfg/rpo/rpo.factor b/basis/compiler/cfg/rpo/rpo.factor index b569327c83..6e09d9885f 100644 --- a/basis/compiler/cfg/rpo/rpo.factor +++ b/basis/compiler/cfg/rpo/rpo.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors namespaces make math sequences sets assocs fry compiler.cfg compiler.cfg.instructions ; +FROM: namespaces => set ; IN: compiler.cfg.rpo SYMBOL: visited diff --git a/basis/compiler/cfg/ssa/construction/construction.factor b/basis/compiler/cfg/ssa/construction/construction.factor index 7662b8ab01..7cd85e5fbe 100644 --- a/basis/compiler/cfg/ssa/construction/construction.factor +++ b/basis/compiler/cfg/ssa/construction/construction.factor @@ -12,6 +12,7 @@ compiler.cfg.instructions compiler.cfg.renaming compiler.cfg.renaming.functor compiler.cfg.ssa.construction.tdmsc ; +FROM: namespaces => set ; IN: compiler.cfg.ssa.construction ! The phi placement algorithm is implemented in @@ -135,4 +136,4 @@ PRIVATE> [ compute-defs compute-phi-nodes insert-phi-nodes ] [ rename ] [ ] - } cleave ; \ No newline at end of file + } cleave ; diff --git a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor index 955d41814f..9b24c55078 100644 --- a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor +++ b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor @@ -2,6 +2,7 @@ USING: accessors arrays compiler.cfg compiler.cfg.debugger compiler.cfg.dominance compiler.cfg.predecessors compiler.cfg.ssa.construction.tdmsc kernel namespaces sequences tools.test vectors sets ; +FROM: namespaces => set ; IN: compiler.cfg.ssa.construction.tdmsc.tests : test-tdmsc ( -- ) @@ -70,4 +71,4 @@ V{ } 7 test-bb [ ] [ test-tdmsc ] unit-test [ V{ 2 } ] [ { 2 3 4 5 } [ get ] map merge-set [ number>> ] map ] unit-test -[ V{ } ] [ { 0 1 6 7 } [ get ] map merge-set ] unit-test \ No newline at end of file +[ V{ } ] [ { 0 1 6 7 } [ get ] map merge-set ] unit-test diff --git a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor index 837b41e47f..51eb3c8a98 100644 --- a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor +++ b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor @@ -3,6 +3,7 @@ USING: accessors arrays assocs bit-arrays bit-sets fry hashtables hints kernel locals math namespaces sequences sets compiler.cfg compiler.cfg.dominance compiler.cfg.rpo ; +FROM: namespaces => set ; IN: compiler.cfg.ssa.construction.tdmsc ! TDMSC-I algorithm from "A Practical and Fast Iterative Algorithm for @@ -15,7 +16,7 @@ IN: compiler.cfg.ssa.construction.tdmsc SYMBOLS: visited merge-sets levels again? ; : init-merge-sets ( cfg -- ) - post-order dup length '[ _ ] H{ } map>assoc merge-sets set ; + post-order dup length '[ _ ] H{ } map>assoc merge-sets set ; : compute-levels ( cfg -- ) 0 over entry>> associate [ @@ -29,15 +30,12 @@ SYMBOLS: visited merge-sets levels again? ; : level ( bb -- n ) levels get at ; inline -: set-bit ( bit-array n -- ) - [ t ] 2dip swap set-nth ; - : update-merge-set ( tmp to -- ) [ merge-sets get ] dip '[ _ - [ merge-sets get at bit-set-union ] - [ dupd number>> set-bit ] + [ merge-sets get at union ] + [ number>> over adjoin ] bi ] change-at ; @@ -51,10 +49,10 @@ SYMBOLS: visited merge-sets levels again? ; [ [ predecessors>> ] keep ] dip '[ _ 2dup j-edge? _ [ 2drop ] if ] each ; inline -: visited? ( pair -- ? ) visited get key? ; +: visited? ( pair -- ? ) visited get in? ; : consistent? ( snode lnode -- ? ) - [ merge-sets get at ] bi@ swap bit-set-subset? ; + [ merge-sets get at ] bi@ subset? ; : (process-edge) ( from to -- ) f walk [ @@ -65,7 +63,7 @@ SYMBOLS: visited merge-sets levels again? ; : process-edge ( from to -- ) 2dup 2array dup visited? [ 3drop ] [ - visited get conjoin + visited get adjoin (process-edge) ] if ; @@ -73,7 +71,7 @@ SYMBOLS: visited merge-sets levels again? ; [ process-edge ] each-incoming-j-edge ; : compute-merge-set-step ( bfo -- ) - visited get clear-assoc + HS{ } clone visited set [ process-block ] each ; : compute-merge-set-loop ( cfg -- ) @@ -82,29 +80,22 @@ SYMBOLS: visited merge-sets levels again? ; loop ; : (merge-set) ( bbs -- flags rpo ) - merge-sets get '[ _ at ] [ bit-set-union ] map-reduce + merge-sets get '[ _ at ] [ union ] map-reduce cfg get reverse-post-order ; inline -: filter-by ( flags seq -- seq' ) - [ drop ] selector [ 2each ] dip ; - -HINTS: filter-by { bit-array object } ; - PRIVATE> : compute-merge-sets ( cfg -- ) needs-dominance - H{ } clone visited set + HS{ } clone visited set [ compute-levels ] [ init-merge-sets ] [ compute-merge-set-loop ] tri ; -: merge-set-each ( ... bbs quot: ( ... bb -- ... ) -- ... ) - [ (merge-set) ] dip '[ - swap _ [ drop ] if - ] 2each ; inline - : merge-set ( bbs -- bbs' ) - (merge-set) filter-by ; + (merge-set) [ members ] dip nths ; + +: merge-set-each ( bbs quot: ( bb -- ) -- ) + [ merge-set ] dip each ; inline diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor index d93045da55..8b766c8114 100644 --- a/basis/compiler/cfg/ssa/destruction/destruction.factor +++ b/basis/compiler/cfg/ssa/destruction/destruction.factor @@ -15,6 +15,7 @@ compiler.cfg.ssa.interference compiler.cfg.ssa.interference.live-ranges compiler.cfg.utilities compiler.utilities ; +FROM: namespaces => set ; IN: compiler.cfg.ssa.destruction ! Maps vregs to leaders. diff --git a/basis/compiler/cfg/ssa/liveness/liveness.factor b/basis/compiler/cfg/ssa/liveness/liveness.factor index 7847de28fc..6e84b8b77d 100644 --- a/basis/compiler/cfg/ssa/liveness/liveness.factor +++ b/basis/compiler/cfg/ssa/liveness/liveness.factor @@ -6,6 +6,7 @@ compiler.cfg.rpo compiler.cfg.dominance compiler.cfg.def-use compiler.cfg.instructions ; +FROM: namespaces => set ; IN: compiler.cfg.ssa.liveness ! Liveness checking on SSA IR, as described in diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor index 30a2c4c13f..95feb4c034 100644 --- a/basis/compiler/cfg/stacks/local/local.factor +++ b/basis/compiler/cfg/stacks/local/local.factor @@ -8,6 +8,7 @@ compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks.height compiler.cfg.parallel-copy ; +FROM: namespaces => set ; IN: compiler.cfg.stacks.local ! Local stack analysis. We build three sets for every basic block @@ -106,4 +107,4 @@ M: rs-loc translate-local-loc n>> current-height get r>> - ; : peek-set ( bb -- assoc ) peek-sets get at ; : replace-set ( bb -- assoc ) replace-sets get at ; -: kill-set ( bb -- assoc ) kill-sets get at ; \ No newline at end of file +: kill-set ( bb -- assoc ) kill-sets get at ; diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor index 523f7c6d1c..cecf5f7251 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier.factor @@ -3,6 +3,7 @@ USING: accessors assocs combinators.short-circuit compiler.cfg.instructions compiler.cfg.rpo kernel namespaces sequences sets ; +FROM: namespaces => set ; IN: compiler.cfg.write-barrier SYMBOL: fresh-allocations diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 963ed0ab28..3edfcc565b 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -16,6 +16,7 @@ compiler.cfg.registers compiler.cfg.builder compiler.codegen.fixup compiler.utilities ; +FROM: namespaces => set ; IN: compiler.codegen SYMBOL: insn-counts diff --git a/basis/compiler/tree/checker/checker.factor b/basis/compiler/tree/checker/checker.factor index b3f01c8c01..a3a19b8f4d 100644 --- a/basis/compiler/tree/checker/checker.factor +++ b/basis/compiler/tree/checker/checker.factor @@ -7,6 +7,7 @@ compiler.tree compiler.tree.def-use compiler.tree.recursive compiler.tree.combinators ; +FROM: namespaces => set ; IN: compiler.tree.checker ! Check some invariants; this can help catch compiler bugs. diff --git a/basis/compiler/tree/dead-code/branches/branches.factor b/basis/compiler/tree/dead-code/branches/branches.factor index d1fdf6359a..5b5249f8e4 100644 --- a/basis/compiler/tree/dead-code/branches/branches.factor +++ b/basis/compiler/tree/dead-code/branches/branches.factor @@ -4,6 +4,7 @@ USING: sequences namespaces kernel accessors assocs sets fry arrays combinators columns stack-checker.backend stack-checker.branches compiler.tree compiler.tree.combinators compiler.tree.dead-code.liveness compiler.tree.dead-code.simple ; +FROM: namespaces => set ; IN: compiler.tree.dead-code.branches M: #if mark-live-values* look-at-inputs ; diff --git a/basis/compiler/tree/dead-code/liveness/liveness.factor b/basis/compiler/tree/dead-code/liveness/liveness.factor index 9ece5d340b..7e437cbc4e 100644 --- a/basis/compiler/tree/dead-code/liveness/liveness.factor +++ b/basis/compiler/tree/dead-code/liveness/liveness.factor @@ -4,6 +4,7 @@ USING: fry accessors namespaces assocs deques search-deques dlists kernel sequences compiler.utilities words sets stack-checker.branches compiler.tree compiler.tree.def-use compiler.tree.combinators ; +FROM: namespaces => set ; IN: compiler.tree.dead-code.liveness SYMBOL: work-list diff --git a/basis/compiler/tree/def-use/def-use.factor b/basis/compiler/tree/def-use/def-use.factor index 872b6131c9..4af54d0319 100644 --- a/basis/compiler/tree/def-use/def-use.factor +++ b/basis/compiler/tree/def-use/def-use.factor @@ -6,6 +6,8 @@ stack-checker.state stack-checker.branches compiler.tree compiler.tree.combinators ; +FROM: namespaces => set ; +FROM: sets => members ; IN: compiler.tree.def-use SYMBOL: def-use @@ -42,7 +44,7 @@ GENERIC: node-uses-values ( node -- values ) M: #introduce node-uses-values drop f ; M: #push node-uses-values drop f ; -M: #phi node-uses-values phi-in-d>> concat remove-bottom prune ; +M: #phi node-uses-values phi-in-d>> concat remove-bottom members ; M: #declare node-uses-values drop f ; M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ; M: #shuffle node-uses-values [ in-d>> ] [ in-r>> ] bi append ; diff --git a/basis/compiler/tree/def-use/simplified/simplified.factor b/basis/compiler/tree/def-use/simplified/simplified.factor index c2fb74c97e..0061e8cffb 100644 --- a/basis/compiler/tree/def-use/simplified/simplified.factor +++ b/basis/compiler/tree/def-use/simplified/simplified.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: sequences kernel fry vectors accessors namespaces assocs sets stack-checker.branches compiler.tree compiler.tree.def-use ; +FROM: namespaces => set ; IN: compiler.tree.def-use.simplified ! Simplified def-use follows chains of copies. diff --git a/basis/compiler/tree/escape-analysis/allocations/allocations.factor b/basis/compiler/tree/escape-analysis/allocations/allocations.factor index 5291c5e81f..015b6ad626 100644 --- a/basis/compiler/tree/escape-analysis/allocations/allocations.factor +++ b/basis/compiler/tree/escape-analysis/allocations/allocations.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs namespaces sequences kernel math combinators sets disjoint-sets fry stack-checker.values ; +FROM: namespaces => set ; IN: compiler.tree.escape-analysis.allocations ! A map from values to classes. Only for #introduce outputs diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor index ece2ed80f3..961ce1ecd7 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor @@ -9,6 +9,7 @@ compiler.tree.propagation.info compiler.tree.def-use compiler.tree.def-use.simplified compiler.tree.late-optimizations ; +FROM: namespaces => set ; IN: compiler.tree.modular-arithmetic ! This is a late-stage optimization. diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 0077d0f123..4f0eea9cbb 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -9,6 +9,7 @@ vectors hashtables combinators effects generalizations assocs sets combinators.short-circuit sequences.private locals growable stack-checker namespaces compiler.tree.propagation.info ; FROM: math => float ; +FROM: sets => set ; IN: compiler.tree.propagation.transforms \ equal? [ @@ -134,6 +135,7 @@ IN: compiler.tree.propagation.transforms in-d>> first value-info literal>> { { V{ } [ [ drop { } 0 vector boa ] ] } { H{ } [ [ drop 0 ] ] } + { HS{ } [ [ drop f fast-set ] ] } [ drop f ] } case ] "custom-inlining" set-word-prop @@ -207,7 +209,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 +274,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/basis/compiler/tree/recursive/recursive.factor b/basis/compiler/tree/recursive/recursive.factor index af76cda903..0473e3a3a4 100644 --- a/basis/compiler/tree/recursive/recursive.factor +++ b/basis/compiler/tree/recursive/recursive.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel assocs arrays namespaces accessors sequences deques fry search-deques dlists combinators.short-circuit make sets compiler.tree ; +FROM: namespaces => set ; IN: compiler.tree.recursive TUPLE: call-site tail? node label ; diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 7707c2a2c7..406dada145 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -4,6 +4,7 @@ USING: sequences kernel splitting lists fry accessors assocs math.order math combinators namespaces urls.encoding xml.syntax xmode.code2html xml.data arrays strings vectors xml.writer io.streams.string locals unicode.categories ; +FROM: namespaces => set ; IN: farkup SYMBOL: relative-link-prefix diff --git a/basis/furnace/auth/auth.factor b/basis/furnace/auth/auth.factor index 29ab04fe1b..2acb09919d 100644 --- a/basis/furnace/auth/auth.factor +++ b/basis/furnace/auth/auth.factor @@ -15,6 +15,7 @@ furnace.boilerplate furnace.auth.providers furnace.auth.providers.db ; FROM: assocs => change-at ; +FROM: namespaces => set ; IN: furnace.auth SYMBOL: logged-in-user diff --git a/basis/help/crossref/crossref-tests.factor b/basis/help/crossref/crossref-tests.factor index 6fb4c562cf..99f40622ea 100644 --- a/basis/help/crossref/crossref-tests.factor +++ b/basis/help/crossref/crossref-tests.factor @@ -62,4 +62,4 @@ ARTICLE: "crossref-test-1" "Crossref test 1" ARTICLE: "crossref-test-2" "Crossref test 2" { $markup-example { $subsection "crossref-test-1" } } ; -[ V{ } ] [ "crossref-test-2" >link article-children ] unit-test +[ { } ] [ "crossref-test-2" >link article-children ] unit-test diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index e3a7af6fc2..da5f2911f8 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -166,6 +166,7 @@ ARTICLE: "collections" "Collections" } { $heading "Other collections" } { $subsections + "sets" "lists" "disjoint-sets" "interval-maps" diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index 85fa50f2b9..87b44595d2 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -6,6 +6,7 @@ help help.markup help.topics io.streams.string kernel macros namespaces sequences sequences.deep sets sorting splitting strings unicode.categories values vocabs vocabs.loader words words.symbol summary debugger io ; +FROM: sets => members ; IN: help.lint.checks ERROR: simple-lint-error message ; @@ -48,7 +49,7 @@ SYMBOL: vocab-articles : effect-values ( word -- seq ) stack-effect [ in>> ] [ out>> ] bi append - [ dup pair? [ first ] when effect>string ] map prune ; + [ dup pair? [ first ] when effect>string ] map members ; : effect-effects ( word -- seq ) stack-effect in>> [ @@ -103,7 +104,7 @@ SYMBOL: vocab-articles : check-see-also ( element -- ) \ $see-also swap elements [ - rest dup prune [ length ] bi@ assert= + rest all-unique? t assert= ] each ; : vocab-exists? ( name -- ? ) diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index f951f30b2f..ce954eae98 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -8,6 +8,7 @@ prettyprint.stylesheet quotations see sequences sets slots sorting splitting strings vectors vocabs vocabs.loader words words.symbol ; FROM: prettyprint.sections => with-pprint ; +FROM: namespaces => set ; IN: help.markup PREDICATE: simple-element < array @@ -441,7 +442,7 @@ M: array elements* : elements ( elt-type element -- seq ) [ elements* ] { } make ; : collect-elements ( element seq -- elements ) - swap '[ _ elements [ rest ] map concat ] map concat prune ; + swap '[ _ elements [ rest ] map concat ] gather ; : <$link> ( topic -- element ) 1array \ $link prefix ; diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor index 2aa7cd218e..92d61ca7cf 100644 --- a/basis/inspector/inspector.factor +++ b/basis/inspector/inspector.factor @@ -5,6 +5,7 @@ namespaces prettyprint prettyprint.custom prettyprint.sections sequences strings io.styles vectors words quotations mirrors splitting math.parser classes vocabs sets sorting summary debugger continuations fry combinators ; +FROM: namespaces => set ; IN: inspector SYMBOL: +number-rows+ diff --git a/basis/io/monitors/linux/linux.factor b/basis/io/monitors/linux/linux.factor index eacc920303..63484f467f 100644 --- a/basis/io/monitors/linux/linux.factor +++ b/basis/io/monitors/linux/linux.factor @@ -81,7 +81,7 @@ M: linux-monitor dispose* ( monitor -- ) IN_MOVED_FROM +rename-file-old+ ?flag IN_MOVED_TO +rename-file-new+ ?flag drop - ] { } make prune ; + ] { } make members ; : parse-event-name ( event -- name ) dup len>> zero? diff --git a/basis/locals/rewrite/closures/closures.factor b/basis/locals/rewrite/closures/closures.factor index d85155daad..b0f1426bec 100644 --- a/basis/locals/rewrite/closures/closures.factor +++ b/basis/locals/rewrite/closures/closures.factor @@ -18,7 +18,7 @@ GENERIC: rewrite-closures* ( obj -- ) GENERIC: defs-vars* ( seq form -- seq' ) -: defs-vars ( form -- vars ) { } [ defs-vars* ] reduce prune ; +: defs-vars ( form -- vars ) { } [ defs-vars* ] reduce members ; M: def defs-vars* local>> unquote suffix ; @@ -28,7 +28,7 @@ M: object defs-vars* drop ; GENERIC: uses-vars* ( seq form -- seq' ) -: uses-vars ( form -- vars ) { } [ uses-vars* ] reduce prune ; +: uses-vars ( form -- vars ) { } [ uses-vars* ] reduce members ; M: local-writer uses-vars* "local-reader" word-prop suffix ; diff --git a/basis/math/ranges/ranges-tests.factor b/basis/math/ranges/ranges-tests.factor index e314f72c6b..16cb379ba8 100644 --- a/basis/math/ranges/ranges-tests.factor +++ b/basis/math/ranges/ranges-tests.factor @@ -23,5 +23,5 @@ IN: math.ranges.tests [ { 0 1/3 2/3 1 } ] [ 1 0 -1/3 >array reverse ] unit-test [ 100 ] [ - 1 100 [a,b] [ 2^ [1,b] ] map prune length + 1 100 [a,b] [ 2^ [1,b] ] map members length ] unit-test diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index a180713ccf..cc480c30b2 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -5,6 +5,7 @@ io vectors arrays math.parser math.order combinators classes sets unicode.categories compiler.units parser effects.parser words quotations memoize accessors locals splitting combinators.short-circuit generalizations ; +FROM: namespaces => set ; IN: peg TUPLE: parse-result remaining ast ; diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 11d97a5118..7d0cb40576 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -6,7 +6,8 @@ combinators continuations effects generic hashtables io 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: sets => members ; IN: prettyprint.backend M: effect pprint* effect>string "(" ")" surround text ; @@ -187,6 +188,7 @@ M: hashtable pprint-delims drop \ H{ \ } ; 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 ; @@ -195,6 +197,7 @@ M: callable >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 ; @@ -226,6 +229,7 @@ M: byte-vector pprint* pprint-object ; M: hashtable pprint* pprint-object ; M: curry pprint* pprint-object ; M: compose pprint* pprint-object ; +M: hash-set pprint* pprint-object ; M: wrapper pprint* { diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 23cf956a1d..249a6e0a57 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -5,6 +5,7 @@ io.streams.string io.styles kernel make math math.parser namespaces parser prettyprint.backend prettyprint.config prettyprint.custom prettyprint.sections quotations sequences sorting strings vocabs vocabs.prettyprint words sets generic ; +FROM: namespaces => set ; IN: prettyprint : with-use ( obj quot -- ) diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index 6f5f61f688..cd606667fd 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -4,6 +4,7 @@ USING: arrays generic hashtables io kernel math assocs namespaces make sequences strings io.styles vectors words prettyprint.config splitting classes continuations accessors sets vocabs.parser combinators vocabs ; +FROM: namespaces => set ; IN: prettyprint.sections ! State diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor index 9341b96b11..3fc4ff80eb 100644 --- a/basis/random/random-tests.factor +++ b/basis/random/random-tests.factor @@ -14,7 +14,7 @@ IN: random.tests [ t ] [ 10000 [ iota 0 [ drop 187 random + ] reduce ] keep / 2 * 187 10 ~ ] unit-test [ t ] [ 10000 [ iota 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test -[ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test +[ t ] [ 1000 [ 400 random ] replicate members length 256 > ] unit-test [ f ] [ 0 random ] unit-test @@ -28,8 +28,8 @@ IN: random.tests [ { 1 2 } 3 sample ] [ too-many-samples? ] must-fail-with -[ 3 ] [ { 1 2 3 4 } 3 sample prune length ] unit-test -[ 99 ] [ 100 iota 99 sample prune length ] unit-test +[ 3 ] [ { 1 2 3 4 } 3 sample members length ] unit-test +[ 99 ] [ 100 iota 99 sample members length ] unit-test [ ] [ [ 100 random-bytes ] with-system-random drop ] unit-test diff --git a/basis/regexp/classes/classes-tests.factor b/basis/regexp/classes/classes-tests.factor index e2db86f6c1..4044a059a5 100644 --- a/basis/regexp/classes/classes-tests.factor +++ b/basis/regexp/classes/classes-tests.factor @@ -36,7 +36,7 @@ IN: regexp.classes.tests ! Making classes into nested conditionals -[ V{ 1 2 3 4 } ] [ T{ and-class f { 1 T{ not-class f 2 } T{ or-class f { 3 4 } } 2 } } class>questions ] unit-test +[ { 1 2 3 4 } ] [ T{ and-class f { 1 T{ not-class f 2 } T{ or-class f { 3 4 } } 2 } } class>questions ] unit-test [ { 3 } ] [ { { 3 t } } table>condition ] unit-test [ { T{ primitive-class } } ] [ { { 1 t } { 2 T{ primitive-class } } } table>questions ] unit-test [ { { 1 t } { 2 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } t assoc-answer ] unit-test diff --git a/basis/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor index e3e2f0bcf3..fd4c7e7e4f 100644 --- a/basis/regexp/classes/classes.factor +++ b/basis/regexp/classes/classes.factor @@ -5,6 +5,7 @@ unicode.categories combinators.short-circuit sequences fry macros arrays assocs sets classes mirrors unicode.script unicode.data ; FROM: ascii => ascii? ; +FROM: sets => members ; IN: regexp.classes SINGLETONS: dot letter-class LETTER-class Letter-class digit-class @@ -157,7 +158,7 @@ DEFER: substitute TUPLE: class-partition integers not-integers simples not-simples and or other ; : partition-classes ( seq -- class-partition ) - prune + members [ integer? ] partition [ not-integer? ] partition [ simple-class? ] partition @@ -194,7 +195,7 @@ TUPLE: class-partition integers not-integers simples not-simples and or other ; [ t swap remove ] change-other dup contradiction? [ drop f ] - [ filter-not-integers class-partition>seq prune t and-class seq>instance ] if ; + [ filter-not-integers class-partition>seq members t and-class seq>instance ] if ; : ( seq -- class ) dup and-class flatten partition-classes @@ -225,7 +226,7 @@ TUPLE: class-partition integers not-integers simples not-simples and or other ; [ f swap remove ] change-other dup tautology? [ drop t ] - [ filter-integers class-partition>seq prune f or-class seq>instance ] if ; + [ filter-integers class-partition>seq members f or-class seq>instance ] if ; : ( seq -- class ) dup or-class flatten partition-classes @@ -329,7 +330,7 @@ M: object class>questions 1array ; : condition-states ( condition -- states ) dup condition? [ [ yes>> ] [ no>> ] bi - [ condition-states ] bi@ append prune + [ condition-states ] bi@ union ] [ 1array ] if ; : condition-at ( condition assoc -- new-condition ) diff --git a/basis/regexp/compiler/compiler.factor b/basis/regexp/compiler/compiler.factor index d8940bb829..0682cc4f56 100644 --- a/basis/regexp/compiler/compiler.factor +++ b/basis/regexp/compiler/compiler.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: regexp.classes kernel sequences regexp.negation -quotations assocs fry math locals combinators +quotations assocs fry math locals combinators sets accessors words compiler.units kernel.private strings sequences.private arrays namespaces unicode.breaks regexp.transition-tables combinators.short-circuit ; @@ -106,7 +106,7 @@ C: box : word>quot ( word dfa -- quot ) [ transitions>> at ] - [ final-states>> key? ] 2bi + [ final-states>> in? ] 2bi transitions>quot ; : states>code ( words dfa -- ) diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor index fa75232fd5..416781bdb3 100644 --- a/basis/regexp/dfa/dfa.factor +++ b/basis/regexp/dfa/dfa.factor @@ -69,10 +69,10 @@ IN: regexp.dfa : set-final-states ( nfa dfa -- ) [ - [ final-states>> keys ] + [ final-states>> members ] [ transitions>> keys ] bi* [ intersects? ] with filter - unique + fast-set ] keep (>>final-states) ; : initialize-dfa ( nfa -- dfa ) diff --git a/basis/regexp/minimize/minimize-tests.factor b/basis/regexp/minimize/minimize-tests.factor index 17a1d51b88..7f961f4d98 100644 --- a/basis/regexp/minimize/minimize-tests.factor +++ b/basis/regexp/minimize/minimize-tests.factor @@ -34,7 +34,7 @@ IN: regexp.minimize.tests { 3 H{ } } } } { start-state 0 } - { final-states H{ { 3 3 } } } + { final-states HS{ 3 } } } ] [ T{ transition-table @@ -48,7 +48,7 @@ IN: regexp.minimize.tests { 6 H{ } } } } { start-state 0 } - { final-states H{ { 3 3 } { 6 6 } } } + { final-states HS{ 3 6 } } } combine-states ] unit-test diff --git a/basis/regexp/minimize/minimize.factor b/basis/regexp/minimize/minimize.factor index 08f7b1da58..7991efb047 100644 --- a/basis/regexp/minimize/minimize.factor +++ b/basis/regexp/minimize/minimize.factor @@ -19,7 +19,7 @@ IN: regexp.minimize { [ drop <= ] [ transitions>> '[ _ at keys ] bi@ set= ] - [ final-states>> '[ _ key? ] bi@ = ] + [ final-states>> '[ _ in? ] bi@ = ] } 3&& ; :: initialize-partitions ( transition-table -- partitions ) diff --git a/basis/regexp/negation/negation-tests.factor b/basis/regexp/negation/negation-tests.factor index 41dfe7f493..f367e62ff5 100644 --- a/basis/regexp/negation/negation-tests.factor +++ b/basis/regexp/negation/negation-tests.factor @@ -12,7 +12,7 @@ IN: regexp.negation.tests { -1 H{ { t -1 } } } } } { start-state 0 } - { final-states H{ { 0 0 } { -1 -1 } } } + { final-states HS{ 0 -1 } } } ] [ ! R/ a/ @@ -22,6 +22,6 @@ IN: regexp.negation.tests { 1 H{ } } } } { start-state 0 } - { final-states H{ { 1 1 } } } + { final-states HS{ 1 } } } negate-table ] unit-test diff --git a/basis/regexp/negation/negation.factor b/basis/regexp/negation/negation.factor index 802e211536..5f627b645e 100644 --- a/basis/regexp/negation/negation.factor +++ b/basis/regexp/negation/negation.factor @@ -3,7 +3,7 @@ USING: regexp.nfa regexp.disambiguate kernel sequences assocs regexp.classes hashtables accessors fry vectors regexp.ast regexp.transition-tables regexp.minimize -regexp.dfa namespaces ; +regexp.dfa namespaces sets ; IN: regexp.negation CONSTANT: fail-state -1 @@ -21,7 +21,7 @@ CONSTANT: fail-state -1 fail-state-recurses ; : inverse-final-states ( transition-table -- final-states ) - [ transitions>> assoc>set ] [ final-states>> ] bi assoc-diff ; + [ transitions>> keys ] [ final-states>> ] bi diff fast-set ; : negate-table ( transition-table -- transition-table ) clone @@ -36,14 +36,14 @@ CONSTANT: fail-state -1 [ [ [ 1vector ] assoc-map ] assoc-map ] change-transitions ; : unify-final-state ( transition-table -- transition-table ) - dup [ final-states>> keys ] keep + dup [ final-states>> members ] keep '[ -2 epsilon _ set-transition ] each - H{ { -2 -2 } } >>final-states ; + HS{ -2 } clone >>final-states ; : adjoin-dfa ( transition-table -- start end ) unify-final-state renumber-states box-transitions [ start-state>> ] - [ final-states>> keys first ] + [ final-states>> members first ] [ nfa-table get [ transitions>> ] bi@ swap assoc-union! drop ] tri ; : ast>dfa ( parse-tree -- minimal-dfa ) diff --git a/basis/regexp/nfa/nfa.factor b/basis/regexp/nfa/nfa.factor index 35edcf328a..fb210c5ef2 100644 --- a/basis/regexp/nfa/nfa.factor +++ b/basis/regexp/nfa/nfa.factor @@ -5,6 +5,7 @@ sequences fry quotations math.order math.ranges vectors unicode.categories regexp.transition-tables words sets hashtables combinators.short-circuit unicode.data regexp.ast regexp.classes memoize ; +FROM: namespaces => set ; IN: regexp.nfa ! This uses unicode.data for ch>upper and ch>lower @@ -162,6 +163,6 @@ M: with-options nfa-node ( node -- start end ) nfa-table set nfa-node nfa-table get - swap dup associate >>final-states + swap 1array fast-set >>final-states swap >>start-state ] with-scope ; diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index 70281aa798..0025b89d56 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -27,7 +27,7 @@ ERROR: bad-class name ; [ [ simple ] keep ] H{ } map>assoc ; MEMO: simple-script-table ( -- table ) - script-table interval-values prune simple-table ; + script-table interval-values members simple-table ; MEMO: simple-category-table ( -- table ) categories simple-table ; diff --git a/basis/regexp/transition-tables/transition-tables.factor b/basis/regexp/transition-tables/transition-tables.factor index f452e3d24a..b548b883b2 100644 --- a/basis/regexp/transition-tables/transition-tables.factor +++ b/basis/regexp/transition-tables/transition-tables.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs fry hashtables kernel sequences -vectors locals regexp.classes ; +vectors locals regexp.classes sets ; IN: regexp.transition-tables TUPLE: transition-table transitions start-state final-states ; @@ -9,7 +9,7 @@ TUPLE: transition-table transitions start-state final-states ; : ( -- transition-table ) transition-table new H{ } clone >>transitions - H{ } clone >>final-states ; + HS{ } clone >>final-states ; :: (set-transition) ( from to obj hash -- ) from hash at @@ -27,8 +27,8 @@ TUPLE: transition-table transitions start-state final-states ; : add-transition ( from to obj transition-table -- ) transitions>> (add-transition) ; -: map-set ( assoc quot -- new-assoc ) - '[ drop @ dup ] assoc-map ; inline +: map-set ( set quot -- new-set ) + over [ [ members ] dip map ] dip set-like ; inline : number-transitions ( transitions numbering -- new-transitions ) dup '[ diff --git a/basis/see/see.factor b/basis/see/see.factor index 326e051219..38a8a48934 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -8,6 +8,9 @@ io.streams.string io.styles kernel make namespaces prettyprint prettyprint.backend prettyprint.config prettyprint.custom prettyprint.sections sequences sets sorting strings summary words words.symbol words.constant words.alias vocabs slots ; +FROM: namespaces => set ; +FROM: classes => members ; +RENAME: members sets => set-members IN: see GENERIC: synopsis* ( defspec -- ) @@ -237,7 +240,7 @@ PRIVATE> dup class? [ dup seeing-implementors % ] when dup generic? [ dup seeing-methods % ] when drop - ] { } make prune ; + ] { } make set-members ; : see-methods ( word -- ) methods see-all nl ; diff --git a/basis/simple-flat-file/simple-flat-file.factor b/basis/simple-flat-file/simple-flat-file.factor index 88a64b7746..a2fa8c3c4c 100644 --- a/basis/simple-flat-file/simple-flat-file.factor +++ b/basis/simple-flat-file/simple-flat-file.factor @@ -47,7 +47,7 @@ SYMBOL: interned ] { } make ; : process-interval-file ( ranges -- table ) - dup values prune interned + dup values members interned [ expand-ranges ] with-variable ; : load-interval-file ( filename -- table ) diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 61ccd5c435..045c08df42 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -7,6 +7,7 @@ io.encodings.ascii io.timeouts io.sockets io.sockets.secure io.crlf kernel logging sequences combinators splitting assocs strings math.order math.parser random system calendar summary calendar.format accessors sets hashtables base64 debugger classes prettyprint words ; +FROM: namespaces => set ; IN: smtp SYMBOL: smtp-domain diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 1e7ae5a9f3..51b5f0cdaf 100644 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -7,6 +7,7 @@ definitions locals sets hints macros stack-checker.state stack-checker.visitor stack-checker.errors stack-checker.values stack-checker.recursive-state stack-checker.dependencies summary ; FROM: sequences.private => from-end ; +FROM: namespaces => set ; IN: stack-checker.backend : push-d ( obj -- ) meta-d push ; diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor index 7110fa77ab..50d5ff6189 100644 --- a/basis/stack-checker/dependencies/dependencies.factor +++ b/basis/stack-checker/dependencies/dependencies.factor @@ -5,6 +5,7 @@ generic kernel math namespaces sequences words sets combinators.short-circuit classes.tuple alien.c-types ; FROM: classes.tuple.private => tuple-layout ; FROM: assocs => change-at ; +FROM: namespaces => set ; IN: stack-checker.dependencies ! Words that the current quotation depends on diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 98e20e5330..610d3f8600 100644 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -9,6 +9,7 @@ sequences.private generalizations stack-checker.backend stack-checker.state stack-checker.visitor stack-checker.errors stack-checker.values stack-checker.recursive-state stack-checker.dependencies ; +FROM: namespaces => set ; IN: stack-checker.transforms : call-transformer ( stack quot -- newquot ) diff --git a/basis/suffix-arrays/suffix-arrays-tests.factor b/basis/suffix-arrays/suffix-arrays-tests.factor index 5149804ce6..f9de4979ab 100644 --- a/basis/suffix-arrays/suffix-arrays-tests.factor +++ b/basis/suffix-arrays/suffix-arrays-tests.factor @@ -25,14 +25,14 @@ IN: suffix-arrays.tests [ { } ] [ SA{ } "something" swap query ] unit-test -[ V{ "unit-test" "(unit-test)" } ] +[ { "unit-test" "(unit-test)" } ] [ "suffix-array" get "unit-test" swap query ] unit-test [ t ] [ "suffix-array" get "something else" swap query empty? ] unit-test -[ V{ "rofl" } ] [ SA{ "rofl" } "r" swap query ] unit-test -[ V{ "rofl" } ] [ SA{ "rofl" } "o" swap query ] unit-test -[ V{ "rofl" } ] [ SA{ "rofl" } "f" swap query ] unit-test -[ V{ "rofl" } ] [ SA{ "rofl" } "l" swap query ] unit-test -[ V{ } ] [ SA{ "rofl" } "t" swap query ] unit-test +[ { "rofl" } ] [ SA{ "rofl" } "r" swap query ] unit-test +[ { "rofl" } ] [ SA{ "rofl" } "o" swap query ] unit-test +[ { "rofl" } ] [ SA{ "rofl" } "f" swap query ] unit-test +[ { "rofl" } ] [ SA{ "rofl" } "l" swap query ] unit-test +[ { } ] [ SA{ "rofl" } "t" swap query ] unit-test diff --git a/basis/suffix-arrays/suffix-arrays.factor b/basis/suffix-arrays/suffix-arrays.factor index 134c144fda..8f728c1eda 100644 --- a/basis/suffix-arrays/suffix-arrays.factor +++ b/basis/suffix-arrays/suffix-arrays.factor @@ -35,5 +35,5 @@ SYNTAX: SA{ \ } [ >suffix-array ] parse-literal ; : query ( begin suffix-array -- matches ) 2dup find-index dup - [ -rot [ from-to ] keep [ seq>> ] map prune ] + [ -rot [ from-to ] keep [ seq>> ] map members ] [ 3drop { } ] if ; diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 9a5f89fae0..6fb6ab91ec 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -20,6 +20,8 @@ QUALIFIED: source-files QUALIFIED: source-files.errors QUALIFIED: vocabs FROM: alien.libraries.private => >deployed-library-path ; +FROM: namespaces => set ; +FROM: sets => members ; IN: tools.deploy.shaker ! This file is some hairy shit. @@ -506,7 +508,7 @@ SYMBOL: deploy-vocab : write-vocab-manifest ( vocab-manifest-out -- ) "Writing vocabulary manifest to " write dup print flush vocabs "VOCABS:" prefix - deploy-libraries get [ libraries get at path>> ] map prune "LIBRARIES:" prefix append + deploy-libraries get [ libraries get at path>> ] map members "LIBRARIES:" prefix append swap utf8 set-file-lines ; : prepare-deploy-libraries ( -- ) diff --git a/basis/tools/profiler/profiler.factor b/basis/tools/profiler/profiler.factor index b0ce5dfbe4..c79d8b443c 100644 --- a/basis/tools/profiler/profiler.factor +++ b/basis/tools/profiler/profiler.factor @@ -5,6 +5,7 @@ io io.styles namespaces assocs kernel.private strings combinators sorting math.parser vocabs definitions tools.profiler.private tools.crossref continuations generic compiler.units compiler.crossref sets classes fry ; +FROM: sets => members ; IN: tools.profiler : profile ( quot -- ) @@ -41,7 +42,7 @@ IN: tools.profiler [ smart-usage [ word? ] filter ] [ generic-call-sites-of keys ] [ effect-dependencies-of keys ] - tri 3append prune ; + tri 3append members ; : usage-counters ( word -- alist ) profiler-usage counters ; diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor index ea16abb9ba..e9d677537c 100644 --- a/basis/ui/gadgets/gadgets-tests.factor +++ b/basis/ui/gadgets/gadgets-tests.factor @@ -2,6 +2,7 @@ USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test namespaces models kernel dlists deques math math.parser ui sequences hashtables assocs io arrays prettyprint io.streams.string math.rectangles ui.gadgets.private sets generic ; +FROM: namespaces => set ; IN: ui.gadgets.tests [ { 300 300 } ] @@ -126,16 +127,16 @@ M: mock-gadget ungraft* ] each-integer ; : status-flags ( -- seq ) - { "g" "1" "2" "3" } [ get graft-state>> ] map prune ; + { "g" "1" "2" "3" } [ get graft-state>> ] map members ; : notify-combo ( ? ? -- ) nl "===== Combo: " write 2dup 2array . nl \ graft-queue [ "g" set [ ] [ add-some-children ] unit-test - [ V{ { f f } } ] [ status-flags ] unit-test + [ { { f f } } ] [ status-flags ] unit-test [ ] [ "g" get graft ] unit-test - [ V{ { f t } } ] [ status-flags ] unit-test + [ { { f t } } ] [ status-flags ] unit-test dup [ [ ] [ notify-queued ] unit-test ] when [ ] [ "g" get clear-gadget ] unit-test [ [ t ] [ graft-queue [ front>> ] [ back>> ] bi eq? ] unit-test ] unless @@ -146,7 +147,7 @@ M: mock-gadget ungraft* [ { f t } ] [ "3" get graft-state>> ] unit-test [ ] [ graft-queue [ "x" print notify ] slurp-deque ] unit-test [ ] [ notify-queued ] unit-test - [ V{ { t t } } ] [ status-flags ] unit-test + [ { { t t } } ] [ status-flags ] unit-test ] with-variable ; { { f f } { f t } { t f } { t t } } [ notify-combo ] assoc-each diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index f33b6ec6da..6e8e73ab55 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -5,6 +5,8 @@ namespaces make sequences words strings system hashtables math.parser math.vectors classes.tuple classes boxes calendar alarms combinators sets columns fry deques ui.gadgets ui.gadgets.private ascii combinators.short-circuit ; +FROM: namespaces => set ; +FROM: sets => members ; IN: ui.gestures : get-gesture-handler ( gesture gadget -- quot ) @@ -234,7 +236,7 @@ SYMBOL: drag-timer : modifier ( mod modifiers -- seq ) [ second swap bitand 0 > ] with filter - 0 prune [ f ] [ >array ] if-empty ; + 0 members [ f ] [ >array ] if-empty ; : drag-loc ( -- loc ) hand-loc get-global hand-click-loc get-global v- ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 2a948fddc0..53d3bec56e 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -16,6 +16,7 @@ ui.tools.listener.completion ui.tools.listener.popups ui.tools.listener.history ui.images ui.tools.error-list tools.errors.model ; FROM: source-files.errors => all-errors ; +FROM: namespaces => set ; IN: ui.tools.listener ! If waiting is t, we're waiting for user input, and invoking diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 824ffb8351..bf32b329ce 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -138,7 +138,7 @@ M: world ungraft* layout-queue [ dup layout find-world [ , ] when* ] slurp-deque - ] { } make prune ; + ] { } make members ; : redraw-worlds ( seq -- ) [ dup update-hand draw-world ] each ; diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 24dfba6be0..ff4e64df29 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -6,6 +6,7 @@ math.parser hash2 math.order byte-arrays namespaces compiler.units parser io.encodings.ascii values interval-maps ascii sets combinators locals math.ranges sorting make strings.parser io.encodings.utf8 memoize simple-flat-file ; +FROM: namespaces => set ; IN: unicode.data code-point ] assoc-map ; : properties>intervals ( properties -- assoc[str,interval] ) - dup values prune [ f ] H{ } map>assoc + dup values members [ f ] H{ } map>assoc [ [ push-at ] curry assoc-each ] keep [ ] assoc-map ; diff --git a/basis/vocabs/hierarchy/hierarchy.factor b/basis/vocabs/hierarchy/hierarchy.factor index b840b5ab9d..986091a543 100644 --- a/basis/vocabs/hierarchy/hierarchy.factor +++ b/basis/vocabs/hierarchy/hierarchy.factor @@ -65,8 +65,8 @@ PRIVATE> #! Hack. [ vocab-prefix? ] partition [ - [ vocab-name ] map unique - '[ name>> _ key? not ] filter + [ vocab-name ] map fast-set + '[ name>> _ in? not ] filter convert-prefixes ] keep append ; diff --git a/basis/vocabs/metadata/metadata.factor b/basis/vocabs/metadata/metadata.factor index 09ca012fcc..5048b0edd0 100644 --- a/basis/vocabs/metadata/metadata.factor +++ b/basis/vocabs/metadata/metadata.factor @@ -73,7 +73,7 @@ M: vocab-link summary vocab-summary ; dup vocab-tags-path set-vocab-file-contents ; : add-vocab-tags ( tags vocab -- ) - [ vocab-tags append prune ] keep set-vocab-tags ; + [ vocab-tags append members ] keep set-vocab-tags ; : remove-vocab-tags ( tags vocab -- ) [ vocab-tags swap diff ] keep set-vocab-tags ; diff --git a/basis/vocabs/refresh/monitor/monitor.factor b/basis/vocabs/refresh/monitor/monitor.factor index 1bf73862e6..6274921bdb 100644 --- a/basis/vocabs/refresh/monitor/monitor.factor +++ b/basis/vocabs/refresh/monitor/monitor.factor @@ -39,7 +39,7 @@ TR: convert-separators "/\\" ".." ; : monitor-thread ( -- ) [ [ - vocab-roots get prune [ add-monitor-for-path ] each + vocab-roots get [ add-monitor-for-path ] each H{ } clone changed-vocabs set-global vocabs [ changed-vocab ] each diff --git a/basis/vocabs/refresh/refresh.factor b/basis/vocabs/refresh/refresh.factor index 9ec89e3102..3d9c91bbcd 100644 --- a/basis/vocabs/refresh/refresh.factor +++ b/basis/vocabs/refresh/refresh.factor @@ -3,6 +3,7 @@ USING: accessors assocs checksums checksums.crc32 io.encodings.utf8 io.files kernel namespaces sequences sets source-files vocabs vocabs.errors vocabs.loader ; +FROM: namespaces => set ; IN: vocabs.refresh : source-modified? ( path -- ? ) @@ -81,11 +82,11 @@ SYMBOL: modified-docs [ [ vocab f >>docs-loaded? drop ] each ] bi* ] [ - append prune + union [ unchanged-vocabs ] [ require-all load-failures. ] bi ] 2bi ; : refresh ( prefix -- ) to-refresh do-refresh ; -: refresh-all ( -- ) "" refresh ; \ No newline at end of file +: refresh-all ( -- ) "" refresh ; diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor index b927947329..1e59c19909 100644 --- a/basis/xml/elements/elements.factor +++ b/basis/xml/elements/elements.factor @@ -4,6 +4,7 @@ USING: kernel namespaces xml.tokenize xml.state xml.name xml.data accessors arrays make xml.char-classes fry assocs sequences math xml.errors sets combinators io.encodings io.encodings.iana unicode.case xml.dtd strings xml.entities unicode.categories ; +FROM: namespaces => set ; IN: xml.elements : take-interpolated ( quot -- interpolated ) diff --git a/basis/xmode/keyword-map/keyword-map.factor b/basis/xmode/keyword-map/keyword-map.factor index 877eda44aa..402dd974b1 100644 --- a/basis/xmode/keyword-map/keyword-map.factor +++ b/basis/xmode/keyword-map/keyword-map.factor @@ -32,7 +32,7 @@ M: keyword-map >alist assoc>> >alist ; : (keyword-map-no-word-sep) ( assoc -- str ) - keys concat [ alpha? not ] filter prune natural-sort ; + keys combine [ alpha? not ] filter natural-sort ; : keyword-map-no-word-sep* ( keyword-map -- str ) dup no-word-sep>> [ ] [ diff --git a/core/alien/alien-tests.factor b/core/alien/alien-tests.factor index 7eaa5cc50b..3321dbe2ed 100644 --- a/core/alien/alien-tests.factor +++ b/core/alien/alien-tests.factor @@ -1,6 +1,7 @@ USING: accessors alien alien.accessors alien.syntax byte-arrays arrays kernel kernel.private namespaces tools.test sequences libc math system prettyprint layouts alien.libraries sets ; +FROM: namespaces => set ; IN: alien.tests [ t ] [ -1 alien-address 0 > ] unit-test @@ -83,4 +84,4 @@ f initialize-test set-global [ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test -[ V{ BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } prune ] unit-test \ No newline at end of file +[ { BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } members ] unit-test diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 1870f4ac1b..c13f9f9026 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -29,6 +29,7 @@ IN: bootstrap.syntax "HEX:" "HOOK:" "H{" + "HS{" "IN:" "INSTANCE:" "M:" diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index f9aaf3eaa5..ae217904b7 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -3,6 +3,8 @@ USING: kernel classes classes.private combinators accessors sequences arrays vectors assocs namespaces words sorting layouts math hashtables kernel.private sets math.order ; +FROM: classes => members ; +RENAME: members sets => set-members IN: classes.algebra ( members -- class ) - [ null eq? not ] filter prune + [ null eq? not ] filter set-members dup length 1 = [ first ] [ anonymous-union boa ] if ; TUPLE: anonymous-intersection { participants read-only } ; : ( participants -- class ) - prune dup length 1 = [ first ] [ anonymous-intersection boa ] if ; + set-members dup length 1 = + [ first ] [ anonymous-intersection boa ] if ; TUPLE: anonymous-complement { class read-only } ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 28f0b192ee..623368d6fb 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -4,6 +4,7 @@ USING: accessors arrays definitions assocs kernel kernel.private slots.private namespaces make sequences strings words words.symbol vectors math quotations combinators sorting effects graphs vocabs sets ; +FROM: namespaces => set ; IN: classes ERROR: bad-inheritance class superclass ; diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index d14564f7b2..7ef2ed5f9f 100644 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -147,7 +147,7 @@ ERROR: no-case object ; : contiguous-range? ( keys -- ? ) dup [ fixnum? ] all? [ dup all-unique? [ - [ prune length ] + [ length ] [ [ supremum ] [ infimum ] bi - ] bi - 1 = ] [ drop f ] if diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index b024ed2c65..ffbdbefbf2 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -4,6 +4,7 @@ USING: accessors arrays kernel continuations assocs namespaces sequences words vocabs definitions hashtables init sets math math.order classes classes.private classes.algebra classes.tuple classes.tuple.private generic source-files.errors kernel.private ; +FROM: namespaces => set ; IN: compiler.units SYMBOL: old-definitions diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index ac3751e32e..e6d78fa03e 100644 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors continuations kernel namespaces make sequences vectors sets assocs init math ; +FROM: namespaces => set ; IN: destructors SYMBOL: disposables diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 0c626ac1d6..a733ac90fa 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -4,6 +4,7 @@ USING: accessors words kernel sequences namespaces make assocs hashtables definitions kernel.private classes classes.private classes.algebra quotations arrays vocabs effects combinators sets ; +FROM: namespaces => set ; IN: generic ! Method combination protocol diff --git a/core/generic/single/single-tests.factor b/core/generic/single/single-tests.factor index cee99a828e..6be03042cb 100644 --- a/core/generic/single/single-tests.factor +++ b/core/generic/single/single-tests.factor @@ -5,6 +5,7 @@ quotations stack-checker vectors growable hashtables sbufs prettyprint byte-vectors bit-vectors specialized-vectors definitions generic sets graphs assocs grouping see eval ; QUALIFIED-WITH: alien.c-types c +FROM: namespaces => set ; SPECIALIZED-VECTOR: c:double IN: generic.single.tests diff --git a/core/hash-sets/hash-sets-docs.factor b/core/hash-sets/hash-sets-docs.factor new file mode 100644 index 0000000000..e771442932 --- /dev/null +++ b/core/hash-sets/hash-sets-docs.factor @@ -0,0 +1,18 @@ +USING: help.markup help.syntax sequences ; +IN: hash-sets + +ARTICLE: "hash-sets" "Hash sets" +"The " { $vocab-link "hash-sets" } " vocabulary implements hashtable-backed sets. These are of the class:" +{ $subsection hash-set } +"They can be instantiated with the word" +{ $subsection } +"The syntax for hash sets is described in " { $link "syntax-hash-sets" } "." ; + +ABOUT: "hash-sets" + +HELP: hash-set +{ $class-description "The class of hashtable-based sets. These implement the " { $link "sets" } "." } ; + +HELP: +{ $values { "members" sequence } { "hash-set" hash-set } } +{ $description "Creates a new hash set with the given members." } ; diff --git a/core/hash-sets/hash-sets-tests.factor b/core/hash-sets/hash-sets-tests.factor new file mode 100644 index 0000000000..5b7ffafc8b --- /dev/null +++ b/core/hash-sets/hash-sets-tests.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2010 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: 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 diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor new file mode 100644 index 0000000000..bdef9a6ff9 --- /dev/null +++ b/core/hash-sets/hash-sets.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2010 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs hashtables kernel sets +sequences parser ; +QUALIFIED: sets +IN: hash-sets + +! In a better implementation, less memory would be used +TUPLE: hash-set { table hashtable read-only } ; + +: ( 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 ] unless ; +M: hash-set clone + table>> clone hash-set boa ; + +M: sequence fast-set ; +M: f fast-set drop H{ } clone hash-set boa ; + +M: sequence duplicates + HS{ } clone [ [ in? ] [ adjoin ] 2bi ] curry filter ; diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index d9b1271152..ac296f949c 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -1,42 +1,71 @@ USING: assocs hashtables help.markup help.syntax kernel -quotations sequences ; +quotations sequences vectors ; IN: sets -ARTICLE: "sets" "Set-theoretic operations on sequences" -"Set-theoretic operations on sequences are defined on the " { $vocab-link "sets" } " vocabulary. All of these operations use hashtables internally to achieve linear running time." -$nl -"Remove duplicates:" -{ $subsections prune } -"Test for duplicates:" +ARTICLE: "sets" "Sets" +"A set is an unordered list of elements. Words for working with sets are in the " { $vocab-link "sets" } " vocabulary." +"All sets are instances of a mixin class:" { $subsections - all-unique? - duplicates + set + set? } -"Set operations on sequences:" +{ $subsections "set-operations" "set-implementations" } ; + +ABOUT: "sets" + +ARTICLE: "set-operations" "Operations on sets" +"To test if an object is a member of a set:" +{ $subsection member? } +"All sets can be represented as a sequence, without duplicates, of their members:" +{ $subsection members } +"Sets can have members added or removed destructively:" +{ $subsections + adjoin + delete +} +"Basic mathematical operations, which any type of set may override for efficiency:" { $subsections diff intersect union } -"Set-theoretic predicates:" +"Mathematical predicates on sets, which may be overridden for efficiency:" { $subsections intersects? subset? set= } -"A word used to implement the above:" -{ $subsections unique } -"Adding elements to sets:" +"An optional generic word for creating sets of the same class as a given set:" +{ $subsection set-like } +"An optional generic word for creating a set with a fast lookup operation, if the set itself has a slow lookup operation:" +{ $subsection fast-set } +"For set types that allow duplicates, like sequence sets, some additional words test for duplication:" { $subsections - adjoin -} -{ $see-also member? member-eq? any? all? "assocs-sets" } ; + all-unique? + duplicates +} ; -ABOUT: "sets" +ARTICLE: "set-implementations" "Set implementations" +"There are several implementations of sets in the Factor library. More can be added if they implement the words of the set protocol, the basic set operations." +{ $subsections + "sequence-sets" + "hash-sets" + "bit-sets" +} ; + +ARTICLE: "sequence-sets" "Sequences as sets" +"Any sequence can be used as a set. The members of this set are the elements of the sequence. Calling the word " { $link members } " on a sequence returns a copy of the sequence with only one listing of each member. Destructive operations " { $link adjoin } " and " { $link delete } " only work properly on growable sequences like " { $link vector } "s." +$nl +"Care must be taken in writing efficient code using sequence sets. Testing for membership with " { $link in? } ", as well as the destructive set operations, take time proportional to the size of the sequence. Another representation, like " { $link "hash-sets" } ", would take constant time for membership tests. But binary operations like " { $link union } "are asymptotically optimal, taking time proportional to the sum of the size of the inputs." +$nl +"As one particlar example, " { $link POSTPONE: f } " is a representation of the empty set, as it represents the empty sequence." ; + +HELP: set +{ $class-description "The class of all sets. Custom implementations of the set protocol should be declared as instances of this mixin for all set implementation to work correctly." } ; HELP: adjoin -{ $values { "elt" object } { "seq" "a resizable mutable sequence" } } -{ $description "Removes all elements equal to " { $snippet "elt" } ", and adds " { $snippet "elt" } " at the end of the sequence." } +{ $values { "elt" object } { "set" set } } +{ $description "Destructively adds " { $snippet "elt" } " to " { $snippet "set" } ". For sequences, this guarantees that this element is not duplicated, and that it is at the end of the sequence." $nl "Each mutable set type is expected to implement a method on this generic word." } { $examples { $example "USING: namespaces prettyprint sets ;" @@ -47,48 +76,36 @@ HELP: adjoin "V{ \"beans\" \"cheese\" \"nachos\" \"salsa\" }" } } -{ $side-effects "seq" } ; +{ $side-effects "set" } ; -HELP: conjoin -{ $values { "elt" object } { "assoc" assoc } } -{ $description "Stores a key/value pair, both equal to " { $snippet "elt" } ", into the assoc." } -{ $examples - { $example - "USING: kernel prettyprint sets ;" - "H{ } clone 1 over conjoin ." - "H{ { 1 1 } }" - } -} +HELP: delete +{ $values { "elt" object } { "set" set } } +{ $description "Destructively removes " { $snippet "elt" } " from " { $snippet "set" } ". If the element is not present, this does nothing." $nl "Each mutable set type is expected to implement a method on this generic word." } +{ $side-effects "set" } ; + +HELP: members +{ $values { "set" set } { "seq" sequence } } +{ $description "Creates a sequence with a single copy of each member of the set." $nl "Each set type is expected to implement a method on this generic word." } ; + +HELP: in? +{ $values { "elt" object } { "set" set } { "?" "a boolean" } } +{ $description "Tests whether the element is a member of the set." $nl "Each set type is expected to implement a method on this generic word as part of the set protocol." } ; + +HELP: adjoin-at +{ $values { "value" object } { "key" object } { "assoc" assoc } } +{ $description "Adds " { $snippet "value" } " to the set stored at " { $snippet "key" } " of " { $snippet "assoc" } "." } { $side-effects "assoc" } ; -HELP: conjoin-at -{ $values { "value" object } { "key" object } { "assoc" assoc } } -{ $description "Adds " { $snippet "value" } " to the set stored at " { $snippet "key" } " of " { $snippet "assoc" } "." } ; - -HELP: unique -{ $values { "seq" "a sequence" } { "assoc" assoc } } -{ $description "Outputs a new assoc where the keys and values are equal." } -{ $examples - { $example "USING: sets prettyprint ;" "{ 1 1 2 2 3 3 } unique ." "H{ { 1 1 } { 2 2 } { 3 3 } }" } -} ; - -HELP: prune -{ $values { "seq" "a sequence" } { "newseq" "a sequence" } } -{ $description "Outputs a new sequence with each distinct element of " { $snippet "seq" } " appearing only once. Elements are compared for equality using " { $link = } " and elements are ordered according to their position in " { $snippet "seq" } "." } -{ $examples - { $example "USING: sets prettyprint ;" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" } -} ; - HELP: duplicates -{ $values { "seq" "a sequence" } { "newseq" "a sequence" } } -{ $description "Outputs a new sequence consisting of elements which occur more than once in " { $snippet "seq" } "." } +{ $values { "set" set } { "seq" sequence } } +{ $description "Outputs a sequence consisting of elements which occur more than once in " { $snippet "set" } "." } { $examples - { $example "USING: sets prettyprint ;" "{ 1 2 3 1 2 1 } duplicates ." "{ 1 2 1 }" } + { $example "USING: sets prettyprint ;" "{ 1 2 3 1 2 1 } duplicates ." "{ 2 1 2 1 }" } } ; HELP: all-unique? -{ $values { "seq" sequence } { "?" "a boolean" } } -{ $description "Tests whether a sequence contains any repeated elements." } +{ $values { "set" set } { "?" "a boolean" } } +{ $description "Tests whether a set contains any repeated elements." } { $example "USING: sets prettyprint ;" "{ 0 1 1 2 3 5 } all-unique? ." @@ -96,41 +113,44 @@ HELP: all-unique? } ; HELP: diff -{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } } -{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq1" } " but not " { $snippet "seq2" } ", comparing elements for equality." +{ $values { "set1" set } { "set2" set } { "set" set } } +{ $description "Outputs a set consisting of elements present in " { $snippet "set1" } " but not " { $snippet "set2" } ", comparing elements for equality." +"This word has a default definition which works for all sets, but set implementations may override the default for efficiency." } { $examples { $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 1 }" } } ; HELP: intersect -{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } } -{ $description "Outputs a sequence consisting of elements present in both " { $snippet "seq1" } " and " { $snippet "seq2" } "." } +{ $values { "set1" set } { "set2" set } { "set" set } } +{ $description "Outputs a set consisting of elements present in both " { $snippet "set1" } " and " { $snippet "set2" } "." +"This word has a default definition which works for all sets, but set implementations may override the default for efficiency." } { $examples { $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } intersect ." "{ 2 3 }" } } ; HELP: union -{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } } -{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq1" } " and " { $snippet "seq2" } " which does not contain duplicate values." } +{ $values { "set1" set } { "set2" set } { "set" set } } +{ $description "Outputs a set consisting of elements present in either " { $snippet "set1" } " or " { $snippet "set2" } " which does not contain duplicate values." +"This word has a default definition which works for all sets, but set implementations may override the default for efficiency." } { $examples - { $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } union ." "V{ 1 2 3 4 }" } + { $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } union ." "{ 1 2 3 4 }" } } ; { diff intersect union } related-words HELP: intersects? -{ $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } } -{ $description "Tests if " { $snippet "seq1" } " and " { $snippet "seq2" } " have any elements in common." } -{ $notes "If one of the sequences is empty, the result is always " { $link f } "." } ; +{ $values { "set1" set } { "set2" set } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "set1" } " and " { $snippet "set2" } " have any elements in common." } +{ $notes "If one of the sets is empty, the result is always " { $link f } "." } ; HELP: subset? -{ $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } } -{ $description "Tests if every element of " { $snippet "seq1" } " is contained in " { $snippet "seq2" } "." } -{ $notes "If " { $snippet "seq1" } " is empty, the result is always " { $link t } "." } ; +{ $values { "set1" set } { "set2" set } { "?" "a boolean" } } +{ $description "Tests if every element of " { $snippet "set1" } " is contained in " { $snippet "set2" } "." } +{ $notes "If " { $snippet "set1" } " is empty, the result is always " { $link t } "." } ; HELP: set= -{ $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } } -{ $description "Tests if both sequences contain the same elements, disregrading order and duplicates." } ; +{ $values { "set1" set } { "set2" set } { "?" "a boolean" } } +{ $description "Tests if both sets contain the same elements, disregrading order and duplicates." } ; HELP: gather { $values @@ -138,3 +158,10 @@ HELP: gather { "newseq" sequence } } { $description "Maps a quotation onto a sequence, concatenates the results of the mapping, and removes duplicates." } ; +HELP: set-like +{ $values { "set" set } { "exemplar" set } { "set'" set } } +{ $description "If the conversion is defined for the exemplar, converts the set into a set of the exemplar's class. This is not guaranteed to create a new set, for example if the input set and exemplar are of the same class." $nl +"Set implementations may optionally implement a method on this generic word. The default implementation returns its input set." } +{ $examples + { $example "USING: sets prettyprint ;" "{ 1 2 3 } HS{ } set-like ." "HS{ 1 2 3 }" } +} ; diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor index f9f8ba9e65..aa76a4f02e 100644 --- a/core/sets/sets-tests.factor +++ b/core/sets/sets-tests.factor @@ -1,26 +1,16 @@ -USING: kernel sets tools.test ; +! Copyright (C) 2010 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sets tools.test kernel prettyprint hash-sets sorting ; IN: sets.tests -[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test -[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test - -[ V{ 1 2 3 } ] [ { 1 2 2 3 3 } prune ] unit-test -[ V{ 3 2 1 } ] [ { 3 3 2 2 1 } prune ] unit-test - [ { } ] [ { } { } 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 -[ V{ } ] [ { } { } union ] unit-test -[ V{ 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test - -[ V{ 1 2 3 } ] -[ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test - -[ V{ 1 2 3 } ] -[ 3 V{ 1 3 2 } clone [ adjoin ] keep ] 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 @@ -30,3 +20,34 @@ IN: sets.tests [ 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 + +[ 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 + +[ { 2 1 2 1 } ] [ { 1 2 3 2 1 2 1 } duplicates ] unit-test +[ f ] [ HS{ 1 2 3 1 2 1 } duplicates ] unit-test + +[ H{ { 3 HS{ 1 2 } } } ] [ H{ } clone 1 3 pick adjoin-at 2 3 pick adjoin-at ] unit-test diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 38c1f73bb3..5274c07d37 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -1,59 +1,113 @@ -! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. +! Copyright (C) 2010 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: assocs hashtables kernel sequences vectors ; +USING: accessors assocs hashtables kernel vectors +math sequences ; IN: sets -: adjoin ( elt seq -- ) [ remove! drop ] [ push ] 2bi ; +! 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 -- ? ) +GENERIC: duplicates ( set -- seq ) +GENERIC: all-unique? ( set -- ? ) -: conjoin ( elt assoc -- ) dupd set-at ; +! Defaults for some methods. +! Override them for efficiency -: conjoin-at ( value key assoc -- ) - [ dupd ?set-at ] change-at ; +M: set set-like drop ; inline -: (prune) ( elt hash vec -- ) - 3dup drop key? [ 3drop ] [ - [ drop conjoin ] [ nip push ] 3bi - ] if ; inline - -: prune ( seq -- newseq ) - [ ] [ length ] [ length ] tri - [ [ (prune) ] 2curry each ] keep ; - -: duplicates ( seq -- newseq ) - H{ } clone [ [ key? ] [ conjoin ] 2bi ] curry filter ; - -: gather ( seq quot -- newseq ) - map concat prune ; inline - -: unique ( seq -- assoc ) - [ dup ] H{ } map>assoc ; - -: (all-unique?) ( elt hash -- ? ) - 2dup key? [ 2drop f ] [ conjoin t ] if ; - -: all-unique? ( seq -- ? ) - dup length [ (all-unique?) ] curry all? ; +M: set union + [ [ members ] bi@ append ] keep set-like ; -: intersect ( seq1 seq2 -- newseq ) - tester filter ; +M: set intersect + [ sequence/tester filter ] keep set-like ; -: intersects? ( seq1 seq2 -- ? ) - tester any? ; +M: set diff + [ sequence/tester [ not ] compose filter ] keep set-like ; -: diff ( seq1 seq2 -- newseq ) - tester [ not ] compose filter ; +M: set intersects? + sequence/tester any? ; -: union ( seq1 seq2 -- newseq ) - append prune ; +M: set subset? + sequence/tester all? ; + +M: set set= + 2dup subset? [ swap subset? ] [ 2drop f ] if ; -: subset? ( seq1 seq2 -- ? ) - tester all? ; +M: set fast-set ; -: set= ( seq1 seq2 -- ? ) - [ unique ] bi@ = ; +M: set duplicates drop f ; + +M: set all-unique? drop t ; + + ] bi + [ [ (pruned) ] 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 + [ members ] dip like ; + +M: sequence members + [ pruned ] keep like ; + +M: sequence all-unique? + dup pruned sequence= ; + +: combine ( sets -- set ) + f [ union ] reduce ; + +: gather ( seq quot -- newseq ) + map concat members ; inline + +: adjoin-at ( value key assoc -- ) + [ [ f fast-set ] unless* [ adjoin ] keep ] change-at ; + +! Temporarily for compatibility + +: unique ( seq -- assoc ) + [ dup ] H{ } map>assoc ; +: conjoin ( elt assoc -- ) + dupd set-at ; +: conjoin-at ( value key assoc -- ) + [ dupd ?set-at ] change-at ; diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 4a1af4c578..035ac1454b 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -189,6 +189,10 @@ ARTICLE: "syntax-hashtables" "Hashtable syntax" { $subsections POSTPONE: H{ } "Hashtables are documented in " { $link "hashtables" } "." ; +ARTICLE: "syntax-hash-sets" "Hash set syntax" +{ $subsections POSTPONE: HS{ } +"Hashtables are documented in " { $link "hash-sets" } "." ; + ARTICLE: "syntax-tuples" "Tuple syntax" { $subsections POSTPONE: T{ } "Tuples are documented in " { $link "tuples" } "." ; @@ -229,6 +233,7 @@ $nl "syntax-vectors" "syntax-sbufs" "syntax-hashtables" + "syntax-hash-sets" "syntax-tuples" "syntax-pathnames" "syntax-effects" @@ -330,7 +335,7 @@ HELP: } $nl "Parsing words can use this word as a generic end delimiter." } ; -{ POSTPONE: { POSTPONE: V{ POSTPONE: H{ POSTPONE: C{ POSTPONE: T{ POSTPONE: W{ POSTPONE: } } related-words +{ POSTPONE: { POSTPONE: V{ POSTPONE: H{ POSTPONE: HS{ POSTPONE: C{ POSTPONE: T{ POSTPONE: W{ POSTPONE: } } related-words HELP: { { $syntax "{ elements... }" } @@ -356,6 +361,12 @@ HELP: H{ { $description "Marks the beginning of a literal hashtable, given as a list of two-element arrays holding key/value pairs. Literal hashtables are terminated by " { $link POSTPONE: } } "." } { $examples { $code "H{ { \"tuna\" \"fish\" } { \"jalapeno\" \"vegetable\" } }" } } ; +HELP: HS{ +{ $syntax "HS{ members ... }" } +{ $values { "members" "a list of objects" } } +{ $description "Marks the beginning of a literal hash set, given as a list of its members. Literal hashtables are terminated by " { $link POSTPONE: } } "." } +{ $examples { $code "HS{ 3 \"foo\" }" } } ; + HELP: C{ { $syntax "C{ real-part imaginary-part }" } { $values { "real-part" "a real number" } { "imaginary-part" "a real number" } } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 6c35a3c5c6..84a753fb1b 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -8,7 +8,7 @@ generic.standard generic.hook generic.math generic.parser classes 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 @@ -104,6 +104,7 @@ IN: bootstrap.syntax "H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax "T{" [ parse-tuple-literal suffix! ] define-core-syntax "W{" [ \ } [ first ] parse-literal ] define-core-syntax + "HS{" [ \ } [ ] parse-literal ] define-core-syntax "POSTPONE:" [ scan-word suffix! ] define-core-syntax "\\" [ scan-word suffix! ] define-core-syntax diff --git a/extra/contributors/contributors.factor b/extra/contributors/contributors.factor index 97f4edc521..1ca62beef3 100644 --- a/extra/contributors/contributors.factor +++ b/extra/contributors/contributors.factor @@ -11,7 +11,7 @@ IN: contributors ] with-directory ; : patch-counts ( authors -- assoc ) - dup prune + dup members [ dup rot [ = ] with count ] with { } map>assoc ; diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor index 39ba3bd2b3..649081ff03 100644 --- a/extra/fuel/xref/xref.factor +++ b/extra/fuel/xref/xref.factor @@ -29,7 +29,7 @@ IN: fuel.xref [ word? ] filter [ word>xref ] map ; : filter-prefix ( seq prefix -- seq ) - [ drop-prefix nip length 0 = ] curry filter prune ; + [ drop-prefix nip length 0 = ] curry filter members ; MEMO: (vocab-words) ( name -- seq ) >vocab-link words [ name>> ] map ; @@ -40,7 +40,7 @@ MEMO: (vocab-words) ( name -- seq ) append H{ } [ assoc-union ] reduce keys ; : vocabs-words ( names -- seq ) - prune [ (vocab-words) ] map concat ; + members [ (vocab-words) ] map concat ; PRIVATE> diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 2d0b9514ff..760fd1e47b 100644 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -145,7 +145,7 @@ TUPLE: link attributes clickable ; [ >url ] map ; : find-all-links ( vector -- vector' ) - [ find-hrefs ] [ find-frame-links ] bi append prune ; + [ find-hrefs ] [ find-frame-links ] bi union ; : find-forms ( vector -- vector' ) "form" over find-opening-tags-by-name diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index c35ba6ac8c..58c90df6e9 100644 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -4,6 +4,7 @@ USING: accessors arrays hashtables assocs io kernel locals math math.vectors math.matrices math.matrices.elimination namespaces parser prettyprint sequences words combinators math.parser splitting sorting shuffle sets math.order ; +FROM: namespaces => set ; IN: koszul ! Utilities @@ -78,11 +79,8 @@ SYMBOL: terms [ nth ] 2keep swap 1 + tail-slice (inversions) + ] curry each ; -: duplicates? ( seq -- ? ) - dup prune [ length ] bi@ > ; - : (wedge) ( n basis1 basis2 -- n basis ) - append dup duplicates? [ + append dup all-unique? not [ 2drop 0 { } ] [ dup permutation inversions -1^ rot * diff --git a/extra/managed-server/chat/chat.factor b/extra/managed-server/chat/chat.factor index e75a2803e6..ecf36bcfbb 100644 --- a/extra/managed-server/chat/chat.factor +++ b/extra/managed-server/chat/chat.factor @@ -5,6 +5,7 @@ destructors fry io io.encodings.utf8 kernel managed-server namespaces parser sequences sorting splitting strings.parser unicode.case unicode.categories calendar calendar.format locals io.encodings.binary io.encodings.string prettyprint ; +FROM: namespaces => set ; IN: managed-server.chat TUPLE: chat-server < managed-server ; diff --git a/extra/managed-server/managed-server.factor b/extra/managed-server/managed-server.factor index 6f9bdf25f1..acb3c84825 100644 --- a/extra/managed-server/managed-server.factor +++ b/extra/managed-server/managed-server.factor @@ -5,6 +5,7 @@ io.encodings.binary io.servers.connection io.sockets io.streams.duplex fry kernel locals math math.ranges multiline namespaces prettyprint random sequences sets splitting threads tools.continuations ; +FROM: namespaces => set ; IN: managed-server TUPLE: managed-server < threaded-server clients ; diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor index 2421a288ee..fba3ed58c4 100644 --- a/extra/mason/test/test.factor +++ b/extra/mason/test/test.factor @@ -24,7 +24,7 @@ M: method word-vocabulary "method-generic" word-prop word-vocabulary ; :: do-step ( errors summary-file details-file -- ) errors [ error-type +linkage-error+ eq? not ] filter - [ file>> ] map prune natural-sort summary-file to-file + [ file>> ] map members natural-sort summary-file to-file errors details-file utf8 [ errors. ] with-file-writer ; : do-tests ( -- ) @@ -62,7 +62,7 @@ M: method word-vocabulary "method-generic" word-prop word-vocabulary ; "" to-refresh drop 2dup [ empty? not ] either? [ "Boot image is out of date. Changed vocabs:" print - append prune [ print ] each + members [ print ] each flush 1 exit ] [ 2drop ] if ; diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index caf37dbadb..a65e459a7c 100644 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -6,6 +6,7 @@ definitions prettyprint prettyprint.backend prettyprint.custom quotations generalizations debugger io compiler.units kernel.private effects accessors hashtables sorting shuffle math.order sets see effects.parser ; +FROM: namespaces => set ; IN: multi-methods ! PART I: Converting hook specializers diff --git a/extra/project-euler/004/004.factor b/extra/project-euler/004/004.factor index 1bb9ebbef5..342e8d1a9e 100644 --- a/extra/project-euler/004/004.factor +++ b/extra/project-euler/004/004.factor @@ -29,7 +29,7 @@ IN: project-euler.004 PRIVATE> : euler004 ( -- answer ) - source-004 dup [ * ] cartesian-map concat prune max-palindrome ; + source-004 dup [ * ] cartesian-map combine max-palindrome ; ! [ euler004 ] 100 ave-time ! 1164 ms ave run time - 39.35 SD (100 trials) diff --git a/extra/project-euler/029/029.factor b/extra/project-euler/029/029.factor index 31be1a566b..944d345938 100644 --- a/extra/project-euler/029/029.factor +++ b/extra/project-euler/029/029.factor @@ -29,7 +29,7 @@ IN: project-euler.029 ! -------- : euler029 ( -- answer ) - 2 100 [a,b] dup [ ^ ] cartesian-map concat prune length ; + 2 100 [a,b] dup [ ^ ] cartesian-map concat members length ; ! [ euler029 ] 100 ave-time ! 704 ms ave run time - 28.07 SD (100 trials) diff --git a/extra/project-euler/032/032.factor b/extra/project-euler/032/032.factor index 7def55b659..de0cb72609 100644 --- a/extra/project-euler/032/032.factor +++ b/extra/project-euler/032/032.factor @@ -48,7 +48,7 @@ IN: project-euler.032 PRIVATE> : euler032 ( -- answer ) - source-032 [ valid? ] filter products prune sum ; + source-032 [ valid? ] filter products members sum ; ! [ euler032 ] 10 ave-time ! 16361 ms ave run time - 417.8 SD (10 trials) @@ -72,7 +72,7 @@ PRIVATE> 50 [1,b] 2000 [1,b] [ mmp ] cartesian-map concat [ pandigital? ] filter - products prune sum ; + products members sum ; ! [ euler032a ] 10 ave-time ! 2624 ms ave run time - 131.91 SD (10 trials) diff --git a/extra/project-euler/051/051.factor b/extra/project-euler/051/051.factor index ff45e9e58a..f0bdd69901 100644 --- a/extra/project-euler/051/051.factor +++ b/extra/project-euler/051/051.factor @@ -29,6 +29,7 @@ USING: assocs kernel math math.combinatorics math.functions math.parser math.primes namespaces project-euler.common sequences sets strings grouping math.ranges arrays fry math.order ; +FROM: namespaces => set ; IN: project-euler.051 swap [ bitxor ] 2map ; : frequency-analysis ( seq -- seq ) - dup prune [ + dup members [ [ 2dup [ = ] curry count 2array , ] each ] { } make nip ; inline diff --git a/extra/project-euler/079/079.factor b/extra/project-euler/079/079.factor index 3ad7406703..e0a616dc52 100644 --- a/extra/project-euler/079/079.factor +++ b/extra/project-euler/079/079.factor @@ -35,7 +35,7 @@ IN: project-euler.079 ] { } make ; : find-source ( seq -- elt ) - unzip diff prune + unzip diff [ "Topological sort failed" throw ] [ first ] if-empty ; : remove-source ( seq elt -- seq ) @@ -52,7 +52,7 @@ PRIVATE> : topological-sort ( seq -- seq ) [ [ (topological-sort) ] { } make ] keep - concat prune over diff append ; + combine over diff append ; : euler079 ( -- answer ) source-079 >edges topological-sort 10 digits>integer ; @@ -60,7 +60,7 @@ PRIVATE> ! [ euler079 ] 100 ave-time ! 1 ms ave run time - 0.46 SD (100 trials) -! TODO: prune and diff are relatively slow; topological sort could be +! TODO: set words on sequences are relatively slow; topological sort could be ! cleaned up and generalized much better, but it works for this problem SOLUTION: euler079 diff --git a/extra/project-euler/203/203.factor b/extra/project-euler/203/203.factor index 806098b865..2077fe328e 100644 --- a/extra/project-euler/203/203.factor +++ b/extra/project-euler/203/203.factor @@ -45,7 +45,7 @@ IN: project-euler.203 [ 0 prefix ] [ 0 suffix ] bi [ + ] 2map ; : generate ( n -- seq ) - 1 - { 1 } [ (generate) ] iterate concat prune ; + 1 - { 1 } [ (generate) ] iterate combine ; : squarefree ( n -- ? ) factors all-unique? ; diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index c8ea4734d2..2a0b2946e5 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -48,7 +48,7 @@ fetched-in parsed-html links processed-in fetched-at ; nonmatching>> push-links ; : filter-base-links ( spider spider-result -- base-links nonmatching-links ) - [ base>> host>> ] [ links>> prune ] bi* + [ base>> host>> ] [ links>> members ] bi* [ host>> = ] with partition ; : add-spidered ( spider spider-result -- )