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

specialized-arrays: performed some cleanup. 

Specifically,
    •   Created >c-array to be replacement for >T-array.
    •   Created cast-array to be generic replacement for all T-array-cast words.
    •   Created c-array@ to be generic replacement for T-array@ words.
    •   Replaced usages of <T-array> with T <c-array>
    •   Replaced usages of <direct-T-array> with T <c-direct-array>
    •   Replaced usages of >T-array with T >c-array
    •   Replaced usages of T-array-cast with T cast-array
    •   Replaced usages of malloc-T-array with T malloc-array.
    •   Removed malloc-T-array.
    •   Removed T-array-cast.
    •   Removed T-array@.
    •   Removed >T-array.

I also added (but didn't change any code to use):
    •   T c-array-type, returns T-array
    •   T c-array?, returns T-array?
    •   c-array{ T ... }, returns T-array{ ... }

Bootstraps just find on Mac OS X.  Also `load-all test-all` works for me.
John Benediktsson 2011-09-25 11:49:27 -07:00
parent 322e3ba109
commit 0e3d598e69
86 changed files with 398 additions and 351 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
basis/alien/data/data-docs.factor
View File

@ -4,18 +4,35 @@ alien.strings sequences io.encodings.string debugger destructors
vocabs.loader classes.struct quotations kernel ;
IN: alien.data
HELP: >c-array
{ $values { "seq" sequence } { "c-type" "a C type" } { "array" byte-array } }
{ $description "Outputs a freshly allocated byte-array whose elements are C type values from the given sequence." }
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
HELP: <c-array>
{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } }
{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
HELP: c-array{
{ $description "Literal syntax, consists of a C-type followed by a series of values terminated by " { $snippet "}" } }
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
HELP: memory>byte-array
{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
HELP: cast-array
{ $values { "byte-array" byte-array } { "c-type" "a C type" } { "array" "a specialized array" } }
{ $description "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" }
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
HELP: malloc-array
{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" "a specialized array" } }
{ $values { "n" "a non-negative integer" } { "c-type" "a C type" } { "array" "a specialized array" } }
{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-direct-array> } "." }
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }

47
basis/alien/data/data.factor
View File

@ -1,9 +1,9 @@
! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
USING: accessors alien alien.c-types alien.arrays alien.strings
arrays byte-arrays cpu.architecture fry io io.encodings.binary
io.files io.streams.memory kernel libc math math.functions
sequences words macros combinators generalizations
stack-checker.dependencies combinators.short-circuit ;
USING: accessors alien alien.arrays alien.c-types alien.strings
arrays byte-arrays combinators combinators.short-circuit
cpu.architecture fry generalizations io io.streams.memory kernel
libc macros math math.functions parser sequences
stack-checker.dependencies summary words ;
QUALIFIED: math
IN: alien.data
@ -22,6 +22,26 @@ GENERIC: c-(array)-constructor ( c-type -- word ) foldable
GENERIC: c-direct-array-constructor ( c-type -- word ) foldable
GENERIC: c-array-type ( c-type -- word ) foldable
GENERIC: c-array-type? ( c-type -- word ) foldable
GENERIC: c-array? ( obj c-type -- ? ) foldable
M: word c-array?
c-array-type? execute( seq -- array ) ; inline
M: pointer c-array?
drop void* c-array? ;
GENERIC: >c-array ( seq c-type -- array )
M: word >c-array
c-array-type new clone-like ;
M: pointer >c-array
drop void* >c-array ;
GENERIC: <c-array> ( len c-type -- array )
M: word <c-array>
@ -46,7 +66,22 @@ M: word <c-direct-array>
M: pointer <c-direct-array>
drop void* <c-direct-array> ;
: malloc-array ( n type -- array )
SYNTAX: c-array{ \ } [ unclip >c-array ] parse-literal ;
SYNTAX: c-array@
scan-object [ scan-object scan-object ] dip
<c-direct-array> suffix! ;
ERROR: bad-byte-array-length byte-array type ;
M: bad-byte-array-length summary
drop "Byte array length doesn't divide type width" ;
: cast-array ( byte-array c-type -- array )
[ binary-object ] dip [ heap-size /mod 0 = ] keep swap
[ <c-direct-array> ] [ bad-byte-array-length ] if ; inline
: malloc-array ( n c-type -- array )
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
: malloc-byte-array ( byte-array -- alien )

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

@ -184,7 +184,7 @@ HINTS: (process-md5-block-I) { uint-array md5-state } ;
] unless ;
: uint-array-cast-le ( byte-array -- uint-array )
byte-array>le uint-array-cast ;
byte-array>le uint cast-array ;
HINTS: uint-array-cast-le byte-array ;

4
basis/classes/struct/struct-docs.factor
View File

@ -121,11 +121,11 @@ ARTICLE: "classes.struct.examples" "Struct class examples"
{ $code "test-struct <struct> ." }
"Creating a new instance with slots initialized from the stack:"
{ $code
"USING: libc specialized-arrays ;"
"USING: libc specialized-arrays alien.data ;"
"SPECIALIZED-ARRAY: char"
""
"42"
"\"Hello, chicken.\" >char-array"
"\"Hello, chicken.\" char >c-array"
"1024 malloc"
"test-struct <struct-boa> ."
} ;

6
basis/classes/struct/struct-tests.factor
View File

@ -305,7 +305,7 @@ SPECIALIZED-ARRAY: struct-test-optimization
[ t ] [
[ struct-test-optimization memory>struct x>> second ]
{ memory>struct x>> <direct-int-array> <tuple> <tuple-boa> } inlined?
{ memory>struct x>> int <c-direct-array> <tuple> <tuple-boa> } inlined?
] unit-test
[ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
@ -328,7 +328,7 @@ STRUCT: clone-test-struct { x int } { y char[3] } ;
clone-test-struct <struct>
1 >>x char-array{ 9 1 1 } >>y
clone
[ x>> ] [ y>> >char-array ] bi
[ x>> ] [ y>> char >c-array ] bi
] unit-test
[ t 1 char-array{ 9 1 1 } ] [
@ -336,7 +336,7 @@ STRUCT: clone-test-struct { x int } { y char[3] } ;
clone-test-struct malloc-struct &free
1 >>x char-array{ 9 1 1 } >>y
clone
[ >c-ptr byte-array? ] [ x>> ] [ y>> >char-array ] tri
[ >c-ptr byte-array? ] [ x>> ] [ y>> char >c-array ] tri
] with-destructors
] unit-test

4
basis/classes/struct/struct.factor
View File

@ -64,7 +64,7 @@ M: struct equal?
M: struct hashcode*
binary-object over
[ <direct-uchar-array> hashcode* ] [ 3drop 0 ] if ; inline
[ uchar <c-direct-array> hashcode* ] [ 3drop 0 ] if ; inline
: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
@ -244,7 +244,7 @@ M: struct-bit-slot-spec compute-slot-offset
PRIVATE>
M: struct byte-length class "struct-size" word-prop ; foldable
M: struct binary-zero? binary-object <direct-uchar-array> [ 0 = ] all? ; inline
M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inline
! class definition

2
basis/cocoa/messages/messages.factor
View File

@ -218,7 +218,7 @@ ERROR: no-objc-type name ;
: each-method-in-class ( class quot -- )
[ { uint } [ class_copyMethodList ] with-out-parameters ] dip
over 0 = [ 3drop ] [
[ <direct-void*-array> ] dip
[ void* <c-direct-array> ] dip
[ each ] [ drop (free) ] 2bi
] if ; inline

4
basis/compiler/tests/alien.factor
View File

@ -227,8 +227,8 @@ FUNCTION: int ffi_test_12 int a int b RECT c int d int e int f ;
FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
[ 32.0 ] [
{ 1.0 2.0 3.0 } >float-array
{ 4.0 5.0 6.0 } >float-array
{ 1.0 2.0 3.0 } float >c-array
{ 4.0 5.0 6.0 } float >c-array
ffi_test_23
] unit-test

6
basis/core-foundation/dictionaries/dictionaries.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax core-foundation kernel assocs
specialized-arrays math sequences accessors ;
USING: alien.c-types alien.data alien.syntax core-foundation
kernel assocs specialized-arrays math sequences accessors ;
IN: core-foundation.dictionaries
SPECIALIZED-ARRAY: void*
@ -27,7 +27,7 @@ FUNCTION: void* CFDictionaryGetValue (
: <CFDictionary> ( alist -- dictionary )
[ kCFAllocatorDefault ] dip
unzip [ >void*-array ] bi@
unzip [ void* >c-array ] bi@
[ [ underlying>> ] bi@ ] [ nip length ] 2bi
&: kCFTypeDictionaryKeyCallBacks
&: kCFTypeDictionaryValueCallBacks

10
basis/core-foundation/fsevents/fsevents.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax kernel
math sequences namespaces make assocs init accessors
USING: alien alien.c-types alien.data alien.strings alien.syntax
kernel math sequences namespaces make assocs init accessors
continuations combinators io.encodings.utf8 destructors locals
arrays specialized-arrays classes.struct core-foundation
core-foundation.arrays core-foundation.run-loop
@ -165,9 +165,9 @@ SYMBOL: event-stream-callbacks
event-stream-callbacks get delete-at ;
:: (master-event-source-callback) ( eventStream info numEvents eventPaths eventFlags eventIds -- )
eventPaths numEvents <direct-void*-array> [ utf8 alien>string ] { } map-as
eventFlags numEvents <direct-int-array>
eventIds numEvents <direct-longlong-array>
eventPaths numEvents void* <c-direct-array> [ utf8 alien>string ] { } map-as
eventFlags numEvents int <c-direct-array>
eventIds numEvents longlong <c-direct-array>
3array flip
info event-stream-callbacks get at [ drop ] or call( changes -- ) ;

2
basis/db/postgresql/lib/lib.factor
View File

@ -93,7 +93,7 @@ M: postgresql-result-null summary ( obj -- str )
] 2map flip [
f f
] [
first2 [ >void*-array ] [ >uint-array ] bi*
first2 [ void* >c-array ] [ uint >c-array ] bi*
] if-empty ;
: param-formats ( statement -- seq )

2
basis/game/input/dinput/dinput.factor
View File

