From a8098e31821f6229306e84da859f40d06e2e4091 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 May 2010 23:09:34 -0400 Subject: [PATCH] specialized-arrays: rename byte-array>T-array to T-array-cast, and make it work with anything that responds to >c-ptr / byte-length --- basis/checksums/md5/md5.factor | 8 ++--- basis/images/bitmap/bitmap.factor | 4 +-- .../images/normalization/normalization.factor | 6 ++-- basis/io/ports/ports-tests.factor | 2 +- .../vectors/simd/intrinsics/intrinsics.factor | 20 +++++------ basis/random/sfmt/sfmt.factor | 2 +- .../specialized-arrays-docs.factor | 2 +- .../specialized-arrays-tests.factor | 4 +-- .../specialized-arrays.factor | 35 +++++++++---------- basis/ui/backend/windows/windows.factor | 2 +- extra/alien/data/map/map-tests.factor | 8 ++--- extra/grid-meshes/grid-meshes-tests.factor | 2 +- extra/noise/noise.factor | 2 +- 13 files changed, 47 insertions(+), 50 deletions(-) diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index 63fdb4dee0..f83d0354f6 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -182,10 +182,10 @@ HINTS: (process-md5-block-I) { uint-array md5-state } ; ] each ] unless ; -: byte-array>uint-array-le ( byte-array -- uint-array ) - byte-array>le byte-array>uint-array ; +: uint-array-cast-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 ) underlying>> byte-array>le ; @@ -194,7 +194,7 @@ HINTS: uint-array>byte-array-le uint-array ; 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-G) ] [ (process-md5-block-H) ] diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index aa500e53fb..424efb993a 100644 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -281,7 +281,7 @@ ERROR: bmp-not-supported n ; { 24 [ color-index>> ] } { 16 [ [ - ! byte-array>ushort-array + ! ushort-array-cast 2 group [ le> ] map ! 5 6 5 ! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield @@ -312,7 +312,7 @@ M: unsupported-bitfield-widths summary dup header>> bit-count>> { { 16 [ dup bitfields>> '[ - byte-array>ushort-array _ uncompress-bitfield + ushort-array-cast _ uncompress-bitfield ] change-color-index ] } { 32 [ ] } diff --git a/basis/images/normalization/normalization.factor b/basis/images/normalization/normalization.factor index a73de4f7b8..aa85057ee9 100644 --- a/basis/images/normalization/normalization.factor +++ b/basis/images/normalization/normalization.factor @@ -47,13 +47,13 @@ GENERIC: normalize-component-type* ( image component-type -- image ) [ 255.0 * >integer ] B{ } map-as ; 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* - drop byte-array>half-array normalize-floats ; + drop half-array-cast normalize-floats ; : 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* drop ushorts>ubytes ; diff --git a/basis/io/ports/ports-tests.factor b/basis/io/ports/ports-tests.factor index c7af6909e1..d2fb5764ff 100644 --- a/basis/io/ports/ports-tests.factor +++ b/basis/io/ports/ports-tests.factor @@ -18,7 +18,7 @@ IN: io.ports.tests [ t ] [ "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 ] unit-test diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index c7d650e1e6..121293f45e 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -45,16 +45,16 @@ IN: math.vectors.simd.intrinsics : [byte>rep-array] ( rep -- class ) { - { char-16-rep [ [ byte-array>char-array ] ] } - { uchar-16-rep [ [ byte-array>uchar-array ] ] } - { short-8-rep [ [ byte-array>short-array ] ] } - { ushort-8-rep [ [ byte-array>ushort-array ] ] } - { int-4-rep [ [ byte-array>int-array ] ] } - { uint-4-rep [ [ byte-array>uint-array ] ] } - { longlong-2-rep [ [ byte-array>longlong-array ] ] } - { ulonglong-2-rep [ [ byte-array>ulonglong-array ] ] } - { float-4-rep [ [ byte-array>float-array ] ] } - { double-2-rep [ [ byte-array>double-array ] ] } + { char-16-rep [ [ char-array-cast ] ] } + { uchar-16-rep [ [ uchar-array-cast ] ] } + { short-8-rep [ [ short-array-cast ] ] } + { ushort-8-rep [ [ ushort-array-cast ] ] } + { int-4-rep [ [ int-array-cast ] ] } + { uint-4-rep [ [ uint-array-cast ] ] } + { longlong-2-rep [ [ longlong-array-cast ] ] } + { ulonglong-2-rep [ [ ulonglong-array-cast ] ] } + { float-4-rep [ [ float-array-cast ] ] } + { double-2-rep [ [ double-array-cast ] ] } } case ; foldable : [>rep-array] ( rep -- class ) diff --git a/basis/random/sfmt/sfmt.factor b/basis/random/sfmt/sfmt.factor index 7a80cda062..ccccaac7ea 100644 --- a/basis/random/sfmt/sfmt.factor +++ b/basis/random/sfmt/sfmt.factor @@ -118,7 +118,7 @@ M:: sfmt generate ( sfmt -- ) state-multiplier * 32 bits ] dip + 32 bits ] uint-array{ } accumulate-as nip - dup underlying>> byte-array>uint-4-array ; + dup uint-4-array-cast ; : ( seed n m mask parity -- sfmt ) sfmt-state diff --git a/basis/specialized-arrays/specialized-arrays-docs.factor b/basis/specialized-arrays/specialized-arrays-docs.factor index 68ce02e71e..fd1a4a72f2 100644 --- a/basis/specialized-arrays/specialized-arrays-docs.factor +++ b/basis/specialized-arrays/specialized-arrays-docs.factor @@ -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 "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 "" } { "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{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } } } diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index ad1b4ad2b7..3a34b3891b 100644 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -27,10 +27,10 @@ SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ; ] unit-test [ 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 -[ B{ 210 4 1 } byte-array>ushort-array ] must-fail +[ B{ 210 4 1 } ushort-array-cast ] must-fail [ { 3 1 3 3 7 } ] [ int-array{ 3 1 3 3 7 } malloc-byte-array 5 >array diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 35448a501c..34854597e1 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -34,19 +34,19 @@ M: not-a-byte-array summary FUNCTOR: define-array ( T -- ) -A DEFINES-CLASS ${T}-array - DEFINES <${A}> -(A) DEFINES (${A}) - DEFINES -malloc-A DEFINES malloc-${A} ->A DEFINES >${A} -byte-array>A DEFINES byte-array>${A} - -A{ DEFINES ${A}{ -A@ DEFINES ${A}@ - -NTH [ T dup c-getter array-accessor ] -SET-NTH [ T dup c-setter array-accessor ] +A DEFINES-CLASS ${T}-array + DEFINES <${A}> +(A) DEFINES (${A}) + DEFINES +malloc-A DEFINES malloc-${A} +>A DEFINES >${A} +A-cast DEFINES ${A}-cast + +A{ DEFINES ${A}{ +A@ DEFINES ${A}@ + +NTH [ T dup c-getter array-accessor ] +SET-NTH [ T dup c-setter array-accessor ] WHERE @@ -65,12 +65,9 @@ TUPLE: A : malloc-A ( len -- specialized-array ) [ \ T heap-size calloc ] keep ; inline -: byte-array>A ( byte-array -- specialized-array ) - >c-ptr dup byte-array? [ - dup length \ T heap-size /mod 0 = - [ ] - [ drop \ T bad-byte-array-length ] if - ] [ not-a-byte-array ] if ; inline +: A-cast ( byte-array -- specialized-array ) + binary-object \ T heap-size /mod 0 = + [ ] [ drop \ T bad-byte-array-length ] bi ; inline M: A clone [ underlying>> clone ] [ length>> ] bi ; inline diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 8dae849a1f..00fdb907fd 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -797,7 +797,7 @@ M: windows-ui-backend system-alert : client-area>RECT ( hwnd -- RECT ) RECT [ 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 ; : hwnd>RECT ( hwnd -- RECT ) diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor index 305ae6bdf2..67e7b5f22e 100644 --- a/extra/alien/data/map/map-tests.factor +++ b/extra/alien/data/map/map-tests.factor @@ -9,7 +9,7 @@ IN: alien.data.map.tests [ 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] ) - byte-array>float-array + float-array-cast ] unit-test [ @@ -20,7 +20,7 @@ IN: alien.data.map.tests } ] [ 3 iota [ float-4-with ] data-map( object -- float-4 ) - byte-array>float-4-array + float-4-array-cast ] unit-test [ @@ -31,7 +31,7 @@ IN: alien.data.map.tests } ] [ 12 iota [ float-4-boa ] data-map( object[4] -- float-4 ) - byte-array>float-4-array + float-4-array-cast ] unit-test [ 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 ) ; [ 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 diff --git a/extra/grid-meshes/grid-meshes-tests.factor b/extra/grid-meshes/grid-meshes-tests.factor index ef71a669ed..0b6275dba0 100644 --- a/extra/grid-meshes/grid-meshes-tests.factor +++ b/extra/grid-meshes/grid-meshes-tests.factor @@ -18,4 +18,4 @@ SPECIALIZED-ARRAY: float 1.0 0.0 0.5 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 diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index 9204fa55f1..9417a868a0 100644 --- a/extra/noise/noise.factor +++ b/extra/noise/noise.factor @@ -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 ) 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-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ;