deques: adding ?peek-front and ?peek-back.

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 } }

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-front* ( deque -- obj ? )
-GENERIC: peek-back ( 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
 

basis/dlists/dlists-tests.factor

@@ -58,10 +58,15 @@ IN: dlists.tests
 [ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node class-of 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
+[ f ] [ <dlist> ?peek-front ] unit-test
-[ <dlist> peek-back ] [ empty-dlist? ] must-fail-with
+[ 1 ] [ <dlist> 1 over push-front ?peek-front ] unit-test
-[ <dlist> pop-front ] [ empty-dlist? ] must-fail-with
+[ f ] [ <dlist> ?peek-back ] unit-test
-[ <dlist> pop-back ] [ empty-dlist? ] must-fail-with
+[ 1 ] [ <dlist> 1 over push-back ?peek-back ] unit-test
+
+[ <dlist> peek-front ] [ empty-deque? ] must-fail-with
+[ <dlist> peek-back ] [ empty-deque? ] must-fail-with
+[ <dlist> pop-front ] [ empty-deque? ] must-fail-with
+[ <dlist> pop-back ] [ empty-deque? ] must-fail-with
 
 [ t ] [ <dlist> 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test
 

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 )
+M: dlist peek-back* ( dlist -- obj/f ? )
-    drop "Empty dlist" ;
+    back>> [ obj>> t ] [ f f ] if* ;
-
-M: dlist peek-front ( dlist -- obj )
-    front>> [ obj>> ] [ empty-dlist ] 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

basis/search-deques/search-deques.factor

@@ -9,9 +9,9 @@ C: <search-deque> 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 ] [

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 ]
+    [ [ front-pos>> ] dip data>> nth-unsafe t ]
-    [ empty-unrolled-list ]
+    [ 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 ]
+    [ [ back-pos>> 1 - ] dip data>> nth-unsafe t ]
-    [ empty-unrolled-list ]
+    [ drop f f ]
     if* ;
 
 : pop-back/new ( list back -- )