generalize stack effect of while, until, and produce
parent
9571bf6d4b
commit
17df15280e
|
@ -177,10 +177,10 @@ UNION: boolean POSTPONE: t POSTPONE: f ;
|
|||
: do ( pred body -- pred body )
|
||||
dup 2dip ; inline
|
||||
|
||||
: while ( ... pred: ( ... -- ... ? ) body: ( ... -- ... ) -- ... )
|
||||
: while ( ..a pred: ( ..a -- ..b ? ) body: ( ..b -- ..a ) -- ..b )
|
||||
swap do compose [ loop ] curry when ; inline
|
||||
|
||||
: until ( ... pred: ( ... -- ... ? ) body: ( ... -- ... ) -- )
|
||||
: until ( ..a pred: ( ..a -- ..b ? ) body: ( ..b -- ..a ) -- ..b )
|
||||
[ [ not ] compose ] dip while ; inline
|
||||
|
||||
! Object protocol
|
||||
|
|
|
@ -513,10 +513,10 @@ PRIVATE>
|
|||
: collector ( quot -- quot' vec )
|
||||
V{ } collector-for ; inline
|
||||
|
||||
: produce-as ( ... pred: ( ... -- ... ? ) quot: ( ... -- ... obj ) exemplar -- ... seq )
|
||||
: produce-as ( ..a pred: ( ..a -- ..b ? ) quot: ( ..b -- ..a obj ) exemplar -- ..b seq )
|
||||
dup [ collector-for [ while ] dip ] curry dip like ; inline
|
||||
|
||||
: produce ( ... pred: ( ... -- ... ? ) quot: ( ... -- ... obj ) -- ... seq )
|
||||
: produce ( ..a pred: ( ..a -- ..b ? ) quot: ( ..b -- ..a obj ) -- ..b seq )
|
||||
{ } produce-as ; inline
|
||||
|
||||
: follow ( ... obj quot: ( ... prev -- ... result/f ) -- ... seq )
|
||||
|
|
Loading…
Reference in New Issue