persistent deques cleanup, name changes

basis/persistent/deques/deques-tests.factor

@@ -1,35 +1,38 @@
-! Copyright (C) 2008 Daniel Ehrenberg
+! Copyback (C) 2008 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test persistent.deques kernel math ;
 IN: persistent.deques.tests
 
 [ 3 2 1 t ]
-[ { 1 2 3 } sequence>deque 3 [ pop-right ] times deque-empty? ] unit-test
+[ { 1 2 3 } sequence>deque 3 [ pop-back ] times deque-empty? ] unit-test
 
 [ 1 2 3 t ]
-[ { 1 2 3 } sequence>deque 3 [ pop-left ] times deque-empty? ] unit-test
+[ { 1 2 3 } sequence>deque 3 [ pop-front ] times deque-empty? ] unit-test
 
 [ 1 3 2 t ]
-[ { 1 2 3 } sequence>deque pop-left 2 [ pop-right ] times deque-empty? ]
+[ { 1 2 3 } sequence>deque pop-front 2 [ pop-back ] times deque-empty? ]
 unit-test
 
 [ { 2 3 4 5 6 1 } ]
-[ { 1 2 3 4 5 6 } sequence>deque pop-left swap push-right deque>sequence ]
+[ { 1 2 3 4 5 6 } sequence>deque pop-front swap push-back deque>sequence ]
 unit-test
 
-[ 1 t ] [ <deque> 1 push-left pop-right deque-empty? ] unit-test
+[ 1 ] [ { 1 2 3 4 } sequence>deque peek-front ] unit-test
-[ 1 t ] [ <deque> 1 push-left pop-left deque-empty? ] unit-test
+[ 4 ] [ { 1 2 3 4 } sequence>deque peek-back ] unit-test
-[ 1 t ] [ <deque> 1 push-right pop-left deque-empty? ] unit-test
+
-[ 1 t ] [ <deque> 1 push-right pop-right deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-front pop-back deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-front pop-front deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-back pop-front deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-back pop-back deque-empty? ] unit-test
 
 [ 1 f ]
-[ <deque> 1 push-left 2 push-left pop-right deque-empty? ] unit-test
+[ <deque> 1 push-front 2 push-front pop-back deque-empty? ] unit-test
 
 [ 1 f ]
-[ <deque> 1 push-right 2 push-right pop-left deque-empty? ] unit-test
+[ <deque> 1 push-back 2 push-back pop-front deque-empty? ] unit-test
 
 [ 2 f ]
-[ <deque> 1 push-right 2 push-right pop-right deque-empty? ] unit-test
+[ <deque> 1 push-back 2 push-back pop-back deque-empty? ] unit-test
 
 [ 2 f ]
-[ <deque> 1 push-left 2 push-left pop-left deque-empty? ] unit-test
+[ <deque> 1 push-front 2 push-front pop-front deque-empty? ] unit-test

basis/persistent/deques/deques.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Daniel Ehrenberg
+! Copyback (C) 2008 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors math qualified ;
 QUALIFIED: sequences
@@ -33,44 +33,55 @@ C: <cons> cons
     dup length 2/ cut [ reverse ] bi@ ;
 PRIVATE>
 
-TUPLE: deque { lhs read-only } { rhs read-only } ;
+TUPLE: deque { front read-only } { back read-only } ;
 : <deque> ( -- deque ) T{ deque } ;
 
+<PRIVATE
+: flip ( deque -- newdeque )
+    [ back>> ] [ front>> ] bi deque boa ;
+
+: flipped ( deque quot -- newdeque )
+    >r flip r> call flip ;
+PRIVATE>
+
 : deque-empty? ( deque -- ? )
-    [ lhs>> ] [ rhs>> ] bi or not ;
+    [ front>> ] [ back>> ] bi or not ;
-
-: push-left ( deque item -- newdeque )
-    swap [ lhs>> <cons> ] [ rhs>> ] bi deque boa ;
-
-: push-right ( deque item -- newdeque )
-    swap [ rhs>> <cons> ] [ lhs>> ] bi swap deque boa ;
 
 <PRIVATE
-: (pop-left) ( deque -- item newdeque )
+: push ( item deque -- newdeque )
-    [ lhs>> car>> ] [ [ lhs>> cdr>> ] [ rhs>> ] bi deque boa ] bi ;
+    [ front>> <cons> ] [ back>> ] bi deque boa ; inline
-
-: transfer-left ( deque -- item newdeque )
-    rhs>> [ split-reverse deque boa (pop-left) ]
-    [ "Popping from an empty deque" throw ] if* ;
 PRIVATE>
 
-: pop-left ( deque -- item newdeque )
+: push-front ( deque item -- newdeque )
-    dup lhs>> [ (pop-left) ] [ transfer-left ] if ;
+    swap push ;
+
+: push-back ( deque item -- newdeque )
+    swap [ push ] flipped ;
 
 <PRIVATE
-: (pop-right) ( deque -- item newdeque )
+: remove ( deque -- item newdeque )
-    [ rhs>> car>> ] [ [ lhs>> ] [ rhs>> cdr>> ] bi deque boa ] bi ;
+    [ front>> car>> ] [ [ front>> cdr>> ] [ back>> ] bi deque boa ] bi ; inline
 
-: transfer-right ( deque -- newdeque item )
+: transfer ( deque -- item newdeque )
-    lhs>> [ split-reverse deque boa (pop-left) ]
+    back>> [ split-reverse deque boa remove ]
-    [ "Popping from an empty deque" throw ] if* ;
+    [ "Popping from an empty deque" throw ] if* ; inline
+
+: pop ( deque -- item newdeque )
+    dup front>> [ remove ] [ transfer ] if ; inline
 PRIVATE>
 
-: pop-right ( deque -- item newdeque )
+: pop-front ( deque -- item newdeque )
-    dup rhs>> [ (pop-right) ] [ transfer-right ] if ;
+    pop ;
+
+: pop-back ( deque -- item newdeque )
+    [ pop ] flipped ;
+
+: peek-front ( deque -- item ) pop-front drop ;
+
+: peek-back ( deque -- item ) pop-back drop ;
 
 : sequence>deque ( sequence -- deque )
-    <deque> [ push-right ] sequences:reduce ;
+    <deque> [ push-back ] sequences:reduce ;
 
 : deque>sequence ( deque -- sequence )
-    [ dup deque-empty? not ] [ pop-left swap ] [ ] sequences:produce nip ;
+    [ dup deque-empty? not ] [ pop-front swap ] [ ] sequences:produce nip ;