core: Working on making map-as better.

(each-integer) -> iterate-upto

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

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 ;

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

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 ? )

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'''

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

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

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

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

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

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 -- ? )

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) <iota>
+        [ length min ] (each) iterate-upto <iota>
     ] 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) <iota>
+        [ array-length min ] (each) iterate-upto <iota>
     ] keep
     [ [ { array } declare array-nth ] with { } map-as ] curry { } map-as ;
 

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
 
 <PRIVATE
 

misc/vim/syntax/factor.vim

@@ -56,7 +56,7 @@ syn keyword factorCallNextMethod call-next-method
 syn keyword factorKeyword (clone) -roll -rot -rotd 2bi 2bi* 2bi@ 2curry 2dip 2drop 2dup 2keep 2keepd 2nip 2nipd 2over 2tri 2tri* 2tri@ 2with 3bi 3curry 3dip 3drop 3dup 3keep 3nip 3nipd 3tri 4dip 4drop 4dup 4keep 4nip 5drop 5nip <wrapper> = >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 <enumerated> >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^ < <= <fp-nan> > >= >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^ < <= <fp-nan> > >= >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 <iota> <repetition> <reversed> <slice> ?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 array? pair pair? resize-array