Finish cleaning up erg's changes, remove queues

release
Slava Pestov 2007-11-05 11:01:11 -05:00
parent f26d8efa06
commit 599f1c6087
16 changed files with 81 additions and 174 deletions

View File

@ -2,8 +2,36 @@ USING: help.markup help.syntax kernel ;
IN: dlists
ARTICLE: "dlists" "Doubly-linked lists"
"A doubly-linked list is a list of nodes. Each node has a link to the previous and next nodes, and a slot to store an object. Objects can be pushed and popped from the front and back of the list. The linked list keeps track of its length, so finding the length is O(1)."
;
"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."
$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
"Dlists form a class:"
{ $subsection dlist }
{ $subsection dlist? }
"Constructing a dlist:"
{ $subsection <dlist> }
"Double-ended queue protocol:"
{ $subsection dlist-empty? }
{ $subsection push-front }
{ $subsection pop-front }
{ $subsection pop-front* }
{ $subsection push-back }
{ $subsection pop-back }
{ $subsection pop-back* }
"Finding out the length:"
{ $subsection dlist-length }
"Iterating over elements:"
{ $subsection dlist-each }
{ $subsection dlist-find }
{ $subsection dlist-contains? }
"Deleting a node matching a predicate:"
{ $subsection delete-node* }
{ $subsection delete-node }
"Consuming all nodes:"
{ $subsection dlist-slurp } ;
ABOUT: "dlists"
HELP: dlist-empty?
{ $values { "dlist" { $link dlist } } { "?" "a boolean" } }

View File

@ -4,6 +4,7 @@ USING: combinators kernel math ;
IN: dlists
TUPLE: dlist front back length ;
: <dlist> ( -- obj )
dlist construct-empty
0 over set-dlist-length ;
@ -122,3 +123,8 @@ PRIVATE>
: dlist-each ( dlist quot -- )
[ dlist-node-obj ] swap compose dlist-each-node ; inline
: dlist-slurp ( dlist quot -- )
over dlist-empty?
[ 2drop ] [ [ >r pop-back r> call ] 2keep dlist-slurp ] if ;
inline

View File

@ -2,9 +2,31 @@ USING: heaps.private help.markup help.syntax kernel ;
IN: heaps
ARTICLE: "heaps" "Heaps"
"A heap is a data structure that obeys the heap property. A min-heap will always have its smallest member available, as a max-heap will its largest. Objects stored on the heap must be comparable using the " { $link <=> } " operator, which may mean defining a new method on an object by using " { $link POSTPONE: M: } "."
;
"A heap is an implementation of a " { $emphasis "priority queue" } ", which is a structure that maintains a sorted set of elements. The key property is that insertion of an arbitrary element and removal of the first element (determined by order) is performed in O(log n) time."
$nl
"Heap elements are compared using the " { $link <=> } " generic word."
$nl
"There are two classes of heaps. Min-heaps sort their elements so that the minimum element is first:"
{ $subsection min-heap }
{ $subsection min-heap? }
{ $subsection <min-heap> }
"Max-heaps sort their elements so that the maximum element is first:"
{ $subsection min-heap }
{ $subsection min-heap? }
{ $subsection <min-heap> }
"Both obey a protocol."
$nl
"Queries:"
{ $subsection heap-empty? }
{ $subsection heap-peek }
"Insertion:"
{ $subsection heap-push }
{ $subsection heap-push-all }
"Removal:"
{ $subsection heap-pop* }
{ $subsection heap-pop } ;
ABOUT: "heaps"
HELP: <min-heap>
{ $values { "min-heap" min-heap } }

View File

@ -1 +0,0 @@
Slava Pestov

View File

