diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index 6c05511e57..76cf745c72 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -90,7 +90,7 @@ IN: compiler.cfg.builder.tests [ { array } declare dup 1 slot [ 1 slot ] when ] [ [ dup more? ] [ dup ] produce ] [ vector new over test-case-1 [ test-case-2 ] [ ] if ] - [ [ [ nth-unsafe ".." = 0 ] dip set-nth-unsafe ] 2curry (each-integer) ] + [ [ [ nth-unsafe ".." = 0 ] dip set-nth-unsafe ] 2curry iterate-upto ] [ { fixnum sbuf } declare 2dup 3 slot fixnum> [ over 3 fixnum* over dup [ 2 slot resize-string ] dip 2 set-slot diff --git a/basis/compiler/cfg/stacks/local/local-tests.factor b/basis/compiler/cfg/stacks/local/local-tests.factor index 9318145c92..e7aba0e881 100644 --- a/basis/compiler/cfg/stacks/local/local-tests.factor +++ b/basis/compiler/cfg/stacks/local/local-tests.factor @@ -178,4 +178,4 @@ IN: compiler.cfg.stacks.local.tests my-new-key4 set-slot ] - curry (each-integer) ; + curry iterate-upto ; diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index 33ee339841..8711888f29 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/basis/compiler/tree/dead-code/dead-code-tests.factor @@ -167,7 +167,7 @@ IN: compiler.tree.dead-code.tests { } [ [ call-recursive-dce-5 swap ] optimize-quot drop ] unit-test -{ } [ [ [ 0 -rot set-nth-unsafe ] curry (each-integer) ] optimize-quot drop ] unit-test +{ } [ [ [ 0 -rot set-nth-unsafe ] curry iterate-upto ] optimize-quot drop ] unit-test : call-recursive-dce-6 ( i quot: ( ..a -- ..b ) -- i ) dup call [ drop ] [ call-recursive-dce-6 ] if ; inline recursive diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index e00f8ed791..5abaf92f0f 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -680,7 +680,7 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ; { } [ [ [ ] [ ] compose curry call ] final-info drop ] unit-test { V{ } } [ - [ [ drop ] [ drop ] compose curry (each-integer) ] final-classes + [ [ drop ] [ drop ] compose curry iterate-upto ] final-classes ] unit-test GENERIC: iterate ( obj -- next-obj ? ) diff --git a/basis/compiler/tree/recursive/recursive-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor index 0ecf67cc30..250da8b516 100644 --- a/basis/compiler/tree/recursive/recursive-tests.factor +++ b/basis/compiler/tree/recursive/recursive-tests.factor @@ -51,7 +51,7 @@ IN: compiler.tree.recursive.tests { t } [ [ [ loop-test-1 ] each ] build-tree analyze-recursive - \ (each-integer) label-is-loop? + \ iterate-upto label-is-loop? ] unit-test : loop-test-2 ( a b -- a' ) @@ -175,7 +175,7 @@ DEFER: a'' { t } [ [ 10 [ [ drop ] each-integer ] loop-in-non-loop ] build-tree analyze-recursive - \ (each-integer) label-is-loop? + \ iterate-upto label-is-loop? ] unit-test DEFER: a''' diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index 72d7f4c474..ee24f9c092 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -80,7 +80,7 @@ TYPED: buffer-find ( seps buffer: buffer -- n/f ) [ swap [ [ pos>> ] [ fill>> ] [ ptr>> ] tri ] dip [ swap alien-unsigned-1 ] [ member-eq? ] bi-curry* - compose (find-integer) + compose find-upto ] [ [ pos>> - ] curry [ f ] if* ] bi ; inline diff --git a/basis/sorting/insertion/insertion.factor b/basis/sorting/insertion/insertion.factor index 2a2ac4134a..e3259c3092 100644 --- a/basis/sorting/insertion/insertion.factor +++ b/basis/sorting/insertion/insertion.factor @@ -16,4 +16,4 @@ PRIVATE> : insertion-sort ( ... seq quot: ( ... elt -- ... elt' ) -- ... ) ! quot is a transformation on elements - over length [ insert ] 2with 1 -rot (each-integer) ; inline + over length [ insert ] 2with 1 -rot iterate-upto ; inline diff --git a/basis/tools/hexdump/hexdump.factor b/basis/tools/hexdump/hexdump.factor index 783baefe1a..529cf5c5c5 100644 --- a/basis/tools/hexdump/hexdump.factor +++ b/basis/tools/hexdump/hexdump.factor @@ -34,7 +34,7 @@ CONSTANT: hex-digits $[ [ 0 swap length ] keep ; inline : each-byte ( from to bytes quot: ( elt -- ) -- ) - '[ _ nth-unsafe @ ] (each-integer) ; inline + '[ _ nth-unsafe @ ] iterate-upto ; inline : write-bytes ( from to bytes stream -- ) '[ hex-digits nth-unsafe _ stream-write ] each-byte ; inline diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 2f7554a762..29dd753968 100644 --- a/core/growable/growable.factor +++ b/core/growable/growable.factor @@ -35,7 +35,7 @@ GENERIC: contract ( len seq -- ) M: growable contract ( len seq -- ) [ length ] keep [ [ 0 ] 2dip set-nth-unsafe ] curry - (each-integer) ; inline + iterate-upto ; inline M: growable set-length ( n seq -- ) bounds-check-head diff --git a/core/math/math.factor b/core/math/math.factor index b19a056085..a5114d2f93 100644 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -245,23 +245,24 @@ GENERIC: prev-float ( m -- n ) : align ( m w -- n ) 1 - [ + ] keep bitnot bitand ; inline -: (each-integer) ( ... i n quot: ( ... i -- ... ) -- ... ) +: iterate-upto ( ... i n quot: ( ... i -- ... ) -- ... ) 2over < [ [ nip call ] 3keep - [ 1 + ] 2dip (each-integer) + [ 1 + ] 2dip iterate-upto ] [ 3drop ] if ; inline recursive -: (find-integer) ( ... i n quot: ( ... i -- ... ? ) -- ... i/f ) +: find-upto ( ... i n quot: ( ... i -- ... ? ) -- ... i/f ) 2over < [ [ nip call ] 3keep roll [ 2drop ] - [ [ 1 + ] 2dip (find-integer) ] if + [ [ 1 + ] 2dip find-upto ] if ] [ 3drop f ] if ; inline recursive +! iterate-end? : (all-integers?) ( ... i n quot: ( ... i -- ... ? ) -- ... ? ) 2over < [ [ nip call ] 3keep roll @@ -272,13 +273,13 @@ GENERIC: prev-float ( m -- n ) ] if ; inline recursive : each-integer ( ... n quot: ( ... i -- ... ) -- ... ) - [ 0 ] 2dip (each-integer) ; inline + [ 0 ] 2dip iterate-upto ; inline : times ( ... n quot: ( ... -- ... ) -- ... ) [ drop ] prepose each-integer ; inline : find-integer ( ... n quot: ( ... i -- ... ? ) -- ... i/f ) - [ 0 ] 2dip (find-integer) ; inline + [ 0 ] 2dip find-upto ; inline : all-integers? ( ... n quot: ( ... i -- ... ? ) -- ... ? ) [ 0 ] 2dip (all-integers?) ; inline diff --git a/core/sequences/generalizations/generalizations.factor b/core/sequences/generalizations/generalizations.factor index 1a98c4d26d..a62db15f0c 100644 --- a/core/sequences/generalizations/generalizations.factor +++ b/core/sequences/generalizations/generalizations.factor @@ -124,7 +124,7 @@ MACRO: (ncollect) ( n -- quot ) MACRO: nmap-reduce ( map-quot reduce-quot n -- quot ) -rot dupd compose overd over '[ [ [ first ] _ napply @ 1 ] _ nkeep - _ _ (neach) (each-integer) + _ _ (neach) iterate-upto ] ; : nall? ( seqs... quot n -- ? ) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index cd6cc2bd66..73ef3cee13 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -463,7 +463,7 @@ PRIVATE> (each) each-integer ; inline : each-from ( ... seq quot: ( ... x -- ... ) i -- ... ) - -rot (each) (each-integer) ; inline + -rot (each) iterate-upto ; inline : reduce ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... result ) swapd each ; inline @@ -471,13 +471,26 @@ PRIVATE> : map-integers ( ... len quot: ( ... i -- ... elt ) exemplar -- ... newseq ) overd [ collect ] new-like ; inline -: map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq ) - [ [ length ensure-integer ] keep ] 2dip - pickd [ +! quot: ( a b c -- ) +: transfer-quot ( ... quot -- ... transfer-quot ) + [ [ [ length ] keep ] 2dip ] prepose + [ each-integer ] compose ; inline + +: map-into-quot ( -- transfer-quot: ( seq quot newseq -- ) ) + [ [ [ nth-unsafe ] curry ] [ compose [ keep ] curry ] - [ [ set-nth-unsafe ] curry compose ] tri* each-integer - ] new-like ; inline + [ [ set-nth-unsafe ] curry compose ] tri* + ] transfer-quot ; inline + +: new-output-sequence ( ... seq quot exemplar -- ... seq quot newseq ) + [ over length ] dip new-sequence ; inline + +: like-exemplar ( ... seq quot exemplar quot -- ... newseq ) + [ new-output-sequence ] prepose [ keep ] compose keep like ; inline + +: map-as ( ... seq quot exemplar -- ... newseq ) + [ map-into-quot ] like-exemplar ; inline : map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq ) over map-as ; inline @@ -489,7 +502,7 @@ PRIVATE> { } replicate-as ; inline : map! ( ... seq quot: ( ... elt -- ... newelt ) -- ... seq ) - over [ map-into ] keep ; inline + over map-into-quot keep ; inline : accumulate-as ( ... seq identity quot: ( ... prev elt -- ... next ) exemplar -- ... final newseq ) [ (accumulate) ] dip map-as ; inline @@ -513,7 +526,7 @@ PRIVATE> (2each) each-integer ; inline : 2each-from ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ) i -- ... ) - [ (2each) ] dip -rot (each-integer) ; inline + [ (2each) ] dip -rot iterate-upto ; inline : 2reduce ( ... seq1 seq2 identity quot: ( ... prev elt1 elt2 -- ... next ) -- ... result ) -rotd 2each ; inline @@ -537,7 +550,7 @@ PRIVATE> pickd swap 3map-as ; inline : find-from ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ) - [ (find-integer) ] (find-from) ; inline + [ find-upto ] (find-from) ; inline : find ( ... seq quot: ( ... elt -- ... ? ) -- ... i elt ) [ find-integer ] (find) ; inline @@ -549,7 +562,7 @@ PRIVATE> [ [ 1 - ] dip find-last-integer ] (find) ; inline : find-index-from ( ... n seq quot: ( ... elt i -- ... ? ) -- ... i elt ) - [ (find-integer) ] (find-index-from) ; inline + [ find-upto ] (find-index-from) ; inline : find-index ( ... seq quot: ( ... elt i -- ... ? ) -- ... i elt ) [ find-integer ] (find-index) ; inline @@ -1000,7 +1013,7 @@ PRIVATE> : subseq-start-from ( subseq seq n -- i ) pick length [ pick length swap - 1 + ] keep - [ (subseq-start-from) ] curry (find-integer) 2nip ; + [ (subseq-start-from) ] curry find-upto 2nip ; : subseq-start ( subseq seq -- i ) 0 subseq-start-from ; inline @@ -1140,7 +1153,7 @@ PRIVATE> : generic-flip ( matrix -- newmatrix ) [ [ first-unsafe length 1 ] keep - [ length min ] (each) (each-integer) + [ length min ] (each) iterate-upto ] keep [ [ nth-unsafe ] with { } map-as ] curry { } map-as ; inline @@ -1153,7 +1166,7 @@ USE: arrays { array } declare [ [ first-unsafe array-length 1 ] keep - [ array-length min ] (each) (each-integer) + [ array-length min ] (each) iterate-upto ] keep [ [ { array } declare array-nth ] with { } map-as ] curry { } map-as ; diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 46a9af1de4..5cf5a2e87d 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -296,7 +296,7 @@ PRIVATE> : 3each-from ( ... seq1 seq2 seq3 quot: ( ... elt1 elt2 elt3 -- ... ) i -- ... ) - [ (3each) ] dip -rot (each-integer) ; inline + [ (3each) ] dip -rot iterate-upto ; inline : 3map-reduce ( ..a seq1 seq2 seq3 map-quot: ( ..a elt1 elt2 elt3 -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result ) @@ -552,7 +552,7 @@ PRIVATE> [ length 1 - swap - ] [ nth ] bi ; inline : each-index-from ( ... seq quot: ( ... elt index -- ... ) i -- ... ) - -rot (each-index) (each-integer) ; inline + -rot (each-index) iterate-upto ; inline = >boolean ? ?if and assert assert= assert? bi bi* bi-curry bi-curry* bi-curry@ bi@ boa boolean boolean? both? build call callstack callstack>array callstack? clear clone compose composed composed? curried curried? curry die dip do drop dup dupd either? eq? equal? execute get-callstack get-datastack get-retainstack hashcode hashcode* identity-hashcode identity-tuple identity-tuple? if if* keep keepd keepdd loop most new nip nipd not null object or over overd pick pickd prepose reach roll rot rotd same? spin swap swapd throw tri tri* tri-curry tri-curry* tri-curry@ tri@ tuck tuple tuple? unless unless* until when when* while with wrapper wrapper? xor syn keyword factorKeyword 2cache >alist ?at ?of assoc assoc-all? assoc-any? assoc-clone-like assoc-combine assoc-diff assoc-diff! assoc-differ assoc-each assoc-empty? assoc-filter assoc-filter! assoc-filter-as assoc-find assoc-hashcode assoc-intersect assoc-like assoc-map assoc-map-as assoc-partition assoc-refine assoc-reject assoc-reject! assoc-reject-as assoc-size assoc-stack assoc-subset? assoc-union assoc-union! assoc-union-as assoc= assoc>map assoc? at at* at+ cache change-at clear-assoc collect-by delete-at delete-at* enumerated enumerated? extract-keys harvest-keys harvest-values inc-at key? keys map>alist map>assoc maybe-set-at new-assoc of push-at rename-at set-at sift-keys sift-values substitute unzip value-at value-at* value? values zip zip-as zip-index zip-index-as syn keyword factorKeyword 2cleave 2cleave>quot 3cleave 3cleave>quot 4cleave 4cleave>quot alist>quot call-effect case case-find case>quot cleave cleave>quot cond cond>quot deep-spread>quot execute-effect linear-case-quot no-case no-case? no-cond no-cond? recursive-hashcode shallow-spread>quot spread to-fixed-point wrong-values wrong-values? -syn keyword factorKeyword (all-integers?) (each-integer) (find-integer) * + - / /f /i /mod 2/ 2^ < <= > >= >bignum >fixnum >float >fraction >integer >rect ?1+ abs align all-integers? bignum bignum? bit? bitand bitnot bitor bits>double bits>float bitxor complex complex? denominator double>bits each-integer even? find-integer find-last-integer fixnum fixnum? float float>bits float? fp-bitwise= fp-infinity? fp-nan-payload fp-nan? fp-qnan? fp-sign fp-snan? fp-special? gcd if-zero imaginary-part integer integer>fixnum integer>fixnum-strict integer? log2 log2-expects-positive log2-expects-positive? mod neg neg? next-float next-power-of-2 number number= number? numerator odd? power-of-2? prev-float ratio ratio? rational rational? real real-part real? recip rect> rem sgn shift simple-gcd sq times u< u<= u> u>= unless-zero unordered? when-zero zero? +syn keyword factorKeyword (all-integers?) iterate-upto find-upto * + - / /f /i /mod 2/ 2^ < <= > >= >bignum >fixnum >float >fraction >integer >rect ?1+ abs align all-integers? bignum bignum? bit? bitand bitnot bitor bits>double bits>float bitxor complex complex? denominator double>bits each-integer even? find-integer find-last-integer fixnum fixnum? float float>bits float? fp-bitwise= fp-infinity? fp-nan-payload fp-nan? fp-qnan? fp-sign fp-snan? fp-special? gcd if-zero imaginary-part integer integer>fixnum integer>fixnum-strict integer? log2 log2-expects-positive log2-expects-positive? mod neg neg? next-float next-power-of-2 number number= number? numerator odd? power-of-2? prev-float ratio ratio? rational rational? real real-part real? recip rect> rem sgn shift simple-gcd sq times u< u<= u> u>= unless-zero unordered? when-zero zero? syn keyword factorKeyword 1sequence 2all? 2each 2each-from 2map 2map-as 2map-reduce 2reduce 2selector 2sequence 3append 3append-as 3each 3map 3map-as 3sequence 4sequence ?first ?last ?nth ?second ?set-nth accumulate accumulate! accumulate* accumulate*! accumulate*-as accumulate-as all? any? append append! append-as assert-sequence assert-sequence= assert-sequence? binary-reduce bounds-check bounds-check? bounds-error bounds-error? but-last but-last-slice cartesian-each cartesian-map cartesian-product change-nth check-slice clone-like collapse-slice collector collector-as collector-for collector-for-as concat concat-as copy count cut cut* cut-slice delete-all delete-slice drop-prefix each each-from each-index empty? exchange filter filter! filter-as find find-from find-index find-index-from find-last find-last-from first first2 first3 first4 flip follow fourth glue halves harvest head head* head-slice head-slice* head? if-empty immutable immutable-sequence immutable-sequence? immutable? index index-from indices infimum infimum-by insert-nth interleave iota iota? join join-as last last-index last-index-from length lengthen like longer longer? longest map map! map-as map-find map-find-last map-index map-index-as map-integers map-reduce map-sum max-length member-eq? member? midpoint@ min-length mismatch move new-like new-resizable new-sequence non-negative-integer-expected non-negative-integer-expected? none? nth nths pad-head pad-tail padding partition pop pop* prefix prepend prepend-as produce produce-as product push push-all push-either push-if reduce reduce-index reject reject! reject-as remove remove! remove-eq remove-eq! remove-nth remove-nth! repetition repetition? replace-slice replicate replicate-as rest rest-slice reverse reverse! reversed reversed? second selector selector-as sequence sequence-hashcode sequence= sequence? set-first set-fourth set-last set-length set-nth set-second set-third short shorten shorter shorter? shortest sift slice slice-error slice-error? slice? snip snip-slice subseq subseq-as subseq-start subseq-start-from subseq? suffix suffix! sum sum-lengths supremum supremum-by surround tail tail* tail-slice tail-slice* tail? third trim trim-head trim-head-slice trim-slice trim-tail trim-tail-slice unclip unclip-last unclip-last-slice unclip-slice unless-empty virtual-exemplar virtual-sequence virtual-sequence? virtual@ when-empty syn keyword factorKeyword +@ change change-global counter dec get get-global get-namestack global inc init-namespaces initialize namespace off on set set-global set-namestack toggle with-global with-scope with-variable with-variable-off with-variable-on with-variables syn keyword factorKeyword 1array 2array 3array 4array >array array array? pair pair? resize-array