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

basis/alien/c-types/c-types-docs.factor

@@ -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." }
+{ $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 set for details on the underlying sequence types loaded." } ;
+{ $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."

basis/alien/c-types/c-types.factor

@@ -21,11 +21,7 @@ TUPLE: abstract-c-type
 { getter callable }
 { setter callable }
 size
-align
+align ;
-array-class
-array-constructor
-(array)-constructor
-direct-array-constructor ;
 
 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
+M: array require-c-array first require-c-array ;
-    drop ;
 
-M: c-type require-c-array
+GENERIC: c-array-constructor ( c-type -- word )
-    array-class>> ?require-word ;
 
-M: string require-c-array
+GENERIC: c-(array)-constructor ( c-type -- word )
-    c-type require-c-array ;
 
-M: array require-c-array
+GENERIC: c-direct-array-constructor ( c-type -- word )
-    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-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
+    c-array-constructor execute( len -- array ) ; inline
-M: array <c-array>
-    first c-type <c-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
+    c-(array)-constructor execute( len -- array ) ; inline
-M: array (c-array)
-    first c-type (c-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
+    c-direct-array-constructor execute( alien len -- array ) ; inline
-M: array <c-direct-array>
-    first c-type <c-direct-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

basis/alien/complex/functor/functor.factor

@@ -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

basis/alien/structs/structs.factor

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

basis/bootstrap/compiler/timing/tags.txt

@@ -0,0 +1 @@
+unportable

basis/checksums/md5/md5.factor

@@ -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

basis/classes/struct/struct-tests.factor

@@ -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
+prettyprint.config see sequences specialized-arrays
-specialized-arrays.int specialized-arrays.ushort
+system tools.test ;
-struct-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
 

basis/classes/struct/struct.factor

@@ -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
+kernel kernel.private lexer libc locals macros make math
-parser quotations sequences slots slots.private struct-arrays vectors
+math.order parser quotations sequences slots slots.private
-words compiler.tree.propagation.transforms specialized-arrays.uchar ;
+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 ;
 

basis/cocoa/messages/messages.factor

@@ -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 ;
 

basis/compiler/tests/alien.factor

@@ -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
+specialized-arrays stack-checker stack-checker.errors
-system threads tools.test words specialized-arrays.char ;
+system threads tools.test words ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: char
 IN: compiler.tests.alien
 
 <<

basis/compiler/tree/propagation/propagation-tests.factor

@@ -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

basis/core-foundation/dictionaries/dictionaries.factor

@@ -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*

basis/core-foundation/fsevents/fsevents.factor

@@ -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
+arrays specialized-arrays classes.struct core-foundation
-specialized-arrays.int specialized-arrays.longlong
+core-foundation.run-loop core-foundation.strings
-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
 

basis/db/postgresql/lib/lib.factor

@@ -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 )

basis/game-input/dinput/dinput.factor

@@ -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 ]
+    [ configure-mouse ] [ +mouse-device+ set-global ] bi
-    [ +mouse-device+ set-global ] bi
+    0 0 0 0 8 f <array> mouse-state boa +mouse-state+ set-global
-    0 0 0 0 8 f <array> mouse-state boa
+    MOUSE-BUFFER-SIZE <DIDEVICEOBJECTDATA-array> +mouse-buffer+ set-global ;
-    +mouse-state+ set-global
-    MOUSE-BUFFER-SIZE DIDEVICEOBJECTDATA <struct-array>
-    +mouse-buffer+ set-global ;
 
 : device-info ( device -- DIDEVICEIMAGEINFOW )
     DIDEVICEINSTANCEW <struct>

basis/images/bitmap/bitmap.factor

@@ -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
+math.functions namespaces sequences specialized-arrays
-specialized-arrays.ushort strings summary ;
+strings summary ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ushort
 IN: images.bitmap
 
 : write2 ( n -- ) 2 >le write ;

basis/images/bitmap/loading/loading.factor

@@ -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

basis/images/tiff/tiff.factor

@@ -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

basis/io/backend/unix/multiplexers/epoll/epoll.factor

@@ -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
+sequences assocs specialized-arrays math namespaces
-unix.linux.epoll unix.time io.ports io.backend.unix
+locals fry unix unix.linux.epoll unix.time io.ports
-io.backend.unix.multiplexers ;
+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 ;
 

basis/io/backend/unix/multiplexers/kqueue/kqueue.factor

@@ -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
+io.backend.unix kernel math.bitwise sequences
-unix.kqueue unix.time assocs io.backend.unix.multiplexers
+specialized-arrays unix unix.kqueue unix.time assocs
-classes.struct ;
+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 ;
 

basis/io/files/info/unix/freebsd/freebsd.factor

@@ -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 ;

basis/io/files/info/unix/macosx/macosx.factor

@@ -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
+grouping io.encodings.utf8 io.files kernel math sequences system
-system unix io.files.unix specialized-arrays.uint arrays
+unix io.files.unix arrays unix.statfs.macosx unix.statvfs.macosx
-unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx
+unix.getfsstat.macosx io.files.info.unix io.files.info
-io.files.info.unix io.files.info classes.struct struct-arrays ;
+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 ;

basis/io/files/info/unix/netbsd/netbsd.factor

@@ -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
+grouping sequences io.encodings.utf8 classes.struct
-io.files.info.unix ;
+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 ;

basis/io/files/info/unix/openbsd/openbsd.factor

@@ -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
+arrays io.files.info.unix classes.struct
-io.encodings.utf8 ;
+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 ;

basis/io/files/info/unix/unix.factor

@@ -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
+io.files.types io.backend io.directories unix unix.stat
-unix.groups classes.struct struct-arrays ;
+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>
 

basis/io/files/info/windows/windows.factor

@@ -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' )

basis/io/files/windows/nt/nt.factor

@@ -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

basis/io/launcher/windows/windows.factor

@@ -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
+io.backend.windows io.pipes.windows.nt io.pathnames libc
-windows.types math windows.kernel32
+io.ports windows.types math windows.kernel32 namespaces make
-namespaces make io.launcher kernel sequences windows.errors
+io.launcher kernel sequences windows.errors splitting system
-splitting system threads init strings combinators
+threads init strings combinators io.backend accessors
-io.backend accessors concurrency.flags io.files assocs
+concurrency.flags io.files assocs io.files.private windows
-io.files.private windows destructors specialized-arrays.ushort
+destructors specialized-arrays.alien classes classes.struct ;
-specialized-arrays.alien classes classes.struct ;
+SPECIALIZED-ARRAY: ushort
 IN: io.launcher.windows
 
 TUPLE: CreateProcess-args

basis/io/mmap/alien/alien.factor

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

basis/io/mmap/bool/bool.factor

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

basis/io/mmap/char/char.factor

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

basis/io/mmap/double/double.factor

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

basis/io/mmap/float/float.factor

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

basis/io/mmap/functor/functor.factor

@@ -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

basis/io/mmap/int/int.factor

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

basis/io/mmap/long/long.factor

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

basis/io/mmap/longlong/longlong.factor

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

basis/io/mmap/mmap-tests.factor

@@ -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
+[ ] [ "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 [ length ] with-mapped-char-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 [ length ] with-mapped-char-file-reader ] 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
 

basis/io/mmap/mmap.factor

@@ -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 ;

basis/io/mmap/short/short.factor

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

basis/io/mmap/uchar/uchar.factor

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

basis/io/mmap/uint/uint.factor

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

basis/io/mmap/ulong/ulong.factor

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

basis/io/mmap/ulonglong/ulonglong.factor

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

basis/io/mmap/ushort/ushort.factor

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

basis/io/pipes/unix/unix.factor

@@ -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 ;
+io.backend.unix io.ports specialized-arrays accessors ;
-IN: io.pipes.unix
 QUALIFIED: io.pipes
+SPECIALIZED-ARRAY: int
+IN: io.pipes.unix
 
 M: unix io.pipes:(pipe) ( -- pair )
     2 <int-array>

basis/math/blas/matrices/matrices.factor

@@ -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
+parser prettyprint.backend prettyprint.custom ascii
-specialized-arrays.complex-float specialized-arrays.complex-double
+specialized-arrays ;
-parser prettyprint.backend prettyprint.custom ascii ;
+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 ;

basis/math/blas/vectors/vectors.factor

@@ -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 ;
-specialized-arrays.complex-float specialized-arrays.complex-double ;
+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 ;

basis/math/vectors/simd/alien/alien-tests.factor

@@ -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 } ] [

basis/math/vectors/specialization/specialization-tests.factor

@@ -1,8 +1,9 @@
 IN: math.vectors.specialization.tests
 USING: compiler.tree.debugger math.vectors tools.test kernel
-kernel.private math specialized-arrays.double
+kernel.private math specialized-arrays ;
-specialized-arrays.complex-float
+SPECIALIZED-ARRAY: double
-specialized-arrays.float ;
+SPECIALIZED-ARRAY: complex-float
+SPECIALIZED-ARRAY: float
 
 [ V{ t } ] [
     [ { double-array double-array } declare distance 0.0 < not ] final-literals

basis/math/vectors/specialization/specialization.factor

@@ -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
+USING: alien.c-types words kernel make sequences effects
-combinators math math.intervals math.vectors namespaces assocs fry
+kernel.private accessors combinators math math.intervals
-splitting classes.algebra generalizations locals
+math.vectors namespaces assocs fry splitting classes.algebra
-compiler.tree.propagation.info ;
+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 [
+    elt-type number class<= [
-        [ array-type elt-type simd specialize-vector-word ]
+        vector-words keys [
-        [ array-type elt-type input-signature ]
+            [ array-type elt-type simd specialize-vector-word ]
-        [ ]
+            [ array-type elt-type input-signature ]
-        tri add-specialization
+            [ ]
-    ] each ;
+            tri add-specialization
+        ] each
+    ] when ;
 
 : find-specialization ( classes word -- word/f )
     specializations

basis/opengl/opengl.factor

@@ -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

basis/opengl/shaders/shaders.factor

@@ -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 -- )

basis/opengl/textures/textures.factor

@@ -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
+USING: accessors assocs cache colors.constants destructors
-opengl opengl.gl opengl.capabilities combinators images
+kernel opengl opengl.gl opengl.capabilities combinators images
-images.tesselation grouping specialized-arrays.float sequences math
+images.tesselation grouping sequences math math.vectors
-math.vectors math.matrices generalizations fry arrays namespaces
+math.matrices generalizations fry arrays namespaces system
-system locals literals ;
+locals literals specialized-arrays ;
+SPECIALIZED-ARRAY: float
 IN: opengl.textures
 
 SYMBOL: non-power-of-2-textures?

basis/random/mersenne-twister/mersenne-twister.factor

@@ -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

basis/sequences/complex/complex-docs.factor

@@ -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
+USING: prettyprint specialized-arrays ;
-specialized-arrays.double sequences.complex
+sequences.complex sequences arrays ;
-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 }" } } ;
 

