[
drop
[
- dup iota [
+ dup <iota> [
[ 1 + - -8 * ] [ nip 8 * ] 2bi
'[ _ shift 0xff bitand _ shift ]
] with map
{ 3 } [ 4 { 1 2 3 4 5 6 } [ <=> ] with search drop ] unit-test
{ 2 } [ 3.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
{ 4 } [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
-{ 10 } [ 10 20 iota [ <=> ] with search drop ] unit-test
+{ 10 } [ 10 20 <iota> [ <=> ] with search drop ] unit-test
{ 0 } [ "alligator" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
{ 3 } [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
[ intersect ] keep = ;
M: bit-set members
- table>> [ length iota ] keep '[ _ nth-unsafe ] filter ;
+ table>> [ length <iota> ] keep '[ _ nth-unsafe ] filter ;
<PRIVATE
writer bytes>> ;
:: byte-array-n>sequence ( byte-array n -- seq )
- byte-array length 8 * n / iota
+ byte-array length 8 * n / <iota>
byte-array <msb0-bit-reader> '[
drop n _ read
] { } map-as ;
CONSTANT: crc16-table V{ }
-256 iota [
+256 <iota> [
8 [
[ 2/ ] [ even? ] bi [ crc16-polynomial bitxor ] unless
] times
[ old-state<< ] [ state<< ] bi ; inline
CONSTANT: T $[
- 80 iota [ sin abs 32 2^ * >integer ] uint-array{ } map-as
+ 80 <iota> [ sin abs 32 2^ * >integer ] uint-array{ } map-as
]
:: F ( X Y Z -- FXYZ )
checksums-differ
] if ;
-{ t } [ 100 iota [ drop sha1 100 [ 100 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
-{ t } [ 100 iota [ drop sha1 20 [ 20 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
-{ t } [ 100 iota [ drop sha1 10 [ 10 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
+{ t } [ 100 <iota> [ drop sha1 100 [ 100 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
+{ t } [ 100 <iota> [ drop sha1 20 [ 20 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
+{ t } [ 100 <iota> [ drop sha1 10 [ 10 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
{ t } [ sha1 {
B{ 105 27 166 214 73 114 110 }
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
items-count 0 = [
state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
- items-count iota [ items nth quot call ] each
+ items-count <iota> [ items nth quot call ] each
object quot state stackbuf count (NSFastEnumeration-each)
] unless ; inline recursive
(free) ;
: method-arg-types ( method -- args )
- dup method_getNumberOfArguments iota
+ dup method_getNumberOfArguments <iota>
[ method-arg-type ] with map ;
: method-return-type ( method -- ctype )
[ swap nth ] 2bi * ;
: conditional-probabilities ( seq -- seq' )
- dup length iota [ (conditional-probabilities) ] with map ;
+ dup length <iota> [ (conditional-probabilities) ] with map ;
: (direct>conditional) ( assoc -- assoc' )
[ keys conditional-probabilities ] [ values ] bi zip ;
: unbox-parameters ( parameters -- vregs reps )
[
- [ length iota <reversed> ] keep
+ [ length <iota> <reversed> ] keep
[ [ <ds-loc> peek-loc ] [ base-type ] bi* unbox-parameter ]
2 2 mnmap [ concat ] bi@
]
{ t } [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
: non-det-test ( -- cfg )
- 9 iota [ V{ } clone over insns>block ] { } map>assoc dup
+ 9 <iota> [ V{ } clone over insns>block ] { } map>assoc dup
{
{ 0 1 }
{ 1 2 } { 1 7 }
:: zero-byte-array ( len reg -- )
0 ^^load-literal :> elt
reg ^^tagged>integer :> reg
- len cell align cell /i iota [
+ len cell align cell /i <iota> [
[ elt reg ] dip cells byte-array-offset + int-rep f ##store-memory-imm,
] each ;
: >variable-shuffle ( shuffle rep -- shuffle' )
rep-component-type heap-size
[ dup <repetition> >byte-array ]
- [ iota >byte-array ] bi
+ [ <iota> >byte-array ] bi
'[ _ n*v _ v+ ] map concat ;
: ^load-immediate-shuffle ( shuffle rep -- dst )
] unit-test
{ { 0 1 2 3 4 5 } } [
- 6 iota [ V{ } clone over insns>block ] { } map>assoc dup
+ 6 <iota> [ V{ } clone over insns>block ] { } map>assoc dup
{
{ 0 1 } { 0 2 } { 0 5 }
{ 2 3 }
! liveness-step
{ 3 } [
init-liveness
- 3 iota [ <basic-block> swap >>number ] map <basic-block>
+ 3 <iota> [ <basic-block> swap >>number ] map <basic-block>
[ connect-Nto1-bbs ] keep liveness-step length
] unit-test
] [ drop ] if ; inline recursive
: number-blocks ( blocks -- )
- dup length iota <reversed>
+ dup length <iota> <reversed>
[ >>number drop ] 2each ;
: post-order ( cfg -- blocks )
: make-phi-inputs ( -- assoc )
H{ } clone [
{ 2287 2288 } [
- 10 iota 1 sample first rot set-at
+ 10 <iota> 1 sample first rot set-at
] with each
] keep ;
height-state get global-loc>local replaces get set-at ;
: kill-locations ( begin inc -- seq )
- 0 min neg iota [ swap - ] with map ;
+ 0 min neg <iota> [ swap - ] with map ;
: local-kill-set ( ds-begin ds-inc rs-begin rs-inc -- set )
[ kill-locations ] 2bi@
swap 2dup second member? [ 2drop 2 ] [ first >= [ 1 ] [ 0 ] if ] if ;
: shift-stack ( n stack -- stack' )
- first2 pick '[ _ + ] map [ 0 >= ] filter pick 0 max iota sets:union
+ first2 pick '[ _ + ] map [ 0 >= ] filter pick 0 max <iota> sets:union
[ + ] dip 2array ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ swap new swap >>n ] with map <reversed> ;
: stack-locs ( loc-class n -- locs )
- iota create-locs ;
+ <iota> create-locs ;
: (load-vregs) ( n loc-class -- vregs )
swap stack-locs [ peek-loc ] map ;
[
[ , [ f <array> ] % ]
[
- dup iota [
+ dup <iota> [
- 1 - , [ swap [ set-array-nth ] keep ] %
] with each
] bi
! should be redone completely.
: useless-shuffle-vector-imm? ( insn -- ? )
- [ shuffle>> ] [ rep>> rep-length iota ] bi sequence= ;
+ [ shuffle>> ] [ rep>> rep-length <iota> ] bi sequence= ;
: compose-shuffle-vector-imm ( outer inner -- insn' )
2dup [ rep>> ] bi@ eq? [
! Bug with ##return node construction
: return-recursive-bug ( nodes -- ? )
- { fixnum } declare iota [
+ { fixnum } declare <iota> [
dup 3 bitand 1 = [ drop t ] [
dup 3 bitand 2 = [
return-recursive-bug
] { } make ; inline
[ t ] [| |
- 1000 iota [ drop 1,000,000 random 1,000,000 random ] H{ } map>assoc :> a-hashtable
+ 1000 <iota> [ drop 1,000,000 random 1,000,000 random ] H{ } map>assoc :> a-hashtable
a-hashtable [ [ drop , ] funky-assoc>map ] compile-call
a-hashtable keys =
] unit-test
[ ] [
10000 [
- 5 random iota [ drop 32 random-bits ] map product >bignum
+ 5 random <iota> [ drop 32 random-bits ] map product >bignum
dup [ bignum>fixnum ] keep compiled-bignum>fixnum =
[ drop ] [ "Oops" throw ] if
] times
: double-label-2 ( a -- b )
dup array? [ ] [ ] if 0 t double-label-1 ;
-[ 0 ] [ 10 iota double-label-2 ] unit-test
+[ 0 ] [ 10 <iota> double-label-2 ] unit-test
! regression
GENERIC: void-generic ( obj -- * )
[ 5 ] [ { 1 2 { 3 { 4 5 } } } deep-find-test ] unit-test
[ f ] [ { 1 2 { 3 { 4 } } } deep-find-test ] unit-test
-[ B{ 0 1 2 3 4 5 6 7 } ] [ [ 8 iota [ ] B{ } map-as ] compile-call ] unit-test
+[ B{ 0 1 2 3 4 5 6 7 } ] [ [ 8 <iota> [ ] B{ } map-as ] compile-call ] unit-test
[ 0 ] [ 1234 [ { fixnum } declare -64 shift ] compile-call ] unit-test
STRUCT: my-struct { x int } ;
SPECIALIZED-ARRAY: my-struct
-: my-word ( a -- b ) iota [ my-struct <struct-boa> ] my-struct-array{ } map-as ;
+: my-word ( a -- b ) <iota> [ my-struct <struct-boa> ] my-struct-array{ } map-as ;
[ ] [
[
] unit-test
{ t } [
- [ { fixnum } declare iota [ drop ] each ]
+ [ { fixnum } declare <iota> [ drop ] each ]
{ < <-integer-fixnum +-integer-fixnum + } inlined?
] unit-test
{ t } [
- [ { fixnum } declare iota 0 [ + ] reduce ]
+ [ { fixnum } declare <iota> 0 [ + ] reduce ]
{ < <-integer-fixnum nth-unsafe } inlined?
] unit-test
{ f } [
- [ { fixnum } declare iota 0 [ + ] reduce ]
+ [ { fixnum } declare <iota> 0 [ + ] reduce ]
\ +-integer-fixnum inlined?
] unit-test
{ t } [
[
- { integer } declare iota [ ] map
+ { integer } declare <iota> [ ] map
] \ integer>fixnum inlined?
] unit-test
{ t } [
[
- { integer } declare iota [ 0 >= ] map
+ { integer } declare <iota> [ 0 >= ] map
] { >= fixnum>= } inlined?
] unit-test
pad-with-bottom >>phi-in-d drop ;
: live-value-indices ( values -- indices )
- [ length iota ] keep live-values get
+ [ length <iota> ] keep live-values get
'[ _ nth _ key? ] filter ; inline
: drop-indexed-values ( values indices -- node )
{ t } [
[
- { fixnum } declare iota 0 swap
+ { fixnum } declare <iota> 0 swap
[
drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
] map
{ t } [
[
- { integer } declare iota [ 256 mod ] map
+ { integer } declare <iota> [ 256 mod ] map
] { mod fixnum-mod } inlined?
] unit-test
{ t } [
[
- { iota-tuple } declare [ 256 rem ] map
+ { iota } declare [ 256 rem ] map
] { mod fixnum-mod rem } inlined?
] unit-test
} 1&& ;
: lookup-table-seq ( assoc -- table )
- [ keys supremum 1 + iota ] keep '[ _ at ] { } map-as ;
+ [ keys supremum 1 + <iota> ] keep '[ _ at ] { } map-as ;
: lookup-table-quot ( seq -- newquot )
lookup-table-seq
:: all-patterns ( huffman-code n -- seq )
n log2 huffman-code size>> - :> free-bits
free-bits 0 >
- [ free-bits 2^ iota [ huffman-code code>> free-bits 2^ * + ] map ]
+ [ free-bits 2^ <iota> [ huffman-code code>> free-bits 2^ * + ] map ]
[ huffman-code code>> free-bits neg 2^ /i 1array ] if ;
:: huffman-each ( ... tdesc quot: ( ... huffman-code -- ... ) -- ... )
] reduce
[ dup array? [ second 0 <repetition> ] [ 1array ] if ] map concat
nip swap cut 2array
- [ [ length>> iota ] [ ] bi get-table ] map ;
+ [ [ length>> <iota> ] [ ] bi get-table ] map ;
MEMO: static-huffman-tables ( -- obj )
[
280 287 [a,b] length [ 8 ] replicate append
] append-outputs
0 31 [a,b] length [ 5 ] replicate 2array
- [ [ length>> iota ] [ ] bi get-table ] map ;
+ [ [ length>> <iota> ] [ ] bi get-table ] map ;
CONSTANT: length-table
{
TUPLE: gif-lzw < lzw ;
: initial-uncompress-table ( size -- seq )
- iota [ 1vector ] V{ } map-as ;
+ <iota> [ 1vector ] V{ } map-as ;
: reset-lzw-uncompress ( lzw -- lzw )
dup end-of-information-code>> 1 + initial-uncompress-table >>table
[ error>> "Even" = ] must-fail-with
{ V{ 0 3 6 9 } }
-[ 10 iota [ 3 mod zero? ] parallel-filter ] unit-test
+[ 10 <iota> [ 3 mod zero? ] parallel-filter ] unit-test
{ 10 }
[
V{ } clone
- 10 iota over [ push ] curry parallel-each
+ 10 <iota> over [ push ] curry parallel-each
length
] unit-test
{ 20 }
[
V{ } clone
- 10 iota 10 iota pick [ [ push ] [ push ] bi ] curry 2parallel-each
+ 10 <iota> 10 iota pick [ [ push ] [ push ] bi ] curry 2parallel-each
length
] unit-test
] 2map >>bind-params ;
M: retryable execute-statement* ( statement type -- )
- drop [ retries>> iota ] [
+ drop [ retries>> <iota> ] [
[
nip
[ query-results dispose t ]
test-2 ensure-table
] with-db
] [
- 10 iota [
+ 10 <iota> [
drop
10 [
dup [
] [
<db-pool> [
[
- 10 iota [
+ 10 <iota> [
10 [
test-1-tuple insert-tuple yield
] times
{ "hi" 3 } [ "h" "i" 3 [ append ] funny-dip ] unit-test
{ { 1 2 3 } } [
- 3 1 '[ _ iota [ _ + ] map ] call
+ 3 1 '[ _ <iota> [ _ + ] map ] call
] unit-test
{ { 1 { 2 { 3 } } } } [
} case ;
: fill-mouse-state ( buffer count -- state )
- iota [ +mouse-state+ get-global ] 2dip swap [ nth (fill-mouse-state) ] curry each ;
+ <iota> [ +mouse-state+ get-global ] 2dip swap [ nth (fill-mouse-state) ] curry each ;
: get-device-state ( device DIJOYSTATE2 -- )
[ dup IDirectInputDevice8W::Poll check-ole32-error ] dip
} ; inline
: x-bits>hid-bits ( bit-array -- bit-array )
- 256 iota zip [ first ] filter values
+ 256 <iota> zip [ first ] filter values
x>hid-bit-order [ nth ] curry map
256 <bit-array> swap [ t swap pick set-nth ] each ;
} ; inline
: x-bits>hid-bits ( bit-array -- bit-array )
- 256 iota [ 2array ] { } 2map-as [ first ] filter values
+ 256 <iota> [ 2array ] { } 2map-as [ first ] filter values
x>hid-bit-order [ nth ] curry map
256 <bit-array> swap [ t swap pick set-nth ] each ;
MACRO: nspread* ( m n -- quot )
[ drop [ ] ] [
[ * 0 ] [ drop neg ] 2bi
- <range> rest >array dup length iota <reversed>
+ <range> rest >array dup length <iota> <reversed>
[
'[ [ [ _ ndip ] curry ] _ ndip ]
] 2map dup rest-slice [ [ compose ] compose ] map! drop
1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
MACRO: nweave ( n -- quot )
- [ dup iota <reversed> [ '[ _ _ mnswap ] ] with map ] keep
+ [ dup <iota> <reversed> [ '[ _ _ mnswap ] ] with map ] keep
'[ _ _ ncleave ] ;
: nbi-curry ( n -- )
{ $examples
{ $example
"USING: arrays kernel prettyprint sequences grouping ;"
- "9 iota >array 3 <groups>"
+ "9 <iota> >array 3 <groups>"
"dup [ reverse! drop ] each concat >array ."
"{ 2 1 0 5 4 3 8 7 6 }"
}
[ heap-push-all ] keep heap-pop-all ;
: random-alist ( n -- alist )
- iota [
+ <iota> [
drop 32 random-bits dup number>string
] H{ } map>assoc >alist ;
: test-entry-indices ( n -- ? )
random-alist
<min-heap> [ heap-push-all ] keep
- data>> dup length iota swap [ index>> ] map sequence= ;
+ data>> dup length <iota> swap [ index>> ] map sequence= ;
14 [
[ t ] swap [ 2^ test-entry-indices ] curry unit-test
"specializer" word-prop ;
: make-specializer ( specs -- quot )
- dup length iota <reversed>
+ dup length <iota> <reversed>
[ (picker) 2array ] 2map
[ drop object eq? ] assoc-reject
[ [ t ] ] [
:: each-pixel ( ... image quot: ( ... x y pixel -- ... ) -- ... )
image dim>> first2 :> ( width height )
image bytes-per-pixel :> n
- height width [ iota ] bi@ [| y x |
+ height width [ <iota> ] bi@ [| y x |
y width * x + :> start
start n * :> from
from n + :> to
IN: images.processing
: coord-matrix ( dim -- m )
- [ iota ] map first2 cartesian-product ;
+ [ <iota> ] map first2 cartesian-product ;
: map^2 ( m quot -- m' ) '[ _ map ] map ; inline
: each^2 ( m quot -- m' ) '[ _ each ] each ; inline
"vocab:io/encodings/iso2022/212.txt" load-codetable-file jis212 set-global
SYMBOL: ascii
-128 iota dup zip >biassoc ascii set-global
+128 <iota> dup zip >biassoc ascii set-global
TUPLE: iso2022-state type ;
unique-length get random-string ;
: retry ( quot: ( -- ? ) n -- )
- iota swap [ drop ] prepose attempt-all ; inline
+ <iota> swap [ drop ] prepose attempt-all ; inline
PRIVATE>
{ } [
path binary [
[
- 100,000 iota
+ 100,000 <iota>
0
100,000 int malloc-array &free [ copy ] keep write
] with-destructors
{ t } [
path binary [
- 100,000 4 * read int cast-array 100,000 iota sequence=
+ 100,000 4 * read int cast-array 100,000 <iota> sequence=
] with-file-reader
] unit-test
X509_get_issuer_name x509name>string ;
: name-stack>sequence ( name-stack -- seq )
- dup sk_num iota [ sk_value GENERAL_NAME_st memory>struct ] with map ;
+ dup sk_num <iota> [ sk_value GENERAL_NAME_st memory>struct ] with map ;
: alternative-dns-names ( certificate -- dns-names )
NID_subject_alt_name f f X509_get_ext_d2i
{ $examples
{ $code
"USING: colors.gray io.styles hashtables sequences kernel math ;"
- "10 iota ["
+ "10 <iota> ["
" \"Hello world\\n\""
" swap 10 / 1 <gray> foreground associate format"
"] each"
{ $examples
{ $code
"USING: colors hashtables io io.styles kernel math sequences ;"
- "10 iota ["
+ "10 <iota> ["
" \"Hello world\\n\""
" swap 10 / 1 over - over 1 <rgba>"
" background associate format"
i 1 + j 1 + matrix nth-unsafe set-nth-unsafe ; inline
: lcs-initialize ( |str1| |str2| -- matrix )
-
iota [ drop 0 <array> ] with map ;
+
<iota> [ drop 0 <array> ] with map ;
: levenshtein-initialize ( |str1| |str2| -- matrix )
- [ iota ] bi@ [ [ + ] curry map ] with map ;
+ [ <iota> ] bi@ [ [ + ] curry map ] with map ;
:: run-lcs ( old new init step -- matrix )
old length 1 + new length 1 + init call :> matrix
- old length iota [| i |
- new length iota [| j |
+ old length <iota> [| i |
+ new length <iota> [| j |
i j matrix old new step loop-step
] each
] each matrix ; inline
stack get pop end
[ [ expand-macros ] [ ] map-as '[ _ dip ] % ]
[
- length iota [ <reversed> ] keep
+ length <iota> [ <reversed> ] keep
[ '[ _ ndrop _ nnip call ] [ ] like ] 2map , \ dispatch ,
] bi ;
<<
\ byte-bit-count
-256 iota [
+256 <iota> [
8 <bits> 0 [ [ 1 + ] when ] reduce
] B{ } map-as '[ 0xff bitand _ nth-unsafe ]
( byte -- table ) define-declared
{ $notes "Combinations are 0-based and a bounds error will be thrown if " { $snippet "m" } " is larger than " { $snippet "seq length k nCk" } "." }
{ $examples
{ $example "USING: math.combinatorics sequences prettyprint ;"
- "6 7 iota 4 combination ." "{ 0 1 3 6 }" }
+ "6 7 <iota> 4 combination ." "{ 0 1 3 6 }" }
{ $example "USING: math.combinatorics prettyprint ;"
"0 { \"a\" \"b\" \"c\" \"d\" } 2 combination ." "{ \"a\" \"b\" }" }
} ;
{ { 0 1 3 2 } } [ { 0 0 1 0 } >permutation ] unit-test
{ { 1 2 0 6 3 5 4 } } [ { 1 1 0 3 0 1 0 } >permutation ] unit-test
-{ { 0 1 2 3 } } [ 0 4 iota permutation-indices ] unit-test
-{ { 0 1 3 2 } } [ 1 4 iota permutation-indices ] unit-test
-{ { 1 2 0 6 3 5 4 } } [ 859 7 iota permutation-indices ] unit-test
+{ { 0 1 2 3 } } [ 0 4 <iota> permutation-indices ] unit-test
+{ { 0 1 3 2 } } [ 1 4 <iota> permutation-indices ] unit-test
+{ { 1 2 0 6 3 5 4 } } [ 859 7 <iota> permutation-indices ] unit-test
{ { "a" "b" "c" "d" } } [ 0 { "a" "b" "c" "d" } permutation ] unit-test
{ { "d" "c" "b" "a" } } [ 23 { "a" "b" "c" "d" } permutation ] unit-test
{ { 2 1 3 } } [ { 1 2 3 } [ first 2 = ] find-permutation ] unit-test
{ { { 0 1 2 } { 0 2 1 } { 1 0 2 } { 1 2 0 } { 2 0 1 } { 2 1 0 } } }
-[ 3
iota <permutations> >array ] unit-test
+[ 3
<iota> <permutations> >array ] unit-test
{ { "as" "ad" "af" "sa" "sd" "sf" "da" "ds" "df" "fa" "fs" "fd" } }
[ "asdf" 2 <k-permutations> >array ] unit-test
M: string nths-unsafe (nths-unsafe) ;
M: array nths-unsafe (nths-unsafe) ;
M: vector nths-unsafe (nths-unsafe) ;
-M: iota-tuple nths-unsafe (nths-unsafe) ;
+M: iota nths-unsafe (nths-unsafe) ;
M: object nths-unsafe (nths-unsafe) ;
: possible? ( n m -- ? )
: permutation-indices ( n seq -- permutation )
length [ factoradic ] dip 0 pad-head >permutation ;
-: permutation-iota ( seq -- iota )
- length factorial iota ; inline
+: permutation-iota ( seq -- <iota> )
+ length factorial <iota> ; inline
PRIVATE>
<PRIVATE
: permutations-quot ( seq quot -- seq quot' )
- [ [ permutation-iota ] [ length iota >array ] [ ] tri ] dip
+ [ [ permutation-iota ] [ length <iota> >array ] [ ] tri ] dip
'[ drop _ [ _ nths-unsafe @ ] keep next-permutation drop ] ; inline
PRIVATE>
:: combinations-quot ( seq k quot -- seq quot' )
seq length :> n
- n k nCk iota k iota >array seq quot n
+ n k nCk <iota> k iota >array seq quot n
'[ drop _ [ _ nths-unsafe @ ] keep _ next-combination drop ] ; inline
PRIVATE>
: roots ( x t -- seq )
[ [ log ] [ recip ] bi* * e^ ]
[ recip 2pi * 0 swap complex boa e^ ]
- [ iota [ ^ * ] 2with map ] tri ;
+ [ <iota> [ ^ * ] 2with map ] tri ;
: sigmoid ( x -- y ) neg e^ 1 + recip ; inline
] if ;
binary-ops [
- [ [ t ] ] dip '[ 8000 iota [ drop _ binary-test ] all? ] unit-test
+ [ [ t ] ] dip '[ 8000 <iota> [ drop _ binary-test ] all? ] unit-test
] each
: comparison-ops ( -- alist )
second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
comparison-ops [
- [ [ t ] ] dip '[ 8000 iota [ drop _ comparison-test ] all? ] unit-test
+ [ [ t ] ] dip '[ 8000 <iota> [ drop _ comparison-test ] all? ] unit-test
] each
{ t } [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
commutative-ops [
[ [ t ] ] dip '[
- 8000 iota [
+ 8000 <iota> [
drop
random-interval-or-empty random-interval-or-empty _
[ execute ] [ swapd execute ] 3bi =
[ [ clear-scale ] 2keep [ n*v ] dip v+ ] change-row ;
: rows-from ( row# -- slice )
- rows dup iota <slice> ;
+ rows dup <iota> <slice> ;
: clear-col ( col# row# rows -- )
[ nth-row ] dip [ [ 2dup ] dip (clear-col) ] each 2drop ;
: reduced ( matrix' -- matrix'' )
[
- rows iota <reversed> [
+ rows <iota> <reversed> [
dup nth-row leading drop
- [ swap dup iota clear-col ] [ drop ] if*
+ [ swap dup <iota> clear-col ] [ drop ] if*
] each
] with-matrix ;
1 <repetition> diagonal-matrix ; inline
: eye ( m n k -- matrix )
- [ [ iota ] bi@ ] dip neg '[ _ + = 1 0 ? ] cartesian-map ;
+ [ [ <iota> ] bi@ ] dip neg '[ _ + = 1 0 ? ] cartesian-map ;
: hilbert-matrix ( m n -- matrix )
- [ iota ] bi@ [ + 1 + recip ] cartesian-map ;
+ [ <iota> ] bi@ [ + 1 + recip ] cartesian-map ;
: toeplitz-matrix ( n -- matrix )
- iota dup [ - abs 1 + ] cartesian-map ;
+ <iota> dup [ - abs 1 + ] cartesian-map ;
: hankel-matrix ( n -- matrix )
- [ iota dup ] keep '[ + abs 1 + dup _ > [ drop 0 ] when ] cartesian-map ;
+ [ <iota> dup ] keep '[ + abs 1 + dup _ > [ drop 0 ] when ] cartesian-map ;
: box-matrix ( r -- matrix )
2 * 1 + dup '[ _ 1 <array> ] replicate ;
: vandermonde-matrix ( u n -- matrix )
- iota [ v^n ] with map reverse flip ;
+ <iota> [ v^n ] with map reverse flip ;
:: rotation-matrix3 ( axis theta -- matrix )
theta cos :> c
'[ _ map ] map ; inline
: column-map ( matrix quot -- seq )
- [ [ first length iota ] keep ] dip '[ _ col @ ] map ; inline
+ [ [ first length <iota> ] keep ] dip '[ _ col @ ] map ; inline
: cartesian-square-indices ( n -- matrix )
- iota dup cartesian-product ; inline
+ <iota> dup cartesian-product ; inline
: cartesian-matrix-map ( matrix quot -- matrix' )
[ [ first length cartesian-square-indices ] keep ] dip
: sample-cov-matrix ( matrix -- cov ) 1 cov-matrix-ddof ; inline
GENERIC: square-rows ( object -- matrix )
-M: integer square-rows iota square-rows ;
+M: integer square-rows <iota> square-rows ;
M: sequence square-rows
[ length ] keep >array '[ _ clone ] { } replicate-as ;
GENERIC: square-cols ( object -- matrix )
-M: integer square-cols iota square-cols ;
+M: integer square-cols <iota> square-cols ;
M: sequence square-cols
[ length ] keep [ <array> ] with { } map-as ;
: make-matrix-with-indices ( m n quot -- matrix )
- [ [ iota ] bi@ ] dip '[ @ ] cartesian-map ; inline
+ [ [ <iota> ] bi@ ] dip '[ @ ] cartesian-map ; inline
: null-matrix? ( matrix -- ? ) empty? ; inline
{ [ well-formed-matrix? ] [ dim all-eq? ] } 1&& ;
: matrix-coordinates ( dim -- coordinates )
- first2 [ iota ] bi@ cartesian-product ; inline
+ first2 [ <iota> ] bi@ cartesian-product ; inline
: dimension-range ( matrix -- dim range )
dim [ matrix-coordinates ] [ first [1,b] ] bi ;
: p* ( p q -- r )
2unempty pextend-conv
- [ drop length [ iota ] keep ]
+ [ drop length [ <iota> ] keep ]
[ nip <reversed> ]
[ drop ] 2tri
'[ _ _ <slice> _ v* sum ] map reverse! ;
[ V{ 0 } clone V{ 1 } clone ] 2dip swap (pgcd) [ >array ] bi@ ;
: pdiff ( p -- p' )
- dup length iota v* rest ;
+ dup length <iota> v* rest ;
: polyval ( x p -- p[x] )
! Horner scheme
{ t } [ 37 miller-rabin ] unit-test
{ t } [ 2135623355842621559 miller-rabin ] unit-test
-{ f } [ 1000 iota [ drop 15 miller-rabin ] any? ] unit-test
+{ f } [ 1000 <iota> [ drop 15 miller-rabin ] any? ] unit-test
n 1 - :> n-1
n-1 factor-2s :> ( r s )
0 :> a!
- trials iota [
+ trials <iota> [
drop
2 n 2 - [a,b] random a!
a s n ^mod 1 = [
f
] [
- r iota [
+ r <iota> [
2^ s * a swap n ^mod n-1 =
] any? not
] if
{ { 0 0 0 } } [ { 1 1 1 } standardize ] unit-test
-{ { 0 1/4 1/2 3/4 1 } } [ 5 iota rescale ] unit-test
+{ { 0 1/4 1/2 3/4 1 } } [ 5 <iota> rescale ] unit-test
{
[ [ { } ] ] dip
[ new length shuffles-for ] keep
'[
- _ [ [ _ new [ length iota ] keep like 1quotation ] dip '[ _ vshuffle ] ]
+ _ [ [ _ new [ length <iota> ] keep like 1quotation ] dip '[ _ vshuffle ] ]
[ = ] check-optimizer
] unit-test
] each
'[
_ [ [
_ new
- [ [ length iota ] keep like ]
+ [ [ length <iota> ] keep like ]
[ [ length dup dup + [a,b) ] keep like ] bi [ ] 2sequence
] dip '[ _ vshuffle2-elements ] ]
[ = ] check-optimizer
! Test element access -- it should box bignums for int-4 on x86
: test-accesses ( seq -- failures )
- [ length iota dup [ >bignum ] map append ] keep
+ [ length <iota> dup [ >bignum ] map append ] keep
'[ [ _ 1quotation ] dip '[ _ swap nth ] ] [ = ] check-optimizer ; inline
{ { } } [ float-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
"== Checking broadcast" print
: test-broadcast ( seq -- failures )
- [ length iota >array ] keep
+ [ length <iota> >array ] keep
'[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ;
{ { } } [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
[ -1 <nibble-array> ] [ T{ bad-array-length f -1 } = ] must-fail-with
-{ t } [ 16 iota dup >nibble-array sequence= ] unit-test
+{ t } [ 16 <iota> dup >nibble-array sequence= ] unit-test
{ N{ 4 2 1 3 } } [ N{ 3 1 2 4 } reverse ] unit-test
{ N{ 1 4 9 0 9 4 } } [ N{ 1 2 3 4 5 6 } [ sq ] map ] unit-test
] unit-test
{ 100 1060 2000 10000 100000 1000000 } [
- [ t ] swap [ iota dup >persistent-vector sequence= ] curry unit-test
+ [ t ] swap [ <iota> dup >persistent-vector sequence= ] curry unit-test
] each
{ } [ 10000 [ 16 random-bits ] PV{ } replicate-as "1" set ] unit-test
{ } [ "1" get >vector "2" set ] unit-test
{ t } [
- 3000 iota [
+ 3000 <iota> [
drop
16 random-bits 10000 random
[ "1" [ new-nth ] change ]
] unit-test
{ t } [
- 10000 iota >persistent-vector 752 [ ppop ] times dup length iota sequence=
+ 10000 <iota> >persistent-vector 752 [ ppop ] times dup length iota sequence=
] unit-test
{ t } [
- 100 iota [
+ 100 <iota> [
drop
100 random [
16 random-bits [ "1" [ ppush ] change ] [ "2" get push ] bi
[ 0 0 ] dip skip-consonants (consonant-seq) ;
: stem-vowel? ( str -- ? )
- [ length iota ] keep [ consonant? ] curry all? not ;
+ [ length <iota> ] keep [ consonant? ] curry all? not ;
: double-consonant? ( i str -- ? )
over 1 < [
] unit-test
{ "{ 0 1 2 3 4 }" } [
- [ 5 length-limit [ 5 iota >array pprint ] with-variable ]
+ [ 5 length-limit [ 5 <iota> >array pprint ] with-variable ]
with-string-writer
] unit-test
{ "{ 0 1 2 3 ~2 more~ }" } [
- [ 5 length-limit [ 6 iota >array pprint ] with-variable ]
+ [ 5 length-limit [ 6 <iota> >array pprint ] with-variable ]
with-string-writer
] unit-test
: group-flow ( seq -- newseq )
[
- dup length iota [
+ dup length <iota> [
2dup 1 - swap ?nth prev namespaces:set
2dup 1 + swap ?nth next namespaces:set
swap nth dup split-before dup , split-after
{ 2 } [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test
[ V{ } [ delete-random drop ] keep length ] must-fail
-{ t } [ 10000 [ iota 0 [ drop 187 random + ] reduce ] keep / 2 * 187 10 ~ ] unit-test
-{ t } [ 10000 [ iota 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test
+{ t } [ 10000 [ <iota> 0 [ drop 187 random + ] reduce ] keep / 2 * 187 10 ~ ] unit-test
+{ t } [ 10000 [ <iota> 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test
{ t } [ 1000 [ 400 random ] replicate members length 256 > ] unit-test
[ { 1 2 } 3 sample ] [ too-many-samples? ] must-fail-with
{ 3 } [ { 1 2 3 4 } 3 sample members length ] unit-test
-{ 99 } [ 100 iota 99 sample members length ] unit-test
+{ 99 } [ 100 <iota> 99 sample members length ] unit-test
{ }
[ [ 100 random-bytes ] with-system-random drop ] unit-test
: sample ( seq n -- seq' )
2dup [ length ] dip < [ too-many-samples ] when
- [ [ length iota >array ] dip [ randomize-n-last ] keep tail-slice* ]
+ [ [ length <iota> >array ] dip [ randomize-n-last ] keep tail-slice* ]
[ drop ] 2bi nths-unsafe ;
: delete-random ( seq -- elt )
state n>> :> n
state mask>> :> mask
- n m - >fixnum iota [| i |
+ n m - >fixnum <iota> [| i |
i array nth-unsafe
i m + array nth-unsafe
mask state r1>> state r2>> formula :> r
] each
! n m - 1 + n [a,b) [
- m 1 - iota [
+ m 1 - <iota> [
n m - 1 + + >fixnum :> i
i array nth-unsafe
m n - i + array nth-unsafe
zip [ first ] partition [ values ] bi@ parts boa ;
: powerset-partition ( sequence -- partitions )
- [ length [ 2^ iota ] keep ] keep '[ _ <bits> _ make-partition ] map rest ;
+ [ length [ 2^ <iota> ] keep ] keep '[ _ <bits> _ make-partition ] map rest ;
: partition>class ( parts -- class )
[ out>> [ <not-class> ] map ]
MACRO: set-firstn-unsafe ( n -- quot )
[ 1 + ]
- [ iota [ '[ _ rot [ set-nth-unsafe ] keep ] ] map ] bi
+ [ <iota> [ '[ _ rot [ set-nth-unsafe ] keep ] ] map ] bi
'[ _ -nrot _ spread drop ] ;
MACRO: set-firstn ( n -- quot )
swap '[ _ call( i -- ) ] each-integer ;
<< \ (unrolled-each-integer) [
- iota [ '[ _ swap call( i -- ) ] ] [ ] map-as '[ _ cleave ]
+ <iota> [ '[ _ swap call( i -- ) ] ] [ ] map-as '[ _ cleave ]
] 1 define-partial-eval >>
: (unrolled-collect) ( quot into -- quot' )
4 npick unrolled-2map-as ; inline
: unrolled-map-index ( seq len quot: ( x i -- newx ) -- newseq )
- [ dup length iota ] 2dip unrolled-2map ; inline
+ [ dup length <iota> ] 2dip unrolled-2map ; inline
{ $code "1.0 [ sin ] [ cos ] [ tan ] tri float-array{ } 3sequence ." }
"Create a float array and sum the elements:"
{ $code
- "1000 iota [ 1000 /f pi * sin ] float-array{ } map-as"
+ "1000 <iota> [ 1000 /f pi * sin ] float-array{ } map-as"
"0.0 [ + ] reduce ."
} ;
] [ 4drop ] if ; inline recursive
: recursive-reduce ( seq i quot: ( prev elt -- next ) -- result )
swapd [ 0 ] 2dip over length (recursive-reduce) ; inline
-{ 24995000 } [ 10000 iota 0 [ dup even? [ + ] [ drop ] if ] recursive-reduce ] unit-test
+{ 24995000 } [ 10000 <iota> 0 [ dup even? [ + ] [ drop ] if ] recursive-reduce ] unit-test
{ 3 1 } [ [ member? [ 1 + ] when ] curry recursive-reduce ] must-infer-as
[ [ [ write write ] each ] infer ] [ unbalanced-branches-error? ] must-fail-with
<PRIVATE
: suffixes ( string -- suffixes-seq )
- dup length iota [ tail-slice ] with map ;
+ dup length <iota> [ tail-slice ] with map ;
: prefix<=> ( begin seq -- <=> )
[ <=> ] [ swap head? ] 2bi [ drop +eq+ ] when ;
! Don't use $example below: it won't pass help-lint.
{ $code
"USING: math.parser threads ;"
- "[ 10 iota [ number>string write nl yield ] each ] \"test\" spawn drop"
+ "[ 10 <iota> [ number>string write nl yield ] each ] \"test\" spawn drop"
"10 [ yield ] times"
"0"
"1"
{ f } [ f get-global ] unit-test
{ { 0 3 6 9 12 15 18 21 24 27 } } [
- 10 iota [
+ 10 <iota> [
0 "i" tset
[
"i" [ yield 3 + ] tchange
ico-header heap-size bytes <displaced-alien>
header ImageCount>> ico-directory-entry <c-direct-array> :> directory
- directory dup length iota [ ico>group-directory-entry ] { } 2map-as
+ directory dup length <iota> [ ico>group-directory-entry ] { } 2map-as
:> group-directory
directory [ bytes ico-icon ] { } map-as :> icon-bytes
{ t } [ B{ } hexdump "Length: 0, 0h\n" = ] unit-test
{ t } [ "abcdefghijklmnopqrstuvwxyz" >byte-array hexdump "Length: 26, 1ah\n00000000h: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop\n00000010h: 71 72 73 74 75 76 77 78 79 7a qrstuvwxyz\n" = ] unit-test
-{ t } [ 256 iota [ ] B{ } map-as hexdump "Length: 256, 100h\n00000000h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ................\n00000010h: 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f ................\n00000020h: 20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f !\"#$%&'()*+,-./\n00000030h: 30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f 0123456789:;<=>?\n00000040h: 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f @ABCDEFGHIJKLMNO\n00000050h: 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_\n00000060h: 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno\n00000070h: 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~.\n00000080h: 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................\n00000090h: 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................\n000000a0h: a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................\n000000b0h: b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................\n000000c0h: c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................\n000000d0h: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................\n000000e0h: e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................\n000000f0h: f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................\n" = ] unit-test
+{ t } [ 256 <iota> [ ] B{ } map-as hexdump "Length: 256, 100h\n00000000h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ................\n00000010h: 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f ................\n00000020h: 20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f !\"#$%&'()*+,-./\n00000030h: 30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f 0123456789:;<=>?\n00000040h: 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f @ABCDEFGHIJKLMNO\n00000050h: 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_\n00000060h: 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno\n00000070h: 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~.\n00000080h: 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................\n00000090h: 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................\n000000a0h: a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................\n000000b0h: b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................\n000000c0h: c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................\n000000d0h: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................\n000000e0h: e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................\n000000f0h: f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................\n" = ] unit-test
{
{ } [ 10 [ [ 100 [ 1000 random (byte-array) drop ] times compact-gc ] profile ] times ] unit-test
{ } [ 2 [ [ 1 seconds sleep ] profile ] times ] unit-test
-{ } [ [ 300,000 iota [ sq sq sq ] map drop ] profile flat profile. ] unit-test
-{ } [ [ 300,000 iota [ sq sq sq ] map drop ] profile top-down profile. ] unit-test
+{ } [ [ 300,000 <iota> [ sq sq sq ] map drop ] profile flat profile. ] unit-test
+{ } [ [ 300,000 <iota> [ sq sq sq ] map drop ] profile top-down profile. ] unit-test
f raw-profile-data set-global
gc
] unit-test
{
-"HELP: iota-tuple
+"HELP: iota
{ $class-description \"\" } ;
" }
[
- [ \ iota-tuple (help.) ] with-string-writer
+ [ \ iota (help.) ] with-string-writer
] unit-test
{ sequence t } [ "seq" lookup-type ] unit-test
[ [ ascii? ] all? ] both? [ bad-tr ] unless ;
: compute-tr ( quot from to -- mapping )
- [ 128 iota ] 3dip zip
+ [ 128 <iota> ] 3dip zip
'[ [ _ call( x -- y ) _ at ] keep or ] B{ } map-as ; inline
: tr-hints ( word -- )
MACRO: write-tuple ( class -- quot )
[ '[ [ _ boa ] undo ] ]
- [ tuple-arity iota <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
+ [ tuple-arity <iota> <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
bi '[ _ dip @ ] ;
: check-final ( class -- )
<flag> ui-notify-flag set-global
[ fake-ui-loop ] "Fake UI" spawn drop
- 8001 iota [ layout-later ] each
+ 8001 <iota> [ layout-later ] each
ui-notify-flag get-global value>>
layout-queue delete-all
] unit-test
"s" set
{ t } [
- 10 iota [
+ 10 <iota> [
drop
"g2" get scroll>gadget
"s" get layout
:: gradient-vertices ( direction dim colors -- seq )
direction dim v* dim over v- swap
- colors length [ iota ] [ 1 - ] bi v/n [ v*n ] with map
+ colors length [ <iota> ] [ 1 - ] bi v/n [ v*n ] with map
swap [ over v+ 2array ] curry map
concat concat float >c-array ;
grapheme-break-test parse-test-file [ >graphemes ] test
word-break-test parse-test-file [ >words ] test
-{ { t f t t f t } } [ 6 iota [ "as df" word-break-at? ] map ] unit-test
+{ { t f t t f t } } [ 6 <iota> [ "as df" word-break-at? ] map ] unit-test
: make-grapheme-table ( -- )
{ CR } { LF } connect
- { Control CR LF } graphemes iota disconnect
- graphemes iota { Control CR LF } disconnect
+ { Control CR LF } graphemes <iota> disconnect
+ graphemes <iota> { Control CR LF } disconnect
{ L } { L V LV LVT } connect
{ LV V } { V T } connect
{ LVT T } { T } connect
- graphemes iota { Extend } connect
- graphemes iota { SpacingMark } connect
- { Prepend } graphemes iota connect ;
+ graphemes <iota> { Extend } connect
+ graphemes <iota> { SpacingMark } connect
+ { Prepend } graphemes <iota> connect ;
"grapheme-table" create-word-in
graphemes init-table table
: make-word-table ( -- )
{ wCR } { wLF } connect
- { wNewline wCR wLF } unicode-words iota disconnect
- unicode-words iota { wNewline wCR wLF } disconnect
+ { wNewline wCR wLF } unicode-words <iota> disconnect
+ unicode-words <iota> { wNewline wCR wLF } disconnect
{ wALetter } { wMidLetter wMidNumLet } check-letter-after set-table
{ wMidLetter wMidNumLet } { wALetter } check-letter-before set-table
{ wNumeric wALetter } { wNumeric wALetter } connect
: add ( char -- )
dup blocked? [ 1string , ] [
- dup possible-bases dup length iota
+ dup possible-bases dup length <iota>
[ ?combine ] 2with any?
[ drop ] [ 1string , ] if
] if ;
over tail-slice first-word + ;
: last-word ( str -- i )
- [ length iota ] keep '[ _ word-break-at? ] find-last drop 0 or ;
+ [ length <iota> ] keep '[ _ word-break-at? ] find-last drop 0 or ;
: last-word-from ( end str -- i )
swap head-slice last-word ;
:: reg-enum-keys ( registry-info -- seq )
- registry-info sub-keys>> iota [
+ registry-info sub-keys>> <iota> [
[ registry-info key>> ] dip
registry-value-max-length TCHAR <c-array> dup :> registry-value
registry-value length dup :> registry-value-length
{ 2 V{ 2 5 8 } }
}
} [
- 10 iota [ 3 mod ] collect-by
+ 10 <iota> [ 3 mod ] collect-by
] unit-test
{ } zip-as ; inline
: zip-index-as ( values exemplar -- assoc )
- [ dup length iota ] dip zip-as ; inline
+ [ dup length <iota> ] dip zip-as ; inline
: zip-index ( values -- alist )
{ } zip-index-as ; inline
M: enum >alist ( enum -- alist ) ; inline
-M: enum keys seq>> length iota >array ; inline
+M: enum keys seq>> length <iota> >array ; inline
M: enum values seq>> >array ; inline
CONSTANT: crc32-table V{ }
-256 iota [
+256 <iota> [
8 [
[ 2/ ] [ even? ] bi [ crc32-polynomial bitxor ] unless
] times
dup tuple? [ not-a-tuple ] unless ; inline
: prepare-tuple-slots ( tuple -- n tuple )
- check-tuple [ tuple-size iota ] keep ;
+ check-tuple [ tuple-size <iota> ] keep ;
: copy-tuple-slots ( n tuple -- array )
[ array-nth ] curry map ;
M: tuple-class slots>tuple ( seq class -- tuple )
check-slots pad-slots
tuple-layout <tuple> [
- [ tuple-size iota ]
+ [ tuple-size <iota> ]
[ [ set-array-nth ] curry ]
bi 2each
] keep ;
[
[ drop 1000003 ] dip
[ class-of hashcode ] [ tuple-size ] bi
- [ dup fixnum+fast 82520 fixnum+fast ] [ iota ] bi
+ [ dup fixnum+fast 82520 fixnum+fast ] [ <iota> ] bi
] 2keep [
swapd array-nth hashcode* >fixnum rot fixnum-bitxor
pick fixnum*fast [ [ fixnum+fast ] keep ] dip swap
] if ;
: <buckets> ( initial length -- array )
- next-power-of-2 iota swap [ nip clone ] curry map ;
+ next-power-of-2 <iota> swap [ nip clone ] curry map ;
: distribute-buckets ( alist initial quot -- buckets )
swapd [ [ dup first ] dip call 2array ] curry map
M: slice hashcode* [ sequence-hashcode ] recursive-hashcode ;
-M: iota-tuple hashcode*
+M: iota hashcode*
over 0 <= [ 2drop 0 ] [
nip length 0 swap [ sequence-hashcode-step ] each-integer
] if ;
] with-variables
] callcc0 "x" get 5 = ;
-{ t } [ 10 callcc1-test 10 iota reverse >vector = ] unit-test
+{ t } [ 10 callcc1-test 10 <iota> reverse >vector = ] unit-test
{ t } [ callcc-namespace-test ] unit-test
[ 5 throw ] [ 5 = ] must-fail-with
! make sure growth and capacity use same load-factor
{ t } [
- 100 iota
+ 100 <iota>
[ [ <hash-set> ] map ]
[ [ HS{ } clone [ '[ _ adjoin ] each-integer ] keep ] map ] bi
[ [ array>> length ] bi@ = ] 2all?
{ H{ } } [ { } [ dup ] H{ } map>assoc ] unit-test
-{ } [ 1000 iota [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
+{ } [ 1000 <iota> [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
{ V{ } }
-[ 1000 iota [ dup sq swap "testhash" get at = ] reject ]
+[ 1000 <iota> [ dup sq swap "testhash" get at = ] reject ]
unit-test
{ t }
! make sure growth and capacity use same load-factor
{ t } [
- 100 iota
+ 100 <iota>
[ [ <hashtable> ] map ]
[ [ H{ } clone [ '[ dup _ set-at ] each-integer ] keep ] map ] bi
[ [ array>> length ] bi@ = ] 2all?
{ 1 } [ 2 "h" get at ] unit-test
! Random test case
-{ "A" } [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test
+{ "A" } [ 100 <iota> [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test
PRIVATE>
-: >le ( x n -- byte-array ) iota map-bytes ;
+: >le ( x n -- byte-array ) <iota> map-bytes ;
-: >be ( x n -- byte-array ) iota <reversed> map-bytes ;
+: >be ( x n -- byte-array ) <iota> <reversed> map-bytes ;
: d>w/w ( d -- w1 w2 )
[ 0xffffffff bitand ] [ -32 shift 0xffffffff bitand ] bi ;
set-nth-unsafe ; inline
: ascii-string>utf16-byte-array ( off string -- byte-array )
- [ length >fixnum [ iota ] [ 2 fixnum*fast <byte-array> ] bi ] keep
+ [ length >fixnum [ <iota> ] [ 2 fixnum*fast <byte-array> ] bi ] keep
[ [ ascii-char>utf16-byte-array ] 2curry with each ] 2keep drop ; inline
: ascii-string>utf16le ( string stream -- )
{ 3 } [ 2 "lápis" >utf8-index ] unit-test
-{ V{ } } [ 100000 iota [ [ code-point-length ] [ 1string utf8 encode length ] bi = ] reject ] unit-test
+{ V{ } } [ 100000 <iota> [ [ code-point-length ] [ 1string utf8 encode length ] bi = ] reject ] unit-test
{ { CHAR: replacement-character } } [ { 0b110,00000 0b10,000000 } decode-utf8-w/stream ] unit-test
{ { CHAR: replacement-character } } [ { 0b110,00001 0b10,111111 } decode-utf8-w/stream ] unit-test
{ $notes "This operation is efficient and does not copy the quotation." }
{ $examples
{ $example "USING: kernel math prettyprint sequences ;" "1 { 1 2 3 } [ / ] with map ." "{ 1 1/2 1/3 }" }
- { $example "USING: kernel math prettyprint sequences ;" "1000 100 5 iota [ sq + + ] 2with map ." "{ 1100 1101 1104 1109 1116 }" }
+ { $example "USING: kernel math prettyprint sequences ;" "1000 100 5 <iota> [ sq + + ] 2with map ." "{ 1100 1101 1104 1109 1116 }" }
} ;
HELP: 2with
{ 1 2 8 }
{ 1 2 9 }
}
-} [ 1 2 10 iota [ 3array ] 2with map ] unit-test
+} [ 1 2 10 <iota> [ 3array ] 2with map ] unit-test
! Don't leak extra roots if error is thrown
{ } [ 1000 [ [ 3 throw ] ignore-errors ] times ] unit-test
{ 0 } [ 1/0. >bignum ] unit-test
-{ t } [ 64 iota [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
+{ t } [ 64 <iota> [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
{ 5 } [ 10.5 1.9 /i ] unit-test
drop 2097103 <byte-array> ;
: outer ( -- lag )
- 9 iota [ inner ] map
+ 9 <iota> [ inner ] map
! D 0 is scrubbed, but if the branch calling 'inner' was
! called, then both D 0 and D 1 should have been scrubbed.
0 9 1 tup2 boa ;
{ fixnum } [ 1 >bignum SBUF" " new-sequence length class-of ] unit-test
-{ fixnum } [ 1 >bignum iota [ ] SBUF" " map-as length class-of ] unit-test
+{ fixnum } [ 1 >bignum <iota> [ ] SBUF" " map-as length class-of ] unit-test
[ 1.5 SBUF" " new-sequence ] must-fail
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
{ $examples
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
- "10 iota [ even? ] selector [ each ] dip ."
+ "10 <iota> [ even? ] selector [ each ] dip ."
"V{ 0 2 4 6 8 }"
}
}
{ $description "Like " { $link reduce } ", but splits the sequence in half recursively until each sequence is small enough, and calls the quotation on these smaller sequences. If the quotation computes values that depend on the size of their input, such as bignum arithmetic, then this algorithm can be more efficient than using " { $link reduce } "." }
{ $examples "Computing factorial:"
{ $example "USING: prettyprint sequences math ;"
- "40 iota rest-slice 1 [ * ] binary-reduce ."
+ "40 <iota> rest-slice 1 [ * ] binary-reduce ."
"20397882081197443358640281739902897356800000000" }
} ;
"V{ 1 2 3 }"
} } ;
-HELP: iota
+HELP: <iota>
{ $values { "n" integer } { "iota" iota } }
{ $description "Creates an immutable virtual sequence containing the integers from 0 to " { $snippet "n-1" } "." }
{ $examples
{ $example
"USING: math sequences prettyprint ;"
- "3 iota [ sq ] map ."
+ "3 <iota> [ sq ] map ."
"{ 0 1 4 }"
}
} ;
ARTICLE: "sequences-integers" "Counted loops"
"A virtual sequence is defined for iterating over integers from zero."
-{ $subsection iota }
-"For example, calling " { $link iota } " on the integer 3 produces a sequence containing the elements 0, 1, and 2. This is very useful for performing counted loops using words such as " { $link each } ":"
-{ $example "USING: sequences prettyprint ; 3 iota [ . ] each" "0\n1\n2" }
+{ $subsection <iota> }
+"For example, calling " { $link <iota> } " on the integer 3 produces a sequence containing the elements 0, 1, and 2. This is very useful for performing counted loops using words such as " { $link each } ":"
+{ $example "USING: sequences prettyprint ; 3 <iota> [ . ] each" "0\n1\n2" }
"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link each-index } ", " { $link map-index } " and " { $link reduce-index } "."
$nl
-"Combinators that produce new sequences, such as " { $link map } ", will output an array if the input is an instance of " { $link iota } "."
+"Combinators that produce new sequences, such as " { $link map } ", will output an array if the input is an instance of " { $link <iota> } "."
$nl
"More elaborate counted loops can be performed with " { $link "math.ranges" } "." ;
{ "empty" } [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
{ { 1 } "not empty" } [ { 1 } [ "empty" ] [ "not empty" ] if-empty ] unit-test
-{ V{ 1 2 3 4 } } [ 1 5 dup iota <slice> >vector ] unit-test
-{ 3 } [ 1 4 dup iota <slice> length ] unit-test
+{ V{ 1 2 3 4 } } [ 1 5 dup <iota> <slice> >vector ] unit-test
+{ 3 } [ 1 4 dup <iota> <slice> length ] unit-test
{ 2 } [ 1 3 { 1 2 3 4 } <slice> length ] unit-test
{ V{ 2 3 } } [ 1 3 { 1 2 3 4 } <slice> >vector ] unit-test
{ V{ 4 5 } } [ { 1 2 3 4 5 } 2 tail-slice* >vector ] unit-test
-{ V{ 3 4 } } [ 2 4 1 10 dup iota <slice> subseq >vector ] unit-test
-{ V{ 3 4 } } [ 0 2 2 4 1 10 dup iota <slice> <slice> subseq >vector ] unit-test
+{ V{ 3 4 } } [ 2 4 1 10 dup <iota> <slice> subseq >vector ] unit-test
+{ V{ 3 4 } } [ 0 2 2 4 1 10 dup <iota> <slice> <slice> subseq >vector ] unit-test
[ 0 10 "hello" <slice> ] must-fail
[ -10 3 "hello" <slice> ] must-fail
[ 2 1 "hello" <slice> ] must-fail
{ t } [ B{ 0 } { 1 } append byte-array? ] unit-test
{ t } [ B{ 0 } { 1 } prepend byte-array? ] unit-test
-{ "0123456789" } [ 58 iota [ 48 < ] "" reject-as ] unit-test
+{ "0123456789" } [ 58 <iota> [ 48 < ] "" reject-as ] unit-test
{ [ ] } [ 1 [ ] remove ] unit-test
{ [ ] } [ 1 [ 1 ] remove ] unit-test
[ 4 [ CHAR: a <string> ] { } map-integers ]
unit-test
-{ V{ 1 3 5 7 9 } } [ 10 iota >vector [ even? ] reject! ] unit-test
+{ V{ 1 3 5 7 9 } } [ 10 <iota> >vector [ even? ] reject! ] unit-test
{ V{ } } [ "f" V{ } clone remove! ] unit-test
{ V{ } } [ "f" V{ "f" } clone remove! ] unit-test
{ V{ "x" } } [ "f" V{ "f" "x" "f" } clone remove! ] unit-test
{ V{ "y" "x" } } [ "f" V{ "y" "f" "x" "f" } clone remove! ] unit-test
-{ V{ 0 1 4 5 } } [ 6 iota >vector 2 4 pick delete-slice ] unit-test
+{ V{ 0 1 4 5 } } [ 6 <iota> >vector 2 4 pick delete-slice ] unit-test
[ 6 >vector 2 8 pick delete-slice ] must-fail
-{ V{ } } [ 6 iota >vector 0 6 pick delete-slice ] unit-test
+{ V{ } } [ 6 <iota> >vector 0 6 pick delete-slice ] unit-test
{ { 1 2 "a" "b" 5 6 7 } } [
{ "a" "b" } 2 4 { 1 2 3 4 5 6 7 }
{ 0 } [ f length ] unit-test
[ f first ] must-fail
-{ 3 } [ 3 10 iota nth ] unit-test
-{ 3 } [ 3 10 iota nth-unsafe ] unit-test
-[ -3 10 iota nth ] must-fail
-[ 11 10 iota nth ] must-fail
+{ 3 } [ 3 10 <iota> nth ] unit-test
+{ 3 } [ 3 10 <iota> nth-unsafe ] unit-test
+[ -3 10 <iota> nth ] must-fail
+[ 11 10 <iota> nth ] must-fail
{ f } [ f ?first ] unit-test
{ f } [ { } ?first ] unit-test
-{ 0 } [ 10 iota ?first ] unit-test
+{ 0 } [ 10 <iota> ?first ] unit-test
{ f } [ f ?last ] unit-test
{ f } [ { } ?last ] unit-test
-{ 9 } [ 10 iota ?last ] unit-test
+{ 9 } [ 10 <iota> ?last ] unit-test
[ -1/0. 0 remove-nth! ] must-fail
{ "" } [ "" [ CHAR: \s = ] trim ] unit-test
{ "asdf " } [ " asdf " [ CHAR: \s = ] trim-head ] unit-test
{ " asdf" } [ " asdf " [ CHAR: \s = ] trim-tail ] unit-test
-{ 328350 } [ 100 iota [ sq ] map-sum ] unit-test
+{ 328350 } [ 100 <iota> [ sq ] map-sum ] unit-test
-{ 50 } [ 100 iota [ even? ] count ] unit-test
-{ 50 } [ 100 iota [ odd? ] count ] unit-test
+{ 50 } [ 100 <iota> [ even? ] count ] unit-test
+{ 50 } [ 100 <iota> [ odd? ] count ] unit-test
{ { "b" "d" } } [ { 1 3 } { "a" "b" "c" "d" } nths ] unit-test
{ { "a" "b" "c" "d" } } [ { 0 1 2 3 } { "a" "b" "c" "d" } nths ] unit-test
{ V{ 0 3 } } [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test
-[ "asdf" iota ] must-fail
-[ -1 iota ] must-fail
-{ T{ iota-tuple { n 10 } } } [ 10 iota ] unit-test
-{ 0 } [ 10 iota first ] unit-test
-{ 0 } [ 0 iota sum ] unit-test
-{ 0 } [ 1 iota sum ] unit-test
-{ 10 } [ 5 iota sum ] unit-test
-{ 15 } [ 6 iota sum ] unit-test
+[ "asdf" <iota> ] must-fail
+[ -1 <iota> ] must-fail
+{ T{ iota { n 10 } } } [ 10 <iota> ] unit-test
+{ 0 } [ 10 <iota> first ] unit-test
+{ 0 } [ 0 <iota> sum ] unit-test
+{ 0 } [ 1 <iota> sum ] unit-test
+{ 10 } [ 5 <iota> sum ] unit-test
+{ 15 } [ 6 <iota> sum ] unit-test
{ "hi" 3 } [
{ 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
[ { } { } [ + ] [ + ] 2map-reduce ] must-fail
{ 24 } [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test
-{ 4 } [ 5 iota [ ] supremum-by ] unit-test
-{ 0 } [ 5 iota [ ] infimum-by ] unit-test
+{ 4 } [ 5 <iota> [ ] supremum-by ] unit-test
+{ 0 } [ 5 <iota> [ ] infimum-by ] unit-test
{ "bar" } [ { "bar" "baz" "qux" } [ length ] supremum-by ] unit-test
{ "bar" } [ { "bar" "baz" "qux" } [ length ] infimum-by ] unit-test
{ { "foo" } } [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
INSTANCE: f immutable-sequence
! Integer sequences
-TUPLE: iota-tuple { n integer read-only } ;
+TUPLE: iota { n integer read-only } ;
ERROR: non-negative-integer-expected n ;
-: iota ( n -- iota )
+: <iota> ( n -- iota )
dup 0 < [ non-negative-integer-expected ] when
- iota-tuple boa ; inline
+ iota boa ; inline
-M: iota-tuple length n>> ; inline
-M: iota-tuple nth-unsafe drop ; inline
+M: iota length n>> ; inline
+M: iota nth-unsafe drop ; inline
-INSTANCE: iota-tuple immutable-sequence
+INSTANCE: iota immutable-sequence
<PRIVATE
(each-index) each-integer ; inline
: map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... newseq )
- [ dup length iota ] 2dip 2map-as ; inline
+ [ dup length <iota> ] 2dip 2map-as ; inline
: map-index ( ... seq quot: ( ... elt index -- ... newelt ) -- ... newseq )
{ } map-index-as ; inline
GENERIC: sum ( seq -- n )
M: object sum 0 [ + ] binary-reduce ; inline
-M: iota-tuple sum length dup 1 - * 2/ ; inline
+M: iota sum length dup 1 - * 2/ ; inline
M: repetition sum [ elt>> ] [ length>> ] bi * ; inline
: product ( seq -- n ) 1 [ * ] binary-reduce ;
: generic-flip ( matrix -- newmatrix )
[
[ first-unsafe length 1 ] keep
- [ length min ] setup-each (each-integer) iota
+ [ length min ] setup-each (each-integer) <iota>
] keep
[ [ nth-unsafe ] with { } map-as ] curry { } map-as ; inline
{ array } declare
[
[ first-unsafe array-length 1 ] keep
- [ array-length min ] setup-each (each-integer) iota
+ [ array-length min ] setup-each (each-integer) <iota>
] keep
[ [ { array } declare array-nth ] with { } map-as ] curry { } map-as ;
[ make-slot ] map ;
: finalize-slots ( specs base -- specs )
- over length iota [ + ] with map [ >>offset ] 2map ;
+ over length <iota> [ + ] with map [ >>offset ] 2map ;
: slot-named* ( name specs -- offset spec/f )
[ name>> = ] with find ;
{ { } } [ { } natural-sort ] unit-test
{ { 270000000 270000001 } }
-[ T{ slice f 270000000 270000002 T{ iota-tuple f 270000002 } } natural-sort ]
+[ T{ slice f 270000000 270000002 T{ iota f 270000002 } } natural-sort ]
unit-test
{ t } [
{ 4 } [ 5 V{ 1 2 3 4 5 } index ] unit-test
{ t } [
- 100 iota >array dup >vector <reversed> >array [ reverse ] dip =
+ 100 <iota> >array dup >vector <reversed> >array [ reverse ] dip =
] unit-test
{ fixnum } [ 1 >bignum V{ } new-sequence length class-of ] unit-test
-{ fixnum } [ 1 >bignum iota [ ] V{ } map-as length class-of ] unit-test
+{ fixnum } [ 1 >bignum <iota> [ ] V{ } map-as length class-of ] unit-test
{ V{ "lulz" } } [ "lulz" 1vector ] unit-test
float-4{ 2.0 2.0 2.0 2.0 }
}
} [
- 3 iota [ float-4-with ] data-map( object -- float-4 )
+ 3 <iota> [ float-4-with ] data-map( object -- float-4 )
float-4 cast-array
] unit-test
float-4{ 8.0 9.0 10.0 11.0 }
}
} [
- 12 iota [ float-4-boa ] data-map( object[4] -- float-4 )
+ 12 <iota> [ float-4-boa ] data-map( object[4] -- float-4 )
float-4 cast-array
] unit-test
: ones ( shape -- shaped-array ) 1 repeated-shaped ;
: increasing ( shape -- shaped-array )
- [ shape-capacity iota >array ] [ ] bi <shaped-array> ;
+ [ shape-capacity <iota> >array ] [ ] bi <shaped-array> ;
: decreasing ( shape -- shaped-array )
- [ shape-capacity iota <reversed> >array ] [ ] bi <shaped-array> ;
+ [ shape-capacity <iota> <reversed> >array ] [ ] bi <shaped-array> ;
: row-length ( shape -- n ) rest-slice product ; inline
! : set-shaped-where ( .. elt sa quot -- )
! [
- ! [ underlying>> [ length iota ] keep zip ]
+ ! [ underlying>> [ length <iota> ] keep zip ]
! [ ] bi
! ] dip '[ _ [ _ set- ] @ ] assoc-each ; inline
block-array boa ;
: iteration-indices ( shaped -- seq )
- [ iota ] [
+ [ <iota> ] [
cartesian-product concat
[ dup first array? [ first2 suffix ] when ] map
] map-reduce ;
len max-len min :> len'
pcm #channels void* <c-direct-array> :> channel*s
- len' iota [| sample |
- #channels iota [| channel |
+ len' <iota> [| sample |
+ #channels <iota> [| channel |
channel channel*s nth len c:float <c-direct-array>
sample swap nth
float>short-sample short-buffer push
IN: benchmark.base64
: base64-benchmark ( -- )
- 65535 iota [ 255 bitand ] "" map-as
+ 65535 <iota> [ 255 bitand ] "" map-as
20 [ >base64 base64> ] times
drop ;
! http://crazybob.org/BeustSequence.java.html
:: (count-numbers) ( remaining first value used max listener: ( -- ) -- ? )
- 10 first - iota [| i |
+ 10 first - <iota> [| i |
i first + :> digit
digit 2^ :> mask
i value + :> value'
] any? ; inline recursive
:: count-numbers ( max listener -- )
- 10 iota [ 1 + 1 1 0 max listener (count-numbers) ] any? drop ; inline
+ 10 <iota> [ 1 + 1 1 0 max listener (count-numbers) ] any? drop ; inline
:: beust2-benchmark ( -- )
0 :> i!
IN: benchmark.bloom-filters
: insert-data ( bloom-filter -- bloom-filter )
- 100 [ 2,000 iota [ over bloom-filter-insert ] each ] times ;
+ 100 [ 2,000 <iota> [ over bloom-filter-insert ] each ] times ;
: test-hit ( bloom-filter -- bloom-filter )
100,000 [ 100 over bloom-filter-member? drop ] times ;
<mailbox> >>mailbox ;
: make-creatures ( colors -- seq )
- [ length iota ] [ ] bi [ <creature> ] 2map ;
+ [ length <iota> ] [ ] bi [ <creature> ] 2map ;
: complement-color ( color1 color2 -- color3 )
2dup = [ drop ] [
] with each ;
: bench-permutations ( n -- )
- iota {
+ <iota> {
[ all-permutations drop ]
[ [ drop ] each-permutation ]
[ [ first 2 = ] find-permutation drop ]
IN: benchmark.csv
: csv-benchmark ( -- )
- 1,000 200
iota [ number>string ] map <array>
+ 1,000 200
<iota> [ number>string ] map <array>
[ csv>string string>csv ] keep assert= ;
MAIN: csv-benchmark
: count-ones ( int-array -- n ) [ 1 = ] count ; inline
: make-int-array ( -- int-array )
- 120000 iota [ 255 bitand ] int-array{ } map-as ; inline
+ 120000 <iota> [ 255 bitand ] int-array{ } map-as ; inline
: dawes-benchmark ( -- )
200 make-int-array '[ _ count-ones ] replicate drop ;
: sequences ( -- seq )
[
- 1 iota ,
- 10 >bignum iota ,
+ 1 <iota> ,
+ 10 >bignum <iota> ,
{ 1 2 3 } ,
"hello world" ,
SBUF" sbuf world" ,
double-array{ 1.0 2.0 3.0 } ,
"hello world" 4 tail-slice ,
10 f <repetition> ,
- 100 iota 2 <groups> ,
+ 100 <iota> 2 <groups> ,
"hello" <reversed> ,
{ { 1 2 } { 3 4 } } 0 <column> ,
?{ t f t } ,
IN: benchmark.dlists
: dlists-benchmark ( -- )
- 5,000 iota [
- [ iota 0 swap >dlist [ + ] slurp-deque ]
+ 5,000 <iota> [
+ [ <iota> 0 swap >dlist [ + ] slurp-deque ]
[ dup 1 - * 2 / ] bi assert=
] each ;
IN: benchmark.e-decimals
: D-factorial ( n -- D! )
- iota DECIMAL: 1 [ 0 <decimal> DECIMAL: 1 D+ D* ] reduce ; inline
+ <iota> DECIMAL: 1 [ 0 <decimal> DECIMAL: 1 D+ D* ] reduce ; inline
:: calculate-e-decimals ( n -- e )
n [1,b] DECIMAL: 1
IN: benchmark.e-ratios
: calculate-e-ratios ( n -- e )
- iota [ factorial recip ] map-sum ;
+ <iota> [ factorial recip ] map-sum ;
: e-ratios-benchmark ( -- )
5 [ 300 calculate-e-ratios drop ] times ;
IN: benchmark.empty-loop-2
: empty-loop-2 ( n -- )
- iota [ drop ] each ;
+ <iota> [ drop ] each ;
: empty-loop-2-benchmark ( -- )
50000000 empty-loop-2 ;
: fannkuch ( n -- )
[
- [ 0 0 ] dip iota [ 1 + ] B{ } map-as
+ [ 0 0 ] dip <iota> [ 1 + ] B{ } map-as
[ fannkuch-step ] each-permutation nip
] keep
"Pfannkuchen(" write pprint ") = " write . ;
TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
alu length :> kn
- len iota [ k + kn mod alu nth-unsafe ] "" map-as print
+ len <iota> [ k + kn mod alu nth-unsafe ] "" map-as print
k len + ;
: write-repeat-fasta ( n alu desc id -- )
USING: math sequences kernel ;
IN: benchmark.gc1
-: gc1-benchmark ( -- ) 600000 iota [ >bignum 1 + ] map drop ;
+: gc1-benchmark ( -- ) 600000 <iota> [ >bignum 1 + ] map drop ;
MAIN: gc1-benchmark
IN: benchmark.gc3
: gc3-benchmark ( -- )
- 1000000 iota
+ 1000000 <iota>
1000000 <hashtable>
'[ [ number>string ] keep _ set-at ] each ;
CONSTANT: test-sets $[
{ 10 100 1,000 10,000 50,000 100,000 }
- [ iota >hash-set ] map dup append
+ [ <iota> >hash-set ] map dup append
]
: do-times ( n quot: ( set1 set2 -- set' ) -- )
USING: sequences vectors arrays strings sbufs math math.vectors
kernel ;
-: <range> ( from to -- seq ) dup iota <slice> ; inline
+: <range> ( from to -- seq ) dup <iota> <slice> ; inline
: vector-iter ( -- ) 100 [ 0 100000 <range> >vector [ ] map drop ] times ;
: array-iter ( -- ) 100 [ 0 100000 <range> >array [ ] map drop ] times ;
IN: benchmark.json
: json-benchmark ( -- )
- 200 iota [ [ number>string ] keep ] H{ } map>assoc
+ 200 <iota> [ [ number>string ] keep ] H{ } map>assoc
1,000 [ >json json> ] times drop ;
MAIN: json-benchmark
IN: benchmark.linked-assocs
: (linked-assocs-benchmark) ( -- )
- 10,000 iota <linked-hash> {
+ 10,000 <iota> <linked-hash> {
[ '[ 0 swap _ set-at ] each ]
[ '[ _ at ] map-sum 0 assert= ]
[ '[ dup _ set-at ] each ]
[ [ CHAR: a , ] times ] "" make ;
: make-arrays ( n -- seq )
- [ iota % ] { } make ;
+ [ <iota> % ] { } make ;
: make-vectors ( n -- seq )
- [ iota % ] V{ } make ;
+ [ <iota> % ] V{ } make ;
: make-benchmark ( -- )
- 5,000 iota [
+ 5,000 <iota> [
[ make-strings ] [ make-arrays ] [ make-vectors ] tri
3drop
] each ;
CONSTANT: val 0.85
: <color-map> ( nb-cols -- map )
- [ iota ] keep '[
+ [ <iota> ] keep '[
360 * _ 1 + / sat val
1 <hsva> >rgba scale-rgb
] map ;
[ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
: render ( -- )
- height iota [ width iota swap '[ _ c pixel color write ] each ] each ; inline
+ height <iota> [ width iota swap '[ _ c pixel color write ] each ] each ; inline
: ppm-header ( -- )
ascii encode-output
{ 0.0 0.0 0.0 0.0 }
{ 0.0 0.0 0.0 0.0 }
}
- iterations iota [| i |
+ iterations <iota> [| i |
m i m^n i factorial >float m/n m+
] each ;
TYPED:: e^m4 ( m: matrix4 iterations: fixnum -- e^m: matrix4 )
zero-matrix4
- iterations iota [| i |
+ iterations <iota> [| i |
m i m4^n i factorial >float m4/n m4+
] each ;
IN: benchmark.md5
: md5-benchmark ( -- )
- 2000000 iota >byte-array md5 checksum-bytes drop ;
+ 2000000 <iota> >byte-array md5 checksum-bytes drop ;
MAIN: md5-benchmark
: memoize-benchmark ( -- )
1000 [
- 1000 iota [
+ 1000 <iota> [
mem0 [ mem1 ] keep [ mem2 ] 2keep [ mem3 ] 3keep mem4 drop
] each
] times ;
[ >msgpack msgpack> length ] map-sum ;
: msgpack-benchmark ( -- )
- 500,000 iota pack-sum 124,999,750,000 assert=
+ 500,000 <iota> pack-sum 124,999,750,000 assert=
500,000 "hello" <repetition> pack-sum-lengths 2,500,000 assert=
500,000 pi <repetition> pack-sum 0x1.7f7ec53a9f04ap20 assert= ;
IN: benchmark.parse-bignum
: parse-bignum-benchmark ( -- )
- 3000 iota [
+ 3000 <iota> [
2^ [ number>string string>number ] [ assert= ] bi
] each ;
IN: benchmark.parse-fixnum
: parse-fixnum-benchmark ( -- )
- 2,000,000 iota [
+ 2,000,000 <iota> [
[ number>string string>number ] [ assert= ] bi
] each ;
IN: benchmark.partial-sums
! Helper words
-: summing-integers ( n quot -- y ) [ 0.0 ] [ iota ] [ ] tri* '[ 1 + @ + ] each ; inline
+: summing-integers ( n quot -- y ) [ 0.0 ] [ <iota> ] [ ] tri* '[ 1 + @ + ] each ; inline
: summing-floats ( n quot -- y ) '[ >float @ ] summing-integers ; inline
: cube ( x -- y ) dup dup * * ; inline
: -1^ ( n -- -1/1 ) 2 mod 2 * 1 - ; inline
USING: arrays kernel literals random sequences ;
IN: benchmark.randomize
-CONSTANT: data $[ 10,000,000 iota >array ]
+CONSTANT: data $[ 10,000,000 <iota> >array ]
: randomize-benchmark ( -- )
data randomize drop ;
: ray-pixel ( scene point -- ray-grid )
[ 0.0 ] 2dip
- oversampling iota [
- oversampling iota [
+ oversampling <iota> [
+ oversampling <iota> [
ss-point v+ normalize
double-4{ 0.0 0.0 -4.0 0.0 } swap <ray>
swap cast-ray +
] 2with each ; inline no-compile
: ray-trace ( scene -- grid )
- size iota <reversed> [
- size iota [
+ size <iota> <reversed> [
+ size <iota> [
[ size 0.5 * - ] bi@ swap size
0.0 double-4-boa ray-pixel
] 2with map
[ oversampling /f ] bi@ 0.0 double-array{ } 3sequence ;
: ss-grid ( -- ss-grid )
- oversampling iota [ oversampling iota [ ss-point ] with map ] map ;
+ oversampling <iota> [ oversampling iota [ ss-point ] with map ] map ;
: ray-grid ( point ss-grid -- ray-grid )
[
[ [ swap cast-ray + ] with each ] with each ;
: pixel-grid ( -- grid )
- size iota reverse [
- size iota [
+ size <iota> reverse [
+ size <iota> [
[ size 0.5 * - ] bi@ swap size
double-array{ } 3sequence
] with map
: regexp-benchmark ( -- )
200
- 20,000 iota [ number>string ] map
- 200 iota [ 1 + CHAR: a <string> ] map
+ 20,000 <iota> [ number>string ] map
+ 200 <iota> [ 1 + CHAR: a <string> ] map
'[
_ R/ \d+/ [ matches? ] curry all? t assert=
_ R/ [a]+/ [ matches? ] curry all? t assert=
] times ;
: send-messages ( messages target -- )
- [ dup iota ] dip [ send ] curry each [ receive drop ] times ;
+ [ dup <iota> ] dip [ send ] curry each [ receive drop ] times ;
: destroy-ring ( target -- )
done swap send [ done eq? ] receive-if drop ;
IN: benchmark.sha1
: sha1-benchmark ( -- )
- 2000000 iota >byte-array sha1 checksum-bytes drop ;
+ 2000000 <iota> >byte-array sha1 checksum-bytes drop ;
: sha224-benchmark ( -- )
- 2000000 iota >byte-array sha-224 checksum-bytes drop ;
+ 2000000 <iota> >byte-array sha-224 checksum-bytes drop ;
: sha256-benchmark ( -- )
- 2000000 iota >byte-array sha-256 checksum-bytes drop ;
+ 2000000 <iota> >byte-array sha-256 checksum-bytes drop ;
USE: checksums.openssl
: openssl-sha1-benchmark ( -- )
- 2000000 iota >byte-array openssl-sha1 checksum-bytes drop ;
+ 2000000 <iota> >byte-array openssl-sha1 checksum-bytes drop ;
MAIN: sha1-benchmark
0.0 float-4-boa ; inline
: make-points ( len -- points )
-
iota [ <point> ] float-4-array{ } map-as ; inline
+
<iota> [ <point> ] float-4-array{ } map-as ; inline
: normalize-points ( points -- )
[ normalize ] map! drop ; inline
IN: benchmark.sort
CONSTANT: numbers-to-sort $[ 300,000 200 random-integers ]
-CONSTANT: alist-to-sort $[ 1,000 iota dup zip ]
+CONSTANT: alist-to-sort $[ 1,000 <iota> dup zip ]
: sort-benchmark ( -- )
10 [ numbers-to-sort natural-sort drop ] times
IN: benchmark.spectral-norm-simd
:: inner-loop ( u n quot -- seq )
- n 4 /i iota [| i |
- n iota [| j | u i j quot call ] [ v+ ] map-reduce
+ n 4 /i <iota> [| i |
+ n <iota> [| j | u i j quot call ] [ v+ ] map-reduce
] double-4-array{ } map-as ; inline
: eval-A ( i j -- n )
IN: benchmark.spectral-norm
:: inner-loop ( u n quot -- seq )
- n iota [| i |
- n iota 0.0 [| j |
+ n <iota> [| i |
+ n <iota> 0.0 [| j |
u i j quot call +
] reduce
] double-array{ } map-as ; inline
IN: benchmark.splay
: initial-alist ( n -- alist )
- iota >array randomize dup zip ;
+ <iota> >array randomize dup zip ;
: change-random ( newkeys splay keys -- splay' )
swapd [ first pick delete-at first2 pick set-at ] 2each ;
IN: benchmark.splitting
: test-data ( -- seq seps )
- 1000 iota dup [ 10 /i zero? ] filter ; ! not inline to prevent type inference
+ 1000 <iota> dup [ 10 /i zero? ] filter ; ! not inline to prevent type inference
: splitting-benchmark ( -- )
test-data 2,000 [
<<
"sum-file.txt" temp-file ascii [
- 100000 iota [ number>string print ] each
+ 100000 <iota> [ number>string print ] each
] with-file-writer
>>
! Max size here is 26 2^ 1 - because array-capacity limits on 32bit platforms
CONSTANT: test-size0 $[ 23 2^ 1 - ]
-MEMO: test-bytes ( n -- byte-array ) iota >byte-array ;
+MEMO: test-bytes ( n -- byte-array ) <iota> >byte-array ;
TUPLE: tcp-echo < threaded-server #times #bytes ;
TUPLE-ARRAY: point
: tuple-arrays-benchmark ( -- )
- 1,000 iota [
+ 1,000 <iota> [
drop 5,000 <point-array> [
[ 1 + ] change-x
[ 1 - ] change-y
: udp-echo ( #times #bytes -- )
'[
- _ iota [ _ >be ] map
+ _ <iota> [ _ >be ] map
"127.0.0.1" 0 <inet4> <datagram> &dispose
"127.0.0.1" 0 <inet4> <datagram> &dispose
[ send/recv ] 2curry each
IN: benchmark.ui-panes
: ui-panes-benchmark ( -- )
- [ 10000 iota [ number>string print ] each ] make-pane drop ;
+ [ 10000 <iota> [ number>string print ] each ] make-pane drop ;
MAIN: ui-panes-benchmark
IN: benchmark.wrap
: wrap-benchmark ( -- )
- 1,000 iota [ number>string ] map " " join
+ 1,000 <iota> [ number>string ] map " " join
100 [ dup 80 wrap-string drop ] times drop ;
MAIN: wrap-benchmark
h >>uv_height
w >>y_stride
w >>uv_stride
- w h * iota [ dup * ] B{ } map-as malloc-byte-array &free >>y
- w h * 2/ iota [ dup dup * * ] B{ } map-as malloc-byte-array &free >>u
- w h * 2/ iota [ dup * dup * ] B{ } map-as malloc-byte-array &free >>v ;
+ w h * <iota> [ dup * ] B{ } map-as malloc-byte-array &free >>y
+ w h * 2/ <iota> [ dup dup * * ] B{ } map-as malloc-byte-array &free >>u
+ w h * 2/ <iota> [ dup * dup * ] B{ } map-as malloc-byte-array &free >>v ;
: clamp ( n -- n )
255 min 0 max ; inline
: yuv>rgb-row ( index rgb yuv y -- index )
over stride
- pick y_width>> iota
+ pick y_width>> <iota>
[ yuv>rgb-pixel ] 4 nwith each ; inline
TYPED: yuv>rgb ( rgb: byte-array yuv: yuv-buffer -- )
[ 0 ] 2dip
- dup y_height>> iota
+ dup y_height>> <iota>
[ yuv>rgb-row ] 2with each
drop ;
! Should not generate bignum hash codes. Enhanced double hashing may generate a
! lot of hash codes, and it's better to do this earlier than later.
-{ t } [ 10000 iota [ double-hashcodes [ fixnum? ] both? ] all? ] unit-test
+{ t } [ 10000 <iota> [ double-hashcodes [ fixnum? ] both? ] all? ] unit-test
: empty-bloom-filter ( -- bloom-filter )
0.01 2000 <bloom-filter> ;
{ 1 } [ basic-insert-test-setup count>> ] unit-test
: non-empty-bloom-filter ( -- bloom-filter )
- 1000 iota
+ 1000 <iota>
empty-bloom-filter
[ [ bloom-filter-insert ] curry each ] keep ;
: full-bloom-filter ( -- bloom-filter )
- 2000 iota
+ 2000 <iota>
empty-bloom-filter
[ [ bloom-filter-insert ] curry each ] keep ;
! Should find what we put in there.
-{ t } [ 2000 iota
+{ t } [ 2000 <iota>
full-bloom-filter
[ bloom-filter-member? ] curry map
[ ] all?
] unit-test
! We shouldn't have more than 0.01 false-positive rate.
-{ t } [ 1000 iota [ drop most-positive-fixnum random 1000 + ] map
+{ t } [ 1000 <iota> [ drop most-positive-fixnum random 1000 + ] map
full-bloom-filter
[ bloom-filter-member? ] curry map
[ ] count
<PRIVATE
: write-le ( x n -- )
- iota [ nth-byte write1 ] with each ; inline
+ <iota> [ nth-byte write1 ] with each ; inline
TYPED: write-int32 ( int: integer -- )
INT32-SIZE write-le ; inline
space 2.0 10000 cpSpaceResizeActiveHash
space 1 >>iterations drop
- image-height iota [| y |
- image-width iota [| x |
+ image-height <iota> [| y |
+ image-width <iota> [| x |
x y get-pixel [
x image-width 2 / - 0.05 random-unit * + 2 *
image-height 2 / y - 0.05 random-unit * + 2 *
[ vectored-element> ] T-array new map-as ; inline
M: T-array struct-transpose
- dup length [ nip iota ] [ drop ] [ nip (vectored-T) ] 2tri
+ dup length [ nip <iota> ] [ drop ] [ nip (vectored-T) ] 2tri
[ [ [ nth ] [ set-nth ] bi-curry* bi ] 2curry each ] keep ; inline
;FUNCTOR
[
[ , [ f <array> ] % ]
[
- dup iota [
+ dup <iota> [
- 1 - , [ swap [ set-array-nth ] keep ] %
] with each
] bi
! should be redone completely.
: useless-shuffle-vector-imm? ( insn -- ? )
- [ shuffle>> ] [ rep>> rep-length iota ] bi sequence= ;
+ [ shuffle>> ] [ rep>> rep-length <iota> ] bi sequence= ;
: compose-shuffle-vector-imm ( outer inner -- insn' )
2dup [ rep>> ] bi@ eq? [
'[ CHAR: \0 _ ? ] "" map-as append
md5 checksum-bytes :> final!
- 1000 iota [
+ 1000 <iota> [
"" swap
{
[ 0 bit? password final ? append ]
: xor-crypt ( seq key -- seq' )
[ empty-xor-key ] when-empty
- [ dup length iota ] dip '[ _ mod-nth bitxor ] 2map ;
+ [ dup length <iota> ] dip '[ _ mod-nth bitxor ] 2map ;
[ { CUdevice } ] dip '[ _ cuDeviceGet cuda-error ] with-out-parameters ;
: enumerate-cuda-devices ( -- devices )
- #cuda-devices iota [ n>cuda-device ] map ;
+ #cuda-devices <iota> [ n>cuda-device ] map ;
: with-each-cuda-device ( quot -- )
[ enumerate-cuda-devices ] dip '[ 0 _ with-cuda-context ] each ; inline
: cuda. ( -- )
init-cuda
"CUDA Version: " write cuda-version number>string print nl
- #cuda-devices iota [ nl ] [ cuda-device. ] interleave ;
+ #cuda-devices <iota> [ nl ] [ cuda-device. ] interleave ;
: up/i ( x y -- z )
[ 1 - + ] keep /i ; inline
IN: enigma.tests
-{ t } [ <reflector> natural-sort 26 iota sequence= ] unit-test
+{ t } [ <reflector> natural-sort 26 <iota> sequence= ] unit-test
{ "" } [ "" 4 <enigma> encode ] unit-test
IN: enigma
: <alphabet> ( -- seq )
- 26 iota >array ;
+ 26 <iota> >array ;
: <cog> ( -- cog )
<alphabet> randomize ;
: <reflector> ( -- reflector )
- <alphabet> dup length iota >vector [ dup empty? ] [
+ <alphabet> dup length <iota> >vector [ dup empty? ] [
[
[ delete-random ] [ delete-random ] bi
pick exchange
ln 1 + ln!
cogs [ nth ] each reflector nth
cogs reverse [ index ] each CHAR: a +
- cogs length iota [ 6 * 1 + ln mod zero? ] filter
+ cogs length <iota> [ 6 * 1 + ln mod zero? ] filter
cogs [ unclip prefix ] change-nths
] unless
] map ;
{ { 1 -1 -1 } { 1 1 -1 } } }
CONSTANT: cylinder-vertices
- $[ 12 iota [ 2pi 12 / * [ cos ] [ drop 0.0 ] [ sin ] tri 3array ] map ]
+ $[ 12 <iota> [ 2pi 12 / * [ cos ] [ drop 0.0 ] [ sin ] tri 3array ] map ]
:: scale-cylinder-vertices ( radius half-height verts -- bot-verts top-verts )
verts
<axis-gadget> [ >>raxis ] [ add-gadget-with-border ] bi-curry bi* ;
:: (add-button-gadgets) ( gadget shelf -- )
- gadget controller>> read-controller buttons>> length iota [
+ gadget controller>> read-controller buttons>> length <iota> [
number>string [ drop ] <border-button>
shelf over add-gadget drop
] map gadget buttons<< ;
[ uniform-tuple-texture-accessors ] if
] [
2dup swap empty? not and [
- iota [
+ <iota> [
[ swap nth ] swap prefix
over length 1 = [ swap first append ] [ swap suffix ] if
] with map
{ mat4x3-uniform { [ dim 0 ] dip 4 3 >uniform-matrix-array glUniformMatrix4x3fv } }
{ mat4-uniform { [ dim 0 ] dip 4 4 >uniform-matrix-array glUniformMatrix4fv } }
- { texture-uniform { drop dim dup iota [ texture-unit + ] int-array{ } map-as glUniform1iv } }
+ { texture-uniform { drop dim dup <iota> [ texture-unit + ] int-array{ } map-as glUniform1iv } }
} at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot
type uniform-type-texture-units dim * texture-unit +
:: [bind-uniform-struct] ( value>>-quot type texture-unit name dim -- texture-unit' quot )
dim
[
- iota
+ <iota>
[ [ [ swap nth ] swap prefix ] map ]
[ [ number>string name "[" append "]." surround ] map ] bi
] [
'[ _ swap first2 bind-vertex-format ] each ; inline
: (reset-vertex-array) ( -- )
- GL_MAX_VERTEX_ATTRIBS get-gl-int iota [ glDisableVertexAttribArray ] each ; inline
+ GL_MAX_VERTEX_ATTRIBS get-gl-int <iota> [ glDisableVertexAttribArray ] each ; inline
:: <multi-vertex-array-object> ( vertex-formats program-instance -- vertex-array )
gen-vertex-array :> handle
{ $example
"USING: accessors graphviz prettyprint sequences ;"
"<graph>"
- " 5 iota [ add-node ] each"
+ " 5 <iota> [ add-node ] each"
"statements>> [ id>> . ] each"
"\"0\"\n\"1\"\n\"2\"\n\"3\"\n\"4\""
}
""
" over number>string \"K \" prepend =label"
""
-" swap iota 2 [ first2 add-edge ] each-combination"
+" swap <iota> 2 [ first2 add-edge ] each-combination"
" preview ;"
}
$nl
" color <cluster>"
" color =color"
" [node color =color ];"
-" n iota ["
+" n <iota> ["
" number>string color prepend add-node"
" ] each ;"
""
"graphviz graphviz.notation graphviz.render ;"
""
": add-cycle ( graph n -- graph' )"
-" [ iota add-path ] [ 1 - 0 add-edge ] bi ;"
+" [ <iota> add-path ] [ 1 - 0 add-edge ] bi ;"
""
": C_n ( n -- )"
" <graph>"
"graphviz graphviz.notation graphviz.render ;"
""
": add-cycle ( graph n -- graph' )"
-" [ iota add-path ] [ 1 - 0 add-edge ] bi ;"
+" [ <iota> add-path ] [ 1 - 0 add-edge ] bi ;"
""
": W_n ( n -- )"
" <graph>"
" over number>string \"W \" prepend =label"
" over add-node"
" over 1 - add-cycle"
-" swap [ ] [ 1 - iota >array ] bi add-edge"
+" swap [ ] [ 1 - <iota> >array ] bi add-edge"
" preview ;"
}
$nl
""
" 0 [add-node \"invis\" =style \"none\" =shape ];"
""
-" 16 iota ["
+" 16 <iota> ["
" [ 0 -- ] [ colored-circle add ] bi"
" ] each"
"preview"
[node "point" =shape ];
[graph "t" =labelloc "circo" =layout ];
over number>string "K " prepend =label
- swap iota 2 [ first2 add-edge ] each-combination ;
+ swap <iota> 2 [ first2 add-edge ] each-combination ;
:: partite-set ( n color -- cluster )
color <cluster>
color =color
[node color =color ];
- n iota [
+ n <iota> [
number>string color prepend add-node
] each ;
n m "K %d,%d" sprintf =label ;
: add-cycle ( graph n -- graph' )
- [ iota add-path ] [ 1 - 0 add-edge ] bi ;
+ [ <iota> add-path ] [ 1 - 0 add-edge ] bi ;
: C_n ( n -- graph )
<graph>
over number>string "W " prepend =label
over add-node
over 1 - add-cycle
- swap [ ] [ 1 - iota >array ] bi add-edge ;
+ swap [ ] [ 1 - <iota> >array ] bi add-edge ;
: cluster-example ( -- graph )
<digraph>
"" =label ];
[edge "invis" =style ];
0 [add-node "invis" =style "none" =shape ];
- 16 iota [
+ 16 <iota> [
[ 0 -- ] [ colored-circle add ] bi
] each ;
: draw-grid-mesh ( grid-mesh -- )
GL_ARRAY_BUFFER over buffer>> [
[ 4 GL_FLOAT 0 f glVertexPointer ] dip
- dup dim>> second iota [ draw-vertex-buffer-row ] with each
+ dup dim>> second <iota> [ draw-vertex-buffer-row ] with each
] with-gl-buffer ;
: <grid-mesh> ( dim -- grid-mesh )
{ 2 V{ 6 7 8 } }
{ 3 V{ 9 } } }
} [
- 10 iota [ 3 / floor ] group-by
+ 10 <iota> [ 3 / floor ] group-by
] unit-test
{ V{ { t V{ 0 1 2 3 4 5 6 7 8 9 } } } }
-[ 10 iota [ drop t ] group-by ] unit-test
+[ 10 <iota> [ drop t ] group-by ] unit-test
{ V{ } } [ { } [ drop t ] group-by ] unit-test
[ <enum> >alist ] [ '[ second @ ] ] bi* filter ; inline
: loopn-index ( n quot -- )
- [ iota ] [ '[ @ not ] ] bi* find 2drop ; inline
+ [ <iota> ] [ '[ @ not ] ] bi* find 2drop ; inline
: loopn ( n quot -- )
[ drop ] prepose loopn-index ; inline
{ t }
-[ 10000 iota [ synchsafe>sequence sequence>synchsafe ] map [ < ] monotonic? ] unit-test
+[ 10000 <iota> [ synchsafe>sequence sequence>synchsafe ] map [ < ] monotonic? ] unit-test
image dim>> first2 :> ( w h )
image-placement loc>> first2 :> ( x y )
- h iota [| row |
+ h <iota> [| row |
0 row w image pixel-row-slice-at
x y row + w atlas set-pixel-row-at
] each ; inline
:: read-binary-bits ( width height -- )
width 8 align 8 / height * read
width 8 align 8 / <groups> [| row |
- width iota [| n |
+ width <iota> [| n |
n 8 / floor row nth
n 8 mod 7 swap - bit?
[ 0 ] [ 255 ] if ,
prev width tail-slice :> b
curr :> a
curr width tail-slice :> x
- x length iota
+ x length <iota>
filter {
{ filter-none [ drop ] }
{ filter-sub [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
41 read ascii decode [ 0 = ] trim ; inline
: read-author-comments ( -- string )
- 4 iota [ drop 81 read ascii decode [ 0 = ] trim ] map concat ; inline
+ 4 <iota> [ drop 81 read ascii decode [ 0 = ] trim ] map concat ; inline
: read-date-timestamp ( -- timestamp )
timestamp new
1 read le> 4 = ; inline
: read-scan-line-table ( height -- scan-offsets )
- iota [ drop 4 read le> ] map ; inline
+ <iota> [ drop 4 read le> ] map ; inline
: read-postage-stamp-image ( depth -- postage-data )
8 align 8 / 1 read le> 1 read le> * * read ; inline
:: read-color-correction-table ( -- correction-table )
- 256 iota
+ 256 <iota>
[
drop
- 4 iota
+ 4 <iota>
[
drop
2 read le> 65535 /f :> alpha
] map ; inline
: read-developer-directory ( -- developer-directory )
- 2 read le> iota
+ 2 read le> <iota>
[
drop
2 read le>
[
[
[
- 26
iota >byte-array <memory-stream> <peek-stream>
+ 26
<iota> >byte-array <memory-stream> <peek-stream>
4 over stream-peek ,
6 over stream-peek ,
2 over stream-read ,
: equally-spaced-radians ( n -- seq )
! return a sequence of n numbers between 0 and 2pi
- [ iota ] keep [ / pi 2 * * ] curry map ;
+ [ <iota> ] keep [ / pi 2 * * ] curry map ;
: draw-segment-vertex ( segment theta -- )
over color>> gl-color segment-vertex-and-normal
[ > ] with count ;
: inversions ( seq -- n )
- 0 swap [ length iota ] keep [
+ 0 swap [ length <iota> ] keep [
[ nth ] 2keep swap 1 + tail-slice (inversions) +
] curry each ;
[ dup length pick nth push ] reduce ;
: nth-basis-elt ( generators n -- elt )
- over length iota [
+ over length <iota> [
3dup bit? [ nth ] [ 2drop f ] if
] map sift 2nip ;
: basis ( generators -- seq )
- natural-sort dup length 2^ iota [ nth-basis-elt ] with map ;
+ natural-sort dup length 2^ <iota> [ nth-basis-elt ] with map ;
: (tensor) ( seq1 seq2 -- seq )
[
dim-im/ker-d ;
: graded-ker/im-d ( graded-basis -- seq )
- [ length iota ] keep [ (graded-ker/im-d) ] curry map ;
+ [ length <iota> ] keep [ (graded-ker/im-d) ] curry map ;
: graded-betti ( generators -- seq )
basis graded graded-ker/im-d unzip but-last 0 prefix v- ;
dim-im/ker-d ;
:: bigraded-ker/im-d ( basis -- seq )
- basis length iota [| z |
- basis first length iota [| u |
+ basis length <iota> [| z |
+ basis first length <iota> [| u |
u z basis (bigraded-ker/im-d)
] map
] map ;
3array ;
:: bigraded-triples ( grid -- triples )
- grid length iota [| z |
- grid first length iota [| u |
+ grid length <iota> [| z |
+ grid first length <iota> [| u |
u z grid bigraded-triple
] map
] map ;
'[ _ lcd-digit ] { } map-as concat ;
: lcd ( digit-str -- string )
- 4 iota [ lcd-row ] with map "\n" join ;
+ 4 <iota> [ lcd-row ] with map "\n" join ;
: <time-display> ( model -- gadget )
[ timestamp>hms lcd ] <arrow> <label-control>
{
[ ">" write ] [ "/>" write ] [ " " write ]
[ 0 or + ]
- [ dup length iota ]
+ [ dup length <iota> ]
[ 0 swap copy ]
[ dup length ]
[ 0 swap ]
[
[ class-of heap-size ]
[ >c-ptr <displaced-alien> ]
- [ ncmds>> ] tri iota [
+ [ ncmds>> ] tri <iota> [
drop read-command
] each drop
] { } make ;
try-output-process ;
: retry ( n quot -- )
- [ iota ] dip
+ [ <iota> ] dip
'[ drop @ f ] attempt-all drop ; inline
: upload-process ( process -- )
IN: math.extras.test
{ { 1 -1/2 1/6 0 -1/30 0 1/42 0 -1/30 0 } }
-[ 10 iota [ bernoulli ] map ] unit-test
+[ 10 <iota> [ bernoulli ] map ] unit-test
{ -1 } [ -1 7 jacobi ] unit-test
{ 0 } [ 3 3 jacobi ] unit-test
{ { 0 1 2 3 0 0 1 } } [ { 1 2 3 3 2 1 2 } [ <= ] monotonic-count ] unit-test
{ 4 } [ { 1 2 3 1 2 3 4 5 } [ < ] max-monotonic-count ] unit-test
-{ 2470 } [ 20 iota sum-squares ] unit-test
-{ 2470 } [ 20 iota >array sum-squares ] unit-test
+{ 2470 } [ 20 <iota> sum-squares ] unit-test
+{ 2470 } [ 20 <iota> >array sum-squares ] unit-test
-{ 36100 } [ 20 iota sum-cubes ] unit-test
-{ 36100 } [ 20 iota >array sum-cubes ] unit-test
+{ 36100 } [ 20 <iota> sum-cubes ] unit-test
+{ 36100 } [ 20 <iota> >array sum-cubes ] unit-test
{
{
<PRIVATE
: (bernoulli) ( p -- n )
- [ iota ] [ 1 + ] bi [
+ [ <iota> ] [ 1 + ] bi [
0 [ [ nCk ] [ bernoulli * ] bi + ] with reduce
] keep recip neg * ;
: bartlett ( n -- seq )
dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [
- [ iota ] [ 1 - 2 / ] bi [
+ [ <iota> ] [ 1 - 2 / ] bi [
[ recip * ] [ >= ] 2bi [ 2 swap - ] when
] curry map
] if ;
: [0,2pi] ( n -- seq )
- [ iota ] [ 1 - 2pi swap / ] bi v*n ;
+ [ <iota> ] [ 1 - 2pi swap / ] bi v*n ;
: hanning ( n -- seq )
dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [
unzip cum-sum [ last random ] [ bisect-left ] bi swap nth ;
: unique-indices ( seq -- unique indices )
- [ members ] keep over dup length iota H{ } zip-as '[ _ at ] map ;
+ [ members ] keep over dup length <iota> H{ } zip-as '[ _ at ] map ;
: digitize] ( seq bins -- seq' )
'[ _ bisect-left ] map ;
GENERIC: sum-squares ( seq -- n )
M: object sum-squares [ sq ] map-sum ;
-M: iota-tuple sum-squares
+M: iota sum-squares
length 1 - [ ] [ 1 + ] [ 1/2 + ] tri * * 3 / ;
GENERIC: sum-cubes ( seq -- n )
M: object sum-cubes [ 3 ^ ] map-sum ;
-M: iota-tuple sum-cubes sum sq ;
+M: iota sum-cubes sum sq ;
: mobius ( n -- x )
group-factors values [ 1 ] [
{ t } [ 20 3 [ 1 factorial-power ] [ falling-factorial ] 2bi = ] unit-test
{ t } [ 20 3 [ 0 factorial-power ] [ ^ ] 2bi = ] unit-test
-{ { 1 2 6 30 210 2310 } } [ 6 iota [ primorial ] map ] unit-test
+{ { 1 2 6 30 210 2310 } } [ 6 <iota> [ primorial ] map ] unit-test
{ t } [
- 6 iota
+ 6 <iota>
[ [ double-factorial ] map ]
[ [ 2 multifactorial ] map ]
bi =
] unit-test
{ { 1 2 12 120 1680 30240 } }
-[ 6 iota [ quadruple-factorial ] map ] unit-test
+[ 6 <iota> [ quadruple-factorial ] map ] unit-test
-{ { 1 1 2 12 288 } } [ 5 iota [ super-factorial ] map ] unit-test
+{ { 1 1 2 12 288 } } [ 5 <iota> [ super-factorial ] map ] unit-test
-{ { 1 1 4 108 27648 } } [ 5 iota [ hyper-factorial ] map ] unit-test
+{ { 1 1 4 108 27648 } } [ 5 <iota> [ hyper-factorial ] map ] unit-test
{ { 1 1 1 5 19 101 619 4421 35899 326981 } }
-[ 10 iota [ alternating-factorial ] map ] unit-test
+[ 10 <iota> [ alternating-factorial ] map ] unit-test
-{ { 1 1 2 9 262144 } } [ 5 iota [ exponential-factorial ] map ] unit-test
+{ { 1 1 2 9 262144 } } [ 5 <iota> [ exponential-factorial ] map ] unit-test
{ V{ 2 3 5 7 23 719 5039 } }
-[ 10,000 iota [ factorial-prime? ] filter ] unit-test
+[ 10,000 <iota> [ factorial-prime? ] filter ] unit-test
{ V{ 3 5 7 29 31 211 2309 2311 } }
-[ 10,000 iota [ primorial-prime? ] filter ] unit-test
+[ 10,000 <iota> [ primorial-prime? ] filter ] unit-test
{ 10 } [ 3628800 reverse-factorial ] unit-test
{ 12 } [ 479001600 reverse-factorial ] unit-test
{ { 2 4 } } [ { 1 3 5 } 2 sma ] unit-test
-{ { 2 3 4 5 } } [ 6 iota 2 dema ] unit-test
+{ { 2 3 4 5 } } [ 6 <iota> 2 dema ] unit-test
-{ t } [ 6 iota 2 [ dema ] [ 1 gdema ] 2bi = ] unit-test
+{ t } [ 6 <iota> 2 [ dema ] [ 1 gdema ] 2bi = ] unit-test
-{ { 3 4 5 } } [ 6 iota 2 tema ] unit-test
-{ { 6 7 8 9 } } [ 10 iota 3 tema ] unit-test
+{ { 3 4 5 } } [ 6 <iota> 2 tema ] unit-test
+{ { 6 7 8 9 } } [ 10 <iota> 3 tema ] unit-test
{ { 1 3 1 } } [ { 1 3 2 6 3 } 2 momentum ] unit-test
INSTANCE: missing immutable-sequence
: first-sub-matrix ( matrix -- first-row seq )
- [ unclip-slice swap ] [ length iota ] bi
+ [ unclip-slice swap ] [ length <iota> ] bi
[ '[ _ <missing> ] map ] with map ;
:: laplace-expansion ( row matrix -- x )
IN: math.primes.solovay-strassen
{ t } [
- 100,000 iota [ solovay-strassen ] filter
+ 100,000 <iota> [ solovay-strassen ] filter
100,000 primes-upto =
] unit-test
<PRIVATE
:: (solovay-strassen) ( n numtrials -- ? )
- numtrials iota [
+ numtrials <iota> [
drop
n 1 - [1,b) random :> a
a n simple-gcd 1 > [ t ] [
acc ;
:: <cubic-hermite-curve> ( p0 m0 p1 m1 -- polynomials )
- p0 length iota [
+ p0 length <iota> [
{
[ p0 nth ] [ m0 nth ]
[ p1 nth ] [ m1 nth ]
<PRIVATE
: eval-polynomials ( polynomials-seq n -- xy-sequence )
[
- [ 1 + iota ] keep [
+ [ 1 + <iota> ] keep [
/f swap [ polyval ] with map
] curry with map
] curry map concat ;
! Discrete Fourier Transform
:: (slow-fft) ( seq inverse? -- seq' )
seq length :> N
- inverse? 1 -1 ? 2pi * N / N iota n*v :> omega
- N iota [| k |
+ inverse? 1 -1 ? 2pi * N / N <iota> n*v :> omega
+ N <iota> [| k |
0 seq omega [ k * cis * + ] 2each
inverse? [ N / ] when
] map ; inline
: canonicalize-specializer-1 ( specializer -- specializer' )
[
[ class? ] filter
- [ length iota <reversed> [ 1 + neg ] map ] keep zip
+ [ length <iota> <reversed> [ 1 + neg ] map ] keep zip
[ length args [ max ] change ] keep
]
[
swap predicate-def append ;
: multi-predicate ( classes -- quot )
- dup length iota <reversed>
+ dup length <iota> <reversed>
[ picker 2array ] 2map
[ drop object eq? ] assoc-reject
[ [ t ] ] [
ERROR: invalid-perlin-noise-table table ;
: <perlin-noise-table> ( -- table )
- 256 iota >byte-array randomize dup append ; inline
+ 256 <iota> >byte-array randomize dup append ; inline
: validate-table ( table -- table )
dup { [ byte-array? ] [ length 512 >= ] } 1&&
faded trilerp ;
MEMO: perlin-noise-map-coords ( dim -- coords )
- first2 iota [| x y | x iota [ y 0.0 0.0 float-4-boa ] float-4-array{ } map-as ] with map concat ;
+ first2 <iota> [| x y | x iota [ y 0.0 0.0 float-4-boa ] float-4-array{ } map-as ] with map concat ;
TYPED:: perlin-noise-map ( table: byte-array transform: matrix4 coords: float-4-array -- map: float-array )
coords [| coord | table transform coord m4.v perlin-noise ] data-map( float-4 -- c:float )
c1 c2 c3 c4 float-array{ } 4sequence ;
: order-knot-constants ( curve order -- knot-constants )
- 2dup [ knots>> length ] dip - iota
+ 2dup [ knots>> length ] dip - <iota>
[ order-index-knot-constants ] 2with map ;
: knot-constants ( curve -- knot-constants )
: odbc-get-row-fields ( statement -- seq )
[
- dup odbc-number-of-columns iota [
+ dup odbc-number-of-columns <iota> [
1 + odbc-get-field value>> ,
] with each
] { } make ;
: name-table-entries ( pcre extra -- addrs )
[ name-table ] [ name-entry-size ] [ name-count ] 2tri
- iota [ * + name-table-entry 2array ] 2with map ;
+ <iota> [ * + name-table-entry 2array ] 2with map ;
: options ( pcre -- opts )
f PCRE_INFO_OPTIONS pcre-fullinfo ;
x 0 <= [ "Invalid input" throw ] when
x 12 < [ x gamma abs log ] [
1.0 x x * / :> z
- 7 c nth 7 iota reverse [ [ z * ] [ c nth ] bi* + ] each x / :> series
+ 7 c nth 7 <iota> reverse [ [ z * ] [ c nth ] bi* + ] each x / :> series
x 0.5 - x log * x - halfLogTwoPi + series +
] if ;
0.0 :> num!
1.0 :> den!
y 1 - :> z!
- 8 iota [
+ 8 <iota> [
[ P nth num + z * num! ]
[ Q nth den z * + den! ] bi
] each
: euler001b ( -- answer )
- 1000 iota [ [ 5 mod ] [ 3 mod ] bi [ 0 = ] either? ] filter sum ;
+ 1000 <iota> [ [ 5 mod ] [ 3 mod ] bi [ 0 = ] either? ] filter sum ;
! [ euler001b ] 100 ave-time
! 0 ms ave run time - 0.06 SD (100 trials)
: euler001c ( -- answer )
- 1000 iota [ { 3 5 } [ divisor? ] with any? ] filter sum ;
+ 1000 <iota> [ { 3 5 } [ divisor? ] with any? ] filter sum ;
! [ euler001c ] 100 ave-time
! 0 ms ave run time - 0.06 SD (100 trials)
: pad-front ( matrix -- matrix )
[
- length iota [ 0 <repetition> ] map
+ length <iota> [ 0 <repetition> ] map
] keep [ append ] 2map ;
: pad-back ( matrix -- matrix )
<reversed> [
- length iota [ 0 <repetition> ] map
+ length <iota> [ 0 <repetition> ] map
] keep [ <reversed> append ] 2map ;
: diagonal/ ( -- matrix )
! --------
: euler024 ( -- answer )
- 999999 10 iota permutation digits>number ;
+ 999999 10 <iota> permutation digits>number ;
! [ euler024 ] 100 ave-time
! 0 ms ave run time - 0.27 SD (100 trials)
<PRIVATE
: source-027 ( -- seq )
- 1000 iota [ prime? ] filter [ dup [ neg ] map append ] keep
+ 1000 <iota> [ prime? ] filter [ dup [ neg ] map append ] keep
cartesian-product concat [ first2 < ] filter ;
: quadratic ( b a n -- m )
PRIVATE>
: euler030 ( -- answer )
- 325537 iota [ dup sum-fifth-powers = ] filter sum 1 - ;
+ 325537 <iota> [ dup sum-fifth-powers = ] filter sum 1 - ;
! [ euler030 ] 100 ave-time
! 1700 ms ave run time - 64.84 SD (100 trials)
<PRIVATE
: source-032 ( -- seq )
- 9 factorial iota [
- 9 iota permutation [ 1 + ] map digits>number
+ 9 factorial <iota> [
+ 9 <iota> permutation [ 1 + ] map digits>number
] map ;
: 1and4 ( n -- ? )
[ unclip 1 head prefix concat ] map [ all-unique? ] filter ;
: add-missing-digit ( seq -- seq )
- dup natural-sort 10 iota swap diff prepend ;
+ dup natural-sort 10 <iota> swap diff prepend ;
: interesting-pandigitals ( -- seq )
17 candidates { 13 11 7 5 3 2 } [
<PRIVATE
: map-nx ( n x -- seq )
- iota [ 1 + * ] with map ; inline
+ <iota> [ 1 + * ] with map ; inline
: all-same-digits? ( seq -- ? )
[ number>digits natural-sort ] map all-equal? ;
! --------
: euler053 ( -- answer )
- 23 100 [a,b] [ dup iota [ nCk 1000000 > ] with count ] map-sum ;
+ 23 100 [a,b] [ dup <iota> [ nCk 1000000 > ] with count ] map-sum ;
! [ euler053 ] 100 ave-time
! 52 ms ave run time - 4.44 SD (100 trials)
PRIVATE>
: euler055 ( -- answer )
- 10000 iota [ lychrel? ] count ;
+ 10000 <iota> [ lychrel? ] count ;
! [ euler055 ] 100 ave-time
! 478 ms ave run time - 30.63 SD (100 trials)
>fraction [ number>string length ] bi@ > ; inline
: euler057 ( -- answer )
- 0 1000 iota [ drop 2 + recip dup 1 + longer-numerator? ] count nip ;
+ 0 1000 <iota> [ drop 2 + recip dup 1 + longer-numerator? ] count nip ;
! [ euler057 ] 100 ave-time
! 1728 ms ave run time - 80.81 SD (100 trials)
3dup minimal-path-sum-to '[ _ + ] change-matrix ;
: (euler081) ( matrix -- n )
- dup first length iota dup
+ dup first length <iota> dup
[ pick update-minimal-path-sum ] cartesian-each
last last ;
:: (euler150) ( m -- n )
sums-triangle :> table
- m iota [| x |
- x 1 + iota [| y |
- m x - iota [| z |
+ m <iota> [| x |
+ x 1 + <iota> [| y |
+ m x - <iota> [| z |
x z + table nth-unsafe
[ y z + 1 + swap nth-unsafe ]
[ y swap nth-unsafe ] bi -
{ { 0 0 1 0 } [ { 0 0 0 1 } (euler151) 1 + ] }
{ { 0 1 0 0 } [ { 0 0 1 1 } (euler151) 1 + ] }
{ { 1 0 0 0 } [ { 0 1 1 1 } (euler151) 1 + ] }
- [ [ dup length iota [ pick-sheet ] with map-sum ] [ sum ] bi / ]
+ [ [ dup length <iota> [ pick-sheet ] with map-sum ] [ sum ] bi / ]
} case ] cache ;
: euler151 ( -- answer )
<PRIVATE
: next-keys ( key -- keys )
- [ last ] [ 10 swap sum - iota ] bi [ 2array ] with map ;
+ [ last ] [ 10 swap sum - <iota> ] bi [ 2array ] with map ;
: next-table ( assoc -- assoc )
H{ } clone swap
CONSTANT: N 5
: decompose ( n -- seq )
- N iota [ drop [ 2/ ] [ 1 bitand ] bi ] map nip reverse ;
+ N <iota> [ drop [ 2/ ] [ 1 bitand ] bi ] map nip reverse ;
: bits ( seq -- n )
0 [ [ 2 * ] [ + ] bi* ] reduce ;
unclip decompose append [ 1 bitand ] map ;
: rotate-bits ( seq -- seq' )
- dup length iota [ cut prepend bits ] with map ;
+ dup length <iota> [ cut prepend bits ] with map ;
: ?register ( acc seq -- )
complete rotate-bits
HINTS: count-digits fixnum ;
: max-children ( seq -- seq )
- [ dup length 1 - iota [ nth-pair max , ] with each ] { } make ;
+ [ dup length 1 - <iota> [ nth-pair max , ] with each ] { } make ;
! Propagate one row into the upper one
: propagate ( bottom top -- newtop )
{ $examples
{ $example
"USING: arrays prettyprint python sequences ;"
- "10 iota >array >py py> ."
+ "10 <iota> >array >py py> ."
"{ 0 1 2 3 4 5 6 7 8 9 }"
}
}
[ rot py-list-set-item ] with each-index ;
: py-tuple>array ( py-tuple -- arr )
- dup py-tuple-size iota [ py-tuple-get-item ] with map ;
+ dup py-tuple-size <iota> [ py-tuple-get-item ] with map ;
: py-list>vector ( py-list -- vector )
- dup py-list-size iota [ py-list-get-item ] with V{ } map-as ;
+ dup py-list-size <iota> [ py-list-get-item ] with V{ } map-as ;
DEFER: >py
}
} [
cmwc-4096
- 4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
+ 4096 <iota> uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] unit-test
{ t } [
cmwc-4096 [
- 4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
+ 4096 <iota> uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] [
- 4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
+ 4096 <iota> uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] bi =
! gives an interval of x from 0 to 1 to map the bezier function
: t-interval ( x -- interval )
- [ iota ] keep 1 - [ / ] curry map ;
+ [ <iota> ] keep 1 - [ / ] curry map ;
! turns a list of points into the list of lines between them
: points-to-lines ( seq -- seq )
] 2map ;
: best-bounty ( -- bounty )
- find-max-amounts [ 1 +
iota ] map <product-sequence>
+ find-max-amounts [ 1 +
<iota> ] map <product-sequence>
[ <bounty> ] [ max ] map-reduce ;
] each ;
: fill-table ( table -- )
- [ items length iota ] dip
+ [ items length <iota> ] dip
'[ _ iterate ] each ;
:: extract-packed-items ( table -- items )
[
limit :> weight!
- items length iota <reversed> [| item-no |
+ items length <iota> <reversed> [| item-no |
item-no table nth :> prev
item-no 1 + table nth :> curr
weight [ curr nth ] [ prev nth ] bi =
: longmult-seq ( xs ys -- zs )
[ * ] cartesian-map
- dup length iota [ 0 <repetition> ] map
+ dup length <iota> [ 0 <repetition> ] map
[ prepend ] 2map
[ ] [ [ 0 suffix ] dip v+ ] map-reduce ;
while drop ;
: luhn-digit ( n -- n )
- reversed-digits dup length iota [
+ reversed-digits dup length <iota> [
2dup swap nth
swap odd? [ 2 * 10 /mod + ] when
] map sum 10 mod
:: safe? ( board q -- ? )
[let q board nth :> x
- q iota [
+ q <iota> [
x swap
[ board nth ] keep
q swap -
] ;
: solution? ( board -- ? )
- dup length iota [ dupd safe? ] all? nip ;
+ dup length <iota> [ dupd safe? ] all? nip ;
: queens ( n -- l )
- iota all-permutations [ solution? ] filter ;
+ <iota> all-permutations [ solution? ] filter ;
: queens. ( n -- )
queens [ [ 1 + "%d " printf ] each nl ] each ;
index [ 1 - ] [ 1 + ] bi [ world ?nth ] bi@ bool-sum ;
: count-neighbours ( world -- neighbours )
- [ length iota ] keep [ neighbours ] curry map ;
+ [ length <iota> ] keep [ neighbours ] curry map ;
: life-law ( alive? neighbours -- alive? )
swap [ 1 = ] [ 2 = ] if ;
"--ABC--"
}
} [
- "ABC" 8 iota [ CHAR: - pad-center ] with map
+ "ABC" 8 <iota> [ CHAR: - pad-center ] with map
] unit-test
{ { 0 1 0 1 } } [
{ "lohel" } [ "hello" dup -12 rotate! ] unit-test
{ { } } [ { } [ ] map-concat ] unit-test
-{ V{ 0 0 1 0 1 2 } } [ 4 iota [ iota ] map-concat ] unit-test
+{ V{ 0 0 1 0 1 2 } } [ 4 <iota> [ iota ] map-concat ] unit-test
{ "abc" } [ "abc" [ 1string ] map-concat ] unit-test
{ "abc" } [ { 97 98 99 } [ 1string ] map-concat ] unit-test
{ { 97 98 99 } } [ "abc" [ 1string ] { } map-concat-as ] unit-test
{ { } } [ { } [ ] [ even? ] map-filter ] unit-test
{ "bcde" } [ "abcd" [ 1 + ] [ drop t ] map-filter ] unit-test
-{ { 0 4 16 36 64 } } [ 10 iota [ sq ] [ even? ] { } map-filter-as ] unit-test
+{ { 0 4 16 36 64 } } [ 10 <iota> [ sq ] [ even? ] { } map-filter-as ] unit-test
-{ V{ 0 4 16 36 64 } } [ 10 iota [ even? ] [ sq ] filter-map ] unit-test
-{ { 2 6 10 14 18 } } [ 10 iota [ odd? ] [ 2 * ] { } filter-map-as ] unit-test
+{ V{ 0 4 16 36 64 } } [ 10 <iota> [ even? ] [ sq ] filter-map ] unit-test
+{ { 2 6 10 14 18 } } [ 10 <iota> [ odd? ] [ 2 * ] { } filter-map-as ] unit-test
-{ 8 } [ 3 iota dup [ 1 + * ] 2map-sum ] unit-test
+{ 8 } [ 3 <iota> dup [ 1 + * ] 2map-sum ] unit-test
{ 4 } [ "hello" "jello" [ = ] 2count ] unit-test
{ { } } [ { } round-robin ] unit-test
{ { { 5 8 0 } { 6 9 1 } { 7 10 2 } } } [ { 5 6 7 } { 8 9 10 } [ 3array ] 2map-index ] unit-test
{ { } } [ { } <evens> >array ] unit-test
-{ { 0 2 } } [ 4 iota <evens> >array ] unit-test
-{ { 0 2 4 } } [ 5 iota <evens> >array ] unit-test
+{ { 0 2 } } [ 4 <iota> <evens> >array ] unit-test
+{ { 0 2 4 } } [ 5 <iota> <evens> >array ] unit-test
{ { } } [ { } <odds> >array ] unit-test
-{ { 1 3 } } [ 5 iota <odds> >array ] unit-test
-{ { 1 3 5 } } [ 6 iota <odds> >array ] unit-test
+{ { 1 3 } } [ 5 <iota> <odds> >array ] unit-test
+{ { 1 3 5 } } [ 6 <iota> <odds> >array ] unit-test
{ 1 } [ { 1 7 3 7 6 3 7 } arg-max ] unit-test
{ 0 } [ { 1 7 3 7 6 3 7 } arg-min ] unit-test
{ { 1 2 3 } } [ { 1 2 3 } flatten1 ] unit-test
{ { 1 2 3 { { 4 } } } } [ { 1 { 2 } { 3 { { 4 } } } } flatten1 ] unit-test
-{ t 3 3 } [ 10 iota [ [ odd? ] [ 1 > ] bi* and ] map-find-index ] unit-test
-{ f f f } [ 10 iota [ [ odd? ] [ 9 > ] bi* and ] map-find-index ] unit-test
+{ t 3 3 } [ 10 <iota> [ [ odd? ] [ 1 > ] bi* and ] map-find-index ] unit-test
+{ f f f } [ 10 <iota> [ [ odd? ] [ 9 > ] bi* and ] map-find-index ] unit-test
{ "abcdef" } [ f f "abcdef" subseq* ] unit-test
{ "abcdef" } [ 0 f "abcdef" subseq* ] unit-test
{ "" " foo" } [ " foo" [ blank? ] cut-when ] unit-test
{ "foo" " bar" } [ "foo bar" [ blank? ] cut-when ] unit-test
-{ { 4 0 3 1 2 } } [ { 0 4 1 3 2 } 5 iota [ nth* ] curry map ] unit-test
+{ { 4 0 3 1 2 } } [ { 0 4 1 3 2 } 5 <iota> [ nth* ] curry map ] unit-test
{ 1 "beef" } [ { "chicken" "beef" "moose" } [ length ] infimum-by* ] unit-test
{ 0 "chicken" } [ { "chicken" "beef" "moose" } [ length ] supremum-by* ] unit-test
{ 2 "moose" } [ { "chicken" "beef" "moose" } [ first ] supremum-by* ] unit-test
-{ 3/10 } [ 10 iota [ 3 < ] count* ] unit-test
+{ 3/10 } [ 10 <iota> [ 3 < ] count* ] unit-test
{ { 0 } } [ "ABA" "ABABA" start-all ] unit-test
{ { 0 2 } } [ "ABA" "ABABA" start-all* ] unit-test
{ }
[ "test:" all-words [ name>> over prepend ] map-zip 2drop ] unit-test
-{ { 0 1 2 3 } } [ 8 iota [ 4 < ] take-while >array ] unit-test
+{ { 0 1 2 3 } } [ 8 <iota> [ 4 < ] take-while >array ] unit-test
{ { } } [ { 15 16 } [ 4 < ] take-while >array ] unit-test
-{ { 0 1 2 } } [ 3 iota [ 4 < ] take-while >array ] unit-test
+{ { 0 1 2 } } [ 3 <iota> [ 4 < ] take-while >array ] unit-test
-{ { 4 5 6 7 } } [ 8 iota [ 4 < ] drop-while >array ] unit-test
+{ { 4 5 6 7 } } [ 8 <iota> [ 4 < ] drop-while >array ] unit-test
{ { 15 16 } } [ { 15 16 } [ 4 < ] drop-while >array ] unit-test
-{ { } } [ 3 iota [ 4 < ] drop-while >array ] unit-test
+{ { } } [ 3 <iota> [ 4 < ] drop-while >array ] unit-test
] until 3drop ;
: all-rotations ( seq -- seq' )
- dup length iota [ rotate ] with map ;
+ dup length <iota> [ rotate ] with map ;
<PRIVATE
: round-robin ( seq -- newseq )
[ { } ] [
- [ longest length iota ] keep
+ [ longest length <iota> ] keep
[ [ ?nth ] with map ] curry map concat sift
] if-empty ;
INSTANCE: rotated virtual-sequence
: all-rotations ( seq -- seq' )
- dup length iota [ <rotated> ] with map ;
+ dup length <iota> [ <rotated> ] with map ;
USING: arrays sequences tools.test ;
IN: sequences.shifted
-{ { 1 2 3 7 } } [ 4 iota -1 7 <shifted> >array ] unit-test
-{ { 7 0 1 2 } } [ 4 iota 1 7 <shifted> >array ] unit-test
-{ { 0 1 2 3 } } [ 4 iota 0 f <shifted> >array ] unit-test
-{ { f f f f } } [ 4 iota 4 f <shifted> >array ] unit-test
-{ { f f f f } } [ 4 iota -4 f <shifted> >array ] unit-test
+{ { 1 2 3 7 } } [ 4 <iota> -1 7 <shifted> >array ] unit-test
+{ { 7 0 1 2 } } [ 4 <iota> 1 7 <shifted> >array ] unit-test
+{ { 0 1 2 3 } } [ 4 <iota> 0 f <shifted> >array ] unit-test
+{ { f f f f } } [ 4 <iota> 4 f <shifted> >array ] unit-test
+{ { f f f f } } [ 4 <iota> -4 f <shifted> >array ] unit-test
USING: arrays sequences tools.test ;
IN: sequences.snipped
-{ { 0 1 2 5 6 } } [ 3 5 7 iota <snipped> >array ] unit-test
-{ { 0 1 2 } } [ 3 10 7 iota <snipped> >array ] unit-test
-{ { 6 } } [ -1 5 7 iota <snipped> >array ] unit-test
-{ { } } [ -1 10 7 iota <snipped> >array ] unit-test
+{ { 0 1 2 5 6 } } [ 3 5 7 <iota> <snipped> >array ] unit-test
+{ { 0 1 2 } } [ 3 10 7 <iota> <snipped> >array ] unit-test
+{ { 6 } } [ -1 5 7 <iota> <snipped> >array ] unit-test
+{ { } } [ -1 10 7 <iota> <snipped> >array ] unit-test
{ "abc" } [ "abcddd" non-repeating ] unit-test
{ "" } [ "aabbcc" non-repeating ] unit-test
-{ HS{ 0 10 20 30 40 } } [ 5 iota [ 10 * ] mapped-set ] unit-test
+{ HS{ 0 10 20 30 40 } } [ 5 <iota> [ 10 * ] mapped-set ] unit-test
{ { 1 2 4 } } [ { 1 2 3 4 5 } [ 2/ ] unique-by ] unit-test
opposite-dir prefix [ >>dir ] 2map ;
: all-indices ( -- points )
- snake-game-dim first2 * iota ;
+ snake-game-dim first2 * <iota> ;
: snake-occupied-locs ( snake head-loc -- points )
[ dir>> relative-loc ] accumulate nip ;
:: image-part ( image x y w h -- image )
image w h new-image-like :> new-image
- h iota [| i |
+ h <iota> [| i |
new-image bitmap>>
x y i + w image pixel-row-slice-at
append! drop
:: generate-sprite-sheet ( image rows cols -- seq )
cols rows 2array :> split-dims
image dim>> split-dims [ / ] 2map first2 :> ( sw sh )
- rows iota sh v*n :> ys
- cols iota sh v*n :> xs
+ rows <iota> sh v*n :> ys
+ cols <iota> sh v*n :> xs
ys xs [
swap [ image ] 2dip sw sh image-part
] cartesian-map f join ;
{ { 0 1 2 3 4 5 6 7 8 9 } } [
{ }
- 10 iota >array randomize
+ 10 <iota> >array randomize
[ swap insort-right ] each
] unit-test
{ V{ 0 1 2 3 4 5 6 7 8 9 } } [
V{ } clone
- 10 iota >array randomize
+ 10 <iota> >array randomize
[ swap insort-right! ] each
] unit-test
plot-bitmap-pixel ;
: do-bitmap-update ( bitmap value addr -- )
- addr>xy swap 8 iota [ plot-bitmap-bits ] with with with each ;
+ addr>xy swap 8 <iota> [ plot-bitmap-bits ] with with with each ;
M: space-invaders update-video
over 0x2400 >= [
CONSTANT: ALPHABET "abcdefghijklmnopqrstuvwxyz"
: deletes ( word -- edits )
- [ length iota ] keep '[ _ remove-nth ] map ;
+ [ length <iota> ] keep '[ _ remove-nth ] map ;
: transposes ( word -- edits )
[ length [1,b) ] keep '[
] map ;
: replaces ( word -- edits )
- [ length iota ] keep '[
+ [ length <iota> ] keep '[
ALPHABET [
swap _ clone [ set-nth-unsafe ] keep
] with { } map-as
: cell-any? ( n x y i -- ? ) 3 /mod pair+ board> = ;
: box-any? ( n x y -- ? )
- [ 3 /i 3 * ] bi@ 9 iota [ cell-any? ] 3 nwith any? ;
+ [ 3 /i 3 * ] bi@ 9 <iota> [ cell-any? ] 3 nwith any? ;
: board-any? ( n x y -- ? )
{ [ nip row-any? ] [ drop col-any? ] [ box-any? ] } 3|| ;
IN: synth
MEMO: single-sine-wave ( samples/wave -- seq )
- [ iota ] [ pi 2 * swap / [ * sin ] curry ] bi map ;
+ [ <iota> ] [ pi 2 * swap / [ * sin ] curry ] bi map ;
: (sine-wave) ( samples/wave n-samples -- seq )
[ single-sine-wave ] dip <cycles> ;
{ $slide "Non-static stack effect"
"Not a good practice, nor useful"
"Not compiled by the optimizing compiler"
- { $code "100 iota [ ] each" }
+ { $code "100 <iota> [ ] each" }
}
{ $slide "Module system"
"Code divided up into vocabulary roots"
[ 1 - fib ] [ 2 - fib ] bi +
] unless ;"
}
- { $code "36 iota [ fib ] map ." }
+ { $code "36 <iota> [ fib ] map ." }
}
{ $slide "Memoized Fibonacci"
"Change one word and it's efficient"
[ 1 - fib ] [ 2 - fib ] bi +
] unless ;"
}
- { $code "36 iota [ fib ] map ." }
+ { $code "36 <iota> [ fib ] map ." }
}
{ $slide "Destructors"
"Deterministic resource disposal"
TUPLE: board { width integer } { height integer } rows ;
: make-rows ( width height -- rows )
-
iota [ drop f <array> ] with map ;
+
<iota> [ drop f <array> ] with map ;
: <board> ( width height -- board )
2dup make-rows board boa ;
: block-free? ( board block -- ? ) block not ;
: block-in-bounds? ( board block -- ? )
- [ first swap width>> iota bounds-check? ]
- [ second swap height>> iota bounds-check? ] 2bi and ;
+ [ first swap width>> <iota> bounds-check? ]
+ [ second swap height>> <iota> bounds-check? ] 2bi and ;
: location-valid? ( board block -- ? )
2dup block-in-bounds? [ block-free? ] [ 2drop f ] if ;
[ gl-color 2array draw-block ] [ 3drop ] if ;
: draw-row ( y row -- )
- [ length iota swap ] keep [ (draw-row) ] 2curry each ;
+ [ length <iota> swap ] keep [ (draw-row) ] 2curry each ;
: draw-board ( board -- )
- rows>> [ length iota ] keep
+ rows>> [ length <iota> ] keep
[ dupd nth draw-row ] curry each ;
: scale-board ( width height board -- )
! test that converting from a balanced tree doesn't reshape
! the tree
-{ t } [ 10 iota >array reverse dup zip >avl dup >avl = ] unit-test
+{ t } [ 10 <iota> >array reverse dup zip >avl dup >avl = ] unit-test
IN: trees.splay.tests
: randomize-numeric-splay-tree ( splay-tree -- )
- 100 iota [ drop 100 random of drop ] with each ;
+ 100 <iota> [ drop 100 random of drop ] with each ;
: make-numeric-splay-tree ( n -- splay-tree )
- iota <splay> [ '[ dup _ set-at ] each ] keep ;
+ <iota> <splay> [ '[ dup _ set-at ] each ] keep ;
{ t } [
100 make-numeric-splay-tree dup randomize-numeric-splay-tree
] unit-test
{ 0 } [
- 100 iota [ dup zip >splay ] keep
+ 100 <iota> [ dup zip >splay ] keep
[ over delete-at ] each assoc-size
] unit-test
CONSTANT: -pi $[ pi neg ]
: sine-wave ( steps -- seq )
- [ iota ] keep
+ [ <iota> ] keep
pi 2 * swap / [ * pi - dup sin 2array ] curry map
${ pi $[ pi sin ] } suffix ;
: cosine-wave ( steps -- seq )
- [ iota ] keep
+ [ <iota> ] keep
pi 2 * swap / [ * pi - dup cos 2array ] curry map
${ pi $[ pi cos ] } suffix ;
{
{ 0 30 60 90 120 150 180 210 240 270 300 }
} [
- 11 iota [ 10 + ] map [ 300 swap 20 10 scale ] map
+ 11 <iota> [ 10 + ] map [ 300 swap 20 10 scale ] map
] unit-test
{ { } }
"Connecting to hello world server…" print
ZMQ_REQ <zmq-socket> &dispose
dup "tcp://localhost:5555" zmq-connect
- 10 iota [
+ 10 <iota> [
[ "Hello" dup rot "Sending %s %d...\n" printf
dupd >byte-array 0 zmq-send ]
[ [ dup 0 zmq-recv >string ] dip
! Start our clock now
now
! Process 100 confirmations
- 100 iota [
+ 100 <iota> [
pick 0 zmq-recv drop
10 rem zero? [ ":" ] [ "." ] if write flush
] each
data>>
binary
[
- read1 iota
+ read1 <iota>
[ drop
read1 jpeg> color-info>> nth clone
read1 16 /mod [ >>dc-huff-table ] [ >>ac-huff-table ] bi*
{ 8 8 } coord-matrix [ { u v } [ wave ] 2map product ] map^2
1 u v [ 0 = [ 2 sqrt / ] when ] bi@ 4 / m*n ;
-MEMO: dct-matrix ( -- m ) 64 iota [ 8 /mod dct-vect flatten ] map ;
+MEMO: dct-matrix ( -- m ) 64 <iota> [ 8 /mod dct-vect flatten ] map ;
: mb-dim ( component -- dim ) [ h>> ] [ v>> ] bi 2array ;
:: draw-macroblock-yuv444 ( mb blocks -- )
mb { 8 8 } v* :> pos
- 3 iota [ [ blocks nth pos ] [ jpeg> draw-block ] bi ] each ;
+ 3 <iota> [ [ blocks nth pos ] [ jpeg> draw-block ] bi ] each ;
:: draw-macroblock-y ( mb blocks -- )
mb { 8 8 } v* :> pos
:: solutions ( puzzle random? -- solutions )
f puzzle random? [ indices [ f ] [ random? swap nth-or-lower ] if-empty ] [ index ] if
[ :> pos
- 1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
+ 1 9 [a,b] 80 <iota> [ pos near ] filter [ puzzle nth ] map prune diff
[ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
] [ puzzle list-monad return ] if* ;
projects / factor.git / commitdiff