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

Slight cleanup

db4
Slava Pestov 2008-06-15 00:32:48 -05:00
parent 5b4809e49d
commit 229ad78907
3 changed files with 14 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
core/assocs/assocs.factor
View File

@ -20,26 +20,25 @@ GENERIC: assoc-clone-like ( assoc exemplar -- newassoc )
GENERIC: >alist ( assoc -- newassoc ) GENERIC: >alist ( assoc -- newassoc )
: (assoc-each) ( assoc quot -- seq quot' )
>r >alist r> [ first2 ] prepose ; inline
: assoc-find ( assoc quot -- key value ? ) : assoc-find ( assoc quot -- key value ? )
>r >alist r> [ first2 ] prepose find swap (assoc-each) find swap [ first2 t ] [ drop f f f ] if ; inline
[ first2 t ] [ drop f f f ] if ; inline
: key? ( key assoc -- ? ) at* nip ; inline : key? ( key assoc -- ? ) at* nip ; inline
: assoc-each ( assoc quot -- ) : assoc-each ( assoc quot -- )
[ f ] compose assoc-find 3drop ; inline (assoc-each) each ; inline
: (assoc>map) ( quot accum -- quot' )
[ push ] curry compose ; inline
: assoc>map ( assoc quot exemplar -- seq ) : assoc>map ( assoc quot exemplar -- seq )
>r over assoc-size >r accumulator >r assoc-each r> r> like ; inline
<vector> [ (assoc>map) assoc-each ] keep
r> like ; inline : assoc-map-as ( assoc quot exemplar -- newassoc )
>r [ 2array ] compose V{ } assoc>map r> assoc-like ; inline
: assoc-map ( assoc quot -- newassoc ) : assoc-map ( assoc quot -- newassoc )
over >r [ 2array ] compose V{ } assoc>map r> assoc-like ; over assoc-map-as ; inline
inline
: assoc-push-if ( key value quot accum -- ) : assoc-push-if ( key value quot accum -- )
>r 2keep r> roll >r 2keep r> roll

7
core/sequences/sequences.factor
View File

@ -419,10 +419,11 @@ PRIVATE>
: interleave ( seq between quot -- ) : interleave ( seq between quot -- )
[ (interleave) ] 2curry >r dup length swap r> 2each ; inline [ (interleave) ] 2curry >r dup length swap r> 2each ; inline
: accumulator ( quot -- quot' vec )
V{ } clone [ [ push ] curry compose ] keep ; inline
: unfold ( pred quot tail -- seq ) : unfold ( pred quot tail -- seq )
V{ } clone [ swap accumulator >r swap while r> { } like ; inline
swap >r [ push ] curry compose r> while
] keep { } like ; inline
: follow ( obj quot -- seq ) : follow ( obj quot -- seq )
>r [ dup ] r> [ keep ] curry [ ] unfold nip ; inline >r [ dup ] r> [ keep ] curry [ ] unfold nip ; inline

3
extra/sequences/lib/lib.factor
View File

@ -201,9 +201,6 @@ USE: continuations
>r >r 0 max r> r> >r >r 0 max r> r>
[ length tuck min >r min r> ] keep subseq ; [ length tuck min >r min r> ] keep subseq ;
: accumulator ( quot -- quot vec )
V{ } clone [ [ push ] curry compose ] keep ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! List the positions of obj in seq ! List the positions of obj in seq