Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2009-09-09 23:38:01 -05:00
commit bda5963c62
172 changed files with 978 additions and 1106 deletions

View File

@ -51,7 +51,7 @@ HELP: c-setter
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>
@ -73,7 +73,7 @@ HELP: byte-array>memory
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." } ;
@ -132,13 +132,13 @@ HELP: malloc-string
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."

View File

@ -21,11 +21,7 @@ TUPLE: abstract-c-type
{ getter callable }
{ setter callable }
size
align
array-class
array-constructor
(array)-constructor
direct-array-constructor ;
align ;
TUPLE: c-type < abstract-c-type
boxer
@ -75,9 +71,6 @@ M: string c-type ( name -- type )
] ?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.
@ -89,55 +82,28 @@ M: abstract-c-type heap-size size>> ;
GENERIC: require-c-array ( c-type -- )
M: object require-c-array
drop ;
M: array require-c-array first require-c-array ;
M: c-type require-c-array
array-class>> ?require-word ;
GENERIC: c-array-constructor ( c-type -- word )
M: string require-c-array
c-type require-c-array ;
GENERIC: c-(array)-constructor ( c-type -- word )
M: array require-c-array
first c-type require-c-array ;
ERROR: specialized-array-vocab-not-loaded vocab word ;
: c-array-constructor ( c-type -- word )
array-constructor>> dup array?
[ first2 specialized-array-vocab-not-loaded ] when ; foldable
: c-(array)-constructor ( c-type -- word )
(array)-constructor>> dup array?
[ first2 specialized-array-vocab-not-loaded ] when ; foldable
: 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
@ -347,32 +313,6 @@ M: long-long-type box-return ( type -- )
: 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"
@ -395,7 +335,6 @@ CONSTANT: primitive-types
[ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer
"alien_offset" >>unboxer
"alien" "void*" set-array-class*
"void*" define-primitive-type
<long-long-type>
@ -407,7 +346,6 @@ CONSTANT: primitive-types
8 >>align
"box_signed_8" >>boxer
"to_signed_8" >>unboxer
"longlong" set-array-class
"longlong" define-primitive-type
<long-long-type>
@ -419,7 +357,6 @@ CONSTANT: primitive-types
8 >>align
"box_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
"ulonglong" set-array-class
"ulonglong" define-primitive-type
<c-type>
@ -431,7 +368,6 @@ CONSTANT: primitive-types
bootstrap-cell >>align
"box_signed_cell" >>boxer
"to_fixnum" >>unboxer
"long" set-array-class
"long" define-primitive-type
<c-type>
@ -443,7 +379,6 @@ CONSTANT: primitive-types
bootstrap-cell >>align
"box_unsigned_cell" >>boxer
"to_cell" >>unboxer
"ulong" set-array-class
"ulong" define-primitive-type
<c-type>
@ -455,7 +390,6 @@ CONSTANT: primitive-types
4 >>align
"box_signed_4" >>boxer
"to_fixnum" >>unboxer
"int" set-array-class
"int" define-primitive-type
<c-type>
@ -467,7 +401,6 @@ CONSTANT: primitive-types
4 >>align
"box_unsigned_4" >>boxer
"to_cell" >>unboxer
"uint" set-array-class
"uint" define-primitive-type
<c-type>
@ -479,7 +412,6 @@ CONSTANT: primitive-types
2 >>align
"box_signed_2" >>boxer
"to_fixnum" >>unboxer
"short" set-array-class
"short" define-primitive-type
<c-type>
@ -491,7 +423,6 @@ CONSTANT: primitive-types
2 >>align
"box_unsigned_2" >>boxer
"to_cell" >>unboxer
"ushort" set-array-class
"ushort" define-primitive-type
<c-type>
@ -503,7 +434,6 @@ CONSTANT: primitive-types
1 >>align
"box_signed_1" >>boxer
"to_fixnum" >>unboxer
"char" set-array-class
"char" define-primitive-type
<c-type>
@ -515,7 +445,6 @@ CONSTANT: primitive-types
1 >>align
"box_unsigned_1" >>boxer
"to_cell" >>unboxer
"uchar" set-array-class
"uchar" define-primitive-type
<c-type>
@ -525,7 +454,6 @@ CONSTANT: primitive-types
1 >>align
"box_boolean" >>boxer
"to_boolean" >>unboxer
"bool" set-array-class
"bool" define-primitive-type
<c-type>
@ -539,7 +467,6 @@ CONSTANT: primitive-types
"to_float" >>unboxer
float-rep >>rep
[ >float ] >>unboxer-quot
"float" set-array-class
"float" define-primitive-type
<c-type>
@ -553,7 +480,6 @@ CONSTANT: primitive-types
"to_double" >>unboxer
double-rep >>rep
[ >float ] >>unboxer-quot
"double" set-array-class
"double" define-primitive-type
"long" "ptrdiff_t" typedef

View File

@ -26,7 +26,6 @@ T-class c-type
<T> 1quotation >>unboxer-quot
*T 1quotation >>boxer-quot
number >>boxed-class
T set-array-class
drop
;FUNCTOR

View File

@ -66,4 +66,4 @@ M: struct-type stack-size
[ name>> = ] with find nip offset>> ;
USE: vocabs.loader
"struct-arrays" require
"specialized-arrays" require

View File

@ -0,0 +1 @@
unportable

View File

@ -5,7 +5,8 @@ math.functions math.parser namespaces splitting grouping strings
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

View File

@ -5,9 +5,11 @@ classes.struct classes.tuple.private combinators
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
<<
@ -301,9 +303,11 @@ STRUCT: struct-test-array-slots
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

View File

@ -4,13 +4,14 @@ alien.structs.fields arrays byte-arrays classes classes.parser
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 ;

View File

@ -5,9 +5,11 @@ classes.struct continuations combinators compiler compiler.alien
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 ;

View File

@ -3,8 +3,10 @@ alien.syntax arrays classes.struct combinators
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
<<

View File

@ -8,8 +8,9 @@ math.functions math.private strings layouts
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

View File

@ -1,9 +1,11 @@
! 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*

View File

@ -3,12 +3,15 @@
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

View File

@ -6,7 +6,9 @@ db.types tools.walker ascii splitting math.parser combinators
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 )

