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

Fix bug in delete-node

release
Slava Pestov 2007-11-16 00:17:34 -05:00
parent 299dca3200
commit 24de62e335
2 changed files with 21 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
core/dlists/dlists-tests.factor
View File

@ -81,3 +81,17 @@ IN: temporary
dlist>array dlist>array
] 2keep seq-diff assert-same-elements ] 2keep seq-diff assert-same-elements
] unit-test ] unit-test
[ ] [
<dlist> "d" set
1 "d" get push-front
2 "d" get push-front
3 "d" get push-front
4 "d" get push-front
2 "d" get dlist-delete drop
3 "d" get dlist-delete drop
4 "d" get dlist-delete drop
] unit-test
[ 1 ] [ "d" get dlist-length ] unit-test
[ 1 ] [ "d" get dlist>array length ] unit-test

11
core/dlists/dlists.factor
View File

@ -103,12 +103,15 @@ PRIVATE>
: dlist-contains? ( quot dlist -- ? ) : dlist-contains? ( quot dlist -- ? )
dlist-find nip ; inline dlist-find nip ; inline
: unlink-node ( dlist-node -- )
dup dlist-node-prev over dlist-node-next set-prev-when
dup dlist-node-next swap dlist-node-prev set-next-when ;
: (delete-node) ( dlist dlist-node -- ) : (delete-node) ( dlist dlist-node -- )
{ {
{ [ 2dup >r dlist-front r> = ] [ drop pop-front* ] } { [ over dlist-front over eq? ] [ drop pop-front* ] }
{ [ 2dup >r dlist-back r> = ] [ drop pop-back* ] } { [ over dlist-back over eq? ] [ drop pop-back* ] }
{ [ t ] [ dup dlist-node-prev swap dlist-node-next set-prev-when { [ t ] [ unlink-node dec-length ] }
dec-length ] }
} cond ; } cond ;
: delete-node* ( quot dlist -- obj/f ? ) : delete-node* ( quot dlist -- obj/f ? )