@ -1,77 +0,0 @@
USING: help.markup help.syntax kernel ;
IN: queues
ARTICLE: "queues" "Queues"
"Last-in-first-out queues are defined in the " { $vocab-link "queues" } " vocabulary."
$nl
"Queues are a class."
{ $subsection queue }
{ $subsection queue? }
{ $subsection <queue> }
"Testing queues:"
{ $subsection queue-empty? }
"Adding elements:"
{ $subsection deque }
"Removing elements:"
{ $subsection enque }
{ $subsection clear-queue }
{ $subsection queue-each }
"An example:"
{ $code
"<queue> \"q\" set"
"5 \"q\" get enque"
"3 \"q\" get enque"
"7 \"q\" get enque"
"\"q\" get deque ."
" 5"
"\"q\" get deque ."
" 3"
"\"q\" get deque ."
" 7"
} ;
ABOUT: "queues"
HELP: queue
{ $class-description "A simple first-in-first-out queue. See " { $link "queues" } "." } ;
HELP: entry
{ $class-description "The class of entries in a " { $link queue } ". Each entry holds an object and a reference to the next entry." } ;
HELP: <entry>
{ $values { "obj" object } { "entry" entry } }
{ $description "Creates a new queue entry." }
{ $notes "This word is a factor of " { $link enque } "." } ;
HELP: <queue>
{ $values { "queue" queue } }
{ $description "Makes a new queue with no elements." } ;
HELP: queue-empty?
{ $values { "queue" queue } { "?" "a boolean" } }
{ $description "Tests if a queue contains no elements." } ;
HELP: deque
{ $values { "queue" queue } { "elt" object } }
{ $description "Removes an element from the front of the queue." }
{ $errors "Throws an " { $link empty-queue-error } " if the queue has no entries." }
{ $side-effects "queue" } ;
HELP: enque
{ $values { "elt" object } { "queue" queue } }
{ $description "Adds an element to the back of the queue." }
{ $side-effects "queue" } ;
HELP: empty-queue-error
{ $description "Throws an " { $link empty-queue-error } "." }
{ $error-description "Thrown by " { $link deque } " if the queue has no entries." } ;
HELP: clear-queue
{ $values { "queue" queue } }
{ $description "Removes all entries from the queue." }
{ $side-effects "queue" } ;
HELP: queue-each
{ $values { "queue" queue } { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } }
{ $description "Applies the quotation to each entry in the queue, starting from the least recently added entry, clearing the queue in the process." }
{ $side-effects "queue" } ;

View File

@ -1,12 +0,0 @@
USING: kernel math namespaces queues sequences tools.test ;
IN: temporary
<queue> "queue" set
[ t ] [ "queue" get queue-empty? ] unit-test
[ ] [ [ 1 2 3 4 5 ] [ "queue" get enque ] each ] unit-test
[ { 1 2 3 4 5 } ] [ 5 [ drop "queue" get deque ] map ] unit-test
[ "queue" get deque ] unit-test-fails

View File

@ -1,57 +0,0 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: queues
USING: kernel inspector ;
TUPLE: entry obj next ;
: <entry> ( obj -- entry ) f entry construct-boa ;
TUPLE: queue head tail ;
: <queue> ( -- queue ) queue construct-empty ;
: queue-empty? ( queue -- ? ) queue-head not ;
: (enque) ( entry queue -- )
[ set-queue-head ] 2keep set-queue-tail ;
: clear-queue ( queue -- )
f swap (enque) ;
: enque ( elt queue -- )
>r <entry> r> dup queue-empty? [
(enque)
] [
[ queue-tail set-entry-next ] 2keep set-queue-tail
] if ;
: clear-entry ( entry -- )
f over set-entry-obj f swap set-entry-next ;
: (deque) ( queue -- )
dup queue-head over queue-tail eq? [
clear-queue
] [
dup queue-head dup entry-next rot set-queue-head
clear-entry
] if ;
TUPLE: empty-queue-error ;
: empty-queue-error ( -- * )
\ empty-queue-error construct-empty throw ;
: deque ( queue -- elt )
dup queue-empty? [
empty-queue-error
] [
dup queue-head entry-obj >r (deque) r>
] if ;
M: empty-queue-error summary
drop "Empty queue" ;
: queue-each ( queue quot -- )
over queue-empty?
[ 2drop ] [ [ >r deque r> call ] 2keep queue-each ] if ;
inline

View File

@ -1 +0,0 @@
FIFO queues

View File

@ -1 +0,0 @@
collections

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax kernel kernel.private io
threads.private continuations queues ;
threads.private continuations ;
IN: threads
ARTICLE: "threads" "Threads"

View File

