From 04878057aff1288f8b7347964c657d5ddadaa571 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 16 Feb 2010 15:48:07 -0600 Subject: [PATCH] Compiler.cfg.{dce,linearization} use new-sets --- basis/bit-sets/bit-sets-tests.factor | 3 ++ basis/bit-sets/bit-sets.factor | 3 ++ basis/compiler/cfg/dce/dce.factor | 19 +++++----- .../cfg/linearization/order/order.factor | 16 ++++---- basis/new-sets/new-sets-tests.factor | 31 +--------------- basis/new-sets/new-sets.factor | 37 ++++--------------- 6 files changed, 33 insertions(+), 76 deletions(-) diff --git a/basis/bit-sets/bit-sets-tests.factor b/basis/bit-sets/bit-sets-tests.factor index c4260915ac..26010a3337 100644 --- a/basis/bit-sets/bit-sets-tests.factor +++ b/basis/bit-sets/bit-sets-tests.factor @@ -58,3 +58,6 @@ IN: bit-sets.tests [ 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 d6c9a48bed..a3cac64295 100644 --- a/basis/bit-sets/bit-sets.factor +++ b/basis/bit-sets/bit-sets.factor @@ -69,3 +69,6 @@ M: bit-set set-like [ members ] dip table>> length [ [ adjoin ] curry each ] keep ] if ; + +M: bit-set clone + table>> clone bit-set boa ; diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor index 03a43d0ab7..c8010d9aa8 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 new-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/linearization/order/order.factor b/basis/compiler/cfg/linearization/order/order.factor index 1fcc137c60..f48816d1b9 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 +new-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/new-sets/new-sets-tests.factor b/basis/new-sets/new-sets-tests.factor index a03ab9f18e..12da3a7515 100644 --- a/basis/new-sets/new-sets-tests.factor +++ b/basis/new-sets/new-sets-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: new-sets tools.test kernel sorting prettyprint bit-arrays arrays ; +USING: new-sets tools.test kernel prettyprint hash-sets sorting ; IN: new-sets.tests [ { } ] [ { } { } intersect ] unit-test @@ -38,32 +38,3 @@ IN: new-sets.tests [ { 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 } ] [ 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/basis/new-sets/new-sets.factor b/basis/new-sets/new-sets.factor index 770368ae3b..5f42dc40af 100644 --- a/basis/new-sets/new-sets.factor +++ b/basis/new-sets/new-sets.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs hashtables kernel math sequences parser prettyprint.custom ; -QUALIFIED: sets +FROM: sets => prune ; IN: new-sets ! The vocab is called new-sets for now, but only until it gets into core ! All the code here is in the style that could be put in core @@ -52,37 +52,14 @@ M: set set= M: set fast-set ; -! Hash sets -! In a better implementation, less memory would be used -TUPLE: hash-set { table hashtable read-only } ; - -: ( members -- hash-set ) - sets:unique 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 ; - -SYNTAX: HS{ - \ } [ ] parse-literal ; - -M: hash-set pprint* pprint-object ; -M: hash-set pprint-delims drop \ HS{ \ } ; -M: hash-set >pprint-sequence members ; - ! Sequences are sets INSTANCE: sequence set M: sequence in? member? ; inline -M: sequence adjoin sets:adjoin ; inline +M: sequence adjoin [ delete ] [ push ] 2bi ; M: sequence delete remove! drop ; inline M: sequence set-like - [ dup sequence? [ sets:prune ] [ members ] if ] dip - like ; -M: sequence members ; -M: sequence fast-set ; + [ dup sequence? [ prune ] [ members ] if ] dip like ; +M: sequence members fast-set members ; + +USE: vocabs.loader +"hash-sets" require