Update Unicode docs
[factor/jcg.git] / basis / persistent / deques / deques.factor
blobbe63d807b9796aca54e38fdb224b88795c63b095
1 ! Copyback (C) 2008 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel accessors math ;
4 QUALIFIED: sequences
5 IN: persistent.deques
7 ! Amortized O(1) push/pop on both ends for single-threaded access
8 ! In a pathological case, if there are m modified versions from the
9 !   same source, it could take O(m) amortized time per update.
11 <PRIVATE
12 TUPLE: cons { car read-only } { cdr read-only } ;
13 C: <cons> cons
15 : each ( list quot: ( elt -- ) -- )
16     over
17     [ [ [ car>> ] dip call ] [ [ cdr>> ] dip ] 2bi each ]
18     [ 2drop ] if ; inline recursive
20 : reduce ( list start quot -- end )
21     swapd each ; inline
23 : reverse ( list -- reversed )
24     f [ swap <cons> ] reduce ;
26 : length ( list -- length )
27     0 [ drop 1+ ] reduce ;
29 : cut ( list index -- back front-reversed )
30     f swap [ [ [ cdr>> ] [ car>> ] bi ] dip <cons> ] times ;
32 : split-reverse ( list -- back-reversed front )
33     dup length 2/ cut [ reverse ] bi@ ;
34 PRIVATE>
36 TUPLE: deque { front read-only } { back read-only } ;
37 : <deque> ( -- deque ) T{ deque } ;
39 <PRIVATE
40 : flip ( deque -- newdeque )
41     [ back>> ] [ front>> ] bi deque boa ;
43 : flipped ( deque quot -- newdeque )
44     [ flip ] dip call flip ;
45 PRIVATE>
47 : deque-empty? ( deque -- ? )
48     [ front>> ] [ back>> ] bi or not ;
50 <PRIVATE
51 : push ( item deque -- newdeque )
52     [ front>> <cons> ] [ back>> ] bi deque boa ; inline
53 PRIVATE>
55 : push-front ( deque item -- newdeque )
56     swap push ;
58 : push-back ( deque item -- newdeque )
59     swap [ push ] flipped ;
61 <PRIVATE
62 : remove ( deque -- item newdeque )
63     [ front>> car>> ] [ [ front>> cdr>> ] [ back>> ] bi deque boa ] bi ; inline
65 : transfer ( deque -- item newdeque )
66     back>> [ split-reverse deque boa remove ]
67     [ "Popping from an empty deque" throw ] if* ; inline
69 : pop ( deque -- item newdeque )
70     dup front>> [ remove ] [ transfer ] if ; inline
71 PRIVATE>
73 : pop-front ( deque -- item newdeque )
74     pop ;
76 : pop-back ( deque -- item newdeque )
77     [ pop ] flipped ;
79 : peek-front ( deque -- item ) pop-front drop ;
81 : peek-back ( deque -- item ) pop-back drop ;
83 : sequence>deque ( sequence -- deque )
84     <deque> [ push-back ] sequences:reduce ;
86 : deque>sequence ( deque -- sequence )
87     [ dup deque-empty? not ] [ pop-front swap ] [ ] sequences:produce nip ;