From 191e95d8c11c77cbbb0824e69cfc274c782bce5b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 25 May 2008 18:28:07 -0500 Subject: [PATCH] fix a couple of dlists bugs document more words add more tests --- core/dlists/dlists-docs.factor | 40 ++++++++++++++++++++++----------- core/dlists/dlists-tests.factor | 21 ++++++++++------- core/dlists/dlists.factor | 16 ++++++++----- 3 files changed, 50 insertions(+), 27 deletions(-) diff --git a/core/dlists/dlists-docs.factor b/core/dlists/dlists-docs.factor index c957c04453..8616d1f253 100755 --- a/core/dlists/dlists-docs.factor +++ b/core/dlists/dlists-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax kernel quotations ; +USING: help.markup help.syntax kernel quotations dlists.private ; IN: dlists ARTICLE: "dlists" "Doubly-linked lists" @@ -51,38 +51,52 @@ HELP: dlist-empty? HELP: push-front { $values { "obj" "an object" } { "dlist" dlist } } { $description "Push the object onto the front of the " { $link dlist } "." } -{ $notes "This operation is O(1)." } -{ $see-also push-back pop-front pop-front* pop-back pop-back* } ; +{ $notes "This operation is O(1)." } ; + +HELP: push-front* +{ $values { "obj" "an object" } { "dlist" dlist } { "dlist-node" dlist-node } } +{ $description "Push the object onto the front of the " { $link dlist } " and return the newly created " { $snippet "dlist-node" } "." } +{ $notes "This operation is O(1)." } ; HELP: push-back { $values { "obj" "an object" } { "dlist" dlist } } { $description "Push the object onto the back of the " { $link dlist } "." } -{ $notes "This operation is O(1)." } -{ $see-also push-front pop-front pop-front* pop-back pop-back* } ; +{ $notes "This operation is O(1)." } ; + +HELP: push-back* +{ $values { "obj" "an object" } { "dlist" dlist } { "dlist-node" dlist-node } } +{ $description "Push the object onto the back of the " { $link dlist } " and return the newly created " { $snippet "dlist-node" } "." } +{ $notes "This operation is O(1)." } ; + +HELP: peek-front +{ $values { "dlist" dlist } { "obj" "an object" } } +{ $description "Returns the object at the front of the " { $link dlist } "." } ; HELP: pop-front { $values { "dlist" dlist } { "obj" "an object" } } { $description "Pop the object off the front of the " { $link dlist } " and return the object." } -{ $notes "This operation is O(1)." } -{ $see-also push-front push-back pop-front* pop-back pop-back* } ; +{ $notes "This operation is O(1)." } ; HELP: pop-front* { $values { "dlist" dlist } } { $description "Pop the object off the front of the " { $link dlist } "." } -{ $notes "This operation is O(1)." } -{ $see-also push-front push-back pop-front pop-back pop-back* } ; +{ $notes "This operation is O(1)." } ; + +HELP: peek-back +{ $values { "dlist" dlist } { "obj" "an object" } } +{ $description "Returns the object at the back of the " { $link dlist } "." } ; HELP: pop-back { $values { "dlist" dlist } { "obj" "an object" } } { $description "Pop the object off the back of the " { $link dlist } " and return the object." } -{ $notes "This operation is O(1)." } -{ $see-also push-front push-back pop-front pop-front* pop-back* } ; +{ $notes "This operation is O(1)." } ; HELP: pop-back* { $values { "dlist" dlist } } { $description "Pop the object off the back of the " { $link dlist } "." } -{ $notes "This operation is O(1)." } -{ $see-also push-front push-back pop-front pop-front* pop-back } ; +{ $notes "This operation is O(1)." } ; + +{ push-front push-front* push-back push-back* peek-front pop-front pop-front* peek-back pop-back pop-back* } related-words HELP: dlist-find { $values { "dlist" { $link dlist } } { "quot" quotation } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } } diff --git a/core/dlists/dlists-tests.factor b/core/dlists/dlists-tests.factor index 3bf324664f..6a29362c5d 100755 --- a/core/dlists/dlists-tests.factor +++ b/core/dlists/dlists-tests.factor @@ -1,6 +1,6 @@ USING: dlists dlists.private kernel tools.test random assocs sets sequences namespaces sorting debugger io prettyprint -math ; +math accessors classes ; IN: dlists.tests [ t ] [ dlist-empty? ] unit-test @@ -65,20 +65,17 @@ IN: dlists.tests : assert-same-elements [ prune natural-sort ] bi@ assert= ; -: dlist-push-all [ push-front ] curry each ; - : dlist-delete-all [ dlist-delete drop ] curry each ; : dlist>array [ [ , ] dlist-slurp ] { } make ; [ ] [ 5 [ drop 30 random >fixnum ] map prune - 6 [ drop 30 random >fixnum ] map prune 2dup nl . . nl - [ + 6 [ drop 30 random >fixnum ] map prune [ - [ dlist-push-all ] keep - [ dlist-delete-all ] keep - dlist>array + [ push-all-front ] + [ dlist-delete-all ] + [ dlist>array ] tri ] 2keep swap diff assert-same-elements ] unit-test @@ -95,3 +92,11 @@ IN: dlists.tests [ 1 ] [ "d" get dlist-length ] unit-test [ 1 ] [ "d" get dlist>array length ] unit-test + +[ t ] [ 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node drop class dlist-node = ] unit-test +[ t ] [ 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node drop class dlist-node = ] unit-test +[ t ] [ 4 over push-back 5 over push-back* [ = ] curry dlist-find-node drop class dlist-node = ] unit-test +[ ] [ 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test + +[ f ] [ peek-front ] unit-test +[ f ] [ peek-back ] unit-test diff --git a/core/dlists/dlists.factor b/core/dlists/dlists.factor index d9aa6b1c19..0e0cfb9f58 100755 --- a/core/dlists/dlists.factor +++ b/core/dlists/dlists.factor @@ -47,7 +47,7 @@ C: dlist-node : (dlist-find-node) ( dlist-node quot -- node/f ? ) over [ - [ >r obj>> r> call ] 2keep rot + [ call ] 2keep rot [ drop t ] [ >r next>> r> (dlist-find-node) ] if ] [ 2drop f f ] if ; inline @@ -55,7 +55,7 @@ C: dlist-node >r front>> r> (dlist-find-node) ; inline : dlist-each-node ( dlist quot -- ) - [ t ] compose dlist-find-node 2drop ; inline + [ f ] compose dlist-find-node 2drop ; inline PRIVATE> @@ -85,7 +85,7 @@ PRIVATE> [ push-back ] curry each ; : peek-front ( dlist -- obj ) - front>> obj>> ; + front>> dup [ obj>> ] when ; : pop-front ( dlist -- obj ) dup front>> [ @@ -96,10 +96,11 @@ PRIVATE> ] 2keep obj>> swap [ normalize-back ] keep dec-length ; -: pop-front* ( dlist -- ) pop-front drop ; +: pop-front* ( dlist -- ) + pop-front drop ; : peek-back ( dlist -- obj ) - back>> obj>> ; + back>> dup [ obj>> ] when ; : pop-back ( dlist -- obj ) dup back>> [ @@ -110,9 +111,11 @@ PRIVATE> ] 2keep obj>> swap [ normalize-front ] keep dec-length ; -: pop-back* ( dlist -- ) pop-back drop ; +: pop-back* ( dlist -- ) + pop-back drop ; : dlist-find ( dlist quot -- obj/f ? ) + [ obj>> ] prepose dlist-find-node [ obj>> t ] [ drop f f ] if ; inline : dlist-contains? ( dlist quot -- ? ) @@ -141,6 +144,7 @@ PRIVATE> ] if ; inline : delete-node-if ( dlist quot -- obj/f ) + [ obj>> ] prepose delete-node-if* drop ; inline : dlist-delete ( obj dlist -- obj/f )