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

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

db4
Doug Coleman 2008-04-01 19:03:52 -05:00
parent ae623ff924 5b65e02851
commit d3da0eb5ca
2 changed files with 68 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,5 @@
USING: kernel sequences macros combinators ;
USING: kernel arrays sequences macros combinators ;
IN: combinators.cleave
@ -21,6 +21,18 @@ MACRO: <2arr> ( seq -- )
[ >quots ] [ length ] bi
'[ , 2cleave , narray ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: {1} ( x -- {x} ) 1array ; inline
: {2} ( x y -- {x,y} ) 2array ; inline
: {3} ( x y z -- {x,y,z} ) 3array ; inline
: {n} narray ;
: {bi} ( x p q -- {p(x),q(x)} ) bi {2} ; inline
: {tri} ( x p q r -- {p(x),q(x),r(x)} ) tri {3} ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Spread into array
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -28,3 +40,8 @@ MACRO: <2arr> ( seq -- )
MACRO: <arr*> ( seq -- )
[ >quots ] [ length ] bi
'[ , spread , narray ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: {bi*} ( x y p q -- {p(x),q(y)} ) bi* {2} ; inline
: {tri*} ( x y z p q r -- {p(x),q(y),r(z)} ) tri* {3} ; inline

50
extra/newfx/newfx.factor Normal file
View File

@ -0,0 +1,50 @@
USING: kernel sequences assocs qualified ;
QUALIFIED: sequences
IN: newfx
! Now, we can see a new world coming into view.
! A world in which there is the very real prospect of a new world order.
!
! - George Herbert Walker Bush
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: nth-at ( seq i -- val ) swap nth ;
: nth-of ( i seq -- val ) nth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: nth-is ( seq i val -- seq ) swap pick set-nth ;
: is-nth ( seq val i -- seq ) pick set-nth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: at-key ( tbl key -- val ) swap at ;
: key-of ( key tbl -- val ) at ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: key-is ( tbl key val -- tbl ) swap pick set-at ;
: is-key ( tbl val key -- tbl ) pick set-at ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: push ( seq obj -- seq ) over sequences:push ;
: push-on ( obj seq -- seq ) tuck sequences:push ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: member? ( seq obj -- ? ) swap sequences:member? ;
: member-of? ( obj seq -- ? ) sequences:member? ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: delete-at-key ( tbl key -- tbl ) over delete-at ;
: delete-key-of ( key tbl -- tbl ) tuck delete-at ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!