dlists: new word dlist-length for getting the length

diff --git a/basis/dlists/dlists-docs.factor b/basis/dlists/dlists-docs.factor
index 508116816aea1427d5306bade5eee7fe6f9cbb91..990b20a760b4bea4fdd53f3267379f85b678ce34 100644 (file)
--- a/basis/dlists/dlists-docs.factor
+++ b/basis/dlists/dlists-docs.factor
@@ -39,6 +39,11 @@ HELP: <hashed-dlist>
 { $values { "search-deque" search-deque } }
 { $description "Creates a new " { $link search-deque } " backed by a " { $link dlist } ", with a " { $link hashtable } " for fast membership tests." } ;
 
+HELP: dlist-any?
+{ $values { "dlist" { $link dlist } } { "quot" quotation } { "?" boolean } }
+{ $description "Just like " { $link dlist-find } " except it doesn't return the object." }
+{ $notes "This operation is O(n)." } ;
+
 HELP: dlist-find
 { $values { "dlist" { $link dlist } } { "quot" quotation } { "obj/f" { $maybe object } } { "?" boolean } }
 { $description "Applies the quotation to each element of the " { $link dlist } " in turn, until it outputs a true value or the end of the " { $link dlist } " is reached.  Outputs either the object it found or " { $link f } ", and a boolean which is true if an object is found." }
@@ -48,13 +53,13 @@ HELP: dlist-find
 } ;
 
 HELP: dlist-filter
-{ $values { "dlist" { $link dlist } } { "quot" quotation } { "dlist'" { $link dlist } } }
+{ $values { "dlist" dlist } { "quot" quotation } { "dlist'" dlist } }
 { $description "Applies the quotation to each element of the " { $link dlist } " in turn, removing the corresponding nodes if the quotation returns " { $link f } "." }
 { $side-effects { "dlist" } } ;
 
-HELP: dlist-any?
-{ $values { "dlist" { $link dlist } } { "quot" quotation } { "?" boolean } }
-{ $description "Just like " { $link dlist-find } " except it doesn't return the object." }
+HELP: dlist-length
+{ $values { "dlist" dlist } { "n" "a non-negative number" } }
+{ $description "Calculates the length of the linked list." }
 { $notes "This operation is O(n)." } ;
 
 HELP: delete-node-if*

diff --git a/basis/dlists/dlists-tests.factor b/basis/dlists/dlists-tests.factor
index bdc1bf69ecffc4a545697f8b8558112aaec3b15f..ccb9d0c4a45fad4d2b8bc7b408a716146c8643bc 100644 (file)
--- a/basis/dlists/dlists-tests.factor
+++ b/basis/dlists/dlists-tests.factor
@@ -153,3 +153,8 @@ TUPLE: my-node < dlist-link { obj fixnum } ;
         { 3 2 4 1 0 } [ swap push-sorted drop ] with each
     ] keep
 ] unit-test
+
+{ 0 5 } [
+    <dlist> dlist-length
+    { 3 4 9 1 7 } >dlist dlist-length
+] unit-test

diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor
index 527dfdf91d500cab6840461b14462ca21f9a0f74..7b4eb3068567a6e5e48335c09eb4bfeec9629ab9 100644 (file)
--- a/basis/dlists/dlists.factor
+++ b/basis/dlists/dlists.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2007, 2009 Mackenzie Straight, Doug Coleman,
 ! Slava Pestov, John Benediktsson.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators combinators.short-circuit
-deques fry hashtables kernel math.order parser search-deques
-sequences summary vocabs.loader ;
+USING: accessors combinators combinators.short-circuit deques fry
+hashtables kernel kernel.private math math.order parser search-deques
+sequences vocabs.loader ;
 IN: dlists
 
 TUPLE: dlist-link
@@ -165,6 +165,11 @@ M: dlist delete-node
 M: dlist clear-deque
     f >>front f >>back drop ;
 
+: dlist-length ( dlist -- n )
+    0 swap [
+        drop { fixnum } declare 1 + f
+    ] dlist-find-node drop ; flushable
+
 : dlist-each ( ... dlist quot: ( ... value -- ... ) -- ... )
     '[ obj>> @ ] dlist-each-node ; inline