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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-07-05 17:08:09 -05:00
parent a8b826e8ed d532c819a2
commit 64a10be386
3 changed files with 48 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
extra/combinators/cleave/cleave-tests.factor Normal file
View File

@ -0,0 +1,19 @@
USING: kernel math math.functions tools.test combinators.cleave ;
IN: combinators.cleave.tests
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: unit-test* ( input output -- ) swap unit-test ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ { [ 1 ] [ 2 ] [ 3 ] [ 4 ] } 0arr ] [ { 1 2 3 4 } ] unit-test*
[ 3 { 1+ 1- 2^ } 1arr ] [ { 4 2 8 } ] unit-test*
[ 3 4 { [ + ] [ - ] [ ^ ] } 2arr ] [ { 7 -1 81 } ] unit-test*
[ 1 2 3 { [ + + ] [ - - ] [ * * ] } 3arr ] [ { 6 2 6 } ] unit-test*

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

@ -1,17 +1,36 @@
USING: kernel arrays sequences macros combinators ;
USING: kernel combinators words quotations arrays sequences locals macros
shuffle combinators.lib arrays.lib fry ;
IN: combinators.cleave
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: >quot ( obj -- quot ) dup word? [ 1quotation ] when ;
: >quots ( seq -- seq ) [ >quot ] map ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: [ncleave] ( SEQ N -- quot )
SEQ >quots [ [ N nkeep ] curry ] map concat [ N ndrop ] append >quotation ;
MACRO: ncleave ( seq n -- quot ) [ncleave] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 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 -- )
[ >quots ] [ length ] bi

6
extra/newfx/newfx.factor
View File

@ -237,3 +237,9 @@ METHOD: as-mutate { object object assoc } set-at ;
: prepend! ( a b -- ba ) over append 0 pick copy ;
: prepended! ( a b -- ) over append 0 rot copy ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: insert ( seq i obj -- seq ) >r cut r> prefix append ;
: splice ( seq i seq -- seq ) >r cut r> prepend append ;