Paste: mlists
Author: | prunedtree |
Mode: | factor |
Date: | Mon, 17 Nov 2008 12:04:48 |
Plain Text |
USING: kernel math accessors arrays sequences sequences.private fry math.ranges
combinators locals circular ;
IN: mlists
TUPLE: mlist
{ next-map initial: { 1 } }
{ values initial: { } }
{ (count) initial: 0 }
{ last# initial: 1 }
{ free# initial: 1 } ;
TUPLE: mlist-cursor
{ (list) read-only }
{ (index) read-only } ;
<PRIVATE
TUPLE: mlist-vocab-dummy-slots value next free last count lazy-next ;
PRIVATE>
SLOT: value
SLOT: next
SLOT: free
SLOT: last
SLOT: count
SLOT: lazy-next
: <mlc> swap mlist-cursor boa ;
: index>> (index)>> ;
: list>> (list)>> ;
M: mlist-cursor value>> [ index>> 2 - ] [ list>> values>> ] bi nth ;
M: mlist-cursor (>>value) dup [ ] [ index>> 2 - ] [ list>> values>> ] tri* set-nth ;
: last? [ index>> ] [ list>> last#>> ] bi = ;
: first? index>> 1 = ;
M: mlist-cursor next>> lazy-next>> ;
: <mlist> mlist new ;
: zero>> 1 swap <mlc> ;
M: mlist last>> [ last#>> ] keep <mlc> ;
M: mlist count>> (count)>> ;
M: mlist (>>count) (>>(count)) ;
<PRIVATE
DEFER: (delete-next)
: unsafe-next>> [ index>> 1- ] [ list>> next-map>> nth ] [ list>> ] tri <mlc> ;
: (next)>> unsafe-next>> [ index>> abs ] [ list>> ] bi <mlc> ;
: set-lazy-deleted [ (next)>> index>> ] [ [ neg ] [ list>> ] bi* <mlc> ] [ ] tri (>>next) ;
: lazy-deleted? unsafe-next>> index>> 0 < ;
M: mlist-cursor lazy-next>>
dup (next)>> lazy-deleted? [ [ (delete-next) ] [ lazy-next>> ] bi ] [ (next)>> ] if ;
M: mlist-cursor (>>next)
dup [ index>> ] [ index>> 1- ] [ list>> next-map>> ] tri* set-nth ;
M: mlist free>> [ free#>> ] keep <mlc> ;
M: mlist (>>free) [ index>> ] [ (>>free#) ] bi* ;
M: mlist (>>last) [ index>> ] [ (>>last#) ] bi* ;
: alloc-rate 8 ;
: delete-effort 0 ;
: free { [ list>> free>> ] [ (>>next) ] [ ] [ list>> (>>free) ] [ f swap (>>value) ] } cleave ;
:: (grow)
mlist
[ dup length n + swap resize ] [ change-values ] [ change-next-map ] bi
next-map>> n tail-slice* [ from>> ] [ to>> ] bi [a,b) [ 1+ mlist <mlc> free ] each ;
: grow-count values>> length alloc-rate /i 1+ ;
: grow [ grow-count ] keep (grow) ;
: alloc
[ dup free>> first? [ grow ] [ drop ] if ] keep
dup free>> [ (next)>> >>free drop ] keep ;
: (delete-next)
{
[ dup (next)>> last? [ dup list>> swap >>last ] when drop ]
[ (next)>> ]
[ dup (next)>> (next)>> >>next drop ]
} cleave free ;
: change-list-count over list>> [ count>> swap call ] keep (>>count) ; inline
PRIVATE>
: insert-after
[ 1+ ] change-list-count
[ [ list>> alloc swap >>value ] [ next>> ] bi >>next ] keep swap >>next
dup last? [ [ next>> ] [ list>> swap >>last ] bi ] when drop ;
: delete-lazy
[ delete-effort [ next>> ] times drop ] keep [ 1- ] change-list-count set-lazy-deleted ;
: delete-next
[ last? [ "last element" throw ] when ] keep [ 1- ] change-list-count (delete-next) ;
: >mlist
{
[ length 1+ [1,b] 1 circular boa >array ]
[ >array ]
[ length ]
[ length 1+ ]
[ drop 1 ]
} cleave mlist boa ;
: list>cursors
zero>> next>> V{ } clone [ '[ [ next>> ] [ _ push ] [ last? not ] tri ] loop ] keep nip ;
: list>sequence
zero>> next>> V{ } clone [ '[ [ next>> ] [ value>> _ push ] [ last? not ] tri ] loop ] keep nip ;
: list>indexes
zero>> next>> V{ } clone [ '[ [ next>> ] [ index>> _ push ] [ last? not ] tri ] loop ] keep nip ;
: mlist-contract list>sequence >mlist ;
<PRIVATE
: >mlist-proper <mlist> zero>> swap [ swap [ insert-after ] [ next>> ] bi ] each list>> ;
: list>sequence-proper list>cursors [ value>> ] map ;
: list>indexes-proper list>cursors [ index>> ] map ;
PRIVATE>
New Annotation