Search dequeues: constant-time insert/removal at both ends, membership test

db4
Slava Pestov 2008-06-10 18:32:44 -05:00
parent bdf77814e2
commit 4d0abcae4d
12 changed files with 321 additions and 195 deletions

View File

@ -0,0 +1 @@
Slava Pestov

View File

@ -0,0 +1,89 @@
IN: dequeues
USING: help.markup help.syntax kernel ;
ARTICLE: "dequeues" "Dequeues"
"A dequeue is a data structure with constant-time insertion and removal of elements at both ends. Dequeue operations are defined in the " { $vocab-link "dequeues" } " vocabulary."
$nl
"Dequeues must be instances of a mixin class:"
{ $subsection dequeue }
"Dequeues must implement a protocol."
$nl
"Querying the dequeue:"
{ $subsection peek-front }
{ $subsection peek-back }
{ $subsection dequeue-length }
{ $subsection dequeue-member? }
"Adding and removing elements:"
{ $subsection push-front* }
{ $subsection push-back* }
{ $subsection pop-front* }
{ $subsection pop-back* }
{ $subsection clear-dequeue }
"Working with node objects output by " { $link push-front* } " and " { $link push-back* } ":"
{ $subsection delete-node }
{ $subsection node-value }
"Utility operations built in terms of the above:"
{ $subsection dequeue-empty? }
{ $subsection push-front }
{ $subsection push-all-front }
{ $subsection push-back }
{ $subsection push-all-back }
{ $subsection pop-front }
{ $subsection pop-back }
{ $subsection slurp-dequeue }
"When using a dequeue as a queue, the convention is to queue elements with " { $link push-front } " and dequeue them with " { $link pop-back } "." ;
ABOUT: "dequeues"
HELP: dequeue-empty?
{ $values { "dequeue" { $link dequeue } } { "?" "a boolean" } }
{ $description "Returns true if a dequeue is empty." }
{ $notes "This operation is O(1)." } ;
HELP: push-front
{ $values { "obj" object } { "dequeue" dequeue } }
{ $description "Push the object onto the front of the dequeue." }
{ $notes "This operation is O(1)." } ;
HELP: push-front*
{ $values { "obj" object } { "dequeue" dequeue } { "node" "a node" } }
{ $description "Push the object onto the front of the dequeue and return the newly created node." }
{ $notes "This operation is O(1)." } ;
HELP: push-back
{ $values { "obj" object } { "dequeue" dequeue } }
{ $description "Push the object onto the back of the dequeue." }
{ $notes "This operation is O(1)." } ;
HELP: push-back*
{ $values { "obj" object } { "dequeue" dequeue } { "node" "a node" } }
{ $description "Push the object onto the back of the dequeue and return the newly created node." }
{ $notes "This operation is O(1)." } ;
HELP: peek-front
{ $values { "dequeue" dequeue } { "obj" object } }
{ $description "Returns the object at the front of the dequeue." } ;
HELP: pop-front
{ $values { "dequeue" dequeue } { "obj" object } }
{ $description "Pop the object off the front of the dequeue and return the object." }
{ $notes "This operation is O(1)." } ;
HELP: pop-front*
{ $values { "dequeue" dequeue } }
{ $description "Pop the object off the front of the dequeue." }
{ $notes "This operation is O(1)." } ;
HELP: peek-back
{ $values { "dequeue" dequeue } { "obj" object } }
{ $description "Returns the object at the back of the dequeue." } ;
HELP: pop-back
{ $values { "dequeue" dequeue } { "obj" object } }
{ $description "Pop the object off the back of the dequeue and return the object." }
{ $notes "This operation is O(1)." } ;
HELP: pop-back*
{ $values { "dequeue" dequeue } }
{ $description "Pop the object off the back of the dequeue." }
{ $notes "This operation is O(1)." } ;

View File

