steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

specialized-arrays: rename byte-array>T-array to T-array-cast, and make it work with anything that responds to >c-ptr / byte-length

db4
Slava Pestov 2010-05-18 23:09:34 -04:00
parent 4dd58ce40e
commit a8098e3182
13 changed files with 47 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/checksums/md5/md5.factor
View File

@ -182,10 +182,10 @@ HINTS: (process-md5-block-I) { uint-array md5-state } ;
] each ] each
] unless ; ] unless ;
: byte-array>uint-array-le ( byte-array -- uint-array ) : uint-array-cast-le ( byte-array -- uint-array )
byte-array>le byte-array>uint-array ; byte-array>le uint-array-cast ;
HINTS: byte-array>uint-array-le byte-array ; HINTS: uint-array-cast-le byte-array ;
: uint-array>byte-array-le ( uint-array -- byte-array ) : uint-array>byte-array-le ( uint-array -- byte-array )
underlying>> byte-array>le ; underlying>> byte-array>le ;
@ -194,7 +194,7 @@ HINTS: uint-array>byte-array-le uint-array ;
M: md5-state checksum-block ( block state -- ) M: md5-state checksum-block ( block state -- )
[ [
[ byte-array>uint-array-le ] [ state>> ] bi* { [ uint-array-cast-le ] [ state>> ] bi* {
[ (process-md5-block-F) ] [ (process-md5-block-F) ]
[ (process-md5-block-G) ] [ (process-md5-block-G) ]
[ (process-md5-block-H) ] [ (process-md5-block-H) ]

4
basis/images/bitmap/bitmap.factor
View File

@ -281,7 +281,7 @@ ERROR: bmp-not-supported n ;
{ 24 [ color-index>> ] } { 24 [ color-index>> ] }
{ 16 [ { 16 [
[ [
! byte-array>ushort-array ! ushort-array-cast
2 group [ le> ] map 2 group [ le> ] map
! 5 6 5 ! 5 6 5
! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield ! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
@ -312,7 +312,7 @@ M: unsupported-bitfield-widths summary
dup header>> bit-count>> { dup header>> bit-count>> {
{ 16 [ { 16 [
dup bitfields>> '[ dup bitfields>> '[
byte-array>ushort-array _ uncompress-bitfield ushort-array-cast _ uncompress-bitfield
] change-color-index ] change-color-index
] } ] }
{ 32 [ ] } { 32 [ ] }

6
basis/images/normalization/normalization.factor
View File

@ -47,13 +47,13 @@ GENERIC: normalize-component-type* ( image component-type -- image )
[ 255.0 * >integer ] B{ } map-as ; [ 255.0 * >integer ] B{ } map-as ;
M: float-components normalize-component-type* M: float-components normalize-component-type*
drop byte-array>float-array normalize-floats ; drop float-array-cast normalize-floats ;
M: half-components normalize-component-type* M: half-components normalize-component-type*
drop byte-array>half-array normalize-floats ; drop half-array-cast normalize-floats ;
: ushorts>ubytes ( bitmap -- bitmap' ) : ushorts>ubytes ( bitmap -- bitmap' )
byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline ushort-array-cast [ -8 shift ] B{ } map-as ; inline
M: ushort-components normalize-component-type* M: ushort-components normalize-component-type*
drop ushorts>ubytes ; drop ushorts>ubytes ;

2
basis/io/ports/ports-tests.factor
View File

@ -18,7 +18,7 @@ IN: io.ports.tests
[ t ] [ [ t ] [
"test.txt" temp-file binary [ "test.txt" temp-file binary [
100,000 4 * read byte-array>int-array 100,000 iota sequence= 100,000 4 * read int-array-cast 100,000 iota sequence=
] with-file-reader ] with-file-reader
] unit-test ] unit-test

20
basis/math/vectors/simd/intrinsics/intrinsics.factor
View File

@ -45,16 +45,16 @@ IN: math.vectors.simd.intrinsics
: [byte>rep-array] ( rep -- class ) : [byte>rep-array] ( rep -- class )
{ {
{ char-16-rep [ [ byte-array>char-array ] ] } { char-16-rep [ [ char-array-cast ] ] }
{ uchar-16-rep [ [ byte-array>uchar-array ] ] } { uchar-16-rep [ [ uchar-array-cast ] ] }
{ short-8-rep [ [ byte-array>short-array ] ] } { short-8-rep [ [ short-array-cast ] ] }
{ ushort-8-rep [ [ byte-array>ushort-array ] ] } { ushort-8-rep [ [ ushort-array-cast ] ] }
{ int-4-rep [ [ byte-array>int-array ] ] } { int-4-rep [ [ int-array-cast ] ] }
{ uint-4-rep [ [ byte-array>uint-array ] ] } { uint-4-rep [ [ uint-array-cast ] ] }
{ longlong-2-rep [ [ byte-array>longlong-array ] ] } { longlong-2-rep [ [ longlong-array-cast ] ] }
{ ulonglong-2-rep [ [ byte-array>ulonglong-array ] ] } { ulonglong-2-rep [ [ ulonglong-array-cast ] ] }
{ float-4-rep [ [ byte-array>float-array ] ] } { float-4-rep [ [ float-array-cast ] ] }
{ double-2-rep [ [ byte-array>double-array ] ] } { double-2-rep [ [ double-array-cast ] ] }
} case ; foldable } case ; foldable
: [>rep-array] ( rep -- class ) : [>rep-array] ( rep -- class )

2
basis/random/sfmt/sfmt.factor
View File

@ -118,7 +118,7 @@ M:: sfmt generate ( sfmt -- )
state-multiplier * 32 bits state-multiplier * 32 bits
] dip + 32 bits ] dip + 32 bits
] uint-array{ } accumulate-as nip ] uint-array{ } accumulate-as nip
dup underlying>> byte-array>uint-4-array ; dup uint-4-array-cast ;
: <sfmt-state> ( seed n m mask parity -- sfmt ) : <sfmt-state> ( seed n m mask parity -- sfmt )
sfmt-state <struct> sfmt-state <struct>

2
basis/specialized-arrays/specialized-arrays-docs.factor
View File

@ -21,7 +21,7 @@ ARTICLE: "specialized-array-words" "Specialized array words"
{ { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } } { { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } }
{ { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated unmanaged memory; stack effect " { $snippet "( alien len -- array )" } } } { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated unmanaged memory; stack effect " { $snippet "( alien len -- array )" } } }
{ { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } } { { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } }
{ { $snippet "byte-array>T-array" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } } { { $snippet "T-array-cast" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } }
{ { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } } { { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
{ { $snippet "T-array{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } } { { $snippet "T-array{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } }
} }

4
basis/specialized-arrays/specialized-arrays-tests.factor
View File

@ -27,10 +27,10 @@ SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
] unit-test ] unit-test
[ ushort-array{ 1234 } ] [ [ ushort-array{ 1234 } ] [
little-endian? B{ 210 4 } B{ 4 210 } ? byte-array>ushort-array little-endian? B{ 210 4 } B{ 4 210 } ? ushort-array-cast
] unit-test ] unit-test
[ B{ 210 4 1 } byte-array>ushort-array ] must-fail [ B{ 210 4 1 } ushort-array-cast ] must-fail
[ { 3 1 3 3 7 } ] [ [ { 3 1 3 3 7 } ] [
int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array

35
basis/specialized-arrays/specialized-arrays.factor
View File

@ -34,19 +34,19 @@ M: not-a-byte-array summary
FUNCTOR: define-array ( T -- ) FUNCTOR: define-array ( T -- )
A DEFINES-CLASS ${T}-array A DEFINES-CLASS ${T}-array
<A> DEFINES <${A}> <A> DEFINES <${A}>
(A) DEFINES (${A}) (A) DEFINES (${A})
<direct-A> DEFINES <direct-${A}> <direct-A> DEFINES <direct-${A}>
malloc-A DEFINES malloc-${A} malloc-A DEFINES malloc-${A}
>A DEFINES >${A} >A DEFINES >${A}
byte-array>A DEFINES byte-array>${A} A-cast DEFINES ${A}-cast
A{ DEFINES ${A}{ A{ DEFINES ${A}{
A@ DEFINES ${A}@ A@ DEFINES ${A}@
NTH [ T dup c-getter array-accessor ] NTH [ T dup c-getter array-accessor ]
SET-NTH [ T dup c-setter array-accessor ] SET-NTH [ T dup c-setter array-accessor ]
WHERE WHERE
@ -65,12 +65,9 @@ TUPLE: A
: malloc-A ( len -- specialized-array ) : malloc-A ( len -- specialized-array )
[ \ T heap-size calloc ] keep <direct-A> ; inline [ \ T heap-size calloc ] keep <direct-A> ; inline
: byte-array>A ( byte-array -- specialized-array ) : A-cast ( byte-array -- specialized-array )
>c-ptr dup byte-array? [ binary-object \ T heap-size /mod 0 =
dup length \ T heap-size /mod 0 = [ <direct-A> ] [ drop \ T bad-byte-array-length ] bi ; inline
[ <direct-A> ]
[ drop \ T bad-byte-array-length ] if
] [ not-a-byte-array ] if ; inline
M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline

2
basis/ui/backend/windows/windows.factor
View File

@ -797,7 +797,7 @@ M: windows-ui-backend system-alert
: client-area>RECT ( hwnd -- RECT ) : client-area>RECT ( hwnd -- RECT )
RECT <struct> RECT <struct>
[ GetClientRect win32-error=0/f ] [ GetClientRect win32-error=0/f ]
[ >c-ptr byte-array>POINT-array [ ClientToScreen drop ] with each ] [ >c-ptr POINT-array-cast [ ClientToScreen drop ] with each ]
[ nip ] 2tri ; [ nip ] 2tri ;
: hwnd>RECT ( hwnd -- RECT ) : hwnd>RECT ( hwnd -- RECT )

8
extra/alien/data/map/map-tests.factor
View File

@ -9,7 +9,7 @@ IN: alien.data.map.tests
[ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } ] [ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } ]
[ [
int-array{ 1 3 5 } [ dup ] data-map( int -- float[2] ) int-array{ 1 3 5 } [ dup ] data-map( int -- float[2] )
byte-array>float-array float-array-cast
] unit-test ] unit-test
[ [
@ -20,7 +20,7 @@ IN: alien.data.map.tests
} }
] [ ] [
3 iota [ float-4-with ] data-map( object -- float-4 ) 3 iota [ float-4-with ] data-map( object -- float-4 )
byte-array>float-4-array float-4-array-cast
] unit-test ] unit-test
[ [
@ -31,7 +31,7 @@ IN: alien.data.map.tests
} }
] [ ] [
12 iota [ float-4-boa ] data-map( object[4] -- float-4 ) 12 iota [ float-4-boa ] data-map( object[4] -- float-4 )
byte-array>float-4-array float-4-array-cast
] unit-test ] unit-test
[ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 0.0 0.0 } ] [ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 0.0 0.0 } ]
@ -151,5 +151,5 @@ CONSTANT: plane-count 4
[ ] data-map( object -- float ) ; [ ] data-map( object -- float ) ;
[ float-array{ 0.0 0.5 1.0 } ] [ float-array{ 0.0 0.5 1.0 } ]
[ 2 data-map-compiler-bug-test byte-array>float-array ] [ 2 data-map-compiler-bug-test float-array-cast ]
unit-test unit-test

2
extra/grid-meshes/grid-meshes-tests.factor
View File

@ -18,4 +18,4 @@ SPECIALIZED-ARRAY: float
1.0 0.0 0.5 1.0 1.0 0.0 0.5 1.0
1.0 0.0 1.0 1.0 1.0 0.0 1.0 1.0
} }
] [ { 2 2 } vertex-array byte-array>float-array ] unit-test ] [ { 2 2 } vertex-array float-array-cast ] unit-test

2
extra/noise/noise.factor
View File

@ -124,7 +124,7 @@ MEMO: perlin-noise-map-coords ( dim -- coords )
TYPED:: perlin-noise-map ( table: byte-array transform: matrix4 coords: float-4-array -- map: float-array ) 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 ) coords [| coord | table transform coord m4.v perlin-noise ] data-map( float-4 -- c:float )
byte-array>float-array ; float-array-cast ;
: perlin-noise-image ( table transform dim -- image ) : perlin-noise-image ( table transform dim -- image )
[ perlin-noise-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ; [ perlin-noise-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ;