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

heaps: cleanup some code, faster heap-compare.

db4
John Benediktsson 2014-05-21 08:56:30 -07:00
parent 4e04107e4f
commit feb4dcae9a
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/heaps/heaps.factor
View File

@ -64,14 +64,15 @@ M: heap heap-size ( heap -- n )
[ right ] dip data-nth ; inline [ right ] dip data-nth ; inline
: data-set-nth ( entry n heap -- ) : data-set-nth ( entry n heap -- )
[ [ >>index drop ] [ ] 2bi ] dip [ [ swap index<< ] 2keep ] dip
data>> set-nth-unsafe ; inline data>> set-nth-unsafe ; inline
: data-push ( entry heap -- n ) : data-push ( entry heap -- n )
dup heap-size [ dup heap-size [
swap 2dup data>> ensure 2drop data-set-nth swap
] [ [ data>> ensure 2drop ]
] bi ; inline [ data-set-nth ] 2bi
] keep ; inline
: data-first ( heap -- entry ) : data-first ( heap -- entry )
data>> first ; inline data>> first ; inline
@ -82,12 +83,12 @@ M: heap heap-size ( heap -- n )
GENERIC: heap-compare ( entry1 entry2 heap -- ? ) GENERIC: heap-compare ( entry1 entry2 heap -- ? )
: (heap-compare) ( entry1 entry2 heap -- <=> ) : entry<=> ( entry1 entry2 -- <=> )
drop [ key>> ] compare ; inline { entry entry } declare [ key>> ] compare ; inline
M: min-heap heap-compare (heap-compare) +gt+ eq? ; M: min-heap heap-compare drop entry<=> +gt+ eq? ;
M: max-heap heap-compare (heap-compare) +lt+ eq? ; M: max-heap heap-compare drop entry<=> +lt+ eq? ;
: heap-bounds-check? ( m heap -- ? ) : heap-bounds-check? ( m heap -- ? )
heap-size >= ; inline heap-size >= ; inline
@ -135,12 +136,13 @@ DEFER: down-heap
] if ; inline recursive ] if ; inline recursive
: down-heap ( m heap -- ) : down-heap ( m heap -- )
2dup left-bounds-check? [ 2drop ] [ (down-heap) ] if ; inline recursive 2dup left-bounds-check?
[ 2drop ] [ (down-heap) ] if ; inline recursive
PRIVATE> PRIVATE>
M: heap heap-push* ( value key heap -- entry ) M: heap heap-push* ( value key heap -- entry )
[ <entry> dup ] [ data-push ] [ ] tri up-heap ; [ <entry> dup ] [ data-push ] [ up-heap ] tri ;
: heap-push ( value key heap -- ) heap-push* drop ; : heap-push ( value key heap -- ) heap-push* drop ;
@ -163,22 +165,20 @@ M: bad-heap-delete summary
index>> { fixnum } declare ; inline index>> { fixnum } declare ; inline
M: heap heap-delete ( entry heap -- ) M: heap heap-delete ( entry heap -- )
[ entry>index ] [ ] bi [ entry>index ] keep
2dup heap-size 1 - = [ 2dup heap-size 1 - = [
nip data>> pop* nip data>> pop*
] [ ] [
[ nip data>> pop ] [ nip data>> pop ]
[ data-set-nth ] [ data-set-nth ]
[ ] 2tri [ down-heap ] 2tri
down-heap
] if ; ] if ;
M: heap heap-pop* ( heap -- ) M: heap heap-pop* ( heap -- )
[ data-first ] keep heap-delete ; [ data-first ] keep heap-delete ;
M: heap heap-pop ( heap -- value key ) M: heap heap-pop ( heap -- value key )
[ data-first ] keep [ data-first dup ] keep heap-delete >entry< ;
[ heap-delete ] [ drop ] 2bi >entry< ;
: heap-pop-all ( heap -- alist ) : heap-pop-all ( heap -- alist )
[ dup heap-empty? not ] [ dup heap-empty? not ]