Simplify lazy-while and lazy-until constructs
parent
4eb7aad50b
commit
0bf5c6bf0f
|
@ -211,17 +211,17 @@ TUPLE: lazy-until cons quot ;
|
||||||
C: <lazy-until> lazy-until
|
C: <lazy-until> lazy-until
|
||||||
|
|
||||||
: luntil ( list quot -- result )
|
: luntil ( list quot -- result )
|
||||||
<lazy-until> ;
|
over nil? [ drop ] [ <lazy-until> ] if ;
|
||||||
|
|
||||||
M: lazy-until car ( lazy-until -- car )
|
M: lazy-until car ( lazy-until -- car )
|
||||||
lazy-until-cons car ;
|
lazy-until-cons car ;
|
||||||
|
|
||||||
M: lazy-until cdr ( lazy-until -- cdr )
|
M: lazy-until cdr ( lazy-until -- cdr )
|
||||||
[ lazy-until-cons uncons ] keep lazy-until-quot
|
[ lazy-until-cons uncons swap ] keep lazy-until-quot tuck call
|
||||||
rot over call [ 2drop nil ] [ luntil ] if ;
|
[ 2drop nil ] [ luntil ] if ;
|
||||||
|
|
||||||
M: lazy-until nil? ( lazy-until -- bool )
|
M: lazy-until nil? ( lazy-until -- bool )
|
||||||
lazy-until-cons nil? ;
|
drop f ;
|
||||||
|
|
||||||
M: lazy-until list? ( lazy-until -- bool )
|
M: lazy-until list? ( lazy-until -- bool )
|
||||||
drop t ;
|
drop t ;
|
||||||
|
@ -231,19 +231,16 @@ TUPLE: lazy-while cons quot ;
|
||||||
C: <lazy-while> lazy-while
|
C: <lazy-while> lazy-while
|
||||||
|
|
||||||
: lwhile ( list quot -- result )
|
: lwhile ( list quot -- result )
|
||||||
<lazy-while>
|
over nil? [ drop ] [ <lazy-while> ] if ;
|
||||||
;
|
|
||||||
|
|
||||||
M: lazy-while car ( lazy-while -- car )
|
M: lazy-while car ( lazy-while -- car )
|
||||||
lazy-while-cons car ;
|
lazy-while-cons car ;
|
||||||
|
|
||||||
M: lazy-while cdr ( lazy-while -- cdr )
|
M: lazy-while cdr ( lazy-while -- cdr )
|
||||||
dup lazy-while-cons cdr dup nil?
|
[ lazy-while-cons cdr ] keep lazy-while-quot lwhile ;
|
||||||
[ 2drop nil ] [ swap lazy-while-quot lwhile ] if ;
|
|
||||||
|
|
||||||
M: lazy-while nil? ( lazy-while -- bool )
|
M: lazy-while nil? ( lazy-while -- bool )
|
||||||
dup lazy-while-cons nil?
|
[ car ] keep lazy-while-quot call not ;
|
||||||
[ nip ] [ [ car ] keep lazy-while-quot call not ] if* ;
|
|
||||||
|
|
||||||
M: lazy-while list? ( lazy-while -- bool )
|
M: lazy-while list? ( lazy-while -- bool )
|
||||||
drop t ;
|
drop t ;
|
||||||
|
|
Loading…
Reference in New Issue