View File

@ -3,11 +3,13 @@ assocs byte-arrays combinators continuations game-input
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
@ -70,12 +72,9 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
: 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>

View File

@ -5,8 +5,10 @@ combinators compression.run-length endian fry grouping images
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 ;

View File

@ -4,8 +4,9 @@ USING: accessors arrays byte-arrays combinators
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

View File

@ -5,8 +5,9 @@ compression.lzw endian fry grouping images io
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

View File

@ -1,9 +1,10 @@
! 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 ;
@ -16,7 +17,7 @@ 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 ;

View File

@ -1,9 +1,10 @@
! 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 ;
@ -15,7 +16,7 @@ CONSTANT: max-events 256
: <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 ;

View File

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

View File

@ -1,10 +1,12 @@
! 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
@ -12,7 +14,7 @@ io-size owner type-id filesystem-subtype ;
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 ;

View File

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

View File

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

View File

@ -3,8 +3,10 @@
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
@ -184,7 +186,7 @@ M: unix copy-file-and-info ( from to -- )
: timestamps>byte-array ( timestamps -- byte-array )
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
\ timeval >struct-array ;
>timeval-array ;
PRIVATE>

View File

@ -6,7 +6,8 @@ windows.time windows accessors alien.c-types combinators
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' )

View File

@ -5,7 +5,8 @@ windows.kernel32 kernel libc math threads system environment
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

View File

@ -1,13 +1,13 @@
! 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

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.alien ;
IN: io.mmap.alien
<< "void*" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.bool ;
IN: io.mmap.bool
<< "bool" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.char ;
IN: io.mmap.char
<< "char" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.double ;
IN: io.mmap.double
<< "double" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.float ;
IN: io.mmap.float
<< "float" define-mapped-array >>

View File

@ -1,32 +0,0 @@
! 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

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.int ;
IN: io.mmap.int
<< "int" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.long ;
IN: io.mmap.long
<< "long" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.longlong ;
IN: io.mmap.longlong
<< "longlong" define-mapped-array >>

View File

@ -1,13 +1,13 @@
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

View File

@ -1,4 +1,4 @@
! 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
@ -30,6 +30,11 @@ PRIVATE>
: <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 ;

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.short ;
IN: io.mmap.short
<< "short" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.uchar ;
IN: io.mmap.uchar
<< "uchar" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.uint ;
IN: io.mmap.uint
<< "uint" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.ulong ;
IN: io.mmap.ulong
<< "ulong" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.ulonglong ;
IN: io.mmap.ulonglong
<< "ulonglong" define-mapped-array >>

