persistent deques cleanup, name changes
parent
b5473d7f14
commit
87610f24dc
|
@ -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 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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
: 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 ;
|
||||
[ 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-right ( deque -- newdeque item )
|
||||
lhs>> [ split-reverse deque boa (pop-left) ]
|
||||
[ "Popping from an empty deque" throw ] if* ;
|
||||
: transfer ( deque -- item newdeque )
|
||||
back>> [ split-reverse deque boa remove ]
|
||||
[ "Popping from an empty deque" throw ] if* ; inline
|
||||
|
||||
: 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 ;
|
||||
|
|
Loading…
Reference in New Issue