@ -0,0 +1,44 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences math ;
IN: dequeues
GENERIC: push-front* ( obj dequeue -- node )
GENERIC: push-back* ( obj dequeue -- node )
GENERIC: peek-front ( dequeue -- obj )
GENERIC: peek-back ( dequeue -- obj )
GENERIC: pop-front* ( dequeue -- )
GENERIC: pop-back* ( dequeue -- )
GENERIC: delete-node ( node dequeue -- )
GENERIC: dequeue-length ( dequeue -- n )
GENERIC: dequeue-member? ( value dequeue -- ? )
GENERIC: clear-dequeue ( dequeue -- )
GENERIC: node-value ( node -- value )
: dequeue-empty? ( dequeue -- ? )
dequeue-length zero? ;
: push-front ( obj dequeue -- )
push-front* drop ;
: push-all-front ( seq dequeue -- )
[ push-front ] curry each ;
: push-back ( obj dequeue -- )
push-back* drop ;
: push-all-back ( seq dequeue -- )
[ push-back ] curry each ;
: pop-front ( dequeue -- obj )
[ peek-front ] [ pop-front* ] bi ;
: pop-back ( dequeue -- obj )
[ peek-back ] [ pop-back* ] bi ;
: slurp-dequeue ( dequeue quot -- )
over dequeue-empty? [ 2drop ] [
[ [ pop-back ] dip call ] [ slurp-dequeue ] 2bi
] if ; inline
MIXIN: dequeue

View File

@ -0,0 +1 @@
Double-ended queue protocol and common operations

1
core/dequeues/tags.txt Normal file
View File

@ -0,0 +1 @@
collections

View File