@ -75,7 +75,7 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
GUID_SysMouse device-for-guid
[ configure-mouse ] [ +mouse-device+ set-global ] bi
0 0 0 0 8 f <array> mouse-state boa +mouse-state+ set-global
MOUSE-BUFFER-SIZE <DIDEVICEOBJECTDATA-array> +mouse-buffer+ set-global ;
MOUSE-BUFFER-SIZE DIDEVICEOBJECTDATA <c-array> +mouse-buffer+ set-global ;
: device-info ( device -- DIDEVICEIMAGEINFOW )
DIDEVICEINSTANCEW <struct>

2
basis/images/gtk/gtk.factor
View File

@ -38,7 +38,7 @@ os { linux freebsd netbsd openbsd } member? [
bytes-per-row rowstride =
[ pixels h rowstride * memory>byte-array ]
[
pixels rowstride h * <direct-uchar-array>
pixels rowstride h * uchar <c-direct-array>
rowstride <sliced-groups>
[ bytes-per-row head-slice ] map concat
] if

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

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman, Keith Lazuka
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types byte-arrays combinators fry
grouping images kernel locals math math.vectors
USING: accessors alien.c-types alien.data byte-arrays
combinators fry grouping images kernel locals math math.vectors
sequences specialized-arrays math.floats.half ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: half
@ -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 float-array-cast normalize-floats ;
drop float cast-array normalize-floats ;
M: half-components normalize-component-type*
drop half-array-cast normalize-floats ;
drop half cast-array normalize-floats ;
: ushorts>ubytes ( bitmap -- bitmap' )
ushort-array-cast [ -8 shift ] B{ } map-as ; inline
ushort cast-array [ -8 shift ] B{ } map-as ; inline
M: ushort-components normalize-component-type*
drop ushorts>ubytes ;

6
basis/io/backend/unix/multiplexers/kqueue/kqueue.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types combinators destructors
io.backend.unix kernel math.bitwise sequences
USING: accessors alien.c-types alien.data combinators
destructors io.backend.unix kernel math.bitwise sequences
specialized-arrays unix unix.kqueue unix.time assocs
io.backend.unix.multiplexers classes.struct literals ;
SPECIALIZED-ARRAY: kevent
@ -16,7 +16,7 @@ CONSTANT: max-events 256
: <kqueue-mx> ( -- mx )
kqueue-mx new-mx
kqueue dup io-error >>fd
max-events <kevent-array> >>events ;
max-events \ kevent <c-array> >>events ;
M: kqueue-mx dispose* fd>> close-file ;

6
basis/io/files/info/unix/freebsd/freebsd.factor
View File

@ -4,8 +4,8 @@ USING: accessors alien alien.c-types alien.syntax combinators
io.backend io.files io.files.info io.files.unix kernel math system unix
unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd
sequences grouping alien.strings io.encodings.utf8 unix.types
arrays io.files.info.unix classes.struct
specialized-arrays ;
arrays io.files.info.unix classes.struct specialized-arrays
alien.data ;
SPECIALIZED-ARRAY: statfs
IN: io.files.info.unix.freebsd
@ -52,6 +52,6 @@ M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
<statfs-array>
\ statfs <c-array>
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;

2
basis/io/files/info/unix/macosx/macosx.factor
View File

@ -14,7 +14,7 @@ io-size owner type-id filesystem-subtype ;
M: macosx file-systems ( -- array )
f void* <ref> dup 0 getmntinfo64 dup io-error
[ void* deref ] dip <direct-statfs64-array>
[ void* deref ] dip \ statfs64 <c-direct-array>
[ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ;
M: macosx new-file-system-info macosx-file-system-info new ;

4
basis/io/files/info/unix/netbsd/netbsd.factor
View File

@ -4,7 +4,7 @@ USING: alien alien.syntax kernel unix.stat math unix
combinators system io.backend accessors alien.c-types
io.encodings.utf8 alien.strings unix.types io.files.unix
io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays
grouping sequences io.encodings.utf8 classes.struct
grouping sequences io.encodings.utf8 classes.struct alien.data
specialized-arrays io.files.info.unix ;
SPECIALIZED-ARRAY: statvfs
IN: io.files.info.unix.netbsd
@ -48,6 +48,6 @@ M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-inf
M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error
<statvfs-array>
\ statvfs <c-array>
[ dup byte-length 0 getvfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;

4
basis/io/files/info/unix/openbsd/openbsd.factor
View File

@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.strings alien.syntax
combinators io.backend io.files io.files.info io.files.unix kernel math
sequences system unix unix.getfsstat.openbsd grouping
unix.statfs.openbsd unix.statvfs.openbsd unix.types
arrays io.files.info.unix classes.struct
arrays io.files.info.unix classes.struct alien.data
specialized-arrays io.encodings.utf8 ;
SPECIALIZED-ARRAY: statfs
IN: io.files.unix.openbsd
@ -49,6 +49,6 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
<statfs-array>
\ statfs <c-array>
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;

14
basis/io/files/info/unix/unix.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays calendar calendar.unix
classes.struct combinators combinators.short-circuit io.backend
io.directories io.files.info io.files.types kernel literals
math math.bitwise sequences specialized-arrays strings system
unix unix.ffi unix.groups unix.stat unix.time unix.users
vocabs.loader ;
USING: accessors alien.c-types alien.data arrays calendar
calendar.unix classes.struct combinators
combinators.short-circuit io.backend io.directories
io.files.info io.files.types kernel literals math math.bitwise
sequences specialized-arrays strings system unix unix.ffi
unix.groups unix.stat unix.time unix.users vocabs.loader ;
IN: io.files.info.unix
SPECIALIZED-ARRAY: timeval
@ -195,7 +195,7 @@ M: unix copy-file-and-info ( from to -- )
: timestamps>byte-array ( timestamps -- byte-array )
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
>timeval-array ;
timeval >c-array ;
PRIVATE>

2
basis/io/files/windows/windows.factor
View File

@ -297,7 +297,7 @@ SYMBOLS: +read-only+ +hidden+ +system+
SetFileTime win32-error=0/f ;
M: windows cwd
MAX_UNICODE_PATH dup <ushort-array>
MAX_UNICODE_PATH dup ushort <c-array>
[ GetCurrentDirectory win32-error=0/f ] keep
utf16n alien>string ;

4
basis/io/pipes/unix/unix.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types system kernel unix math sequences
USING: alien.c-types alien.data system kernel unix math sequences
io.backend.unix io.ports specialized-arrays accessors unix.ffi ;
QUALIFIED: io.pipes
SPECIALIZED-ARRAY: int
IN: io.pipes.unix
M: unix io.pipes:(pipe) ( -- pair )
2 <int-array>
2 int <c-array>
[ pipe io-error ]
[ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;

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

@ -1,6 +1,6 @@
USING: destructors io io.directories io.encodings.binary
io.files io.files.temp kernel libc math sequences
specialized-arrays.instances.alien.c-types.int tools.test ;
USING: alien.c-types alien.data destructors io io.directories
io.encodings.binary io.files io.files.temp kernel libc math
sequences tools.test ;
IN: io.ports.tests
! Make sure that writing malloced storage to a file works, and
@ -11,14 +11,14 @@ IN: io.ports.tests
[
100,000 iota
0
100,000 malloc-int-array &free [ copy ] keep write
100,000 int malloc-array &free [ copy ] keep write
] with-destructors
] with-file-writer
] unit-test
[ t ] [
"test.txt" temp-file binary [
100,000 4 * read int-array-cast 100,000 iota sequence=
100,000 4 * read int cast-array 100,000 iota sequence=
] with-file-reader
] unit-test

6
basis/io/ports/ports.factor
View File

@ -3,8 +3,8 @@
USING: math kernel io sequences io.buffers io.timeouts generic
byte-vectors system io.encodings math.order io.backend
continuations classes byte-arrays namespaces splitting grouping
dlists alien alien.c-types assocs io.encodings.binary summary
accessors destructors combinators fry specialized-arrays
dlists alien alien.c-types alien.data assocs io.encodings.binary
summary accessors destructors combinators fry specialized-arrays
locals ;
SPECIALIZED-ARRAY: uchar
IN: io.ports
@ -120,7 +120,7 @@ M: output-port stream-write1
buffer>> byte>buffer ; inline
: write-in-groups ( byte-array port -- )
[ binary-object <direct-uchar-array> ] dip
[ binary-object uchar <c-direct-array> ] dip
[ buffer>> size>> <sliced-groups> ] [ '[ _ stream-write ] ] bi
each ;

4
basis/math/bitwise/bitwise-tests.factor
View File

@ -1,5 +1,5 @@
USING: accessors math math.bitwise tools.test kernel words
specialized-arrays alien.c-types math.vectors.simd
specialized-arrays alien.c-types alien.data math.vectors.simd
sequences destructors libc literals classes.struct ;
SPECIALIZED-ARRAY: int
IN: math.bitwise.tests
@ -44,7 +44,7 @@ SPECIALIZED-ARRAY: uint-4
[ 1 ] [
[
2 malloc-int-array &free 1 0 pick set-nth bit-count
2 int malloc-array &free 1 0 pick set-nth bit-count
] with-destructors
] unit-test

2
basis/math/floats/half/half-tests.factor
View File

@ -45,5 +45,5 @@ STRUCT: halves
] unit-test
[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ]
[ { 1.0 2.0 3.0 1/0. -1/0. } >half-array ] unit-test
[ { 1.0 2.0 3.0 1/0. -1/0. } half >c-array ] unit-test

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

@ -60,44 +60,44 @@ SYNTAX: SIMD-INTRINSIC::
: [byte>rep-array] ( rep -- class )
{
{ char-16-rep [ [ 16 <direct-char-array> ] ] }
{ uchar-16-rep [ [ 16 <direct-uchar-array> ] ] }
{ short-8-rep [ [ 8 <direct-short-array> ] ] }
{ ushort-8-rep [ [ 8 <direct-ushort-array> ] ] }
{ int-4-rep [ [ 4 <direct-int-array> ] ] }
{ uint-4-rep [ [ 4 <direct-uint-array> ] ] }
{ longlong-2-rep [ [ 2 <direct-longlong-array> ] ] }
{ ulonglong-2-rep [ [ 2 <direct-ulonglong-array> ] ] }
{ float-4-rep [ [ 4 <direct-float-array> ] ] }
{ double-2-rep [ [ 2 <direct-double-array> ] ] }
{ char-16-rep [ [ 16 c:char <c-direct-array> ] ] }
{ uchar-16-rep [ [ 16 c:uchar <c-direct-array> ] ] }
{ short-8-rep [ [ 8 c:short <c-direct-array> ] ] }
{ ushort-8-rep [ [ 8 c:ushort <c-direct-array> ] ] }
{ int-4-rep [ [ 4 c:int <c-direct-array> ] ] }
{ uint-4-rep [ [ 4 c:uint <c-direct-array> ] ] }
{ longlong-2-rep [ [ 2 c:longlong <c-direct-array> ] ] }
{ ulonglong-2-rep [ [ 2 c:ulonglong <c-direct-array> ] ] }
{ float-4-rep [ [ 4 c:float <c-direct-array> ] ] }
{ double-2-rep [ [ 2 c:double <c-direct-array> ] ] }
} case ; foldable
: [>rep-array] ( rep -- class )
{
{ char-16-rep [ [ >char-array ] ] }
{ uchar-16-rep [ [ >uchar-array ] ] }
{ short-8-rep [ [ >short-array ] ] }
{ ushort-8-rep [ [ >ushort-array ] ] }
{ int-4-rep [ [ >int-array ] ] }
{ uint-4-rep [ [ >uint-array ] ] }
{ longlong-2-rep [ [ >longlong-array ] ] }
{ ulonglong-2-rep [ [ >ulonglong-array ] ] }
{ float-4-rep [ [ >float-array ] ] }
{ double-2-rep [ [ >double-array ] ] }
{ char-16-rep [ [ c:char >c-array ] ] }
{ uchar-16-rep [ [ c:uchar >c-array ] ] }
{ short-8-rep [ [ c:short >c-array ] ] }
{ ushort-8-rep [ [ c:ushort >c-array ] ] }
{ int-4-rep [ [ c:int >c-array ] ] }
{ uint-4-rep [ [ c:uint >c-array ] ] }
{ longlong-2-rep [ [ c:longlong >c-array ] ] }
{ ulonglong-2-rep [ [ c:ulonglong >c-array ] ] }
{ float-4-rep [ [ c:float >c-array ] ] }
{ double-2-rep [ [ c:double >c-array ] ] }
} case ; foldable
: [<rep-array>] ( rep -- class )
{
{ char-16-rep [ [ 16 (char-array) ] ] }
{ uchar-16-rep [ [ 16 (uchar-array) ] ] }
{ short-8-rep [ [ 8 (short-array) ] ] }
{ ushort-8-rep [ [ 8 (ushort-array) ] ] }
{ int-4-rep [ [ 4 (int-array) ] ] }
{ uint-4-rep [ [ 4 (uint-array) ] ] }
{ longlong-2-rep [ [ 2 (longlong-array) ] ] }
{ ulonglong-2-rep [ [ 2 (ulonglong-array) ] ] }
{ float-4-rep [ [ 4 (float-array) ] ] }
{ double-2-rep [ [ 2 (double-array) ] ] }
{ char-16-rep [ [ 16 c:char (c-array) ] ] }
{ uchar-16-rep [ [ 16 c:uchar (c-array) ] ] }
{ short-8-rep [ [ 8 c:short (c-array) ] ] }
{ ushort-8-rep [ [ 8 c:ushort (c-array) ] ] }
{ int-4-rep [ [ 4 c:int (c-array) ] ] }
{ uint-4-rep [ [ 4 c:uint (c-array) ] ] }
{ longlong-2-rep [ [ 2 c:longlong (c-array) ] ] }
{ ulonglong-2-rep [ [ 2 c:ulonglong (c-array) ] ] }
{ float-4-rep [ [ 4 c:float (c-array) ] ] }
{ double-2-rep [ [ 2 c:double (c-array) ] ] }
} case ; foldable
: rep-tf-values ( rep -- t f )

2
basis/opengl/opengl.factor
View File

@ -183,7 +183,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
glActiveTexture swap glBindTexture gl-error ;
: (set-draw-buffers) ( buffers -- )
[ length ] [ >uint-array ] bi glDrawBuffers ;
[ length ] [ uint >c-array ] bi glDrawBuffers ;
MACRO: set-draw-buffers ( buffers -- )
words>values '[ _ (set-draw-buffers) ] ;

2
basis/opengl/shaders/shaders.factor
View File

@ -108,7 +108,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
: gl-program-shaders ( program -- shaders )
dup gl-program-shaders-length 2 *
0 int <ref>
over <uint-array>
over uint <c-array>
[ glGetAttachedShaders ] keep [ zero? not ] filter ;
: delete-gl-program-only ( program -- )

4
basis/random/mersenne-twister/mersenne-twister.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
! mersenne twister based on
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
USING: alien.c-types kernel math namespaces sequences
USING: alien.c-types alien.data kernel math namespaces sequences
sequences.private system init accessors math.ranges random
math.bitwise combinators specialized-arrays fry ;
SPECIALIZED-ARRAY: uint
@ -44,7 +44,7 @@ CONSTANT: a uint-array{ 0 HEX: 9908b0df }
] each-integer ; inline
: init-mt-seq ( seed -- seq )
32 bits n <uint-array>
32 bits n uint <c-array>
[ set-first ] [ init-mt-rest ] [ ] tri ; inline
: mt-temper ( y -- yt )

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

@ -112,14 +112,14 @@ M:: sfmt generate ( sfmt -- )
: <sfmt-array> ( sfmt -- uint-array uint-4-array )
state>>
[ n>> 4 * [1,b] >uint-array ] [ seed>> ] bi
[ n>> 4 * [1,b] uint >c-array ] [ seed>> ] bi
[
[
[ -30 shift ] [ ] bi bitxor
state-multiplier * 32 bits
] dip + 32 bits
] uint-array{ } accumulate-as nip
dup uint-4-array-cast ;
dup uint-4 cast-array ;
: <sfmt-state> ( seed n m mask parity -- sfmt )
sfmt-state <struct>

8
basis/specialized-arrays/prettyprint/prettyprint.factor
View File

@ -1,13 +1,15 @@
! Copyright (C) 2009 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel prettyprint.backend
USING: accessors alien.data kernel prettyprint.backend
prettyprint.sections prettyprint.custom
specialized-arrays ;
IN: specialized-arrays.prettyprint
: pprint-direct-array ( direct-array -- )
dup direct-array-syntax
[ [ underlying>> ] [ length>> ] bi [ pprint* ] bi@ ] pprint-prefix ;
\ c-array@ [
[ underlying-type ] [ underlying>> ] [ length>> ] tri
[ pprint* ] tri@
] pprint-prefix ;
M: specialized-array pprint*
[ pprint-object ] [ pprint-direct-array ] pprint-c-object ;

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

@ -41,10 +41,7 @@ ARTICLE: "specialized-array-words" "Specialized array words"
{ { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } }
{ { $snippet "<T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; 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, zeroed out, unmanaged memory; stack effect " { $snippet "( 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 "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 "}" } } }
}
"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-arrays.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-ARRAY: } " or " { $link POSTPONE: SPECIALIZED-ARRAYS: } ". This ensures that the vocabulary can get generated the first time it is needed."
@ -70,7 +67,7 @@ $nl
"FUNCTION: void process_data ( int* data, int len ) ;"
"int-array{ 10 20 30 } dup length process_data"
}
"Literal specialized arrays, as well as specialized arrays created with " { $snippet "<T-array>" } " and " { $snippet ">T-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead."
"Literal specialized arrays, as well as specialized arrays created with " { $snippet "<T-array>" } " and " { $snippet "T >c-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead."
$nl
"In the following example, it is presumed that the C library holds on to a pointer to the array's data after the " { $snippet "init_with_data()" } " call returns; this is one situation where unmanaged memory has to be used instead. Note the use of destructors to ensure the memory is deallocated after the block ends:"
{ $code

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

@ -13,28 +13,28 @@ IN: specialized-arrays.tests
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
[ t ] [ { 1 2 3 } int >c-array int-array? ] unit-test
[ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
[ 2 ] [ int-array{ 1 2 3 } second ] unit-test
[ t ] [
{ t f t } >bool-array underlying>>
{ t f t } bool >c-array underlying>>
{ 1 0 1 } bool heap-size {
{ 1 [ >char-array ] }
{ 4 [ >uint-array ] }
{ 1 [ char >c-array ] }
{ 4 [ uint >c-array ] }
} case underlying>> =
] unit-test
[ ushort-array{ 1234 } ] [
little-endian? B{ 210 4 } B{ 4 210 } ? ushort-array-cast
little-endian? B{ 210 4 } B{ 4 210 } ? ushort cast-array
] unit-test
[ B{ 210 4 1 } ushort-array-cast ] must-fail
[ B{ 210 4 1 } ushort cast-array ] must-fail
[ { 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 int <c-direct-array> >array
] unit-test
[ float-array{ HEX: 1.222,222 HEX: 1.111,112 } ]
@ -130,7 +130,7 @@ SPECIALIZED-ARRAY: fixed-string
! Test prettyprinting
[ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
[ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
[ "c-array@ int f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
! If the C type doesn't exist, don't generate a vocab
SYMBOL: __does_not_exist__

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

@ -12,24 +12,25 @@ MIXIN: specialized-array
INSTANCE: specialized-array sequence
GENERIC: direct-array-syntax ( obj -- word )
ERROR: bad-byte-array-length byte-array type ;
M: bad-byte-array-length summary
drop "Byte array length doesn't divide type width" ;
ERROR: not-a-byte-array alien ;
M: not-a-byte-array summary
drop "Not a byte array" ;
: (underlying) ( n c-type -- array )
heap-size * (byte-array) ; inline
: <underlying> ( n type -- array )
heap-size * <byte-array> ; inline
GENERIC: underlying-type ( c-type -- c-type' )
M: c-type-word underlying-type
dup "c-type" word-prop {
{ [ dup not ] [ drop no-c-type ] }
{ [ dup pointer? ] [ 2drop void* ] }
{ [ dup c-type-word? ] [ nip underlying-type ] }
[ drop ]
} cond ;
M: pointer underlying-type
drop void* ;
<PRIVATE
GENERIC: nth-c-ptr ( n seq -- displaced-alien )
@ -42,7 +43,6 @@ A DEFINES-CLASS ${T}-array
(A) DEFINES (${A})
<direct-A> DEFINES <direct-${A}>
malloc-A DEFINES malloc-${A}
>A DEFINES >${A}
A-cast DEFINES ${A}-cast
A{ DEFINES ${A}{
A@ DEFINES ${A}@
@ -63,13 +63,6 @@ M: A direct-like drop <direct-A> ; inline
: (A) ( n -- specialized-array )
[ \ T (underlying) ] keep <direct-A> ; inline
: malloc-A ( len -- specialized-array )
[ \ T heap-size calloc ] keep <direct-A> ; inline
: A-cast ( byte-array -- specialized-array )
binary-object \ T heap-size /mod 0 =
[ <direct-A> ] [ drop \ T bad-byte-array-length ] if ; inline
M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
M: A length length>> ; inline
@ -80,9 +73,7 @@ M: A nth-c-ptr underlying>> \ T array-accessor drop swap <displaced-alien> ; inl
M: A set-nth-unsafe underlying>> \ T set-alien-element ; inline
: >A ( seq -- specialized-array ) A new clone-like ;
M: A like drop dup A instance? [ >A ] unless ; inline
M: A like drop dup A instance? [ \ T >c-array ] unless ; inline
M: A new-sequence drop (A) ; inline
@ -97,14 +88,13 @@ M: A resize
M: A element-size drop \ T heap-size ; inline
M: A direct-array-syntax drop \ A@ ;
M: A underlying-type drop \ T ;
M: A pprint-delims drop \ A{ \ } ;
M: A >pprint-sequence ;
SYNTAX: A{ \ } [ >A ] parse-literal ;
SYNTAX: A@ scan-object scan-object <direct-A> suffix! ;
SYNTAX: A{ \ } [ \ T >c-array ] parse-literal ;
INSTANCE: A specialized-array
@ -116,19 +106,6 @@ M: A v*high [ * \ T heap-size neg shift ] 2map ; inline
;FUNCTOR
GENERIC: underlying-type ( c-type -- c-type' )
M: c-type-word underlying-type
dup "c-type" word-prop {
{ [ dup not ] [ drop no-c-type ] }
{ [ dup pointer? ] [ 2drop void* ] }
{ [ dup c-type-word? ] [ nip underlying-type ] }
[ drop ]
} cond ;
M: pointer underlying-type
drop void* ;
: specialized-array-vocab ( c-type -- vocab )
[
"specialized-arrays.instances." %
@ -180,6 +157,20 @@ M: c-type-word c-direct-array-constructor
M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ;
M: c-type-word c-array-type
underlying-type
dup [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
M: pointer c-array-type drop void* c-array-type ;
M: c-type-word c-array-type?
underlying-type
dup [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
M: pointer c-array-type? drop void* c-array-type? ;
SYNTAX: SPECIALIZED-ARRAYS:
";" [ parse-c-type define-array-vocab use-vocab ] each-token ;

11
basis/specialized-vectors/specialized-vectors.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.parser assocs
classes compiler.units functors growable kernel lexer math
namespaces parser prettyprint.custom sequences
USING: accessors alien alien.c-types alien.data alien.parser
assocs classes compiler.units functors growable kernel lexer
math namespaces parser prettyprint.custom sequences
specialized-arrays specialized-arrays.private strings
vocabs vocabs.loader vocabs.parser vocabs.generated fry make ;
FROM: sequences.private => nth-unsafe ;
@ -19,7 +19,6 @@ FUNCTOR: define-vector ( T -- )
V DEFINES-CLASS ${T}-vector
A IS ${T}-array
>A IS >${A}
<A> IS <${A}>
<direct-A> IS <direct-${A}>
@ -48,7 +47,9 @@ M: V nth-c-ptr underlying>> nth-c-ptr ; inline
M: A like
drop dup A instance? [
dup V instance? [ [ >c-ptr ] [ length>> ] bi <direct-A> ] [ >A ] if
dup V instance? [
[ >c-ptr ] [ length>> ] bi <direct-A>
] [ \ T >c-array ] if
] unless ; inline
SYNTAX: V{ \ } [ >V ] parse-literal ;

2
basis/system-info/windows/windows.factor
View File

@ -55,7 +55,7 @@ M: windows os-version ( -- obj )
PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
: get-directory ( word -- str )
[ MAX_UNICODE_PATH [ <ushort-array> ] keep dupd ] dip
[ MAX_UNICODE_PATH [ ushort <c-array> ] keep dupd ] dip
execute win32-error=0/f alien>native-string ; inline
: windows-directory ( -- str )

8
basis/tools/deploy/libraries/windows/windows.factor
View File

@ -1,7 +1,7 @@
! (c)2010 Joe Groff bsd license
USING: alien.strings byte-arrays io.encodings.utf16n kernel
specialized-arrays system tools.deploy.libraries windows.kernel32
windows.types ;
USING: alien.data alien.strings byte-arrays io.encodings.utf16n
kernel specialized-arrays system tools.deploy.libraries
windows.kernel32 windows.types ;
FROM: alien.c-types => ushort ;
SPECIALIZED-ARRAY: ushort
IN: tools.deploy.libraries.windows
@ -9,7 +9,7 @@ IN: tools.deploy.libraries.windows
M: windows find-library-file
f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [
[
32768 (ushort-array) [ 32768 GetModuleFileName drop ] keep
32768 ushort (c-array) [ 32768 GetModuleFileName drop ] keep
utf16n alien>string
] [ FreeLibrary drop ] bi
] [ f ] if* ;

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

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

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

@ -41,7 +41,7 @@ SINGLETON: x11-ui-backend
]
with-out-parameters
[| type format n-atoms bytes-after atoms |
atoms n-atoms <direct-ulong-array> >array
atoms n-atoms ulong <c-direct-array> >array
atoms XFree
] call ;

6
basis/ui/pens/gradient/gradient.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math math.vectors locals sequences
specialized-arrays colors arrays combinators
specialized-arrays colors arrays combinators alien.data
opengl opengl.gl ui.pens ui.pens.caching ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
@ -18,11 +18,11 @@ TUPLE: gradient < caching-pen colors last-vertices last-colors ;
direction dim v* dim over v- swap
colors length [ iota ] [ 1 - ] bi v/n [ v*n ] with map
swap [ over v+ 2array ] curry map
concat concat >float-array ;
concat concat float >c-array ;
: gradient-colors ( colors -- seq )
[ >rgba-components 4array dup 2array ] map concat concat
>float-array ;
float >c-array ;
M: gradient recompute-pen ( gadget gradient -- )
[ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi

8
basis/ui/pens/polygon/polygon.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types colors help.markup help.syntax
kernel opengl opengl.gl sequences math.vectors ui.gadgets
ui.pens specialized-arrays ;
USING: accessors alien.c-types alien.data colors help.markup
help.syntax kernel opengl opengl.gl sequences math.vectors
ui.gadgets ui.pens specialized-arrays ;
SPECIALIZED-ARRAY: float
IN: ui.pens.polygon
@ -17,7 +17,7 @@ boundary-count ;
dup first suffix ;
: <polygon> ( color points -- polygon )
dup close-path [ [ concat >float-array ] [ length ] bi ] bi@
dup close-path [ [ concat float >c-array ] [ length ] bi ] bi@
polygon boa ;
M: polygon draw-boundary

8
basis/ui/pixel-formats/pixel-formats.factor
View File

@ -1,6 +1,6 @@
USING: alien.c-types accessors assocs classes destructors
functors kernel lexer math parser sequences specialized-arrays
ui.backend words ;
USING: alien.c-types alien.data accessors assocs classes
destructors functors kernel lexer math parser sequences
specialized-arrays ui.backend words ;
SPECIALIZED-ARRAY: int
IN: ui.pixel-formats
@ -82,7 +82,7 @@ M: pixel-format-attribute >PFA
[ drop { } ] if* ;
: >PFA-int-array ( attribute -- int-array )
[ >PFA ] map concat PERM prepend 0 suffix >int-array ;
[ >PFA ] map concat PERM prepend 0 suffix int >c-array ;
;FUNCTOR

2
basis/windows/com/wrapper/wrapper.factor
View File

@ -158,5 +158,5 @@ M: com-wrapper dispose*
: com-wrap ( object wrapper -- wrapped-object )
[ vtbls>> ] [ (malloc-wrapped-object) ] bi
[ over length <direct-void*-array> 0 swap copy ] keep
[ over length void* <c-direct-array> 0 swap copy ] keep
[ +wrapped-objects+ get-global set-at ] keep ;

2
basis/windows/directx/dinput/constants/constants.factor
View File

@ -62,7 +62,7 @@ M: array array-base-type first ;
: make-DIOBJECTDATAFORMAT-array-quot ( struct arr -- quot )
[ nip length ] [ make-DIOBJECTDATAFORMAT-arrays ] 2bi '[
_ malloc-DIOBJECTDATAFORMAT-array
_ DIOBJECTDATAFORMAT malloc-array
[ _ dup byte-length memcpy ]
[ _ [ get >>pguid drop ] 2each ]
[ ] tri

6
basis/windows/shell32/shell32.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax
USING: alien alien.c-types alien.data alien.strings alien.syntax
classes.struct combinators io.encodings.utf16n io.files
io.pathnames kernel windows.errors windows.com
windows.com.syntax windows.types windows.user32
@ -89,7 +89,7 @@ ALIAS: ShellExecute ShellExecuteW
: shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT
MAX_UNICODE_PATH <ushort-array>
MAX_UNICODE_PATH ushort <c-array>
[ SHGetFolderPath drop ] keep utf16n alien>string ;
: desktop ( -- str )
@ -224,4 +224,4 @@ FUNCTION: HRESULT SHGetDesktopFolder ( IShellFolder** ppshf ) ;
FUNCTION: UINT DragQueryFileW ( HDROP hDrop, UINT iFile, LPWSTR lpszFile, UINT cch ) ;
ALIAS: DragQueryFile DragQueryFileW
FUNCTION: BOOL IsUserAnAdmin ( ) ;
FUNCTION: BOOL IsUserAnAdmin ( ) ;

8
basis/windows/streams/streams.factor
View File

@ -1,6 +1,6 @@
USING: accessors alien.c-types classes.struct combinators
continuations io kernel libc literals locals sequences
specialized-arrays windows.com memoize
USING: accessors alien.c-types alien.data classes.struct
combinators continuations io kernel libc literals locals
sequences specialized-arrays windows.com memoize
windows.com.wrapper windows.kernel32 windows.ole32
windows.types ;
IN: windows.streams
@ -24,7 +24,7 @@ SPECIALIZED-ARRAY: uchar
:: IStream-write ( stream pv cb out-written -- hresult )
[
pv cb <direct-uchar-array> stream stream-write
pv cb uchar <c-direct-array> stream stream-write
out-written [ cb out-written 0 ULONG set-alien-value ] when
S_OK
] with-hresult ; inline

2
basis/x11/xim/xim.factor
View File

@ -41,7 +41,7 @@ SYMBOL: keybuf
SYMBOL: keysym
: prepare-lookup ( -- )
buf-size <uint-array> keybuf set
buf-size uint <c-array> keybuf set
0 KeySym <ref> keysym set ;
: finish-lookup ( len -- string keysym )

6
core/io/files/files-tests.factor
View File

@ -1,4 +1,4 @@
USING: alien alien.c-types arrays classes.struct
USING: alien alien.c-types alien.data arrays classes.struct
debugger.threads destructors generic.single io io.directories
io.encodings.8-bit.latin1 io.encodings.ascii
io.encodings.binary io.encodings.string io.files
@ -80,7 +80,7 @@ IN: io.files.tests
"test.txt" temp-file binary [
3 4 * read
] with-file-reader
int-array-cast
int cast-array
] unit-test
[ ] [
@ -117,7 +117,7 @@ CONSTANT: pt-array-1
[ t ] [
"test.txt" temp-file binary file-contents
pt-array-cast
pt cast-array
pt-array-1 rest-slice sequence=
] unit-test

4
core/io/streams/byte-array/byte-array-tests.factor
View File

@ -1,6 +1,6 @@
USING: tools.test io.streams.byte-array io.encodings.binary
io.encodings.utf8 io kernel arrays strings namespaces math
specialized-arrays alien.c-types io.encodings.ascii ;
specialized-arrays alien.c-types alien.data io.encodings.ascii ;
SPECIALIZED-ARRAY: int
IN: io.streams.byte-array.tests
@ -55,5 +55,5 @@ IN: io.streams.byte-array.tests
! Writing specialized arrays to byte writers
[ int-array{ 1 2 3 } ] [
binary [ int-array{ 1 2 3 } write ] with-byte-writer
int-array-cast
int cast-array
] unit-test

4
core/io/streams/c/c-tests.factor
View File

@ -1,6 +1,6 @@
USING: tools.test io.files io.files.temp io io.streams.c
io.encodings.ascii strings destructors kernel specialized-arrays
alien.c-types math ;
alien.c-types math alien.data ;
SPECIALIZED-ARRAY: int
IN: io.streams.c.tests
@ -31,7 +31,7 @@ IN: io.streams.c.tests
"test.txt" temp-file "rb" fopen <c-reader> [
3 4 * read
] with-input-stream
int-array-cast
int cast-array
] unit-test
! Writing strings to binary streams should fail

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

@ -1,5 +1,5 @@
! (c)Joe Groff bsd license
USING: alien.data.map fry generalizations kernel locals math.vectors
USING: alien.data alien.data.map fry generalizations kernel locals math.vectors
math.vectors.conversion math math.vectors.simd math.ranges sequences
specialized-arrays tools.test ;
FROM: alien.c-types => uchar short int float ;
@ -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] )
float-array-cast
float cast-array
] unit-test
[
@ -20,7 +20,7 @@ IN: alien.data.map.tests
}
] [
3 iota [ float-4-with ] data-map( object -- float-4 )
float-4-array-cast
float-4 cast-array
] unit-test
[
@ -31,7 +31,7 @@ IN: alien.data.map.tests
}
] [
12 iota [ float-4-boa ] data-map( object[4] -- float-4 )
float-4-array-cast
float-4 cast-array
] 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 float-array-cast ]
[ 2 data-map-compiler-bug-test float cast-array ]
unit-test

4
extra/audio/engine/engine.factor
View File

@ -118,7 +118,7 @@ ERROR: audio-context-not-available device-name ;
al-context>> alcMakeContextCurrent drop ; inline
: allocate-sources ( audio-engine -- sources )
voice-count>> dup (uint-array) [ alGenSources ] keep ; inline
voice-count>> dup c:uint (c-array) [ alGenSources ] keep ; inline
:: flush-source ( al-source -- )
al-source alSourceStop
@ -277,7 +277,7 @@ M: audio-engine dispose*
audio-engine get-available-source :> al-source
al-source [
buffer-count dup (uint-array) [ alGenBuffers ] keep :> al-buffers
buffer-count dup c:uint (c-array) [ alGenBuffers ] keep :> al-buffers
generator generator-audio-format :> ( channels sample-bits sample-rate )
streaming-audio-clip new-disposable

12
extra/audio/vorbis/vorbis.factor
View File

@ -4,9 +4,9 @@ byte-arrays classes.struct combinators destructors fry io
io.files io.encodings.binary kernel libc locals make math
math.order math.parser ogg ogg.vorbis sequences
specialized-arrays specialized-vectors ;
FROM: alien.c-types => float short void* ;
SPECIALIZED-ARRAYS: float void* ;
SPECIALIZED-VECTOR: short
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS: c:float c:void* ;
SPECIALIZED-VECTOR: c:short
IN: audio.vorbis
TUPLE: vorbis-stream < disposable
@ -166,15 +166,15 @@ ERROR: no-vorbis-in-ogg ;
vorbis-stream buffer>> :> buffer
buffer length -1 shift :> buffer-length
offset -1 shift :> sample-offset
buffer buffer-length <direct-short-array> sample-offset short-vector boa :> short-buffer
buffer buffer-length c:short <c-direct-array> sample-offset short-vector boa :> short-buffer
vorbis-stream info>> channels>> :> #channels
buffer-length sample-offset - #channels /i :> max-len
len max-len min :> len'
pcm #channels <direct-void*-array> :> channel*s
pcm #channels void* <c-direct-array> :> channel*s
len' iota [| sample |
#channels iota [| channel |
channel channel*s nth len <direct-float-array>
channel channel*s nth len c:float <c-direct-array>
sample swap nth
float>short-sample short-buffer push
] each

4
extra/benchmark/fasta/fasta.factor
View File

@ -1,7 +1,7 @@
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
USING: assocs benchmark.reverse-complement byte-arrays fry io
io.encodings.ascii io.files locals kernel math sequences
sequences.private specialized-arrays strings typed ;
sequences.private specialized-arrays strings typed alien.data ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:double
IN: benchmark.fasta
@ -47,7 +47,7 @@ CONSTANT: homo-sapiens
TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
[ keys >byte-array ]
[ values >double-array unclip [ + ] accumulate swap suffix ] bi ;
[ values c:double >c-array unclip [ + ] accumulate swap suffix ] bi ;
:: select-random ( seed chars floats -- seed elt )
seed random floats [ <= ] with find drop chars nth-unsafe ; inline

8
extra/benchmark/spectral-norm-simd/spectral-norm-simd.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types specialized-arrays kernel math
USING: alien.c-types alien.data specialized-arrays kernel math
math.functions math.vectors sequences sequences.private
prettyprint words typed locals math.vectors.simd
math.vectors.simd.cords ;
@ -43,10 +43,10 @@ IN: benchmark.spectral-norm-simd
[ swap nth-unsafe ] [ eval4-A' ] bi-curry bi* n*v ; inline
: eval-At-times-u ( u n -- seq )
[ double-array-cast ] dip [ (eval-At-times-u) ] inner-loop ; inline
[ double cast-array ] dip [ (eval-At-times-u) ] inner-loop ; inline
: eval-AtA-times-u ( u n -- seq )
[ double-array-cast ] dip [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
[ double cast-array ] dip [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
: ones ( n -- seq )
4 /i [ double-4{ 1.0 1.0 1.0 1.0 } ] double-4-array{ } replicate-as ; inline
@ -60,7 +60,7 @@ IN: benchmark.spectral-norm-simd
] times ; inline
TYPED: spectral-norm ( n: fixnum -- norm )
u/v [ double-array-cast ] bi@ [ v. ] [ norm-sq ] bi /f sqrt ;
u/v [ double cast-array ] bi@ [ v. ] [ norm-sq ] bi /f sqrt ;
: spectral-norm-main ( -- )
2000 spectral-norm . ;

6
extra/benchmark/struct-arrays/struct-arrays.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes.struct combinators.smart fry kernel
math math.functions math.order math.parser sequences
USING: accessors alien.data classes.struct combinators.smart
fry kernel math math.functions math.order math.parser sequences
specialized-arrays io ;
FROM: alien.c-types => float ;
IN: benchmark.struct-arrays
@ -22,7 +22,7 @@ SPECIALIZED-ARRAY: point
1 + ; inline
: make-points ( len -- points )
<point-array> dup 0 [ init-point ] reduce drop ; inline
point <c-array> dup 0 [ init-point ] reduce drop ; inline
: point-norm ( point -- norm )
[ xyz [ absq ] tri@ ] sum-outputs sqrt ; inline

6
extra/bunny/model/model.factor
View File

@ -2,7 +2,7 @@ USING: accessors alien.c-types arrays combinators destructors
http.client io io.encodings.ascii io.files io.files.temp kernel
locals math math.matrices math.parser math.vectors opengl
opengl.capabilities opengl.gl opengl.demo-support sequences
splitting vectors words specialized-arrays ;
splitting vectors words specialized-arrays alien.data ;
FROM: sequences => change-nth ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
@ -72,11 +72,11 @@ TUPLE: bunny-buffers array element-array nv ni ;
{
[
[ first concat ] [ second concat ] bi
append >float-array underlying>>
append c:float >c-array underlying>>
GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
]
[
third concat >uint-array underlying>>
third concat c:uint >c-array underlying>>
GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
]
[ first length 3 * ]

14
extra/chipmunk/demo/demo.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types chipmunk.ffi classes.struct
game.loop game.worlds kernel literals locals math method-chains
opengl.gl random sequences specialized-arrays ui
ui.gadgets.worlds ui.pixel-formats ;
USING: accessors alien alien.c-types alien.data chipmunk.ffi
classes.struct game.loop game.worlds kernel literals locals
math method-chains opengl.gl random sequences specialized-arrays
ui ui.gadgets.worlds ui.pixel-formats ;
SPECIALIZED-ARRAY: void*
IN: chipmunk.demo
@ -81,7 +81,7 @@ M:: chipmunk-world draw-world* ( world -- )
0 0 0 glColor3f
GL_POINTS glBegin
space bodies>>
[ num>> ] [ arr>> swap <direct-void*-array> ] bi [
[ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
cpBody memory>struct p>> [ x>> ] [ y>> ] bi glVertex2f
] each
glEnd
@ -90,9 +90,9 @@ M:: chipmunk-world draw-world* ( world -- )
1 0 0 glColor3f
GL_POINTS glBegin
space arbiters>>
[ num>> ] [ arr>> swap <direct-void*-array> ] bi [
[ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
cpArbiter memory>struct
[ numContacts>> ] [ contacts>> >c-ptr swap <direct-cpContact-array> ] bi [
[ numContacts>> ] [ contacts>> >c-ptr swap cpContact <c-direct-array> ] bi [
p>> [ x>> ] [ y>> ] bi glVertex2f
] each
] each

12
extra/chipmunk/ffi/ffi.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.libraries
USING: accessors alien alien.c-types alien.data alien.libraries
alien.syntax classes.struct combinators combinators.short-circuit
kernel math math.order sequences typed specialized-arrays locals
system ;
@ -442,17 +442,17 @@ FUNCTION: int cpPolyShapeGetNumVerts ( cpShape* shape ) ;
FUNCTION: cpVect cpPolyShapeGetVert ( cpShape* shape, int idx ) ;
TYPED: cpPolyShapeValueOnAxis ( poly: cpPolyShape n: cpVect d -- min-dist )
swap rot [ numVerts>> ] [ tVerts>> swap <direct-cpVect-array> ] bi swap
swap rot [ numVerts>> ] [ tVerts>> swap cpVect <c-direct-array> ] bi swap
[ cpvdot ] curry [ min ] reduce swap - ; inline
TYPED: cpPolyShapeContainsVert ( poly: cpPolyShape v: cpVect -- ? )
swap [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi swap
swap [ numVerts>> ] [ tAxes>> swap cpPolyShapeAxis <c-direct-array> ] bi swap
[
[ [ n>> ] dip cpvdot ] [ drop d>> ] 2bi -
] curry [ max ] reduce 0.0 <= ; inline
TYPED: cpPolyShapeContainsVertPartial ( poly: cpPolyShape v: cpVect n: cpVect -- ? )
rot [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi -rot
rot [ numVerts>> ] [ tAxes>> swap cpPolyShapeAxis <c-direct-array> ] bi -rot
[| axis v n |
axis n>> n cpvdot 0.0 < 0
[ 0.0 ]
@ -527,7 +527,7 @@ TYPED: cpArbiterGetNormal ( arb: cpArbiter i -- n: cpVect )
[
swap
[ numContacts>> ]
[ contacts>> swap <direct-void*-array> ] bi nth cpContact memory>struct n>>
[ contacts>> swap void* <c-direct-array> ] bi nth cpContact memory>struct n>>
]
[
drop swappedColl>> 0 = [ ] [ cpvneg ] if
@ -536,7 +536,7 @@ TYPED: cpArbiterGetNormal ( arb: cpArbiter i -- n: cpVect )
TYPED: cpArbiterGetPoint ( arb: cpArbiter i -- p: cpVect )
swap
[ numContacts>> ]
[ contacts>> swap <direct-void*-array> ] bi
[ contacts>> swap void* <c-direct-array> ] bi
nth cpContact memory>struct p>> ; inline
! cpCollision.h

25
extra/elf/elf.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings alien.syntax arrays
classes.struct fry io.encodings.ascii io.mmap kernel locals math
math.intervals sequences specialized-arrays strings typed assocs ;
USING: accessors alien alien.c-types alien.data alien.strings
alien.syntax arrays classes.struct fry io.encodings.ascii
io.mmap kernel locals math math.intervals sequences
specialized-arrays strings typed assocs ;
IN: elf
! FFI data
@ -482,15 +483,15 @@ TYPED:: elf-section-headers ( elf: Elf32/64_Ehdr -- headers: Elf32/64_Shdr-array
elf [ e_shoff>> ] [ e_shnum>> ] bi :> ( off num )
off elf >c-ptr <displaced-alien> num
elf 64-bit?
[ <direct-Elf64_Shdr-array> ]
[ <direct-Elf32_Shdr-array> ] if ;
[ Elf64_Shdr <c-direct-array> ]
[ Elf32_Shdr <c-direct-array> ] if ;
TYPED:: elf-program-headers ( elf: Elf32/64_Ehdr -- headers: Elf32/64_Phdr-array )
elf [ e_phoff>> ] [ e_phnum>> ] bi :> ( off num )
off elf >c-ptr <displaced-alien> num
elf 64-bit?
[ <direct-Elf64_Phdr-array> ]
[ <direct-Elf32_Phdr-array> ] if ;
[ Elf64_Phdr <c-direct-array> ]
[ Elf32_Phdr <c-direct-array> ] if ;
TYPED: elf-loadable-segments ( headers: Elf32/64_Phdr-array -- headers: Elf32/64_Phdr-array )
[ p_type>> PT_LOAD = ] filter ;
@ -517,10 +518,10 @@ TYPED:: virtual-address-section ( elf: Elf32/64_Ehdr address -- section-header/f
] filter [ f ] [ first ] if-empty ;
TYPED:: elf-segment-data ( elf: Elf32/64_Ehdr header: Elf32/64_Phdr -- uchar-array/f )
header [ p_offset>> elf >c-ptr <displaced-alien> ] [ p_filesz>> ] bi <direct-uchar-array> ;
header [ p_offset>> elf >c-ptr <displaced-alien> ] [ p_filesz>> ] bi uchar <c-direct-array> ;
TYPED:: elf-section-data ( elf: Elf32/64_Ehdr header: Elf32/64_Shdr -- uchar-array/f )
header [ sh_offset>> elf >c-ptr <displaced-alien> ] [ sh_size>> ] bi <direct-uchar-array> ;
header [ sh_offset>> elf >c-ptr <displaced-alien> ] [ sh_size>> ] bi uchar <c-direct-array> ;
TYPED:: elf-section-data-by-index ( elf: Elf32/64_Ehdr index -- header/f uchar-array/f )
elf elf-section-headers :> sections
@ -554,8 +555,8 @@ TYPED:: elf-symbols ( elf: Elf32/64_Ehdr section-data: uchar-array -- symbols )
elf ".strtab" elf-section-data-by-name nip >c-ptr :> strings
section-data [ >c-ptr ] [ length ] bi
elf 64-bit?
[ Elf64_Sym heap-size / <direct-Elf64_Sym-array> ]
[ Elf32_Sym heap-size / <direct-Elf32_Sym-array> ] if
[ Elf64_Sym heap-size / Elf64_Sym <c-direct-array> ]
[ Elf32_Sym heap-size / Elf32_Sym <c-direct-array> ] if
[ [ st_name>> strings <displaced-alien> ascii alien>string ] keep 2array ] { } map-as ;
! High level interface
@ -608,7 +609,7 @@ M:: segment sections ( segment -- sections )
symbol [ elf-header>> ] [ sym>> st_value>> ] bi virtual-address-segment :> segment
symbol sym>> st_value>> segment p_vaddr>> - segment p_offset>> + :> faddress
faddress symbol elf-header>> >c-ptr <displaced-alien>
symbol sym>> st_size>> <direct-uchar-array> ;
symbol sym>> st_size>> uchar <c-direct-array> ;
: find-section ( sections name -- section/f )
'[ name>> _ = ] find nip ; inline

6
extra/fluids/fluids.factor
View File

@ -6,7 +6,7 @@ gpu.render gpu.shaders gpu.state gpu.textures gpu.util images
images.loader kernel literals locals make math math.rectangles
math.vectors namespaces opengl.gl sequences specialized-arrays
ui.gadgets.worlds ui.gestures ui.pixel-formats gpu.effects.step
images.pgm images.ppm ;
images.pgm images.ppm alien.data ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: fluids
@ -113,8 +113,8 @@ GAME: fluids {
fluids-world H{
{ T{ button-down } [ [
hand-loc get >float-array
world get dim>> >float-array v/ 2 v*n 1 v-n { 1 -1 } v*
hand-loc get float >c-array
world get dim>> float >c-array v/ 2 v*n 1 v-n { 1 -1 } v*
float-array{ 0 0.2 } 2.0 particle_t <struct-boa> suffix
] change-particles drop ] }
} set-gestures

11
extra/game/debug/debug.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays circular colors colors.constants
columns destructors fonts gpu.buffers gpu.render gpu.shaders gpu.state
gpu.textures images kernel literals locals make math math.constants
math.functions math.vectors sequences specialized-arrays typed ui.text fry ;
USING: accessors alien.c-types alien.data arrays circular colors
colors.constants columns destructors fonts gpu.buffers
gpu.render gpu.shaders gpu.state gpu.textures images kernel
literals locals make math math.constants math.functions
math.vectors sequences specialized-arrays typed ui.text fry ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAYS: float uint ;
IN: game.debug
@ -108,7 +109,7 @@ CONSTANT: debug-text-texture-parameters
image upside-down?>>
[ { x0 y0 0 0 x1 y0 1 0 x1 y1 1 1 x0 y1 0 1 } ]
[ { x0 y0 0 1 x1 y0 1 1 x1 y1 1 0 x0 y1 0 0 } ]
if >float-array ;
if float >c-array ;
: debug-text-uniform-variables ( string color -- image uniforms )
text>image dup image>texture

18
extra/game/models/collada/collada.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs grouping hashtables kernel locals
math math.parser sequences sequences.deep
specialized-arrays.instances.alien.c-types.float
specialized-arrays.instances.alien.c-types.uint splitting xml
xml.data xml.traversal math.order namespaces combinators images
gpu.shaders io make game.models game.models.util
io.encodings.ascii game.models.loader ;
USING: accessors alien.c-types alien.data arrays assocs grouping
hashtables kernel locals math math.parser sequences sequences.deep
splitting xml xml.data xml.traversal math.order namespaces
combinators images gpu.shaders io make game.models game.models.util
io.encodings.ascii game.models.loader specialized-arrays ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS: c:float c:uint ;
IN: game.models.collada
SINGLETON: collada-models
@ -150,8 +150,8 @@ VERTEX-FORMAT: collada-vertex-format
]
[
soa>aos
[ flatten >float-array ]
[ flatten >uint-array ]
[ flatten c:float >c-array ]
[ flatten c:uint >c-array ]
bi* collada-vertex-format f model boa
] bi ;

14
extra/game/models/obj/obj.factor
View File

@ -2,11 +2,11 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io io.encodings.ascii math.parser sequences splitting
kernel assocs io.files combinators math.order math namespaces
arrays sequences.deep accessors
specialized-arrays.instances.alien.c-types.float
specialized-arrays.instances.alien.c-types.uint game.models
game.models.util gpu.shaders images game.models.loader
prettyprint ;
arrays sequences.deep accessors alien.c-types alien.data
game.models game.models.util gpu.shaders images game.models.loader
prettyprint specialized-arrays ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS: c:float c:uint ;
IN: game.models.obj
SINGLETON: obj-models
@ -125,8 +125,8 @@ VERTEX-FORMAT: obj-vertex-format
: push-current-model ( -- )
current-model get [
[ dseq>> flatten >float-array ]
[ iseq>> flatten >uint-array ]
[ dseq>> flatten c:float >c-array ]
[ iseq>> flatten c:uint >c-array ]
bi obj-vertex-format current-material get model boa models get push
V{ } V{ } H{ } <indexed-seq> current-model set
] unless-empty ;

4
extra/gpu/framebuffers/framebuffers.factor
View File

@ -281,8 +281,8 @@ M: opengl-2 (clear-integer-color-attachment)
M: opengl-3 (clear-integer-color-attachment)
[ GL_COLOR 0 ] dip 4 0 pad-tail
swap {
{ int-type [ >int-array glClearBufferiv ] }
{ uint-type [ >uint-array glClearBufferuiv ] }
{ int-type [ int >c-array glClearBufferiv ] }
{ uint-type [ uint >c-array glClearBufferuiv ] }
} case ;
:: (clear-color-attachment) ( type attachment value -- )

10
extra/gpu/render/render.factor
View File

@ -293,13 +293,13 @@ GENERIC: bind-uniform-vec4 ( index sequence -- )
M: object >uniform-bool-array [ >c-bool ] int-array{ } map-as ; inline
M: binary-data >uniform-bool-array ; inline
M: object >uniform-int-array >int-array ; inline
M: object >uniform-int-array c:int >c-array ; inline
M: binary-data >uniform-int-array ; inline
M: object >uniform-uint-array >uint-array ; inline
M: object >uniform-uint-array c:uint >c-array ; inline
M: binary-data >uniform-uint-array ; inline
M: object >uniform-float-array >float-array ; inline
M: object >uniform-float-array c:float >c-array ; inline
M: binary-data >uniform-float-array ; inline
M: object >uniform-bvec-array '[ _ head-slice [ >c-bool ] int-array{ } map-as ] map concat ; inline
@ -316,7 +316,7 @@ M: binary-data >uniform-vec-array drop ; inline
M:: object >uniform-matrix ( sequence cols rows -- c-array )
sequence flip cols head-slice
[ rows head-slice >float-array ] { } map-as concat ; inline
[ rows head-slice c:float >c-array ] { } map-as concat ; inline
M: binary-data >uniform-matrix 2drop ; inline
M: object >uniform-matrix-array
@ -549,7 +549,7 @@ SYNTAX: UNIFORM-TUPLE:
[ gl-attachment ] with map
dup length 1 =
[ first glDrawBuffer ]
[ [ length ] [ >int-array ] bi glDrawBuffers ] if ;
[ [ length ] [ c:int >c-array ] bi glDrawBuffers ] if ;
: bind-named-output-attachments ( program-instance framebuffer attachments -- )
rot '[ first _ swap output-index ] sort-with values

4
extra/gpu/state/state.factor
View File

@ -425,9 +425,9 @@ M: mask-state set-gpu-state*
: get-gl-bools ( enum count -- value )
<byte-array> [ glGetBooleanv ] keep [ c-bool> ] { } map-as ;
: get-gl-ints ( enum count -- value )
<int-array> [ glGetIntegerv ] keep ;
int <c-array> [ glGetIntegerv ] keep ;
: get-gl-floats ( enum count -- value )
<float-array> [ glGetFloatv ] keep ;
c:float <c-array> [ glGetFloatv ] keep ;
: get-gl-rect ( enum -- value )
4 get-gl-ints first4 [ 2array ] 2bi@ <rect> ;

2
extra/graphviz/ffi/ffi.factor
View File

@ -147,7 +147,7 @@ FUNCTION: char**
f
gvPluginList &(free) :> ret
size* int deref :> size
ret size <direct-void*-array> [
ret size void* <c-direct-array> [
&(free) ascii alien>string
] { } map-as
] with-destructors ;

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

@ -1,5 +1,5 @@
IN: grid-meshes.tests
USING: alien.c-types grid-meshes grid-meshes.private
USING: alien.c-types alien.data grid-meshes grid-meshes.private
specialized-arrays tools.test ;
SPECIALIZED-ARRAY: float
@ -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 float-array-cast ] unit-test
] [ { 2 2 } vertex-array float cast-array ] unit-test

15
extra/images/bitmap/bitmap.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays byte-arrays combinators
compression.run-length fry grouping images images.loader
images.normalization io io.binary io.encodings.8-bit.latin1
io.encodings.string kernel math math.bitwise sequences
specialized-arrays summary io.streams.throwing ;
USING: accessors alien.c-types alien.data arrays byte-arrays
combinators compression.run-length fry grouping images
images.loader images.normalization io io.binary
io.encodings.8-bit.latin1 io.encodings.string kernel math
math.bitwise sequences specialized-arrays summary
io.streams.throwing ;
QUALIFIED-WITH: bitstreams b
SPECIALIZED-ARRAYS: uint ushort ;
IN: images.bitmap
@ -279,7 +280,7 @@ ERROR: bmp-not-supported n ;
{ 24 [ color-index>> ] }
{ 16 [
[
! ushort-array-cast
! ushort cast-array
2 group [ le> ] map
! 5 6 5
! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
@ -310,7 +311,7 @@ M: unsupported-bitfield-widths summary
dup header>> bit-count>> {
{ 16 [
dup bitfields>> '[
ushort-array-cast _ uncompress-bitfield
ushort cast-array _ uncompress-bitfield
] change-color-index
] }
{ 32 [ ] }

8
extra/libusb/libusb.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.libraries
USING: accessors alien alien.c-types alien.data alien.libraries
alien.syntax classes.struct combinators endian io.binary
kernel locals math sequences specialized-arrays
system unix.time unix.types ;
@ -341,7 +341,7 @@ FUNCTION: void libusb_free_transfer ( libusb_transfer* transfer ) ;
: libusb_set_iso_packet_lengths ( transfer length -- )
[ [ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
<direct-libusb_iso_packet_descriptor-array>
libusb_iso_packet_descriptor <c-direct-array>
] dip [ >>length drop ] curry each ; inline
:: libusb_get_iso_packet_buffer ( transfer packet -- data )
@ -351,7 +351,7 @@ FUNCTION: void libusb_free_transfer ( libusb_transfer* transfer ) ;
transfer
[ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
<direct-libusb_iso_packet_descriptor-array> 0
libusb_iso_packet_descriptor <c-direct-array> 0
[ length>> + ] reduce
transfer buffer>> <displaced-alien>
] if ;
@ -363,7 +363,7 @@ FUNCTION: void libusb_free_transfer ( libusb_transfer* transfer ) ;
0 transfer
[ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
<direct-libusb_iso_packet_descriptor-array> nth
libusb_iso_packet_descriptor <c-direct-array> nth
length>> packet *
transfer buffer>> <displaced-alien>
] if ;

15
extra/llvm/invoker/invoker.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien arrays assocs compiler.units effects
io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
llvm.types make namespaces sequences specialized-arrays
vocabs words ;
SPECIALIZED-ARRAY: void*
USING: accessors alien alien.data arrays assocs compiler.units
effects io.backend io.pathnames kernel llvm.core llvm.jit
llvm.reader llvm.types make namespaces sequences
specialized-arrays vocabs words ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:void*
IN: llvm.invoker
! get function name, ret type, param types and names
@ -15,7 +16,7 @@ IN: llvm.invoker
TUPLE: function name alien return params ;
: params ( llvm-function -- param-list )
dup LLVMCountParams <void*-array>
dup LLVMCountParams c:void* <c-array>
[ LLVMGetParams ] keep >array
[ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
@ -52,5 +53,5 @@ TUPLE: function name alien return params ;
: install-bc ( path -- )
[ normalize-path ] [ file-name ] bi
[ load-into-jit ] keep install-module ;
<< "alien.llvm" create-vocab drop >>

16
extra/llvm/types/types.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays combinators kernel
llvm.core locals math.parser math multiline namespaces parser
peg.ebnf sequences sequences.deep specialized-arrays strings
vocabs words ;
USING: accessors alien.c-types alien.data arrays combinators
kernel llvm.core locals math.parser math multiline namespaces
parser peg.ebnf sequences sequences.deep specialized-arrays
strings vocabs words ;
SPECIALIZED-ARRAY: void*
IN: llvm.types
@ -119,13 +119,13 @@ TUPLE: struct < enclosing types packed? ;
swap >>packed? swap >>types ;
M: struct (>tref)*
[ types>> [ (>tref) ] map >void*-array ]
[ types>> [ (>tref) ] map void* >c-array ]
[ types>> length ]
[ packed?>> 1 0 ? ] tri LLVMStructType ;
M: struct clean* types>> [ clean ] each ;
M: struct (tref>)*
over LLVMIsPackedStruct 0 = not >>packed?
swap dup LLVMCountStructElementTypes <void*-array>
swap dup LLVMCountStructElementTypes void* <c-array>
[ LLVMGetStructElementTypes ] keep >array
[ (tref>) ] map >>types ;
@ -148,7 +148,7 @@ TUPLE: function < enclosing return params vararg? ;
M: function (>tref)* {
[ return>> (>tref) ]
[ params>> [ (>tref) ] map >void*-array ]
[ params>> [ (>tref) ] map void* >c-array ]
[ params>> length ]
[ vararg?>> 1 0 ? ]
} cleave LLVMFunctionType ;
@ -156,7 +156,7 @@ M: function clean* [ return>> clean ] [ params>> [ clean ] each ] bi ;
M: function (tref>)*
over LLVMIsFunctionVarArg 0 = not >>vararg?
over LLVMGetReturnType (tref>) >>return
swap dup LLVMCountParamTypes <void*-array>
swap dup LLVMCountParamTypes void* <c-array>
[ LLVMGetParamTypes ] keep >array
[ (tref>) ] map >>params ;

22
extra/macho/macho.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2010 Erik Charlebois.
! See http:// factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings alien.syntax
classes classes.struct combinators combinators.short-circuit
io.encodings.ascii io.encodings.string kernel literals make
math sequences specialized-arrays typed fry io.mmap formatting
locals splitting io.binary arrays ;
USING: accessors alien alien.c-types alien.data alien.strings
alien.syntax classes classes.struct combinators
combinators.short-circuit io.encodings.ascii io.encodings.string
kernel literals make math sequences specialized-arrays typed
fry io.mmap formatting locals splitting io.binary arrays ;
FROM: alien.c-types => short ;
IN: macho
@ -837,12 +837,12 @@ TYPED: fat-binary-members ( >c-ptr -- fat-binary-members )
} case dup
[ >c-ptr fat_header heap-size swap <displaced-alien> ]
[ nfat_arch>> 4 >be le> ] bi
<direct-fat_arch-array> [
fat_arch <c-direct-array> [
{
[ nip cputype>> 4 >be le> ]
[ nip cpusubtype>> 4 >be le> ]
[ offset>> 4 >be le> swap >c-ptr <displaced-alien> ]
[ nip size>> 4 >be le> <direct-uchar-array> ]
[ nip size>> 4 >be le> uchar <c-direct-array> ]
} 2cleave fat-binary-member boa
] with { } map-as ;
@ -913,8 +913,8 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands )
[ nsects>> ]
[ segment_command_64? ]
} cleave
[ <direct-section_64-array> ]
[ <direct-section-array> ] if ;
[ section_64 <c-direct-array> ]
[ section <c-direct-array> ] if ;
: sections-array ( segment-commands -- sections-array )
[
@ -926,8 +926,8 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands )
: symbols ( mach-header symtab-command -- symbols string-table )
[ symoff>> swap >c-ptr <displaced-alien> ]
[ nsyms>> swap 64-bit?
[ <direct-nlist_64-array> ]
[ <direct-nlist-array> ] if ]
[ nlist_64 <c-direct-array> ]
[ nlist <c-direct-array> ] if ]
[ stroff>> swap >c-ptr <displaced-alien> ] 2tri ;
: symbol-name ( symbol string-table -- name )

4
extra/noise/noise.factor
View File

@ -1,4 +1,4 @@
USING: accessors alien.data.map byte-arrays combinators combinators.short-circuit
USING: accessors alien.data alien.data.map byte-arrays combinators combinators.short-circuit
fry generalizations images kernel locals math math.constants math.functions
math.libm math.matrices.simd math.vectors math.vectors.conversion math.vectors.simd
memoize random random.mersenne-twister sequences sequences.private specialized-arrays
@ -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 )
float-array-cast ;
c:float cast-array ;
: perlin-noise-image ( table transform dim -- image )
[ perlin-noise-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ;

6
extra/openal/openal.factor
View File

@ -248,15 +248,15 @@ DESTRUCTOR: alcCloseDevice*
DESTRUCTOR: alcDestroyContext
: gen-sources ( size -- seq )
dup <uint-array> [ alGenSources ] keep ;
dup uint <c-array> [ alGenSources ] keep ;
: gen-buffers ( size -- seq )
dup <uint-array> [ alGenBuffers ] keep ;
dup uint <c-array> [ alGenBuffers ] keep ;
: gen-buffer ( -- buffer ) 1 gen-buffers first ;
: queue-buffers ( source buffers -- )
[ length ] [ >uint-array ] bi alSourceQueueBuffers ;
[ length ] [ uint >c-array ] bi alSourceQueueBuffers ;
: queue-buffer ( source buffer -- )
1array queue-buffers ;

4
extra/opencl/ffi/ffi-tests.factor
View File

@ -30,7 +30,7 @@ ERROR: cl-error err ;
:: opencl-square ( in -- out )
0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
dup <void*-array> [ f clGetPlatformIDs cl-success ] keep first
dup void* <c-array> [ f clGetPlatformIDs cl-success ] keep first
CL_DEVICE_TYPE_DEFAULT 1 f void* <ref> [ f clGetDeviceIDs cl-success ] keep void* deref :> device-id
f 1 device-id void* <ref> f f 0 int <ref> [ clCreateContext ] keep int deref cl-success :> context
context device-id 0 0 int <ref> [ clCreateCommandQueue ] keep int deref cl-success :> queue
@ -60,7 +60,7 @@ ERROR: cl-error err ;
queue clFinish cl-success
queue output CL_TRUE 0 in byte-length in length <float-array>
queue output CL_TRUE 0 in byte-length in length float <c-array>
[ 0 f f clEnqueueReadBuffer cl-success ] keep
input clReleaseMemObject cl-success

2
extra/opencl/ffi/ffi.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.libraries alien.syntax
USING: alien alien.c-types alien.data alien.libraries alien.syntax
classes.struct combinators system alien.accessors byte-arrays
kernel ;
IN: opencl.ffi

3
extra/opencl/opencl-tests.factor
View File

@ -36,7 +36,8 @@ __kernel void square(
{ num-floats } [ ] cl-queue-kernel &dispose drop
cl-finish
out-buffer 0 num-bytes <cl-buffer-range> cl-read-buffer num-floats <direct-float-array>
out-buffer 0 num-bytes <cl-buffer-range>
cl-read-buffer num-floats flloat <c-direct-array>
] with-cl-state
] with-destructors ;

6
extra/opencl/opencl.factor
View File

@ -60,7 +60,7 @@ ERROR: cl-error err ;
[ ascii decode 1 head* ] 2info ; inline
: info-size_t-array ( handle name quot -- size_t-array )
[ [ length size_t heap-size / ] keep swap <direct-size_t-array> ] info ; inline
[ [ length size_t heap-size / ] keep swap size_t <c-direct-array> ] info ; inline
TUPLE: cl-handle < disposable handle ;
PRIVATE>
@ -314,7 +314,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ;
CL_DEVICE_TYPE_ALL [
0 f 0 uint <ref> [ clGetDeviceIDs cl-success ] keep uint deref
] [
rot dup <void*-array> [ f clGetDeviceIDs cl-success ] keep
rot dup void* <c-array> [ f clGetDeviceIDs cl-success ] keep
] 2bi ; inline
: command-queue-info-ulong ( handle name -- ulong )
@ -427,7 +427,7 @@ PRIVATE>
: cl-platforms ( -- platforms )
0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
dup <void*-array> [ f clGetPlatformIDs cl-success ] keep
dup void* <c-array> [ f clGetPlatformIDs cl-success ] keep
[
dup
[ platform-info ]

10
extra/random/cmwc/cmwc-tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types arrays kernel random random.cmwc sequences
specialized-arrays tools.test ;
USING: alien.c-types alien.data arrays kernel random random.cmwc
sequences specialized-arrays tools.test ;
SPECIALIZED-ARRAY: uint
IN: random.cmwc.tests
@ -26,18 +26,18 @@ IN: random.cmwc.tests
}
] [
cmwc-4096
4096 iota >uint-array 362436 <cmwc-seed> seed-random [
4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] unit-test
[ t ] [
cmwc-4096 [
4096 iota >uint-array 362436 <cmwc-seed> seed-random [
4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] [
4096 iota >uint-array 362436 <cmwc-seed> seed-random [
4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] bi =

6
extra/random/cmwc/cmwc.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays fry kernel locals math
math.bitwise random sequences sequences.private
USING: accessors alien.c-types alien.data arrays fry kernel
locals math math.bitwise random sequences sequences.private
specialized-arrays ;
SPECIALIZED-ARRAY: uint
IN: random.cmwc
@ -24,7 +24,7 @@ TUPLE: cmwc-seed { Q uint-array read-only } { c read-only } ;
swap >>c
swap >>b
swap >>a
swap [ 1 - >>i ] [ <uint-array> >>Q ] bi
swap [ 1 - >>i ] [ uint <c-array> >>Q ] bi
dup b>> 1 - >>r
dup Q>> length 1 - >>mod ; inline

7
extra/random/lagged-fibonacci/lagged-fibonacci.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types fry kernel literals locals math
random sequences specialized-arrays namespaces sequences.private ;
USING: accessors alien.c-types alien.data fry kernel literals
locals math random sequences specialized-arrays namespaces
sequences.private ;
SPECIALIZED-ARRAY: double
IN: random.lagged-fibonacci
@ -54,7 +55,7 @@ M:: lagged-fibonacci seed-random ( lagged-fibonacci seed! -- lagged-fibonacci )
: <lagged-fibonacci> ( seed -- lagged-fibonacci )
lagged-fibonacci new
p-r 1 + <double-array> >>u
p-r 1 + double <c-array> >>u
swap seed-random ; inline
GENERIC: random-float* ( tuple -- r )

3
unmaintained/math/blas/matrices/matrices.factor
View File

@ -251,7 +251,6 @@ FUNCTOR: (define-blas-matrix) ( TYPE T U C -- )
VECTOR IS ${TYPE}-blas-vector
<VECTOR> IS <${TYPE}-blas-vector>
>ARRAY IS >${TYPE}-array
XGEMV IS ${T}GEMV
XGEMM IS ${T}GEMM
XGERU IS ${T}GER${U}
@ -281,7 +280,7 @@ M: MATRIX (blas-vector-like)
drop <VECTOR> ;
: >MATRIX ( arrays -- matrix )
[ >ARRAY underlying>> ] (>matrix) <MATRIX> ;
[ TYPE >c-array underlying>> ] (>matrix) <MATRIX> ;
M: VECTOR n*M.V+n*V!
(prepare-gemv) [ XGEMV ] dip ;

13
unmaintained/math/blas/vectors/vectors.factor
View File

@ -1,8 +1,8 @@
USING: accessors alien alien.c-types alien.complex arrays ascii
byte-arrays combinators combinators.short-circuit fry kernel
math math.blas.ffi math.complex math.functions math.order
sequences sequences.private functors words locals parser
prettyprint.backend prettyprint.custom specialized-arrays ;
USING: accessors alien alien.c-types alien.complex alien.data
arrays ascii byte-arrays combinators combinators.short-circuit
fry kernel math math.blas.ffi math.complex math.functions
math.order sequences sequences.private functors words locals
parser prettyprint.backend prettyprint.custom specialized-arrays ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double
@ -132,7 +132,6 @@ M: blas-vector-base virtual@
FUNCTOR: (define-blas-vector) ( TYPE T -- )
<DIRECT-ARRAY> IS <direct-${TYPE}-array>
>ARRAY IS >${TYPE}-array
XCOPY IS ${T}COPY
XSWAP IS ${T}SWAP
IXAMAX IS I${T}AMAX
@ -154,7 +153,7 @@ TUPLE: VECTOR < blas-vector-base ;
: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
: >VECTOR ( seq -- v )
[ >ARRAY underlying>> ] [ length ] bi 1 <VECTOR> ;
[ TYPE >c-array underlying>> ] [ length ] bi 1 <VECTOR> ;
M: VECTOR clone
TYPE heap-size (prepare-copy)