find-dlist-node was returning duplicated information -- node/f tells you enough,...

diff --git a/basis/dlists/dlists-tests.factor b/basis/dlists/dlists-tests.factor
index 8072c93753c0be2be127ebe39d73f8e436c5af4f..ab27304350dad85ef9b687c695a77d751572b171 100644 (file)
--- a/basis/dlists/dlists-tests.factor
+++ b/basis/dlists/dlists-tests.factor
@@ -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> 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>> 5 = ] dlist-find-node drop 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 [ 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 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> 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 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
+

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