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

basis/alien/arrays/arrays-docs.factor

@@ -6,7 +6,7 @@ ARTICLE: "c-arrays" "C arrays"
 $nl
 "C type specifiers for array types are documented in " { $link "c-types-specs" } "."
 $nl
-"Specialized sequences are provided for accessing memory as an array of primitive type values. These sequences are implemented in the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets. They can also be loaded and constructed through their primitive C types:"
+"Specialized sequences are provided for accessing memory as an array of primitive type values. These sequences are implemented in the " { $vocab-link "specialized-arrays" } " vocabulary set. They can also be loaded and constructed through their primitive C types:"
-{ $subsection require-c-arrays }
+{ $subsection require-c-array }
 { $subsection <c-array> }
 { $subsection <c-direct-array> } ;

basis/alien/arrays/arrays.factor

@@ -35,7 +35,7 @@ M: array stack-size drop "void*" stack-size ;
 M: array c-type-boxer-quot
     unclip
     [ array-length ]
-    [ [ require-c-arrays ] keep ] bi*
+    [ [ require-c-array ] keep ] bi*
     [ <c-direct-array> ] 2curry ;
 
 M: array c-type-unboxer-quot drop [ >c-ptr ] ;

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-arrays } " 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, 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." }
 { $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 direct 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-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." }
+{ $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." }
 { $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." } ;
 
@@ -130,15 +130,15 @@ HELP: malloc-string
     }
 } ;
 
-HELP: require-c-arrays
+HELP: require-c-array
 { $values { "c-type" "a C type" } }
-{ $description { $link require } "s any unloaded vocabularies needed to construct a specialized array or direct array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
+{ $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" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets 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 set 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 direct 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-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } ;
+{ $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." } ;
 
 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

@@ -25,9 +25,7 @@ align
 array-class
 array-constructor
 (array)-constructor
-direct-array-class
+direct-array-constructor ;
-direct-array-constructor
-sequence-mixin-class ;
 
 TUPLE: c-type < abstract-c-type
 boxer
@@ -89,21 +87,19 @@ M: string heap-size c-type heap-size ;
 
 M: abstract-c-type heap-size size>> ;
 
-GENERIC: require-c-arrays ( c-type -- )
+GENERIC: require-c-array ( c-type -- )
 
-M: object require-c-arrays
+M: object require-c-array
     drop ;
 
-M: c-type require-c-arrays
+M: c-type require-c-array
-    [ array-class>> ?require-word ]
+    array-class>> ?require-word ;
-    [ sequence-mixin-class>> ?require-word ]
-    [ direct-array-class>> ?require-word ] tri ;
 
-M: string require-c-arrays
+M: string require-c-array
-    c-type require-c-arrays ;
+    c-type require-c-array ;
 
-M: array require-c-arrays
+M: array require-c-array
-    first c-type require-c-arrays ;
+    first c-type require-c-array ;
 
 ERROR: specialized-array-vocab-not-loaded vocab word ;
 
@@ -370,14 +366,6 @@ M: long-long-type box-return ( type -- )
         ]
         [
             [ "specialized-arrays." prepend ]
-            [ "-sequence" append ] bi* ?lookup >>sequence-mixin-class
-        ]
-        [
-            [ "specialized-arrays.direct." prepend ]
-            [ "direct-" "-array" surround ] bi* ?lookup >>direct-array-class
-        ]
-        [
-            [ "specialized-arrays.direct." prepend ]
             [ "<direct-" "-array>" surround ] bi* ?lookup >>direct-array-constructor
         ]
     } 2cleave ;

basis/classes/struct/struct-tests.factor

@@ -5,9 +5,8 @@ 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.char int
-specialized-arrays.direct.int specialized-arrays.ushort
+specialized-arrays.ushort struct-arrays system tools.test ;
-struct-arrays system tools.test ;
 IN: classes.struct.tests
 
 <<

basis/classes/struct/struct.factor

@@ -6,7 +6,7 @@ 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.direct.uchar ;
+words compiler.tree.propagation.transforms specialized-arrays.uchar ;
 FROM: slots => reader-word writer-word ;
 IN: classes.struct
 
@@ -20,8 +20,7 @@ TUPLE: struct
 TUPLE: struct-slot-spec < slot-spec
     c-type ;
 
-PREDICATE: struct-class < tuple-class
+PREDICATE: struct-class < tuple-class \ struct subclass-of? ;
-    { [ \ struct subclass-of? ] [ all-slots length 1 = ] } 1&& ;
 
 : struct-slots ( struct-class -- slots )
     "struct-slots" word-prop ;
@@ -126,10 +125,6 @@ M: struct-class writer-quot
     [ \ struct-slot-values ] [ struct-slot-values-quot ] bi
     define-inline-method ;
 
-: (define-byte-length-method) ( class -- )
-    [ \ byte-length ] [ heap-size \ drop swap [ ] 2sequence ] bi
-    define-inline-method ;
-
 : clone-underlying ( struct -- byte-array )
     [ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline
 
@@ -203,6 +198,9 @@ M: struct-class c-type-unboxer-quot
 M: struct-class heap-size
     "struct-size" word-prop ;
 
+M: struct byte-length
+    class "struct-size" word-prop ; foldable
+
 ! class definition
 
 <PRIVATE
@@ -218,9 +216,8 @@ M: struct-class heap-size
 
 : (struct-methods) ( class -- )
     [ (define-struct-slot-values-method) ]
-    [ (define-byte-length-method) ]
     [ (define-clone-method) ]
-    tri ;
+    bi ;
 
 : (struct-word-props) ( class slots size align -- )
     [

basis/cocoa/enumeration/enumeration.factor

@@ -4,7 +4,7 @@ USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types
 locals math sequences vectors fry libc destructors ;
 IN: cocoa.enumeration
 
-<< "id" require-c-arrays >>
+<< "id" require-c-array >>
 
 CONSTANT: NS-EACH-BUFFER-SIZE 16
 

basis/cocoa/messages/messages.factor

@@ -5,7 +5,7 @@ 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.direct.alien ;
+generalizations specialized-arrays.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )

basis/core-foundation/fsevents/fsevents.factor

@@ -3,8 +3,8 @@
 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.direct.alien classes.struct
+arrays specialized-arrays.alien classes.struct
-specialized-arrays.direct.int specialized-arrays.direct.longlong
+specialized-arrays.int specialized-arrays.longlong
 core-foundation core-foundation.run-loop core-foundation.strings
 core-foundation.time ;
 IN: core-foundation.fsevents

basis/environment/winnt/winnt.factor

@@ -6,7 +6,7 @@ alien.c-types sequences windows.errors io.streams.memory
 io.encodings io ;
 IN: environment.winnt
 
-<< "TCHAR" require-c-arrays >>
+<< "TCHAR" require-c-array >>
 
 M: winnt os-env ( key -- value )
     MAX_UNICODE_PATH "TCHAR" <c-array>

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

@@ -2,7 +2,7 @@
 ! 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.direct.uint arrays
+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 ;
 IN: io.files.info.unix.macosx

basis/io/launcher/windows/nt/nt-tests.factor

@@ -42,7 +42,7 @@ IN: io.launcher.windows.nt.tests
         console-vm "-run=listener" 2array >>command
         +closed+ >>stdin
         +stdout+ >>stderr
-    ascii [ contents ] with-process-reader
+    ascii [ lines last ] with-process-reader
 ] unit-test
 
 : launcher-test-path ( -- str )
@@ -166,7 +166,7 @@ IN: io.launcher.windows.nt.tests
 
 [ "( scratchpad ) " ] [
     console-vm "-run=listener" 2array
-    ascii [ "USE: system 0 exit" print flush readln ] with-process-stream
+    ascii [ "USE: system 0 exit" print flush lines last ] with-process-stream
 ] unit-test
 
 [ ] [

basis/io/mmap/alien/alien.factor

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

basis/io/mmap/bool/bool.factor

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

basis/io/mmap/char/char.factor

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

basis/io/mmap/double/double.factor

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

basis/io/mmap/float/float.factor

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

basis/io/mmap/int/int.factor

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

basis/io/mmap/long/long.factor

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

basis/io/mmap/longlong/longlong.factor

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

basis/io/mmap/short/short.factor

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

basis/io/mmap/uchar/uchar.factor

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

basis/io/mmap/uint/uint.factor

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

basis/io/mmap/ulong/ulong.factor

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

basis/io/mmap/ulonglong/ulonglong.factor

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

basis/io/mmap/ushort/ushort.factor

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

basis/math/blas/matrices/matrices.factor

@@ -3,9 +3,7 @@ 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.direct.float specialized-arrays.direct.double
 specialized-arrays.float specialized-arrays.double
-specialized-arrays.direct.complex-float specialized-arrays.direct.complex-double
 specialized-arrays.complex-float specialized-arrays.complex-double
 parser prettyprint.backend prettyprint.custom ascii ;
 IN: math.blas.matrices

basis/math/blas/vectors/vectors.factor

@@ -3,10 +3,7 @@ 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.direct.float specialized-arrays.direct.double
+specialized-arrays.complex-float specialized-arrays.complex-double ;
-specialized-arrays.complex-float specialized-arrays.complex-double
-specialized-arrays.direct.complex-float
-specialized-arrays.direct.complex-double ;
 IN: math.blas.vectors
 
 TUPLE: blas-vector-base underlying length inc ;

basis/specialized-arrays/direct/alien/alien.factor

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

basis/specialized-arrays/direct/bool/bool.factor

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

basis/specialized-arrays/direct/char/char.factor

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

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

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

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

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

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

@@ -1,33 +0,0 @@
-USING: help.markup help.syntax byte-arrays alien ;
-IN: specialized-arrays.direct
-
-ARTICLE: "specialized-arrays.direct" "Direct-mapped specialized arrays"
-"The " { $vocab-link "specialized-arrays.direct" } " vocabulary implements fixed-length sequence types for storing machine values in unmanaged C memory."
-$nl
-"For each primitive C type " { $snippet "T" } ", a set of words are defined:"
-{ $table
-    { { $snippet "direct-T-array" } { "The class of direct arrays with elements of type " { $snippet "T" } } }
-    { { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( alien len -- array )" } } }
-}
-"Each direct array has a " { $slot "underlying" } " slot holding an " { $link simple-alien } " pointer to the raw data. This data can be passed to C functions."
-$nl
-"The primitive C types for which direct 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 "void*" }
-    { $snippet "bool" }
-}
-"Direct arrays are generated with a functor in the " { $vocab-link "specialized-arrays.direct.functor" } " vocabulary." ;
-
-ABOUT: "specialized-arrays.direct"

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

@@ -1,7 +0,0 @@
-IN: specialized-arrays.direct.tests
-USING: specialized-arrays.direct.ushort tools.test
-specialized-arrays.ushort alien.syntax sequences ;
-
-[ ushort-array{ 0 0 0 } ] [
-    3 ALIEN: 123 100 <direct-ushort-array> new-sequence
-] unit-test

basis/specialized-arrays/direct/direct.factor

@@ -1,3 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: specialized-arrays.direct

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

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

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

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

basis/specialized-arrays/direct/functor/functor.factor

@@ -1,66 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: functors sequences sequences.private kernel words classes
-math alien alien.c-types byte-arrays accessors
-specialized-arrays parser
-prettyprint.backend prettyprint.custom prettyprint.sections ;
-IN: specialized-arrays.direct.functor
-
-<PRIVATE
-
-: pprint-direct-array ( direct-array tag -- )
-    [ [ underlying>> ] [ length>> ] bi [ pprint* ] bi@ ] pprint-prefix ;
-
-PRIVATE>
-
-FUNCTOR: define-direct-array ( T -- )
-
-A'      IS ${T}-array
-S       IS ${T}-sequence
->A'     IS >${T}-array
-<A'>    IS <${A'}>
-A'{     IS ${A'}{
-
-A       DEFINES-CLASS direct-${T}-array
-<A>     DEFINES <${A}>
-A'@      DEFINES ${A'}@
-
-NTH     [ T dup c-type-getter-boxer array-accessor ]
-SET-NTH [ T dup c-setter array-accessor ]
-
-WHERE
-
-TUPLE: A
-{ underlying c-ptr read-only }
-{ length fixnum read-only } ;
-
-: <A> ( alien len -- direct-array ) A boa ; inline
-M: A length length>> ; inline
-M: A nth-unsafe underlying>> NTH call ; inline
-M: A set-nth-unsafe underlying>> SET-NTH call ; inline
-M: A like drop dup A instance? [ >A' ] unless ; inline
-M: A new-sequence drop <A'> ; inline
-
-M: A byte-length length>> T heap-size * ; inline
-
-SYNTAX: A'@ 
-    scan-object scan-object <A> parsed ;
-
-M: A pprint-delims drop \ A'{ \ } ;
-
-M: A >pprint-sequence ;
-
-M: A pprint*
-    [ pprint-object ]
-    [ \ A'@ pprint-direct-array ]
-    pprint-c-object ;
-
-INSTANCE: A sequence
-INSTANCE: A S
-
-T c-type
-    \ A >>direct-array-class
-    \ <A> >>direct-array-constructor
-    drop
-
-;FUNCTOR

basis/specialized-arrays/direct/functor/summary.txt

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

basis/specialized-arrays/direct/int/int.factor

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

basis/specialized-arrays/direct/long/long.factor

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

basis/specialized-arrays/direct/longlong/longlong.factor

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

basis/specialized-arrays/direct/short/short.factor

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

basis/specialized-arrays/direct/uchar/uchar.factor

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

basis/specialized-arrays/direct/uint/uint.factor

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

basis/specialized-arrays/direct/ulong/ulong.factor

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

basis/specialized-arrays/direct/ulonglong/ulonglong.factor

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

basis/specialized-arrays/direct/ushort/ushort.factor

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

basis/specialized-arrays/functor/functor.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! 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.c-types byte-arrays accessors summary alien specialized-arrays ;
 IN: specialized-arrays.functor
 
 ERROR: bad-byte-array-length byte-array type ;
@@ -22,9 +22,12 @@ 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 ]
@@ -34,18 +37,20 @@ WHERE
 MIXIN: S
 
 TUPLE: A
-{ length array-capacity read-only }
+{ underlying c-ptr read-only }
-{ underlying byte-array read-only } ;
+{ length array-capacity read-only } ;
 
-: <A> ( n -- specialized-array ) dup T <underlying> A boa ; inline
+: <direct-A> ( alien len -- specialized-array ) A boa ; inline
 
-: (A) ( n -- specialized-array ) dup T (underlying) 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
-    swap A boa ; inline
+    <direct-A> ; inline
 
-M: A clone [ length>> ] [ underlying>> clone ] bi A boa ; inline
+M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
 
 M: A length length>> ; inline
 
@@ -62,24 +67,20 @@ M: A new-sequence drop (A) ; inline
 M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
 
 M: A resize
-    [ drop ] [
+    [
         [ T heap-size * ] [ underlying>> ] bi*
         resize-byte-array
-    ] 2bi
+    ] [ drop ] 2bi
-    A boa ; inline
+    <direct-A> ; inline
 
 M: A byte-length underlying>> length ; inline
-
 M: A pprint-delims drop \ A{ \ } ;
-
 M: A >pprint-sequence ;
 
-M: A pprint* pprint-object ;
-
 SYNTAX: A{ \ } [ >A ] parse-literal ;
+SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
 
-INSTANCE: A sequence
+INSTANCE: A specialized-array
-INSTANCE: A S
 
 A T c-type-boxed-class specialize-vector-words
 
@@ -87,7 +88,7 @@ T c-type
     \ A >>array-class
     \ <A> >>array-constructor
     \ (A) >>(array)-constructor
-    \ S >>sequence-mixin-class
+    \ <direct-A> >>direct-array-constructor
     drop
 
 ;FUNCTOR

basis/specialized-arrays/prettyprint/prettyprint.factor

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

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

@@ -8,8 +8,9 @@ $nl
 { $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 ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
+    { { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; 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."

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

@@ -2,8 +2,7 @@ IN: specialized-arrays.tests
 USING: tools.test specialized-arrays sequences
 specialized-arrays.int specialized-arrays.bool
 specialized-arrays.ushort alien.c-types accessors kernel
-specialized-arrays.direct.int specialized-arrays.char
+specialized-arrays.char specialized-arrays.uint arrays combinators ;
-specialized-arrays.uint arrays combinators ;
 
 [ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
 
@@ -28,3 +27,7 @@ specialized-arrays.uint arrays combinators ;
 [ { 3 1 3 3 7 } ] [
     int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
 ] unit-test
+
+[ ushort-array{ 0 0 0 } ] [
+    3 ALIEN: 123 100 <direct-ushort-array> new-sequence
+] unit-test

basis/specialized-arrays/specialized-arrays.factor

@@ -1,3 +1,13 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences vocabs vocabs.loader ;
 IN: specialized-arrays
+
+MIXIN: specialized-array
+INSTANCE: specialized-array sequence
+
+GENERIC: direct-array-syntax ( obj -- word )
+
+"prettyprint" vocab [
+    "specialized-arrays.prettyprint" require
+] when

basis/tools/deploy/shaker/shaker.factor

@@ -178,6 +178,7 @@ IN: tools.deploy.shaker
                 "slots"
                 "special"
                 "specializer"
+                "struct-slots"
                 ! UI needs this
                 ! "superclass"
                 "transform-n"

basis/windows/com/prettyprint/prettyprint.factor

@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: windows.com windows.kernel32 windows.ole32
+prettyprint.custom prettyprint.sections sequences ;
+IN: windows.com.prettyprint
+
+M: GUID pprint* guid>string "GUID: " prepend text ;

basis/windows/com/syntax/syntax.factor

@@ -2,7 +2,7 @@ USING: alien alien.c-types alien.accessors effects kernel
 windows.ole32 parser lexer splitting grouping sequences
 namespaces assocs quotations generalizations accessors words
 macros alien.syntax fry arrays layouts math classes.struct
-windows.kernel32 prettyprint.custom prettyprint.sections ;
+windows.kernel32 ;
 IN: windows.com.syntax
 
 <PRIVATE
@@ -99,4 +99,8 @@ SYNTAX: COM-INTERFACE:
 
 SYNTAX: GUID: scan string>guid parsed ;
 
-M: GUID pprint* guid>string "GUID: " prepend text ;
+USING: vocabs vocabs.loader ;
+
+"prettyprint" vocab [
+    "windows.com.prettyprint" require
+] when

basis/windows/com/wrapper/wrapper.factor

@@ -3,8 +3,7 @@ init windows.com.syntax.private windows.com continuations kernel
 namespaces windows.ole32 libc vocabs assocs accessors arrays
 sequences quotations combinators math words compiler.units
 destructors fry math.parser generalizations sets
-specialized-arrays.alien specialized-arrays.direct.alien
+specialized-arrays.alien windows.kernel32 classes.struct ;
-windows.kernel32 classes.struct ;
 IN: windows.com.wrapper
 
 TUPLE: com-wrapper < disposable callbacks vtbls ;

basis/windows/dragdrop-listener/dragdrop-listener.factor

@@ -5,7 +5,7 @@ prettyprint namespaces ui.tools.listener ui.tools.workspace
 alien.c-types alien sequences math ;
 IN: windows.dragdrop-listener
 
-<< "WCHAR" require-c-arrays >>
+<< "WCHAR" require-c-array >>
 
 : filenames-from-hdrop ( hdrop -- filenames )
     dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files

basis/windows/errors/errors.factor

@@ -4,7 +4,7 @@ io.encodings.string io.encodings.utf16n alien.strings
 arrays literals ;
 IN: windows.errors
 
-<< "TCHAR" require-c-arrays >>
+<< "TCHAR" require-c-array >>
 
 CONSTANT: ERROR_SUCCESS                               0
 CONSTANT: ERROR_INVALID_FUNCTION                      1
@@ -698,7 +698,7 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK   HEX: 000000FF
 : make-lang-id ( lang1 lang2 -- n )
     10 shift bitor ; inline
 
-<< "TCHAR" require-c-arrays >>
+<< "TCHAR" require-c-array >>
 
 ERROR: error-message-failed id ;
 :: n>win32-error-string ( id -- string )

basis/windows/ole32/ole32.factor

@@ -1,7 +1,7 @@
 USING: alien alien.syntax alien.c-types alien.strings math
 kernel sequences windows.errors windows.types io
 accessors math.order namespaces make math.parser windows.kernel32
-combinators locals specialized-arrays.direct.uchar
+combinators locals specialized-arrays.uchar
 literals splitting grouping classes.struct combinators.smart ;
 IN: windows.ole32
 

extra/half-floats/half-floats.factor

@@ -1,6 +1,6 @@
 ! (c)2009 Joe Groff bsd license
 USING: accessors alien.c-types alien.syntax kernel math math.order
-specialized-arrays.direct.functor specialized-arrays.functor ;
+specialized-arrays.functor ;
 IN: half-floats
 
 : half>bits ( float -- bits )
@@ -37,6 +37,5 @@ C-STRUCT: half { "ushort" "(bits)" } ;
     drop
 
 "half" define-array
-"half" define-direct-array
 
 >>

extra/images/normalization/normalization.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2009 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors grouping sequences combinators
+USING: kernel accessors grouping sequences combinators math
-math specialized-arrays.direct.uint byte-arrays fry
+byte-arrays fry specialized-arrays.direct.ushort
-specialized-arrays.direct.ushort specialized-arrays.uint
+specialized-arrays.uint specialized-arrays.ushort
-specialized-arrays.ushort specialized-arrays.float images
+specialized-arrays.float images half-floats ;
-half-floats ;
 IN: images.normalization
 
 <PRIVATE