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

add combinators.cleave

release
Eduardo Cavazos 2007-11-14 17:32:06 -06:00
parent 0320068a95
commit bee5738aee
1 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
extra/combinators/cleave/cleave.factor Normal file
View File

@ -0,0 +1,32 @@
USING: kernel ;
IN: combinators.cleave
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The cleaver family
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: bi ( obj quot quot -- val val ) >r over slip r> call ; inline
: tri ( obj quot quot quot -- val val val )
>r pick >r bi r> r> call ; inline
: tetra ( obj quot quot quot quot -- val val val val )
>r >r pick >r bi r> r> r> bi ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The spread family
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: bi* ( obj obj quot quot -- val val ) >r swap >r call r> r> call ; inline
: tri* ( obj obj obj quot quot quot -- val val val )
>r rot >r bi* r> r> call ; inline
: tetra* ( obj obj obj obj quot quot quot quot -- val val val val )
>r roll >r tri* r> r> call ; inline