persistent deques cleanup, name changes

db4
Daniel Ehrenberg 2008-08-15 05:10:18 +02:00
parent b5473d7f14
commit 87610f24dc
2 changed files with 53 additions and 39 deletions

View File

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

View File

@ -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 ;