Unrolled lists
Slava Pestov
parent
7fc13ef03c
commit
9c84ad8944
|
|
@ -24,7 +24,10 @@ $nl
|
|||
|
||||
ABOUT: "dlists"
|
||||
|
||||
HELP: <hashed-dlist> ( -- search-deque )
|
||||
HELP: <dlist>
|
||||
{ $description "Creates a new double-linked list." } ;
|
||||
|
||||
HELP: <hashed-dlist>
|
||||
{ $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." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,22 @@
|
|||
IN: unrolled-lists
|
||||
USING: help.markup help.syntax hashtables search-deques dlists
|
||||
deques ;
|
||||
|
||||
HELP: unrolled-list
|
||||
{ $class-description "The class of unrolled lists." } ;
|
||||
|
||||
HELP: <unrolled-list>
|
||||
{ $values { "list" unrolled-list } }
|
||||
{ $description "Creates a new unrolled list." } ;
|
||||
|
||||
HELP: <hashed-unrolled-list>
|
||||
{ $values { "search-deque" search-deque } }
|
||||
{ $description "Creates a new " { $link search-deque } " backed by an " { $link unrolled-list } ", with a " { $link hashtable } " for fast membership tests." } ;
|
||||
|
||||
ARTICLE: "unrolled-lists" "Unrolled lists"
|
||||
"The " { $vocab-link "unrolled-lists" } " vocabulary provides an implementation of the " { $link deque } " protocol with constant time insertion and removal at both ends, and lower memory overhead than a " { $link dlist } " due to packing 32 elements per every node. The one tradeoff is that unlike dlists, " { $link delete-node } " is not supported for unrolled lists."
|
||||
{ $subsection unrolled-list }
|
||||
{ $subsection <unrolled-list> }
|
||||
{ $subsection <hashed-unrolled-list> } ;
|
||||
|
||||
ABOUT: "unrolled-lists"
|
||||
|
|
@ -0,0 +1,130 @@
|
|||
USING: unrolled-lists tools.test deques kernel sequences
|
||||
random prettyprint grouping ;
|
||||
IN: unrolled-lists.tests
|
||||
|
||||
[ 1 ] [ <unrolled-list> 1 over push-front pop-front ] unit-test
|
||||
[ 1 ] [ <unrolled-list> 1 over push-front pop-back ] unit-test
|
||||
[ 1 ] [ <unrolled-list> 1 over push-back pop-front ] unit-test
|
||||
[ 1 ] [ <unrolled-list> 1 over push-back pop-back ] unit-test
|
||||
|
||||
[ 1 2 ] [
|
||||
<unrolled-list> 1 over push-back 2 over push-back
|
||||
[ pop-front ] [ pop-front ] bi
|
||||
] unit-test
|
||||
|
||||
[ 2 1 ] [
|
||||
<unrolled-list> 1 over push-back 2 over push-back
|
||||
[ pop-back ] [ pop-back ] bi
|
||||
] unit-test
|
||||
|
||||
[ 1 2 3 ] [
|
||||
<unrolled-list>
|
||||
1 over push-back
|
||||
2 over push-back
|
||||
3 over push-back
|
||||
[ pop-front ] [ pop-front ] [ pop-front ] tri
|
||||
] unit-test
|
||||
|
||||
[ 3 2 1 ] [
|
||||
<unrolled-list>
|
||||
1 over push-back
|
||||
2 over push-back
|
||||
3 over push-back
|
||||
[ pop-back ] [ pop-back ] [ pop-back ] tri
|
||||
] unit-test
|
||||
|
||||
[ { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 } ] [
|
||||
<unrolled-list>
|
||||
32 [ over push-front ] each
|
||||
32 [ dup pop-back ] replicate
|
||||
nip
|
||||
] unit-test
|
||||
|
||||
[ { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 } ] [
|
||||
<unrolled-list>
|
||||
32 [ over push-front ] each
|
||||
32 [ dup pop-front ] replicate reverse
|
||||
nip
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
<unrolled-list>
|
||||
1000 [ 1000 random ] replicate
|
||||
[ [ over push-front ] each ]
|
||||
[ [ dup pop-back ] replicate ]
|
||||
[ ]
|
||||
tri
|
||||
=
|
||||
nip
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
<unrolled-list>
|
||||
1000 [ 1000 random ] replicate
|
||||
[
|
||||
10 group [
|
||||
[ [ over push-front ] each ]
|
||||
[ [ dup pop-back ] replicate ]
|
||||
bi
|
||||
] map concat
|
||||
] keep
|
||||
=
|
||||
nip
|
||||
] unit-test
|
||||
|
||||
[ t ] [ <unrolled-list> deque-empty? ] unit-test
|
||||
|
||||
[ t ] [
|
||||
<unrolled-list>
|
||||
1 over push-front
|
||||
dup pop-front*
|
||||
deque-empty?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
<unrolled-list>
|
||||
1 over push-back
|
||||
dup pop-front*
|
||||
deque-empty?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
<unrolled-list>
|
||||
1 over push-front
|
||||
dup pop-back*
|
||||
deque-empty?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
<unrolled-list>
|
||||
1 over push-back
|
||||
dup pop-back*
|
||||
deque-empty?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
<unrolled-list>
|
||||
21 over push-front
|
||||
22 over push-front
|
||||
25 over push-front
|
||||
26 over push-front
|
||||
dup pop-back 21 assert=
|
||||
28 over push-front
|
||||
dup pop-back 22 assert=
|
||||
29 over push-front
|
||||
dup pop-back 25 assert=
|
||||
24 over push-front
|
||||
dup pop-back 26 assert=
|
||||
23 over push-front
|
||||
dup pop-back 28 assert=
|
||||
dup pop-back 29 assert=
|
||||
dup pop-back 24 assert=
|
||||
17 over push-front
|
||||
dup pop-back 23 assert=
|
||||
27 over push-front
|
||||
dup pop-back 17 assert=
|
||||
30 over push-front
|
||||
dup pop-back 27 assert=
|
||||
dup pop-back 30 assert=
|
||||
deque-empty?
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays math kernel accessors sequences sequences.private
|
||||
deques search-deques hashtables ;
|
||||
IN: unrolled-lists
|
||||
|
||||
: unroll-factor 32 ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
MIXIN: ?node
|
||||
INSTANCE: f ?node
|
||||
TUPLE: node { data array } { prev ?node } { next ?node } ;
|
||||
INSTANCE: node ?node
|
||||
|
||||
PRIVATE>
|
||||
|
||||
TUPLE: unrolled-list
|
||||
{ front ?node } { front-pos fixnum }
|
||||
{ back ?node } { back-pos fixnum } ;
|
||||
|
||||
: <unrolled-list> ( -- list )
|
||||
unrolled-list new
|
||||
unroll-factor >>back-pos ; inline
|
||||
|
||||
: <hashed-unrolled-list> ( -- list )
|
||||
20 <hashtable> <unrolled-list> <search-deque> ;
|
||||
|
||||
ERROR: empty-unrolled-list list ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
M: unrolled-list deque-empty?
|
||||
dup [ front>> ] [ back>> ] bi dup [
|
||||
eq? [ [ front-pos>> ] [ back-pos>> ] bi eq? ] [ drop f ] if
|
||||
] [ 3drop t ] if ;
|
||||
|
||||
M: unrolled-list clear-deque
|
||||
f >>front
|
||||
0 >>front-pos
|
||||
f >>back
|
||||
unroll-factor >>back-pos
|
||||
drop ;
|
||||
|
||||
: <front-node> ( elt front -- node )
|
||||
[
|
||||
unroll-factor 0 <array>
|
||||
[ unroll-factor 1- swap set-nth ] keep f
|
||||
] dip [ node boa dup ] keep
|
||||
dup [ (>>prev) ] [ 2drop ] if ; inline
|
||||
|
||||
: normalize-back ( list -- )
|
||||
dup back>> [
|
||||
dup prev>> [ drop ] [ swap front>> >>prev ] if
|
||||
] [ dup front>> >>back ] if* drop ; inline
|
||||
|
||||
: push-front/new ( elt list -- )
|
||||
unroll-factor 1- >>front-pos
|
||||
[ <front-node> ] change-front
|
||||
normalize-back ; inline
|
||||
|
||||
: push-front/existing ( elt list front -- )
|
||||
[ [ 1- ] change-front-pos ] dip
|
||||
[ front-pos>> ] [ data>> ] bi* set-nth-unsafe ; inline
|
||||
|
||||
M: unrolled-list push-front*
|
||||
dup [ front>> ] [ front-pos>> 0 eq? not ] bi
|
||||
[ drop ] [ and ] 2bi
|
||||
[ push-front/existing ] [ drop push-front/new ] if f ;
|
||||
|
||||
M: unrolled-list peek-front
|
||||
dup front>>
|
||||
[ [ front-pos>> ] dip data>> nth-unsafe ]
|
||||
[ empty-unrolled-list ]
|
||||
if* ;
|
||||
|
||||
: pop-front/new ( list front -- )
|
||||
[ 0 >>front-pos ] dip
|
||||
[ f ] change-next drop dup [ f >>prev ] when >>front
|
||||
dup front>> [ normalize-back ] [ f >>back drop ] if ; inline
|
||||
|
||||
: pop-front/existing ( list front -- )
|
||||
[ dup front-pos>> ] [ data>> ] bi* [ 0 ] 2dip set-nth-unsafe
|
||||
[ 1+ ] change-front-pos
|
||||
drop ; inline
|
||||
|
||||
M: unrolled-list pop-front*
|
||||
dup front>> [ empty-unrolled-list ] unless*
|
||||
over front-pos>> unroll-factor 1- eq?
|
||||
[ pop-front/new ] [ pop-front/existing ] if ;
|
||||
|
||||
: <back-node> ( elt back -- node )
|
||||
[
|
||||
unroll-factor 0 <array> [ set-first ] keep
|
||||
] dip [ f node boa dup ] keep
|
||||
dup [ (>>next) ] [ 2drop ] if ; inline
|
||||
|
||||
: normalize-front ( list -- )
|
||||
dup front>> [
|
||||
dup next>> [ drop ] [ swap back>> >>next ] if
|
||||
] [ dup back>> >>front ] if* drop ; inline
|
||||
|
||||
: push-back/new ( elt list -- )
|
||||
1 >>back-pos
|
||||
[ <back-node> ] change-back
|
||||
normalize-front ; inline
|
||||
|
||||
: push-back/existing ( elt list back -- )
|
||||
[ [ 1+ ] change-back-pos ] dip
|
||||
[ back-pos>> 1- ] [ data>> ] bi* set-nth-unsafe ; inline
|
||||
|
||||
M: unrolled-list push-back*
|
||||
dup [ back>> ] [ back-pos>> unroll-factor eq? not ] bi
|
||||
[ drop ] [ and ] 2bi
|
||||
[ push-back/existing ] [ drop push-back/new ] if f ;
|
||||
|
||||
M: unrolled-list peek-back
|
||||
dup back>>
|
||||
[ [ back-pos>> 1- ] dip data>> nth-unsafe ]
|
||||
[ empty-unrolled-list ]
|
||||
if* ;
|
||||
|
||||
: pop-back/new ( list back -- )
|
||||
[ unroll-factor >>back-pos ] dip
|
||||
[ f ] change-prev drop dup [ f >>next ] when >>back
|
||||
dup back>> [ normalize-front ] [ f >>front drop ] if ; inline
|
||||
|
||||
: pop-back/existing ( list back -- )
|
||||
[ [ 1- ] change-back-pos ] dip
|
||||
[ dup back-pos>> ] [ data>> ] bi* [ 0 ] 2dip set-nth-unsafe
|
||||
drop ; inline
|
||||
|
||||
M: unrolled-list pop-back*
|
||||
dup back>> [ empty-unrolled-list ] unless*
|
||||
over back-pos>> 1 eq?
|
||||
[ pop-back/new ] [ pop-back/existing ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
INSTANCE: unrolled-list deque
|
||||
Loading…
Reference in New Issue