dlists: fix equality when custom dlist-link nodes are used.

db4
John Benediktsson 2012-07-13 16:56:28 -07:00
parent 20046a08a7
commit fd61f71956
2 changed files with 11 additions and 11 deletions

View File

@ -118,34 +118,34 @@ TUPLE: my-node < dlist-link { obj fixnum } ;
[ prev>> ] [ next>> ] bi 2array { f f } assert= ; [ prev>> ] [ next>> ] bi 2array { f f } assert= ;
[ V{ } ] [ <dlist> 1 <my-node> over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>sequence ] unit-test [ V{ } ] [ <dlist> 1 <my-node> over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>sequence ] unit-test
[ V{ 1 2 } ] [| | [ V{ 1 2 } t ] [| |
<dlist> :> dl <dlist> :> dl
1 <my-node> :> n1 n1 dl push-node-back 1 <my-node> :> n1 n1 dl push-node-back
2 <my-node> :> n2 n2 dl push-node-back 2 <my-node> :> n2 n2 dl push-node-back
3 <my-node> :> n3 n3 dl push-node-back 3 <my-node> :> n3 n3 dl push-node-back
n3 dl delete-node n3 assert-links n3 dl delete-node n3 assert-links
dl dlist>sequence dl dlist>sequence dup >dlist dl =
] unit-test ] unit-test
[ V{ 1 3 } ] [| | [ V{ 1 3 } t ] [| |
<dlist> :> dl <dlist> :> dl
1 <my-node> :> n1 n1 dl push-node-back 1 <my-node> :> n1 n1 dl push-node-back
2 <my-node> :> n2 n2 dl push-node-back 2 <my-node> :> n2 n2 dl push-node-back
3 <my-node> :> n3 n3 dl push-node-back 3 <my-node> :> n3 n3 dl push-node-back
n2 dl delete-node n2 assert-links n2 dl delete-node n2 assert-links
dl dlist>sequence dl dlist>sequence dup >dlist dl =
] unit-test ] unit-test
[ V{ 2 3 } ] [| | [ V{ 2 3 } t ] [| |
<dlist> :> dl <dlist> :> dl
1 <my-node> :> n1 n1 dl push-node-back 1 <my-node> :> n1 n1 dl push-node-back
2 <my-node> :> n2 n2 dl push-node-back 2 <my-node> :> n2 n2 dl push-node-back
3 <my-node> :> n3 n3 dl push-node-back 3 <my-node> :> n3 n3 dl push-node-back
n1 dl delete-node n1 assert-links n1 dl delete-node n1 assert-links
dl dlist>sequence dl dlist>sequence dup >dlist dl =
] unit-test ] unit-test

View File

@ -12,6 +12,8 @@ TUPLE: dlist-node < dlist-link obj ;
M: dlist-link obj>> ; M: dlist-link obj>> ;
M: dlist-link node-value obj>> ;
: new-dlist-link ( obj prev next class -- node ) : new-dlist-link ( obj prev next class -- node )
new new
swap >>next swap >>next
@ -33,14 +35,12 @@ TUPLE: dlist
M: dlist deque-empty? front>> not ; inline M: dlist deque-empty? front>> not ; inline
M: dlist-node node-value obj>> ;
<PRIVATE <PRIVATE
: dlist-nodes= ( dlist-node/f dlist-node/f -- ? ) : dlist-nodes= ( dlist-node/f dlist-node/f -- ? )
{ {
[ [ dlist-node? ] both? ] [ [ dlist-link? ] both? ]
[ [ obj>> ] bi@ = ] [ [ obj>> ] bi@ = ]
} 2&& ; inline } 2&& ; inline
PRIVATE> PRIVATE>
@ -49,7 +49,7 @@ M: dlist equal?
over dlist? [ over dlist? [
[ front>> ] bi@ [ front>> ] bi@
[ 2dup dlist-nodes= ] [ 2dup dlist-nodes= ]
[ [ next>> ] bi@ ] while [ [ next>> ] bi@ ] while
or not or not
] [ ] [
2drop f 2drop f