@ -1,103 +1,27 @@
USING: help.markup help.syntax kernel quotations dlists.private ;
USING: help.markup help.syntax kernel quotations
dequeues ;
IN: dlists
ARTICLE: "dlists" "Doubly-linked lists"
"A doubly-linked list, or dlist, is a list of nodes. Each node has a link to the previous and next nodes, and a slot to store an object."
ARTICLE: "dlists" "Double-linked lists"
"A double-linked list is the canonical implementation of a " { $link dequeue } "."
$nl
"While nodes can be modified directly, the fundamental protocol support by doubly-linked lists is that of a double-ended queue with a few additional operations. Elements can be added or removed at both ends of the dlist in constant time."
$nl
"When using a dlist as a simple queue, the convention is to queue elements with " { $link push-front } " and dequeue them with " { $link pop-back } "."
$nl
"Dlists form a class:"
"Double-linked lists form a class:"
{ $subsection dlist }
{ $subsection dlist? }
"Constructing a dlist:"
"Constructing a double-linked list:"
{ $subsection <dlist> }
"Working with the front of the list:"
{ $subsection push-front }
{ $subsection push-front* }
{ $subsection peek-front }
{ $subsection pop-front }
{ $subsection pop-front* }
"Working with the back of the list:"
{ $subsection push-back }
{ $subsection push-back* }
{ $subsection peek-back }
{ $subsection pop-back }
{ $subsection pop-back* }
"Finding out the length:"
{ $subsection dlist-empty? }
{ $subsection dlist-length }
"Double-linked lists support all the operations of the dequeue protocol (" { $link "dequeues" } ") as well as the following."
$nl
"Iterating over elements:"
{ $subsection dlist-each }
{ $subsection dlist-find }
{ $subsection dlist-contains? }
"Deleting a node:"
{ $subsection delete-node }
{ $subsection dlist-delete }
"Deleting a node matching a predicate:"
{ $subsection delete-node-if* }
{ $subsection delete-node-if }
"Consuming all nodes:"
{ $subsection dlist-slurp } ;
{ $subsection delete-node-if } ;
ABOUT: "dlists"
HELP: dlist-empty?
{ $values { "dlist" { $link dlist } } { "?" "a boolean" } }
{ $description "Returns true if a " { $link dlist } " is empty." }
{ $notes "This operation is O(1)." } ;
HELP: push-front
{ $values { "obj" "an object" } { "dlist" dlist } }
{ $description "Push the object onto the front of the " { $link dlist } "." }
{ $notes "This operation is O(1)." } ;
HELP: push-front*
{ $values { "obj" "an object" } { "dlist" dlist } { "dlist-node" dlist-node } }
{ $description "Push the object onto the front of the " { $link dlist } " and return the newly created " { $snippet "dlist-node" } "." }
{ $notes "This operation is O(1)." } ;
HELP: push-back
{ $values { "obj" "an object" } { "dlist" dlist } }
{ $description "Push the object onto the back of the " { $link dlist } "." }
{ $notes "This operation is O(1)." } ;
HELP: push-back*
{ $values { "obj" "an object" } { "dlist" dlist } { "dlist-node" dlist-node } }
{ $description "Push the object onto the back of the " { $link dlist } " and return the newly created " { $snippet "dlist-node" } "." }
{ $notes "This operation is O(1)." } ;
HELP: peek-front
{ $values { "dlist" dlist } { "obj" "an object" } }
{ $description "Returns the object at the front of the " { $link dlist } "." } ;
HELP: pop-front
{ $values { "dlist" dlist } { "obj" "an object" } }
{ $description "Pop the object off the front of the " { $link dlist } " and return the object." }
{ $notes "This operation is O(1)." } ;
HELP: pop-front*
{ $values { "dlist" dlist } }
{ $description "Pop the object off the front of the " { $link dlist } "." }
{ $notes "This operation is O(1)." } ;
HELP: peek-back
{ $values { "dlist" dlist } { "obj" "an object" } }
{ $description "Returns the object at the back of the " { $link dlist } "." } ;
HELP: pop-back
{ $values { "dlist" dlist } { "obj" "an object" } }
{ $description "Pop the object off the back of the " { $link dlist } " and return the object." }
{ $notes "This operation is O(1)." } ;
HELP: pop-back*
{ $values { "dlist" dlist } }
{ $description "Pop the object off the back of the " { $link dlist } "." }
{ $notes "This operation is O(1)." } ;
{ push-front push-front* push-back push-back* peek-front pop-front pop-front* peek-back pop-back pop-back* } related-words
HELP: dlist-find
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } }
{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, until it outputs a true value or the end of the " { $link dlist } " is reached. Outputs either the object it found or " { $link f } ", and a boolean which is true if an object is found." }

View File

@ -1,17 +1,17 @@
USING: dlists dlists.private kernel tools.test random assocs
sets sequences namespaces sorting debugger io prettyprint
USING: dequeues dlists dlists.private kernel tools.test random
assocs sets sequences namespaces sorting debugger io prettyprint
math accessors classes ;
IN: dlists.tests
[ t ] [ <dlist> dlist-empty? ] unit-test
[ t ] [ <dlist> dequeue-empty? ] unit-test
[ T{ dlist f T{ dlist-node f 1 f f } T{ dlist-node f 1 f f } 1 } ]
[ <dlist> 1 over push-front ] unit-test
! Make sure empty lists are empty
[ t ] [ <dlist> dlist-empty? ] unit-test
[ f ] [ <dlist> 1 over push-front dlist-empty? ] unit-test
[ f ] [ <dlist> 1 over push-back dlist-empty? ] unit-test
[ t ] [ <dlist> dequeue-empty? ] unit-test
[ f ] [ <dlist> 1 over push-front dequeue-empty? ] unit-test
[ f ] [ <dlist> 1 over push-back dequeue-empty? ] unit-test
[ 1 ] [ <dlist> 1 over push-front pop-front ] unit-test
[ 1 ] [ <dlist> 1 over push-front pop-back ] unit-test
@ -25,22 +25,22 @@ IN: dlists.tests
! Test the prev,next links for two nodes
[ f ] [
<dlist> 1 over push-back 2 over push-back
dlist-front dlist-node-prev
front>> prev>>
] unit-test
[ 2 ] [
<dlist> 1 over push-back 2 over push-back
dlist-front dlist-node-next dlist-node-obj
front>> next>> obj>>
] unit-test
[ 1 ] [
<dlist> 1 over push-back 2 over push-back
dlist-front dlist-node-next dlist-node-prev dlist-node-obj
front>> next>> prev>> obj>>
] unit-test
[ f ] [
<dlist> 1 over push-back 2 over push-back
dlist-front dlist-node-next dlist-node-next
front>> next>> next>>
] unit-test
[ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
@ -50,55 +50,24 @@ IN: dlists.tests
[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-contains? ] unit-test
[ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dlist-empty? ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dlist-empty? ] unit-test
[ 0 ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dlist-length ] unit-test
[ 1 ] [ <dlist> 1 over push-back 2 over push-back dup [ 1 = ] delete-node-if drop dlist-length ] unit-test
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 1 = ] delete-node-if drop dlist-length ] unit-test
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 2 = ] delete-node-if drop dlist-length ] unit-test
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 3 = ] delete-node-if drop dlist-length ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dequeue-empty? ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dequeue-empty? ] unit-test
[ 0 ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dequeue-length ] unit-test
[ 1 ] [ <dlist> 1 over push-back 2 over push-back dup [ 1 = ] delete-node-if drop dequeue-length ] unit-test
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 1 = ] delete-node-if drop dequeue-length ] unit-test
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 2 = ] delete-node-if drop dequeue-length ] unit-test
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 3 = ] delete-node-if drop dequeue-length ] unit-test
[ 0 ] [ <dlist> dlist-length ] unit-test
[ 1 ] [ <dlist> 1 over push-front dlist-length ] unit-test
[ 0 ] [ <dlist> 1 over push-front dup pop-front* dlist-length ] unit-test
: assert-same-elements
[ prune natural-sort ] bi@ assert= ;
: dlist-delete-all [ dlist-delete drop ] curry each ;
: dlist>array [ [ , ] dlist-slurp ] { } make ;
[ ] [
5 [ drop 30 random >fixnum ] map prune
6 [ drop 30 random >fixnum ] map prune [
<dlist>
[ push-all-front ]
[ dlist-delete-all ]
[ dlist>array ] tri
] 2keep swap diff assert-same-elements
] unit-test
[ ] [
<dlist> "d" set
1 "d" get push-front
2 "d" get push-front
3 "d" get push-front
4 "d" get push-front
2 "d" get dlist-delete drop
3 "d" get dlist-delete drop
4 "d" get dlist-delete drop
] unit-test
[ 1 ] [ "d" get dlist-length ] unit-test
[ 1 ] [ "d" get dlist>array length ] unit-test
[ 0 ] [ <dlist> dequeue-length ] unit-test
[ 1 ] [ <dlist> 1 over push-front dequeue-length ] unit-test
[ 0 ] [ <dlist> 1 over push-front dup pop-front* dequeue-length ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node drop class dlist-node = ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node drop class dlist-node = ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node drop class dlist-node = ] unit-test
[ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
[ <dlist> peek-front ] must-fail
[ <dlist> peek-back ] must-fail
[ <dlist> peek-front ] [ empty-dlist? ] must-fail-with
[ <dlist> peek-back ] [ empty-dlist? ] must-fail-with
[ <dlist> pop-front ] [ empty-dlist? ] must-fail-with
[ <dlist> pop-back ] [ empty-dlist? ] must-fail-with

View File

@ -1,7 +1,8 @@
! Copyright (C) 2007, 2008 Mackenzie Straight, Doug Coleman,
! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel math sequences accessors inspector ;
USING: combinators kernel math sequences accessors inspector
dequeues ;
IN: dlists
TUPLE: dlist front back length ;
@ -10,7 +11,7 @@ TUPLE: dlist front back length ;
dlist new
0 >>length ;
: dlist-empty? ( dlist -- ? ) front>> not ;
M: dlist dequeue-length length>> ;
<PRIVATE
@ -18,6 +19,8 @@ TUPLE: dlist-node obj prev next ;
C: <dlist-node> dlist-node
M: dlist-node node-value obj>> ;
: inc-length ( dlist -- )
[ 1+ ] change-length drop ; inline
@ -57,69 +60,59 @@ C: <dlist-node> dlist-node
: dlist-each-node ( dlist quot -- )
[ f ] compose dlist-find-node 2drop ; inline
: unlink-node ( dlist-node -- )
dup prev>> over next>> set-prev-when
dup next>> swap prev>> set-next-when ;
PRIVATE>
: push-front* ( obj dlist -- dlist-node )
M: dlist push-front* ( obj dlist -- dlist-node )
[ front>> f swap <dlist-node> dup dup set-next-prev ] keep
[ (>>front) ] keep
[ set-back-to-front ] keep
inc-length ;
: push-front ( obj dlist -- )
push-front* drop ;
: push-all-front ( seq dlist -- )
[ push-front ] curry each ;
: push-back* ( obj dlist -- dlist-node )
M: dlist push-back* ( obj dlist -- dlist-node )
[ back>> f <dlist-node> ] keep
[ back>> set-next-when ] 2keep
[ (>>back) ] 2keep
[ set-front-to-back ] keep
inc-length ;
: push-back ( obj dlist -- )
push-back* drop ;
: push-all-back ( seq dlist -- )
[ push-back ] curry each ;
ERROR: empty-dlist ;
M: empty-dlist summary ( dlist -- )
drop "Emtpy dlist" ;
drop "Empty dlist" ;
: peek-front ( dlist -- obj )
front>> [ empty-dlist ] unless* obj>> ;
M: dlist peek-front ( dlist -- obj )
front>> [ obj>> ] [ empty-dlist ] if* ;
: pop-front ( dlist -- obj )
dup front>> [ empty-dlist ] unless*
M: dlist pop-front* ( dlist -- )
dup front>> [ empty-dlist ] unless
[
dup front>>
dup next>>
f rot (>>next)
f over set-prev-when
swap (>>front)
] 2keep obj>>
swap [ normalize-back ] keep dec-length ;
] keep
[ normalize-back ] keep
dec-length ;
: pop-front* ( dlist -- )
pop-front drop ;
M: dlist peek-back ( dlist -- obj )
back>> [ obj>> ] [ empty-dlist ] if* ;
: peek-back ( dlist -- obj )
back>> [ empty-dlist ] unless* obj>> ;
: pop-back ( dlist -- obj )
dup back>> [ empty-dlist ] unless*
M: dlist pop-back* ( dlist -- )
dup back>> [ empty-dlist ] unless
[
dup back>>
dup prev>>
f rot (>>prev)
f over set-next-when
swap (>>back)
] 2keep obj>>
swap [ normalize-front ] keep dec-length ;
: pop-back* ( dlist -- )
pop-back drop ;
] keep
[ normalize-front ] keep
dec-length ;
: dlist-find ( dlist quot -- obj/f ? )
[ obj>> ] prepose
@ -128,21 +121,20 @@ M: empty-dlist summary ( dlist -- )
: dlist-contains? ( dlist quot -- ? )
dlist-find nip ; inline
: unlink-node ( dlist-node -- )
dup prev>> over next>> set-prev-when
dup next>> swap prev>> set-next-when ;
M: dlist dequeue-member? ( value dlist -- ? )
[ = ] curry dlist-contains? ;
: delete-node ( dlist dlist-node -- )
M: dlist delete-node ( dlist-node dlist -- )
{
{ [ over front>> over eq? ] [ drop pop-front* ] }
{ [ over back>> over eq? ] [ drop pop-back* ] }
[ unlink-node dec-length ]
{ [ 2dup front>> eq? ] [ nip pop-front* ] }
{ [ 2dup back>> eq? ] [ nip pop-back* ] }
[ dec-length unlink-node ]
} cond ;
: delete-node-if* ( dlist quot -- obj/f ? )
dupd dlist-find-node [
dup [
[ delete-node ] keep obj>> t
[ swap delete-node ] keep obj>> t
] [
2drop f f
] if
@ -151,13 +143,9 @@ M: empty-dlist summary ( dlist -- )
] if ; inline
: delete-node-if ( dlist quot -- obj/f )
[ obj>> ] prepose
delete-node-if* drop ; inline
[ obj>> ] prepose delete-node-if* drop ; inline
: dlist-delete ( obj dlist -- obj/f )
swap [ eq? ] curry delete-node-if ;
: dlist-delete-all ( dlist -- )
M: dlist clear-dequeue ( dlist -- )
f >>front
f >>back
0 >>length
@ -166,9 +154,6 @@ M: empty-dlist summary ( dlist -- )
: dlist-each ( dlist quot -- )
[ obj>> ] prepose dlist-each-node ; inline
: dlist-slurp ( dlist quot -- )
over dlist-empty?
[ 2drop ] [ [ >r pop-back r> call ] 2keep dlist-slurp ] if ;
inline
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
INSTANCE: dlist dequeue

