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

give cords a shot of red bull

db4
Joe Groff 2009-10-06 10:46:09 -05:00
parent fb8eeb6065
commit f7820f9b51
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/cords/cords.factor
View File

@ -6,35 +6,37 @@ IN: cords
<PRIVATE <PRIVATE
TUPLE: simple-cord first second ; TUPLE: simple-cord
{ first read-only } { second read-only } ;
M: simple-cord length M: simple-cord length
[ first>> length ] [ second>> length ] bi + ; [ first>> length ] [ second>> length ] bi + ; inline
M: simple-cord virtual-seq first>> ; M: simple-cord virtual-seq first>> ; inline
M: simple-cord virtual@ M: simple-cord virtual@
2dup first>> length < 2dup first>> length <
[ first>> ] [ [ first>> length - ] [ second>> ] bi ] if ; [ first>> ] [ [ first>> length - ] [ second>> ] bi ] if ; inline
TUPLE: multi-cord count seqs ; TUPLE: multi-cord
{ count read-only } { seqs read-only } ;
M: multi-cord length count>> ; M: multi-cord length count>> ; inline
M: multi-cord virtual@ M: multi-cord virtual@
dupd dupd
seqs>> [ first <=> ] with search nip seqs>> [ first <=> ] with search nip
[ first - ] [ second ] bi ; [ first - ] [ second ] bi ; inline
M: multi-cord virtual-seq M: multi-cord virtual-seq
seqs>> [ f ] [ first second ] if-empty ; seqs>> [ f ] [ first second ] if-empty ; inline
: <cord> ( seqs -- cord ) : <cord> ( seqs -- cord )
dup length 2 = [ dup length 2 = [
first2 simple-cord boa first2 simple-cord boa
] [ ] [
[ 0 [ length + ] accumulate ] keep zip multi-cord boa [ 0 [ length + ] accumulate ] keep zip multi-cord boa
] if ; ] if ; inline
PRIVATE> PRIVATE>
@ -52,7 +54,7 @@ INSTANCE: multi-cord virtual-sequence
{ [ over cord? ] [ [ seqs>> values ] dip suffix <cord> ] } { [ over cord? ] [ [ seqs>> values ] dip suffix <cord> ] }
{ [ dup cord? ] [ seqs>> values swap prefix <cord> ] } { [ dup cord? ] [ seqs>> values swap prefix <cord> ] }
[ 2array <cord> ] [ 2array <cord> ]
} cond ; } cond ; inline
: cord-concat ( seqs -- cord ) : cord-concat ( seqs -- cord )
{ {
@ -67,4 +69,4 @@ INSTANCE: multi-cord virtual-sequence
} cond } cond
] map concat <cord> ] map concat <cord>
] ]
} cond ; } cond ; inline