Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
45d96fdf33
|
|
@ -32,7 +32,7 @@ HELP: assoc>disjoint-set
|
|||
"4 5 pick equiv? ."
|
||||
"1 5 pick equiv? ."
|
||||
"drop"
|
||||
"t\nt\nf\n"
|
||||
"t\nt\nf"
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
IN: io.windows.launcher.nt.tests
|
||||
USING: io.launcher tools.test calendar accessors
|
||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||
sequences parser assocs hashtables math continuations ;
|
||||
sequences parser assocs hashtables math continuations eval ;
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,18 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel assocs ;
|
||||
IN: persistent.assocs
|
||||
|
||||
GENERIC: new-at ( value key assoc -- assoc' )
|
||||
|
||||
M: assoc new-at clone [ set-at ] keep ;
|
||||
|
||||
GENERIC: pluck-at ( key assoc -- assoc' )
|
||||
|
||||
M: assoc pluck-at clone [ delete-at ] keep ;
|
||||
|
||||
: changed-at ( key assoc quot -- assoc' )
|
||||
[ [ at ] dip call ] [ drop new-at ] 3bi ; inline
|
||||
|
||||
: conjoined ( key assoc -- assoc' )
|
||||
dupd new-at ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Persistent associative mapping protocol
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: layouts kernel parser math ;
|
||||
IN: persistent.hashtables.config
|
||||
|
||||
: radix-bits ( -- n ) << cell 4 = 4 5 ? parsed >> ; foldable
|
||||
: radix-mask ( -- n ) radix-bits 2^ 1- ; foldable
|
||||
: full-bitmap-mask ( -- n ) radix-bits 2^ 2^ 1- ; inline
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
IN: persistent.hashtables.tests
|
||||
USING: persistent.hashtables persistent.assocs hashtables assocs
|
||||
tools.test kernel namespaces random math.ranges sequences fry ;
|
||||
|
||||
[ t ] [ PH{ } assoc-empty? ] unit-test
|
||||
|
||||
[ PH{ { "A" "B" } } ] [ PH{ } "B" "A" rot new-at ] unit-test
|
||||
|
||||
[ "B" ] [ "A" PH{ { "A" "B" } } at ] unit-test
|
||||
|
||||
[ f ] [ "X" PH{ { "A" "B" } } at ] unit-test
|
||||
|
||||
TUPLE: hash-0-a ;
|
||||
|
||||
M: hash-0-a hashcode* 2drop 0 ;
|
||||
|
||||
TUPLE: hash-0-b ;
|
||||
|
||||
M: hash-0-b hashcode* 2drop 0 ;
|
||||
|
||||
[ ] [
|
||||
PH{ }
|
||||
"a" T{ hash-0-a } rot new-at
|
||||
"b" T{ hash-0-b } rot new-at
|
||||
"ph" set
|
||||
] unit-test
|
||||
|
||||
[
|
||||
H{
|
||||
{ T{ hash-0-a } "a" }
|
||||
{ T{ hash-0-b } "b" }
|
||||
}
|
||||
] [ "ph" get >hashtable ] unit-test
|
||||
|
||||
[
|
||||
H{
|
||||
{ T{ hash-0-b } "b" }
|
||||
}
|
||||
] [ "ph" get T{ hash-0-a } swap pluck-at >hashtable ] unit-test
|
||||
|
||||
[
|
||||
H{
|
||||
{ T{ hash-0-a } "a" }
|
||||
}
|
||||
] [ "ph" get T{ hash-0-b } swap pluck-at >hashtable ] unit-test
|
||||
|
||||
[
|
||||
H{
|
||||
{ T{ hash-0-a } "a" }
|
||||
{ T{ hash-0-b } "b" }
|
||||
}
|
||||
] [ "ph" get "X" swap pluck-at >hashtable ] unit-test
|
||||
|
||||
[ ] [
|
||||
PH{ }
|
||||
"B" "A" rot new-at
|
||||
"D" "C" rot new-at
|
||||
"ph" set
|
||||
] unit-test
|
||||
|
||||
[ H{ { "A" "B" } { "C" "D" } } ] [
|
||||
"ph" get >hashtable
|
||||
] unit-test
|
||||
|
||||
[ H{ { "C" "D" } } ] [
|
||||
"ph" get "A" swap pluck-at >hashtable
|
||||
] unit-test
|
||||
|
||||
[ H{ { "A" "B" } { "C" "D" } { "E" "F" } } ] [
|
||||
"ph" get "F" "E" rot new-at >hashtable
|
||||
] unit-test
|
||||
|
||||
[ H{ { "C" "D" } { "E" "F" } } ] [
|
||||
"ph" get "F" "E" rot new-at "A" swap pluck-at >hashtable
|
||||
] unit-test
|
||||
|
||||
: random-string ( -- str )
|
||||
1000000 random ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ;
|
||||
|
||||
: random-assocs ( -- hash phash )
|
||||
[ random-string ] replicate
|
||||
[ H{ } clone [ '[ swap , set-at ] each-index ] keep ]
|
||||
[ PH{ } clone swap [ spin new-at ] each-index ]
|
||||
bi ;
|
||||
|
||||
: ok? ( assoc1 assoc2 -- ? )
|
||||
[ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ;
|
||||
|
||||
: test-persistent-hashtables-1 ( n -- )
|
||||
random-assocs ok? ;
|
||||
|
||||
[ t ] [ 10 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 20 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 30 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 50 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 100 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 500 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 1000 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 5000 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 10000 test-persistent-hashtables-1 ] unit-test
|
||||
[ t ] [ 50000 test-persistent-hashtables-1 ] unit-test
|
||||
|
||||
: test-persistent-hashtables-2 ( n -- )
|
||||
random-assocs
|
||||
dup keys [
|
||||
[ nip over delete-at ] [ swap pluck-at nip ] 3bi
|
||||
2dup ok?
|
||||
] all? 2nip ;
|
||||
|
||||
[ t ] [ 6000 test-persistent-hashtables-2 ] unit-test
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: kernel math accessors assocs fry combinators parser
|
||||
prettyprint.backend namespaces
|
||||
persistent.assocs
|
||||
persistent.hashtables.nodes
|
||||
persistent.hashtables.nodes.empty
|
||||
persistent.hashtables.nodes.leaf
|
||||
persistent.hashtables.nodes.full
|
||||
persistent.hashtables.nodes.bitmap
|
||||
persistent.hashtables.nodes.collision ;
|
||||
IN: persistent.hashtables
|
||||
|
||||
TUPLE: persistent-hash
|
||||
{ root read-only initial: empty-node }
|
||||
{ count fixnum read-only } ;
|
||||
|
||||
M: persistent-hash assoc-size count>> ;
|
||||
|
||||
M: persistent-hash at*
|
||||
[ dup hashcode >fixnum ] [ root>> ] bi* (entry-at)
|
||||
dup [ value>> t ] [ f ] if ;
|
||||
|
||||
M: persistent-hash new-at ( value key assoc -- assoc' )
|
||||
[
|
||||
{ [ 0 ] [ ] [ dup hashcode >fixnum ] [ root>> ] } spread
|
||||
(new-at) 1 0 ?
|
||||
] [ count>> ] bi +
|
||||
persistent-hash boa ;
|
||||
|
||||
M: persistent-hash pluck-at
|
||||
[ [ dup hashcode >fixnum ] [ root>> ] bi* (pluck-at) ] keep
|
||||
{
|
||||
{ [ 2dup root>> eq? ] [ nip ] }
|
||||
{ [ over not ] [ 2drop T{ persistent-hash } ] }
|
||||
[ count>> 1- persistent-hash boa ]
|
||||
} cond ;
|
||||
|
||||
M: persistent-hash >alist [ root>> >alist% ] { } make ;
|
||||
|
||||
: >persistent-hash ( assoc -- phash )
|
||||
T{ persistent-hash } swap [ spin new-at ] assoc-each ;
|
||||
|
||||
: PH{ \ } [ >persistent-hash ] parse-literal ; parsing
|
||||
|
||||
M: persistent-hash pprint-delims drop \ PH{ \ } ;
|
||||
|
||||
M: persistent-hash >pprint-sequence >alist ;
|
||||
|
|
@ -0,0 +1,86 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: math math.bit-count arrays kernel accessors locals sequences
|
||||
sequences.private sequences.lib
|
||||
persistent.sequences
|
||||
persistent.hashtables.config
|
||||
persistent.hashtables.nodes ;
|
||||
IN: persistent.hashtables.nodes.bitmap
|
||||
|
||||
: index ( bit bitmap -- n ) [ 1- ] dip bitand bit-count ; inline
|
||||
|
||||
M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry )
|
||||
[let* | shift [ bitmap-node shift>> ]
|
||||
bit [ hashcode shift bitpos ]
|
||||
bitmap [ bitmap-node bitmap>> ]
|
||||
nodes [ bitmap-node nodes>> ] |
|
||||
bitmap bit bitand 0 eq? [ f ] [
|
||||
key hashcode
|
||||
bit bitmap index nodes nth-unsafe
|
||||
(entry-at)
|
||||
] if
|
||||
] ;
|
||||
|
||||
M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-leaf )
|
||||
[let* | shift [ bitmap-node shift>> ]
|
||||
bit [ hashcode shift bitpos ]
|
||||
bitmap [ bitmap-node bitmap>> ]
|
||||
idx [ bit bitmap index ]
|
||||
nodes [ bitmap-node nodes>> ] |
|
||||
bitmap bit bitand 0 eq? [
|
||||
[let | new-leaf [ value key hashcode <leaf-node> ] |
|
||||
bitmap bit bitor
|
||||
new-leaf idx nodes insert-nth
|
||||
shift
|
||||
<bitmap-node>
|
||||
new-leaf
|
||||
]
|
||||
] [
|
||||
[let | n [ idx nodes nth ] |
|
||||
shift radix-bits + value key hashcode n (new-at)
|
||||
[let | new-leaf [ ] n' [ ] |
|
||||
n n' eq? [
|
||||
bitmap-node
|
||||
] [
|
||||
bitmap
|
||||
n' idx nodes new-nth
|
||||
shift
|
||||
<bitmap-node>
|
||||
] if
|
||||
new-leaf
|
||||
]
|
||||
]
|
||||
] if
|
||||
] ;
|
||||
|
||||
M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
|
||||
[let | bit [ hashcode bitmap-node shift>> bitpos ]
|
||||
bitmap [ bitmap-node bitmap>> ]
|
||||
nodes [ bitmap-node nodes>> ]
|
||||
shift [ bitmap-node shift>> ] |
|
||||
bit bitmap bitand 0 eq? [ bitmap-node ] [
|
||||
[let* | idx [ bit bitmap index ]
|
||||
n [ idx nodes nth-unsafe ]
|
||||
n' [ key hashcode n (pluck-at) ] |
|
||||
n n' eq? [
|
||||
bitmap-node
|
||||
] [
|
||||
n' [
|
||||
bitmap
|
||||
n' idx nodes new-nth
|
||||
shift
|
||||
<bitmap-node>
|
||||
] [
|
||||
bitmap bit eq? [ f ] [
|
||||
bitmap bit bitnot bitand
|
||||
idx nodes remove-nth
|
||||
shift
|
||||
<bitmap-node>
|
||||
] if
|
||||
] if
|
||||
] if
|
||||
]
|
||||
] if
|
||||
] ;
|
||||
|
||||
M: bitmap-node >alist% ( node -- ) nodes>> >alist-each% ;
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: kernel accessors math arrays fry sequences sequences.lib
|
||||
locals persistent.sequences
|
||||
persistent.hashtables.config
|
||||
persistent.hashtables.nodes
|
||||
persistent.hashtables.nodes.leaf ;
|
||||
IN: persistent.hashtables.nodes.collision
|
||||
|
||||
: find-index ( key hashcode collision-node -- n leaf-node )
|
||||
leaves>> -rot '[ , , _ matching-key? ] find ; inline
|
||||
|
||||
M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node )
|
||||
key hashcode collision-node find-index nip ;
|
||||
|
||||
M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node )
|
||||
hashcode collision-node hashcode>> eq? [
|
||||
[let | idx [ key hashcode collision-node find-index drop ] |
|
||||
idx [
|
||||
idx collision-node leaves>> smash [
|
||||
collision-node hashcode>>
|
||||
<collision-node>
|
||||
] when
|
||||
] [ collision-node ] if
|
||||
]
|
||||
] [ collision-node ] if ;
|
||||
|
||||
M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf )
|
||||
hashcode collision-node hashcode>> eq? [
|
||||
key hashcode collision-node find-index
|
||||
[let | leaf-node [ ] idx [ ] |
|
||||
idx [
|
||||
value leaf-node value>> = [
|
||||
collision-node f
|
||||
] [
|
||||
hashcode
|
||||
value key hashcode <leaf-node>
|
||||
idx
|
||||
collision-node leaves>>
|
||||
new-nth
|
||||
<collision-node>
|
||||
f
|
||||
] if
|
||||
] [
|
||||
[let | new-leaf-node [ value key hashcode <leaf-node> ] |
|
||||
hashcode
|
||||
collision-node leaves>>
|
||||
new-leaf-node
|
||||
suffix
|
||||
<collision-node>
|
||||
new-leaf-node
|
||||
]
|
||||
] if
|
||||
]
|
||||
] [
|
||||
shift collision-node value key hashcode make-bitmap-node
|
||||
] if ;
|
||||
|
||||
M: collision-node >alist% leaves>> >alist-each% ;
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: accessors kernel locals persistent.hashtables.nodes ;
|
||||
IN: persistent.hashtables.nodes.empty
|
||||
|
||||
M: empty-node (entry-at) 3drop f ;
|
||||
|
||||
M: empty-node (pluck-at) 2nip ;
|
||||
|
||||
M:: empty-node (new-at) ( shift value key hashcode node -- node' added-leaf )
|
||||
value key hashcode <leaf-node> dup ;
|
||||
|
||||
M: empty-node >alist% drop ;
|
||||
|
||||
M: empty-node hashcode>> drop 0 ;
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: math accessors kernel arrays sequences sequences.private
|
||||
locals sequences.lib
|
||||
persistent.sequences
|
||||
persistent.hashtables.config
|
||||
persistent.hashtables.nodes ;
|
||||
IN: persistent.hashtables.nodes.full
|
||||
|
||||
M:: full-node (new-at) ( shift value key hashcode full-node -- node' added-leaf )
|
||||
[let* | nodes [ full-node nodes>> ]
|
||||
idx [ hashcode full-node shift>> mask ]
|
||||
n [ idx nodes nth-unsafe ] |
|
||||
shift radix-bits + value key hashcode n (new-at)
|
||||
[let | new-leaf [ ] n' [ ] |
|
||||
n n' eq? [
|
||||
full-node
|
||||
] [
|
||||
n' idx nodes new-nth shift <full-node>
|
||||
] if
|
||||
new-leaf
|
||||
]
|
||||
] ;
|
||||
|
||||
M:: full-node (pluck-at) ( key hashcode full-node -- node' )
|
||||
[let* | idx [ hashcode full-node shift>> mask ]
|
||||
n [ idx full-node nodes>> nth ]
|
||||
n' [ key hashcode n (pluck-at) ] |
|
||||
n n' eq? [
|
||||
full-node
|
||||
] [
|
||||
n' [
|
||||
n' idx full-node nodes>> new-nth
|
||||
full-node shift>>
|
||||
<full-node>
|
||||
] [
|
||||
hashcode full-node shift>> bitpos bitnot full-bitmap-mask bitand
|
||||
idx full-node nodes>> remove-nth
|
||||
full-node shift>>
|
||||
<bitmap-node>
|
||||
] if
|
||||
] if
|
||||
] ;
|
||||
|
||||
M:: full-node (entry-at) ( key hashcode full-node -- node' )
|
||||
key hashcode
|
||||
hashcode full-node shift>> mask
|
||||
full-node nodes>> nth-unsafe
|
||||
(entry-at) ;
|
||||
|
||||
M: full-node >alist% nodes>> >alist-each% ;
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: kernel accessors locals math arrays namespaces
|
||||
persistent.hashtables.config
|
||||
persistent.hashtables.nodes ;
|
||||
IN: persistent.hashtables.nodes.leaf
|
||||
|
||||
: matching-key? ( key hashcode leaf-node -- ? )
|
||||
tuck hashcode>> eq? [ key>> = ] [ 2drop f ] if ; inline
|
||||
|
||||
M: leaf-node (entry-at) [ matching-key? ] keep and ;
|
||||
|
||||
M: leaf-node (pluck-at) [ matching-key? not ] keep and ;
|
||||
|
||||
M:: leaf-node (new-at) ( shift value key hashcode leaf-node -- node' added-leaf )
|
||||
hashcode leaf-node hashcode>> eq? [
|
||||
key leaf-node key>> = [
|
||||
value leaf-node value>> =
|
||||
[ leaf-node f ] [ value key hashcode <leaf-node> f ] if
|
||||
] [
|
||||
[let | new-leaf [ value key hashcode <leaf-node> ] |
|
||||
hashcode leaf-node new-leaf 2array <collision-node>
|
||||
new-leaf
|
||||
]
|
||||
] if
|
||||
] [ shift leaf-node value key hashcode make-bitmap-node ] if ;
|
||||
|
||||
M: leaf-node >alist% [ key>> ] [ value>> ] bi 2array , ;
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: math arrays kernel sequences sequences.lib
|
||||
accessors locals persistent.hashtables.config ;
|
||||
IN: persistent.hashtables.nodes
|
||||
|
||||
SINGLETON: empty-node
|
||||
|
||||
TUPLE: leaf-node
|
||||
{ value read-only }
|
||||
{ key read-only }
|
||||
{ hashcode fixnum read-only } ;
|
||||
|
||||
C: <leaf-node> leaf-node
|
||||
|
||||
TUPLE: collision-node
|
||||
{ hashcode fixnum read-only }
|
||||
{ leaves array read-only } ;
|
||||
|
||||
C: <collision-node> collision-node
|
||||
|
||||
TUPLE: full-node
|
||||
{ nodes array read-only }
|
||||
{ shift fixnum read-only }
|
||||
{ hashcode fixnum read-only } ;
|
||||
|
||||
: <full-node> ( nodes shift -- node )
|
||||
over first hashcode>> full-node boa ;
|
||||
|
||||
TUPLE: bitmap-node
|
||||
{ bitmap fixnum read-only }
|
||||
{ nodes array read-only }
|
||||
{ shift fixnum read-only }
|
||||
{ hashcode fixnum read-only } ;
|
||||
|
||||
: <bitmap-node> ( bitmap nodes shift -- node )
|
||||
pick full-bitmap-mask =
|
||||
[ <full-node> nip ]
|
||||
[ over first hashcode>> bitmap-node boa ] if ;
|
||||
|
||||
GENERIC: (entry-at) ( key hashcode node -- entry )
|
||||
|
||||
GENERIC: (new-at) ( shift value key hashcode node -- node' added-leaf )
|
||||
|
||||
GENERIC: (pluck-at) ( key hashcode node -- node' )
|
||||
|
||||
GENERIC: >alist% ( node -- )
|
||||
|
||||
: >alist-each% ( nodes -- ) [ >alist% ] each ;
|
||||
|
||||
: mask ( hash shift -- n ) neg shift radix-mask bitand ; inline
|
||||
|
||||
: bitpos ( hash shift -- n ) mask 2^ ; inline
|
||||
|
||||
: smash ( idx seq -- seq/elt ? )
|
||||
dup length 2 = [ [ 1 = ] dip first2 ? f ] [ remove-nth t ] if ; inline
|
||||
|
||||
:: make-bitmap-node ( shift branch value key hashcode -- node' added-leaf )
|
||||
shift value key hashcode
|
||||
branch hashcode>> shift bitpos
|
||||
branch 1array
|
||||
shift
|
||||
<bitmap-node>
|
||||
(new-at) ; inline
|
||||
|
|
@ -0,0 +1 @@
|
|||
Persistent hashtables with O(1) insertion, removal and lookup
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.syntax help.markup kernel arrays assocs ;
|
||||
IN: persistent-heaps
|
||||
IN: persistent.heaps
|
||||
|
||||
HELP: <persistent-heap>
|
||||
{ $values { "heap" "a persistent heap" } }
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
USING: persistent-heaps tools.test ;
|
||||
IN: persistent-heaps.tests
|
||||
USING: persistent.heaps tools.test ;
|
||||
IN: persistent.heaps.tests
|
||||
|
||||
: test-input
|
||||
{ { "hello" 3 } { "goodbye" 2 } { "whatever" 5 }
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
USING: kernel accessors multi-methods locals combinators math arrays
|
||||
assocs namespaces sequences ;
|
||||
IN: persistent-heaps
|
||||
IN: persistent.heaps
|
||||
! These are minheaps
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -0,0 +1 @@
|
|||
collections
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
IN: persistent.sequences
|
||||
USING: help.markup help.syntax math sequences kernel ;
|
||||
|
||||
HELP: new-nth
|
||||
{ $values { "val" object } { "i" integer } { "seq" sequence } { "seq'" sequence } }
|
||||
{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." }
|
||||
{ $notes "This operation runs in " { $snippet "O(log_32 n)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ;
|
||||
|
||||
HELP: ppush
|
||||
{ $values { "val" object } { "seq" sequence } { "seq'" sequence } }
|
||||
{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." }
|
||||
{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ;
|
||||
|
||||
HELP: ppop
|
||||
{ $values { "seq" sequence } { "seq'" sequence } }
|
||||
{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." }
|
||||
{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ;
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences kernel ;
|
||||
IN: persistent.sequences
|
||||
|
||||
GENERIC: ppush ( val seq -- seq' )
|
||||
|
||||
M: sequence ppush swap suffix ;
|
||||
|
||||
GENERIC: ppop ( seq -- seq' )
|
||||
|
||||
M: sequence ppop 1 head* ;
|
||||
|
||||
GENERIC: new-nth ( val i seq -- seq' )
|
||||
|
||||
M: sequence new-nth clone [ set-nth ] keep ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Persistent sequence protocol
|
||||
|
|
@ -0,0 +1 @@
|
|||
collections
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1 @@
|
|||
Immutable vectors with O(log_32 n) random access, push, and pop
|
||||
|
|
@ -0,0 +1 @@
|
|||
collections
|
||||
|
|
@ -1,21 +1,6 @@
|
|||
USING: help.markup help.syntax kernel math sequences ;
|
||||
IN: persistent-vectors
|
||||
|
||||
HELP: new-nth
|
||||
{ $values { "val" object } { "i" integer } { "seq" sequence } { "seq'" sequence } }
|
||||
{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." }
|
||||
{ $notes "This operation runs in " { $snippet "O(log_32 n)" } " time on " { $link persistent-vector } " instances and " { $snippet "O(n)" } " time on all other sequences." } ;
|
||||
|
||||
HELP: ppush
|
||||
{ $values { "val" object } { "seq" sequence } { "seq'" sequence } }
|
||||
{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." }
|
||||
{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link persistent-vector } " instances and " { $snippet "O(n)" } " time on all other sequences." } ;
|
||||
|
||||
HELP: ppop
|
||||
{ $values { "seq" sequence } { "seq'" sequence } }
|
||||
{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." }
|
||||
{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link persistent-vector } " instances and " { $snippet "O(n)" } " time on all other sequences." } ;
|
||||
|
||||
HELP: PV{
|
||||
{ $syntax "elements... }" }
|
||||
{ $description "Parses a literal " { $link persistent-vector } "." } ;
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
IN: persistent-vectors.tests
|
||||
USING: accessors tools.test persistent-vectors sequences kernel
|
||||
arrays random namespaces vectors math math.order ;
|
||||
USING: accessors tools.test persistent.vectors
|
||||
persistent.sequences sequences kernel arrays random namespaces
|
||||
vectors math math.order ;
|
||||
|
||||
\ new-nth must-infer
|
||||
\ ppush must-infer
|
||||
|
|
@ -1,8 +1,9 @@
|
|||
! Based on Clojure's PersistentVector by Rich Hickey.
|
||||
|
||||
USING: math accessors kernel sequences.private sequences arrays
|
||||
combinators combinators.short-circuit parser prettyprint.backend ;
|
||||
IN: persistent-vectors
|
||||
combinators combinators.short-circuit parser prettyprint.backend
|
||||
persistent.sequences ;
|
||||
IN: persistent.vectors
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -12,18 +13,6 @@ PRIVATE>
|
|||
|
||||
ERROR: empty-error pvec ;
|
||||
|
||||
GENERIC: ppush ( val seq -- seq' )
|
||||
|
||||
M: sequence ppush swap suffix ;
|
||||
|
||||
GENERIC: ppop ( seq -- seq' )
|
||||
|
||||
M: sequence ppop 1 head* ;
|
||||
|
||||
GENERIC: new-nth ( val i seq -- seq' )
|
||||
|
||||
M: sequence new-nth clone [ set-nth ] keep ;
|
||||
|
||||
TUPLE: persistent-vector
|
||||
{ count fixnum }
|
||||
{ root node initial: T{ node f { } 1 } }
|
||||
|
|
@ -212,7 +212,7 @@ HELP: bit?
|
|||
|
||||
HELP: log2
|
||||
{ $values { "x" "a positive integer" } { "n" integer } }
|
||||
{ $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "2^n" } " is less than " { $snippet "x" } "." }
|
||||
{ $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "2^n" } " is less than or equal to " { $snippet "x" } "." }
|
||||
{ $errors "Throws an error if " { $snippet "x" } " is zero or negative." } ;
|
||||
|
||||
HELP: 1+
|
||||
|
|
|
|||
|
|
@ -0,0 +1,38 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions quotations words sequences
|
||||
sequences.private combinators fry ;
|
||||
IN: math.bit-count
|
||||
|
||||
<PRIVATE
|
||||
|
||||
DEFER: byte-bit-count
|
||||
|
||||
<<
|
||||
|
||||
\ byte-bit-count
|
||||
256 [
|
||||
0 swap [ [ 1+ ] when ] each-bit
|
||||
] B{ } map-as '[ HEX: ff bitand , nth-unsafe ] define-inline
|
||||
|
||||
>>
|
||||
|
||||
GENERIC: (bit-count) ( x -- n )
|
||||
|
||||
M: fixnum (bit-count)
|
||||
{
|
||||
[ byte-bit-count ]
|
||||
[ -8 shift byte-bit-count ]
|
||||
[ -16 shift byte-bit-count ]
|
||||
[ -24 shift byte-bit-count ]
|
||||
} cleave + + + ;
|
||||
|
||||
M: bignum (bit-count)
|
||||
dup 0 = [ drop 0 ] [
|
||||
[ byte-bit-count ] [ -8 shift (bit-count) ] bi +
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: bit-count ( x -- n )
|
||||
dup 0 >= [ (bit-count) ] [ bitnot (bit-count) ] if ; inline
|
||||
|
|
@ -1 +0,0 @@
|
|||
Immutable vectors with O(log_32 n) random access and amortized O(1) push/pop
|
||||
|
|
@ -205,8 +205,11 @@ PRIVATE>
|
|||
: nths ( seq indices -- seq' )
|
||||
swap [ nth ] curry map ;
|
||||
|
||||
: remove-nth ( seq n -- seq' )
|
||||
cut-slice rest-slice append ;
|
||||
: remove-nth ( n seq -- seq' )
|
||||
[ swap head-slice ] [ swap 1+ tail-slice ] 2bi append ;
|
||||
|
||||
: insert-nth ( elt n seq -- seq' )
|
||||
swap cut-slice [ swap 1array ] dip 3append ;
|
||||
|
||||
: if-seq ( seq quot1 quot2 -- )
|
||||
[ f like ] 2dip if* ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue