Implement equal? on dlists. Fixes #338.

diff --git a/basis/dlists/dlists-tests.factor b/basis/dlists/dlists-tests.factor
index 1ca7c0771a8ad6d3f6693994dd6a2bbc85698ed3..1198ec270aad9eb7256a2821dcb0158554306c39 100644 (file)
--- a/basis/dlists/dlists-tests.factor
+++ b/basis/dlists/dlists-tests.factor
@@ -85,3 +85,13 @@ IN: dlists.tests
 [ 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
 
+[ t ] [ DL{ } DL{ } = ] unit-test
+[ t ] [ DL{ 1 } DL{ 1 } = ] unit-test
+[ t ] [ DL{ 1 2 } DL{ 1 2 } = ] unit-test
+[ t ] [ DL{ 1 1 } DL{ 1 1 } = ] unit-test
+[ f ] [ DL{ 1 2 3 } DL{ 1 2 } = ] unit-test
+[ f ] [ DL{ 1 2 } DL{ 1 2 3 } = ] unit-test
+[ f ] [ DL{ } DL{ 1 } = ] unit-test
+[ f ] [ DL{ f } DL{ 1 } = ] unit-test
+[ f ] [ f DL{ } = ] unit-test
+[ f ] [ DL{ } f = ] unit-test

diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor
index 710c9d94fb3c805210363781273b6b5d68e5086f..c385b57973372fb69a87f6fa7af2bbc136e3b071 100644 (file)
--- a/basis/dlists/dlists.factor
+++ b/basis/dlists/dlists.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2007, 2009 Mackenzie Straight, Doug Coleman,
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators deques fry hashtables kernel math
-math.order parser search-deques sequences summary vocabs.loader ;
+USING: accessors arrays combinators combinators.short-circuit
+deques fry hashtables kernel parser search-deques sequences
+summary vocabs.loader ;
 IN: dlists
 
 <PRIVATE
@@ -33,6 +34,26 @@ M: dlist deque-empty? front>> not ; inline
 
 M: dlist-node node-value obj>> ;
 
+<PRIVATE
+
+: dlist-nodes= ( dlist-node/f dlist-node/f -- ? )
+    {
+        [ [ dlist-node? ] both? ]
+        [ [ obj>> ] bi@ = ] 
+    } 2&& ; inline
+
+PRIVATE>
+
+M: dlist equal?
+    over dlist? [
+        [ front>> ] bi@
+        [ 2dup dlist-nodes= ]
+        [ [ next>> ] bi@ ] while 
+        2array { f f } =
+    ] [
+        2drop f
+    ] if ;
+
 : set-prev-when ( dlist-node dlist-node/f -- )
     [ prev<< ] [ drop ] if* ; inline