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

combinators.cleave: narr and arity variants

db4
Eduardo Cavazos 2008-07-05 07:25:10 -05:00
parent a5751f9cc1
commit 0b6d405537
1 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
extra/combinators/cleave/cleave.factor
View File

@ -1,13 +1,19 @@
USING: kernel combinators quotations arrays sequences locals macros USING: kernel combinators words quotations arrays sequences locals macros
shuffle combinators.lib ; shuffle combinators.lib arrays.lib fry ;
IN: combinators.cleave IN: combinators.cleave
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: >quot ( obj -- quot ) dup word? [ 1quotation ] when ;
: >quots ( seq -- seq ) [ >quot ] map ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: [ncleave] ( SEQ N -- quot ) :: [ncleave] ( SEQ N -- quot )
SEQ [ [ N nkeep ] curry ] map concat [ N ndrop ] append >quotation ; SEQ >quots [ [ N nkeep ] curry ] map concat [ N ndrop ] append >quotation ;
MACRO: ncleave ( seq n -- quot ) [ncleave] ; MACRO: ncleave ( seq n -- quot ) [ncleave] ;
@ -15,11 +21,16 @@ MACRO: ncleave ( seq n -- quot ) [ncleave] ;
! Cleave into array ! Cleave into array
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USING: words quotations fry arrays.lib ; : [narr] ( seq n -- quot ) over length '[ , , ncleave , narray ] ;
: >quot ( obj -- quot ) dup word? [ 1quotation ] when ; MACRO: narr ( seq n -- array ) [narr] ;
: >quots ( seq -- seq ) [ >quot ] map ; MACRO: 0arr ( seq -- array ) 0 [narr] ;
MACRO: 1arr ( seq -- array ) 1 [narr] ;
MACRO: 2arr ( seq -- array ) 2 [narr] ;
MACRO: 3arr ( seq -- array ) 3 [narr] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: <arr> ( seq -- ) MACRO: <arr> ( seq -- )
[ >quots ] [ length ] bi [ >quots ] [ length ] bi