steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix a couple of dlists bugs 

document more words
add more tests
db4
Doug Coleman 2008-05-25 18:28:07 -05:00
parent 299bb1fb16
commit 191e95d8c1
3 changed files with 50 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
core/dlists/dlists-docs.factor
View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax kernel quotations ;
USING: help.markup help.syntax kernel quotations dlists.private ;
IN: dlists
ARTICLE: "dlists" "Doubly-linked lists"
@ -51,38 +51,52 @@ HELP: dlist-empty?
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)." }
{ $see-also push-back pop-front pop-front* pop-back pop-back* } ;
{ $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)." }
{ $see-also push-front pop-front pop-front* pop-back pop-back* } ;
{ $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)." }
{ $see-also push-front push-back pop-front* pop-back pop-back* } ;
{ $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)." }
{ $see-also push-front push-back pop-front pop-back pop-back* } ;
{ $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)." }
{ $see-also push-front push-back pop-front pop-front* pop-back* } ;
{ $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)." }
{ $see-also push-front push-back pop-front pop-front* pop-back } ;
{ $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" } }

21
core/dlists/dlists-tests.factor
View File

@ -1,6 +1,6 @@
USING: dlists dlists.private kernel tools.test random assocs
sets sequences namespaces sorting debugger io prettyprint
math ;
math accessors classes ;
IN: dlists.tests
[ t ] [ <dlist> dlist-empty? ] unit-test
@ -65,20 +65,17 @@ IN: dlists.tests
: assert-same-elements
[ prune natural-sort ] bi@ assert= ;
: dlist-push-all [ push-front ] curry each ;
: 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 2dup nl . . nl
[
6 [ drop 30 random >fixnum ] map prune [
<dlist>
[ dlist-push-all ] keep
[ dlist-delete-all ] keep
dlist>array
[ push-all-front ]
[ dlist-delete-all ]
[ dlist>array ] tri
] 2keep swap diff assert-same-elements
] unit-test
@ -95,3 +92,11 @@ IN: dlists.tests
[ 1 ] [ "d" get dlist-length ] unit-test
[ 1 ] [ "d" get dlist>array 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
[ f ] [ <dlist> peek-front ] unit-test
[ f ] [ <dlist> peek-back ] unit-test

16
core/dlists/dlists.factor
View File

@ -47,7 +47,7 @@ C: <dlist-node> dlist-node
: (dlist-find-node) ( dlist-node quot -- node/f ? )
over [
[ >r obj>> r> call ] 2keep rot
[ call ] 2keep rot
[ drop t ] [ >r next>> r> (dlist-find-node) ] if
] [ 2drop f f ] if ; inline
@ -55,7 +55,7 @@ C: <dlist-node> dlist-node
>r front>> r> (dlist-find-node) ; inline
: dlist-each-node ( dlist quot -- )
[ t ] compose dlist-find-node 2drop ; inline
[ f ] compose dlist-find-node 2drop ; inline
PRIVATE>
@ -85,7 +85,7 @@ PRIVATE>
[ push-back ] curry each ;
: peek-front ( dlist -- obj )
front>> obj>> ;
front>> dup [ obj>> ] when ;
: pop-front ( dlist -- obj )
dup front>> [
@ -96,10 +96,11 @@ PRIVATE>
] 2keep obj>>
swap [ normalize-back ] keep dec-length ;
: pop-front* ( dlist -- ) pop-front drop ;
: pop-front* ( dlist -- )
pop-front drop ;
: peek-back ( dlist -- obj )
back>> obj>> ;
back>> dup [ obj>> ] when ;
: pop-back ( dlist -- obj )
dup back>> [
@ -110,9 +111,11 @@ PRIVATE>
] 2keep obj>>
swap [ normalize-front ] keep dec-length ;
: pop-back* ( dlist -- ) pop-back drop ;
: pop-back* ( dlist -- )
pop-back drop ;
: dlist-find ( dlist quot -- obj/f ? )
[ obj>> ] prepose
dlist-find-node [ obj>> t ] [ drop f f ] if ; inline
: dlist-contains? ( dlist quot -- ? )
@ -141,6 +144,7 @@ PRIVATE>
] if ; inline
: delete-node-if ( dlist quot -- obj/f )
[ obj>> ] prepose
delete-node-if* drop ; inline
: dlist-delete ( obj dlist -- obj/f )