better error reporting for push/pop on dlists

core/dlists/dlists-tests.factor

@@ -98,5 +98,7 @@ IN: dlists.tests
 [ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node drop class dlist-node = ] unit-test
 [ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
 
-[ f ] [ <dlist> peek-front ] unit-test
-[ f ] [ <dlist> peek-back ] unit-test
+[ <dlist> peek-front ] must-fail
+[ <dlist> peek-back ] must-fail
+[ <dlist> pop-front ] [ empty-dlist? ] must-fail-with
+[ <dlist> pop-back ] [ empty-dlist? ] must-fail-with

core/dlists/dlists.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Mackenzie Straight, Doug Coleman,
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel math sequences accessors ;
+USING: combinators kernel math sequences accessors inspector ;
 IN: dlists
 
 TUPLE: dlist front back length ;
@@ -84,11 +84,17 @@ PRIVATE>
 : push-all-back ( seq dlist -- )
     [ push-back ] curry each ;
 
+ERROR: empty-dlist ;
+
+M: empty-dlist summary ( dlist -- )
+    drop "Emtpy dlist" ;
+
 : peek-front ( dlist -- obj )
-    front>> dup [ obj>> ] when ;
+    front>> [ empty-dlist ] unless* obj>> ;
 
 : pop-front ( dlist -- obj )
-    dup front>> [
+    dup front>> [ empty-dlist ] unless*
+    [
         dup next>>
         f rot (>>next)
         f over set-prev-when
@@ -100,10 +106,11 @@ PRIVATE>
     pop-front drop ;
 
 : peek-back ( dlist -- obj )
-    back>> dup [ obj>> ] when ;
+    back>> [ empty-dlist ] unless* obj>> ;
 
 : pop-back ( dlist -- obj )
-    dup back>> [
+    dup back>> [ empty-dlist ] unless*
+    [
         dup prev>>
         f rot (>>prev)
         f over set-next-when