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

Merge branch 'for-slava' of git://www.rfc1149.net/factor

db4
Slava Pestov 2008-04-04 07:09:59 -05:00
parent 8d39853248 cf5ff72eb9
commit 26dca5d77a
3 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/lazy-lists/lazy-lists.factor
View File

@ -78,7 +78,7 @@ M: lazy-cons nil? ( lazy-cons -- bool )
swap [ cdr ] times car ; swap [ cdr ] times car ;
: (llength) ( list acc -- n ) : (llength) ( list acc -- n )
over nil? [ nip ] [ >r cdr r> 1+ (llength) ] if ; over nil? [ nip ] [ [ cdr ] dip 1+ (llength) ] if ;
: llength ( list -- n ) : llength ( list -- n )
0 (llength) ; 0 (llength) ;
@ -273,7 +273,7 @@ M: lazy-from-by car ( lazy-from-by -- car )
M: lazy-from-by cdr ( lazy-from-by -- cdr ) M: lazy-from-by cdr ( lazy-from-by -- cdr )
[ lazy-from-by-n ] keep [ lazy-from-by-n ] keep
lazy-from-by-quot dup >r call r> lfrom-by ; lazy-from-by-quot dup slip lfrom-by ;
M: lazy-from-by nil? ( lazy-from-by -- bool ) M: lazy-from-by nil? ( lazy-from-by -- bool )
drop f ; drop f ;
@ -370,10 +370,10 @@ M: lazy-concat nil? ( lazy-concat -- bool )
] if ; ] if ;
: lcomp ( list quot -- result ) : lcomp ( list quot -- result )
>r lcartesian-product* r> lmap ; [ lcartesian-product* ] dip lmap ;
: lcomp* ( list guards quot -- result ) : lcomp* ( list guards quot -- result )
>r >r lcartesian-product* r> [ lsubset ] each r> lmap ; [ [ lcartesian-product* ] dip [ lsubset ] each ] dip lmap ;
DEFER: lmerge DEFER: lmerge
@ -382,7 +382,7 @@ DEFER: lmerge
[ [
dup [ car ] curry -rot dup [ car ] curry -rot
[ [
>r cdr r> cdr lmerge [ cdr ] bi@ lmerge
] 2curry lazy-cons ] 2curry lazy-cons
] 2curry lazy-cons ; ] 2curry lazy-cons ;
@ -419,7 +419,7 @@ M: lazy-io cdr ( lazy-io -- cdr )
[ lazy-io-stream ] keep [ lazy-io-stream ] keep
[ lazy-io-quot ] keep [ lazy-io-quot ] keep
car [ car [
>r f f r> <lazy-io> [ swap set-lazy-io-cdr ] keep [ f f ] dip <lazy-io> [ swap set-lazy-io-cdr ] keep
] [ ] [
3drop nil 3drop nil
] if ] if

2
extra/math/primes/primes.factor
View File

@ -45,7 +45,7 @@ PRIVATE>
: primes-between ( low high -- seq ) : primes-between ( low high -- seq )
primes-upto primes-upto
>r 1- next-prime r> [ 1- next-prime ] dip
[ [ <=> ] binsearch ] keep [ length ] keep <slice> ; foldable [ [ <=> ] binsearch ] keep [ length ] keep <slice> ; foldable
: coprime? ( a b -- ? ) gcd nip 1 = ; foldable : coprime? ( a b -- ? ) gcd nip 1 = ; foldable

2
extra/project-euler/169/169.factor
View File

@ -30,7 +30,7 @@ MEMO: fn ( n -- x )
{ {
{ [ dup 2 < ] [ drop 1 ] } { [ dup 2 < ] [ drop 1 ] }
{ [ dup odd? ] [ 2/ fn ] } { [ dup odd? ] [ 2/ fn ] }
{ [ t ] [ 2/ [ fn ] keep 1- fn + ] } { [ t ] [ 2/ [ fn ] [ 1- fn + ] bi + ] }
} cond ; } cond ;
: euler169 ( -- result ) : euler169 ( -- result )