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

Removing dependency of persistent heaps on multimethods

db4
Daniel Ehrenberg 2008-08-05 22:56:42 -07:00
parent a2c680484b
commit 3d2871ca61
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
extra/persistent-heaps/persistent-heaps.factor
View File

@ -1,4 +1,4 @@
USING: kernel accessors multi-methods locals combinators math arrays USING: kernel accessors locals combinators math arrays
assocs namespaces sequences ; assocs namespaces sequences ;
IN: persistent-heaps IN: persistent-heaps
! These are minheaps ! These are minheaps
@ -36,14 +36,15 @@ PRIVATE>
GENERIC: sift-down ( value prio left right -- heap ) GENERIC: sift-down ( value prio left right -- heap )
METHOD: sift-down { empty-heap empty-heap } <branch> ; : sift-singleton ( value prio left right -- heap )
METHOD: sift-down { singleton-heap empty-heap }
3dup drop prio>> <= [ <branch> ] [ 3dup drop prio>> <= [ <branch> ] [
drop -rot [ [ value>> ] [ prio>> ] bi ] 2dip drop -rot [ [ value>> ] [ prio>> ] bi ] 2dip
<singleton-heap> <persistent-heap> <branch> <singleton-heap> <persistent-heap> <branch>
] if ; ] if ;
M: empty-heap sift-down
over empty-heap? [ <branch> ] [ sift-singleton ] if ;
:: reroot-left ( value prio left right -- heap ) :: reroot-left ( value prio left right -- heap )
left value>> left prio>> left value>> left prio>>
value prio left left>> left right>> sift-down value prio left left>> left right>> sift-down
@ -54,7 +55,7 @@ METHOD: sift-down { singleton-heap empty-heap }
value prio right left>> right right>> sift-down value prio right left>> right right>> sift-down
<branch> ; <branch> ;
METHOD: sift-down { branch branch } M: branch sift-down
3dup [ prio>> <= ] both-with? [ <branch> ] [ 3dup [ prio>> <= ] both-with? [ <branch> ] [
2dup [ prio>> ] bi@ <= [ reroot-left ] [ reroot-right ] if 2dup [ prio>> ] bi@ <= [ reroot-left ] [ reroot-right ] if
] if ; ] if ;