factor/basis/persistent/deques/deques.factor

71 lines
1.8 KiB
Factor
Raw Normal View History

! Copyright (C) 2008 Daniel Ehrenberg
2008-08-09 12:40:17 -04:00
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math lists sequences combinators.short-circuit ;
2008-08-09 12:40:17 -04:00
IN: persistent.deques
! Amortized O(1) push/pop on both ends for single-threaded access
! In a pathological case, if there are m modified versions from the
! same source, it could take O(m) amortized time per update.
<PRIVATE
: split-reverse ( list -- back-reversed front )
dup llength 2/ lcut lreverse swap ;
2008-08-09 12:40:17 -04:00
PRIVATE>
TUPLE: deque { front read-only } { back read-only } ;
: <deque> ( -- deque )
T{ deque f +nil+ +nil+ } ;
2008-08-09 12:40:17 -04:00
<PRIVATE
: flip ( deque -- newdeque )
[ back>> ] [ front>> ] bi deque boa ;
2008-08-09 12:40:17 -04:00
: flipped ( deque quot -- newdeque )
2009-04-15 20:03:44 -04:00
[ flip ] dip call flip ; inline
PRIVATE>
2008-08-09 12:40:17 -04:00
: deque-empty? ( deque -- ? )
{ [ front>> nil? ] [ back>> nil? ] } 1&& ;
2008-08-09 12:40:17 -04:00
<PRIVATE
: push ( item deque -- newdeque )
[ front>> cons ] [ back>> ] bi deque boa ; inline
2008-08-09 12:40:17 -04:00
PRIVATE>
: push-front ( deque item -- newdeque )
swap push ;
: push-back ( deque item -- newdeque )
swap [ push ] flipped ;
2008-08-09 12:40:17 -04:00
<PRIVATE
: remove ( deque -- item newdeque )
[ front>> car ] [ [ front>> cdr ] [ back>> ] bi deque boa ] bi ; inline
: transfer ( deque -- item newdeque )
back>> dup nil?
[ "Popping from an empty deque" throw ]
[ split-reverse deque boa remove ] if ; inline
2008-08-09 12:40:17 -04:00
: pop ( deque -- item newdeque )
dup front>> nil? [ transfer ] [ remove ] if ; inline
2008-08-09 12:40:17 -04:00
PRIVATE>
: 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 ;
2008-08-09 12:40:17 -04:00
: sequence>deque ( sequence -- deque )
<deque> [ push-back ] reduce ;
2008-08-09 12:40:17 -04:00
: deque>sequence ( deque -- sequence )
[ dup deque-empty? not ] [ pop-front swap ] produce nip ;