compiler: more use of ?adjoin.

db4
John Benediktsson 2013-03-23 17:46:45 -07:00
parent c46b69f329
commit 93fb7805b0
4 changed files with 11 additions and 15 deletions

View File

@ -59,11 +59,9 @@ GENERIC: compute-live-vregs ( insn -- )
: (record-live) ( vregs -- ) : (record-live) ( vregs -- )
[ [
dup live-vreg? [ drop ] [ dup live-vregs get ?adjoin [
[ live-vregs get adjoin ] liveness-graph get at (record-live)
[ liveness-graph get at (record-live) ] ] [ drop ] if
bi
] if
] each ; ] each ;
: record-live ( insn -- ) : record-live ( insn -- )

View File

@ -6,13 +6,12 @@ FROM: namespaces => set ;
IN: compiler.cfg.rpo IN: compiler.cfg.rpo
: post-order-traversal ( visited bb -- visited ) : post-order-traversal ( visited bb -- visited )
dup pick in? [ drop ] [ dup pick ?adjoin [
dup pick adjoin
[ [
successors>> <reversed> successors>> <reversed>
[ post-order-traversal ] each [ post-order-traversal ] each
] [ , ] bi ] [ , ] bi
] if ; inline recursive ] [ drop ] if ; inline recursive
: number-blocks ( blocks -- ) : number-blocks ( blocks -- )
dup length iota <reversed> dup length iota <reversed>

View File

@ -87,9 +87,9 @@ SYMBOLS: stacks pushed ;
: gen-name ( vreg -- vreg' ) : gen-name ( vreg -- vreg' )
[ next-vreg dup ] dip [ next-vreg dup ] dip
dup pushed get 2dup in? dup pushed get ?adjoin
[ 2drop stacks get at set-last ] [ stacks get push-at ]
[ adjoin stacks get push-at ] [ stacks get at set-last ]
if ; if ;
: (top-name) ( vreg -- vreg' ) : (top-name) ( vreg -- vreg' )

View File

@ -19,12 +19,11 @@ IN: compiler.cfg.utilities
} 1&& ; } 1&& ;
: (skip-empty-blocks) ( visited bb -- visited bb' ) : (skip-empty-blocks) ( visited bb -- visited bb' )
dup pick in? [
dup empty-block? [ dup empty-block? [
dup pick adjoin dup pick ?adjoin [
successors>> first (skip-empty-blocks) successors>> first (skip-empty-blocks)
] when ] when
] unless ; inline recursive ] when ; inline recursive
: skip-empty-blocks ( bb -- bb' ) : skip-empty-blocks ( bb -- bb' )
[ HS{ } clone ] dip (skip-empty-blocks) nip ; [ HS{ } clone ] dip (skip-empty-blocks) nip ;