View File

@ -0,0 +1,19 @@
IN: search-dequeues
USING: help.markup help.syntax kernel dlists hashtables
dequeues assocs ;
ARTICLE: "search-dequeues" "Search dequeues"
"A search dequeue is a data structure with constant-time insertion and removal of elements at both ends, and constant-time membership tests. Inserting an element more than once has no effect. Search dequeues implement all dequeue operations in terms of an underlying dequeue, and membership testing with " { $link dequeue-member? } " is implemented with an underlying assoc. Search dequeues are defined in the " { $vocab-link "search-dequeues" } " vocabulary."
$nl
"Creating a search dequeue:"
{ $subsection <search-dequeue> }
"Default implementation:"
{ $subsection <hashed-dlist> } ;
HELP: <search-dequeue> ( assoc dequeue -- search-dequeue )
{ $values { "assoc" assoc } { "dequeue" dequeue } { "search-dequeue" search-dequeue } }
{ $description "Creates a new " { $link search-dequeue } "." } ;
HELP: <hashed-dlist> ( -- search-dequeue )
{ $values { "search-dequeue" search-dequeue } }
{ $description "Creates a new " { $link search-dequeue } " backed by a " { $link dlist } ", with a " { $link hashtable } " for fast membership tests." } ;

View File

@ -0,0 +1,35 @@
IN: search-dequeues.tests
USING: search-dequeues tools.test namespaces
kernel sequences words dequeues vocabs ;
<hashed-dlist> "h" set
[ t ] [ "h" get dequeue-empty? ] unit-test
[ ] [ 3 "h" get push-front* "1" set ] unit-test
[ ] [ 1 "h" get push-front ] unit-test
[ ] [ 3 "h" get push-front* "2" set ] unit-test
[ ] [ 3 "h" get push-front* "3" set ] unit-test
[ ] [ 7 "h" get push-front ] unit-test
[ t ] [ "1" get "2" get eq? ] unit-test
[ t ] [ "2" get "3" get eq? ] unit-test
[ 3 ] [ "h" get dequeue-length ] unit-test
[ t ] [ 7 "h" get dequeue-member? ] unit-test
[ 3 ] [ "1" get node-value ] unit-test
[ ] [ "1" get "h" get delete-node ] unit-test
[ 2 ] [ "h" get dequeue-length ] unit-test
[ 1 ] [ "h" get pop-back ] unit-test
[ 7 ] [ "h" get pop-back ] unit-test
[ f ] [ 7 "h" get dequeue-member? ] unit-test
[ ] [
<hashed-dlist>
[ all-words swap [ push-front ] curry each ]
[ [ drop ] slurp-dequeue ]
bi
] unit-test

