basis/persistent/deques/deques.factor

   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
   6
   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.
  10
  11 <PRIVATE
  12 TUPLE: cons { car read-only } { cdr read-only } ;
  13 C: <cons> cons
  14
  15 : each ( list quot: ( elt -- ) -- )
  16     over
  17     [ [ >r car>> r> call ] [ >r cdr>> r> ] 2bi each ]
  18     [ 2drop ] if ; inline recursive
  19
  20 : reduce ( list start quot -- end )
  21     swapd each ; inline
  22
  23 : reverse ( list -- reversed )
  24     f [ swap <cons> ] reduce ;
  25
  26 : length ( list -- length )
  27     0 [ drop 1+ ] reduce ;
  28
  29 : cut ( list index -- back front-reversed )
  30     f swap [ >r [ cdr>> ] [ car>> ] bi r> <cons> ] times ;
  31
  32 : split-reverse ( list -- back-reversed front )
  33     dup length 2/ cut [ reverse ] bi@ ;
  34 PRIVATE>
  35
  36 TUPLE: deque { front read-only } { back read-only } ;
  37 : <deque> ( -- deque ) T{ deque } ;
  38
  39 <PRIVATE
  40 : flip ( deque -- newdeque )
  41     [ back>> ] [ front>> ] bi deque boa ;
  42
  43 : flipped ( deque quot -- newdeque )
  44     >r flip r> call flip ;
  45 PRIVATE>
  46
  47 : deque-empty? ( deque -- ? )
  48     [ front>> ] [ back>> ] bi or not ;
  49
  50 <PRIVATE
  51 : push ( item deque -- newdeque )
  52     [ front>> <cons> ] [ back>> ] bi deque boa ; inline
  53 PRIVATE>
  54
  55 : push-front ( deque item -- newdeque )
  56     swap push ;
  57
  58 : push-back ( deque item -- newdeque )
  59     swap [ push ] flipped ;
  60
  61 <PRIVATE
  62 : remove ( deque -- item newdeque )
  63     [ front>> car>> ] [ [ front>> cdr>> ] [ back>> ] bi deque boa ] bi ; inline
  64
  65 : transfer ( deque -- item newdeque )
  66     back>> [ split-reverse deque boa remove ]
  67     [ "Popping from an empty deque" throw ] if* ; inline
  68
  69 : pop ( deque -- item newdeque )
  70     dup front>> [ remove ] [ transfer ] if ; inline
  71 PRIVATE>
  72
  73 : pop-front ( deque -- item newdeque )
  74     pop ;
  75
  76 : pop-back ( deque -- item newdeque )
  77     [ pop ] flipped ;
  78
  79 : peek-front ( deque -- item ) pop-front drop ;
  80
  81 : peek-back ( deque -- item ) pop-back drop ;
  82
  83 : sequence>deque ( sequence -- deque )
  84     <deque> [ push-back ] sequences:reduce ;
  85
  86 : deque>sequence ( deque -- sequence )
  87     [ dup deque-empty? not ] [ pop-front swap ] [ ] sequences:produce nip ;