dlists: make a dlist-link tuple so you can "be the node" by subclassing it. this allows you go put a type on the obj>> slot. ensure that dlist nodes are returned with prev/next pointers set to f so they can be reused. dlist-filter used to work destructively on the dlist, make a new dlist instead because the combinator relied on using prev/next of deleted nodes.
parent
5a2243d481
commit
9ae3b50a53
basis/dlists
|
@ -1,11 +1,11 @@
|
|||
USING: deques dlists dlists.private kernel tools.test random
|
||||
assocs sets sequences namespaces sorting debugger io prettyprint
|
||||
math accessors classes ;
|
||||
math accessors classes locals arrays ;
|
||||
IN: dlists.tests
|
||||
|
||||
[ t ] [ <dlist> deque-empty? ] unit-test
|
||||
|
||||
[ T{ dlist f T{ dlist-node f 1 f f } T{ dlist-node f 1 f f } } ]
|
||||
[ T{ dlist f T{ dlist-node f f f 1 } T{ dlist-node f f f 1 } } ]
|
||||
[ <dlist> 1 over push-front ] unit-test
|
||||
|
||||
! Make sure empty lists are empty
|
||||
|
@ -100,3 +100,52 @@ IN: dlists.tests
|
|||
[ f ] [ DL{ f } DL{ 1 } = ] unit-test
|
||||
[ f ] [ f DL{ } = ] unit-test
|
||||
[ f ] [ DL{ } f = ] unit-test
|
||||
|
||||
TUPLE: my-node < dlist-link { obj fixnum } ;
|
||||
|
||||
: <my-node> ( obj -- node )
|
||||
my-node new
|
||||
swap >>obj ; inline
|
||||
|
||||
[ V{ 1 } ] [ <dlist> 1 <my-node> over push-node-front dlist>seq ] unit-test
|
||||
[ V{ 2 1 } ] [ <dlist> 1 <my-node> over push-node-front 2 <my-node> over push-node-front dlist>seq ] unit-test
|
||||
|
||||
[ V{ 1 } ] [ <dlist> 1 <my-node> over push-node-back dlist>seq ] unit-test
|
||||
[ V{ 1 2 } ] [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back dlist>seq ] unit-test
|
||||
[ V{ 1 2 3 } ] [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back 3 <my-node> over push-node-back dlist>seq ] unit-test
|
||||
|
||||
: assert-links ( dlist-node -- )
|
||||
[ prev>> ] [ next>> ] bi 2array { f f } assert= ;
|
||||
|
||||
[ V{ } ] [ <dlist> 1 <my-node> over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>seq ] unit-test
|
||||
[ V{ 1 2 } ] [| |
|
||||
<dlist> :> dl
|
||||
1 <my-node> :> n1 n1 dl push-node-back
|
||||
2 <my-node> :> n2 n2 dl push-node-back
|
||||
3 <my-node> :> n3 n3 dl push-node-back
|
||||
|
||||
n3 dl delete-node n3 assert-links
|
||||
dl dlist>seq
|
||||
] unit-test
|
||||
|
||||
[ V{ 1 3 } ] [| |
|
||||
<dlist> :> dl
|
||||
1 <my-node> :> n1 n1 dl push-node-back
|
||||
2 <my-node> :> n2 n2 dl push-node-back
|
||||
3 <my-node> :> n3 n3 dl push-node-back
|
||||
|
||||
n2 dl delete-node n2 assert-links
|
||||
dl dlist>seq
|
||||
] unit-test
|
||||
|
||||
[ V{ 2 3 } ] [| |
|
||||
<dlist> :> dl
|
||||
1 <my-node> :> n1 n1 dl push-node-back
|
||||
2 <my-node> :> n2 n2 dl push-node-back
|
||||
3 <my-node> :> n3 n3 dl push-node-back
|
||||
|
||||
n1 dl delete-node n1 assert-links
|
||||
dl dlist>seq
|
||||
] unit-test
|
||||
|
||||
|
||||
|
|
|
@ -6,19 +6,26 @@ deques fry hashtables kernel parser search-deques sequences
|
|||
summary vocabs.loader ;
|
||||
IN: dlists
|
||||
|
||||
<PRIVATE
|
||||
|
||||
MIXIN: ?dlist-node
|
||||
|
||||
INSTANCE: f ?dlist-node
|
||||
|
||||
TUPLE: dlist-node obj { prev ?dlist-node } { next ?dlist-node } ;
|
||||
TUPLE: dlist-link { prev ?dlist-node } { next ?dlist-node } ;
|
||||
|
||||
INSTANCE: dlist-node ?dlist-node
|
||||
INSTANCE: dlist-link ?dlist-node
|
||||
|
||||
C: <dlist-node> dlist-node
|
||||
TUPLE: dlist-node < dlist-link obj ;
|
||||
|
||||
PRIVATE>
|
||||
M: dlist-link obj>> ;
|
||||
|
||||
: new-dlist-link ( obj prev next class -- node )
|
||||
new
|
||||
swap >>next
|
||||
swap >>prev
|
||||
swap >>obj ; inline
|
||||
|
||||
: <dlist-node> ( obj prev next -- node )
|
||||
\ dlist-node new-dlist-link ; inline
|
||||
|
||||
TUPLE: dlist
|
||||
{ front ?dlist-node }
|
||||
|
@ -63,6 +70,9 @@ M: dlist equal?
|
|||
: set-next-prev ( dlist-node -- )
|
||||
dup next>> set-prev-when ; inline
|
||||
|
||||
: set-prev-next ( dlist-node -- )
|
||||
dup prev>> set-next-when ;
|
||||
|
||||
: normalize-front ( dlist -- )
|
||||
dup back>> [ f >>front ] unless drop ; inline
|
||||
|
||||
|
@ -90,17 +100,27 @@ M: dlist equal?
|
|||
: dlist-each-node ( ... dlist quot: ( ... node -- ... ) -- ... )
|
||||
'[ @ f ] dlist-find-node drop ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: unlink-node ( dlist-node -- )
|
||||
dup prev>> over next>> set-prev-when
|
||||
dup next>> swap prev>> set-next-when ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: dlist push-front* ( obj dlist -- dlist-node )
|
||||
[ front>> f swap <dlist-node> dup dup set-next-prev ] keep
|
||||
[ front<< ] keep
|
||||
set-back-to-front ;
|
||||
|
||||
: push-node-front ( node dlist -- )
|
||||
[ front>> >>next drop ]
|
||||
[ front<< ]
|
||||
[ [ set-next-prev ] [ set-back-to-front ] bi* ] 2tri ;
|
||||
|
||||
: push-node-back ( node dlist -- )
|
||||
[ back>> >>prev drop ]
|
||||
[ back<< ]
|
||||
[ [ set-prev-next ] [ set-front-to-back ] bi* ] 2tri ;
|
||||
|
||||
M: dlist push-back* ( obj dlist -- dlist-node )
|
||||
[ back>> f <dlist-node> ] keep
|
||||
[ back>> set-next-when ] 2keep
|
||||
|
@ -143,11 +163,13 @@ M: dlist deque-member? ( value dlist -- ? )
|
|||
[ = ] with dlist-any? ;
|
||||
|
||||
M: dlist delete-node ( dlist-node dlist -- )
|
||||
{
|
||||
{ [ 2dup front>> eq? ] [ nip pop-front* ] }
|
||||
{ [ 2dup back>> eq? ] [ nip pop-back* ] }
|
||||
[ drop unlink-node ]
|
||||
} cond ;
|
||||
[
|
||||
{
|
||||
{ [ 2dup front>> eq? ] [ nip pop-front* ] }
|
||||
{ [ 2dup back>> eq? ] [ nip pop-back* ] }
|
||||
[ drop unlink-node ]
|
||||
} cond
|
||||
] [ drop f >>prev f >>next drop ] 2bi ;
|
||||
|
||||
: delete-node-if* ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f ? )
|
||||
dupd dlist-find-node [
|
||||
|
@ -180,7 +202,8 @@ M: dlist clear-deque ( dlist -- )
|
|||
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
||||
|
||||
: dlist-filter ( ... dlist quot: ( ... value -- ... ? ) -- ... dlist' )
|
||||
over [ '[ dup obj>> @ [ drop ] [ _ delete-node ] if ] dlist-each-node ] keep ; inline
|
||||
[ not ] compose
|
||||
<dlist> [ '[ dup obj>> @ [ drop ] [ obj>> _ push-back ] if ] dlist-each-node ] keep ; inline
|
||||
|
||||
M: dlist clone
|
||||
<dlist> [ '[ _ push-back ] dlist-each ] keep ;
|
||||
|
@ -190,4 +213,3 @@ INSTANCE: dlist deque
|
|||
SYNTAX: DL{ \ } [ seq>dlist ] parse-literal ;
|
||||
|
||||
{ "dlists" "prettyprint" } "dlists.prettyprint" require-when
|
||||
|
||||
|
|
Loading…
Reference in New Issue