Fix conflict
commit
799cefc39a
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel namespaces arrays sequences io debugger words fry
|
USING: kernel namespaces arrays sequences io debugger words fry
|
||||||
compiler.units continuations vocabs assocs dlists definitions
|
compiler.units continuations vocabs assocs dlists definitions
|
||||||
math threads graphs generic combinators dequeues search-dequeues
|
math threads graphs generic combinators deques search-deques
|
||||||
stack-checker stack-checker.state compiler.generator
|
stack-checker stack-checker.state compiler.generator
|
||||||
compiler.errors compiler.tree.builder compiler.tree.optimizer ;
|
compiler.errors compiler.tree.builder compiler.tree.optimizer ;
|
||||||
IN: compiler
|
IN: compiler
|
||||||
|
@ -60,8 +60,8 @@ SYMBOL: +failed+
|
||||||
} cleave
|
} cleave
|
||||||
] with-return ;
|
] with-return ;
|
||||||
|
|
||||||
: compile-loop ( dequeue -- )
|
: compile-loop ( deque -- )
|
||||||
[ (compile) yield ] slurp-dequeue ;
|
[ (compile) yield ] slurp-deque ;
|
||||||
|
|
||||||
: decompile ( word -- )
|
: decompile ( word -- )
|
||||||
f 2array 1array t modify-code-heap ;
|
f 2array 1array t modify-code-heap ;
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors arrays assocs classes combinators
|
USING: accessors arrays assocs classes combinators
|
||||||
cpu.architecture effects generic hashtables io kernel
|
cpu.architecture effects generic hashtables io kernel
|
||||||
kernel.private layouts math math.parser namespaces prettyprint
|
kernel.private layouts math math.parser namespaces prettyprint
|
||||||
quotations sequences system threads words vectors sets dequeues
|
quotations sequences system threads words vectors sets deques
|
||||||
continuations.private summary alien alien.c-types
|
continuations.private summary alien alien.c-types
|
||||||
alien.structs alien.strings alien.arrays libc compiler.errors
|
alien.structs alien.strings alien.arrays libc compiler.errors
|
||||||
stack-checker.inlining
|
stack-checker.inlining
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: fry accessors namespaces assocs dequeues search-dequeues
|
USING: fry accessors namespaces assocs deques search-deques
|
||||||
kernel sequences sequences.deep words sets stack-checker.branches
|
kernel sequences sequences.deep words sets stack-checker.branches
|
||||||
compiler.tree compiler.tree.def-use compiler.tree.combinators ;
|
compiler.tree compiler.tree.def-use compiler.tree.combinators ;
|
||||||
IN: compiler.tree.dead-code.liveness
|
IN: compiler.tree.dead-code.liveness
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel namespaces search-dequeues assocs fry sequences
|
USING: kernel namespaces assocs fry sequences
|
||||||
disjoint-sets
|
|
||||||
compiler.tree
|
compiler.tree
|
||||||
compiler.tree.escape-analysis.allocations
|
compiler.tree.escape-analysis.allocations
|
||||||
compiler.tree.escape-analysis.recursive
|
compiler.tree.escape-analysis.recursive
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel accessors sequences classes.tuple
|
USING: kernel accessors sequences classes.tuple
|
||||||
classes.tuple.private arrays math math.private slots.private
|
classes.tuple.private arrays math math.private slots.private
|
||||||
combinators dequeues search-dequeues namespaces fry classes
|
combinators deques search-deques namespaces fry classes
|
||||||
classes.algebra stack-checker.state
|
classes.algebra stack-checker.state
|
||||||
compiler.tree
|
compiler.tree
|
||||||
compiler.tree.intrinsics
|
compiler.tree.intrinsics
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences namespaces assocs accessors fry
|
USING: kernel sequences namespaces assocs accessors fry
|
||||||
compiler.tree dequeues search-dequeues ;
|
compiler.tree deques search-deques ;
|
||||||
IN: compiler.tree.loop.detection
|
IN: compiler.tree.loop.detection
|
||||||
|
|
||||||
! A loop is a #recursive which only tail calls itself, and those
|
! A loop is a #recursive which only tail calls itself, and those
|
||||||
|
|
|
@ -1,13 +1,13 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: dequeues threads kernel arrays sequences alarms ;
|
USING: deques threads kernel arrays sequences alarms ;
|
||||||
IN: concurrency.conditions
|
IN: concurrency.conditions
|
||||||
|
|
||||||
: notify-1 ( dequeue -- )
|
: notify-1 ( deque -- )
|
||||||
dup dequeue-empty? [ drop ] [ pop-back resume-now ] if ;
|
dup deque-empty? [ drop ] [ pop-back resume-now ] if ;
|
||||||
|
|
||||||
: notify-all ( dequeue -- )
|
: notify-all ( deque -- )
|
||||||
[ resume-now ] slurp-dequeue ;
|
[ resume-now ] slurp-deque ;
|
||||||
|
|
||||||
: queue-timeout ( queue timeout -- alarm )
|
: queue-timeout ( queue timeout -- alarm )
|
||||||
#! Add an alarm which removes the current thread from the
|
#! Add an alarm which removes the current thread from the
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: dequeues dlists kernel threads continuations math
|
USING: deques dlists kernel threads continuations math
|
||||||
concurrency.conditions ;
|
concurrency.conditions ;
|
||||||
IN: concurrency.locks
|
IN: concurrency.locks
|
||||||
|
|
||||||
|
@ -80,7 +80,7 @@ TUPLE: rw-lock readers writers reader# writer ;
|
||||||
|
|
||||||
: release-write-lock ( lock -- )
|
: release-write-lock ( lock -- )
|
||||||
f over set-rw-lock-writer
|
f over set-rw-lock-writer
|
||||||
dup rw-lock-readers dequeue-empty?
|
dup rw-lock-readers deque-empty?
|
||||||
[ notify-writer ] [ rw-lock-readers notify-all ] if ;
|
[ notify-writer ] [ rw-lock-readers notify-all ] if ;
|
||||||
|
|
||||||
: reentrant-read-lock-ok? ( lock -- ? )
|
: reentrant-read-lock-ok? ( lock -- ? )
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
|
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: concurrency.mailboxes
|
IN: concurrency.mailboxes
|
||||||
USING: dlists dequeues threads sequences continuations
|
USING: dlists deques threads sequences continuations
|
||||||
destructors namespaces random math quotations words kernel
|
destructors namespaces random math quotations words kernel
|
||||||
arrays assocs init system concurrency.conditions accessors
|
arrays assocs init system concurrency.conditions accessors
|
||||||
debugger debugger.threads locals ;
|
debugger debugger.threads locals ;
|
||||||
|
@ -14,7 +14,7 @@ M: mailbox dispose* threads>> notify-all ;
|
||||||
<dlist> <dlist> f mailbox boa ;
|
<dlist> <dlist> f mailbox boa ;
|
||||||
|
|
||||||
: mailbox-empty? ( mailbox -- bool )
|
: mailbox-empty? ( mailbox -- bool )
|
||||||
data>> dequeue-empty? ;
|
data>> deque-empty? ;
|
||||||
|
|
||||||
: mailbox-put ( obj mailbox -- )
|
: mailbox-put ( obj mailbox -- )
|
||||||
[ data>> push-front ]
|
[ data>> push-front ]
|
||||||
|
|
|
@ -2,12 +2,12 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
!
|
!
|
||||||
USING: kernel threads vectors arrays sequences
|
USING: kernel threads vectors arrays sequences
|
||||||
namespaces tools.test continuations dequeues strings math words
|
namespaces tools.test continuations deques strings math words
|
||||||
match quotations concurrency.messaging concurrency.mailboxes
|
match quotations concurrency.messaging concurrency.mailboxes
|
||||||
concurrency.count-downs accessors ;
|
concurrency.count-downs accessors ;
|
||||||
IN: concurrency.messaging.tests
|
IN: concurrency.messaging.tests
|
||||||
|
|
||||||
[ ] [ my-mailbox mailbox-data clear-dequeue ] unit-test
|
[ ] [ my-mailbox mailbox-data clear-deque ] unit-test
|
||||||
|
|
||||||
[ "received" ] [
|
[ "received" ] [
|
||||||
[
|
[
|
||||||
|
@ -64,4 +64,4 @@ SYMBOL: exit
|
||||||
! receive drop
|
! receive drop
|
||||||
! ] "Bad synchronous send" spawn "t" set
|
! ] "Bad synchronous send" spawn "t" set
|
||||||
|
|
||||||
! [ 3 "t" get send-synchronous ] must-fail
|
! [ 3 "t" get send-synchronous ] must-fail
|
||||||
|
|
|
@ -0,0 +1,89 @@
|
||||||
|
IN: deques
|
||||||
|
USING: help.markup help.syntax kernel ;
|
||||||
|
|
||||||
|
ARTICLE: "deques" "Dequeues"
|
||||||
|
"A deque is a data structure with constant-time insertion and removal of elements at both ends. Dequeue operations are defined in the " { $vocab-link "deques" } " vocabulary."
|
||||||
|
$nl
|
||||||
|
"Dequeues must be instances of a mixin class:"
|
||||||
|
{ $subsection deque }
|
||||||
|
"Dequeues must implement a protocol."
|
||||||
|
$nl
|
||||||
|
"Querying the deque:"
|
||||||
|
{ $subsection peek-front }
|
||||||
|
{ $subsection peek-back }
|
||||||
|
{ $subsection deque-length }
|
||||||
|
{ $subsection deque-member? }
|
||||||
|
"Adding and removing elements:"
|
||||||
|
{ $subsection push-front* }
|
||||||
|
{ $subsection push-back* }
|
||||||
|
{ $subsection pop-front* }
|
||||||
|
{ $subsection pop-back* }
|
||||||
|
{ $subsection clear-deque }
|
||||||
|
"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 deque-empty? }
|
||||||
|
{ $subsection push-front }
|
||||||
|
{ $subsection push-all-front }
|
||||||
|
{ $subsection push-back }
|
||||||
|
{ $subsection push-all-back }
|
||||||
|
{ $subsection pop-front }
|
||||||
|
{ $subsection pop-back }
|
||||||
|
{ $subsection slurp-deque }
|
||||||
|
"When using a deque as a queue, the convention is to queue elements with " { $link push-front } " and deque them with " { $link pop-back } "." ;
|
||||||
|
|
||||||
|
ABOUT: "deques"
|
||||||
|
|
||||||
|
HELP: deque-empty?
|
||||||
|
{ $values { "deque" { $link deque } } { "?" "a boolean" } }
|
||||||
|
{ $description "Returns true if a deque is empty." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: push-front
|
||||||
|
{ $values { "obj" object } { "deque" deque } }
|
||||||
|
{ $description "Push the object onto the front of the deque." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: push-front*
|
||||||
|
{ $values { "obj" object } { "deque" deque } { "node" "a node" } }
|
||||||
|
{ $description "Push the object onto the front of the deque and return the newly created node." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: push-back
|
||||||
|
{ $values { "obj" object } { "deque" deque } }
|
||||||
|
{ $description "Push the object onto the back of the deque." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: push-back*
|
||||||
|
{ $values { "obj" object } { "deque" deque } { "node" "a node" } }
|
||||||
|
{ $description "Push the object onto the back of the deque and return the newly created node." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: peek-front
|
||||||
|
{ $values { "deque" deque } { "obj" object } }
|
||||||
|
{ $description "Returns the object at the front of the deque." } ;
|
||||||
|
|
||||||
|
HELP: pop-front
|
||||||
|
{ $values { "deque" deque } { "obj" object } }
|
||||||
|
{ $description "Pop the object off the front of the deque and return the object." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: pop-front*
|
||||||
|
{ $values { "deque" deque } }
|
||||||
|
{ $description "Pop the object off the front of the deque." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: peek-back
|
||||||
|
{ $values { "deque" deque } { "obj" object } }
|
||||||
|
{ $description "Returns the object at the back of the deque." } ;
|
||||||
|
|
||||||
|
HELP: pop-back
|
||||||
|
{ $values { "deque" deque } { "obj" object } }
|
||||||
|
{ $description "Pop the object off the back of the deque and return the object." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
||||||
|
|
||||||
|
HELP: pop-back*
|
||||||
|
{ $values { "deque" deque } }
|
||||||
|
{ $description "Pop the object off the back of the deque." }
|
||||||
|
{ $notes "This operation is O(1)." } ;
|
|
@ -0,0 +1,43 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel sequences math ;
|
||||||
|
IN: deques
|
||||||
|
|
||||||
|
GENERIC: push-front* ( obj deque -- node )
|
||||||
|
GENERIC: push-back* ( obj deque -- node )
|
||||||
|
GENERIC: peek-front ( deque -- obj )
|
||||||
|
GENERIC: peek-back ( deque -- obj )
|
||||||
|
GENERIC: pop-front* ( deque -- )
|
||||||
|
GENERIC: pop-back* ( deque -- )
|
||||||
|
GENERIC: delete-node ( node deque -- )
|
||||||
|
GENERIC: deque-length ( deque -- n )
|
||||||
|
GENERIC: deque-member? ( value deque -- ? )
|
||||||
|
GENERIC: clear-deque ( deque -- )
|
||||||
|
GENERIC: node-value ( node -- value )
|
||||||
|
|
||||||
|
: deque-empty? ( deque -- ? )
|
||||||
|
deque-length zero? ;
|
||||||
|
|
||||||
|
: push-front ( obj deque -- )
|
||||||
|
push-front* drop ;
|
||||||
|
|
||||||
|
: push-all-front ( seq deque -- )
|
||||||
|
[ push-front ] curry each ;
|
||||||
|
|
||||||
|
: push-back ( obj deque -- )
|
||||||
|
push-back* drop ;
|
||||||
|
|
||||||
|
: push-all-back ( seq deque -- )
|
||||||
|
[ push-back ] curry each ;
|
||||||
|
|
||||||
|
: pop-front ( deque -- obj )
|
||||||
|
[ peek-front ] [ pop-front* ] bi ;
|
||||||
|
|
||||||
|
: pop-back ( deque -- obj )
|
||||||
|
[ peek-back ] [ pop-back* ] bi ;
|
||||||
|
|
||||||
|
: slurp-deque ( deque quot -- )
|
||||||
|
[ drop [ deque-empty? not ] curry ]
|
||||||
|
[ [ pop-back ] prepose curry ] 2bi [ ] while ; inline
|
||||||
|
|
||||||
|
MIXIN: deque
|
|
@ -1,89 +0,0 @@
|
||||||
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)." } ;
|
|
|
@ -1,43 +0,0 @@
|
||||||
! 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 -- )
|
|
||||||
[ drop [ dequeue-empty? not ] curry ]
|
|
||||||
[ [ pop-back ] prepose curry ] 2bi [ ] while ; inline
|
|
||||||
|
|
||||||
MIXIN: dequeue
|
|
|
@ -1,16 +1,16 @@
|
||||||
USING: help.markup help.syntax kernel quotations
|
USING: help.markup help.syntax kernel quotations
|
||||||
dequeues ;
|
deques ;
|
||||||
IN: dlists
|
IN: dlists
|
||||||
|
|
||||||
ARTICLE: "dlists" "Double-linked lists"
|
ARTICLE: "dlists" "Double-linked lists"
|
||||||
"A double-linked list is the canonical implementation of a " { $link dequeue } "."
|
"A double-linked list is the canonical implementation of a " { $link deque } "."
|
||||||
$nl
|
$nl
|
||||||
"Double-linked lists form a class:"
|
"Double-linked lists form a class:"
|
||||||
{ $subsection dlist }
|
{ $subsection dlist }
|
||||||
{ $subsection dlist? }
|
{ $subsection dlist? }
|
||||||
"Constructing a double-linked list:"
|
"Constructing a double-linked list:"
|
||||||
{ $subsection <dlist> }
|
{ $subsection <dlist> }
|
||||||
"Double-linked lists support all the operations of the dequeue protocol (" { $link "dequeues" } ") as well as the following."
|
"Double-linked lists support all the operations of the deque protocol (" { $link "deques" } ") as well as the following."
|
||||||
$nl
|
$nl
|
||||||
"Iterating over elements:"
|
"Iterating over elements:"
|
||||||
{ $subsection dlist-each }
|
{ $subsection dlist-each }
|
||||||
|
|
|
@ -1,17 +1,17 @@
|
||||||
USING: dequeues dlists dlists.private kernel tools.test random
|
USING: deques dlists dlists.private kernel tools.test random
|
||||||
assocs sets sequences namespaces sorting debugger io prettyprint
|
assocs sets sequences namespaces sorting debugger io prettyprint
|
||||||
math accessors classes ;
|
math accessors classes ;
|
||||||
IN: dlists.tests
|
IN: dlists.tests
|
||||||
|
|
||||||
[ t ] [ <dlist> dequeue-empty? ] unit-test
|
[ t ] [ <dlist> deque-empty? ] unit-test
|
||||||
|
|
||||||
[ T{ dlist f T{ dlist-node f 1 f f } T{ dlist-node f 1 f f } 1 } ]
|
[ 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
|
[ <dlist> 1 over push-front ] unit-test
|
||||||
|
|
||||||
! Make sure empty lists are empty
|
! Make sure empty lists are empty
|
||||||
[ t ] [ <dlist> dequeue-empty? ] unit-test
|
[ t ] [ <dlist> deque-empty? ] unit-test
|
||||||
[ f ] [ <dlist> 1 over push-front dequeue-empty? ] unit-test
|
[ f ] [ <dlist> 1 over push-front deque-empty? ] unit-test
|
||||||
[ f ] [ <dlist> 1 over push-back dequeue-empty? ] unit-test
|
[ f ] [ <dlist> 1 over push-back deque-empty? ] unit-test
|
||||||
|
|
||||||
[ 1 ] [ <dlist> 1 over push-front pop-front ] unit-test
|
[ 1 ] [ <dlist> 1 over push-front pop-front ] unit-test
|
||||||
[ 1 ] [ <dlist> 1 over push-front pop-back ] unit-test
|
[ 1 ] [ <dlist> 1 over push-front pop-back ] unit-test
|
||||||
|
@ -50,17 +50,17 @@ IN: dlists.tests
|
||||||
[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-contains? ] unit-test
|
[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-contains? ] unit-test
|
||||||
|
|
||||||
[ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] 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 dequeue-empty? ] unit-test
|
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] 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 deque-empty? ] unit-test
|
||||||
[ 0 ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dequeue-length ] unit-test
|
[ 0 ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-length ] unit-test
|
||||||
[ 1 ] [ <dlist> 1 over push-back 2 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 deque-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 [ 1 = ] delete-node-if drop deque-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 [ 2 = ] delete-node-if drop deque-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
|
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 3 = ] delete-node-if drop deque-length ] unit-test
|
||||||
|
|
||||||
[ 0 ] [ <dlist> dequeue-length ] unit-test
|
[ 0 ] [ <dlist> deque-length ] unit-test
|
||||||
[ 1 ] [ <dlist> 1 over push-front dequeue-length ] unit-test
|
[ 1 ] [ <dlist> 1 over push-front deque-length ] unit-test
|
||||||
[ 0 ] [ <dlist> 1 over push-front dup pop-front* dequeue-length ] unit-test
|
[ 0 ] [ <dlist> 1 over push-front dup pop-front* deque-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>> 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 [ obj>> 5 = ] dlist-find-node drop class dlist-node = ] unit-test
|
||||||
|
@ -72,8 +72,8 @@ IN: dlists.tests
|
||||||
[ <dlist> pop-front ] [ empty-dlist? ] must-fail-with
|
[ <dlist> pop-front ] [ empty-dlist? ] must-fail-with
|
||||||
[ <dlist> pop-back ] [ empty-dlist? ] must-fail-with
|
[ <dlist> pop-back ] [ empty-dlist? ] must-fail-with
|
||||||
|
|
||||||
[ t ] [ <dlist> 3 over push-front 4 over push-back 3 swap dequeue-member? ] unit-test
|
[ t ] [ <dlist> 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test
|
||||||
|
|
||||||
[ f ] [ <dlist> 3 over push-front 4 over push-back -1 swap dequeue-member? ] unit-test
|
[ f ] [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test
|
||||||
|
|
||||||
[ f ] [ <dlist> 0 swap dequeue-member? ] unit-test
|
[ f ] [ <dlist> 0 swap deque-member? ] unit-test
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007, 2008 Mackenzie Straight, Doug Coleman,
|
! Copyright (C) 2007, 2008 Mackenzie Straight, Doug Coleman,
|
||||||
! Slava Pestov.
|
! Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: combinators kernel math sequences accessors dequeues
|
USING: combinators kernel math sequences accessors deques
|
||||||
summary ;
|
summary ;
|
||||||
IN: dlists
|
IN: dlists
|
||||||
|
|
||||||
|
@ -11,7 +11,7 @@ TUPLE: dlist front back length ;
|
||||||
dlist new
|
dlist new
|
||||||
0 >>length ;
|
0 >>length ;
|
||||||
|
|
||||||
M: dlist dequeue-length length>> ;
|
M: dlist deque-length length>> ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
@ -121,7 +121,7 @@ M: dlist pop-back* ( dlist -- )
|
||||||
: dlist-contains? ( dlist quot -- ? )
|
: dlist-contains? ( dlist quot -- ? )
|
||||||
dlist-find nip ; inline
|
dlist-find nip ; inline
|
||||||
|
|
||||||
M: dlist dequeue-member? ( value dlist -- ? )
|
M: dlist deque-member? ( value dlist -- ? )
|
||||||
[ = ] with dlist-contains? ;
|
[ = ] with dlist-contains? ;
|
||||||
|
|
||||||
M: dlist delete-node ( dlist-node dlist -- )
|
M: dlist delete-node ( dlist-node dlist -- )
|
||||||
|
@ -145,7 +145,7 @@ M: dlist delete-node ( dlist-node dlist -- )
|
||||||
: delete-node-if ( dlist quot -- obj/f )
|
: delete-node-if ( dlist quot -- obj/f )
|
||||||
[ obj>> ] prepose delete-node-if* drop ; inline
|
[ obj>> ] prepose delete-node-if* drop ; inline
|
||||||
|
|
||||||
M: dlist clear-dequeue ( dlist -- )
|
M: dlist clear-deque ( dlist -- )
|
||||||
f >>front
|
f >>front
|
||||||
f >>back
|
f >>back
|
||||||
0 >>length
|
0 >>length
|
||||||
|
@ -156,4 +156,4 @@ M: dlist clear-dequeue ( dlist -- )
|
||||||
|
|
||||||
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
||||||
|
|
||||||
INSTANCE: dlist dequeue
|
INSTANCE: dlist deque
|
||||||
|
|
|
@ -128,10 +128,10 @@ ARTICLE: "collections" "Collections"
|
||||||
{ $subsection "alists" }
|
{ $subsection "alists" }
|
||||||
{ $subsection "enums" }
|
{ $subsection "enums" }
|
||||||
{ $heading "Double-ended queues" }
|
{ $heading "Double-ended queues" }
|
||||||
{ $subsection "dequeues" }
|
{ $subsection "deques" }
|
||||||
"Implementations:"
|
"Implementations:"
|
||||||
{ $subsection "dlists" }
|
{ $subsection "dlists" }
|
||||||
{ $subsection "search-dequeues" }
|
{ $subsection "search-deques" }
|
||||||
{ $heading "Other collections" }
|
{ $heading "Other collections" }
|
||||||
{ $subsection "boxes" }
|
{ $subsection "boxes" }
|
||||||
{ $subsection "heaps" }
|
{ $subsection "heaps" }
|
||||||
|
|
|
@ -2,7 +2,7 @@ USING: help.markup help.syntax kernel sequences ;
|
||||||
IN: persistent.deques
|
IN: persistent.deques
|
||||||
|
|
||||||
ARTICLE: "persistent.deques" "Persistent deques"
|
ARTICLE: "persistent.deques" "Persistent deques"
|
||||||
"A deque is a data structure that can be used as both a queue and a stack. That is, there are two ends, the left and the right, and values can be pushed onto and popped off of both ends. These operations take O(1) amortized time and space in a normal usage pattern."
|
"A deque is a data structure that can be used as both a queue and a stack. That is, there are two ends, the front and the back, and values can be pushed onto and popped off of both ends. These operations take O(1) amortized time and space in a normal usage pattern."
|
||||||
$nl
|
$nl
|
||||||
"This vocabulary provides a deque implementation which is persistent and purely functional: old versions of deques are not modified by operations. Instead, each push and pop operation creates a new deque based off the old one."
|
"This vocabulary provides a deque implementation which is persistent and purely functional: old versions of deques are not modified by operations. Instead, each push and pop operation creates a new deque based off the old one."
|
||||||
$nl
|
$nl
|
||||||
|
@ -14,10 +14,10 @@ $nl
|
||||||
"To test if a deque is empty:"
|
"To test if a deque is empty:"
|
||||||
{ $subsection deque-empty? }
|
{ $subsection deque-empty? }
|
||||||
"To manipulate deques:"
|
"To manipulate deques:"
|
||||||
{ $subsection push-left }
|
{ $subsection push-front }
|
||||||
{ $subsection push-right }
|
{ $subsection push-back }
|
||||||
{ $subsection pop-left }
|
{ $subsection pop-front }
|
||||||
{ $subsection pop-right }
|
{ $subsection pop-back }
|
||||||
{ $subsection deque>sequence } ;
|
{ $subsection deque>sequence } ;
|
||||||
|
|
||||||
HELP: deque
|
HELP: deque
|
||||||
|
@ -29,28 +29,28 @@ HELP: <deque>
|
||||||
|
|
||||||
HELP: sequence>deque
|
HELP: sequence>deque
|
||||||
{ $values { "sequence" sequence } { "deque" deque } }
|
{ $values { "sequence" sequence } { "deque" deque } }
|
||||||
{ $description "Given a sequence, creates a deque containing those elements in the order such that the beginning of the sequence is on the left and the end is on the right." } ;
|
{ $description "Given a sequence, creates a deque containing those elements in the order such that the beginning of the sequence is on the front and the end is on the back." } ;
|
||||||
|
|
||||||
HELP: deque>sequence
|
HELP: deque>sequence
|
||||||
{ $values { "deque" deque } { "sequence" sequence } }
|
{ $values { "deque" deque } { "sequence" sequence } }
|
||||||
{ $description "Given a deque, creates a sequence containing those elements, such that the left side of the deque is the beginning of the sequence." } ;
|
{ $description "Given a deque, creates a sequence containing those elements, such that the front side of the deque is the beginning of the sequence." } ;
|
||||||
|
|
||||||
HELP: deque-empty?
|
HELP: deque-empty?
|
||||||
{ $values { "deque" deque } { "?" "t/f" } }
|
{ $values { "deque" deque } { "?" "t/f" } }
|
||||||
{ $description "Returns true if the deque is empty. This takes constant time." } ;
|
{ $description "Returns true if the deque is empty. This takes constant time." } ;
|
||||||
|
|
||||||
HELP: push-left
|
HELP: push-front
|
||||||
{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
|
{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
|
||||||
{ $description "Creates a new deque with the given object pushed onto the left side. This takes constant time." } ;
|
{ $description "Creates a new deque with the given object pushed onto the front side. This takes constant time." } ;
|
||||||
|
|
||||||
HELP: push-right
|
HELP: push-back
|
||||||
{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
|
{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
|
||||||
{ $description "Creates a new deque with the given object pushed onto the right side. This takes constant time." } ;
|
{ $description "Creates a new deque with the given object pushed onto the back side. This takes constant time." } ;
|
||||||
|
|
||||||
HELP: pop-left
|
HELP: pop-front
|
||||||
{ $values { "deque" object } { "item" object } { "newdeque" deque } }
|
{ $values { "deque" object } { "item" object } { "newdeque" deque } }
|
||||||
{ $description "Creates a new deque with the leftmost item removed. This takes amortized constant time with single-threaded access." } ;
|
{ $description "Creates a new deque with the frontmost item removed. This takes amortized constant time with single-threaded access." } ;
|
||||||
|
|
||||||
HELP: pop-right
|
HELP: pop-back
|
||||||
{ $values { "deque" object } { "item" object } { "newdeque" deque } }
|
{ $values { "deque" object } { "item" object } { "newdeque" deque } }
|
||||||
{ $description "Creates a new deque with the rightmost item removed. This takes amortized constant time with single-threaded access." } ;
|
{ $description "Creates a new deque with the backmost item removed. This takes amortized constant time with single-threaded access." } ;
|
||||||
|
|
|
@ -1,35 +1,38 @@
|
||||||
! Copyright (C) 2008 Daniel Ehrenberg
|
! Copyback (C) 2008 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: tools.test persistent.deques kernel math ;
|
USING: tools.test persistent.deques kernel math ;
|
||||||
IN: persistent.deques.tests
|
IN: persistent.deques.tests
|
||||||
|
|
||||||
[ 3 2 1 t ]
|
[ 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 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 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
|
unit-test
|
||||||
|
|
||||||
[ { 2 3 4 5 6 1 } ]
|
[ { 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
|
unit-test
|
||||||
|
|
||||||
[ 1 t ] [ <deque> 1 push-left pop-right deque-empty? ] unit-test
|
[ 1 ] [ { 1 2 3 4 } sequence>deque peek-front ] unit-test
|
||||||
[ 1 t ] [ <deque> 1 push-left pop-left deque-empty? ] unit-test
|
[ 4 ] [ { 1 2 3 4 } sequence>deque peek-back ] 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 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 ]
|
[ 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 ]
|
[ 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 ]
|
[ 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 ]
|
[ 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
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2008 Daniel Ehrenberg
|
! Copyback (C) 2008 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel accessors math qualified ;
|
USING: kernel accessors math qualified ;
|
||||||
QUALIFIED: sequences
|
QUALIFIED: sequences
|
||||||
|
@ -33,44 +33,55 @@ C: <cons> cons
|
||||||
dup length 2/ cut [ reverse ] bi@ ;
|
dup length 2/ cut [ reverse ] bi@ ;
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
TUPLE: deque { lhs read-only } { rhs read-only } ;
|
TUPLE: deque { front read-only } { back read-only } ;
|
||||||
: <deque> ( -- deque ) T{ deque } ;
|
: <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 -- ? )
|
: deque-empty? ( deque -- ? )
|
||||||
[ lhs>> ] [ rhs>> ] bi or not ;
|
[ front>> ] [ back>> ] 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 ;
|
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
: (pop-left) ( deque -- item newdeque )
|
: push ( item deque -- newdeque )
|
||||||
[ lhs>> car>> ] [ [ lhs>> cdr>> ] [ rhs>> ] bi deque boa ] bi ;
|
[ front>> <cons> ] [ back>> ] bi deque boa ; inline
|
||||||
|
|
||||||
: transfer-left ( deque -- item newdeque )
|
|
||||||
rhs>> [ split-reverse deque boa (pop-left) ]
|
|
||||||
[ "Popping from an empty deque" throw ] if* ;
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: pop-left ( deque -- item newdeque )
|
: push-front ( deque item -- newdeque )
|
||||||
dup lhs>> [ (pop-left) ] [ transfer-left ] if ;
|
swap push ;
|
||||||
|
|
||||||
|
: push-back ( deque item -- newdeque )
|
||||||
|
swap [ push ] flipped ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
: (pop-right) ( deque -- item newdeque )
|
: remove ( deque -- item newdeque )
|
||||||
[ rhs>> car>> ] [ [ lhs>> ] [ rhs>> cdr>> ] bi deque boa ] bi ;
|
[ front>> car>> ] [ [ front>> cdr>> ] [ back>> ] bi deque boa ] bi ; inline
|
||||||
|
|
||||||
: transfer-right ( deque -- newdeque item )
|
: transfer ( deque -- item newdeque )
|
||||||
lhs>> [ split-reverse deque boa (pop-left) ]
|
back>> [ split-reverse deque boa remove ]
|
||||||
[ "Popping from an empty deque" throw ] if* ;
|
[ "Popping from an empty deque" throw ] if* ; inline
|
||||||
|
|
||||||
|
: pop ( deque -- item newdeque )
|
||||||
|
dup front>> [ remove ] [ transfer ] if ; inline
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: pop-right ( deque -- item newdeque )
|
: pop-front ( deque -- item newdeque )
|
||||||
dup rhs>> [ (pop-right) ] [ transfer-right ] if ;
|
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 )
|
: sequence>deque ( sequence -- deque )
|
||||||
<deque> [ push-right ] sequences:reduce ;
|
<deque> [ push-back ] sequences:reduce ;
|
||||||
|
|
||||||
: deque>sequence ( deque -- sequence )
|
: deque>sequence ( deque -- sequence )
|
||||||
[ dup deque-empty? not ] [ pop-left swap ] [ ] sequences:produce nip ;
|
[ dup deque-empty? not ] [ pop-front swap ] [ ] sequences:produce nip ;
|
||||||
|
|
|
@ -0,0 +1,21 @@
|
||||||
|
IN: search-deques
|
||||||
|
USING: help.markup help.syntax kernel dlists hashtables
|
||||||
|
deques assocs ;
|
||||||
|
|
||||||
|
ARTICLE: "search-deques" "Search deques"
|
||||||
|
"A search deque 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 deques implement all deque operations in terms of an underlying deque, and membership testing with " { $link deque-member? } " is implemented with an underlying assoc. Search deques are defined in the " { $vocab-link "search-deques" } " vocabulary."
|
||||||
|
$nl
|
||||||
|
"Creating a search deque:"
|
||||||
|
{ $subsection <search-deque> }
|
||||||
|
"Default implementation:"
|
||||||
|
{ $subsection <hashed-dlist> } ;
|
||||||
|
|
||||||
|
ABOUT: "search-deques"
|
||||||
|
|
||||||
|
HELP: <search-deque> ( assoc deque -- search-deque )
|
||||||
|
{ $values { "assoc" assoc } { "deque" deque } { "search-deque" search-deque } }
|
||||||
|
{ $description "Creates a new " { $link search-deque } "." } ;
|
||||||
|
|
||||||
|
HELP: <hashed-dlist> ( -- search-deque )
|
||||||
|
{ $values { "search-deque" search-deque } }
|
||||||
|
{ $description "Creates a new " { $link search-deque } " backed by a " { $link dlist } ", with a " { $link hashtable } " for fast membership tests." } ;
|
|
@ -1,10 +1,10 @@
|
||||||
IN: search-dequeues.tests
|
IN: search-deques.tests
|
||||||
USING: search-dequeues tools.test namespaces
|
USING: search-deques tools.test namespaces
|
||||||
kernel sequences words dequeues vocabs ;
|
kernel sequences words deques vocabs ;
|
||||||
|
|
||||||
<hashed-dlist> "h" set
|
<hashed-dlist> "h" set
|
||||||
|
|
||||||
[ t ] [ "h" get dequeue-empty? ] unit-test
|
[ t ] [ "h" get deque-empty? ] unit-test
|
||||||
|
|
||||||
[ ] [ 3 "h" get push-front* "1" set ] unit-test
|
[ ] [ 3 "h" get push-front* "1" set ] unit-test
|
||||||
[ ] [ 1 "h" get push-front ] unit-test
|
[ ] [ 1 "h" get push-front ] unit-test
|
||||||
|
@ -15,21 +15,21 @@ kernel sequences words dequeues vocabs ;
|
||||||
[ t ] [ "1" get "2" get eq? ] unit-test
|
[ t ] [ "1" get "2" get eq? ] unit-test
|
||||||
[ t ] [ "2" get "3" get eq? ] unit-test
|
[ t ] [ "2" get "3" get eq? ] unit-test
|
||||||
|
|
||||||
[ 3 ] [ "h" get dequeue-length ] unit-test
|
[ 3 ] [ "h" get deque-length ] unit-test
|
||||||
[ t ] [ 7 "h" get dequeue-member? ] unit-test
|
[ t ] [ 7 "h" get deque-member? ] unit-test
|
||||||
|
|
||||||
[ 3 ] [ "1" get node-value ] unit-test
|
[ 3 ] [ "1" get node-value ] unit-test
|
||||||
[ ] [ "1" get "h" get delete-node ] unit-test
|
[ ] [ "1" get "h" get delete-node ] unit-test
|
||||||
|
|
||||||
[ 2 ] [ "h" get dequeue-length ] unit-test
|
[ 2 ] [ "h" get deque-length ] unit-test
|
||||||
[ 1 ] [ "h" get pop-back ] unit-test
|
[ 1 ] [ "h" get pop-back ] unit-test
|
||||||
[ 7 ] [ "h" get pop-back ] unit-test
|
[ 7 ] [ "h" get pop-back ] unit-test
|
||||||
|
|
||||||
[ f ] [ 7 "h" get dequeue-member? ] unit-test
|
[ f ] [ 7 "h" get deque-member? ] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
<hashed-dlist>
|
<hashed-dlist>
|
||||||
[ all-words swap [ push-front ] curry each ]
|
[ all-words swap [ push-front ] curry each ]
|
||||||
[ [ drop ] slurp-dequeue ]
|
[ [ drop ] slurp-deque ]
|
||||||
bi
|
bi
|
||||||
] unit-test
|
] unit-test
|
|
@ -0,0 +1,53 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors kernel assocs deques dlists hashtables ;
|
||||||
|
IN: search-deques
|
||||||
|
|
||||||
|
TUPLE: search-deque assoc deque ;
|
||||||
|
|
||||||
|
C: <search-deque> search-deque
|
||||||
|
|
||||||
|
: <hashed-dlist> ( -- search-deque )
|
||||||
|
0 <hashtable> <dlist> <search-deque> ;
|
||||||
|
|
||||||
|
M: search-deque deque-length deque>> deque-length ;
|
||||||
|
|
||||||
|
M: search-deque peek-front deque>> peek-front ;
|
||||||
|
|
||||||
|
M: search-deque peek-back deque>> peek-back ;
|
||||||
|
|
||||||
|
M: search-deque push-front*
|
||||||
|
2dup assoc>> at* [ 2nip ] [
|
||||||
|
drop
|
||||||
|
[ deque>> push-front* ] [ assoc>> ] 2bi
|
||||||
|
[ 2drop ] [ set-at ] 3bi
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
M: search-deque push-back*
|
||||||
|
2dup assoc>> at* [ 2nip ] [
|
||||||
|
drop
|
||||||
|
[ deque>> push-back* ] [ assoc>> ] 2bi
|
||||||
|
[ 2drop ] [ set-at ] 3bi
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
M: search-deque pop-front*
|
||||||
|
[ [ deque>> peek-front ] [ assoc>> ] bi delete-at ]
|
||||||
|
[ deque>> pop-front* ]
|
||||||
|
bi ;
|
||||||
|
|
||||||
|
M: search-deque pop-back*
|
||||||
|
[ [ deque>> peek-back ] [ assoc>> ] bi delete-at ]
|
||||||
|
[ deque>> pop-back* ]
|
||||||
|
bi ;
|
||||||
|
|
||||||
|
M: search-deque delete-node
|
||||||
|
[ deque>> delete-node ]
|
||||||
|
[ [ node-value ] [ assoc>> ] bi* delete-at ] 2bi ;
|
||||||
|
|
||||||
|
M: search-deque clear-deque
|
||||||
|
[ deque>> clear-deque ] [ assoc>> clear-assoc ] bi ;
|
||||||
|
|
||||||
|
M: search-deque deque-member?
|
||||||
|
assoc>> key? ;
|
||||||
|
|
||||||
|
INSTANCE: search-deque deque
|
|
@ -1,21 +0,0 @@
|
||||||
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> } ;
|
|
||||||
|
|
||||||
ABOUT: "search-dequeues"
|
|
||||||
|
|
||||||
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." } ;
|
|
|
@ -1,53 +0,0 @@
|
||||||
! 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
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: help.markup help.syntax kernel kernel.private io
|
USING: help.markup help.syntax kernel kernel.private io
|
||||||
threads.private continuations dlists init quotations strings
|
threads.private continuations dlists init quotations strings
|
||||||
assocs heaps boxes namespaces dequeues ;
|
assocs heaps boxes namespaces deques ;
|
||||||
IN: threads
|
IN: threads
|
||||||
|
|
||||||
ARTICLE: "threads-start/stop" "Starting and stopping threads"
|
ARTICLE: "threads-start/stop" "Starting and stopping threads"
|
||||||
|
@ -86,7 +86,7 @@ HELP: run-queue
|
||||||
{ $var-description "Global variable holding the queue of runnable threads. Calls to " { $link yield } " switch to the thread which has been in the queue for the longest period of time."
|
{ $var-description "Global variable holding the queue of runnable threads. Calls to " { $link yield } " switch to the thread which has been in the queue for the longest period of time."
|
||||||
$nl
|
$nl
|
||||||
"By convention, threads are queued with " { $link push-front }
|
"By convention, threads are queued with " { $link push-front }
|
||||||
" and dequeued with " { $link pop-back } "." } ;
|
" and dequed with " { $link pop-back } "." } ;
|
||||||
|
|
||||||
HELP: resume
|
HELP: resume
|
||||||
{ $values { "thread" thread } }
|
{ $values { "thread" thread } }
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
USING: arrays hashtables heaps kernel kernel.private math
|
USING: arrays hashtables heaps kernel kernel.private math
|
||||||
namespaces sequences vectors continuations continuations.private
|
namespaces sequences vectors continuations continuations.private
|
||||||
dlists assocs system combinators init boxes accessors
|
dlists assocs system combinators init boxes accessors
|
||||||
math.order dequeues strings quotations ;
|
math.order deques strings quotations ;
|
||||||
IN: threads
|
IN: threads
|
||||||
|
|
||||||
SYMBOL: initial-thread
|
SYMBOL: initial-thread
|
||||||
|
@ -91,7 +91,7 @@ PRIVATE>
|
||||||
|
|
||||||
: sleep-time ( -- ms/f )
|
: sleep-time ( -- ms/f )
|
||||||
{
|
{
|
||||||
{ [ run-queue dequeue-empty? not ] [ 0 ] }
|
{ [ run-queue deque-empty? not ] [ 0 ] }
|
||||||
{ [ sleep-queue heap-empty? ] [ f ] }
|
{ [ sleep-queue heap-empty? ] [ f ] }
|
||||||
[ sleep-queue heap-peek nip millis [-] ]
|
[ sleep-queue heap-peek nip millis [-] ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
@ -151,7 +151,7 @@ DEFER: next
|
||||||
|
|
||||||
: next ( -- * )
|
: next ( -- * )
|
||||||
expire-sleep-loop
|
expire-sleep-loop
|
||||||
run-queue dup dequeue-empty? [
|
run-queue dup deque-empty? [
|
||||||
drop no-runnable-threads
|
drop no-runnable-threads
|
||||||
] [
|
] [
|
||||||
pop-back dup array? [ first2 ] [ f swap ] if (next)
|
pop-back dup array? [ first2 ] [ f swap ] if (next)
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
IN: ui.gadgets.tests
|
IN: ui.gadgets.tests
|
||||||
USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
|
USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
|
||||||
tools.test namespaces models kernel dlists dequeues math sets
|
tools.test namespaces models kernel dlists deques math sets
|
||||||
math.parser ui sequences hashtables assocs io arrays prettyprint
|
math.parser ui sequences hashtables assocs io arrays prettyprint
|
||||||
io.streams.string math.geometry.rect ;
|
io.streams.string math.geometry.rect ;
|
||||||
|
|
||||||
|
@ -91,26 +91,26 @@ M: mock-gadget ungraft*
|
||||||
[
|
[
|
||||||
<dlist> \ graft-queue [
|
<dlist> \ graft-queue [
|
||||||
[ ] [ <mock-gadget> dup queue-graft unqueue-graft ] unit-test
|
[ ] [ <mock-gadget> dup queue-graft unqueue-graft ] unit-test
|
||||||
[ t ] [ graft-queue dequeue-empty? ] unit-test
|
[ t ] [ graft-queue deque-empty? ] unit-test
|
||||||
] with-variable
|
] with-variable
|
||||||
|
|
||||||
<dlist> \ graft-queue [
|
<dlist> \ graft-queue [
|
||||||
[ t ] [ graft-queue dequeue-empty? ] unit-test
|
[ t ] [ graft-queue deque-empty? ] unit-test
|
||||||
|
|
||||||
<mock-gadget> "g" set
|
<mock-gadget> "g" set
|
||||||
[ ] [ "g" get queue-graft ] unit-test
|
[ ] [ "g" get queue-graft ] unit-test
|
||||||
[ f ] [ graft-queue dequeue-empty? ] unit-test
|
[ f ] [ graft-queue deque-empty? ] unit-test
|
||||||
[ { f t } ] [ "g" get gadget-graft-state ] unit-test
|
[ { f t } ] [ "g" get gadget-graft-state ] unit-test
|
||||||
[ ] [ "g" get graft-later ] unit-test
|
[ ] [ "g" get graft-later ] unit-test
|
||||||
[ { f t } ] [ "g" get gadget-graft-state ] unit-test
|
[ { f t } ] [ "g" get gadget-graft-state ] unit-test
|
||||||
[ ] [ "g" get ungraft-later ] unit-test
|
[ ] [ "g" get ungraft-later ] unit-test
|
||||||
[ { f f } ] [ "g" get gadget-graft-state ] unit-test
|
[ { f f } ] [ "g" get gadget-graft-state ] unit-test
|
||||||
[ t ] [ graft-queue dequeue-empty? ] unit-test
|
[ t ] [ graft-queue deque-empty? ] unit-test
|
||||||
[ ] [ "g" get ungraft-later ] unit-test
|
[ ] [ "g" get ungraft-later ] unit-test
|
||||||
[ ] [ "g" get graft-later ] unit-test
|
[ ] [ "g" get graft-later ] unit-test
|
||||||
[ ] [ notify-queued ] unit-test
|
[ ] [ notify-queued ] unit-test
|
||||||
[ { t t } ] [ "g" get gadget-graft-state ] unit-test
|
[ { t t } ] [ "g" get gadget-graft-state ] unit-test
|
||||||
[ t ] [ graft-queue dequeue-empty? ] unit-test
|
[ t ] [ graft-queue deque-empty? ] unit-test
|
||||||
[ ] [ "g" get graft-later ] unit-test
|
[ ] [ "g" get graft-later ] unit-test
|
||||||
[ 1 ] [ "g" get mock-gadget-graft-called ] unit-test
|
[ 1 ] [ "g" get mock-gadget-graft-called ] unit-test
|
||||||
[ ] [ "g" get ungraft-later ] unit-test
|
[ ] [ "g" get ungraft-later ] unit-test
|
||||||
|
@ -146,7 +146,7 @@ M: mock-gadget ungraft*
|
||||||
[ { f t } ] [ "1" get gadget-graft-state ] unit-test
|
[ { f t } ] [ "1" get gadget-graft-state ] unit-test
|
||||||
[ { f t } ] [ "2" get gadget-graft-state ] unit-test
|
[ { f t } ] [ "2" get gadget-graft-state ] unit-test
|
||||||
[ { f t } ] [ "3" get gadget-graft-state ] unit-test
|
[ { f t } ] [ "3" get gadget-graft-state ] unit-test
|
||||||
[ ] [ graft-queue [ "x" print notify ] slurp-dequeue ] unit-test
|
[ ] [ graft-queue [ "x" print notify ] slurp-deque ] unit-test
|
||||||
[ ] [ notify-queued ] unit-test
|
[ ] [ notify-queued ] unit-test
|
||||||
[ V{ { t t } } ] [ status-flags ] unit-test
|
[ V{ { t t } } ] [ status-flags ] unit-test
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays hashtables kernel models math namespaces
|
USING: accessors arrays hashtables kernel models math namespaces
|
||||||
sequences quotations math.vectors combinators sorting
|
sequences quotations math.vectors combinators sorting
|
||||||
binary-search vectors dlists dequeues models threads
|
binary-search vectors dlists deques models threads
|
||||||
concurrency.flags math.order math.geometry.rect ;
|
concurrency.flags math.order math.geometry.rect ;
|
||||||
|
|
||||||
IN: ui.gadgets
|
IN: ui.gadgets
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2006, 2007 Slava Pestov.
|
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays assocs io kernel math models namespaces
|
USING: arrays assocs io kernel math models namespaces
|
||||||
prettyprint dlists dequeues sequences threads sequences words
|
prettyprint dlists deques sequences threads sequences words
|
||||||
debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
|
debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
|
||||||
ui.gestures ui.backend ui.render continuations init combinators
|
ui.gestures ui.backend ui.render continuations init combinators
|
||||||
hashtables concurrency.flags sets accessors ;
|
hashtables concurrency.flags sets accessors ;
|
||||||
|
@ -15,7 +15,7 @@ SYMBOL: stop-after-last-window?
|
||||||
: event-loop? ( -- ? )
|
: event-loop? ( -- ? )
|
||||||
{
|
{
|
||||||
{ [ stop-after-last-window? get not ] [ t ] }
|
{ [ stop-after-last-window? get not ] [ t ] }
|
||||||
{ [ graft-queue dequeue-empty? not ] [ t ] }
|
{ [ graft-queue deque-empty? not ] [ t ] }
|
||||||
{ [ windows get-global empty? not ] [ t ] }
|
{ [ windows get-global empty? not ] [ t ] }
|
||||||
[ f ]
|
[ f ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
@ -126,7 +126,7 @@ SYMBOL: ui-hook
|
||||||
in-layout? on
|
in-layout? on
|
||||||
layout-queue [
|
layout-queue [
|
||||||
dup layout find-world [ , ] when*
|
dup layout find-world [ , ] when*
|
||||||
] slurp-dequeue
|
] slurp-deque
|
||||||
] { } make prune ;
|
] { } make prune ;
|
||||||
|
|
||||||
: redraw-worlds ( seq -- )
|
: redraw-worlds ( seq -- )
|
||||||
|
@ -141,7 +141,7 @@ SYMBOL: ui-hook
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
: notify-queued ( -- )
|
: notify-queued ( -- )
|
||||||
graft-queue [ notify ] slurp-dequeue ;
|
graft-queue [ notify ] slurp-deque ;
|
||||||
|
|
||||||
: update-ui ( -- )
|
: update-ui ( -- )
|
||||||
[ notify-queued layout-queued redraw-worlds ] assert-depth ;
|
[ notify-queued layout-queued redraw-worlds ] assert-depth ;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: io.files kernel sequences accessors
|
USING: io.files kernel sequences accessors
|
||||||
dlists dequeues arrays sequences.lib ;
|
dlists deques arrays sequences.lib ;
|
||||||
IN: io.paths
|
IN: io.paths
|
||||||
|
|
||||||
TUPLE: directory-iterator path bfs queue ;
|
TUPLE: directory-iterator path bfs queue ;
|
||||||
|
@ -18,7 +18,7 @@ TUPLE: directory-iterator path bfs queue ;
|
||||||
dup path>> over push-directory ;
|
dup path>> over push-directory ;
|
||||||
|
|
||||||
: next-file ( iter -- file/f )
|
: next-file ( iter -- file/f )
|
||||||
dup queue>> dequeue-empty? [ drop f ] [
|
dup queue>> deque-empty? [ drop f ] [
|
||||||
dup queue>> pop-back first2
|
dup queue>> pop-back first2
|
||||||
[ over push-directory next-file ] [ nip ] if
|
[ over push-directory next-file ] [ nip ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
Loading…
Reference in New Issue