steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Compiler.cfg.{dce,linearization} use new-sets

db4
Daniel Ehrenberg 2010-02-16 15:48:07 -06:00
parent 05df3b3fd0
commit 04878057af
6 changed files with 33 additions and 76 deletions

3
basis/bit-sets/bit-sets-tests.factor
View File

@ -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 <bit-set> dup clone 0 over adjoin ] unit-test

3
basis/bit-sets/bit-sets.factor
View File

@ -69,3 +69,6 @@ M: bit-set set-like
[ members ] dip table>> length <bit-set>
[ [ adjoin ] curry each ] keep
] if ;
M: bit-set clone
table>> clone bit-set boa ;

19
basis/compiler/cfg/dce/dce.factor
View File

@ -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

16
basis/compiler/cfg/linearization/order/order.factor
View File

@ -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 -- )
<dlist> 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 ;
] ?if ;

31
basis/new-sets/new-sets-tests.factor
View File

@ -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

37
basis/new-sets/new-sets.factor
View File

@ -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 } ;
: <hash-set> ( 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 <hash-set> ] unless ;
M: hash-set clone
table>> clone hash-set boa ;
SYNTAX: HS{
\ } [ <hash-set> ] 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 <hash-set> ;
[ dup sequence? [ prune ] [ members ] if ] dip like ;
M: sequence members fast-set members ;
USE: vocabs.loader
"hash-sets" require