@ -2,9 +2,9 @@
! Copyright (C) 2005 Mackenzie Straight.
! See http://factorcode.org/license.txt for BSD license.
IN: threads
USING: arrays init hashtables heaps io.backend kernel kernel.private
math namespaces queues sequences vectors io system sorting
continuations debugger ;
USING: arrays init hashtables heaps io.backend kernel
kernel.private math namespaces sequences vectors io system
continuations debugger dlists ;
<PRIVATE
@ -16,8 +16,8 @@ M: sleeping <=> ( obj1 obj2 -- n )
[ sleeping-ms ] 2apply - ;
: sleep-time ( -- ms )
sleep-queue get-global
dup heap-empty? [ drop 1000 ] [ heap-peek sleeping-ms millis [-] ] if ;
sleep-queue get-global dup heap-empty?
[ drop 1000 ] [ heap-peek sleeping-ms millis [-] ] if ;
: run-queue ( -- queue ) \ run-queue get-global ;
@ -29,7 +29,7 @@ M: sleeping <=> ( obj1 obj2 -- n )
PRIVATE>
: schedule-thread ( continuation -- ) run-queue enque ;
: schedule-thread ( continuation -- ) run-queue push-front ;
: schedule-thread-with ( obj continuation -- )
2array schedule-thread ;
@ -38,7 +38,7 @@ PRIVATE>
walker-hook [
f swap continue-with
] [
run-queue deque dup array?
run-queue pop-back dup array?
[ first2 continue-with ] [ continue ] if
] if* ;
@ -64,10 +64,10 @@ PRIVATE>
[ 0 ? io-multiplex ] if ;
: idle-thread ( -- )
run-queue queue-empty? (idle-thread) yield idle-thread ;
run-queue dlist-empty? (idle-thread) yield idle-thread ;
: init-threads ( -- )
<queue> \ run-queue set-global
<dlist> \ run-queue set-global
<min-heap> sleep-queue set-global
[ idle-thread ] in-thread ;

View File

@ -122,14 +122,14 @@ ARTICLE: "collections" "Collections"
{ $heading "Associative mappings" }
{ $subsection "assocs" }
{ $subsection "namespaces" }
{ $subsection "graphs" }
"Implementations:"
{ $subsection "hashtables" }
{ $subsection "alists" }
{ $heading "Other collections" }
{ $subsection "buffers" }
{ $subsection "dlists" }
{ $subsection "heaps" } ;
{ $subsection "heaps" }
{ $subsection "graphs" }
{ $subsection "buffers" } ;
USE: io.sockets

View File

@ -100,7 +100,7 @@ HELP: $link
{ $values { "element" "a markup element of the form " { $snippet "{ topic }" } } }
{ $description "Prints a link to a help article or word." }
{ $examples
{ $markup-example { $link "queues" } }
{ $markup-example { $link "dlists" } }
{ $markup-example { $link + } }
} ;
@ -123,7 +123,7 @@ HELP: $see-also
{ $values { "topics" "a sequence of article names or words" } }
{ $description "Prints a heading followed by a series of links." }
{ $examples
{ $markup-example { $see-also "graphs" "queues" } }
{ $markup-example { $see-also "graphs" "dlists" } }
} ;
{ $see-also $related related-words } related-words

View File

@ -1,8 +1,8 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables kernel models math namespaces sequences
timers quotations math.vectors queues combinators sorting
vectors ;
timers quotations math.vectors combinators sorting vectors
dlists ;
IN: ui.gadgets
TUPLE: rect loc dim ;
@ -159,7 +159,7 @@ M: array gadget-text*
#! When unit testing gadgets without the UI running, the
#! invalid queue is not initialized and we simply ignore
#! invalidation requests.
invalid [ enque ] [ drop ] if* ;
invalid [ push-front ] [ drop ] if* ;
DEFER: relayout

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs kernel math models namespaces queues
USING: arrays assocs kernel math models namespaces
sequences words strings system hashtables math.parser
math.vectors tuples classes ui.gadgets timers ;
IN: ui.gestures

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs io kernel math models namespaces
prettyprint queues sequences threads sequences words timers
prettyprint dlists sequences threads sequences words timers
debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
ui.gestures ui.backend ui.render continuations init ;
IN: ui
@ -81,7 +81,7 @@ SYMBOL: windows
[
invalid [
dup layout find-world [ , ] when*
] queue-each
] dlist-slurp
] { } make ;
SYMBOL: ui-hook