View File

@ -1,4 +0,0 @@
USING: io.mmap.functor specialized-arrays.ushort ;
IN: io.mmap.ushort
<< "ushort" define-mapped-array >>

View File

@ -1,9 +1,10 @@
! 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>

View File

@ -3,9 +3,12 @@ combinators.short-circuit fry kernel locals macros
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 ;

View File

@ -2,8 +2,11 @@ USING: accessors alien alien.c-types arrays ascii byte-arrays combinators
combinators.short-circuit fry kernel math math.blas.ffi
math.complex math.functions math.order sequences sequences.private
functors words locals parser prettyprint.backend prettyprint.custom
specialized-arrays.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 ;

View File

@ -1,8 +1,9 @@
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 } ] [

View File

@ -1,8 +1,9 @@
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

View File

@ -1,9 +1,9 @@
! 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+ ;
@ -99,12 +99,14 @@ M: vector-word subwords specializations values [ word? ] filter ;
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

View File

@ -7,7 +7,9 @@ continuations kernel libc math macros namespaces math.vectors
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

View File

@ -2,8 +2,9 @@
! 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 -- )

View File

@ -1,10 +1,11 @@
! 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?

View File

@ -4,7 +4,8 @@
! 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

View File

@ -12,9 +12,9 @@ ABOUT: "sequences.complex"
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 } }" } } ;
@ -23,8 +23,9 @@ HELP: <complex-sequence>
{ $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 }" } } ;

View File

@ -1,5 +1,6 @@
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 )

View File

@ -2,9 +2,10 @@
! 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 -- ? )

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.alien
<< "void*" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.bool
<< "bool" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.char
<< "char" define-array >>

View File

@ -1,13 +0,0 @@
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

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.complex-double
<< "complex-double" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.complex-float
<< "complex-float" define-array >>

View File

@ -1,25 +0,0 @@
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

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.float
<< "float" define-array >>

View File

@ -1,94 +0,0 @@
! 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

View File

@ -1 +0,0 @@
Code generation for specialized arrays

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.int
<< "int" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.long
<< "long" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.longlong
<< "longlong" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.alien
<< "ptrdiff_t" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.short
<< "short" define-array >>

View File

@ -1,43 +1,52 @@
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."
"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 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."
$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"

View File

@ -1,9 +1,16 @@
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
@ -37,3 +44,65 @@ specialized-arrays.float arrays combinators compiler ;
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

View File

@ -1,13 +1,156 @@
! 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

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.uchar
<< "uchar" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.uint
<< "uint" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.ulong
<< "ulong" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.ulonglong
<< "ulonglong" define-array >>

View File

@ -1,4 +0,0 @@
USE: specialized-arrays.functor
IN: specialized-arrays.ushort
<< "ushort" define-array >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.alien ;
IN: specialized-vectors.alien
<< "void*" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.bool ;
IN: specialized-vectors.bool
<< "bool" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.char ;
IN: specialized-vectors.char
<< "char" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.double ;
IN: specialized-vectors.double
<< "double" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.float ;
IN: specialized-vectors.float
<< "float" define-vector >>

View File

@ -1,38 +0,0 @@
! 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

View File

@ -1 +0,0 @@
Code generation for specialized vectors

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.int ;
IN: specialized-vectors.int
<< "int" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.long ;
IN: specialized-vectors.long
<< "long" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.longlong ;
IN: specialized-vectors.longlong
<< "longlong" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.short ;
IN: specialized-vectors.short
<< "short" define-vector >>

View File

@ -1,35 +1,28 @@
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"

View File

@ -1,8 +1,9 @@
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

View File

@ -1,3 +1,72 @@
! 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 ;

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.uchar ;
IN: specialized-vectors.uchar
<< "uchar" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.uint ;
IN: specialized-vectors.uint
<< "uint" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.ulong ;
IN: specialized-vectors.ulong
<< "ulong" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.ulonglong ;
IN: specialized-vectors.ulonglong
<< "ulonglong" define-vector >>

View File

@ -1,4 +0,0 @@
USING: specialized-vectors.functor specialized-arrays.ushort ;
IN: specialized-vectors.ushort
<< "ushort" define-vector >>

Some files were not shown because too many files have changed in this diff Show More