- Replace hand-written specialized-arrays.* subvocabularies with new system; instead of USE:ing specialized-arrays.T, do SPECIALIZED-ARRAY: T
- Ditto for specialized-vectors; use SPECIALIZED-VECTOR:
- io.mmap.functor: removed entirely, use <mapped-array> instead
- struct-arrays and struct-vectors have been removed because specialized arrays and vectors subsume them entirely
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, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. 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-object>
HELP: malloc-array
{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } }
{ $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, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. 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 } "." }
{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
HELP: require-c-array
{ $values { "c-type" "a C type" } }
-{ $description { $link require } "s any unloaded vocabularies needed to construct a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
-{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence types loaded." } ;
+{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
+{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ;
HELP: <c-direct-array>
{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
-{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." } ;
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
ARTICLE: "c-strings" "C strings"
"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
{ getter callable }
{ setter callable }
size
-align
-array-class
-array-constructor
-(array)-constructor
-direct-array-constructor ;
+align ;
TUPLE: c-type < abstract-c-type
boxer
] ?if
] if ;
-: ?require-word ( word/pair -- )
- dup word? [ drop ] [ first require ] ?if ;
-
! These words being foldable means that words need to be
! recompiled if a C type is redefined. Even so, folding the
! size facilitates some optimizations.
GENERIC: require-c-array ( c-type -- )
-M: object require-c-array
- drop ;
-
-M: c-type require-c-array
- array-class>> ?require-word ;
-
-M: string require-c-array
- c-type require-c-array ;
-
-M: array require-c-array
- first c-type require-c-array ;
-
-ERROR: specialized-array-vocab-not-loaded vocab word ;
+M: array require-c-array first require-c-array ;
-: c-array-constructor ( c-type -- word )
- array-constructor>> dup array?
- [ first2 specialized-array-vocab-not-loaded ] when ; foldable
+GENERIC: c-array-constructor ( c-type -- word )
-: c-(array)-constructor ( c-type -- word )
- (array)-constructor>> dup array?
- [ first2 specialized-array-vocab-not-loaded ] when ; foldable
+GENERIC: c-(array)-constructor ( c-type -- word )
-: c-direct-array-constructor ( c-type -- word )
- direct-array-constructor>> dup array?
- [ first2 specialized-array-vocab-not-loaded ] when ; foldable
+GENERIC: c-direct-array-constructor ( c-type -- word )
GENERIC: <c-array> ( len c-type -- array )
-M: object <c-array>
- c-array-constructor execute( len -- array ) ; inline
+
M: string <c-array>
- c-type <c-array> ; inline
-M: array <c-array>
- first c-type <c-array> ; inline
+ c-array-constructor execute( len -- array ) ; inline
GENERIC: (c-array) ( len c-type -- array )
-M: object (c-array)
- c-(array)-constructor execute( len -- array ) ; inline
+
M: string (c-array)
- c-type (c-array) ; inline
-M: array (c-array)
- first c-type (c-array) ; inline
+ c-(array)-constructor execute( len -- array ) ; inline
GENERIC: <c-direct-array> ( alien len c-type -- array )
-M: object <c-direct-array>
- c-direct-array-constructor execute( alien len -- array ) ; inline
+
M: string <c-direct-array>
- c-type <c-direct-array> ; inline
-M: array <c-direct-array>
- first c-type <c-direct-array> ; inline
+ c-direct-array-constructor execute( alien len -- array ) ; inline
: malloc-array ( n type -- alien )
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
: if-void ( type true false -- )
pick "void" = [ drop nip call ] [ nip call ] if ; inline
-: ?lookup ( vocab word -- word/pair )
- over vocab [ swap lookup ] [ 2array ] if ;
-
-: set-array-class* ( c-type vocab-stem type-stem -- c-type )
- {
- [
- [ "specialized-arrays." prepend ]
- [ "-array" append ] bi* ?lookup >>array-class
- ]
- [
- [ "specialized-arrays." prepend ]
- [ "<" "-array>" surround ] bi* ?lookup >>array-constructor
- ]
- [
- [ "specialized-arrays." prepend ]
- [ "(" "-array)" surround ] bi* ?lookup >>(array)-constructor
- ]
- [
- [ "specialized-arrays." prepend ]
- [ "<direct-" "-array>" surround ] bi* ?lookup >>direct-array-constructor
- ]
- } 2cleave ;
-
-: set-array-class ( c-type stem -- c-type )
- dup set-array-class* ;
-
CONSTANT: primitive-types
{
"char" "uchar"
[ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer
"alien_offset" >>unboxer
- "alien" "void*" set-array-class*
"void*" define-primitive-type
<long-long-type>
8 >>align
"box_signed_8" >>boxer
"to_signed_8" >>unboxer
- "longlong" set-array-class
"longlong" define-primitive-type
<long-long-type>
8 >>align
"box_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
- "ulonglong" set-array-class
"ulonglong" define-primitive-type
<c-type>
bootstrap-cell >>align
"box_signed_cell" >>boxer
"to_fixnum" >>unboxer
- "long" set-array-class
"long" define-primitive-type
<c-type>
bootstrap-cell >>align
"box_unsigned_cell" >>boxer
"to_cell" >>unboxer
- "ulong" set-array-class
"ulong" define-primitive-type
<c-type>
4 >>align
"box_signed_4" >>boxer
"to_fixnum" >>unboxer
- "int" set-array-class
"int" define-primitive-type
<c-type>
4 >>align
"box_unsigned_4" >>boxer
"to_cell" >>unboxer
- "uint" set-array-class
"uint" define-primitive-type
<c-type>
2 >>align
"box_signed_2" >>boxer
"to_fixnum" >>unboxer
- "short" set-array-class
"short" define-primitive-type
<c-type>
2 >>align
"box_unsigned_2" >>boxer
"to_cell" >>unboxer
- "ushort" set-array-class
"ushort" define-primitive-type
<c-type>
1 >>align
"box_signed_1" >>boxer
"to_fixnum" >>unboxer
- "char" set-array-class
"char" define-primitive-type
<c-type>
1 >>align
"box_unsigned_1" >>boxer
"to_cell" >>unboxer
- "uchar" set-array-class
"uchar" define-primitive-type
<c-type>
1 >>align
"box_boolean" >>boxer
"to_boolean" >>unboxer
- "bool" set-array-class
"bool" define-primitive-type
<c-type>
"to_float" >>unboxer
float-rep >>rep
[ >float ] >>unboxer-quot
- "float" set-array-class
"float" define-primitive-type
<c-type>
"to_double" >>unboxer
double-rep >>rep
[ >float ] >>unboxer-quot
- "double" set-array-class
"double" define-primitive-type
"long" "ptrdiff_t" typedef
<T> 1quotation >>unboxer-quot
*T 1quotation >>boxer-quot
number >>boxed-class
-T set-array-class
drop
;FUNCTOR
[ name>> = ] with find nip offset>> ;
USE: vocabs.loader
-"struct-arrays" require
+"specialized-arrays" require
--- /dev/null
+unportable
sequences byte-arrays locals sequences.private macros fry
io.encodings.binary math.bitwise checksums accessors
checksums.common checksums.stream combinators combinators.smart
-specialized-arrays.uint literals hints ;
+specialized-arrays literals hints ;
+SPECIALIZED-ARRAY: uint
IN: checksums.md5
SINGLETON: md5
compiler.tree.debugger compiler.units destructors
io.encodings.utf8 io.pathnames io.streams.string kernel libc
literals math mirrors multiline namespaces prettyprint
-prettyprint.config see sequences specialized-arrays.char
-specialized-arrays.int specialized-arrays.ushort
-struct-arrays system tools.test ;
+prettyprint.config see sequences specialized-arrays
+system tools.test ;
+SPECIALIZED-ARRAY: char
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: ushort
IN: classes.struct.tests
<<
STRUCT: struct-test-optimization
{ x { "int" 3 } } { y int } ;
+SPECIALIZED-ARRAY: struct-test-optimization
+
[ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [
- [ 3 struct-test-optimization <direct-struct-array> third y>> ]
+ [ 3 <direct-struct-test-optimization-array> third y>> ]
{ <tuple> <tuple-boa> memory>struct y>> } inlined?
] unit-test
classes.tuple classes.tuple.parser classes.tuple.private
combinators combinators.short-circuit combinators.smart
definitions functors.backend fry generalizations generic.parser
-kernel kernel.private lexer libc locals macros make math math.order
-parser quotations sequences slots slots.private struct-arrays vectors
-words compiler.tree.propagation.transforms specialized-arrays.uchar ;
+kernel kernel.private lexer libc locals macros make math
+math.order parser quotations sequences slots slots.private
+specialized-arrays vectors words
+compiler.tree.propagation.transforms ;
FROM: slots => reader-word writer-word ;
IN: classes.struct
-! struct class
+SPECIALIZED-ARRAY: uchar
ERROR: struct-must-have-slots ;
stack-checker kernel math namespaces make quotations sequences
strings words cocoa.runtime io macros memoize io.encodings.utf8
effects libc libc.private lexer init core-foundation fry
-generalizations specialized-arrays.alien ;
+generalizations specialized-arrays ;
IN: cocoa.messages
+SPECIALIZED-ARRAY: void*
+
: make-sender ( method function -- quot )
[ over first , f , , second , \ alien-invoke , ] [ ] make ;
compiler continuations effects io io.backend io.pathnames
io.streams.string kernel math memory namespaces
namespaces.private parser quotations sequences
-specialized-arrays.float stack-checker stack-checker.errors
-system threads tools.test words specialized-arrays.char ;
+specialized-arrays stack-checker stack-checker.errors
+system threads tools.test words ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: char
IN: compiler.tests.alien
<<
compiler.tree.propagation.info compiler.tree.def-use
compiler.tree.debugger compiler.tree.checker
slots.private words hashtables classes assocs locals
-specialized-arrays.double system sorting math.libm
+specialized-arrays system sorting math.libm
math.intervals quotations effects alien ;
+SPECIALIZED-ARRAY: double
IN: compiler.tree.propagation.tests
[ V{ } ] [ [ ] final-classes ] unit-test
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax core-foundation kernel assocs
-specialized-arrays.alien math sequences accessors ;
+specialized-arrays math sequences accessors ;
IN: core-foundation.dictionaries
+SPECIALIZED-ARRAY: void*
+
TYPEDEF: void* CFDictionaryRef
TYPEDEF: void* CFMutableDictionaryRef
TYPEDEF: void* CFDictionaryKeyCallBacks*
USING: alien alien.c-types alien.strings alien.syntax kernel
math sequences namespaces make assocs init accessors
continuations combinators io.encodings.utf8 destructors locals
-arrays specialized-arrays.alien classes.struct
-specialized-arrays.int specialized-arrays.longlong
-core-foundation core-foundation.run-loop core-foundation.strings
+arrays specialized-arrays classes.struct core-foundation
+core-foundation.run-loop core-foundation.strings
core-foundation.time ;
IN: core-foundation.fsevents
+SPECIALIZED-ARRAY: void*
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: longlong
+
CONSTANT: kFSEventStreamCreateFlagUseCFTypes 2
CONSTANT: kFSEventStreamCreateFlagWatchRoot 4
libc calendar.format byte-arrays destructors prettyprint
accessors strings serialize io.encodings.binary io.encodings.utf8
alien.strings io.streams.byte-array summary present urls
-specialized-arrays.uint specialized-arrays.alien db.private ;
+specialized-arrays db.private ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: void*
IN: db.postgresql.lib
: postgresql-result-error-message ( res -- str/f )
game-input.dinput.keys-array io.encodings.utf16
io.encodings.utf16n kernel locals math math.bitwise
math.rectangles namespaces parser sequences shuffle
-struct-arrays ui.backend.windows vectors windows.com
+specialized-arrays ui.backend.windows vectors windows.com
windows.dinput windows.dinput.constants windows.errors
windows.kernel32 windows.messages windows.ole32
windows.user32 classes.struct ;
+SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
IN: game-input.dinput
+
CONSTANT: MOUSE-BUFFER-SIZE 16
SINGLETON: dinput-game-input-backend
: find-mouse ( -- )
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 <struct-array>
- +mouse-buffer+ set-global ;
+ [ 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 ;
: device-info ( device -- DIDEVICEIMAGEINFOW )
DIDEVICEINSTANCEW <struct>
images.bitmap.loading images.loader io io.binary
io.encodings.binary io.encodings.string io.files
io.streams.limited kernel locals macros math math.bitwise
-math.functions namespaces sequences specialized-arrays.uint
-specialized-arrays.ushort strings summary ;
+math.functions namespaces sequences specialized-arrays
+strings summary ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ushort
IN: images.bitmap
: write2 ( n -- ) 2 >le write ;
compression.run-length fry grouping images images.loader io
io.binary io.encodings.8-bit io.encodings.binary
io.encodings.string io.streams.limited kernel math math.bitwise
-sequences specialized-arrays.ushort summary ;
+sequences specialized-arrays summary ;
QUALIFIED-WITH: bitstreams b
+SPECIALIZED-ARRAY: ushort
IN: images.bitmap.loading
SINGLETON: bitmap-image
io.binary io.encodings.ascii io.encodings.binary
io.encodings.string io.encodings.utf8 io.files kernel math
math.bitwise math.order math.parser pack prettyprint sequences
-strings math.vectors specialized-arrays.float locals
+strings math.vectors specialized-arrays locals
images.loader ;
+SPECIALIZED-ARRAY: float
IN: images.tiff
SINGLETON: tiff-image
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes.struct kernel destructors bit-arrays
-sequences assocs struct-arrays math namespaces locals fry unix
-unix.linux.epoll unix.time io.ports io.backend.unix
-io.backend.unix.multiplexers ;
+sequences assocs specialized-arrays math namespaces
+locals fry unix unix.linux.epoll unix.time io.ports
+io.backend.unix io.backend.unix.multiplexers ;
+SPECIALIZED-ARRAY: epoll-event
IN: io.backend.unix.multiplexers.epoll
TUPLE: epoll-mx < mx events ;
: <epoll-mx> ( -- mx )
epoll-mx new-mx
max-events epoll_create dup io-error >>fd
- max-events epoll-event <struct-array> >>events ;
+ max-events <epoll-event-array> >>events ;
M: epoll-mx dispose* fd>> close-file ;
! 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 struct-arrays unix
-unix.kqueue unix.time assocs io.backend.unix.multiplexers
-classes.struct ;
+io.backend.unix kernel math.bitwise sequences
+specialized-arrays unix unix.kqueue unix.time assocs
+io.backend.unix.multiplexers classes.struct ;
+SPECIALIZED-ARRAY: kevent
IN: io.backend.unix.multiplexers.kqueue
TUPLE: kqueue-mx < mx events ;
: <kqueue-mx> ( -- mx )
kqueue-mx new-mx
kqueue dup io-error >>fd
- max-events \ kevent <struct-array> >>events ;
+ max-events <kevent-array> >>events ;
M: kqueue-mx dispose* fd>> close-file ;
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 struct-arrays ;
+arrays io.files.info.unix classes.struct
+specialized-arrays ;
+SPECIALIZED-ARRAY: statfs
IN: io.files.info.unix.freebsd
TUPLE: freebsd-file-system-info < unix-file-system-info
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
- \ statfs <struct-array>
+ <statfs-array>
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings combinators
-grouping io.encodings.utf8 io.files kernel math sequences
-system unix io.files.unix specialized-arrays.uint arrays
-unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx
-io.files.info.unix io.files.info classes.struct struct-arrays ;
+grouping io.encodings.utf8 io.files kernel math sequences system
+unix io.files.unix arrays unix.statfs.macosx unix.statvfs.macosx
+unix.getfsstat.macosx io.files.info.unix io.files.info
+classes.struct specialized-arrays ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: statfs64
IN: io.files.info.unix.macosx
TUPLE: macosx-file-system-info < unix-file-system-info
M: macosx file-systems ( -- array )
f <void*> dup 0 getmntinfo64 dup io-error
- [ *void* ] dip \ statfs64 <direct-struct-array>
+ [ *void* ] dip <direct-statfs64-array>
[ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ;
M: macosx new-file-system-info macosx-file-system-info new ;
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 struct-arrays
-io.files.info.unix ;
+grouping sequences io.encodings.utf8 classes.struct
+specialized-arrays io.files.info.unix ;
+SPECIALIZED-ARRAY: statvfs
IN: io.files.info.unix.netbsd
TUPLE: netbsd-file-system-info < unix-file-system-info
M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error
- \ statvfs <struct-array>
+ <statvfs-array>
[ dup byte-length 0 getvfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
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 struct-arrays
-io.encodings.utf8 ;
+arrays io.files.info.unix classes.struct
+specialized-arrays io.encodings.utf8 ;
+SPECIALIZED-ARRAY: statvfs
IN: io.files.unix.openbsd
TUPLE: openbsd-file-system-info < unix-file-system-info
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
- \ statfs <struct-array>
+ <statfs-array>
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
USING: accessors kernel system math math.bitwise strings arrays
sequences combinators combinators.short-circuit alien.c-types
vocabs.loader calendar calendar.unix io.files.info
-io.files.types io.backend io.directories unix unix.stat unix.time unix.users
-unix.groups classes.struct struct-arrays ;
+io.files.types io.backend io.directories unix unix.stat
+unix.time unix.users unix.groups classes.struct
+specialized-arrays ;
+SPECIALIZED-ARRAY: timeval
IN: io.files.info.unix
TUPLE: unix-file-system-info < file-system-info
: timestamps>byte-array ( timestamps -- byte-array )
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
- \ timeval >struct-array ;
+ >timeval-array ;
PRIVATE>
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
calendar ascii combinators.short-circuit locals classes.struct
-specialized-arrays.ushort ;
+specialized-arrays ;
+SPECIALIZED-ARRAY: ushort
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
alien.c-types alien.arrays alien.strings sequences combinators
combinators.short-circuit ascii splitting alien strings assocs
namespaces make accessors tr windows.time windows.shell32
-windows.errors specialized-arrays.ushort classes.struct ;
+windows.errors specialized-arrays classes.struct ;
+SPECIALIZED-ARRAY: ushort
IN: io.files.windows.nt
M: winnt cwd
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays continuations io
-io.backend.windows io.pipes.windows.nt io.pathnames libc io.ports
-windows.types math windows.kernel32
-namespaces make io.launcher kernel sequences windows.errors
-splitting system threads init strings combinators
-io.backend accessors concurrency.flags io.files assocs
-io.files.private windows destructors specialized-arrays.ushort
-specialized-arrays.alien classes classes.struct ;
+io.backend.windows io.pipes.windows.nt io.pathnames libc
+io.ports windows.types math windows.kernel32 namespaces make
+io.launcher kernel sequences windows.errors splitting system
+threads init strings combinators io.backend accessors
+concurrency.flags io.files assocs io.files.private windows
+destructors specialized-arrays.alien classes classes.struct ;
+SPECIALIZED-ARRAY: ushort
IN: io.launcher.windows
TUPLE: CreateProcess-args
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.alien ;
-IN: io.mmap.alien
-
-<< "void*" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.bool ;
-IN: io.mmap.bool
-
-<< "bool" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.char ;
-IN: io.mmap.char
-
-<< "char" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.double ;
-IN: io.mmap.double
-
-<< "double" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.float ;
-IN: io.mmap.float
-
-<< "float" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: io.mmap functors accessors alien.c-types math kernel
-words fry ;
-IN: io.mmap.functor
-
-SLOT: address
-SLOT: length
-
-: mapped-file>direct ( mapped-file type -- alien length )
- [ [ address>> ] [ length>> ] bi ] dip
- heap-size [ 1 - + ] keep /i ;
-
-FUNCTOR: define-mapped-array ( T -- )
-
-<mapped-A> DEFINES <mapped-${T}-array>
-<A> IS <direct-${T}-array>
-with-mapped-A-file DEFINES with-mapped-${T}-file
-with-mapped-A-file-reader DEFINES with-mapped-${T}-file-reader
-
-WHERE
-
-: <mapped-A> ( mapped-file -- direct-array )
- T mapped-file>direct <A> ; inline
-
-: with-mapped-A-file ( path quot -- )
- '[ <mapped-A> @ ] with-mapped-file ; inline
-
-: with-mapped-A-file-reader ( path quot -- )
- '[ <mapped-A> @ ] with-mapped-file-reader ; inline
-
-;FUNCTOR
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.int ;
-IN: io.mmap.int
-
-<< "int" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.long ;
-IN: io.mmap.long
-
-<< "long" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.longlong ;
-IN: io.mmap.longlong
-
-<< "longlong" define-mapped-array >>
\ No newline at end of file
-USING: io io.mmap io.mmap.char io.files io.files.temp
+USING: io io.mmap io.files io.files.temp
io.directories kernel tools.test continuations sequences
io.encodings.ascii accessors math ;
IN: io.mmap.tests
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
[ ] [ "12345" "mmap-test-file.txt" temp-file ascii set-file-contents ] unit-test
-[ ] [ "mmap-test-file.txt" temp-file [ CHAR: 2 0 pick set-nth drop ] with-mapped-char-file ] unit-test
-[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
-[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file-reader ] unit-test
+[ ] [ "mmap-test-file.txt" temp-file [ "char" <mapped-array> CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" temp-file [ "char" <mapped-array> length ] with-mapped-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" temp-file [ "char" <mapped-array> length ] with-mapped-file-reader ] unit-test
[ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
-! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
+! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors io.files io.files.info
io.backend kernel quotations system alien alien.accessors
: <mapped-file> ( path -- mmap )
[ (mapped-file-r/w) ] prepare-mapped-file ;
+: <mapped-array> ( mmap c-type -- direct-array )
+ [ [ address>> ] [ length>> ] bi ] dip
+ [ heap-size /i ] keep
+ <c-direct-array> ; inline
+
HOOK: close-mapped-file io-backend ( mmap -- )
M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.short ;
-IN: io.mmap.short
-
-<< "short" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.uchar ;
-IN: io.mmap.uchar
-
-<< "uchar" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.uint ;
-IN: io.mmap.uint
-
-<< "uint" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.ulong ;
-IN: io.mmap.ulong
-
-<< "ulong" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.ulonglong ;
-IN: io.mmap.ulonglong
-
-<< "ulonglong" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.ushort ;
-IN: io.mmap.ushort
-
-<< "ushort" define-mapped-array >>
\ No newline at end of file
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: system kernel unix math sequences
-io.backend.unix io.ports specialized-arrays.int accessors ;
-IN: io.pipes.unix
+io.backend.unix io.ports specialized-arrays accessors ;
QUALIFIED: io.pipes
+SPECIALIZED-ARRAY: int
+IN: io.pipes.unix
M: unix io.pipes:(pipe) ( -- pair )
2 <int-array>
math math.blas.ffi math.blas.vectors math.blas.vectors.private
math.complex math.functions math.order functors words
sequences sequences.merged sequences.private shuffle
-specialized-arrays.float specialized-arrays.double
-specialized-arrays.complex-float specialized-arrays.complex-double
-parser prettyprint.backend prettyprint.custom ascii ;
+parser prettyprint.backend prettyprint.custom ascii
+specialized-arrays ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: complex-float
+SPECIALIZED-ARRAY: complex-double
IN: math.blas.matrices
TUPLE: blas-matrix-base underlying ld rows cols transpose ;
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.float specialized-arrays.double
-specialized-arrays.complex-float specialized-arrays.complex-double ;
+specialized-arrays ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: complex-float
+SPECIALIZED-ARRAY: complex-double
IN: math.blas.vectors
TUPLE: blas-vector-base underlying length inc ;
-IN: math.vectors.simd.alien.tests
USING: cpu.architecture math.vectors.simd
math.vectors.simd.intrinsics accessors math.vectors.simd.alien
kernel classes.struct tools.test compiler sequences byte-arrays
-alien math kernel.private specialized-arrays.float combinators ;
+alien math kernel.private specialized-arrays combinators ;
+SPECIALIZED-ARRAY: float
+IN: math.vectors.simd.alien.tests
! Vector alien intrinsics
[ float-4{ 1 2 3 4 } ] [
IN: math.vectors.specialization.tests
USING: compiler.tree.debugger math.vectors tools.test kernel
-kernel.private math specialized-arrays.double
-specialized-arrays.complex-float
-specialized-arrays.float ;
+kernel.private math specialized-arrays ;
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: complex-float
+SPECIALIZED-ARRAY: float
[ V{ t } ] [
[ { double-array double-array } declare distance 0.0 < not ] final-literals
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: words kernel make sequences effects kernel.private accessors
-combinators math math.intervals math.vectors namespaces assocs fry
-splitting classes.algebra generalizations locals
-compiler.tree.propagation.info ;
+USING: alien.c-types words kernel make sequences effects
+kernel.private accessors combinators math math.intervals
+math.vectors namespaces assocs fry splitting classes.algebra
+generalizations locals compiler.tree.propagation.info ;
IN: math.vectors.specialization
SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ;
array-type elt-type word word-schema inputs signature-for-schema ;
:: specialize-vector-words ( array-type elt-type simd -- )
- vector-words keys [
- [ array-type elt-type simd specialize-vector-word ]
- [ array-type elt-type input-signature ]
- [ ]
- tri add-specialization
- ] each ;
+ elt-type number class<= [
+ vector-words keys [
+ [ array-type elt-type simd specialize-vector-word ]
+ [ array-type elt-type input-signature ]
+ [ ]
+ tri add-specialization
+ ] each
+ ] when ;
: find-specialization ( classes word -- word/f )
specializations
math.parser opengl.gl combinators combinators.smart arrays
sequences splitting words byte-arrays assocs vocabs
colors colors.constants accessors generalizations locals fry
-specialized-arrays.float specialized-arrays.uint ;
+specialized-arrays ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: uint
IN: opengl
: gl-color ( color -- ) >rgba-components glColor4d ; inline
! See http://factorcode.org/license.txt for BSD license.
USING: kernel opengl.gl alien.c-types continuations namespaces
assocs alien alien.strings libc opengl math sequences combinators
-macros arrays io.encodings.ascii fry specialized-arrays.uint
+macros arrays io.encodings.ascii fry specialized-arrays
destructors accessors ;
+SPECIALIZED-ARRAY: uint
IN: opengl.shaders
: with-gl-shader-source-ptr ( string quot -- )
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs cache colors.constants destructors kernel
-opengl opengl.gl opengl.capabilities combinators images
-images.tesselation grouping specialized-arrays.float sequences math
-math.vectors math.matrices generalizations fry arrays namespaces
-system locals literals ;
+USING: accessors assocs cache colors.constants destructors
+kernel opengl opengl.gl opengl.capabilities combinators images
+images.tesselation grouping sequences math math.vectors
+math.matrices generalizations fry arrays namespaces system
+locals literals specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: opengl.textures
SYMBOL: non-power-of-2-textures?
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
USING: kernel math namespaces sequences sequences.private system
init accessors math.ranges random math.bitwise combinators
-specialized-arrays.uint fry ;
+specialized-arrays fry ;
+SPECIALIZED-ARRAY: uint
IN: random.mersenne-twister
<PRIVATE
HELP: complex-sequence
{ $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." }
{ $examples { $example <"
-USING: prettyprint
-specialized-arrays.double sequences.complex
-sequences arrays ;
+USING: prettyprint specialized-arrays ;
+sequences.complex sequences arrays ;
+SPECIALIZED-ARRAY: double
double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> >array .
"> "{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ;
{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." }
{ $examples { $example <"
USING: prettyprint
-specialized-arrays.double sequences.complex
+specialized-arrays sequences.complex
sequences arrays ;
+SPECIALIZED-ARRAY: double
double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> second .
"> "C{ -2.0 2.0 }" } } ;
-USING: specialized-arrays.float sequences.complex
+USING: specialized-arrays sequences.complex
kernel sequences tools.test arrays accessors ;
+SPECIALIZED-ARRAY: float
IN: sequences.complex.tests
: test-array ( -- x )
! See http://factorcode.org/license.txt for BSD license.
!
USING: tools.test kernel serialize io io.streams.byte-array
-alien arrays byte-arrays bit-arrays specialized-arrays.double
+alien arrays byte-arrays bit-arrays specialized-arrays
sequences math prettyprint parser classes math.constants
io.encodings.binary random assocs serialize.private ;
+SPECIALIZED-ARRAY: double
IN: serialize.tests
: test-serialize-cell ( a -- ? )
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.alien
-
-<< "void*" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.bool
-
-<< "bool" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.char
-
-<< "char" define-array >>
\ No newline at end of file
+++ /dev/null
-USING: kernel sequences specialized-arrays.complex-double tools.test ;
-IN: specialized-arrays.complex-double.tests
-
-[ C{ 3.0 2.0 } ]
-[ complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 } second ] unit-test
-
-[ C{ 1.0 0.0 } ]
-[ complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 } first ] unit-test
-
-[ complex-double-array{ 1.0 C{ 6.0 -7.0 } 5.0 } ] [
- complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 }
- dup [ C{ 6.0 -7.0 } 1 ] dip set-nth
-] unit-test
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.complex-double
-
-<< "complex-double" define-array >>
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.complex-float
-
-<< "complex-float" define-array >>
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.double
-
-<< "double" define-array >>
-
-! Specializer hints. These should really be generalized, and placed
-! somewhere else
-USING: hints math.vectors arrays kernel math accessors sequences ;
-
-HINTS: <double-array> { 2 } { 3 } ;
-
-HINTS: (double-array) { 2 } { 3 } ;
-
-! Type functions
-USING: words classes.algebra compiler.tree.propagation.info
-math.intervals ;
-
-\ norm-sq [
- class>> double-array class<= [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
-] "outputs" set-word-prop
-
-\ distance [
- [ class>> double-array class<= ] both?
- [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
-] "outputs" set-word-prop
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.float
-
-<< "float" define-array >>
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: functors sequences sequences.private prettyprint.custom
-kernel words classes math math.vectors.specialization parser
-alien.c-types byte-arrays accessors summary alien specialized-arrays ;
-IN: specialized-arrays.functor
-
-ERROR: bad-byte-array-length byte-array type ;
-
-M: bad-byte-array-length summary
- drop "Byte array length doesn't divide type width" ;
-
-: (underlying) ( n c-type -- array )
- heap-size * (byte-array) ; inline
-
-: <underlying> ( n type -- array )
- heap-size * <byte-array> ; inline
-
-FUNCTOR: define-array ( T -- )
-
-A DEFINES-CLASS ${T}-array
-S DEFINES-CLASS ${T}-sequence
-<A> DEFINES <${A}>
-(A) DEFINES (${A})
-<direct-A> DEFINES <direct-${A}>
->A DEFINES >${A}
-byte-array>A DEFINES byte-array>${A}
-
-A{ DEFINES ${A}{
-A@ DEFINES ${A}@
-
-NTH [ T dup c-type-getter-boxer array-accessor ]
-SET-NTH [ T dup c-setter array-accessor ]
-
-WHERE
-
-MIXIN: S
-
-TUPLE: A
-{ underlying c-ptr read-only }
-{ length array-capacity read-only } ;
-
-: <direct-A> ( alien len -- specialized-array ) A boa ; inline
-
-: <A> ( n -- specialized-array ) [ T <underlying> ] keep <direct-A> ; inline
-
-: (A) ( n -- specialized-array ) [ T (underlying) ] keep <direct-A> ; inline
-
-: byte-array>A ( byte-array -- specialized-array )
- dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
- <direct-A> ; inline
-
-M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
-
-M: A length length>> ; inline
-
-M: A nth-unsafe underlying>> NTH call ; inline
-
-M: A set-nth-unsafe underlying>> SET-NTH call ; inline
-
-: >A ( seq -- specialized-array ) A new clone-like ;
-
-M: A like drop dup A instance? [ >A ] unless ; inline
-
-M: A new-sequence drop (A) ; inline
-
-M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
-
-M: A resize
- [
- [ T heap-size * ] [ underlying>> ] bi*
- resize-byte-array
- ] [ drop ] 2bi
- <direct-A> ; inline
-
-M: A byte-length underlying>> length ; inline
-M: A pprint-delims drop \ A{ \ } ;
-M: A >pprint-sequence ;
-
-SYNTAX: A{ \ } [ >A ] parse-literal ;
-SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
-
-INSTANCE: A specialized-array
-
-A T c-type-boxed-class f specialize-vector-words
-
-T c-type
- \ A >>array-class
- \ <A> >>array-constructor
- \ (A) >>(array)-constructor
- \ <direct-A> >>direct-array-constructor
- drop
-
-;FUNCTOR
+++ /dev/null
-Code generation for specialized arrays
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.int
-
-<< "int" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.long
-
-<< "long" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.longlong
-
-<< "longlong" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.alien
-
-<< "ptrdiff_t" define-array >>
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.short
-
-<< "short" define-array >>
\ No newline at end of file
-USING: help.markup help.syntax byte-arrays ;
+USING: help.markup help.syntax byte-arrays alien ;
IN: specialized-arrays
-ARTICLE: "specialized-arrays" "Specialized arrays"
-"The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing."
-$nl
-"For each primitive C type " { $snippet "T" } ", a set of words are defined in the vocabulary named " { $snippet "specialized-arrays.T" } ":"
+HELP: SPECIALIZED-ARRAY:
+{ $syntax "SPECIALIZED-ARRAY: type" }
+{ $values { "type" "a C type" } }
+{ $description "Brings a specialized array for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-array-words" } "." } ;
+
+ARTICLE: "specialized-array-words" "Specialized array words"
+"The " { $link POSTPONE: SPECIALIZED-ARRAY: } " parsing word generates the specialized array type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:"
{ $table
{ { $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 "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( alien len -- array )" } } }
+ { { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } }
+ { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated unmanaged memory; stack effect " { $snippet "( alien len -- array )" } } }
+ { { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } }
{ { $snippet "byte-array>T-array" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } }
{ { $snippet ">T-array" } { "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 "}" } } }
}
-"Each specialized array has a " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. This data can be passed to C functions."
-$nl
-"The primitive C types for which specialized arrays exist:"
-{ $list
- { $snippet "char" }
- { $snippet "uchar" }
- { $snippet "short" }
- { $snippet "ushort" }
- { $snippet "int" }
- { $snippet "uint" }
- { $snippet "long" }
- { $snippet "ulong" }
- { $snippet "longlong" }
- { $snippet "ulonglong" }
- { $snippet "float" }
- { $snippet "double" }
- { $snippet "complex-float" }
- { $snippet "complex-double" }
- { $snippet "void*" }
- { $snippet "bool" }
-}
-"Note that " { $vocab-link "specialized-arrays.bool" } " behaves like a C " { $snippet "bool[]" } " array, and each element takes up 8 bits of space. For a more space-efficient boolean array, see " { $link "bit-arrays" } "."
-$nl
-"Specialized arrays are generated with a functor in the " { $vocab-link "specialized-arrays.functor" } " vocabulary."
+"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: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
+
+ARTICLE: "specialized-array-c" "Passing specialized arrays to C functions"
+"Each specialized array has a " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. Passing a specialized array as a parameter to a C function call will automatically extract the underlying data. To get at the underlying data directly, call the " { $link >c-ptr } " word on a specialized array." ;
+
+ARTICLE: "specialized-array-math" "Vector arithmetic with specialized arrays"
+"Each specialized array with a numeric type generates specialized versions of the " { $link "math-vectors" } " words. The compiler substitutes calls for these words if it can statically determine input types. The " { $snippet "optimized." } " word in the " { $vocab-link "compiler.tree.debugger" } " vocabulary can be used to determine if this optimization is being performed for a particular piece of code." ;
+
+ARTICLE: "specialized-array-examples" "Specialized array examples"
+"Let's import specialized float arrays:"
+{ $code "USING: specialized-arrays math.constants math.functions ;" "SPECIALIZED-ARRAY: float" }
+"Creating a float array with 3 elements:"
+{ $code "1.0 [ sin ] [ cos ] [ tan ] tri float-array{ } 3sequence ." }
+"Create a float array and sum the elements:"
+{ $code
+ "1000 iota [ 1000 /f pi * sin ] float-array{ } map-as"
+ "0.0 [ + ] reduce ."
+} ;
+
+ARTICLE: "specialized-arrays" "Specialized arrays"
+"The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing."
$nl
-"The " { $vocab-link "specialized-vectors" } " vocabulary provides resizable versions of the above." ;
+"A specialized array type needs to be generated for each element type. This is done with a parsing word:"
+{ $subsection POSTPONE: SPECIALIZED-ARRAY: }
+"This parsing word adds new words to the search path:"
+{ $subsection "specialized-array-words" }
+{ $subsection "specialized-array-c" }
+{ $subsection "specialized-array-math" }
+{ $subsection "specialized-array-examples" }
+"The " { $vocab-link "specialized-vectors" } " vocabulary provides a resizable version of this abstraction." ;
ABOUT: "specialized-arrays"
IN: specialized-arrays.tests
-USING: tools.test alien.syntax specialized-arrays sequences
-specialized-arrays.int specialized-arrays.bool
-specialized-arrays.ushort alien.c-types accessors kernel
-specialized-arrays.char specialized-arrays.uint
-specialized-arrays.float arrays combinators compiler ;
+USING: tools.test alien.syntax specialized-arrays
+specialized-arrays sequences alien.c-types accessors
+kernel arrays combinators compiler classes.struct
+combinators.smart compiler.tree.debugger math libc destructors
+sequences.private ;
+
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: bool
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: char
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: float
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
3 ALIEN: 123 100 <direct-ushort-array> new-sequence
dup [ drop 0 ] change-each
] unit-test
+
+STRUCT: test-struct
+ { x int }
+ { y int } ;
+
+SPECIALIZED-ARRAY: test-struct
+
+[ 1 ] [
+ 1 test-struct-array{ } new-sequence length
+] unit-test
+
+[ V{ test-struct } ] [
+ [ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
+] unit-test
+
+: make-point ( x y -- struct )
+ test-struct <struct-boa> ;
+
+[ 5/4 ] [
+ 2 <test-struct-array>
+ 1 2 make-point over set-first
+ 3 4 make-point over set-second
+ 0 [ [ x>> ] [ y>> ] bi / + ] reduce
+] unit-test
+
+[ 5/4 ] [
+ [
+ 2 malloc-test-struct-array
+ dup &free drop
+ 1 2 make-point over set-first
+ 3 4 make-point over set-second
+ 0 [ [ x>> ] [ y>> ] bi / + ] reduce
+ ] with-destructors
+] unit-test
+
+[ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
+
+[ ] [
+ [
+ 10 malloc-test-struct-array
+ &free drop
+ ] with-destructors
+] unit-test
+
+[ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
+
+[ S{ test-struct f 12 20 } ] [
+ test-struct-array{
+ S{ test-struct f 4 20 }
+ S{ test-struct f 12 20 }
+ S{ test-struct f 20 20 }
+ } second
+] unit-test
+
+! Regression
+STRUCT: fixed-string { text char[100] } ;
+
+SPECIALIZED-ARRAY: fixed-string
+
+[ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
+ ALIEN: 123 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
+] unit-test
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences vocabs vocabs.loader ;
+USING: accessors alien alien.c-types assocs byte-arrays classes
+compiler.units functors io kernel lexer libc math
+math.vectors.specialization namespaces parser
+prettyprint.custom sequences sequences.private strings summary
+vocabs vocabs.loader vocabs.parser words ;
IN: specialized-arrays
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" ;
+
+: (underlying) ( n c-type -- array )
+ heap-size * (byte-array) ; inline
+
+: <underlying> ( n type -- array )
+ heap-size * <byte-array> ; inline
+
+<PRIVATE
+
+FUNCTOR: define-array ( T -- )
+
+A DEFINES-CLASS ${T}-array
+S DEFINES-CLASS ${T}-sequence
+<A> DEFINES <${A}>
+(A) DEFINES (${A})
+<direct-A> DEFINES <direct-${A}>
+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-type-getter-boxer array-accessor ]
+SET-NTH [ T dup c-setter array-accessor ]
+
+WHERE
+
+MIXIN: S
+
+TUPLE: A
+{ underlying c-ptr read-only }
+{ length array-capacity read-only } ;
+
+: <direct-A> ( alien len -- specialized-array ) A boa ; inline
+
+: <A> ( n -- specialized-array ) [ T <underlying> ] keep <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
+
+: byte-array>A ( byte-array -- specialized-array )
+ dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
+ <direct-A> ; inline
+
+M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
+
+M: A length length>> ; inline
+
+M: A nth-unsafe underlying>> NTH call ; inline
+
+M: A set-nth-unsafe underlying>> SET-NTH call ; inline
+
+: >A ( seq -- specialized-array ) A new clone-like ;
+
+M: A like drop dup A instance? [ >A ] unless ; inline
+
+M: A new-sequence drop (A) ; inline
+
+M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
+
+M: A resize
+ [
+ [ T heap-size * ] [ underlying>> ] bi*
+ resize-byte-array
+ ] [ drop ] 2bi
+ <direct-A> ; inline
+
+M: A byte-length underlying>> length ; inline
+M: A pprint-delims drop \ A{ \ } ;
+M: A >pprint-sequence ;
+
+SYNTAX: A{ \ } [ >A ] parse-literal ;
+SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
+
+INSTANCE: A specialized-array
+
+A T c-type-boxed-class f specialize-vector-words
+
+;FUNCTOR
+
+: underlying-type ( c-type -- c-type' )
+ dup c-types get at string? [
+ c-types get at underlying-type
+ ] when ;
+
+: specialized-array-vocab ( c-type -- vocab )
+ "specialized-arrays.instances." prepend ;
+
+: defining-array-message ( type -- )
+ "quiet" get [ drop ] [
+ "Generating specialized " " arrays..." surround print
+ ] if ;
+
+PRIVATE>
+
+: define-array-vocab ( type -- vocab )
+ underlying-type
+ dup specialized-array-vocab vocab
+ [ ] [
+ [ defining-array-message ]
+ [
+ [
+ dup specialized-array-vocab
+ [ define-array ] with-current-vocab
+ ] with-compilation-unit
+ ]
+ [ specialized-array-vocab ]
+ tri
+ ] ?if ;
+
+M: string require-c-array define-array-vocab drop ;
+
+ERROR: specialized-array-vocab-not-loaded c-type ;
+
+M: string c-array-constructor
+ underlying-type
+ dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+M: string c-(array)-constructor
+ underlying-type
+ dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+M: string c-direct-array-constructor
+ underlying-type
+ dup [ "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+SYNTAX: SPECIALIZED-ARRAY:
+ scan define-array-vocab use-vocab ;
+
"prettyprint" vocab [
"specialized-arrays.prettyprint" require
] when
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.uchar
-
-<< "uchar" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.uint
-
-<< "uint" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.ulong
-
-<< "ulong" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.ulonglong
-
-<< "ulonglong" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.ushort
-
-<< "ushort" define-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.alien ;
-IN: specialized-vectors.alien
-
-<< "void*" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.bool ;
-IN: specialized-vectors.bool
-
-<< "bool" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.char ;
-IN: specialized-vectors.char
-
-<< "char" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.double ;
-IN: specialized-vectors.double
-
-<< "double" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.float ;
-IN: specialized-vectors.float
-
-<< "float" define-vector >>
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types functors sequences sequences.private growable
-prettyprint.custom kernel words classes math parser ;
-QUALIFIED: vectors.functor
-IN: specialized-vectors.functor
-
-FUNCTOR: define-vector ( T -- )
-
-V DEFINES-CLASS ${T}-vector
-
-A IS ${T}-array
-S IS ${T}-sequence
-<A> IS <${A}>
-
->V DEFERS >${V}
-V{ DEFINES ${V}{
-
-WHERE
-
-V A <A> vectors.functor:define-vector
-
-M: V contract 2drop ;
-
-M: V byte-length underlying>> byte-length ;
-
-M: V pprint-delims drop \ V{ \ } ;
-
-M: V >pprint-sequence ;
-
-M: V pprint* pprint-object ;
-
-SYNTAX: V{ \ } [ >V ] parse-literal ;
-
-INSTANCE: V growable
-INSTANCE: V S
-
-;FUNCTOR
+++ /dev/null
-Code generation for specialized vectors
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.int ;
-IN: specialized-vectors.int
-
-<< "int" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.long ;
-IN: specialized-vectors.long
-
-<< "long" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.longlong ;
-IN: specialized-vectors.longlong
-
-<< "longlong" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.short ;
-IN: specialized-vectors.short
-
-<< "short" define-vector >>
\ No newline at end of file
-USING: help.markup help.syntax byte-vectors ;
+USING: help.markup help.syntax byte-vectors alien byte-arrays ;
IN: specialized-vectors
-ARTICLE: "specialized-vectors" "Specialized vectors"
-"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
-$nl
-"For each primitive C type " { $snippet "T" } ", a set of words are defined:"
+HELP: SPECIALIZED-VECTOR:
+{ $syntax "SPECIALIZED-VECTOR: type" }
+{ $values { "type" "a C type" } }
+{ $description "Brings a specialized vector for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-vector-words" } "." } ;
+
+ARTICLE: "specialized-vector-words" "Specialized vector words"
+"The " { $link POSTPONE: SPECIALIZED-VECTOR: } " parsing word generates the specialized vector type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:"
{ $table
{ { $snippet "T-vector" } { "The class of vectors with elements of type " { $snippet "T" } } }
{ { $snippet "<T-vector>" } { "Constructor for vectors with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- vector )" } } }
{ { $snippet ">T-vector" } { "Converts a sequence into a specialized vector of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- vector )" } } }
{ { $snippet "T-vector{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } }
}
-"The primitive C types for which specialized vectors exist:"
-{ $list
- { $snippet "char" }
- { $snippet "uchar" }
- { $snippet "short" }
- { $snippet "ushort" }
- { $snippet "int" }
- { $snippet "uint" }
- { $snippet "long" }
- { $snippet "ulong" }
- { $snippet "longlong" }
- { $snippet "ulonglong" }
- { $snippet "float" }
- { $snippet "double" }
- { $snippet "void*" }
- { $snippet "bool" }
-}
-"Specialized vectors are generated with a functor in the " { $vocab-link "specialized-vectors.functor" } " vocabulary."
-$nl
-"The " { $vocab-link "specialized-arrays" } " vocabulary provides fixed-length versions of the above." ;
+"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-vectors.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-VECTOR: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
+
+ARTICLE: "specialized-vector-c" "Passing specialized arrays to C functions"
+"Each specialized array has a " { $slot "underlying" } " slot holding a specialized array, which in turn has an " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. Passing a specialized vector as a parameter to a C function call will automatically extract the underlying data. To get at the underlying data directly, call the " { $link >c-ptr } " word on a specialized vector." ;
+
+ARTICLE: "specialized-vectors" "Specialized vectors"
+"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
+{ $subsection "specialized-vector-words" }
+{ $subsection "specialized-vector-c" }
+"The " { $vocab-link "specialized-arrays" } " vocabulary provides a fixed-length version of this abstraction." ;
ABOUT: "specialized-vectors"
IN: specialized-vectors.tests
-USING: specialized-arrays.float
-specialized-vectors.float
-specialized-vectors.double
+USING: specialized-arrays specialized-vectors
tools.test kernel sequences ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-VECTOR: float
+SPECIALIZED-VECTOR: double
[ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types assocs compiler.units functors
+growable io kernel lexer namespaces parser prettyprint.custom
+sequences specialized-arrays specialized-arrays.private strings
+vocabs vocabs.parser ;
+QUALIFIED: vectors.functor
IN: specialized-vectors
+
+<PRIVATE
+
+FUNCTOR: define-vector ( T -- )
+
+V DEFINES-CLASS ${T}-vector
+
+A IS ${T}-array
+S IS ${T}-sequence
+<A> IS <${A}>
+
+>V DEFERS >${V}
+V{ DEFINES ${V}{
+
+WHERE
+
+V A <A> vectors.functor:define-vector
+
+M: V contract 2drop ;
+
+M: V byte-length underlying>> byte-length ;
+
+M: V pprint-delims drop \ V{ \ } ;
+
+M: V >pprint-sequence ;
+
+M: V pprint* pprint-object ;
+
+SYNTAX: V{ \ } [ >V ] parse-literal ;
+
+INSTANCE: V growable
+INSTANCE: V S
+
+;FUNCTOR
+
+: specialized-vector-vocab ( type -- vocab )
+ "specialized-vectors.instances." prepend ;
+
+: defining-vector-message ( type -- )
+ "quiet" get [ drop ] [
+ "Generating specialized " " vectors..." surround print
+ ] if ;
+
+PRIVATE>
+
+: define-vector-vocab ( type -- vocab )
+ underlying-type
+ dup specialized-vector-vocab vocab
+ [ ] [
+ [ defining-vector-message ]
+ [
+ [
+ dup specialized-vector-vocab
+ [ define-vector ] with-current-vocab
+ ] with-compilation-unit
+ ]
+ [ specialized-vector-vocab ]
+ tri
+ ] ?if ;
+
+SYNTAX: SPECIALIZED-VECTOR:
+ scan
+ [ define-array-vocab use-vocab ]
+ [ define-vector-vocab use-vocab ] bi ;
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.uchar ;
-IN: specialized-vectors.uchar
-
-<< "uchar" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.uint ;
-IN: specialized-vectors.uint
-
-<< "uint" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.ulong ;
-IN: specialized-vectors.ulong
-
-<< "ulong" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.ulonglong ;
-IN: specialized-vectors.ulonglong
-
-<< "ulonglong" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.ushort ;
-IN: specialized-vectors.ushort
-
-<< "ushort" define-vector >>
\ No newline at end of file
+++ /dev/null
-Slava Pestov
+++ /dev/null
-! (c)Joe Groff bsd license
-USING: accessors arrays kernel prettyprint.backend
-prettyprint.custom prettyprint.sections sequences struct-arrays ;
-IN: struct-arrays.prettyprint
-
-M: struct-array pprint-delims
- drop \ struct-array{ \ } ;
-
-M: struct-array >pprint-sequence
- [ >array ] [ class>> ] bi prefix ;
-
-: pprint-struct-array-pointer ( struct-array -- )
- \ struct-array@
- [ [ class>> pprint-word ] [ underlying>> pprint* ] [ length>> pprint* ] tri ]
- pprint-prefix ;
-
-M: struct-array pprint*
- [ pprint-object ]
- [ pprint-struct-array-pointer ] pprint-c-object ;
-
+++ /dev/null
-IN: struct-arrays
-USING: classes.struct help.markup help.syntax alien strings math multiline ;
-
-HELP: struct-array
-{ $class-description "The class of C struct and union arrays."
-$nl
-"The " { $slot "underlying" } " slot holds a " { $link c-ptr } " with the raw data. This pointer can be passed to C functions." } ;
-
-HELP: <struct-array>
-{ $values { "length" integer } { "struct-class" struct-class } { "struct-array" struct-array } }
-{ $description "Creates a new array for holding values of the specified struct type." } ;
-
-HELP: <direct-struct-array>
-{ $values { "alien" c-ptr } { "length" integer } { "struct-class" struct-class } { "struct-array" struct-array } }
-{ $description "Creates a new array for holding values of the specified C type, backed by the memory at " { $snippet "alien" } "." } ;
-
-HELP: struct-array-on
-{ $values { "struct" struct } { "length" integer } { "struct-array" struct-array } }
-{ $description "Create a new array for holding values of " { $snippet "struct" } "'s C type, backed by the memory starting at " { $snippet "struct" } "'s address." }
-{ $examples
-"This word is useful with the FFI. When a C function has a pointer to a struct as its return type (or a C callback has a struct pointer as an argument type), Factor automatically wraps the pointer in a " { $link struct } " object. If the pointer actually references an array of objects, this word will convert the struct object to a struct array object:"
-{ $code <" USING: alien.syntax classes.struct struct-arrays ;
-IN: scratchpad
-
-STRUCT: zim { zang int } { zung int } ;
-
-FUNCTION: zim* zingle ( ) ; ! Returns a pointer to 20 zims
-
-zingle 20 struct-array-on "> }
-} ;
-
-HELP: struct-array{
-{ $syntax "struct-array{ class value value value ... }" }
-{ $description "Literal syntax for a " { $link struct-array } " containing structs of the given " { $link struct } " class." } ;
-
-HELP: struct-array@
-{ $syntax "struct-array@ class alien length" }
-{ $description "Literal syntax for a " { $link struct-array } " at a particular memory address. The prettyprinter uses this syntax when the memory backing a struct array object is invalid. This syntax should not generally be used in source code." } ;
-
-{ POSTPONE: struct-array{ POSTPONE: struct-array@ } related-words
-
-ARTICLE: "struct-arrays" "C struct and union arrays"
-"The " { $vocab-link "struct-arrays" } " vocabulary implements arrays specialized for holding C struct and union values."
-{ $subsection struct-array }
-{ $subsection <struct-array> }
-{ $subsection <direct-struct-array> }
-{ $subsection struct-array-on }
-"Struct arrays have literal syntax:"
-{ $subsection POSTPONE: struct-array{ } ;
-
-ABOUT: "struct-arrays"
+++ /dev/null
-IN: struct-arrays.tests
-USING: classes.struct struct-arrays tools.test kernel math sequences
-alien.syntax alien.c-types destructors libc accessors sequences.private
-compiler.tree.debugger combinators.smart ;
-
-STRUCT: test-struct-array
- { x int }
- { y int } ;
-
-[ 1 ] [
- 1 struct-array{ test-struct-array } new-sequence length
-] unit-test
-
-[ V{ test-struct-array } ] [
- [ [ test-struct-array <struct> ] struct-array{ test-struct-array } output>sequence first ] final-classes
-] unit-test
-
-: make-point ( x y -- struct )
- test-struct-array <struct-boa> ;
-
-[ 5/4 ] [
- 2 test-struct-array <struct-array>
- 1 2 make-point over set-first
- 3 4 make-point over set-second
- 0 [ [ x>> ] [ y>> ] bi / + ] reduce
-] unit-test
-
-[ 5/4 ] [
- [
- 2 test-struct-array malloc-struct-array
- dup &free drop
- 1 2 make-point over set-first
- 3 4 make-point over set-second
- 0 [ [ x>> ] [ y>> ] bi / + ] reduce
- ] with-destructors
-] unit-test
-
-[ ] [ ALIEN: 123 10 test-struct-array <direct-struct-array> drop ] unit-test
-
-[ ] [
- [
- 10 test-struct-array malloc-struct-array
- &free drop
- ] with-destructors
-] unit-test
-
-[ 15 ] [ 15 10 test-struct-array <struct-array> resize length ] unit-test
-
-[ S{ test-struct-array f 12 20 } ] [
- struct-array{ test-struct-array
- S{ test-struct-array f 4 20 }
- S{ test-struct-array f 12 20 }
- S{ test-struct-array f 20 20 }
- } second
-] unit-test
-
-! Regression
-STRUCT: fixed-string { text char[100] } ;
-
-[ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
- ALIEN: 123 4 fixed-string <direct-struct-array> [ (underlying)>> ] { } map-as
-] unit-test
-
-[ 10 "int" <struct-array> ] must-fail
-
-STRUCT: wig { x int } ;
-: <bacon> ( -- wig ) 0 wig <struct-boa> ; inline
-: waterfall ( -- a b ) 1 wig <struct-array> <bacon> swap first x>> ; inline
-
-[ t ] [ [ waterfall ] { x>> } inlined? ] unit-test
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.structs byte-arrays
-classes classes.struct kernel libc math parser sequences
-sequences.private words fry memoize compiler.units ;
-IN: struct-arrays
-
-TUPLE: struct-array
-{ underlying c-ptr read-only }
-{ length array-capacity read-only }
-{ element-size array-capacity read-only }
-{ class read-only }
-{ ctor read-only } ;
-
-<PRIVATE
-
-: (nth-ptr) ( i struct-array -- alien )
- [ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
-
-: (struct-element-constructor) ( struct-class -- word )
- [
- "struct-array-ctor" f <word>
- [ swap '[ _ memory>struct ] (( alien -- object )) define-inline ] keep
- ] with-compilation-unit ;
-
-! Foldable memo word. This is an optimization; by precompiling a
-! constructor for array elements, we avoid memory>struct's slow path.
-MEMO: struct-element-constructor ( struct-class -- word )
- (struct-element-constructor) ; foldable
-
-PRIVATE>
-
-M: struct-array length length>> ; inline
-
-M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
-
-M: struct-array nth-unsafe
- [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline
-
-M: struct-array set-nth-unsafe
- [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
-
-ERROR: not-a-struct-class struct-class ;
-
-: <direct-struct-array> ( alien length struct-class -- struct-array )
- dup struct-class? [ not-a-struct-class ] unless
- [ heap-size ] [ ] [ struct-element-constructor ]
- tri struct-array boa ; inline
-
-M: struct-array new-sequence
- [ element-size>> * (byte-array) ] [ class>> ] 2bi
- <direct-struct-array> ; inline
-
-M: struct-array resize ( n seq -- newseq )
- [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi
- <direct-struct-array> ; inline
-
-: <struct-array> ( length struct-class -- struct-array )
- [ heap-size * <byte-array> ] 2keep <direct-struct-array> ; inline
-
-ERROR: bad-byte-array-length byte-array ;
-
-: byte-array>struct-array ( byte-array c-type -- struct-array )
- [
- heap-size
- [ dup length ] dip /mod 0 =
- [ drop bad-byte-array-length ] unless
- ] keep <direct-struct-array> ; inline
-
-: struct-array-on ( struct length -- struct-array )
- [ [ >c-ptr ] [ class ] bi ] dip swap <direct-struct-array> ; inline
-
-: malloc-struct-array ( length c-type -- struct-array )
- [ heap-size calloc ] 2keep <direct-struct-array> ; inline
-
-INSTANCE: struct-array sequence
-
-M: struct-type <c-array> ( len c-type -- array )
- dup c-array-constructor
- [ execute( len -- array ) ]
- [ <struct-array> ] ?if ; inline
-
-M: struct-type <c-direct-array> ( alien len c-type -- array )
- dup c-direct-array-constructor
- [ execute( alien len -- array ) ]
- [ <direct-struct-array> ] ?if ; inline
-
-: >struct-array ( sequence class -- struct-array )
- [ dup length ] dip <struct-array>
- [ 0 swap copy ] keep ; inline
-
-SYNTAX: struct-array{
- \ } scan-word [ >struct-array ] curry parse-literal ;
-
-SYNTAX: struct-array@
- scan-word [ scan-object scan-object ] dip <direct-struct-array> parsed ;
-
-USING: vocabs vocabs.loader ;
-
-"prettyprint" vocab [ "struct-arrays.prettyprint" require ] when
+++ /dev/null
-Arrays of C structs and unions
+++ /dev/null
-collections
+++ /dev/null
-IN: struct-vectors
-USING: help.markup help.syntax classes.struct alien strings math ;
-
-HELP: struct-vector
-{ $class-description "The class of growable C struct and union arrays." } ;
-
-HELP: <struct-vector>
-{ $values { "capacity" integer } { "struct-class" struct-class } { "struct-vector" struct-vector } }
-{ $description "Creates a new vector with the given initial capacity." } ;
-
-ARTICLE: "struct-vectors" "C struct and union vectors"
-"The " { $vocab-link "struct-vectors" } " vocabulary implements vectors specialized for holding C struct and union values. These are growable versions of " { $vocab-link "struct-arrays" } "."
-{ $subsection struct-vector }
-{ $subsection <struct-vector> } ;
-
-ABOUT: "struct-vectors"
+++ /dev/null
-IN: struct-vectors.tests
-USING: struct-vectors tools.test alien.c-types classes.struct accessors
-namespaces kernel sequences ;
-
-STRUCT: point { x float } { y float } ;
-
-: make-point ( x y -- point ) point <struct-boa> ;
-
-[ ] [ 1 point <struct-vector> "v" set ] unit-test
-
-[ 1.5 6.0 ] [
- 1.0 2.0 make-point "v" get push
- 3.0 4.5 make-point "v" get push
- 1.5 6.0 make-point "v" get push
- "v" get pop [ x>> ] [ y>> ] bi
-] unit-test
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types byte-arrays growable kernel math sequences
-sequences.private struct-arrays ;
-IN: struct-vectors
-
-TUPLE: struct-vector
-{ underlying struct-array }
-{ length array-capacity }
-{ c-type read-only } ;
-
-: <struct-vector> ( capacity struct-class -- struct-vector )
- [ <struct-array> 0 ] keep struct-vector boa ; inline
-
-M: struct-vector byte-length underlying>> byte-length ;
-
-M: struct-vector new-sequence
- [ c-type>> <struct-array> ] [ [ >fixnum ] [ c-type>> ] bi* ] 2bi
- struct-vector boa ;
-
-M: struct-vector contract 2drop ;
-
-M: struct-array new-resizable c-type>> <struct-vector> ;
-
-INSTANCE: struct-vector growable
"vocab:tools/deploy/shaker/strip-destructors.factor"
run-file ;
-: strip-struct-arrays ( -- )
- "struct-arrays" vocab [
- "Stripping dynamic struct array code" show
- "vocab:tools/deploy/shaker/strip-struct-arrays.factor"
- run-file
- ] when ;
-
: strip-call ( -- )
"Stripping stack effect checking from call( and execute(" show
"vocab:tools/deploy/shaker/strip-call.factor" run-file ;
: strip ( -- )
init-stripper
strip-libc
- strip-struct-arrays
strip-destructors
strip-call
strip-cocoa
+++ /dev/null
-USING: kernel stack-checker.transforms ;
-IN: struct-arrays.private
-
-: struct-element-constructor ( c-type -- word )
- "Struct array usages must be compiled" throw ;
-
-<<
-
-\ struct-element-constructor [
- (struct-element-constructor) [ ] curry
-] 1 define-transform
-
->>
\ No newline at end of file
! Copyright (C) 2005, 2006 Doug Coleman.
! Portions copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings arrays assocs ui ui.private
-ui.gadgets ui.gadgets.private ui.backend ui.clipboards
-ui.gadgets.worlds ui.gestures ui.event-loop io kernel math
-math.vectors namespaces make sequences strings vectors words
-windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
-windows.messages windows.types windows.offscreen windows.nt
-threads libc combinators fry combinators.short-circuit continuations
-command-line shuffle opengl ui.render math.bitwise locals
-accessors math.rectangles math.order calendar ascii sets
-io.encodings.utf16n windows.errors literals ui.pixel-formats
-ui.pixel-formats.private memoize classes struct-arrays classes.struct ;
+USING: alien alien.c-types alien.strings arrays assocs ui
+ui.private ui.gadgets ui.gadgets.private ui.backend
+ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
+kernel math math.vectors namespaces make sequences strings
+vectors words windows.kernel32 windows.gdi32 windows.user32
+windows.opengl32 windows.messages windows.types
+windows.offscreen windows.nt threads libc combinators fry
+combinators.short-circuit continuations command-line shuffle
+opengl ui.render math.bitwise locals accessors math.rectangles
+math.order calendar ascii sets io.encodings.utf16n
+windows.errors literals ui.pixel-formats
+ui.pixel-formats.private memoize classes
+specialized-arrays classes.struct ;
+SPECIALIZED-ARRAY: POINT
IN: ui.backend.windows
SINGLETON: windows-ui-backend
: client-area>RECT ( hwnd -- RECT )
RECT <struct>
[ GetClientRect win32-error=0/f ]
- [ >c-ptr "POINT" byte-array>struct-array [ ClientToScreen drop ] with each ]
+ [ >c-ptr byte-array>POINT-array [ ClientToScreen drop ] with each ]
[ nip ] 2tri ;
: hwnd>RECT ( hwnd -- RECT )
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math math.vectors locals sequences
-specialized-arrays.float colors arrays combinators
+specialized-arrays colors arrays combinators
opengl opengl.gl ui.pens ui.pens.caching ;
+SPECIALIZED-ARRAY: float
IN: ui.pens.gradient
! Gradient pen
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors colors help.markup help.syntax kernel opengl
-opengl.gl sequences specialized-arrays.float math.vectors
-ui.gadgets ui.pens ;
+opengl.gl sequences math.vectors ui.gadgets ui.pens
+specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: ui.pens.polygon
! Polygon pen
USING: accessors assocs classes destructors functors kernel
-lexer math parser sequences specialized-arrays.int ui.backend
+lexer math parser sequences specialized-arrays ui.backend
words ;
+SPECIALIZED-ARRAY: int
IN: ui.pixel-formats
SYMBOLS:
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings
-combinators.short-circuit fry kernel layouts sequences
-specialized-arrays.alien accessors ;
+combinators.short-circuit fry kernel layouts sequences accessors
+specialized-arrays ;
IN: unix.utilities
+SPECIALIZED-ARRAY: void*
+
: more? ( alien -- ? )
{ [ ] [ *void* ] } 1&& ;
namespaces windows.ole32 libc vocabs assocs accessors arrays
sequences quotations combinators math words compiler.units
destructors fry math.parser generalizations sets
-specialized-arrays.alien windows.kernel32 classes.struct ;
+specialized-arrays windows.kernel32 classes.struct ;
+SPECIALIZED-ARRAY: void*
IN: windows.com.wrapper
TUPLE: com-wrapper < disposable callbacks vtbls ;
windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
combinators sequences fry math accessors macros words quotations
libc continuations generalizations splitting locals assocs init
-struct-arrays memoize classes.struct ;
+specialized-arrays memoize classes.struct ;
+SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
IN: windows.dinput.constants
! Some global variables aren't provided by the DirectInput DLL (they're in the
DIOBJECTDATAFORMAT <struct-boa> ;
:: malloc-DIOBJECTDATAFORMAT-array ( struct array -- alien )
- [let | alien [ array length DIOBJECTDATAFORMAT malloc-struct-array ] |
+ [let | alien [ array length malloc-DIOBJECTDATAFORMAT-array ] |
array [| args i |
struct args <DIOBJECTDATAFORMAT>
i alien set-nth
USING: kernel tools.test windows.ole32 alien.c-types
-classes.struct specialized-arrays.uchar windows.kernel32
+classes.struct specialized-arrays windows.kernel32
windows.com.syntax ;
+SPECIALIZED-ARRAY: uchar
IN: windows.ole32.tests
[ t ] [
USING: alien alien.syntax alien.c-types alien.strings math
-kernel sequences windows.errors windows.types io
-accessors math.order namespaces make math.parser windows.kernel32
-combinators locals specialized-arrays.uchar
-literals splitting grouping classes.struct combinators.smart ;
+kernel sequences windows.errors windows.types io accessors
+math.order namespaces make math.parser windows.kernel32
+combinators locals specialized-arrays literals splitting
+grouping classes.struct combinators.smart ;
+SPECIALIZED-ARRAY: uchar
IN: windows.ole32
LIBRARY: ole32
classes.struct combinators io.encodings.utf16n io.files
io.pathnames kernel windows.errors windows.com
windows.com.syntax windows.user32 windows.ole32 windows
-specialized-arrays.ushort ;
+specialized-arrays ;
+SPECIALIZED-ARRAY: ushort
IN: windows.shell32
CONSTANT: CSIDL_DESKTOP HEX: 00
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings classes.struct
io.encodings.utf8 kernel namespaces sequences
-specialized-arrays.int x11 x11.constants x11.xlib ;
+specialized-arrays x11 x11.constants x11.xlib ;
+SPECIALIZED-ARRAY: int
IN: x11.clipboard
! This code was based on by McCLIM's Backends/CLX/port.lisp
!
! based on glx.h from xfree86, and some of glxtokens.h
USING: alien alien.c-types alien.syntax x11 x11.xlib x11.syntax
-namespaces make kernel sequences parser words specialized-arrays.int
-accessors ;
+namespaces make kernel sequences parser words
+specialized-arrays accessors ;
+SPECIALIZED-ARRAY: int
IN: x11.glx
LIBRARY: glx
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings arrays byte-arrays
hashtables io io.encodings.string kernel math namespaces
-sequences strings continuations x11 x11.xlib specialized-arrays.uint
-accessors io.encodings.utf16n ;
+sequences strings continuations x11 x11.xlib
+specialized-arrays accessors io.encodings.utf16n ;
+SPECIALIZED-ARRAY: uint
IN: x11.xim
SYMBOL: xim
USING: kernel math namespaces make tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
-continuations specialized-arrays.double ;
+continuations specialized-arrays ;
+SPECIALIZED-ARRAY: double
IN: assocs.tests
[ t ] [ H{ } dup assoc-subset? ] unit-test
-USING: tools.test math math.functions math.constants generic.standard
-generic.single strings sequences arrays kernel accessors words
-specialized-arrays.double byte-arrays bit-arrays parser namespaces
-make quotations stack-checker vectors growable hashtables sbufs
-prettyprint byte-vectors bit-vectors specialized-vectors.double
+USING: tools.test math math.functions math.constants
+generic.standard generic.single strings sequences arrays kernel
+accessors words byte-arrays bit-arrays parser namespaces make
+quotations stack-checker vectors growable hashtables sbufs
+prettyprint byte-vectors bit-vectors specialized-vectors
definitions generic sets graphs assocs grouping see eval ;
+SPECIALIZED-VECTOR: double
IN: generic.single.tests
GENERIC: lo-tag-test ( obj -- obj' )
[ manifest get (>>current-vocab) ]
[ words>> <extra-words> (add-qualified) ] bi ;
+: with-current-vocab ( name quot -- )
+ manifest get clone manifest [
+ [ set-current-vocab ] dip call
+ ] with-variable ; inline
+
TUPLE: no-current-vocab ;
: no-current-vocab ( -- vocab )
alien.marshall.private alien.strings byte-arrays classes
combinators combinators.short-circuit destructors fry
io.encodings.utf8 kernel libc sequences
-specialized-arrays.alien specialized-arrays.bool
-specialized-arrays.char specialized-arrays.double
-specialized-arrays.float specialized-arrays.int
-specialized-arrays.long specialized-arrays.longlong
-specialized-arrays.short specialized-arrays.uchar
-specialized-arrays.uint specialized-arrays.ulong
-specialized-arrays.ulonglong specialized-arrays.ushort strings
-unix.utilities vocabs.parser words libc.private struct-arrays
-locals generalizations math ;
+specialized-arrays strings unix.utilities vocabs.parser
+words libc.private locals generalizations math ;
+SPECIALIZED-ARRAY: bool
+SPECIALIZED-ARRAY: char
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: long
+SPECIALIZED-ARRAY: longlong
+SPECIALIZED-ARRAY: short
+SPECIALIZED-ARRAY: uchar
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ulong
+SPECIALIZED-ARRAY: ulonglong
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: void*
IN: alien.marshall
<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
{ [ dup not ] [ ] }
{ [ dup byte-array? ] [ malloc-byte-array ] }
{ [ dup alien-wrapper? ] [ underlying>> ] }
- { [ dup struct-array? ] [ underlying>> ] }
} cond ;
: marshall-primitive ( n -- n )
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.inline arrays
combinators fry functors kernel lexer libc macros math
-sequences specialized-arrays.alien libc.private
+sequences specialized-arrays libc.private
combinators.short-circuit ;
+SPECIALIZED-ARRAY: void*
IN: alien.marshall.private
: bool>arg ( ? -- 1/0/obj )
-USING: sequences hints kernel math specialized-arrays.int fry ;
+USING: sequences kernel math specialized-arrays fry ;
+SPECIALIZED-ARRAY: int
IN: benchmark.dawes
! Phil Dawes's performance problem
: count-ones ( int-array -- n ) [ 1 = ] count ; inline
-HINTS: count-ones int-array ;
-
: make-int-array ( -- int-array )
- 120000 [ 255 bitand ] int-array{ } map-as ;
+ 120000 [ 255 bitand ] int-array{ } map-as ; inline
: dawes-benchmark ( -- )
- make-int-array 200 swap '[ _ count-ones ] replicate drop ;
+ 200 make-int-array '[ _ count-ones ] replicate drop ;
MAIN: dawes-benchmark
USING: make math sequences splitting grouping
-kernel columns specialized-arrays.double bit-arrays ;
+kernel columns specialized-arrays bit-arrays ;
+SPECIALIZED-ARRAY: double
IN: benchmark.dispatch2
: sequences ( -- seq )
USING: sequences math mirrors splitting grouping
kernel make assocs alien.syntax columns
-specialized-arrays.double bit-arrays ;
+specialized-arrays bit-arrays ;
+SPECIALIZED-ARRAY: double
IN: benchmark.dispatch3
GENERIC: g ( obj -- str )
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
USING: math kernel io io.files locals multiline assocs sequences
-sequences.private benchmark.reverse-complement hints io.encodings.ascii
-byte-arrays specialized-arrays.double ;
+sequences.private benchmark.reverse-complement hints
+io.encodings.ascii byte-arrays specialized-arrays ;
+SPECIALIZED-ARRAY: double
IN: benchmark.fasta
CONSTANT: IM 139968
! See http://factorcode.org/license.txt for BSD license.
USING: accessors fry kernel locals math math.constants
math.functions math.vectors math.vectors.simd prettyprint
-combinators.smart sequences hints struct-arrays classes.struct ;
+combinators.smart sequences hints classes.struct
+specialized-arrays ;
IN: benchmark.nbody-simd
: solar-mass ( -- x ) 4 pi sq * ; inline
{ velocity double-4 }
{ mass double } ;
+SPECIALIZED-ARRAY: body
+
: <body> ( location velocity mass -- body )
[ days-per-year v*n ] [ solar-mass * ] bi* body <struct-boa> ; inline
: offset-momentum ( body offset -- body )
vneg solar-mass v/n >>velocity ; inline
-TUPLE: nbody-system { bodies struct-array read-only } ;
-
: init-bodies ( bodies -- )
[ first ] [ [ [ velocity>> ] [ mass>> ] bi v*n ] [ v+ ] map-reduce ] bi
offset-momentum drop ; inline
: <nbody-system> ( -- system )
[ <sun> <jupiter> <saturn> <uranus> <neptune> ]
- struct-array{ body } output>sequence nbody-system boa
- dup bodies>> init-bodies ; inline
+ body-array{ } output>sequence
+ dup init-bodies ; inline
:: each-pair ( bodies pair-quot: ( other-body body -- ) each-quot: ( body -- ) -- )
bodies [| body i |
[ [ other-body ] 2dip '[ body mass>> _ * _ n*v v+ ] change-velocity drop ] 2bi ; inline
: advance ( system dt -- )
- [ bodies>> ] dip
[ '[ _ update-velocity ] [ drop ] each-pair ]
[ '[ _ update-position ] each ]
2bi ; inline
[ [ mass>> ] bi@ * ] [ [ location>> ] bi@ distance ] 2bi / ; inline
: energy ( system -- x )
- [ 0.0 ] dip bodies>> [ newton's-law - ] [ inertia + ] each-pair ; inline
+ [ 0.0 ] dip [ newton's-law - ] [ inertia + ] each-pair ; inline
: nbody ( n -- )
>fixnum
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors specialized-arrays.double fry kernel locals math
-math.constants math.functions math.vectors prettyprint combinators.smart
-sequences hints arrays ;
+USING: accessors specialized-arrays fry kernel locals math
+math.constants math.functions math.vectors prettyprint
+combinators.smart sequences hints arrays ;
+SPECIALIZED-ARRAY: double
IN: benchmark.nbody
: solar-mass ( -- x ) 4 pi sq * ; inline
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Factor port of the raytracer benchmark from
+! http://www.ffconsultancy.com/free/ray_tracer/languages.html
+
+USING: arrays accessors io io.files io.files.temp
+io.encodings.binary kernel math math.constants math.functions
+math.vectors math.vectors.simd math.parser make sequences
+sequences.private words hints classes.struct ;
+IN: benchmark.raytracer-simd
+
+! parameters
+
+! Normalized { -1 -3 2 }.
+CONSTANT: light
+ double-4{
+ -0.2672612419124244
+ -0.8017837257372732
+ 0.5345224838248488
+ 0.0
+ }
+
+CONSTANT: oversampling 4
+
+CONSTANT: levels 3
+
+CONSTANT: size 200
+
+: delta ( -- n ) epsilon sqrt ; inline
+
+TUPLE: ray { orig double-4 read-only } { dir double-4 read-only } ;
+
+C: <ray> ray
+
+TUPLE: hit { normal double-4 read-only } { lambda float read-only } ;
+
+C: <hit> hit
+
+GENERIC: intersect-scene ( hit ray scene -- hit )
+
+TUPLE: sphere { center double-4 read-only } { radius float read-only } ;
+
+C: <sphere> sphere
+
+: sphere-v ( sphere ray -- v )
+ [ center>> ] [ orig>> ] bi* v- ; inline
+
+: sphere-b ( v ray -- b )
+ dir>> v. ; inline
+
+: sphere-d ( sphere b v -- d )
+ [ radius>> sq ] [ sq ] [ norm-sq ] tri* - + ; inline
+
+: -+ ( x y -- x-y x+y )
+ [ - ] [ + ] 2bi ; inline
+
+: sphere-t ( b d -- t )
+ -+ dup 0.0 <
+ [ 2drop 1/0. ] [ [ [ 0.0 > ] keep ] dip ? ] if ; inline
+
+: sphere-b&v ( sphere ray -- b v )
+ [ sphere-v ] [ nip ] 2bi
+ [ sphere-b ] [ drop ] 2bi ; inline
+
+: ray-sphere ( sphere ray -- t )
+ [ drop ] [ sphere-b&v ] 2bi
+ [ drop ] [ sphere-d ] 3bi
+ dup 0.0 < [ 3drop 1/0. ] [ sqrt sphere-t nip ] if ; inline
+
+: if-ray-sphere ( hit ray sphere quot -- hit )
+ #! quot: hit ray sphere l -- hit
+ [
+ [ ] [ swap ray-sphere nip ] [ 2drop lambda>> ] 3tri
+ [ drop ] [ < ] 2bi
+ ] dip [ 3drop ] if ; inline
+
+: sphere-n ( ray sphere l -- n )
+ [ [ orig>> ] [ dir>> ] bi ] [ center>> ] [ ] tri*
+ swap [ v*n ] dip v- v+ ; inline
+
+M: sphere intersect-scene ( hit ray sphere -- hit )
+ [ [ sphere-n normalize ] keep <hit> nip ] if-ray-sphere ;
+
+HINTS: M\ sphere intersect-scene { hit ray sphere } ;
+
+TUPLE: group < sphere { objs array read-only } ;
+
+: <group> ( objs bound -- group )
+ [ center>> ] [ radius>> ] bi rot group boa ; inline
+
+: make-group ( bound quot -- )
+ swap [ { } make ] dip <group> ; inline
+
+M: group intersect-scene ( hit ray group -- hit )
+ [ drop objs>> [ intersect-scene ] with each ] if-ray-sphere ;
+
+HINTS: M\ group intersect-scene { hit ray group } ;
+
+CONSTANT: initial-hit T{ hit f double-4{ 0.0 0.0 0.0 0.0 } 1/0. }
+
+: initial-intersect ( ray scene -- hit )
+ [ initial-hit ] 2dip intersect-scene ; inline
+
+: ray-o ( ray hit -- o )
+ [ [ orig>> ] [ normal>> delta v*n ] bi* ]
+ [ [ dir>> ] [ lambda>> ] bi* v*n ]
+ 2bi v+ v+ ; inline
+
+: sray-intersect ( ray scene hit -- ray )
+ swap [ ray-o light vneg <ray> ] dip initial-intersect ; inline
+
+: ray-g ( hit -- g ) normal>> light v. ; inline
+
+: cast-ray ( ray scene -- g )
+ 2dup initial-intersect dup lambda>> 1/0. = [
+ 3drop 0.0
+ ] [
+ [ sray-intersect lambda>> 1/0. = ] keep swap
+ [ ray-g neg ] [ drop 0.0 ] if
+ ] if ; inline
+
+: create-center ( c r d -- c2 )
+ [ 3.0 12.0 sqrt / * ] dip n*v v+ ; inline
+
+DEFER: create ( level c r -- scene )
+
+: create-step ( level c r d -- scene )
+ over [ create-center ] dip 2.0 / [ 1 - ] 2dip create ;
+
+: create-offsets ( quot -- )
+ {
+ double-4{ -1.0 1.0 -1.0 0.0 }
+ double-4{ 1.0 1.0 -1.0 0.0 }
+ double-4{ -1.0 1.0 1.0 0.0 }
+ double-4{ 1.0 1.0 1.0 0.0 }
+ } swap each ; inline
+
+: create-bound ( c r -- sphere ) 3.0 * <sphere> ;
+
+: create-group ( level c r -- scene )
+ 2dup create-bound [
+ 2dup <sphere> ,
+ [ [ 3dup ] dip create-step , ] create-offsets 3drop
+ ] make-group ;
+
+: create ( level c r -- scene )
+ pick 1 = [ <sphere> nip ] [ create-group ] if ;
+
+: ss-point ( dx dy -- point )
+ [ oversampling /f ] bi@ 0.0 0.0 double-4-boa ;
+
+: ss-grid ( -- ss-grid )
+ oversampling [ oversampling [ ss-point ] with map ] map ;
+
+: ray-grid ( point ss-grid -- ray-grid )
+ [
+ [ v+ normalize double-4{ 0.0 0.0 -4.0 0.0 } swap <ray> ] with map
+ ] with map ;
+
+: ray-pixel ( scene point -- n )
+ ss-grid ray-grid [ 0.0 ] 2dip
+ [ [ swap cast-ray + ] with each ] with each ;
+
+: pixel-grid ( -- grid )
+ size reverse [
+ size [
+ [ size 0.5 * - ] bi@ swap size
+ 0.0 double-4-boa
+ ] with map
+ ] map ;
+
+: pgm-header ( w h -- )
+ "P5\n" % swap # " " % # "\n255\n" % ;
+
+: pgm-pixel ( n -- ) 255 * 0.5 + >fixnum , ;
+
+: ray-trace ( scene -- pixels )
+ pixel-grid [ [ ray-pixel ] with map ] with map ;
+
+: run ( -- string )
+ levels double-4{ 0.0 -1.0 0.0 0.0 } 1.0 create ray-trace [
+ size size pgm-header
+ [ [ oversampling sq / pgm-pixel ] each ] each
+ ] B{ } make ;
+
+: raytracer-main ( -- )
+ run "raytracer.pnm" temp-file binary set-file-contents ;
+
+MAIN: raytracer-main
! Factor port of the raytracer benchmark from
! http://www.ffconsultancy.com/free/ray_tracer/languages.html
-USING: arrays accessors specialized-arrays.double io io.files
+USING: arrays accessors specialized-arrays io io.files
io.files.temp io.encodings.binary kernel math math.constants
math.functions math.vectors math.parser make sequences
sequences.private words hints ;
+SPECIALIZED-ARRAY: double
IN: benchmark.raytracer
! parameters
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel io math math.functions math.parser math.vectors
+math.vectors.simd sequences specialized-arrays ;
+SPECIALIZED-ARRAY: float-4
+IN: benchmark.simd-1
+
+: <point> ( n -- float-4 )
+ >float [ sin ] [ cos 3 * ] [ sin sq 2 / ] tri
+ 0.0 float-4-boa ; inline
+
+: make-points ( len -- points )
+ iota [ <point> ] float-4-array{ } map-as ; inline
+
+: normalize-points ( points -- )
+ [ normalize ] change-each ; inline
+
+: max-points ( points -- point )
+ [ ] [ vmax ] map-reduce ; inline
+
+: print-point ( point -- )
+ [ number>string ] { } map-as ", " join print ; inline
+
+: simd-benchmark ( len -- )
+ >fixnum make-points [ normalize-points ] [ max-points ] bi print-point ;
+
+: main ( -- )
+ 5000000 simd-benchmark ;
+
+MAIN: main
! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
-USING: specialized-arrays.double kernel math math.functions
+USING: specialized-arrays kernel math math.functions
math.vectors sequences sequences.private prettyprint words hints
locals ;
+SPECIALIZED-ARRAY: double
IN: benchmark.spectral-norm
:: inner-loop ( u n quot -- seq )
! 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
-struct-arrays io ;
+specialized-arrays io ;
IN: benchmark.struct-arrays
STRUCT: point { x float } { y float } { z float } ;
+SPECIALIZED-ARRAY: point
+
: xyz ( point -- x y z )
[ x>> ] [ y>> ] [ z>> ] tri ; inline
1 + ; inline
: make-points ( len -- points )
- point <struct-array> dup 0 [ init-point ] reduce drop ; inline
+ <point-array> dup 0 [ init-point ] reduce drop ; inline
: point-norm ( point -- norm )
[ xyz [ absq ] tri@ ] sum-outputs sqrt ; inline
USING: alien.c-types continuations destructors kernel
-opengl opengl.gl bunny.model specialized-arrays.float
-accessors ;
+opengl opengl.gl bunny.model specialized-arrays accessors ;
+SPECIALIZED-ARRAY: float
IN: bunny.fixed-pipeline
TUPLE: bunny-fixed-pipeline ;
http.client io io.encodings.ascii io.files io.files.temp kernel
math math.matrices math.parser math.vectors opengl
opengl.capabilities opengl.gl opengl.demo-support sequences
-splitting vectors words specialized-arrays.float
-specialized-arrays.uint ;
+splitting vectors words specialized-arrays ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: uint
IN: bunny.model
: numbers ( str -- seq )
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types arrays classes.struct combinators
-combinators.short-circuit game-worlds gpu gpu.buffers gpu.util.wasd
-gpu.framebuffers gpu.render gpu.shaders gpu.state gpu.textures gpu.util
-grouping http.client images images.loader io io.encodings.ascii io.files
-io.files.temp kernel math math.matrices math.parser math.vectors
-method-chains sequences specialized-arrays.float specialized-vectors.uint
-splitting struct-vectors threads ui ui.gadgets ui.gadgets.worlds
-ui.pixel-formats ;
+combinators.short-circuit game-worlds gpu gpu.buffers
+gpu.util.wasd gpu.framebuffers gpu.render gpu.shaders gpu.state
+gpu.textures gpu.util grouping http.client images images.loader
+io io.encodings.ascii io.files io.files.temp kernel math
+math.matrices math.parser math.vectors method-chains sequences
+splitting threads ui ui.gadgets ui.gadgets.worlds
+ui.pixel-formats specialized-arrays specialized-vectors ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-VECTOR: uint
IN: gpu.demos.bunny
GLSL-SHADER-FILE: bunny-vertex-shader vertex-shader "bunny.v.glsl"
{ f float-components 1 f } ;
VERTEX-STRUCT: bunny-vertex-struct bunny-vertex
+SPECIALIZED-VECTOR: bunny-vertex-struct
+
UNIFORM-TUPLE: bunny-uniforms < mvp-uniforms
{ "light-position" vec3-uniform f }
{ "color" vec4-uniform f }
] when* ;
: parse-bunny-model ( -- vertexes indexes )
- 100000 bunny-vertex-struct <struct-vector>
+ 100000 <bunny-vertex-struct-vector>
100000 <uint-vector>
(parse-bunny-model) ;
--- /dev/null
+USING: tools.deploy.config ;
+H{
+ { deploy-name "gpu.demos.bunny" }
+ { deploy-word-defs? f }
+ { deploy-io 3 }
+ { "stop-after-last-window?" t }
+ { deploy-math? t }
+ { deploy-word-props? f }
+ { deploy-threads? t }
+ { deploy-c-types? f }
+ { deploy-reflection 2 }
+ { deploy-unicode? f }
+ { deploy-ui? t }
+}
destructors gpu gpu.buffers gpu.private gpu.textures
gpu.textures.private images kernel locals math math.rectangles opengl
opengl.framebuffers opengl.gl opengl.textures sequences
-specialized-arrays.int specialized-arrays.uint
-ui.gadgets.worlds variants ;
+specialized-arrays ui.gadgets.worlds variants ;
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: uint
IN: gpu.framebuffers
SINGLETON: system-framebuffer
USING: alien alien.syntax byte-arrays classes gpu.buffers
gpu.framebuffers gpu.shaders gpu.textures help.markup
help.syntax images kernel math multiline sequences
-specialized-arrays.alien specialized-arrays.uint
-specialized-arrays.ulong strings ;
+specialized-arrays strings ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ulong
+SPECIALIZED-ARRAY: void*
IN: gpu.render
HELP: <index-elements>
gpu.textures gpu.textures.private half-floats images kernel
lexer locals math math.order math.parser namespaces opengl
opengl.gl parser quotations sequences slots sorting
-specialized-arrays.alien specialized-arrays.float specialized-arrays.int
-specialized-arrays.uint strings ui.gadgets.worlds variants
+specialized-arrays strings ui.gadgets.worlds variants
vocabs.parser words ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: void*
IN: gpu.render
UNION: ?integer integer POSTPONE: f ;
! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types alien.strings
-arrays assocs byte-arrays classes.mixin classes.parser
-classes.singleton classes.struct combinators
-combinators.short-circuit definitions destructors
-generic.parser gpu gpu.buffers hashtables images
+USING: accessors alien alien.c-types alien.strings arrays assocs
+byte-arrays classes.mixin classes.parser classes.singleton
+classes.struct combinators combinators.short-circuit definitions
+destructors generic.parser gpu gpu.buffers hashtables images
io.encodings.ascii io.files io.pathnames kernel lexer literals
locals math math.parser memoize multiline namespaces opengl
opengl.gl opengl.shaders parser quotations sequences
-specialized-arrays.alien specialized-arrays.int splitting
-strings tr ui.gadgets.worlds variants vectors vocabs vocabs.loader
-vocabs.parser words words.constant ;
+specialized-arrays splitting strings tr ui.gadgets.worlds
+variants vectors vocabs vocabs.loader vocabs.parser words
+words.constant ;
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: void*
IN: gpu.shaders
VARIANT: shader-kind
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types arrays byte-arrays combinators gpu
kernel literals math math.rectangles opengl opengl.gl sequences
-variants specialized-arrays.int specialized-arrays.float ;
+variants specialized-arrays ;
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: float
IN: gpu.state
UNION: ?rect rect POSTPONE: f ;
USING: accessors alien.c-types arrays byte-arrays combinators
destructors fry gpu gpu.buffers images kernel locals math
opengl opengl.gl opengl.textures sequences
-specialized-arrays.float ui.gadgets.worlds variants ;
+specialized-arrays ui.gadgets.worlds variants ;
+SPECIALIZED-ARRAY: float
IN: gpu.textures
TUPLE: texture < gpu-object
! (c)2009 Joe Groff bsd license
USING: gpu.buffers gpu.render gpu.shaders gpu.textures images kernel
-specialized-arrays.float ;
+specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: gpu.util
CONSTANT: environment-cube-map-mv-matrices
gpu.render gpu.state kernel literals
locals math math.constants math.functions math.matrices
math.order math.vectors opengl.gl sequences
-specialized-arrays.float ui ui.gadgets.worlds ;
+ui ui.gadgets.worlds specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: gpu.util.wasd
UNIFORM-TUPLE: mvp-uniforms
! (c)2009 Joe Groff bsd license
USING: accessors arrays destructors kernel math opengl
-opengl.gl sequences sequences.product specialized-arrays.float ;
+opengl.gl sequences sequences.product specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: grid-meshes
TUPLE: grid-mesh dim buffer row-length ;
-USING: alien.c-types alien.syntax half-floats kernel math tools.test ;
+USING: alien.c-types alien.syntax half-floats kernel math tools.test
+specialized-arrays ;
+SPECIALIZED-ARRAY: half
IN: half-floats.tests
[ HEX: 0000 ] [ 0.0 half>bits ] unit-test
! (c)2009 Joe Groff bsd license
-USING: accessors alien.c-types alien.syntax kernel math math.order
-specialized-arrays.functor ;
+USING: accessors alien.c-types alien.syntax kernel math math.order ;
IN: half-floats
: half>bits ( float -- bits )
[ *ushort bits>half ] >>boxer-quot
drop
-"half" define-array
-
>>
! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences io io.encodings.binary io.files io.pathnames
-strings kernel math io.mmap io.mmap.uchar accessors
-combinators math.ranges unicode.categories byte-arrays
-io.encodings.string io.encodings.utf16 assocs math.parser
-combinators.short-circuit fry namespaces combinators.smart
-splitting io.encodings.ascii arrays io.files.info unicode.case
-io.directories.search literals math.functions continuations ;
+strings kernel math io.mmap accessors combinators math.ranges
+unicode.categories byte-arrays io.encodings.string
+io.encodings.utf16 assocs math.parser combinators.short-circuit
+fry namespaces combinators.smart splitting io.encodings.ascii
+arrays io.files.info unicode.case io.directories.search literals
+math.functions continuations ;
IN: id3
<PRIVATE
CONSTANT: id3v1-length 128
CONSTANT: id3v1-offset 128
CONSTANT: id3v1+-length 227
-CONSTANT: id3v1+-offset $[ 128 227 + ]
+: id3v1+-offset ( -- n ) id3v1-length id3v1+-length + ; inline
: id3v1? ( seq -- ? )
{
: mp3>id3 ( path -- id3/f )
[
- [ <id3> ] dip
- {
- [ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
- [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
- [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
- } cleave
- ] with-mapped-uchar-file-reader ;
+ [ <id3> ] dip "uchar" <mapped-array>
+ [ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
+ [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
+ [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
+ tri
+ ] with-mapped-file-reader ;
: find-id3-frame ( id3 name -- obj/f )
swap frames>> at* [ data>> ] when ;
! Copyright (C) 2009 Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors grouping sequences combinators math
-byte-arrays fry specialized-arrays.uint specialized-arrays.ushort
-specialized-arrays.float images half-floats ;
+byte-arrays fry images half-floats specialized-arrays ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: half
IN: images.normalization
<PRIVATE
USING: accessors alien.c-types jamshred.game jamshred.oint
jamshred.player jamshred.tunnel kernel math math.constants
math.functions math.vectors opengl opengl.gl opengl.glu
-opengl.demo-support sequences specialized-arrays.float ;
+opengl.demo-support sequences specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: jamshred.gl
CONSTANT: min-vertices 6
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors.constants combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle specialized-arrays.float strings system ;
+USING: accessors colors.constants combinators jamshred.log
+jamshred.oint jamshred.sound jamshred.tunnel kernel locals math
+math.constants math.order math.ranges math.vectors math.matrices
+sequences shuffle specialized-arrays strings system ;
+SPECIALIZED-ARRAY: float
IN: jamshred.player
TUPLE: player < oint
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences specialized-arrays.float tools.test ;
+USING: accessors arrays jamshred.oint jamshred.tunnel kernel
+math.vectors sequences specialized-arrays tools.test ;
+SPECIALIZED-ARRAY: float
IN: jamshred.tunnel.tests
[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
USING: accessors arrays colors combinators fry jamshred.oint
kernel literals locals math math.constants math.matrices
math.order math.quadratic math.ranges math.vectors random
-sequences specialized-arrays.float vectors ;
+sequences specialized-arrays vectors ;
FROM: jamshred.oint => distance ;
+SPECIALIZED-ARRAY: float
IN: jamshred.tunnel
CONSTANT: n-segments 5000
! 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.alien
+llvm.types make namespaces sequences specialized-arrays
vocabs words ;
-
+SPECIALIZED-ARRAY: void*
IN: llvm.invoker
! get function name, ret type, param types and names
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators kernel llvm.core
-locals math.parser math multiline
-namespaces parser peg.ebnf sequences
-sequences.deep specialized-arrays.alien strings vocabs words ;
-
+USING: accessors 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
! Type resolution strategy:
! (c)2009 Joe Groff bsd license
USING: accessors arrays grouping kernel locals math math.order
math.ranges math.vectors math.vectors.homogeneous sequences
-specialized-arrays.float ;
+specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: nurbs
TUPLE: nurbs-curve
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors arrays alien system combinators alien.syntax namespaces
- alien.c-types sequences vocabs.loader shuffle
- openal.backend specialized-arrays.uint alien.libraries generalizations ;
+USING: kernel accessors arrays alien system combinators
+alien.syntax namespaces alien.c-types sequences vocabs.loader
+shuffle openal.backend alien.libraries generalizations
+specialized-arrays ;
+SPECIALIZED-ARRAY: uint
IN: openal
<< "alut" {
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged specialized-arrays.uchar specialized-arrays.short ;
+USING: accessors alien.c-types combinators kernel locals math
+math.ranges openal sequences sequences.merged specialized-arrays ;
+SPECIALIZED-ARRAY: uchar
+SPECIALIZED-ARRAY: short
IN: synth.buffers
TUPLE: buffer sample-freq 8bit? id ;
! See http://factorcode.org/license.txt for BSD license.
USING: unix alien alien.c-types kernel math sequences strings
io.backend.unix splitting io.encodings.utf8 io.encodings.string
-specialized-arrays.char ;
+specialized-arrays ;
+SPECIALIZED-ARRAY: char
IN: system-info.linux
: (uname) ( buf -- int )
USING: alien alien.c-types classes.struct accessors kernel
math namespaces windows windows.kernel32 windows.advapi32 words
combinators vocabs.loader system-info.backend system
-alien.strings windows.errors specialized-arrays.ushort ;
+alien.strings windows.errors specialized-arrays ;
+SPECIALIZED-ARRAY: ushort
IN: system-info.windows
: system-info ( -- SYSTEM_INFO )
math math.constants math.functions math.matrices math.order
math.vectors opengl opengl.capabilities opengl.gl
opengl.shaders opengl.textures opengl.textures.private
-sequences sequences.product specialized-arrays.float
+sequences sequences.product specialized-arrays
terrain.generation terrain.shaders ui ui.gadgets
ui.gadgets.worlds ui.pixel-formats game-worlds method-chains
math.affine-transforms noise ui.gestures combinators.short-circuit
destructors grid-meshes ;
+SPECIALIZED-ARRAY: float
IN: terrain
CONSTANT: FOV $[ 2.0 sqrt 1 + ]
projects / factor.git / commitdiff