basis/sequences/complex/complex-tests.factor

@@ -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 )

basis/serialize/serialize-tests.factor

@@ -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 -- ? )

basis/specialized-arrays/alien/alien.factor

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

basis/specialized-arrays/bool/bool.factor

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

basis/specialized-arrays/char/char.factor

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

basis/specialized-arrays/complex-double/complex-double-tests.factor

@@ -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

basis/specialized-arrays/complex-double/complex-double.factor

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

basis/specialized-arrays/complex-float/complex-float.factor

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

basis/specialized-arrays/double/double.factor

@@ -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

basis/specialized-arrays/float/float.factor

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

basis/specialized-arrays/functor/functor.factor

@@ -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

basis/specialized-arrays/functor/summary.txt

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

basis/specialized-arrays/int/int.factor

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

basis/specialized-arrays/long/long.factor

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

basis/specialized-arrays/longlong/longlong.factor

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

basis/specialized-arrays/ptrdiff_t/ptrdiff_t.factor

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

basis/specialized-arrays/short/short.factor

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

basis/specialized-arrays/specialized-arrays-docs.factor

@@ -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"
+HELP: SPECIALIZED-ARRAY:
-"The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing."
+{ $syntax "SPECIALIZED-ARRAY: type" }
-$nl
+{ $values { "type" "a C type" } }
-"For each primitive C type " { $snippet "T" } ", a set of words are defined in the vocabulary named " { $snippet "specialized-arrays.T" } ":"
+{ $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:"
+"A specialized array type needs to be generated for each element type. This is done with a parsing word:"
-{ $list
+{ $subsection POSTPONE: SPECIALIZED-ARRAY: }
-    { $snippet "char" }
+"This parsing word adds new words to the search path:"
-    { $snippet "uchar" }
+{ $subsection "specialized-array-words" }
-    { $snippet "short" }
+{ $subsection "specialized-array-c" }
-    { $snippet "ushort" }
+{ $subsection "specialized-array-math" }
-    { $snippet "int" }
+{ $subsection "specialized-array-examples" }
-    { $snippet "uint" }
+"The " { $vocab-link "specialized-vectors" } " vocabulary provides a resizable version of this abstraction." ;
-    { $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." ;
 
 ABOUT: "specialized-arrays"

basis/specialized-arrays/specialized-arrays-tests.factor

@@ -1,9 +1,16 @@
 IN: specialized-arrays.tests
-USING: tools.test alien.syntax specialized-arrays sequences
+USING: tools.test alien.syntax specialized-arrays
-specialized-arrays.int specialized-arrays.bool
+specialized-arrays sequences alien.c-types accessors
-specialized-arrays.ushort alien.c-types accessors kernel
+kernel arrays combinators compiler classes.struct
-specialized-arrays.char specialized-arrays.uint
+combinators.smart compiler.tree.debugger math libc destructors
-specialized-arrays.float arrays combinators compiler ;
+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

basis/specialized-arrays/specialized-arrays.factor

@@ -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

basis/specialized-arrays/uchar/uchar.factor

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

basis/specialized-arrays/uint/uint.factor

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

basis/specialized-arrays/ulong/ulong.factor

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

basis/specialized-arrays/ulonglong/ulonglong.factor

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

basis/specialized-arrays/ushort/ushort.factor

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

basis/specialized-vectors/alien/alien.factor

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

basis/specialized-vectors/bool/bool.factor

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

basis/specialized-vectors/char/char.factor

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

basis/specialized-vectors/double/double.factor

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

basis/specialized-vectors/float/float.factor

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

basis/specialized-vectors/functor/functor.factor

@@ -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

basis/specialized-vectors/functor/summary.txt

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

basis/specialized-vectors/int/int.factor

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

basis/specialized-vectors/long/long.factor

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

basis/specialized-vectors/longlong/longlong.factor

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

basis/specialized-vectors/short/short.factor

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

basis/specialized-vectors/specialized-vectors-docs.factor

@@ -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"
+HELP: SPECIALIZED-VECTOR:
-"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
+{ $syntax "SPECIALIZED-VECTOR: type" }
-$nl
+{ $values { "type" "a C type" } }
-"For each primitive C type " { $snippet "T" } ", a set of words are defined:"
+{ $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:"
+"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." ;
-{ $list
+
-    { $snippet "char" }
+ARTICLE: "specialized-vector-c" "Passing specialized arrays to C functions"
-    { $snippet "uchar" }
+"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." ;
-    { $snippet "short" }
+
-    { $snippet "ushort" }
+ARTICLE: "specialized-vectors" "Specialized vectors"
-    { $snippet "int" }
+"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
-    { $snippet "uint" }
+{ $subsection "specialized-vector-words" }
-    { $snippet "long" }
+{ $subsection "specialized-vector-c" }
-    { $snippet "ulong" }
+"The " { $vocab-link "specialized-arrays" } " vocabulary provides a fixed-length version of this abstraction." ;
-    { $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." ;
 
 ABOUT: "specialized-vectors"

basis/specialized-vectors/specialized-vectors-tests.factor

@@ -1,8 +1,9 @@
 IN: specialized-vectors.tests
-USING: specialized-arrays.float
+USING: specialized-arrays specialized-vectors
-specialized-vectors.float
-specialized-vectors.double
 tools.test kernel sequences ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-VECTOR: float
+SPECIALIZED-VECTOR: double
 
 [ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test
 

basis/specialized-vectors/specialized-vectors.factor

@@ -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 ;

basis/specialized-vectors/uchar/uchar.factor

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

basis/specialized-vectors/uint/uint.factor

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

basis/specialized-vectors/ulong/ulong.factor

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

basis/specialized-vectors/ulonglong/ulonglong.factor

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

basis/specialized-vectors/ushort/ushort.factor

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