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

find-dlist-node was returning duplicated information -- node/f tells you enough, no need for another boolean return value

db4
Doug Coleman 2011-10-17 18:57:21 -07:00
parent d947553df8
commit a2804ebf54
2 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/dlists/dlists-tests.factor
View File

@ -53,9 +53,9 @@ IN: dlists.tests
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node drop class dlist-node = ] unit-test [ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node class dlist-node = ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node drop class dlist-node = ] unit-test [ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node class dlist-node = ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node drop class dlist-node = ] unit-test [ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node class dlist-node = ] unit-test
[ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test [ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
[ <dlist> peek-front ] [ empty-dlist? ] must-fail-with [ <dlist> peek-front ] [ empty-dlist? ] must-fail-with
@ -84,3 +84,4 @@ IN: dlists.tests
[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test [ V{ 2 4 } ] [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test [ V{ 2 4 } ] [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
[ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test [ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test

21
basis/dlists/dlists.factor
View File

@ -2,7 +2,7 @@
! Slava Pestov. ! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel math sequences accessors deques USING: combinators kernel math sequences accessors deques
search-deques summary hashtables fry ; search-deques summary hashtables fry math.order ;
IN: dlists IN: dlists
<PRIVATE <PRIVATE
@ -54,17 +54,20 @@ M: dlist-node node-value obj>> ;
: set-front-to-back ( dlist -- ) : set-front-to-back ( dlist -- )
dup front>> [ dup back>> >>front ] unless drop ; inline dup front>> [ dup back>> >>front ] unless drop ; inline
: (dlist-find-node) ( ... dlist-node quot: ( ... node -- ... ? ) -- ... node/f ? ) : (dlist-find-node) ( ... dlist-node quot: ( ... node -- ... ? ) -- ... node/f )
over [ over [
[ call ] 2keep rot [ call ] 2keep rot
[ drop t ] [ [ next>> ] dip (dlist-find-node) ] if [ drop ] [ [ next>> ] dip (dlist-find-node) ] if
] [ 2drop f f ] if ; inline recursive ] [ 2drop f ] if ; inline recursive
: dlist-find-node ( ... dlist quot: ( ... node -- ... ? ) -- ... node/f ? ) : dlist-find-node ( ... dlist quot: ( ... node -- ... ? ) -- ... node/f )
[ front>> ] dip (dlist-find-node) ; inline [ front>> ] dip (dlist-find-node) ; inline
: dlist-find-node-prev ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f ? )
dlist-find-node [ prev>> ] [ f ] if* ; inline
: dlist-each-node ( ... dlist quot: ( ... node -- ... ) -- ... ) : dlist-each-node ( ... dlist quot: ( ... node -- ... ) -- ... )
'[ @ f ] dlist-find-node 2drop ; inline '[ @ f ] dlist-find-node drop ; inline
: unlink-node ( dlist-node -- ) : unlink-node ( dlist-node -- )
dup prev>> over next>> set-prev-when dup prev>> over next>> set-prev-when
@ -115,7 +118,7 @@ M: dlist pop-back* ( dlist -- )
normalize-front ; normalize-front ;
: dlist-find ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f ? ) : dlist-find ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f ? )
'[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline '[ obj>> @ ] dlist-find-node [ obj>> t ] [ f f ] if* ; inline
: dlist-any? ( ... dlist quot: ( ... value -- ... ? ) -- ... ? ) : dlist-any? ( ... dlist quot: ( ... value -- ... ? ) -- ... ? )
dlist-find nip ; inline dlist-find nip ; inline
@ -138,8 +141,8 @@ M: dlist delete-node ( dlist-node dlist -- )
2drop f f 2drop f f
] if ] if
] [ ] [
2drop f f drop f f
] if ; inline ] if* ; inline
: delete-node-if ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f ) : delete-node-if ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f )
'[ obj>> @ ] delete-node-if* drop ; inline '[ obj>> @ ] delete-node-if* drop ; inline