From 786bba8a6329874cf9bfbd46c24ab994abd36968 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 8 Nov 2011 13:20:56 -0800 Subject: [PATCH] deques: adding ?peek-front and ?peek-back. --- basis/deques/deques-docs.factor | 22 ++++++++++++++++++++-- basis/deques/deques.factor | 18 ++++++++++++++++-- basis/dlists/dlists-tests.factor | 13 +++++++++---- basis/dlists/dlists.factor | 17 ++++++----------- basis/search-deques/search-deques.factor | 4 ++-- basis/unrolled-lists/unrolled-lists.factor | 12 ++++++------ 6 files changed, 59 insertions(+), 27 deletions(-) diff --git a/basis/deques/deques-docs.factor b/basis/deques/deques-docs.factor index c625b9a27d..8b86fd2f3f 100644 --- a/basis/deques/deques-docs.factor +++ b/basis/deques/deques-docs.factor @@ -48,9 +48,18 @@ HELP: push-all-front { "seq" sequence } { "deque" deque } } { $description "Pushes a sequence of elements onto the front of a deque." } ; +HELP: peek-front* +{ $values { "deque" deque } { "obj" object } { "?" boolean } } +{ $contract "Returns the object at the front of the deque, and a boolean indicating if an object was found." } ; + HELP: peek-front { $values { "deque" deque } { "obj" object } } -{ $contract "Returns the object at the front of the deque." } ; +{ $description "Returns the object at the front of the deque." } +{ $errors "Throws an error if the deque is empty." } ; + +HELP: ?peek-front +{ $values { "deque" deque } { "obj/f" "an object or " { $link f } } } +{ $description "A forgiving version of " { $link peek-front } ". If the deque is empty, returns " { $link f } "." } ; HELP: pop-front { $values { "deque" deque } { "obj" object } } @@ -62,9 +71,18 @@ HELP: pop-front* { $contract "Pop the object off the front of the deque." } { $notes "This operation is O(1)." } ; +HELP: peek-back* +{ $values { "deque" deque } { "obj" object } { "?" boolean } } +{ $contract "Returns the object at the back of the deque, and a boolean indicating if an object was found." } ; + HELP: peek-back { $values { "deque" deque } { "obj" object } } -{ $contract "Returns the object at the back of the deque." } ; +{ $description "Returns the object at the back of the deque." } +{ $errors "Throws an error if the deque is empty." } ; + +HELP: ?peek-back +{ $values { "deque" deque } { "obj/f" "an object or " { $link f } } } +{ $description "A forgiving version of " { $link peek-back } ". If the deque is empty, returns " { $link f } "." } ; HELP: pop-back { $values { "deque" deque } { "obj" object } } diff --git a/basis/deques/deques.factor b/basis/deques/deques.factor index 7483c0f56b..307d4828d0 100644 --- a/basis/deques/deques.factor +++ b/basis/deques/deques.factor @@ -5,8 +5,8 @@ IN: deques GENERIC: push-front* ( obj deque -- node ) GENERIC: push-back* ( obj deque -- node ) -GENERIC: peek-front ( deque -- obj ) -GENERIC: peek-back ( deque -- obj ) +GENERIC: peek-front* ( deque -- obj ? ) +GENERIC: peek-back* ( deque -- obj ? ) GENERIC: pop-front* ( deque -- ) GENERIC: pop-back* ( deque -- ) GENERIC: delete-node ( node deque -- ) @@ -15,6 +15,20 @@ GENERIC: clear-deque ( deque -- ) GENERIC: node-value ( node -- value ) GENERIC: deque-empty? ( deque -- ? ) +ERROR: empty-deque ; + +: peek-front ( dlist -- obj ) + peek-front* [ drop empty-deque ] unless ; + +: ?peek-front ( dlist -- obj/f ) + peek-front* [ drop f ] unless ; + +: peek-back ( dlist -- obj ) + peek-back* [ drop empty-deque ] unless ; + +: ?peek-back ( dlist -- obj/f ) + peek-back* [ drop f ] unless ; + : push-front ( obj deque -- ) push-front* drop ; inline diff --git a/basis/dlists/dlists-tests.factor b/basis/dlists/dlists-tests.factor index 1198ec270a..59efcda93e 100644 --- a/basis/dlists/dlists-tests.factor +++ b/basis/dlists/dlists-tests.factor @@ -58,10 +58,15 @@ IN: dlists.tests [ t ] [ 4 over push-back 5 over push-back* [ = ] curry dlist-find-node class-of dlist-node = ] unit-test [ ] [ 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test -[ peek-front ] [ empty-dlist? ] must-fail-with -[ peek-back ] [ empty-dlist? ] must-fail-with -[ pop-front ] [ empty-dlist? ] must-fail-with -[ pop-back ] [ empty-dlist? ] must-fail-with +[ f ] [ ?peek-front ] unit-test +[ 1 ] [ 1 over push-front ?peek-front ] unit-test +[ f ] [ ?peek-back ] unit-test +[ 1 ] [ 1 over push-back ?peek-back ] unit-test + +[ peek-front ] [ empty-deque? ] must-fail-with +[ peek-back ] [ empty-deque? ] must-fail-with +[ pop-front ] [ empty-deque? ] must-fail-with +[ pop-back ] [ empty-deque? ] must-fail-with [ t ] [ 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor index 3c728d7d0c..21b5f40af8 100644 --- a/basis/dlists/dlists.factor +++ b/basis/dlists/dlists.factor @@ -107,31 +107,26 @@ M: dlist push-back* ( obj dlist -- dlist-node ) [ back<< ] 2keep set-front-to-back ; -ERROR: empty-dlist ; +M: dlist peek-front* ( dlist -- obj/f ? ) + front>> [ obj>> t ] [ f f ] if* ; -M: empty-dlist summary ( dlist -- string ) - drop "Empty dlist" ; - -M: dlist peek-front ( dlist -- obj ) - front>> [ obj>> ] [ empty-dlist ] if* ; +M: dlist peek-back* ( dlist -- obj/f ? ) + back>> [ obj>> t ] [ f f ] if* ; M: dlist pop-front* ( dlist -- ) [ [ - [ empty-dlist ] unless* + [ empty-deque ] unless* next>> f over set-prev-when ] change-front drop ] keep normalize-back ; -M: dlist peek-back ( dlist -- obj ) - back>> [ obj>> ] [ empty-dlist ] if* ; - M: dlist pop-back* ( dlist -- ) [ [ - [ empty-dlist ] unless* + [ empty-deque ] unless* prev>> f over set-next-when ] change-back drop diff --git a/basis/search-deques/search-deques.factor b/basis/search-deques/search-deques.factor index 5546a9766d..1f2924e200 100644 --- a/basis/search-deques/search-deques.factor +++ b/basis/search-deques/search-deques.factor @@ -9,9 +9,9 @@ C: search-deque M: search-deque deque-empty? deque>> deque-empty? ; -M: search-deque peek-front deque>> peek-front ; +M: search-deque peek-front* deque>> peek-front* ; -M: search-deque peek-back deque>> peek-back ; +M: search-deque peek-back* deque>> peek-back* ; M: search-deque push-front* 2dup assoc>> at* [ 2nip ] [ diff --git a/basis/unrolled-lists/unrolled-lists.factor b/basis/unrolled-lists/unrolled-lists.factor index a1ec025e45..1a72b0f1ff 100644 --- a/basis/unrolled-lists/unrolled-lists.factor +++ b/basis/unrolled-lists/unrolled-lists.factor @@ -68,10 +68,10 @@ M: unrolled-list push-front* [ drop ] [ and ] 2bi [ push-front/existing ] [ drop push-front/new ] if f ; -M: unrolled-list peek-front +M: unrolled-list peek-front* dup front>> - [ [ front-pos>> ] dip data>> nth-unsafe ] - [ empty-unrolled-list ] + [ [ front-pos>> ] dip data>> nth-unsafe t ] + [ drop f f ] if* ; : pop-front/new ( list front -- ) @@ -114,10 +114,10 @@ M: unrolled-list push-back* [ drop ] [ and ] 2bi [ push-back/existing ] [ drop push-back/new ] if f ; -M: unrolled-list peek-back +M: unrolled-list peek-back* dup back>> - [ [ back-pos>> 1 - ] dip data>> nth-unsafe ] - [ empty-unrolled-list ] + [ [ back-pos>> 1 - ] dip data>> nth-unsafe t ] + [ drop f f ] if* ; : pop-back/new ( list back -- )