-! 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 t ] [ <deque> 1 push-left pop-left deque-empty? ] 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 ] [ { 1 2 3 4 } sequence>deque peek-front ] unit-test
+[ 4 ] [ { 1 2 3 4 } sequence>deque peek-back ] 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
-! 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
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 } ;
-: deque-empty? ( deque -- ? )
- [ lhs>> ] [ rhs>> ] bi or not ;
+<PRIVATE
+: flip ( deque -- newdeque )
+ [ back>> ] [ front>> ] bi deque boa ;
-: push-left ( deque item -- newdeque )
- swap [ lhs>> <cons> ] [ rhs>> ] bi deque boa ;
+: flipped ( deque quot -- newdeque )
+ >r flip r> call flip ;
+PRIVATE>
-: push-right ( deque item -- newdeque )
- swap [ rhs>> <cons> ] [ lhs>> ] bi swap deque boa ;
+: deque-empty? ( deque -- ? )
+ [ front>> ] [ back>> ] bi or not ;
<PRIVATE
-: (pop-left) ( deque -- item newdeque )
- [ lhs>> car>> ] [ [ lhs>> cdr>> ] [ rhs>> ] bi deque boa ] bi ;
-
-: transfer-left ( deque -- item newdeque )
- rhs>> [ split-reverse deque boa (pop-left) ]
- [ "Popping from an empty deque" throw ] if* ;
+: push ( item deque -- newdeque )
+ [ front>> <cons> ] [ back>> ] bi deque boa ; inline
PRIVATE>
-: pop-left ( deque -- item newdeque )
- dup lhs>> [ (pop-left) ] [ transfer-left ] if ;
+: push-front ( deque item -- newdeque )
+ swap push ;
+
+: push-back ( deque item -- newdeque )
+ swap [ push ] flipped ;
<PRIVATE
-: (pop-right) ( deque -- item newdeque )
- [ rhs>> car>> ] [ [ lhs>> ] [ rhs>> cdr>> ] bi deque boa ] bi ;
+: remove ( deque -- item newdeque )
+ [ front>> car>> ] [ [ front>> cdr>> ] [ back>> ] bi deque boa ] bi ; inline
+
+: transfer ( deque -- item newdeque )
+ back>> [ split-reverse deque boa remove ]
+ [ "Popping from an empty deque" throw ] if* ; inline
-: transfer-right ( deque -- newdeque item )
- lhs>> [ split-reverse deque boa (pop-left) ]
- [ "Popping from an empty deque" throw ] if* ;
+: pop ( deque -- item newdeque )
+ dup front>> [ remove ] [ transfer ] if ; inline
PRIVATE>
-: pop-right ( deque -- item newdeque )
- dup rhs>> [ (pop-right) ] [ transfer-right ] if ;
+: pop-front ( deque -- item newdeque )
+ 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 ;