eliminate roll/-roll from core
parent
1cf45abf06
commit
70ffa003ec
|
@ -113,7 +113,7 @@ IN: kernel.tests
|
|||
< [ [ 1 + ] 3dip (loop) ] [ 2drop 2drop ] if ; inline recursive
|
||||
|
||||
: loop ( obj -- )
|
||||
H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;
|
||||
H{ } values swap [ dup length swap ] dip [ 0 ] 3dip (loop) ;
|
||||
|
||||
[ loop ] must-fail
|
||||
|
||||
|
|
|
@ -147,14 +147,16 @@ PRIVATE>
|
|||
|
||||
: (find-integer) ( i n quot: ( i -- ? ) -- i )
|
||||
[
|
||||
iterate-step roll
|
||||
[ 2drop ] [ iterate-next (find-integer) ] if
|
||||
iterate-step
|
||||
[ [ ] ] 2dip
|
||||
[ iterate-next (find-integer) ] 2curry bi-curry if
|
||||
] [ 3drop f ] if-iterate? ; inline recursive
|
||||
|
||||
: (all-integers?) ( i n quot: ( i -- ? ) -- ? )
|
||||
[
|
||||
iterate-step roll
|
||||
[ iterate-next (all-integers?) ] [ 3drop f ] if
|
||||
iterate-step
|
||||
[ iterate-next (all-integers?) ] 3curry
|
||||
[ f ] if
|
||||
] [ 3drop t ] if-iterate? ; inline recursive
|
||||
|
||||
: each-integer ( n quot -- )
|
||||
|
|
|
@ -271,7 +271,8 @@ ERROR: integer-length-expected obj ;
|
|||
dup integer? [ integer-length-expected ] unless ; inline
|
||||
|
||||
: ((copy)) ( dst i src j n -- )
|
||||
dup -roll + swap nth-unsafe -roll + swap set-nth-unsafe ; inline
|
||||
[ + swap nth-unsafe [ ] curry 2dip ] keep
|
||||
+ swap set-nth-unsafe ; inline
|
||||
|
||||
: 5bi ( a b c d e x y -- )
|
||||
bi-curry bi-curry bi-curry bi-curry bi ; inline
|
||||
|
@ -281,9 +282,9 @@ ERROR: integer-length-expected obj ;
|
|||
inline recursive
|
||||
|
||||
: prepare-subseq ( from to seq -- dst i src j n )
|
||||
#! The check-length call forces partial dispatch
|
||||
[ [ swap - ] dip new-sequence dup 0 ] 3keep
|
||||
-rot drop roll length check-length ; inline
|
||||
[ over - ] dip
|
||||
[ new-sequence 0 rot ] 2keep
|
||||
[ ] curry 2dip check-length ; inline
|
||||
|
||||
: check-copy ( src n dst -- )
|
||||
over 0 < [ bounds-error ] when
|
||||
|
|
Loading…
Reference in New Issue