View File

@ -0,0 +1,53 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel assocs dequeues dlists hashtables ;
IN: search-dequeues
TUPLE: search-dequeue assoc dequeue ;
C: <search-dequeue> search-dequeue
: <hashed-dlist> ( -- search-dequeue )
0 <hashtable> <dlist> <search-dequeue> ;
M: search-dequeue dequeue-length dequeue>> dequeue-length ;
M: search-dequeue peek-front dequeue>> peek-front ;
M: search-dequeue peek-back dequeue>> peek-back ;
M: search-dequeue push-front*
2dup assoc>> at* [ 2nip ] [
drop
[ dequeue>> push-front* ] [ assoc>> ] 2bi
[ 2drop ] [ set-at ] 3bi
] if ;
M: search-dequeue push-back*
2dup assoc>> at* [ 2nip ] [
drop
[ dequeue>> push-back* ] [ assoc>> ] 2bi
[ 2drop ] [ set-at ] 3bi
] if ;
M: search-dequeue pop-front*
[ [ dequeue>> peek-front ] [ assoc>> ] bi delete-at ]
[ dequeue>> pop-front* ]
bi ;
M: search-dequeue pop-back*
[ [ dequeue>> peek-back ] [ assoc>> ] bi delete-at ]
[ dequeue>> pop-back* ]
bi ;
M: search-dequeue delete-node
[ dequeue>> delete-node ]
[ [ node-value ] [ assoc>> ] bi* delete-at ] 2bi ;
M: search-dequeue clear-dequeue
[ dequeue>> clear-dequeue ] [ assoc>> clear-assoc ] bi ;
M: search-dequeue dequeue-member?
assoc>> key? ;
INSTANCE: search-dequeue dequeue

View File

@ -157,12 +157,17 @@ ARTICLE: "collections" "Collections"
{ $subsection "hashtables" }
{ $subsection "alists" }
{ $subsection "enums" }
{ $heading "Double-ended queues" }
{ $subsection "dequeues" }
"Implementations:"
{ $subsection "dlists" }
{ $subsection "search-dequeues" }
{ $heading "Other collections" }
{ $subsection "boxes" }
{ $subsection "dlists" }
{ $subsection "heaps" }
{ $subsection "graphs" }
{ $subsection "buffers" } ;
{ $subsection "buffers" }
"There are many other collections in " { $snippet "extra/" } ", such as " { $vocab-link "disjoint-set" } ", " { $vocab-link "persistent-vectors" } ", and " { $vocab-link "tuple-arrays" } "." ;
USING: io.sockets io.launcher io.mmap io.monitors
io.encodings.utf8 io.encodings.utf16 io.encodings.binary io.encodings.ascii io.files ;