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

Further cleanups

db4
Slava Pestov 2008-06-06 03:40:29 -05:00
parent 6d2aabea39
commit 39262a128f
2 changed files with 25 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/persistent-vectors/persistent-vectors-docs.factor
View File

@ -2,18 +2,18 @@ USING: help.markup help.syntax kernel math sequences ;
IN: persistent-vectors IN: persistent-vectors
HELP: new-nth HELP: new-nth
{ $values { "val" object } { "i" integer } { "seq" sequence } } { $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" } "." } { $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." } ; { $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 HELP: ppush
{ $values { "val" object } { "i" integer } { "seq" sequence } } { $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." } { $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." } ; { $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 HELP: ppop
{ $values { "val" object } { "i" integer } { "seq" sequence } } { $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." } { $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." } ; { $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{ HELP: PV{

43
extra/persistent-vectors/persistent-vectors.factor
View File

@ -6,7 +6,7 @@ IN: persistent-vectors
ERROR: empty-error pvec ; ERROR: empty-error pvec ;
GENERIC: ppush ( obj seq -- seq' ) GENERIC: ppush ( val seq -- seq' )
M: sequence ppush swap suffix ; M: sequence ppush swap suffix ;
@ -14,7 +14,7 @@ GENERIC: ppop ( seq -- seq' )
M: sequence ppop 1 head* ; M: sequence ppop 1 head* ;
GENERIC: new-nth ( obj i seq -- seq' ) GENERIC: new-nth ( val i seq -- seq' )
M: sequence new-nth clone [ set-nth ] keep ; M: sequence new-nth clone [ set-nth ] keep ;
@ -26,39 +26,38 @@ M: persistent-vector length count>> ;
TUPLE: node children level ; TUPLE: node children level ;
: node-mask HEX: 1f bitand ; inline
: node-size 32 ; inline : node-size 32 ; inline
: tail-offset [ count>> ] [ tail>> children>> length ] bi - ; : node-mask node-size mod ; inline
: node-shift -5 * shift ; inline : node-shift -5 * shift ; inline
: node-nth ( i node -- obj ) : node-nth ( i node -- obj )
children>> [ node-mask ] dip nth ; inline [ node-mask ] [ children>> ] bi* nth ; inline
: body-nth ( i node -- obj ) : body-nth ( i node -- i node' )
dup level>> 0 > [ dup level>> [
[ drop ] [ [ level>> node-shift ] keep node-nth ] 2bi dupd [ level>> node-shift ] keep node-nth
body-nth ] times ; inline
] [
node-nth : tail-offset ( pvec -- n )
] if ; inline [ count>> ] [ tail>> children>> length ] bi - ;
M: persistent-vector nth-unsafe M: persistent-vector nth-unsafe
2dup tail-offset >= 2dup tail-offset >=
[ tail>> node-nth ] [ root>> body-nth ] if ; [ tail>> ] [ root>> body-nth ] if
node-nth ;
: node-add ( obj node -- node' ) : node-add ( val node -- node' )
clone [ ppush ] change-children ; clone [ ppush ] change-children ;
: ppush-tail ( obj pvec -- pvec' ) : ppush-tail ( val pvec -- pvec' )
[ node-add ] change-tail ; [ node-add ] change-tail ;
: full? ( node -- ? ) : full? ( node -- ? )
children>> length node-size = ; children>> length node-size = ;
: 1node ( obj level -- node ) : 1node ( val level -- node )
node new node new
swap >>level swap >>level
swap 1array >>children ; swap 1array >>children ;
@ -69,11 +68,11 @@ M: persistent-vector nth-unsafe
: new-child ( new-child node -- node' expansion/f ) : new-child ( new-child node -- node' expansion/f )
dup full? [ tuck level>> 1node ] [ node-add f ] if ; dup full? [ tuck level>> 1node ] [ node-add f ] if ;
: pset-last ( val seq -- seq' ) : new-last ( val seq -- seq' )
[ length 1- ] keep new-nth ; [ length 1- ] keep new-nth ;
: node-set-last ( child node -- node' ) : node-set-last ( child node -- node' )
clone [ pset-last ] change-children ; clone [ new-last ] change-children ;
: (ppush-new-tail) ( tail node -- node' expansion/f ) : (ppush-new-tail) ( tail node -- node' expansion/f )
dup level>> 1 = [ dup level>> 1 = [
@ -86,12 +85,12 @@ M: persistent-vector nth-unsafe
: do-expansion ( pvec root expansion/f -- pvec ) : do-expansion ( pvec root expansion/f -- pvec )
[ 2node ] when* >>root ; [ 2node ] when* >>root ;
: ppush-new-tail ( obj pvec -- pvec' ) : ppush-new-tail ( val pvec -- pvec' )
[ ] [ tail>> ] [ root>> ] tri [ ] [ tail>> ] [ root>> ] tri
(ppush-new-tail) do-expansion (ppush-new-tail) do-expansion
swap 0 1node >>tail ; swap 0 1node >>tail ;
M: persistent-vector ppush ( obj pvec -- pvec' ) M: persistent-vector ppush ( val pvec -- pvec' )
clone clone
dup tail>> full? dup tail>> full?
[ ppush-new-tail ] [ ppush-tail ] if [ ppush-new-tail ] [ ppush-tail ] if
@ -173,7 +172,7 @@ M: persistent-vector like
M: persistent-vector equal? M: persistent-vector equal?
over persistent-vector? [ sequence= ] [ 2drop f ] if ; over persistent-vector? [ sequence= ] [ 2drop f ] if ;
: >persistent-vector ( seq -- pvec ) pempty clone-like ; inline : >persistent-vector ( seq -- pvec ) pempty like ; inline
: PV{ \ } [ >persistent-vector ] parse-literal ; parsing : PV{ \ } [ >persistent-vector ] parse-literal ; parsing