core: Rename iota to <iota> so we can have TUPLE: iota ... ; instead of TUPLE: iota-tuple ... ;
parent
0ca1b4656f
commit
e189954ecc
|
@ -22,7 +22,7 @@ MACRO: byte-reverse ( n signed? -- quot )
|
||||||
[
|
[
|
||||||
drop
|
drop
|
||||||
[
|
[
|
||||||
dup iota [
|
dup <iota> [
|
||||||
[ 1 + - -8 * ] [ nip 8 * ] 2bi
|
[ 1 + - -8 * ] [ nip 8 * ] 2bi
|
||||||
'[ _ shift 0xff bitand _ shift ]
|
'[ _ shift 0xff bitand _ shift ]
|
||||||
] with map
|
] with map
|
||||||
|
|
|
@ -6,7 +6,7 @@ USING: binary-search kernel math.order sequences tools.test ;
|
||||||
{ 3 } [ 4 { 1 2 3 4 5 6 } [ <=> ] with search drop ] unit-test
|
{ 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
|
{ 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
|
{ 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
|
{ 0 } [ "alligator" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
|
||||||
{ 3 } [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
|
{ 3 } [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
|
||||||
|
|
|
@ -60,7 +60,7 @@ M: bit-set subset?
|
||||||
[ intersect ] keep = ;
|
[ intersect ] keep = ;
|
||||||
|
|
||||||
M: bit-set members
|
M: bit-set members
|
||||||
table>> [ length iota ] keep '[ _ nth-unsafe ] filter ;
|
table>> [ length <iota> ] keep '[ _ nth-unsafe ] filter ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
|
|
@ -181,7 +181,7 @@ M: msb0-bit-reader peek ( n bs -- bits )
|
||||||
writer bytes>> ;
|
writer bytes>> ;
|
||||||
|
|
||||||
:: byte-array-n>sequence ( byte-array n -- seq )
|
:: 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> '[
|
byte-array <msb0-bit-reader> '[
|
||||||
drop n _ read
|
drop n _ read
|
||||||
] { } map-as ;
|
] { } map-as ;
|
||||||
|
|
|
@ -8,7 +8,7 @@ CONSTANT: crc16-polynomial 0xa001
|
||||||
|
|
||||||
CONSTANT: crc16-table V{ }
|
CONSTANT: crc16-table V{ }
|
||||||
|
|
||||||
256 iota [
|
256 <iota> [
|
||||||
8 [
|
8 [
|
||||||
[ 2/ ] [ even? ] bi [ crc16-polynomial bitxor ] unless
|
[ 2/ ] [ even? ] bi [ crc16-polynomial bitxor ] unless
|
||||||
] times
|
] times
|
||||||
|
|
|
@ -30,7 +30,7 @@ M: md5 initialize-checksum-state drop <md5-state> ;
|
||||||
[ old-state<< ] [ state<< ] bi ; inline
|
[ old-state<< ] [ state<< ] bi ; inline
|
||||||
|
|
||||||
CONSTANT: T $[
|
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 )
|
:: F ( X Y Z -- FXYZ )
|
||||||
|
|
|
@ -92,9 +92,9 @@ ERROR: checksums-differ algorithm seq incremental-checksum one-go-checksum ;
|
||||||
checksums-differ
|
checksums-differ
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
{ t } [ 100 iota [ drop sha1 100 [ 100 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 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 10 [ 10 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
|
||||||
|
|
||||||
{ t } [ sha1 {
|
{ t } [ sha1 {
|
||||||
B{ 105 27 166 214 73 114 110 }
|
B{ 105 27 166 214 73 114 110 }
|
||||||
|
|
|
@ -20,7 +20,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
|
||||||
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
|
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
|
||||||
items-count 0 = [
|
items-count 0 = [
|
||||||
state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
|
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)
|
object quot state stackbuf count (NSFastEnumeration-each)
|
||||||
] unless ; inline recursive
|
] unless ; inline recursive
|
||||||
|
|
||||||
|
|
|
@ -223,7 +223,7 @@ ERROR: no-objc-type name ;
|
||||||
(free) ;
|
(free) ;
|
||||||
|
|
||||||
: method-arg-types ( method -- args )
|
: method-arg-types ( method -- args )
|
||||||
dup method_getNumberOfArguments iota
|
dup method_getNumberOfArguments <iota>
|
||||||
[ method-arg-type ] with map ;
|
[ method-arg-type ] with map ;
|
||||||
|
|
||||||
: method-return-type ( method -- ctype )
|
: method-return-type ( method -- ctype )
|
||||||
|
|
|
@ -47,7 +47,7 @@ MACRO: (casep) ( assoc -- quot ) (casep>quot) ;
|
||||||
[ swap nth ] 2bi * ;
|
[ swap nth ] 2bi * ;
|
||||||
|
|
||||||
: conditional-probabilities ( seq -- seq' )
|
: conditional-probabilities ( seq -- seq' )
|
||||||
dup length iota [ (conditional-probabilities) ] with map ;
|
dup length <iota> [ (conditional-probabilities) ] with map ;
|
||||||
|
|
||||||
: (direct>conditional) ( assoc -- assoc' )
|
: (direct>conditional) ( assoc -- assoc' )
|
||||||
[ keys conditional-probabilities ] [ values ] bi zip ;
|
[ keys conditional-probabilities ] [ values ] bi zip ;
|
||||||
|
|
|
@ -26,7 +26,7 @@ IN: compiler.cfg.builder.alien
|
||||||
|
|
||||||
: unbox-parameters ( parameters -- vregs reps )
|
: unbox-parameters ( parameters -- vregs reps )
|
||||||
[
|
[
|
||||||
[ length iota <reversed> ] keep
|
[ length <iota> <reversed> ] keep
|
||||||
[ [ <ds-loc> peek-loc ] [ base-type ] bi* unbox-parameter ]
|
[ [ <ds-loc> peek-loc ] [ base-type ] bi* unbox-parameter ]
|
||||||
2 2 mnmap [ concat ] bi@
|
2 2 mnmap [ concat ] bi@
|
||||||
]
|
]
|
||||||
|
|
|
@ -74,7 +74,7 @@ V{ } 5 test-bb
|
||||||
{ t } [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
|
{ t } [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
|
||||||
|
|
||||||
: non-det-test ( -- cfg )
|
: 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 }
|
{ 0 1 }
|
||||||
{ 1 2 } { 1 7 }
|
{ 1 2 } { 1 7 }
|
||||||
|
|
|
@ -75,7 +75,7 @@ IN: compiler.cfg.intrinsics.allot
|
||||||
:: zero-byte-array ( len reg -- )
|
:: zero-byte-array ( len reg -- )
|
||||||
0 ^^load-literal :> elt
|
0 ^^load-literal :> elt
|
||||||
reg ^^tagged>integer :> reg
|
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,
|
[ elt reg ] dip cells byte-array-offset + int-rep f ##store-memory-imm,
|
||||||
] each ;
|
] each ;
|
||||||
|
|
||||||
|
|
|
@ -76,7 +76,7 @@ CONSTANT: rep>half {
|
||||||
: >variable-shuffle ( shuffle rep -- shuffle' )
|
: >variable-shuffle ( shuffle rep -- shuffle' )
|
||||||
rep-component-type heap-size
|
rep-component-type heap-size
|
||||||
[ dup <repetition> >byte-array ]
|
[ dup <repetition> >byte-array ]
|
||||||
[ iota >byte-array ] bi
|
[ <iota> >byte-array ] bi
|
||||||
'[ _ n*v _ v+ ] map concat ;
|
'[ _ n*v _ v+ ] map concat ;
|
||||||
|
|
||||||
: ^load-immediate-shuffle ( shuffle rep -- dst )
|
: ^load-immediate-shuffle ( shuffle rep -- dst )
|
||||||
|
|
|
@ -29,7 +29,7 @@ V{ } 2 test-bb
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ { 0 1 2 3 4 5 } } [
|
{ { 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 }
|
{ 0 1 } { 0 2 } { 0 5 }
|
||||||
{ 2 3 }
|
{ 2 3 }
|
||||||
|
|
|
@ -91,7 +91,7 @@ IN: compiler.cfg.liveness.tests
|
||||||
! liveness-step
|
! liveness-step
|
||||||
{ 3 } [
|
{ 3 } [
|
||||||
init-liveness
|
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
|
[ connect-Nto1-bbs ] keep liveness-step length
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ IN: compiler.cfg.rpo
|
||||||
] [ drop ] if ; inline recursive
|
] [ drop ] if ; inline recursive
|
||||||
|
|
||||||
: number-blocks ( blocks -- )
|
: number-blocks ( blocks -- )
|
||||||
dup length iota <reversed>
|
dup length <iota> <reversed>
|
||||||
[ >>number drop ] 2each ;
|
[ >>number drop ] 2each ;
|
||||||
|
|
||||||
: post-order ( cfg -- blocks )
|
: post-order ( cfg -- blocks )
|
||||||
|
|
|
@ -98,7 +98,7 @@ IN: compiler.cfg.ssa.destruction.coalescing.tests
|
||||||
: make-phi-inputs ( -- assoc )
|
: make-phi-inputs ( -- assoc )
|
||||||
H{ } clone [
|
H{ } clone [
|
||||||
{ 2287 2288 } [
|
{ 2287 2288 } [
|
||||||
10 iota 1 sample first rot set-at
|
10 <iota> 1 sample first rot set-at
|
||||||
] with each
|
] with each
|
||||||
] keep ;
|
] keep ;
|
||||||
|
|
||||||
|
|
|
@ -58,7 +58,7 @@ SYMBOLS: locs>vregs local-peek-set replaces ;
|
||||||
height-state get global-loc>local replaces get set-at ;
|
height-state get global-loc>local replaces get set-at ;
|
||||||
|
|
||||||
: kill-locations ( begin inc -- seq )
|
: 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 )
|
: local-kill-set ( ds-begin ds-inc rs-begin rs-inc -- set )
|
||||||
[ kill-locations ] 2bi@
|
[ kill-locations ] 2bi@
|
||||||
|
|
|
@ -21,7 +21,7 @@ IN: compiler.cfg.stacks.padding
|
||||||
swap 2dup second member? [ 2drop 2 ] [ first >= [ 1 ] [ 0 ] if ] if ;
|
swap 2dup second member? [ 2drop 2 ] [ first >= [ 1 ] [ 0 ] if ] if ;
|
||||||
|
|
||||||
: shift-stack ( n stack -- stack' )
|
: 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 ;
|
[ + ] dip 2array ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
|
@ -24,7 +24,7 @@ IN: compiler.cfg.stacks
|
||||||
[ swap new swap >>n ] with map <reversed> ;
|
[ swap new swap >>n ] with map <reversed> ;
|
||||||
|
|
||||||
: stack-locs ( loc-class n -- locs )
|
: stack-locs ( loc-class n -- locs )
|
||||||
iota create-locs ;
|
<iota> create-locs ;
|
||||||
|
|
||||||
: (load-vregs) ( n loc-class -- vregs )
|
: (load-vregs) ( n loc-class -- vregs )
|
||||||
swap stack-locs [ peek-loc ] map ;
|
swap stack-locs [ peek-loc ] map ;
|
||||||
|
|
|
@ -27,7 +27,7 @@ GENERIC: >expr ( insn -- expr )
|
||||||
[
|
[
|
||||||
[ , [ f <array> ] % ]
|
[ , [ f <array> ] % ]
|
||||||
[
|
[
|
||||||
dup iota [
|
dup <iota> [
|
||||||
- 1 - , [ swap [ set-array-nth ] keep ] %
|
- 1 - , [ swap [ set-array-nth ] keep ] %
|
||||||
] with each
|
] with each
|
||||||
] bi
|
] bi
|
||||||
|
|
|
@ -13,7 +13,7 @@ IN: compiler.cfg.value-numbering.simd
|
||||||
! should be redone completely.
|
! should be redone completely.
|
||||||
|
|
||||||
: useless-shuffle-vector-imm? ( insn -- ? )
|
: 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' )
|
: compose-shuffle-vector-imm ( outer inner -- insn' )
|
||||||
2dup [ rep>> ] bi@ eq? [
|
2dup [ rep>> ] bi@ eq? [
|
||||||
|
|
|
@ -316,7 +316,7 @@ cell 4 = [
|
||||||
|
|
||||||
! Bug with ##return node construction
|
! Bug with ##return node construction
|
||||||
: return-recursive-bug ( nodes -- ? )
|
: return-recursive-bug ( nodes -- ? )
|
||||||
{ fixnum } declare iota [
|
{ fixnum } declare <iota> [
|
||||||
dup 3 bitand 1 = [ drop t ] [
|
dup 3 bitand 1 = [ drop t ] [
|
||||||
dup 3 bitand 2 = [
|
dup 3 bitand 2 = [
|
||||||
return-recursive-bug
|
return-recursive-bug
|
||||||
|
|
|
@ -47,7 +47,7 @@ IN: compiler.tests.curry
|
||||||
] { } make ; inline
|
] { } make ; inline
|
||||||
|
|
||||||
[ t ] [| |
|
[ 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 [ [ drop , ] funky-assoc>map ] compile-call
|
||||||
a-hashtable keys =
|
a-hashtable keys =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -339,7 +339,7 @@ ERROR: bug-in-fixnum* x y a b ;
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
10000 [
|
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 =
|
dup [ bignum>fixnum ] keep compiled-bignum>fixnum =
|
||||||
[ drop ] [ "Oops" throw ] if
|
[ drop ] [ "Oops" throw ] if
|
||||||
] times
|
] times
|
||||||
|
|
|
@ -92,7 +92,7 @@ TUPLE: pred-test ;
|
||||||
: double-label-2 ( a -- b )
|
: double-label-2 ( a -- b )
|
||||||
dup array? [ ] [ ] if 0 t double-label-1 ;
|
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
|
! regression
|
||||||
GENERIC: void-generic ( obj -- * )
|
GENERIC: void-generic ( obj -- * )
|
||||||
|
@ -337,7 +337,7 @@ TUPLE: some-tuple x ;
|
||||||
[ 5 ] [ { 1 2 { 3 { 4 5 } } } deep-find-test ] unit-test
|
[ 5 ] [ { 1 2 { 3 { 4 5 } } } deep-find-test ] unit-test
|
||||||
[ f ] [ { 1 2 { 3 { 4 } } } 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
|
[ 0 ] [ 1234 [ { fixnum } declare -64 shift ] compile-call ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@ compiler.units vocabs tools.test specialized-arrays.private ;
|
||||||
|
|
||||||
STRUCT: my-struct { x int } ;
|
STRUCT: my-struct { x int } ;
|
||||||
SPECIALIZED-ARRAY: my-struct
|
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 ;
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
[
|
[
|
||||||
|
|
|
@ -329,23 +329,23 @@ cell-bits 32 = [
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
[ { fixnum } declare iota [ drop ] each ]
|
[ { fixnum } declare <iota> [ drop ] each ]
|
||||||
{ < <-integer-fixnum +-integer-fixnum + } inlined?
|
{ < <-integer-fixnum +-integer-fixnum + } inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
[ { fixnum } declare iota 0 [ + ] reduce ]
|
[ { fixnum } declare <iota> 0 [ + ] reduce ]
|
||||||
{ < <-integer-fixnum nth-unsafe } inlined?
|
{ < <-integer-fixnum nth-unsafe } inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ f } [
|
{ f } [
|
||||||
[ { fixnum } declare iota 0 [ + ] reduce ]
|
[ { fixnum } declare <iota> 0 [ + ] reduce ]
|
||||||
\ +-integer-fixnum inlined?
|
\ +-integer-fixnum inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
[
|
[
|
||||||
{ integer } declare iota [ ] map
|
{ integer } declare <iota> [ ] map
|
||||||
] \ integer>fixnum inlined?
|
] \ integer>fixnum inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
@ -388,7 +388,7 @@ cell-bits 32 = [
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
[
|
[
|
||||||
{ integer } declare iota [ 0 >= ] map
|
{ integer } declare <iota> [ 0 >= ] map
|
||||||
] { >= fixnum>= } inlined?
|
] { >= fixnum>= } inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,7 @@ M: #branch remove-dead-code*
|
||||||
pad-with-bottom >>phi-in-d drop ;
|
pad-with-bottom >>phi-in-d drop ;
|
||||||
|
|
||||||
: live-value-indices ( values -- indices )
|
: live-value-indices ( values -- indices )
|
||||||
[ length iota ] keep live-values get
|
[ length <iota> ] keep live-values get
|
||||||
'[ _ nth _ key? ] filter ; inline
|
'[ _ nth _ key? ] filter ; inline
|
||||||
|
|
||||||
: drop-indexed-values ( values indices -- node )
|
: drop-indexed-values ( values indices -- node )
|
||||||
|
|
|
@ -77,7 +77,7 @@ TUPLE: declared-fixnum { x fixnum } ;
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
[
|
[
|
||||||
{ fixnum } declare iota 0 swap
|
{ fixnum } declare <iota> 0 swap
|
||||||
[
|
[
|
||||||
drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
|
drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
|
||||||
] map
|
] map
|
||||||
|
@ -98,7 +98,7 @@ TUPLE: declared-fixnum { x fixnum } ;
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
[
|
[
|
||||||
{ integer } declare iota [ 256 mod ] map
|
{ integer } declare <iota> [ 256 mod ] map
|
||||||
] { mod fixnum-mod } inlined?
|
] { mod fixnum-mod } inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
@ -134,7 +134,7 @@ TUPLE: declared-fixnum { x fixnum } ;
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
[
|
[
|
||||||
{ iota-tuple } declare [ 256 rem ] map
|
{ iota } declare [ 256 rem ] map
|
||||||
] { mod fixnum-mod rem } inlined?
|
] { mod fixnum-mod rem } inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -255,7 +255,7 @@ CONSTANT: lookup-table-at-max 256
|
||||||
} 1&& ;
|
} 1&& ;
|
||||||
|
|
||||||
: lookup-table-seq ( assoc -- table )
|
: 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-quot ( seq -- newquot )
|
||||||
lookup-table-seq
|
lookup-table-seq
|
||||||
|
|
|
@ -27,7 +27,7 @@ TUPLE: huffman-code
|
||||||
:: all-patterns ( huffman-code n -- seq )
|
:: all-patterns ( huffman-code n -- seq )
|
||||||
n log2 huffman-code size>> - :> free-bits
|
n log2 huffman-code size>> - :> free-bits
|
||||||
free-bits 0 >
|
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-code code>> free-bits neg 2^ /i 1array ] if ;
|
||||||
|
|
||||||
:: huffman-each ( ... tdesc quot: ( ... huffman-code -- ... ) -- ... )
|
:: huffman-each ( ... tdesc quot: ( ... huffman-code -- ... ) -- ... )
|
||||||
|
|
|
@ -59,7 +59,7 @@ CONSTANT: clen-shuffle { 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15 }
|
||||||
] reduce
|
] reduce
|
||||||
[ dup array? [ second 0 <repetition> ] [ 1array ] if ] map concat
|
[ dup array? [ second 0 <repetition> ] [ 1array ] if ] map concat
|
||||||
nip swap cut 2array
|
nip swap cut 2array
|
||||||
[ [ length>> iota ] [ ] bi get-table ] map ;
|
[ [ length>> <iota> ] [ ] bi get-table ] map ;
|
||||||
|
|
||||||
MEMO: static-huffman-tables ( -- obj )
|
MEMO: static-huffman-tables ( -- obj )
|
||||||
[
|
[
|
||||||
|
@ -69,7 +69,7 @@ MEMO: static-huffman-tables ( -- obj )
|
||||||
280 287 [a,b] length [ 8 ] replicate append
|
280 287 [a,b] length [ 8 ] replicate append
|
||||||
] append-outputs
|
] append-outputs
|
||||||
0 31 [a,b] length [ 5 ] replicate 2array
|
0 31 [a,b] length [ 5 ] replicate 2array
|
||||||
[ [ length>> iota ] [ ] bi get-table ] map ;
|
[ [ length>> <iota> ] [ ] bi get-table ] map ;
|
||||||
|
|
||||||
CONSTANT: length-table
|
CONSTANT: length-table
|
||||||
{
|
{
|
||||||
|
|
|
@ -20,7 +20,7 @@ TUPLE: tiff-lzw < lzw ;
|
||||||
TUPLE: gif-lzw < lzw ;
|
TUPLE: gif-lzw < lzw ;
|
||||||
|
|
||||||
: initial-uncompress-table ( size -- seq )
|
: initial-uncompress-table ( size -- seq )
|
||||||
iota [ 1vector ] V{ } map-as ;
|
<iota> [ 1vector ] V{ } map-as ;
|
||||||
|
|
||||||
: reset-lzw-uncompress ( lzw -- lzw )
|
: reset-lzw-uncompress ( lzw -- lzw )
|
||||||
dup end-of-information-code>> 1 + initial-uncompress-table >>table
|
dup end-of-information-code>> 1 + initial-uncompress-table >>table
|
||||||
|
|
|
@ -17,12 +17,12 @@ IN: concurrency.combinators.tests
|
||||||
[ error>> "Even" = ] must-fail-with
|
[ error>> "Even" = ] must-fail-with
|
||||||
|
|
||||||
{ V{ 0 3 6 9 } }
|
{ V{ 0 3 6 9 } }
|
||||||
[ 10 iota [ 3 mod zero? ] parallel-filter ] unit-test
|
[ 10 <iota> [ 3 mod zero? ] parallel-filter ] unit-test
|
||||||
|
|
||||||
{ 10 }
|
{ 10 }
|
||||||
[
|
[
|
||||||
V{ } clone
|
V{ } clone
|
||||||
10 iota over [ push ] curry parallel-each
|
10 <iota> over [ push ] curry parallel-each
|
||||||
length
|
length
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
@ -41,7 +41,7 @@ IN: concurrency.combinators.tests
|
||||||
{ 20 }
|
{ 20 }
|
||||||
[
|
[
|
||||||
V{ } clone
|
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
|
length
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -34,7 +34,7 @@ SINGLETON: retryable
|
||||||
] 2map >>bind-params ;
|
] 2map >>bind-params ;
|
||||||
|
|
||||||
M: retryable execute-statement* ( statement type -- )
|
M: retryable execute-statement* ( statement type -- )
|
||||||
drop [ retries>> iota ] [
|
drop [ retries>> <iota> ] [
|
||||||
[
|
[
|
||||||
nip
|
nip
|
||||||
[ query-results dispose t ]
|
[ query-results dispose t ]
|
||||||
|
|
|
@ -74,7 +74,7 @@ test-2 "TEST2" {
|
||||||
test-2 ensure-table
|
test-2 ensure-table
|
||||||
] with-db
|
] with-db
|
||||||
] [
|
] [
|
||||||
10 iota [
|
10 <iota> [
|
||||||
drop
|
drop
|
||||||
10 [
|
10 [
|
||||||
dup [
|
dup [
|
||||||
|
@ -93,7 +93,7 @@ test-2 "TEST2" {
|
||||||
] [
|
] [
|
||||||
<db-pool> [
|
<db-pool> [
|
||||||
[
|
[
|
||||||
10 iota [
|
10 <iota> [
|
||||||
10 [
|
10 [
|
||||||
test-1-tuple insert-tuple yield
|
test-1-tuple insert-tuple yield
|
||||||
] times
|
] times
|
||||||
|
|
|
@ -65,7 +65,7 @@ SYMBOLS: a b c d e f g h ;
|
||||||
{ "hi" 3 } [ "h" "i" 3 [ append ] funny-dip ] unit-test
|
{ "hi" 3 } [ "h" "i" 3 [ append ] funny-dip ] unit-test
|
||||||
|
|
||||||
{ { 1 2 3 } } [
|
{ { 1 2 3 } } [
|
||||||
3 1 '[ _ iota [ _ + ] map ] call
|
3 1 '[ _ <iota> [ _ + ] map ] call
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ { 1 { 2 { 3 } } } } [
|
{ { 1 { 2 { 3 } } } } [
|
||||||
|
|
|
@ -315,7 +315,7 @@ CONSTANT: pov-values
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
: fill-mouse-state ( buffer count -- state )
|
: 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 -- )
|
: get-device-state ( device DIJOYSTATE2 -- )
|
||||||
[ dup IDirectInputDevice8W::Poll check-ole32-error ] dip
|
[ dup IDirectInputDevice8W::Poll check-ole32-error ] dip
|
||||||
|
|
|
@ -84,7 +84,7 @@ M: linux x>hid-bit-order
|
||||||
} ; inline
|
} ; inline
|
||||||
|
|
||||||
: x-bits>hid-bits ( bit-array -- bit-array )
|
: 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
|
x>hid-bit-order [ nth ] curry map
|
||||||
256 <bit-array> swap [ t swap pick set-nth ] each ;
|
256 <bit-array> swap [ t swap pick set-nth ] each ;
|
||||||
|
|
||||||
|
|
|
@ -78,7 +78,7 @@ M: linux x>hid-bit-order
|
||||||
} ; inline
|
} ; inline
|
||||||
|
|
||||||
: x-bits>hid-bits ( bit-array -- bit-array )
|
: 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
|
x>hid-bit-order [ nth ] curry map
|
||||||
256 <bit-array> swap [ t swap pick set-nth ] each ;
|
256 <bit-array> swap [ t swap pick set-nth ] each ;
|
||||||
|
|
||||||
|
|
|
@ -91,7 +91,7 @@ MACRO: spread* ( n -- quot )
|
||||||
MACRO: nspread* ( m n -- quot )
|
MACRO: nspread* ( m n -- quot )
|
||||||
[ drop [ ] ] [
|
[ drop [ ] ] [
|
||||||
[ * 0 ] [ drop neg ] 2bi
|
[ * 0 ] [ drop neg ] 2bi
|
||||||
<range> rest >array dup length iota <reversed>
|
<range> rest >array dup length <iota> <reversed>
|
||||||
[
|
[
|
||||||
'[ [ [ _ ndip ] curry ] _ ndip ]
|
'[ [ [ _ ndip ] curry ] _ ndip ]
|
||||||
] 2map dup rest-slice [ [ compose ] compose ] map! drop
|
] 2map dup rest-slice [ [ compose ] compose ] map! drop
|
||||||
|
@ -122,7 +122,7 @@ MACRO: mnswap ( m n -- quot )
|
||||||
1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
|
1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
|
||||||
|
|
||||||
MACRO: nweave ( n -- quot )
|
MACRO: nweave ( n -- quot )
|
||||||
[ dup iota <reversed> [ '[ _ _ mnswap ] ] with map ] keep
|
[ dup <iota> <reversed> [ '[ _ _ mnswap ] ] with map ] keep
|
||||||
'[ _ _ ncleave ] ;
|
'[ _ _ ncleave ] ;
|
||||||
|
|
||||||
: nbi-curry ( n -- )
|
: nbi-curry ( n -- )
|
||||||
|
|
|
@ -89,7 +89,7 @@ HELP: <groups>
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example
|
{ $example
|
||||||
"USING: arrays kernel prettyprint sequences grouping ;"
|
"USING: arrays kernel prettyprint sequences grouping ;"
|
||||||
"9 iota >array 3 <groups>"
|
"9 <iota> >array 3 <groups>"
|
||||||
"dup [ reverse! drop ] each concat >array ."
|
"dup [ reverse! drop ] each concat >array ."
|
||||||
"{ 2 1 0 5 4 3 8 7 6 }"
|
"{ 2 1 0 5 4 3 8 7 6 }"
|
||||||
}
|
}
|
||||||
|
|
|
@ -31,7 +31,7 @@ IN: heaps.tests
|
||||||
[ heap-push-all ] keep heap-pop-all ;
|
[ heap-push-all ] keep heap-pop-all ;
|
||||||
|
|
||||||
: random-alist ( n -- alist )
|
: random-alist ( n -- alist )
|
||||||
iota [
|
<iota> [
|
||||||
drop 32 random-bits dup number>string
|
drop 32 random-bits dup number>string
|
||||||
] H{ } map>assoc >alist ;
|
] H{ } map>assoc >alist ;
|
||||||
|
|
||||||
|
@ -57,7 +57,7 @@ IN: heaps.tests
|
||||||
: test-entry-indices ( n -- ? )
|
: test-entry-indices ( n -- ? )
|
||||||
random-alist
|
random-alist
|
||||||
<min-heap> [ heap-push-all ] keep
|
<min-heap> [ heap-push-all ] keep
|
||||||
data>> dup length iota swap [ index>> ] map sequence= ;
|
data>> dup length <iota> swap [ index>> ] map sequence= ;
|
||||||
|
|
||||||
14 [
|
14 [
|
||||||
[ t ] swap [ 2^ test-entry-indices ] curry unit-test
|
[ t ] swap [ 2^ test-entry-indices ] curry unit-test
|
||||||
|
|
|
@ -24,7 +24,7 @@ M: object specializer-declaration class-of ;
|
||||||
"specializer" word-prop ;
|
"specializer" word-prop ;
|
||||||
|
|
||||||
: make-specializer ( specs -- quot )
|
: make-specializer ( specs -- quot )
|
||||||
dup length iota <reversed>
|
dup length <iota> <reversed>
|
||||||
[ (picker) 2array ] 2map
|
[ (picker) 2array ] 2map
|
||||||
[ drop object eq? ] assoc-reject
|
[ drop object eq? ] assoc-reject
|
||||||
[ [ t ] ] [
|
[ [ t ] ] [
|
||||||
|
|
|
@ -171,7 +171,7 @@ PRIVATE>
|
||||||
:: each-pixel ( ... image quot: ( ... x y pixel -- ... ) -- ... )
|
:: each-pixel ( ... image quot: ( ... x y pixel -- ... ) -- ... )
|
||||||
image dim>> first2 :> ( width height )
|
image dim>> first2 :> ( width height )
|
||||||
image bytes-per-pixel :> n
|
image bytes-per-pixel :> n
|
||||||
height width [ iota ] bi@ [| y x |
|
height width [ <iota> ] bi@ [| y x |
|
||||||
y width * x + :> start
|
y width * x + :> start
|
||||||
start n * :> from
|
start n * :> from
|
||||||
from n + :> to
|
from n + :> to
|
||||||
|
|
|
@ -6,7 +6,7 @@ math.ranges math.vectors sequences sequences.deep fry ;
|
||||||
IN: images.processing
|
IN: images.processing
|
||||||
|
|
||||||
: coord-matrix ( dim -- m )
|
: coord-matrix ( dim -- m )
|
||||||
[ iota ] map first2 cartesian-product ;
|
[ <iota> ] map first2 cartesian-product ;
|
||||||
|
|
||||||
: map^2 ( m quot -- m' ) '[ _ map ] map ; inline
|
: map^2 ( m quot -- m' ) '[ _ map ] map ; inline
|
||||||
: each^2 ( m quot -- m' ) '[ _ each ] each ; inline
|
: each^2 ( m quot -- m' ) '[ _ each ] each ; inline
|
||||||
|
|
|
@ -18,7 +18,7 @@ SYMBOL: jis212
|
||||||
"vocab:io/encodings/iso2022/212.txt" load-codetable-file jis212 set-global
|
"vocab:io/encodings/iso2022/212.txt" load-codetable-file jis212 set-global
|
||||||
|
|
||||||
SYMBOL: ascii
|
SYMBOL: ascii
|
||||||
128 iota dup zip >biassoc ascii set-global
|
128 <iota> dup zip >biassoc ascii set-global
|
||||||
|
|
||||||
TUPLE: iso2022-state type ;
|
TUPLE: iso2022-state type ;
|
||||||
|
|
||||||
|
|
|
@ -26,7 +26,7 @@ SYMBOL: unique-retries
|
||||||
unique-length get random-string ;
|
unique-length get random-string ;
|
||||||
|
|
||||||
: retry ( quot: ( -- ? ) n -- )
|
: retry ( quot: ( -- ? ) n -- )
|
||||||
iota swap [ drop ] prepose attempt-all ; inline
|
<iota> swap [ drop ] prepose attempt-all ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -11,7 +11,7 @@ locals math namespaces sequences tools.test ;
|
||||||
{ } [
|
{ } [
|
||||||
path binary [
|
path binary [
|
||||||
[
|
[
|
||||||
100,000 iota
|
100,000 <iota>
|
||||||
0
|
0
|
||||||
100,000 int malloc-array &free [ copy ] keep write
|
100,000 int malloc-array &free [ copy ] keep write
|
||||||
] with-destructors
|
] with-destructors
|
||||||
|
@ -20,7 +20,7 @@ locals math namespaces sequences tools.test ;
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
path binary [
|
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
|
] with-file-reader
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -338,7 +338,7 @@ M: ssl-handle dispose*
|
||||||
X509_get_issuer_name x509name>string ;
|
X509_get_issuer_name x509name>string ;
|
||||||
|
|
||||||
: name-stack>sequence ( name-stack -- seq )
|
: 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 )
|
: alternative-dns-names ( certificate -- dns-names )
|
||||||
NID_subject_alt_name f f X509_get_ext_d2i
|
NID_subject_alt_name f f X509_get_ext_d2i
|
||||||
|
|
|
@ -206,7 +206,7 @@ HELP: foreground
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code
|
{ $code
|
||||||
"USING: colors.gray io.styles hashtables sequences kernel math ;"
|
"USING: colors.gray io.styles hashtables sequences kernel math ;"
|
||||||
"10 iota ["
|
"10 <iota> ["
|
||||||
" \"Hello world\\n\""
|
" \"Hello world\\n\""
|
||||||
" swap 10 / 1 <gray> foreground associate format"
|
" swap 10 / 1 <gray> foreground associate format"
|
||||||
"] each"
|
"] each"
|
||||||
|
@ -218,7 +218,7 @@ HELP: background
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code
|
{ $code
|
||||||
"USING: colors hashtables io io.styles kernel math sequences ;"
|
"USING: colors hashtables io io.styles kernel math sequences ;"
|
||||||
"10 iota ["
|
"10 <iota> ["
|
||||||
" \"Hello world\\n\""
|
" \"Hello world\\n\""
|
||||||
" swap 10 / 1 over - over 1 <rgba>"
|
" swap 10 / 1 over - over 1 <rgba>"
|
||||||
" background associate format"
|
" background associate format"
|
||||||
|
|
|
@ -20,15 +20,15 @@ TYPED:: loop-step ( i j matrix: array old new step -- )
|
||||||
i 1 + j 1 + matrix nth-unsafe set-nth-unsafe ; inline
|
i 1 + j 1 + matrix nth-unsafe set-nth-unsafe ; inline
|
||||||
|
|
||||||
: lcs-initialize ( |str1| |str2| -- matrix )
|
: lcs-initialize ( |str1| |str2| -- matrix )
|
||||||
iota [ drop 0 <array> ] with map ;
|
<iota> [ drop 0 <array> ] with map ;
|
||||||
|
|
||||||
: levenshtein-initialize ( |str1| |str2| -- matrix )
|
: levenshtein-initialize ( |str1| |str2| -- matrix )
|
||||||
[ iota ] bi@ [ [ + ] curry map ] with map ;
|
[ <iota> ] bi@ [ [ + ] curry map ] with map ;
|
||||||
|
|
||||||
:: run-lcs ( old new init step -- matrix )
|
:: run-lcs ( old new init step -- matrix )
|
||||||
old length 1 + new length 1 + init call :> matrix
|
old length 1 + new length 1 + init call :> matrix
|
||||||
old length iota [| i |
|
old length <iota> [| i |
|
||||||
new length iota [| j |
|
new length <iota> [| j |
|
||||||
i j matrix old new step loop-step
|
i j matrix old new step loop-step
|
||||||
] each
|
] each
|
||||||
] each matrix ; inline
|
] each matrix ; inline
|
||||||
|
|
|
@ -42,7 +42,7 @@ M: wrapper expand-macros* wrapped>> literal ;
|
||||||
stack get pop end
|
stack get pop end
|
||||||
[ [ expand-macros ] [ ] map-as '[ _ dip ] % ]
|
[ [ expand-macros ] [ ] map-as '[ _ dip ] % ]
|
||||||
[
|
[
|
||||||
length iota [ <reversed> ] keep
|
length <iota> [ <reversed> ] keep
|
||||||
[ '[ _ ndrop _ nnip call ] [ ] like ] 2map , \ dispatch ,
|
[ '[ _ ndrop _ nnip call ] [ ] like ] 2map , \ dispatch ,
|
||||||
] bi ;
|
] bi ;
|
||||||
|
|
||||||
|
|
|
@ -83,7 +83,7 @@ DEFER: byte-bit-count
|
||||||
<<
|
<<
|
||||||
|
|
||||||
\ byte-bit-count
|
\ byte-bit-count
|
||||||
256 iota [
|
256 <iota> [
|
||||||
8 <bits> 0 [ [ 1 + ] when ] reduce
|
8 <bits> 0 [ [ 1 + ] when ] reduce
|
||||||
] B{ } map-as '[ 0xff bitand _ nth-unsafe ]
|
] B{ } map-as '[ 0xff bitand _ nth-unsafe ]
|
||||||
( byte -- table ) define-declared
|
( byte -- table ) define-declared
|
||||||
|
|
|
@ -73,7 +73,7 @@ HELP: combination
|
||||||
{ $notes "Combinations are 0-based and a bounds error will be thrown if " { $snippet "m" } " is larger than " { $snippet "seq length k nCk" } "." }
|
{ $notes "Combinations are 0-based and a bounds error will be thrown if " { $snippet "m" } " is larger than " { $snippet "seq length k nCk" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: math.combinatorics sequences prettyprint ;"
|
{ $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 ;"
|
{ $example "USING: math.combinatorics prettyprint ;"
|
||||||
"0 { \"a\" \"b\" \"c\" \"d\" } 2 combination ." "{ \"a\" \"b\" }" }
|
"0 { \"a\" \"b\" \"c\" \"d\" } 2 combination ." "{ \"a\" \"b\" }" }
|
||||||
} ;
|
} ;
|
||||||
|
|
|
@ -30,9 +30,9 @@ IN: math.combinatorics.tests
|
||||||
{ { 0 1 3 2 } } [ { 0 0 1 0 } >permutation ] unit-test
|
{ { 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
|
{ { 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 2 3 } } [ 0 4 <iota> permutation-indices ] unit-test
|
||||||
{ { 0 1 3 2 } } [ 1 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
|
{ { 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
|
{ { "a" "b" "c" "d" } } [ 0 { "a" "b" "c" "d" } permutation ] unit-test
|
||||||
{ { "d" "c" "b" "a" } } [ 23 { "a" "b" "c" "d" } permutation ] unit-test
|
{ { "d" "c" "b" "a" } } [ 23 { "a" "b" "c" "d" } permutation ] unit-test
|
||||||
|
@ -102,7 +102,7 @@ IN: math.combinatorics.tests
|
||||||
{ { 2 1 3 } } [ { 1 2 3 } [ first 2 = ] find-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 } } }
|
{ { { 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" } }
|
{ { "as" "ad" "af" "sa" "sd" "sf" "da" "ds" "df" "fa" "fs" "fd" } }
|
||||||
[ "asdf" 2 <k-permutations> >array ] unit-test
|
[ "asdf" 2 <k-permutations> >array ] unit-test
|
||||||
|
|
|
@ -17,7 +17,7 @@ GENERIC: nths-unsafe ( indices seq -- seq' )
|
||||||
M: string nths-unsafe (nths-unsafe) ;
|
M: string nths-unsafe (nths-unsafe) ;
|
||||||
M: array nths-unsafe (nths-unsafe) ;
|
M: array nths-unsafe (nths-unsafe) ;
|
||||||
M: vector 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) ;
|
M: object nths-unsafe (nths-unsafe) ;
|
||||||
|
|
||||||
: possible? ( n m -- ? )
|
: possible? ( n m -- ? )
|
||||||
|
@ -57,8 +57,8 @@ MEMO: factorial ( n -- n! )
|
||||||
: permutation-indices ( n seq -- permutation )
|
: permutation-indices ( n seq -- permutation )
|
||||||
length [ factoradic ] dip 0 pad-head >permutation ;
|
length [ factoradic ] dip 0 pad-head >permutation ;
|
||||||
|
|
||||||
: permutation-iota ( seq -- iota )
|
: permutation-iota ( seq -- <iota> )
|
||||||
length factorial iota ; inline
|
length factorial <iota> ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -101,7 +101,7 @@ DEFER: next-permutation
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: permutations-quot ( seq quot -- seq quot' )
|
: 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
|
'[ drop _ [ _ nths-unsafe @ ] keep next-permutation drop ] ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
@ -216,7 +216,7 @@ INSTANCE: combinations immutable-sequence
|
||||||
|
|
||||||
:: combinations-quot ( seq k quot -- seq quot' )
|
:: combinations-quot ( seq k quot -- seq quot' )
|
||||||
seq length :> n
|
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
|
'[ drop _ [ _ nths-unsafe @ ] keep _ next-combination drop ] ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
|
@ -373,7 +373,7 @@ M: float round dup sgn 2 /f + truncate ;
|
||||||
: roots ( x t -- seq )
|
: roots ( x t -- seq )
|
||||||
[ [ log ] [ recip ] bi* * e^ ]
|
[ [ log ] [ recip ] bi* * e^ ]
|
||||||
[ recip 2pi * 0 swap complex boa e^ ]
|
[ recip 2pi * 0 swap complex boa e^ ]
|
||||||
[ iota [ ^ * ] 2with map ] tri ;
|
[ <iota> [ ^ * ] 2with map ] tri ;
|
||||||
|
|
||||||
: sigmoid ( x -- y ) neg e^ 1 + recip ; inline
|
: sigmoid ( x -- y ) neg e^ 1 + recip ; inline
|
||||||
|
|
||||||
|
|
|
@ -322,7 +322,7 @@ unary-ops [
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
binary-ops [
|
binary-ops [
|
||||||
[ [ t ] ] dip '[ 8000 iota [ drop _ binary-test ] all? ] unit-test
|
[ [ t ] ] dip '[ 8000 <iota> [ drop _ binary-test ] all? ] unit-test
|
||||||
] each
|
] each
|
||||||
|
|
||||||
: comparison-ops ( -- alist )
|
: comparison-ops ( -- alist )
|
||||||
|
@ -339,7 +339,7 @@ binary-ops [
|
||||||
second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
|
second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
|
||||||
|
|
||||||
comparison-ops [
|
comparison-ops [
|
||||||
[ [ t ] ] dip '[ 8000 iota [ drop _ comparison-test ] all? ] unit-test
|
[ [ t ] ] dip '[ 8000 <iota> [ drop _ comparison-test ] all? ] unit-test
|
||||||
] each
|
] each
|
||||||
|
|
||||||
{ t } [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
|
{ t } [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
|
||||||
|
@ -377,7 +377,7 @@ comparison-ops [
|
||||||
|
|
||||||
commutative-ops [
|
commutative-ops [
|
||||||
[ [ t ] ] dip '[
|
[ [ t ] ] dip '[
|
||||||
8000 iota [
|
8000 <iota> [
|
||||||
drop
|
drop
|
||||||
random-interval-or-empty random-interval-or-empty _
|
random-interval-or-empty random-interval-or-empty _
|
||||||
[ execute ] [ swapd execute ] 3bi =
|
[ execute ] [ swapd execute ] 3bi =
|
||||||
|
|
|
@ -42,7 +42,7 @@ SYMBOL: matrix
|
||||||
[ [ clear-scale ] 2keep [ n*v ] dip v+ ] change-row ;
|
[ [ clear-scale ] 2keep [ n*v ] dip v+ ] change-row ;
|
||||||
|
|
||||||
: rows-from ( row# -- slice )
|
: rows-from ( row# -- slice )
|
||||||
rows dup iota <slice> ;
|
rows dup <iota> <slice> ;
|
||||||
|
|
||||||
: clear-col ( col# row# rows -- )
|
: clear-col ( col# row# rows -- )
|
||||||
[ nth-row ] dip [ [ 2dup ] dip (clear-col) ] each 2drop ;
|
[ nth-row ] dip [ [ 2dup ] dip (clear-col) ] each 2drop ;
|
||||||
|
@ -79,9 +79,9 @@ SYMBOL: matrix
|
||||||
|
|
||||||
: reduced ( matrix' -- matrix'' )
|
: reduced ( matrix' -- matrix'' )
|
||||||
[
|
[
|
||||||
rows iota <reversed> [
|
rows <iota> <reversed> [
|
||||||
dup nth-row leading drop
|
dup nth-row leading drop
|
||||||
[ swap dup iota clear-col ] [ drop ] if*
|
[ swap dup <iota> clear-col ] [ drop ] if*
|
||||||
] each
|
] each
|
||||||
] with-matrix ;
|
] with-matrix ;
|
||||||
|
|
||||||
|
|
|
@ -24,22 +24,22 @@ IN: math.matrices
|
||||||
1 <repetition> diagonal-matrix ; inline
|
1 <repetition> diagonal-matrix ; inline
|
||||||
|
|
||||||
: eye ( m n k -- matrix )
|
: 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 )
|
: hilbert-matrix ( m n -- matrix )
|
||||||
[ iota ] bi@ [ + 1 + recip ] cartesian-map ;
|
[ <iota> ] bi@ [ + 1 + recip ] cartesian-map ;
|
||||||
|
|
||||||
: toeplitz-matrix ( n -- matrix )
|
: toeplitz-matrix ( n -- matrix )
|
||||||
iota dup [ - abs 1 + ] cartesian-map ;
|
<iota> dup [ - abs 1 + ] cartesian-map ;
|
||||||
|
|
||||||
: hankel-matrix ( n -- matrix )
|
: 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 )
|
: box-matrix ( r -- matrix )
|
||||||
2 * 1 + dup '[ _ 1 <array> ] replicate ;
|
2 * 1 + dup '[ _ 1 <array> ] replicate ;
|
||||||
|
|
||||||
: vandermonde-matrix ( u n -- matrix )
|
: vandermonde-matrix ( u n -- matrix )
|
||||||
iota [ v^n ] with map reverse flip ;
|
<iota> [ v^n ] with map reverse flip ;
|
||||||
|
|
||||||
:: rotation-matrix3 ( axis theta -- matrix )
|
:: rotation-matrix3 ( axis theta -- matrix )
|
||||||
theta cos :> c
|
theta cos :> c
|
||||||
|
@ -207,10 +207,10 @@ ERROR: negative-power-matrix m n ;
|
||||||
'[ _ map ] map ; inline
|
'[ _ map ] map ; inline
|
||||||
|
|
||||||
: column-map ( matrix quot -- seq )
|
: 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 )
|
: cartesian-square-indices ( n -- matrix )
|
||||||
iota dup cartesian-product ; inline
|
<iota> dup cartesian-product ; inline
|
||||||
|
|
||||||
: cartesian-matrix-map ( matrix quot -- matrix' )
|
: cartesian-matrix-map ( matrix quot -- matrix' )
|
||||||
[ [ first length cartesian-square-indices ] keep ] dip
|
[ [ first length cartesian-square-indices ] keep ] dip
|
||||||
|
@ -227,17 +227,17 @@ ERROR: negative-power-matrix m n ;
|
||||||
: sample-cov-matrix ( matrix -- cov ) 1 cov-matrix-ddof ; inline
|
: sample-cov-matrix ( matrix -- cov ) 1 cov-matrix-ddof ; inline
|
||||||
|
|
||||||
GENERIC: square-rows ( object -- matrix )
|
GENERIC: square-rows ( object -- matrix )
|
||||||
M: integer square-rows iota square-rows ;
|
M: integer square-rows <iota> square-rows ;
|
||||||
M: sequence square-rows
|
M: sequence square-rows
|
||||||
[ length ] keep >array '[ _ clone ] { } replicate-as ;
|
[ length ] keep >array '[ _ clone ] { } replicate-as ;
|
||||||
|
|
||||||
GENERIC: square-cols ( object -- matrix )
|
GENERIC: square-cols ( object -- matrix )
|
||||||
M: integer square-cols iota square-cols ;
|
M: integer square-cols <iota> square-cols ;
|
||||||
M: sequence square-cols
|
M: sequence square-cols
|
||||||
[ length ] keep [ <array> ] with { } map-as ;
|
[ length ] keep [ <array> ] with { } map-as ;
|
||||||
|
|
||||||
: make-matrix-with-indices ( m n quot -- matrix )
|
: 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
|
: null-matrix? ( matrix -- ? ) empty? ; inline
|
||||||
|
|
||||||
|
@ -255,7 +255,7 @@ M: sequence square-cols
|
||||||
{ [ well-formed-matrix? ] [ dim all-eq? ] } 1&& ;
|
{ [ well-formed-matrix? ] [ dim all-eq? ] } 1&& ;
|
||||||
|
|
||||||
: matrix-coordinates ( dim -- coordinates )
|
: matrix-coordinates ( dim -- coordinates )
|
||||||
first2 [ iota ] bi@ cartesian-product ; inline
|
first2 [ <iota> ] bi@ cartesian-product ; inline
|
||||||
|
|
||||||
: dimension-range ( matrix -- dim range )
|
: dimension-range ( matrix -- dim range )
|
||||||
dim [ matrix-coordinates ] [ first [1,b] ] bi ;
|
dim [ matrix-coordinates ] [ first [1,b] ] bi ;
|
||||||
|
|
|
@ -33,7 +33,7 @@ ALIAS: n*p n*v
|
||||||
|
|
||||||
: p* ( p q -- r )
|
: p* ( p q -- r )
|
||||||
2unempty pextend-conv
|
2unempty pextend-conv
|
||||||
[ drop length [ iota ] keep ]
|
[ drop length [ <iota> ] keep ]
|
||||||
[ nip <reversed> ]
|
[ nip <reversed> ]
|
||||||
[ drop ] 2tri
|
[ drop ] 2tri
|
||||||
'[ _ _ <slice> _ v* sum ] map reverse! ;
|
'[ _ _ <slice> _ v* sum ] map reverse! ;
|
||||||
|
@ -86,7 +86,7 @@ PRIVATE>
|
||||||
[ V{ 0 } clone V{ 1 } clone ] 2dip swap (pgcd) [ >array ] bi@ ;
|
[ V{ 0 } clone V{ 1 } clone ] 2dip swap (pgcd) [ >array ] bi@ ;
|
||||||
|
|
||||||
: pdiff ( p -- p' )
|
: pdiff ( p -- p' )
|
||||||
dup length iota v* rest ;
|
dup length <iota> v* rest ;
|
||||||
|
|
||||||
: polyval ( x p -- p[x] )
|
: polyval ( x p -- p[x] )
|
||||||
! Horner scheme
|
! Horner scheme
|
||||||
|
|
|
@ -8,4 +8,4 @@ IN: math.primes.miller-rabin.tests
|
||||||
{ t } [ 37 miller-rabin ] unit-test
|
{ t } [ 37 miller-rabin ] unit-test
|
||||||
{ t } [ 2135623355842621559 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
|
||||||
|
|
|
@ -10,13 +10,13 @@ IN: math.primes.miller-rabin
|
||||||
n 1 - :> n-1
|
n 1 - :> n-1
|
||||||
n-1 factor-2s :> ( r s )
|
n-1 factor-2s :> ( r s )
|
||||||
0 :> a!
|
0 :> a!
|
||||||
trials iota [
|
trials <iota> [
|
||||||
drop
|
drop
|
||||||
2 n 2 - [a,b] random a!
|
2 n 2 - [a,b] random a!
|
||||||
a s n ^mod 1 = [
|
a s n ^mod 1 = [
|
||||||
f
|
f
|
||||||
] [
|
] [
|
||||||
r iota [
|
r <iota> [
|
||||||
2^ s * a swap n ^mod n-1 =
|
2^ s * a swap n ^mod n-1 =
|
||||||
] any? not
|
] any? not
|
||||||
] if
|
] if
|
||||||
|
|
|
@ -183,7 +183,7 @@ IN: math.statistics.tests
|
||||||
|
|
||||||
{ { 0 0 0 } } [ { 1 1 1 } standardize ] unit-test
|
{ { 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
|
||||||
|
|
||||||
|
|
||||||
{
|
{
|
||||||
|
|
|
@ -469,7 +469,7 @@ simd-classes [
|
||||||
[ [ { } ] ] dip
|
[ [ { } ] ] dip
|
||||||
[ new length shuffles-for ] keep
|
[ new length shuffles-for ] keep
|
||||||
'[
|
'[
|
||||||
_ [ [ _ new [ length iota ] keep like 1quotation ] dip '[ _ vshuffle ] ]
|
_ [ [ _ new [ length <iota> ] keep like 1quotation ] dip '[ _ vshuffle ] ]
|
||||||
[ = ] check-optimizer
|
[ = ] check-optimizer
|
||||||
] unit-test
|
] unit-test
|
||||||
] each
|
] each
|
||||||
|
@ -480,7 +480,7 @@ simd-classes [
|
||||||
'[
|
'[
|
||||||
_ [ [
|
_ [ [
|
||||||
_ new
|
_ new
|
||||||
[ [ length iota ] keep like ]
|
[ [ length <iota> ] keep like ]
|
||||||
[ [ length dup dup + [a,b) ] keep like ] bi [ ] 2sequence
|
[ [ length dup dup + [a,b) ] keep like ] bi [ ] 2sequence
|
||||||
] dip '[ _ vshuffle2-elements ] ]
|
] dip '[ _ vshuffle2-elements ] ]
|
||||||
[ = ] check-optimizer
|
[ = ] check-optimizer
|
||||||
|
@ -567,7 +567,7 @@ TUPLE: inconsistent-vector-test bool branch ;
|
||||||
|
|
||||||
! Test element access -- it should box bignums for int-4 on x86
|
! Test element access -- it should box bignums for int-4 on x86
|
||||||
: test-accesses ( seq -- failures )
|
: 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
|
'[ [ _ 1quotation ] dip '[ _ swap nth ] ] [ = ] check-optimizer ; inline
|
||||||
|
|
||||||
{ { } } [ float-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
|
{ { } } [ float-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
|
||||||
|
@ -584,7 +584,7 @@ TUPLE: inconsistent-vector-test bool branch ;
|
||||||
|
|
||||||
"== Checking broadcast" print
|
"== Checking broadcast" print
|
||||||
: test-broadcast ( seq -- failures )
|
: test-broadcast ( seq -- failures )
|
||||||
[ length iota >array ] keep
|
[ length <iota> >array ] keep
|
||||||
'[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ;
|
'[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ;
|
||||||
|
|
||||||
{ { } } [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
|
{ { } } [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
|
||||||
|
|
|
@ -3,6 +3,6 @@ IN: nibble-arrays.tests
|
||||||
|
|
||||||
[ -1 <nibble-array> ] [ T{ bad-array-length f -1 } = ] must-fail-with
|
[ -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{ 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
|
{ N{ 1 4 9 0 9 4 } } [ N{ 1 2 3 4 5 6 } [ sq ] map ] unit-test
|
||||||
|
|
|
@ -18,14 +18,14 @@ vectors math math.order ;
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ 100 1060 2000 10000 100000 1000000 } [
|
{ 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
|
] each
|
||||||
|
|
||||||
{ } [ 10000 [ 16 random-bits ] PV{ } replicate-as "1" set ] unit-test
|
{ } [ 10000 [ 16 random-bits ] PV{ } replicate-as "1" set ] unit-test
|
||||||
{ } [ "1" get >vector "2" set ] unit-test
|
{ } [ "1" get >vector "2" set ] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
3000 iota [
|
3000 <iota> [
|
||||||
drop
|
drop
|
||||||
16 random-bits 10000 random
|
16 random-bits 10000 random
|
||||||
[ "1" [ new-nth ] change ]
|
[ "1" [ new-nth ] change ]
|
||||||
|
@ -56,11 +56,11 @@ vectors math math.order ;
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ 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
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
100 iota [
|
100 <iota> [
|
||||||
drop
|
drop
|
||||||
100 random [
|
100 random [
|
||||||
16 random-bits [ "1" [ ppush ] change ] [ "2" get push ] bi
|
16 random-bits [ "1" [ ppush ] change ] [ "2" get push ] bi
|
||||||
|
|
|
@ -36,7 +36,7 @@ IN: porter-stemmer
|
||||||
[ 0 0 ] dip skip-consonants (consonant-seq) ;
|
[ 0 0 ] dip skip-consonants (consonant-seq) ;
|
||||||
|
|
||||||
: stem-vowel? ( str -- ? )
|
: stem-vowel? ( str -- ? )
|
||||||
[ length iota ] keep [ consonant? ] curry all? not ;
|
[ length <iota> ] keep [ consonant? ] curry all? not ;
|
||||||
|
|
||||||
: double-consonant? ( i str -- ? )
|
: double-consonant? ( i str -- ? )
|
||||||
over 1 < [
|
over 1 < [
|
||||||
|
|
|
@ -457,12 +457,12 @@ TUPLE: fo { a intersection{ integer fixnum } initial: 0 } ;
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ "{ 0 1 2 3 4 }" } [
|
{ "{ 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
|
with-string-writer
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ "{ 0 1 2 3 ~2 more~ }" } [
|
{ "{ 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
|
with-string-writer
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -325,7 +325,7 @@ SYMBOL: next
|
||||||
|
|
||||||
: group-flow ( seq -- newseq )
|
: group-flow ( seq -- newseq )
|
||||||
[
|
[
|
||||||
dup length iota [
|
dup length <iota> [
|
||||||
2dup 1 - swap ?nth prev namespaces:set
|
2dup 1 - swap ?nth prev namespaces:set
|
||||||
2dup 1 + swap ?nth next namespaces:set
|
2dup 1 + swap ?nth next namespaces:set
|
||||||
swap nth dup split-before dup , split-after
|
swap nth dup split-before dup , split-after
|
||||||
|
|
|
@ -11,8 +11,8 @@ IN: random.tests
|
||||||
{ 2 } [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test
|
{ 2 } [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test
|
||||||
[ V{ } [ delete-random drop ] keep length ] must-fail
|
[ 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 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 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test
|
||||||
|
|
||||||
{ t } [ 1000 [ 400 random ] replicate members length 256 > ] unit-test
|
{ t } [ 1000 [ 400 random ] replicate members length 256 > ] unit-test
|
||||||
|
|
||||||
|
@ -29,7 +29,7 @@ IN: random.tests
|
||||||
[ { 1 2 } 3 sample ] [ too-many-samples? ] must-fail-with
|
[ { 1 2 } 3 sample ] [ too-many-samples? ] must-fail-with
|
||||||
|
|
||||||
{ 3 } [ { 1 2 3 4 } 3 sample members length ] unit-test
|
{ 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
|
[ [ 100 random-bytes ] with-system-random drop ] unit-test
|
||||||
|
|
|
@ -128,7 +128,7 @@ ERROR: too-many-samples seq n ;
|
||||||
|
|
||||||
: sample ( seq n -- seq' )
|
: sample ( seq n -- seq' )
|
||||||
2dup [ length ] dip < [ too-many-samples ] when
|
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 ;
|
[ drop ] 2bi nths-unsafe ;
|
||||||
|
|
||||||
: delete-random ( seq -- elt )
|
: delete-random ( seq -- elt )
|
||||||
|
|
|
@ -66,7 +66,7 @@ M:: sfmt generate ( sfmt -- )
|
||||||
state n>> :> n
|
state n>> :> n
|
||||||
state mask>> :> mask
|
state mask>> :> mask
|
||||||
|
|
||||||
n m - >fixnum iota [| i |
|
n m - >fixnum <iota> [| i |
|
||||||
i array nth-unsafe
|
i array nth-unsafe
|
||||||
i m + array nth-unsafe
|
i m + array nth-unsafe
|
||||||
mask state r1>> state r2>> formula :> r
|
mask state r1>> state r2>> formula :> r
|
||||||
|
@ -77,7 +77,7 @@ M:: sfmt generate ( sfmt -- )
|
||||||
] each
|
] each
|
||||||
|
|
||||||
! n m - 1 + n [a,b) [
|
! n m - 1 + n [a,b) [
|
||||||
m 1 - iota [
|
m 1 - <iota> [
|
||||||
n m - 1 + + >fixnum :> i
|
n m - 1 + + >fixnum :> i
|
||||||
i array nth-unsafe
|
i array nth-unsafe
|
||||||
m n - i + array nth-unsafe
|
m n - i + array nth-unsafe
|
||||||
|
|
|
@ -11,7 +11,7 @@ TUPLE: parts in out ;
|
||||||
zip [ first ] partition [ values ] bi@ parts boa ;
|
zip [ first ] partition [ values ] bi@ parts boa ;
|
||||||
|
|
||||||
: powerset-partition ( sequence -- partitions )
|
: 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 )
|
: partition>class ( parts -- class )
|
||||||
[ out>> [ <not-class> ] map ]
|
[ out>> [ <not-class> ] map ]
|
||||||
|
|
|
@ -22,7 +22,7 @@ MACRO: firstn ( n -- quot )
|
||||||
|
|
||||||
MACRO: set-firstn-unsafe ( n -- quot )
|
MACRO: set-firstn-unsafe ( n -- quot )
|
||||||
[ 1 + ]
|
[ 1 + ]
|
||||||
[ iota [ '[ _ rot [ set-nth-unsafe ] keep ] ] map ] bi
|
[ <iota> [ '[ _ rot [ set-nth-unsafe ] keep ] ] map ] bi
|
||||||
'[ _ -nrot _ spread drop ] ;
|
'[ _ -nrot _ spread drop ] ;
|
||||||
|
|
||||||
MACRO: set-firstn ( n -- quot )
|
MACRO: set-firstn ( n -- quot )
|
||||||
|
|
|
@ -9,7 +9,7 @@ IN: sequences.unrolled
|
||||||
swap '[ _ call( i -- ) ] each-integer ;
|
swap '[ _ call( i -- ) ] each-integer ;
|
||||||
|
|
||||||
<< \ (unrolled-each-integer) [
|
<< \ (unrolled-each-integer) [
|
||||||
iota [ '[ _ swap call( i -- ) ] ] [ ] map-as '[ _ cleave ]
|
<iota> [ '[ _ swap call( i -- ) ] ] [ ] map-as '[ _ cleave ]
|
||||||
] 1 define-partial-eval >>
|
] 1 define-partial-eval >>
|
||||||
|
|
||||||
: (unrolled-collect) ( quot into -- quot' )
|
: (unrolled-collect) ( quot into -- quot' )
|
||||||
|
@ -95,4 +95,4 @@ PRIVATE>
|
||||||
4 npick unrolled-2map-as ; inline
|
4 npick unrolled-2map-as ; inline
|
||||||
|
|
||||||
: unrolled-map-index ( seq len quot: ( x i -- newx ) -- newseq )
|
: unrolled-map-index ( seq len quot: ( x i -- newx ) -- newseq )
|
||||||
[ dup length iota ] 2dip unrolled-2map ; inline
|
[ dup length <iota> ] 2dip unrolled-2map ; inline
|
||||||
|
|
|
@ -107,7 +107,7 @@ ARTICLE: "specialized-array-examples" "Specialized array examples"
|
||||||
{ $code "1.0 [ sin ] [ cos ] [ tan ] tri float-array{ } 3sequence ." }
|
{ $code "1.0 [ sin ] [ cos ] [ tan ] tri float-array{ } 3sequence ." }
|
||||||
"Create a float array and sum the elements:"
|
"Create a float array and sum the elements:"
|
||||||
{ $code
|
{ $code
|
||||||
"1000 iota [ 1000 /f pi * sin ] float-array{ } map-as"
|
"1000 <iota> [ 1000 /f pi * sin ] float-array{ } map-as"
|
||||||
"0.0 [ + ] reduce ."
|
"0.0 [ + ] reduce ."
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
|
|
@ -459,7 +459,7 @@ DEFER: eee'
|
||||||
] [ 4drop ] if ; inline recursive
|
] [ 4drop ] if ; inline recursive
|
||||||
: recursive-reduce ( seq i quot: ( prev elt -- next ) -- result )
|
: recursive-reduce ( seq i quot: ( prev elt -- next ) -- result )
|
||||||
swapd [ 0 ] 2dip over length (recursive-reduce) ; inline
|
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
|
{ 3 1 } [ [ member? [ 1 + ] when ] curry recursive-reduce ] must-infer-as
|
||||||
|
|
||||||
[ [ [ write write ] each ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
[ [ [ write write ] each ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: suffix-arrays
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: suffixes ( string -- suffixes-seq )
|
: suffixes ( string -- suffixes-seq )
|
||||||
dup length iota [ tail-slice ] with map ;
|
dup length <iota> [ tail-slice ] with map ;
|
||||||
|
|
||||||
: prefix<=> ( begin seq -- <=> )
|
: prefix<=> ( begin seq -- <=> )
|
||||||
[ <=> ] [ swap head? ] 2bi [ drop +eq+ ] when ;
|
[ <=> ] [ swap head? ] 2bi [ drop +eq+ ] when ;
|
||||||
|
|
|
@ -184,7 +184,7 @@ $nl
|
||||||
! Don't use $example below: it won't pass help-lint.
|
! Don't use $example below: it won't pass help-lint.
|
||||||
{ $code
|
{ $code
|
||||||
"USING: math.parser threads ;"
|
"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"
|
"10 [ yield ] times"
|
||||||
"0"
|
"0"
|
||||||
"1"
|
"1"
|
||||||
|
|
|
@ -44,7 +44,7 @@ yield
|
||||||
{ f } [ f get-global ] unit-test
|
{ f } [ f get-global ] unit-test
|
||||||
|
|
||||||
{ { 0 3 6 9 12 15 18 21 24 27 } } [
|
{ { 0 3 6 9 12 15 18 21 24 27 } } [
|
||||||
10 iota [
|
10 <iota> [
|
||||||
0 "i" tset
|
0 "i" tset
|
||||||
[
|
[
|
||||||
"i" [ yield 3 + ] tchange
|
"i" [ yield 3 + ] tchange
|
||||||
|
|
|
@ -47,7 +47,7 @@ STRUCT: group-directory-entry
|
||||||
ico-header heap-size bytes <displaced-alien>
|
ico-header heap-size bytes <displaced-alien>
|
||||||
header ImageCount>> ico-directory-entry <c-direct-array> :> directory
|
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
|
:> group-directory
|
||||||
directory [ bytes ico-icon ] { } map-as :> icon-bytes
|
directory [ bytes ico-icon ] { } map-as :> icon-bytes
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@ IN: tools.hexdump.tests
|
||||||
{ t } [ B{ } hexdump "Length: 0, 0h\n" = ] unit-test
|
{ 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 } [ "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
|
||||||
|
|
||||||
|
|
||||||
{
|
{
|
||||||
|
|
|
@ -17,8 +17,8 @@ TUPLE: boom ;
|
||||||
{ } [ 10 [ [ 100 [ 1000 random (byte-array) drop ] times compact-gc ] profile ] times ] unit-test
|
{ } [ 10 [ [ 100 [ 1000 random (byte-array) drop ] times compact-gc ] profile ] times ] unit-test
|
||||||
{ } [ 2 [ [ 1 seconds sleep ] 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 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 top-down profile. ] unit-test
|
||||||
|
|
||||||
f raw-profile-data set-global
|
f raw-profile-data set-global
|
||||||
gc
|
gc
|
||||||
|
|
|
@ -21,11 +21,11 @@ IN: tools.scaffold.tests
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{
|
{
|
||||||
"HELP: iota-tuple
|
"HELP: iota
|
||||||
{ $class-description \"\" } ;
|
{ $class-description \"\" } ;
|
||||||
" }
|
" }
|
||||||
[
|
[
|
||||||
[ \ iota-tuple (help.) ] with-string-writer
|
[ \ iota (help.) ] with-string-writer
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ sequence t } [ "seq" lookup-type ] unit-test
|
{ sequence t } [ "seq" lookup-type ] unit-test
|
||||||
|
|
|
@ -18,7 +18,7 @@ M: bad-tr summary
|
||||||
[ [ ascii? ] all? ] both? [ bad-tr ] unless ;
|
[ [ ascii? ] all? ] both? [ bad-tr ] unless ;
|
||||||
|
|
||||||
: compute-tr ( quot from to -- mapping )
|
: compute-tr ( quot from to -- mapping )
|
||||||
[ 128 iota ] 3dip zip
|
[ 128 <iota> ] 3dip zip
|
||||||
'[ [ _ call( x -- y ) _ at ] keep or ] B{ } map-as ; inline
|
'[ [ _ call( x -- y ) _ at ] keep or ] B{ } map-as ; inline
|
||||||
|
|
||||||
: tr-hints ( word -- )
|
: tr-hints ( word -- )
|
||||||
|
|
|
@ -22,7 +22,7 @@ MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ;
|
||||||
|
|
||||||
MACRO: write-tuple ( class -- quot )
|
MACRO: write-tuple ( class -- quot )
|
||||||
[ '[ [ _ boa ] undo ] ]
|
[ '[ [ _ boa ] undo ] ]
|
||||||
[ tuple-arity iota <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
|
[ tuple-arity <iota> <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
|
||||||
bi '[ _ dip @ ] ;
|
bi '[ _ dip @ ] ;
|
||||||
|
|
||||||
: check-final ( class -- )
|
: check-final ( class -- )
|
||||||
|
|
|
@ -163,7 +163,7 @@ ui-running? [
|
||||||
<flag> ui-notify-flag set-global
|
<flag> ui-notify-flag set-global
|
||||||
|
|
||||||
[ fake-ui-loop ] "Fake UI" spawn drop
|
[ fake-ui-loop ] "Fake UI" spawn drop
|
||||||
8001 iota [ layout-later ] each
|
8001 <iota> [ layout-later ] each
|
||||||
ui-notify-flag get-global value>>
|
ui-notify-flag get-global value>>
|
||||||
layout-queue delete-all
|
layout-queue delete-all
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -70,7 +70,7 @@ dup layout
|
||||||
"s" set
|
"s" set
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
10 iota [
|
10 <iota> [
|
||||||
drop
|
drop
|
||||||
"g2" get scroll>gadget
|
"g2" get scroll>gadget
|
||||||
"s" get layout
|
"s" get layout
|
||||||
|
|
|
@ -16,7 +16,7 @@ TUPLE: gradient < caching-pen colors last-vertices last-colors ;
|
||||||
|
|
||||||
:: gradient-vertices ( direction dim colors -- seq )
|
:: gradient-vertices ( direction dim colors -- seq )
|
||||||
direction dim v* dim over v- swap
|
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
|
swap [ over v+ 2array ] curry map
|
||||||
concat concat float >c-array ;
|
concat concat float >c-array ;
|
||||||
|
|
||||||
|
|
|
@ -51,4 +51,4 @@ IN: unicode.breaks.tests
|
||||||
grapheme-break-test parse-test-file [ >graphemes ] test
|
grapheme-break-test parse-test-file [ >graphemes ] test
|
||||||
word-break-test parse-test-file [ >words ] 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
|
||||||
|
|
|
@ -84,14 +84,14 @@ SYMBOL: table
|
||||||
|
|
||||||
: make-grapheme-table ( -- )
|
: make-grapheme-table ( -- )
|
||||||
{ CR } { LF } connect
|
{ CR } { LF } connect
|
||||||
{ Control CR LF } graphemes iota disconnect
|
{ Control CR LF } graphemes <iota> disconnect
|
||||||
graphemes iota { Control CR LF } disconnect
|
graphemes <iota> { Control CR LF } disconnect
|
||||||
{ L } { L V LV LVT } connect
|
{ L } { L V LV LVT } connect
|
||||||
{ LV V } { V T } connect
|
{ LV V } { V T } connect
|
||||||
{ LVT T } { T } connect
|
{ LVT T } { T } connect
|
||||||
graphemes iota { Extend } connect
|
graphemes <iota> { Extend } connect
|
||||||
graphemes iota { SpacingMark } connect
|
graphemes <iota> { SpacingMark } connect
|
||||||
{ Prepend } graphemes iota connect ;
|
{ Prepend } graphemes <iota> connect ;
|
||||||
|
|
||||||
"grapheme-table" create-word-in
|
"grapheme-table" create-word-in
|
||||||
graphemes init-table table
|
graphemes init-table table
|
||||||
|
@ -146,8 +146,8 @@ SYMBOL: check-number-after
|
||||||
|
|
||||||
: make-word-table ( -- )
|
: make-word-table ( -- )
|
||||||
{ wCR } { wLF } connect
|
{ wCR } { wLF } connect
|
||||||
{ wNewline wCR wLF } unicode-words iota disconnect
|
{ wNewline wCR wLF } unicode-words <iota> disconnect
|
||||||
unicode-words iota { wNewline wCR wLF } disconnect
|
unicode-words <iota> { wNewline wCR wLF } disconnect
|
||||||
{ wALetter } { wMidLetter wMidNumLet } check-letter-after set-table
|
{ wALetter } { wMidLetter wMidNumLet } check-letter-after set-table
|
||||||
{ wMidLetter wMidNumLet } { wALetter } check-letter-before set-table
|
{ wMidLetter wMidNumLet } { wALetter } check-letter-before set-table
|
||||||
{ wNumeric wALetter } { wNumeric wALetter } connect
|
{ wNumeric wALetter } { wNumeric wALetter } connect
|
||||||
|
|
|
@ -83,7 +83,7 @@ ducet get-global insert-helpers
|
||||||
|
|
||||||
: add ( char -- )
|
: add ( char -- )
|
||||||
dup blocked? [ 1string , ] [
|
dup blocked? [ 1string , ] [
|
||||||
dup possible-bases dup length iota
|
dup possible-bases dup length <iota>
|
||||||
[ ?combine ] 2with any?
|
[ ?combine ] 2with any?
|
||||||
[ drop ] [ 1string , ] if
|
[ drop ] [ 1string , ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
|
@ -100,7 +100,7 @@ PRIVATE>
|
||||||
over tail-slice first-word + ;
|
over tail-slice first-word + ;
|
||||||
|
|
||||||
: last-word ( str -- i )
|
: 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 )
|
: last-word-from ( end str -- i )
|
||||||
swap head-slice last-word ;
|
swap head-slice last-word ;
|
||||||
|
|
|
@ -98,7 +98,7 @@ TUPLE: registry-enum-key ;
|
||||||
|
|
||||||
|
|
||||||
:: reg-enum-keys ( registry-info -- seq )
|
:: reg-enum-keys ( registry-info -- seq )
|
||||||
registry-info sub-keys>> iota [
|
registry-info sub-keys>> <iota> [
|
||||||
[ registry-info key>> ] dip
|
[ registry-info key>> ] dip
|
||||||
registry-value-max-length TCHAR <c-array> dup :> registry-value
|
registry-value-max-length TCHAR <c-array> dup :> registry-value
|
||||||
registry-value length dup :> registry-value-length
|
registry-value length dup :> registry-value-length
|
||||||
|
|
|
@ -315,5 +315,5 @@ unit-test
|
||||||
{ 2 V{ 2 5 8 } }
|
{ 2 V{ 2 5 8 } }
|
||||||
}
|
}
|
||||||
} [
|
} [
|
||||||
10 iota [ 3 mod ] collect-by
|
10 <iota> [ 3 mod ] collect-by
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -231,7 +231,7 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
|
||||||
{ } zip-as ; inline
|
{ } zip-as ; inline
|
||||||
|
|
||||||
: zip-index-as ( values exemplar -- assoc )
|
: 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 ( values -- alist )
|
||||||
{ } zip-index-as ; inline
|
{ } zip-index-as ; inline
|
||||||
|
@ -295,7 +295,7 @@ M: enum delete-at seq>> remove-nth! drop ; inline
|
||||||
|
|
||||||
M: enum >alist ( enum -- alist ) ; 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
|
M: enum values seq>> >array ; inline
|
||||||
|
|
||||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue