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

basis/alien/arrays/arrays-docs.factor

@@ -1,5 +1,5 @@
+USING: help.syntax help.markup byte-arrays alien.c-types alien.data ;
 IN: alien.arrays
-USING: help.syntax help.markup byte-arrays alien.c-types ;
 
 ARTICLE: "c-arrays" "C arrays"
 "C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."

basis/alien/arrays/arrays.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.strings alien.c-types alien.accessors
+USING: alien alien.strings alien.c-types alien.data alien.accessors
-arrays words sequences math kernel namespaces fry libc cpu.architecture
+arrays words sequences math kernel namespaces fry cpu.architecture
 io.encodings.utf8 accessors ;
 IN: alien.arrays
 
@@ -22,15 +22,15 @@ M: array c-type-align first c-type-align ;
 
 M: array c-type-stack-align? drop f ;
 
-M: array unbox-parameter drop "void*" unbox-parameter ;
+M: array unbox-parameter drop void* unbox-parameter ;
 
-M: array unbox-return drop "void*" unbox-return ;
+M: array unbox-return drop void* unbox-return ;
 
-M: array box-parameter drop "void*" box-parameter ;
+M: array box-parameter drop void* box-parameter ;
 
-M: array box-return drop "void*" box-return ;
+M: array box-return drop void* box-return ;
 
-M: array stack-size drop "void*" stack-size ;
+M: array stack-size drop void* stack-size ;
 
 M: array c-type-boxer-quot
     unclip
@@ -41,7 +41,7 @@ M: array c-type-boxer-quot
 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
 
 PREDICATE: string-type < pair
-    first2 [ "char*" = ] [ word? ] bi* and ;
+    first2 [ char* = ] [ word? ] bi* and ;
 
 M: string-type c-type ;
 
@@ -50,37 +50,37 @@ M: string-type c-type-class drop object ;
 M: string-type c-type-boxed-class drop object ;
 
 M: string-type heap-size
-    drop "void*" heap-size ;
+    drop void* heap-size ;
 
 M: string-type c-type-align
-    drop "void*" c-type-align ;
+    drop void* c-type-align ;
 
 M: string-type c-type-stack-align?
-    drop "void*" c-type-stack-align? ;
+    drop void* c-type-stack-align? ;
 
 M: string-type unbox-parameter
-    drop "void*" unbox-parameter ;
+    drop void* unbox-parameter ;
 
 M: string-type unbox-return
-    drop "void*" unbox-return ;
+    drop void* unbox-return ;
 
 M: string-type box-parameter
-    drop "void*" box-parameter ;
+    drop void* box-parameter ;
 
 M: string-type box-return
-    drop "void*" box-return ;
+    drop void* box-return ;
 
 M: string-type stack-size
-    drop "void*" stack-size ;
+    drop void* stack-size ;
 
 M: string-type c-type-rep
     drop int-rep ;
 
 M: string-type c-type-boxer
-    drop "void*" c-type-boxer ;
+    drop void* c-type-boxer ;
 
 M: string-type c-type-unboxer
-    drop "void*" c-type-unboxer ;
+    drop void* c-type-unboxer ;
 
 M: string-type c-type-boxer-quot
     second '[ _ alien>string ] ;
@@ -94,6 +94,8 @@ M: string-type c-type-getter
 M: string-type c-type-setter
     drop [ set-alien-cell ] ;
 
-{ "char*" utf8 } "char*" typedef
+{ char* utf8 } char* typedef
-"char*" "uchar*" typedef
+char* uchar* typedef
 
+char  char*  "pointer-c-type" set-word-prop
+uchar uchar* "pointer-c-type" set-word-prop

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

@@ -1,7 +1,25 @@
-IN: alien.c-types
 USING: alien help.syntax help.markup libc kernel.private
 byte-arrays math strings hashtables alien.syntax alien.strings sequences
 io.encodings.string debugger destructors vocabs.loader ;
+IN: alien.c-types
+
+HELP: byte-length
+{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
+{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ;
+
+HELP: heap-size
+{ $values { "type" string } { "size" integer } }
+{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
+{ $examples
+    "On a 32-bit system, you will get the following output:"
+    { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" }
+}
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
+
+HELP: stack-size
+{ $values { "type" string } { "size" integer } }
+{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
 
 HELP: <c-type>
 { $values { "type" hashtable } }
@@ -20,24 +38,6 @@ HELP: c-type
 { $description "Looks up a C type by name." }
 { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
 
-HELP: heap-size
-{ $values { "type" string } { "size" integer } }
-{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
-{ $examples
-    "On a 32-bit system, you will get the following output:"
-    { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" }
-}
-{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-
-HELP: stack-size
-{ $values { "type" string } { "size" integer } }
-{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
-{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-
-HELP: byte-length
-{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
-{ $contract "Outputs the size of the byte array or float array data in bytes as presented to the C library interface." } ;
-
 HELP: c-getter
 { $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } }
 { $description "Outputs a quotation which reads values of this C type from a C structure." }
@@ -48,49 +48,6 @@ HELP: c-setter
 { $description "Outputs a quotation which writes values of this C type to a C structure." }
 { $errors "Throws an error if the type does not exist." } ;
 
-HELP: <c-array>
-{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } }
-{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
-{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. 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>
-{ $values { "type" "a C type" } { "array" byte-array } }
-{ $description "Creates a byte array suitable for holding a value with the given C type." }
-{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ;
-
-{ <c-object> malloc-object } related-words
-
-HELP: memory>byte-array
-{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
-{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
-
-HELP: byte-array>memory
-{ $values { "byte-array" byte-array } { "base" c-ptr } }
-{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
-{ $warning "This word is unsafe. Improper use can corrupt 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, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
-
-HELP: malloc-object
-{ $values { "type" "a C type" } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ;
-
-HELP: malloc-byte-array
-{ $values { "byte-array" byte-array } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if memory allocation fails." } ;
-
-{ <c-array> <c-direct-array> malloc-array } related-words
-
 HELP: box-parameter
 { $values { "n" integer } { "ctype" string } }
 { $description "Generates code for converting a C value stored at  offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
@@ -116,48 +73,6 @@ HELP: define-out
 { $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
 { $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
 
-{ string>alien alien>string malloc-string } related-words
-
-HELP: malloc-string
-{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
-{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if one of the following conditions occurs:"
-    { $list
-        "the string contains null code points"
-        "the string contains characters not representable using the encoding specified"
-        "memory allocation fails"
-    }
-} ;
-
-HELP: require-c-array
-{ $values { "c-type" "a C type" } }
-{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
-{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ;
-
-HELP: <c-direct-array>
-{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
-{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
-{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, 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."
-$nl
-"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
-$nl
-"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
-$nl
-"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
-$nl
-"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
-{ $subsection string>alien }
-{ $subsection malloc-string }
-"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
-$nl
-"A word to read strings from arbitrary addresses:"
-{ $subsection alien>string }
-"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
-
 ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
 "The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."
 $nl
@@ -234,61 +149,3 @@ $nl
 "Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation."
 $nl
 "Structure and union types are specified by the name of the structure or union." ;
-
-ARTICLE: "c-byte-arrays" "Passing data in byte arrays"
-"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array."
-$nl
-"Byte arrays can be allocated directly with a byte count using the " { $link <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
-{ $subsection <c-object> }
-{ $subsection <c-array> }
-{ $warning
-"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." }
-{ $see-also "c-arrays" } ;
-
-ARTICLE: "malloc" "Manual memory management"
-"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case."
-$nl
-"Allocating a C datum with a fixed address:"
-{ $subsection malloc-object }
-{ $subsection malloc-array }
-{ $subsection malloc-byte-array }
-"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:"
-{ $subsection malloc }
-{ $subsection calloc }
-{ $subsection realloc }
-"You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
-{ $subsection free }
-"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
-{ $subsection &free }
-{ $subsection |free }
-"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
-$nl
-"You can unsafely copy a range of bytes from one memory location to another:"
-{ $subsection memcpy }
-"You can copy a range of bytes from memory into a byte array:"
-{ $subsection memory>byte-array }
-"You can copy a byte array to memory unsafely:"
-{ $subsection byte-array>memory } ;
-
-ARTICLE: "c-data" "Passing data between Factor and C"
-"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
-$nl
-"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "."
-{ $subsection "c-types-specs" }
-{ $subsection "c-byte-arrays" }
-{ $subsection "malloc" }
-{ $subsection "c-strings" }
-{ $subsection "c-arrays" }
-{ $subsection "c-out-params" }
-"Important guidelines for passing data in byte arrays:"
-{ $subsection "byte-arrays-gc" }
-"C-style enumerated types are supported:"
-{ $subsection POSTPONE: C-ENUM: }
-"C types can be aliased for convenience and consitency with native library documentation:"
-{ $subsection POSTPONE: TYPEDEF: }
-"New C types can be defined:"
-{ $subsection "c-structs" }
-{ $subsection "c-unions" }
-"A utility for defining " { $link "destructors" } " for deallocating memory:"
-{ $subsection "alien.destructors" }
-{ $see-also "aliens" } ;

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

@@ -43,7 +43,7 @@ TYPEDEF: int* MyIntArray
 
 TYPEDEF: uchar* MyLPBYTE
 
-[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test
+[ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test
 
 [
     0 B{ 1 2 3 4 } <displaced-alien> <void*>

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

@@ -1,18 +1,27 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: byte-arrays arrays assocs kernel kernel.private libc math
+USING: byte-arrays arrays assocs kernel kernel.private math
 namespaces make parser sequences strings words splitting math.parser
 cpu.architecture alien alien.accessors alien.strings quotations
 layouts system compiler.units io io.files io.encodings.binary
 io.streams.memory accessors combinators effects continuations fry
-classes vocabs vocabs.loader ;
+classes vocabs vocabs.loader words.symbol ;
+QUALIFIED: math
 IN: alien.c-types
 
+SYMBOLS:
+    char uchar
+    short ushort
+    int uint
+    long ulong
+    longlong ulonglong
+    float double
+    void* bool
+    void ;
+
 DEFER: <int>
 DEFER: *char
 
-: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
-
 TUPLE: abstract-c-type
 { class class initial: object }
 { boxed-class class initial: object }
@@ -40,149 +49,124 @@ global [
 
 ERROR: no-c-type name ;
 
-: (c-type) ( name -- type/f )
+PREDICATE: c-type-word < word
-    c-types get-global at dup [
+    "c-type" word-prop ;
-        dup string? [ (c-type) ] when
+
-    ] when ;
+UNION: c-type-name string c-type-word ;
 
 ! C type protocol
 GENERIC: c-type ( name -- type ) foldable
 
-: resolve-pointer-type ( name -- name )
+GENERIC: resolve-pointer-type ( name -- c-type )
-    c-types get at dup string?
+
-    [ "*" append ] [ drop "void*" ] if
+M: word resolve-pointer-type
-    c-type ;
+    dup "pointer-c-type" word-prop
+    [ ] [ drop void* ] ?if ;
+M: string resolve-pointer-type
+    dup "*" append dup c-types get at
+    [ nip ] [
+        drop
+        c-types get at dup c-type-name?
+        [ resolve-pointer-type ] [ drop void* ] if
+    ] if ;
 
 : resolve-typedef ( name -- type )
-    dup string? [ c-type ] when ;
+    dup c-type-name? [ c-type ] when ;
 
-: parse-array-type ( name -- array )
+: parse-array-type ( name -- dims type )
     "[" split unclip
-    [ [ "]" ?tail drop string>number ] map ] dip prefix ;
+    [ [ "]" ?tail drop string>number ] map ] dip ;
 
 M: string c-type ( name -- type )
     CHAR: ] over member? [
-        parse-array-type
+        parse-array-type prefix
     ] [
-        dup c-types get at [
+        dup c-types get at [ ] [
-            resolve-typedef
-        ] [
             "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
-        ] ?if
+        ] ?if resolve-typedef
     ] if ;
 
+M: word c-type
+    "c-type" word-prop resolve-typedef ;
+
+: void? ( c-type -- ? )
+    { void "void" } member? ;
+
 GENERIC: c-struct? ( type -- ? )
 
 M: object c-struct?
     drop f ;
-M: string c-struct?
+M: c-type-name c-struct?
-    dup "void" = [ drop f ] [ c-type c-struct? ] if ;
+    dup void? [ drop f ] [ c-type c-struct? ] if ;
 
 ! These words being foldable means that words need to be
 ! recompiled if a C type is redefined. Even so, folding the
 ! size facilitates some optimizations.
-GENERIC: heap-size ( type -- size ) foldable
-
-M: string heap-size c-type heap-size ;
-
-M: abstract-c-type heap-size size>> ;
-
-GENERIC: require-c-array ( c-type -- )
-
-M: array require-c-array first require-c-array ;
-
-GENERIC: c-array-constructor ( c-type -- word )
-
-GENERIC: c-(array)-constructor ( c-type -- word )
-
-GENERIC: c-direct-array-constructor ( c-type -- word )
-
-GENERIC: <c-array> ( len c-type -- array )
-
-M: string <c-array>
-    c-array-constructor execute( len -- array ) ; inline
-
-GENERIC: (c-array) ( len c-type -- array )
-
-M: string (c-array)
-    c-(array)-constructor execute( len -- array ) ; inline
-
-GENERIC: <c-direct-array> ( alien len c-type -- array )
-
-M: string <c-direct-array>
-    c-direct-array-constructor execute( alien len -- array ) ; inline
-
-: malloc-array ( n type -- alien )
-    [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
-
-: (malloc-array) ( n type -- alien )
-    [ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
-
 GENERIC: c-type-class ( name -- class )
 
 M: abstract-c-type c-type-class class>> ;
 
-M: string c-type-class c-type c-type-class ;
+M: c-type-name c-type-class c-type c-type-class ;
 
 GENERIC: c-type-boxed-class ( name -- class )
 
 M: abstract-c-type c-type-boxed-class boxed-class>> ;
 
-M: string c-type-boxed-class c-type c-type-boxed-class ;
+M: c-type-name c-type-boxed-class c-type c-type-boxed-class ;
 
 GENERIC: c-type-boxer ( name -- boxer )
 
 M: c-type c-type-boxer boxer>> ;
 
-M: string c-type-boxer c-type c-type-boxer ;
+M: c-type-name c-type-boxer c-type c-type-boxer ;
 
 GENERIC: c-type-boxer-quot ( name -- quot )
 
 M: abstract-c-type c-type-boxer-quot boxer-quot>> ;
 
-M: string c-type-boxer-quot c-type c-type-boxer-quot ;
+M: c-type-name c-type-boxer-quot c-type c-type-boxer-quot ;
 
 GENERIC: c-type-unboxer ( name -- boxer )
 
 M: c-type c-type-unboxer unboxer>> ;
 
-M: string c-type-unboxer c-type c-type-unboxer ;
+M: c-type-name c-type-unboxer c-type c-type-unboxer ;
 
 GENERIC: c-type-unboxer-quot ( name -- quot )
 
 M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ;
 
-M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
+M: c-type-name c-type-unboxer-quot c-type c-type-unboxer-quot ;
 
 GENERIC: c-type-rep ( name -- rep )
 
 M: c-type c-type-rep rep>> ;
 
-M: string c-type-rep c-type c-type-rep ;
+M: c-type-name c-type-rep c-type c-type-rep ;
 
 GENERIC: c-type-getter ( name -- quot )
 
 M: c-type c-type-getter getter>> ;
 
-M: string c-type-getter c-type c-type-getter ;
+M: c-type-name c-type-getter c-type c-type-getter ;
 
 GENERIC: c-type-setter ( name -- quot )
 
 M: c-type c-type-setter setter>> ;
 
-M: string c-type-setter c-type c-type-setter ;
+M: c-type-name c-type-setter c-type c-type-setter ;
 
 GENERIC: c-type-align ( name -- n )
 
 M: abstract-c-type c-type-align align>> ;
 
-M: string c-type-align c-type c-type-align ;
+M: c-type-name c-type-align c-type c-type-align ;
 
 GENERIC: c-type-stack-align? ( name -- ? )
 
 M: c-type c-type-stack-align? stack-align?>> ;
 
-M: string c-type-stack-align? c-type c-type-stack-align? ;
+M: c-type-name c-type-stack-align? c-type c-type-stack-align? ;
 
 : c-type-box ( n type -- )
     [ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi
@@ -196,49 +180,48 @@ GENERIC: box-parameter ( n ctype -- )
 
 M: c-type box-parameter c-type-box ;
 
-M: string box-parameter c-type box-parameter ;
+M: c-type-name box-parameter c-type box-parameter ;
 
 GENERIC: box-return ( ctype -- )
 
 M: c-type box-return f swap c-type-box ;
 
-M: string box-return c-type box-return ;
+M: c-type-name box-return c-type box-return ;
 
 GENERIC: unbox-parameter ( n ctype -- )
 
 M: c-type unbox-parameter c-type-unbox ;
 
-M: string unbox-parameter c-type unbox-parameter ;
+M: c-type-name unbox-parameter c-type unbox-parameter ;
 
 GENERIC: unbox-return ( ctype -- )
 
 M: c-type unbox-return f swap c-type-unbox ;
 
-M: string unbox-return c-type unbox-return ;
+M: c-type-name unbox-return c-type unbox-return ;
+
+: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
+
+GENERIC: heap-size ( type -- size ) foldable
+
+M: c-type-name heap-size c-type heap-size ;
+
+M: abstract-c-type heap-size size>> ;
 
 GENERIC: stack-size ( type -- size ) foldable
 
-M: string stack-size c-type stack-size ;
+M: c-type-name stack-size c-type stack-size ;
 
 M: c-type stack-size size>> cell align ;
 
-MIXIN: value-type
-
-M: value-type c-type-rep drop int-rep ;
-
-M: value-type c-type-getter
-    drop [ swap <displaced-alien> ] ;
-
-M: value-type c-type-setter ( type -- quot )
-    [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
-    '[ @ swap @ _ memcpy ] ;
-
 GENERIC: byte-length ( seq -- n ) flushable
 
 M: byte-array byte-length length ; inline
 
 M: f byte-length drop 0 ; inline
 
+MIXIN: value-type
+
 : c-getter ( name -- quot )
     c-type-getter [
         [ "Cannot read struct fields with this type" throw ]
@@ -252,42 +235,29 @@ M: f byte-length drop 0 ; inline
         [ "Cannot write struct fields with this type" throw ]
     ] unless* ;
 
-: <c-object> ( type -- array )
-    heap-size <byte-array> ; inline
-
-: (c-object) ( type -- array )
-    heap-size (byte-array) ; inline
-
-: malloc-object ( type -- alien )
-    1 swap heap-size calloc ; inline
-
-: (malloc-object) ( type -- alien )
-    heap-size malloc ; inline
-
-: malloc-byte-array ( byte-array -- alien )
-    dup byte-length [ nip malloc dup ] 2keep memcpy ;
-
-: memory>byte-array ( alien len -- byte-array )
-    [ nip (byte-array) dup ] 2keep memcpy ;
-
-: malloc-string ( string encoding -- alien )
-    string>alien malloc-byte-array ;
-
-M: memory-stream stream-read
-    [
-        [ index>> ] [ alien>> ] bi <displaced-alien>
-        swap memory>byte-array
-    ] [ [ + ] change-index drop ] 2bi ;
-
-: byte-array>memory ( byte-array base -- )
-    swap dup byte-length memcpy ; inline
-
 : array-accessor ( type quot -- def )
     [
         \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
     ] [ ] make ;
 
-: typedef ( old new -- ) c-types get set-at ;
+GENERIC: typedef ( old new -- )
+
+PREDICATE: typedef-word < c-type-word
+    "c-type" word-prop c-type-name? ;
+
+M: string typedef ( old new -- ) c-types get set-at ;
+M: word typedef ( old new -- )
+    {
+        [ nip define-symbol ]
+        [ name>> typedef ]
+        [ swap "c-type" set-word-prop ]
+        [
+            swap dup c-type-name? [
+                resolve-pointer-type
+                "pointer-c-type" set-word-prop
+            ] [ 2drop ] if
+        ]
+    } 2cleave ;
 
 TUPLE: long-long-type < c-type ;
 
@@ -312,36 +282,33 @@ M: long-long-type box-return ( type -- )
 
 : define-out ( name -- )
     [ "alien.c-types" constructor-word ]
-    [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
+    [ dup c-setter '[ _ heap-size <byte-array> [ 0 @ ] keep ] ] bi
     (( value -- c-ptr )) define-inline ;
 
-: >c-bool ( ? -- int ) 1 0 ? ; inline
-
-: c-bool> ( int -- ? ) 0 = not ; inline
-
 : define-primitive-type ( type name -- )
     [ typedef ]
-    [ define-deref ]
+    [ name>> define-deref ]
-    [ define-out ]
+    [ name>> define-out ]
     tri ;
 
-: malloc-file-contents ( path -- alien len )
-    binary file-contents [ malloc-byte-array ] [ length ] bi ;
-
 : if-void ( type true false -- )
-    pick "void" = [ drop nip call ] [ nip call ] if ; inline
+    pick void? [ drop nip call ] [ nip call ] if ; inline
 
 CONSTANT: primitive-types
     {
-        "char" "uchar"
+        char uchar
-        "short" "ushort"
+        short ushort
-        "int" "uint"
+        int uint
-        "long" "ulong"
+        long ulong
-        "longlong" "ulonglong"
+        longlong ulonglong
-        "float" "double"
+        float double
-        "void*" "bool"
+        void* bool
     }
 
+SYMBOLS:
+    ptrdiff_t intptr_t size_t
+    char* uchar* ;
+
 [
     <c-type>
         c-ptr >>class
@@ -353,7 +320,7 @@ CONSTANT: primitive-types
         [ >c-ptr ] >>unboxer-quot
         "box_alien" >>boxer
         "alien_offset" >>unboxer
-    "void*" define-primitive-type
+    \ void* define-primitive-type
 
     <long-long-type>
         integer >>class
@@ -364,7 +331,7 @@ CONSTANT: primitive-types
         8 >>align
         "box_signed_8" >>boxer
         "to_signed_8" >>unboxer
-    "longlong" define-primitive-type
+    \ longlong define-primitive-type
 
     <long-long-type>
         integer >>class
@@ -375,7 +342,7 @@ CONSTANT: primitive-types
         8 >>align
         "box_unsigned_8" >>boxer
         "to_unsigned_8" >>unboxer
-    "ulonglong" define-primitive-type
+    \ ulonglong define-primitive-type
 
     <c-type>
         integer >>class
@@ -386,7 +353,7 @@ CONSTANT: primitive-types
         bootstrap-cell >>align
         "box_signed_cell" >>boxer
         "to_fixnum" >>unboxer
-    "long" define-primitive-type
+    \ long define-primitive-type
 
     <c-type>
         integer >>class
@@ -397,7 +364,7 @@ CONSTANT: primitive-types
         bootstrap-cell >>align
         "box_unsigned_cell" >>boxer
         "to_cell" >>unboxer
-    "ulong" define-primitive-type
+    \ ulong define-primitive-type
 
     <c-type>
         integer >>class
@@ -408,7 +375,7 @@ CONSTANT: primitive-types
         4 >>align
         "box_signed_4" >>boxer
         "to_fixnum" >>unboxer
-    "int" define-primitive-type
+    \ int define-primitive-type
 
     <c-type>
         integer >>class
@@ -419,7 +386,7 @@ CONSTANT: primitive-types
         4 >>align
         "box_unsigned_4" >>boxer
         "to_cell" >>unboxer
-    "uint" define-primitive-type
+    \ uint define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -430,7 +397,7 @@ CONSTANT: primitive-types
         2 >>align
         "box_signed_2" >>boxer
         "to_fixnum" >>unboxer
-    "short" define-primitive-type
+    \ short define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -441,7 +408,7 @@ CONSTANT: primitive-types
         2 >>align
         "box_unsigned_2" >>boxer
         "to_cell" >>unboxer
-    "ushort" define-primitive-type
+    \ ushort define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -452,7 +419,7 @@ CONSTANT: primitive-types
         1 >>align
         "box_signed_1" >>boxer
         "to_fixnum" >>unboxer
-    "char" define-primitive-type
+    \ char define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -463,20 +430,20 @@ CONSTANT: primitive-types
         1 >>align
         "box_unsigned_1" >>boxer
         "to_cell" >>unboxer
-    "uchar" define-primitive-type
+    \ uchar define-primitive-type
 
     <c-type>
-        [ alien-unsigned-1 c-bool> ] >>getter
+        [ alien-unsigned-1 0 = not ] >>getter
-        [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
+        [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
         1 >>size
         1 >>align
         "box_boolean" >>boxer
         "to_boolean" >>unboxer
-    "bool" define-primitive-type
+    \ bool define-primitive-type
 
     <c-type>
-        float >>class
+        math:float >>class
-        float >>boxed-class
+        math:float >>boxed-class
         [ alien-float ] >>getter
         [ [ >float ] 2dip set-alien-float ] >>setter
         4 >>size
@@ -485,11 +452,11 @@ CONSTANT: primitive-types
         "to_float" >>unboxer
         float-rep >>rep
         [ >float ] >>unboxer-quot
-    "float" define-primitive-type
+    \ float define-primitive-type
 
     <c-type>
-        float >>class
+        math:float >>class
-        float >>boxed-class
+        math:float >>boxed-class
         [ alien-double ] >>getter
         [ [ >float ] 2dip set-alien-double ] >>setter
         8 >>size
@@ -498,10 +465,10 @@ CONSTANT: primitive-types
         "to_double" >>unboxer
         double-rep >>rep
         [ >float ] >>unboxer-quot
-    "double" define-primitive-type
+    \ double define-primitive-type
 
-    "long" "ptrdiff_t" typedef
+    \ long \ ptrdiff_t typedef
-    "long" "intptr_t" typedef
+    \ long \ intptr_t typedef
-    "ulong" "size_t" typedef
+    \ ulong \ size_t typedef
 ] with-compilation-unit
 

basis/alien/data/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/alien/data/data-docs.factor

@@ -0,0 +1,148 @@
+USING: alien alien.c-types help.syntax help.markup libc kernel.private
+byte-arrays math strings hashtables alien.syntax alien.strings sequences
+io.encodings.string debugger destructors vocabs.loader ;
+IN: alien.data
+
+HELP: <c-array>
+{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } }
+{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. 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>
+{ $values { "type" "a C type" } { "array" byte-array } }
+{ $description "Creates a byte array suitable for holding a value with the given C type." }
+{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ;
+
+{ <c-object> malloc-object } related-words
+
+HELP: memory>byte-array
+{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
+{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
+
+HELP: byte-array>memory
+{ $values { "byte-array" byte-array } { "base" c-ptr } }
+{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
+{ $warning "This word is unsafe. Improper use can corrupt 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, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
+
+HELP: malloc-object
+{ $values { "type" "a C type" } { "alien" alien } }
+{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ;
+
+HELP: malloc-byte-array
+{ $values { "byte-array" byte-array } { "alien" alien } }
+{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if memory allocation fails." } ;
+
+{ <c-array> <c-direct-array> malloc-array } related-words
+
+{ string>alien alien>string malloc-string } related-words
+
+ARTICLE: "malloc" "Manual memory management"
+"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case."
+$nl
+"Allocating a C datum with a fixed address:"
+{ $subsection malloc-object }
+{ $subsection malloc-array }
+{ $subsection malloc-byte-array }
+"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:"
+{ $subsection malloc }
+{ $subsection calloc }
+{ $subsection realloc }
+"You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
+{ $subsection free }
+"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
+{ $subsection &free }
+{ $subsection |free }
+"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
+$nl
+"You can unsafely copy a range of bytes from one memory location to another:"
+{ $subsection memcpy }
+"You can copy a range of bytes from memory into a byte array:"
+{ $subsection memory>byte-array }
+"You can copy a byte array to memory unsafely:"
+{ $subsection byte-array>memory } ;
+
+
+ARTICLE: "c-byte-arrays" "Passing data in byte arrays"
+"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array."
+$nl
+"Byte arrays can be allocated directly with a byte count using the " { $link <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
+{ $subsection <c-object> }
+{ $subsection <c-array> }
+{ $warning
+"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." }
+{ $see-also "c-arrays" } ;
+
+ARTICLE: "c-data" "Passing data between Factor and C"
+"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
+$nl
+"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "."
+{ $subsection "c-types-specs" }
+{ $subsection "c-byte-arrays" }
+{ $subsection "malloc" }
+{ $subsection "c-strings" }
+{ $subsection "c-arrays" }
+{ $subsection "c-out-params" }
+"Important guidelines for passing data in byte arrays:"
+{ $subsection "byte-arrays-gc" }
+"C-style enumerated types are supported:"
+{ $subsection POSTPONE: C-ENUM: }
+"C types can be aliased for convenience and consitency with native library documentation:"
+{ $subsection POSTPONE: TYPEDEF: }
+"New C types can be defined:"
+{ $subsection "c-structs" }
+{ $subsection "c-unions" }
+"A utility for defining " { $link "destructors" } " for deallocating memory:"
+{ $subsection "alien.destructors" }
+{ $see-also "aliens" } ;
+HELP: malloc-string
+{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
+{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if one of the following conditions occurs:"
+    { $list
+        "the string contains null code points"
+        "the string contains characters not representable using the encoding specified"
+        "memory allocation fails"
+    }
+} ;
+
+HELP: require-c-array
+{ $values { "c-type" "a C type" } }
+{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
+{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ;
+
+HELP: <c-direct-array>
+{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
+{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, 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."
+$nl
+"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
+$nl
+"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
+$nl
+"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
+$nl
+"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
+{ $subsection string>alien }
+{ $subsection malloc-string }
+"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
+$nl
+"A word to read strings from arbitrary addresses:"
+{ $subsection alien>string }
+"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
+

basis/alien/data/data.factor

@@ -0,0 +1,83 @@
+! (c)2009 Slava Pestov, Joe Groff bsd license
+USING: accessors alien alien.c-types alien.strings arrays
+byte-arrays cpu.architecture fry io io.encodings.binary
+io.files io.streams.memory kernel libc math sequences ;
+IN: alien.data
+
+GENERIC: require-c-array ( c-type -- )
+
+M: array require-c-array first require-c-array ;
+
+GENERIC: c-array-constructor ( c-type -- word )
+
+GENERIC: c-(array)-constructor ( c-type -- word )
+
+GENERIC: c-direct-array-constructor ( c-type -- word )
+
+GENERIC: <c-array> ( len c-type -- array )
+
+M: c-type-name <c-array>
+    c-array-constructor execute( len -- array ) ; inline
+
+GENERIC: (c-array) ( len c-type -- array )
+
+M: c-type-name (c-array)
+    c-(array)-constructor execute( len -- array ) ; inline
+
+GENERIC: <c-direct-array> ( alien len c-type -- array )
+
+M: c-type-name <c-direct-array>
+    c-direct-array-constructor execute( alien len -- array ) ; inline
+
+: malloc-array ( n type -- alien )
+    [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
+
+: (malloc-array) ( n type -- alien )
+    [ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
+
+: <c-object> ( type -- array )
+    heap-size <byte-array> ; inline
+
+: (c-object) ( type -- array )
+    heap-size (byte-array) ; inline
+
+: malloc-object ( type -- alien )
+    1 swap heap-size calloc ; inline
+
+: (malloc-object) ( type -- alien )
+    heap-size malloc ; inline
+
+: malloc-byte-array ( byte-array -- alien )
+    dup byte-length [ nip malloc dup ] 2keep memcpy ;
+
+: memory>byte-array ( alien len -- byte-array )
+    [ nip (byte-array) dup ] 2keep memcpy ;
+
+: malloc-string ( string encoding -- alien )
+    string>alien malloc-byte-array ;
+
+: malloc-file-contents ( path -- alien len )
+    binary file-contents [ malloc-byte-array ] [ length ] bi ;
+
+M: memory-stream stream-read
+    [
+        [ index>> ] [ alien>> ] bi <displaced-alien>
+        swap memory>byte-array
+    ] [ [ + ] change-index drop ] 2bi ;
+
+: byte-array>memory ( byte-array base -- )
+    swap dup byte-length memcpy ; inline
+
+: >c-bool ( ? -- int ) 1 0 ? ; inline
+
+: c-bool> ( int -- ? ) 0 = not ; inline
+
+M: value-type c-type-rep drop int-rep ;
+
+M: value-type c-type-getter
+    drop [ swap <displaced-alien> ] ;
+
+M: value-type c-type-setter ( type -- quot )
+    [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
+    '[ @ swap @ _ memcpy ] ;
+

basis/alien/data/summary.txt

@@ -0,0 +1 @@
+Words for allocating objects and arrays of C types

basis/alien/fortran/fortran-tests.factor

@@ -1,7 +1,7 @@
 ! (c) 2009 Joe Groff, see BSD license
 USING: accessors alien alien.c-types alien.complex
-alien.fortran alien.fortran.private alien.strings classes.struct
+alien.data alien.fortran alien.fortran.private alien.strings
-arrays assocs byte-arrays combinators fry
+classes.struct arrays assocs byte-arrays combinators fry
 generalizations io.encodings.ascii kernel macros
 macros.expander namespaces sequences shuffle tools.test ;
 IN: alien.fortran.tests

basis/alien/fortran/fortran.factor

@@ -1,5 +1,5 @@
 ! (c) 2009 Joe Groff, see BSD license
-USING: accessors alien alien.c-types alien.complex alien.parser
+USING: accessors alien alien.c-types alien.complex alien.data grouping
 alien.strings alien.syntax arrays ascii assocs
 byte-arrays combinators combinators.short-circuit fry generalizations
 kernel lexer macros math math.parser namespaces parser sequences
@@ -429,6 +429,11 @@ PRIVATE>
 MACRO: fortran-invoke ( return library function parameters -- )
     { [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;
 
+: parse-arglist ( parameters return -- types effect )
+    [ 2 group unzip [ "," ?tail drop ] map ]
+    [ [ { } ] [ 1array ] if-void ]
+    bi* <effect> ;
+
 :: define-fortran-function ( return library function parameters -- )
     function create-in dup reset-generic 
     return library function parameters return [ "void" ] unless* parse-arglist

basis/alien/parser/parser.factor

@@ -1,16 +1,42 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays assocs effects grouping kernel
+USING: accessors alien alien.c-types arrays assocs
-parser sequences splitting words fry locals lexer namespaces
+combinators combinators.short-circuit effects grouping
-summary math ;
+kernel parser sequences splitting words fry locals lexer
+namespaces summary math vocabs.parser ;
 IN: alien.parser
 
+: parse-c-type-name ( name -- word/string )
+    [ search ] keep or ;
+
+: parse-c-type ( string -- array )
+    {
+        { [ dup "void" =            ] [ drop void ] }
+        { [ CHAR: ] over member?    ] [ parse-array-type parse-c-type-name prefix ] }
+        { [ dup search c-type-word? ] [ parse-c-type-name ] }
+        { [ dup c-types get at      ] [ ] }
+        { [ "*" ?tail               ] [ parse-c-type-name resolve-pointer-type ] }
+        [ no-c-type ]
+    } cond ;
+
+: scan-c-type ( -- c-type )
+    scan dup "{" =
+    [ drop \ } parse-until >array ]
+    [ parse-c-type ] if ; 
+
+: reset-c-type ( word -- )
+    { "c-type" "pointer-c-type" } reset-props ;
+
+: CREATE-C-TYPE ( -- word )
+    scan current-vocab create dup reset-c-type ;
+
 : normalize-c-arg ( type name -- type' name' )
     [ length ]
     [
         [ CHAR: * = ] trim-head
         [ length - CHAR: * <array> append ] keep
-    ] bi ;
+    ] bi
+    [ parse-c-type ] dip ;
 
 : parse-arglist ( parameters return -- types effect )
     [
@@ -36,3 +62,9 @@ IN: alien.parser
 
 : define-function ( return library function parameters -- )
     make-function define-declared ;
+
+PREDICATE: alien-function-word < word
+    def>> {
+        [ length 5 = ]
+        [ last \ alien-invoke eq? ]
+    } 1&& ;

basis/alien/prettyprint/prettyprint.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel combinators alien alien.strings alien.syntax
+USING: accessors kernel combinators alien alien.strings alien.c-types
-math.parser prettyprint.backend prettyprint.custom
+alien.parser alien.syntax arrays assocs effects math.parser
-prettyprint.sections ;
+prettyprint.backend prettyprint.custom prettyprint.sections
+definitions see see.private sequences strings words ;
 IN: alien.prettyprint
 
 M: alien pprint*
@@ -13,3 +14,39 @@ M: alien pprint*
     } cond ;
 
 M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
+
+M: c-type-word definer drop \ C-TYPE: f ;
+M: c-type-word definition drop f ;
+M: typedef-word declarations. drop ;
+
+GENERIC: pprint-c-type ( c-type -- )
+M: word pprint-c-type pprint-word ;
+M: wrapper pprint-c-type wrapped>> pprint-word ;
+M: string pprint-c-type text ;
+M: array pprint-c-type pprint* ;
+
+M: typedef-word definer drop \ TYPEDEF: f ;
+
+M: typedef-word synopsis*
+    \ TYPEDEF: pprint-word
+    dup "c-type" word-prop pprint-c-type
+    pprint-word ;
+
+: pprint-function-arg ( type name -- )
+    [ pprint-c-type ] [ text ] bi* ;
+
+: pprint-function-args ( word -- )
+    [ def>> fourth ] [ stack-effect in>> ] bi zip [ ] [
+        unclip-last
+        [ [ first2 "," append pprint-function-arg ] each ] dip
+        first2 pprint-function-arg
+    ] if-empty ;
+
+M: alien-function-word definer
+    drop \ FUNCTION: \ ; ;
+M: alien-function-word definition drop f ;
+M: alien-function-word synopsis*
+    \ FUNCTION: pprint-word
+    [ def>> first pprint-c-type ]
+    [ pprint-word ]
+    [ <block "(" text pprint-function-args ")" text block> ] tri ;

basis/alien/remote-control/remote-control.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings parser
+USING: accessors alien alien.data alien.strings parser
 threads words kernel.private kernel io.encodings.utf8 eval ;
 IN: alien.remote-control
 

basis/alien/structs/structs-docs.factor

@@ -1,4 +1,4 @@
-USING: alien.c-types strings help.markup help.syntax alien.syntax
+USING: alien.c-types alien.data strings help.markup help.syntax alien.syntax
 sequences io arrays kernel words assocs namespaces ;
 IN: alien.structs
 

basis/alien/structs/structs-tests.factor

@@ -1,4 +1,4 @@
-USING: alien alien.syntax alien.c-types kernel tools.test
+USING: alien alien.syntax alien.c-types alien.data kernel tools.test
 sequences system libc words vocabs namespaces layouts ;
 IN: alien.structs.tests
 

basis/alien/structs/structs.factor

@@ -15,7 +15,7 @@ M: struct-type c-type ;
 M: struct-type c-type-stack-align? drop f ;
 
 : if-value-struct ( ctype true false -- )
-    [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
+    [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
 
 M: struct-type unbox-parameter
     [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;

basis/alien/syntax/syntax.factor

@@ -19,7 +19,7 @@ SYNTAX: FUNCTION:
     (FUNCTION:) define-declared ;
 
 SYNTAX: TYPEDEF:
-    scan scan typedef ;
+    scan-c-type CREATE-C-TYPE typedef ;
 
 SYNTAX: C-STRUCT:
     scan current-vocab parse-definition define-struct ; deprecated
@@ -31,6 +31,9 @@ SYNTAX: C-ENUM:
     ";" parse-tokens
     [ [ create-in ] dip define-constant ] each-index ;
 
+SYNTAX: C-TYPE:
+    "Primitive C type definition not supported" throw ;
+
 ERROR: no-such-symbol name library ;
 
 : address-of ( name library -- value )

basis/bit-arrays/bit-arrays.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types accessors math alien.accessors kernel
+USING: alien.c-types alien.data accessors math alien.accessors kernel
 kernel.private sequences sequences.private byte-arrays
 parser prettyprint.custom fry ;
 IN: bit-arrays

basis/checksums/openssl/openssl.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays alien.c-types kernel continuations
+USING: accessors byte-arrays alien.c-types alien.data kernel
-destructors sequences io openssl openssl.libcrypto checksums
+continuations destructors sequences io openssl openssl.libcrypto
-checksums.stream ;
+checksums checksums.stream ;
 IN: checksums.openssl
 
 ERROR: unknown-digest name ;

basis/classes/struct/prettyprint/prettyprint.factor

@@ -1,9 +1,9 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types arrays assocs classes
+USING: accessors alien alien.c-types alien.data alien.prettyprint arrays
-classes.struct combinators combinators.short-circuit continuations
+assocs classes classes.struct combinators combinators.short-circuit
-fry kernel libc make math math.parser mirrors prettyprint.backend
+continuations fry kernel libc make math math.parser mirrors
-prettyprint.custom prettyprint.sections see.private sequences
+prettyprint.backend prettyprint.custom prettyprint.sections
-slots strings summary words ;
+see.private sequences slots strings summary words ;
 IN: classes.struct.prettyprint
 
 <PRIVATE
@@ -20,7 +20,7 @@ IN: classes.struct.prettyprint
     <flow \ { pprint-word
     f <inset {
         [ name>> text ]
-        [ type>> dup string? [ text ] [ pprint* ] if ]
+        [ type>> pprint-c-type ]
         [ read-only>> [ \ read-only pprint-word ] when ]
         [ initial>> [ \ initial: pprint-word pprint* ] when* ]
     } cleave block>

basis/classes/struct/struct-tests.factor

@@ -1,11 +1,13 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types ascii
+USING: accessors alien alien.c-types alien.data ascii
 assocs byte-arrays 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 system
 tools.test parser lexer eval layouts ;
+FROM: math => float ;
+QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: char
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAY: ushort
@@ -46,9 +48,9 @@ STRUCT: struct-test-bar
 
 [ {
     { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
-    { { "x" "char" } 98            }
+    { { "x" char } 98            }
-    { { "y" "int"  } HEX: 7F00007F }
+    { { "y" int  } HEX: 7F00007F }
-    { { "z" "bool" } f             }
+    { { "z" bool } f             }
 } ] [
     B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
     make-mirror >alist
@@ -128,7 +130,7 @@ STRUCT: struct-test-bar
 ] unit-test
 
 UNION-STRUCT: struct-test-float-and-bits
-    { f float }
+    { f c:float }
     { bits uint } ;
 
 [ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
@@ -181,14 +183,14 @@ STRUCT: struct-test-string-ptr
     ] with-scope
 ] unit-test
 
-[ <" USING: classes.struct ;
+[ <" USING: alien.c-types classes.struct ;
 IN: classes.struct.tests
 STRUCT: struct-test-foo
     { x char initial: 0 } { y int initial: 123 } { z bool } ;
 "> ]
 [ [ struct-test-foo see ] with-string-writer ] unit-test
 
-[ <" USING: classes.struct ;
+[ <" USING: alien.c-types classes.struct ;
 IN: classes.struct.tests
 UNION-STRUCT: struct-test-float-and-bits
     { f float initial: 0.0 } { bits uint initial: 0 } ;
@@ -201,20 +203,20 @@ UNION-STRUCT: struct-test-float-and-bits
         { offset 0 }
         { initial 0 }
         { class fixnum }
-        { type "char" }
+        { type char }
     }
     T{ struct-slot-spec
         { name "y" }
         { offset 4 }
         { initial 123 }
         { class integer }
-        { type "int" }
+        { type int }
     }
     T{ struct-slot-spec
         { name "z" }
         { offset 8 }
         { initial f }
-        { type "bool" }
+        { type bool }
         { class object }
     }
 } ] [ "struct-test-foo" c-type fields>> ] unit-test
@@ -223,14 +225,14 @@ UNION-STRUCT: struct-test-float-and-bits
     T{ struct-slot-spec
         { name "f" }
         { offset 0 }
-        { type "float" }
+        { type c:float }
         { class float }
         { initial 0.0 }
     }
     T{ struct-slot-spec
         { name "bits" }
         { offset 0 }
-        { type "uint" }
+        { type uint }
         { class integer }
         { initial 0 }
     }
@@ -277,7 +279,7 @@ STRUCT: struct-test-array-slots
 ] unit-test
 
 STRUCT: struct-test-optimization
-    { x { "int" 3 } } { y int } ;
+    { x { int 3 } } { y int } ;
 
 SPECIALIZED-ARRAY: struct-test-optimization
 

basis/classes/struct/struct.factor

@@ -1,12 +1,12 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types arrays byte-arrays classes
+USING: accessors alien alien.c-types alien.data alien.parser arrays
-classes.parser classes.tuple classes.tuple.parser
+byte-arrays classes classes.parser classes.tuple classes.tuple.parser
 classes.tuple.private combinators combinators.short-circuit
 combinators.smart cpu.architecture definitions functors.backend
 fry generalizations generic.parser kernel kernel.private lexer
 libc locals macros make math math.order parser quotations
 sequences slots slots.private specialized-arrays vectors words
-summary namespaces assocs ;
+summary namespaces assocs vocabs.parser ;
 IN: classes.struct
 
 SPECIALIZED-ARRAY: uchar
@@ -126,7 +126,7 @@ M: struct-c-type c-type ;
 M: struct-c-type c-type-stack-align? drop f ;
 
 : if-value-struct ( ctype true false -- )
-    [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
+    [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
 
 M: struct-c-type unbox-parameter
     [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
@@ -197,20 +197,6 @@ M: struct-c-type c-struct? drop t ;
     [ type>> c-type-align ] [ max ] map-reduce ;
 PRIVATE>
 
-M: struct-class c-type name>> c-type ;
-
-M: struct-class c-type-align c-type c-type-align ;
-
-M: struct-class c-type-getter c-type c-type-getter ;
-
-M: struct-class c-type-setter c-type c-type-setter ;
-
-M: struct-class c-type-boxer-quot c-type c-type-boxer-quot ;
-
-M: struct-class c-type-unboxer-quot c-type c-type-boxer-quot ;
-
-M: struct-class heap-size c-type heap-size ;
-
 M: struct byte-length class "struct-size" word-prop ; foldable
 
 ! class definition
@@ -259,7 +245,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable
         [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
         (struct-word-props)
     ]
-    [ drop [ c-type-for-class ] [ name>> ] bi typedef ] 2tri ; inline
+    [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline
 PRIVATE>
 
 : define-struct-class ( class slots -- )
@@ -284,9 +270,6 @@ ERROR: invalid-struct-slot token ;
     [ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
 
 <PRIVATE
-: scan-c-type ( -- c-type )
-    scan dup "{" = [ drop \ } parse-until >array ] when ;
-
 : parse-struct-slot ( -- slot )
     scan scan-c-type \ } parse-until <struct-slot-spec> ;
     
@@ -317,7 +300,7 @@ SYNTAX: S@
 
 <PRIVATE
 : scan-c-type` ( -- c-type/param )
-    scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
+    scan dup "{" = [ drop \ } parse-until >array ] [ search ] if ;
 
 : parse-struct-slot` ( accum -- accum )
     scan-string-param scan-c-type` \ } parse-until

basis/cocoa/enumeration/enumeration.factor

@@ -1,17 +1,16 @@
 ! Copyright (C) 2008 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types
+USING: accessors kernel classes.struct cocoa cocoa.runtime cocoa.types alien.data
-locals math sequences vectors fry libc destructors ;
+locals math sequences vectors fry libc destructors specialized-arrays ;
+SPECIALIZED-ARRAY: id
 IN: cocoa.enumeration
 
-<< "id" require-c-array >>
-
 CONSTANT: NS-EACH-BUFFER-SIZE 16
 
 : with-enumeration-buffers ( quot -- )
     '[
         NSFastEnumerationState malloc-struct &free
-        NS-EACH-BUFFER-SIZE "id" malloc-array &free
+        NS-EACH-BUFFER-SIZE id malloc-array &free
         NS-EACH-BUFFER-SIZE
         @
     ] with-destructors ; inline
@@ -19,7 +18,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
 :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
     object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
     items-count 0 = [
-        state itemsPtr>> [ items-count "id" <c-direct-array> ] [ stackbuf ] if* :> items
+        state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
         items-count iota [ items nth quot call ] each
         object quot state stackbuf count (NSFastEnumeration-each)
     ] unless ; inline recursive

basis/cocoa/plists/plists.factor

@@ -4,8 +4,8 @@
 USING: strings arrays hashtables assocs sequences fry macros
 cocoa.messages cocoa.classes cocoa.application cocoa kernel
 namespaces io.backend math cocoa.enumeration byte-arrays
-combinators alien.c-types words core-foundation quotations
+combinators alien.c-types alien.data words core-foundation
-core-foundation.data core-foundation.utilities ;
+quotations core-foundation.data core-foundation.utilities ;
 IN: cocoa.plists
 
 : >plist ( value -- plist ) >cf -> autorelease ;

basis/compiler/codegen/codegen.factor

@@ -456,7 +456,7 @@ TUPLE: callback-context ;
 
 : callback-return-quot ( ctype -- quot )
     return>> {
-        { [ dup "void" = ] [ drop [ ] ] }
+        { [ dup void? ] [ drop [ ] ] }
         { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
         [ c-type c-type-unboxer-quot ]
     } cond ;

basis/compiler/tests/alien.factor

@@ -5,6 +5,7 @@ io.streams.string kernel math memory namespaces
 namespaces.private parser quotations sequences
 specialized-arrays stack-checker stack-checker.errors
 system threads tools.test words ;
+FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: char
 IN: compiler.tests.alien

basis/compiler/tests/codegen.factor

@@ -4,6 +4,7 @@ namespaces.private slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
 combinators vectors grouping make alien.c-types combinators.short-circuit
 math.order math.libm math.parser ;
+FROM: math => float ;
 QUALIFIED: namespaces.private
 IN: compiler.tests.codegen
 

basis/compiler/tests/intrinsics.factor

@@ -3,8 +3,9 @@ math math.constants math.private math.integers.private sequences
 strings tools.test words continuations sequences.private
 hashtables.private byte-arrays system random layouts vectors
 sbufs strings.private slots.private alien math.order
-alien.accessors alien.c-types alien.syntax alien.strings
+alien.accessors alien.c-types alien.data alien.syntax alien.strings
 namespaces libc io.encodings.ascii classes compiler ;
+FROM: math => float ;
 IN: compiler.tests.intrinsics
 
 ! Make sure that intrinsic ops compile to correct code.

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

@@ -16,6 +16,7 @@ compiler.tree.propagation
 compiler.tree.propagation.info
 compiler.tree.checker
 compiler.tree.debugger ;
+FROM: math => float ;
 IN: compiler.tree.cleanup.tests
 
 [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

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

@@ -10,6 +10,7 @@ compiler.tree.debugger compiler.tree.checker
 slots.private words hashtables classes assocs locals
 specialized-arrays system sorting math.libm
 math.intervals quotations effects alien ;
+FROM: math => float ;
 SPECIALIZED-ARRAY: double
 IN: compiler.tree.propagation.tests
 

basis/core-foundation/numbers/numbers.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax kernel math core-foundation ;
+FROM: math => float ;
 IN: core-foundation.numbers
 
 TYPEDEF: void* CFNumberRef

basis/cpu/ppc/ppc.factor

@@ -2,13 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs sequences kernel combinators make math
 math.order math.ranges system namespaces locals layouts words
-alien alien.accessors alien.c-types literals cpu.architecture
+alien alien.accessors alien.c-types alien.data literals cpu.architecture
 cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
 compiler.cfg.instructions compiler.cfg.comparisons
 compiler.codegen.fixup compiler.cfg.intrinsics
 compiler.cfg.stack-frame compiler.cfg.build-stack-frame
 compiler.units compiler.constants compiler.codegen ;
 FROM: cpu.ppc.assembler => B ;
+FROM: math => float ;
 IN: cpu.ppc
 
 ! PowerPC register assignments:
@@ -770,5 +771,5 @@ USE: vocabs.loader
         4 >>align
         "box_boolean" >>boxer
         "to_boolean" >>unboxer
-    "bool" define-primitive-type
+    bool define-primitive-type
 ] with-compilation-unit

basis/cpu/x86/64/unix/unix.factor

@@ -16,9 +16,10 @@ M: float-regs param-regs
 
 M: x86.64 reserved-area-size 0 ;
 
-! The ABI for passing structs by value is pretty messed up
+SYMBOL: (stack-value)
-<< "void*" c-type clone "__stack_value" define-primitive-type
+! The ABI for passing structs by value is pretty great
-stack-params "__stack_value" c-type (>>rep) >>
+<< void* c-type clone \ (stack-value) define-primitive-type
+stack-params \ (stack-value) c-type (>>rep) >>
 
 : struct-types&offset ( struct-type -- pairs )
     fields>> [
@@ -33,12 +34,12 @@ stack-params "__stack_value" c-type (>>rep) >>
 : flatten-small-struct ( c-type -- seq )
     struct-types&offset split-struct [
         [ c-type c-type-rep reg-class-of ] map
-        int-regs swap member? "void*" "double" ? c-type
+        int-regs swap member? void* double ? c-type
     ] map ;
 
 : flatten-large-struct ( c-type -- seq )
     heap-size cell align
-    cell /i "__stack_value" c-type <repetition> ;
+    cell /i \ (stack-value) c-type <repetition> ;
 
 : flatten-struct ( c-type -- seq )
     dup heap-size 16 > [

basis/cpu/x86/64/winnt/winnt.factor

@@ -25,8 +25,8 @@ M: x86.64 dummy-fp-params? t ;
 M: x86.64 temp-reg RAX ;
 
 <<
-"longlong" "ptrdiff_t" typedef
+longlong ptrdiff_t typedef
-"longlong" "intptr_t" typedef
+longlong intptr_t  typedef
-"int" c-type "long" define-primitive-type
+int  c-type long  define-primitive-type
-"uint" c-type "ulong" define-primitive-type
+uint c-type ulong define-primitive-type
 >>

basis/cpu/x86/features/features.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: system kernel math math.order math.parser namespaces
-alien.syntax combinators locals init io cpu.x86 compiler
+alien.c-types alien.syntax combinators locals init io cpu.x86
-compiler.units accessors ;
+compiler compiler.units accessors ;
 IN: cpu.x86.features
 
 <PRIVATE

basis/cpu/x86/x86.factor

@@ -12,6 +12,7 @@ compiler.cfg.comparisons
 compiler.cfg.stack-frame
 compiler.codegen
 compiler.codegen.fixup ;
+FROM: math => float ;
 IN: cpu.x86
 
 << enable-fixnum-log2 >>

basis/db/postgresql/lib/lib.factor

@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays continuations db io kernel math namespaces
 quotations sequences db.postgresql.ffi alien alien.c-types
-db.types tools.walker ascii splitting math.parser combinators
+alien.data db.types tools.walker ascii splitting math.parser
-libc calendar.format byte-arrays destructors prettyprint
+combinators libc calendar.format byte-arrays destructors
-accessors strings serialize io.encodings.binary io.encodings.utf8
+prettyprint accessors strings serialize io.encodings.binary
-alien.strings io.streams.byte-array summary present urls
+io.encodings.utf8 alien.strings io.streams.byte-array summary
-specialized-arrays db.private ;
+present urls specialized-arrays db.private ;
 SPECIALIZED-ARRAY: uint
 SPECIALIZED-ARRAY: void*
 IN: db.postgresql.lib

basis/db/sqlite/lib/lib.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays assocs kernel math math.parser
+USING: alien.c-types alien.data arrays assocs kernel math math.parser
 namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary

basis/environment/unix/unix.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax kernel
+USING: alien alien.c-types alien.data alien.strings
-layouts sequences system unix environment io.encodings.utf8
+alien.syntax kernel layouts sequences system unix
-unix.utilities vocabs.loader combinators alien.accessors ;
+environment io.encodings.utf8 unix.utilities vocabs.loader
+combinators alien.accessors ;
 IN: environment.unix
 
 HOOK: environ os ( -- void* )

basis/environment/winnt/winnt.factor

@@ -1,15 +1,14 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.strings fry io.encodings.utf16n kernel
-splitting windows windows.kernel32 system environment
+splitting windows windows.kernel32 windows.types system
-alien.c-types sequences windows.errors io.streams.memory
+environment alien.data sequences windows.errors
-io.encodings io ;
+io.streams.memory io.encodings io specialized-arrays ;
+SPECIALIZED-ARRAY: TCHAR
 IN: environment.winnt
 
-<< "TCHAR" require-c-array >>
-
 M: winnt os-env ( key -- value )
-    MAX_UNICODE_PATH "TCHAR" <c-array>
+    MAX_UNICODE_PATH TCHAR <c-array>
     [ dup length GetEnvironmentVariable ] keep over 0 = [
         2drop f
     ] [

basis/functors/functors-tests.factor

@@ -1,5 +1,6 @@
 USING: classes.struct functors tools.test math words kernel
 multiline parser io.streams.string generic ;
+QUALIFIED-WITH: alien.c-types c
 IN: functors.tests
 
 <<
@@ -160,15 +161,15 @@ T-class DEFINES-CLASS ${T}
 WHERE
 
 STRUCT: T-class
-    { NAME int }
+    { NAME c:int }
     { x { TYPE 4 } }
-    { y { "short" N } }
+    { y { c:short N } }
     { z TYPE initial: 5 }
-    { float { "float" 2 } } ;
+    { float { c:float 2 } } ;
 
 ;FUNCTOR
 
-"a-struct" "nemo" "char" 2 define-a-struct
+"a-struct" "nemo" c:char 2 define-a-struct
 
 >>
 
@@ -179,35 +180,35 @@ STRUCT: T-class
             { offset 0 }
             { class integer }
             { initial 0 } 
-            { type "int" }
+            { type c:int }
         }
         T{ struct-slot-spec
             { name "x" }
             { offset 4 }
             { class object }
             { initial f } 
-            { type { "char" 4 } }
+            { type { c:char 4 } }
         }
         T{ struct-slot-spec
             { name "y" }
             { offset 8 }
             { class object }
             { initial f } 
-            { type { "short" 2 } }
+            { type { c:short 2 } }
         }
         T{ struct-slot-spec
             { name "z" }
             { offset 12 }
             { class fixnum }
             { initial 5 } 
-            { type "char" }
+            { type c:char }
         }
         T{ struct-slot-spec
             { name "float" }
             { offset 16 }
             { class object }
             { initial f } 
-            { type { "float" 2 } }
+            { type { c:float 2 } }
         }
     }
 ] [ a-struct struct-slots ] unit-test

basis/game-input/dinput/dinput.factor

@@ -6,7 +6,7 @@ math.rectangles namespaces parser sequences shuffle
 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 ;
+windows.user32 classes.struct alien.data ;
 SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
 IN: game-input.dinput
 
@@ -160,19 +160,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
     [ device-attached? not ] filter
     [ remove-controller ] each ;
 
-: device-interface? ( dbt-broadcast-hdr -- ? )
+: ?device-interface ( dbt-broadcast-hdr -- ? )
-    dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ;
+    dup dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE =
+    [ >c-ptr DEV_BROADCAST_DEVICEW memory>struct ]
+    [ drop f ] if ; inline
 
 : device-arrived ( dbt-broadcast-hdr -- )
-    device-interface? [ find-controllers ] when ;
+    ?device-interface [ find-controllers ] when ; inline
 
 : device-removed ( dbt-broadcast-hdr -- )
-    device-interface? [ find-and-remove-detached-devices ] when ;
+    ?device-interface [ find-and-remove-detached-devices ] when ; inline
+
+: <DEV_BROADCAST_HDR> ( wParam -- struct )
+    <alien> DEV_BROADCAST_HDR memory>struct ;
 
 : handle-wm-devicechange ( hWnd uMsg wParam lParam -- )
     [ 2drop ] 2dip swap {
-        { [ dup DBT_DEVICEARRIVAL = ]         [ drop <alien> device-arrived ] }
+        { [ dup DBT_DEVICEARRIVAL = ]         [ drop <DEV_BROADCAST_HDR> device-arrived ] }
-        { [ dup DBT_DEVICEREMOVECOMPLETE = ]  [ drop <alien> device-removed ] }
+        { [ dup DBT_DEVICEREMOVECOMPLETE = ]  [ drop <DEV_BROADCAST_HDR> device-removed ] }
         [ 2drop ]
     } cond ;
 

basis/game-input/dinput/keys-array/keys-array.factor

@@ -1,5 +1,5 @@
-USING: sequences sequences.private math alien.c-types
+USING: sequences sequences.private math
-accessors ;
+accessors alien.data ;
 IN: game-input.dinput.keys-array
 
 TUPLE: keys-array

basis/game-input/iokit/iokit.factor

@@ -3,7 +3,8 @@ kernel cocoa.enumeration destructors math.parser cocoa.application
 sequences locals combinators.short-circuit threads
 namespaces assocs arrays combinators hints alien
 core-foundation.run-loop accessors sequences.private
-alien.c-types math parser game-input vectors bit-arrays ;
+alien.c-types alien.data math parser game-input vectors
+bit-arrays ;
 IN: game-input.iokit
 
 SINGLETON: iokit-game-input-backend

basis/images/memory/memory.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types destructors fry images kernel
+USING: accessors alien.c-types alien.data destructors fry images
-libc math sequences ;
+kernel libc math sequences ;
 IN: images.memory
 
 ! Some code shared by core-graphics and cairo for constructing

basis/io/backend/windows/nt/privileges/privileges.factor

@@ -1,4 +1,4 @@
-USING: alien alien.c-types alien.syntax arrays continuations
+USING: alien alien.c-types alien.data alien.syntax arrays continuations
 destructors generic io.mmap io.ports io.backend.windows io.files.windows
 kernel libc math math.bitwise namespaces quotations sequences windows
 windows.advapi32 windows.kernel32 io.backend system accessors

basis/io/buffers/buffers-tests.factor

@@ -1,7 +1,7 @@
 IN: io.buffers.tests
-USING: alien alien.c-types io.buffers kernel kernel.private libc
+USING: alien alien.c-types alien.data io.buffers kernel
-sequences tools.test namespaces byte-arrays strings accessors
+kernel.private libc sequences tools.test namespaces byte-arrays
-destructors ;
+strings accessors destructors ;
 
 : buffer-set ( string buffer -- )
     over >byte-array over ptr>> byte-array>memory

basis/io/buffers/buffers.factor

@@ -2,8 +2,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.accessors alien.c-types
-alien.syntax kernel libc math sequences byte-arrays strings
+alien.data alien.syntax kernel libc math sequences byte-arrays
-hints math.order destructors combinators ;
+strings hints math.order destructors combinators ;
 IN: io.buffers
 
 TUPLE: buffer

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

@@ -6,7 +6,7 @@ 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 ;
+specialized-arrays alien.data ;
 SPECIALIZED-ARRAY: ushort
 IN: io.files.info.windows
 

basis/io/files/windows/windows.factor

@@ -6,7 +6,7 @@ io.backend.windows kernel math splitting fry alien.strings
 windows windows.kernel32 windows.time calendar combinators
 math.functions sequences namespaces make words system
 destructors accessors math.bitwise continuations windows.errors
-arrays byte-arrays generalizations ;
+arrays byte-arrays generalizations alien.data ;
 IN: io.files.windows
 
 : open-file ( path access-mode create-mode flags -- handle )

basis/io/mmap/mmap.factor

@@ -2,7 +2,7 @@
 ! 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
-accessors vocabs.loader combinators alien.c-types
+accessors vocabs.loader combinators alien.c-types alien.data
 math ;
 IN: io.mmap
 

basis/io/monitors/windows/nt/nt.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings libc destructors locals
+USING: alien alien.c-types alien.data alien.strings libc destructors
-kernel math assocs namespaces make continuations sequences
+locals kernel math assocs namespaces make continuations sequences
 hashtables sorting arrays combinators math.bitwise strings
 system accessors threads splitting io.backend io.backend.windows
 io.backend.windows.nt io.files.windows.nt io.monitors io.ports

basis/io/sockets/secure/openssl/openssl.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors byte-arrays kernel sequences namespaces math
-math.order combinators init alien alien.c-types alien.strings
+math.order combinators init alien alien.c-types alien.data
-libc continuations destructors summary splitting assocs random
+alien.strings libc continuations destructors summary splitting
-math.parser locals unicode.case openssl openssl.libcrypto
+assocs random math.parser locals unicode.case openssl
-openssl.libssl io.backend io.ports io.pathnames
+openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames
 io.encodings.8-bit io.timeouts io.sockets.secure ;
 IN: io.sockets.secure.openssl
 

basis/io/sockets/sockets.factor

@@ -6,7 +6,7 @@ arrays io.encodings io.ports io.streams.duplex io.encodings.ascii
 alien.strings io.binary accessors destructors classes byte-arrays
 parser alien.c-types math.parser splitting grouping math assocs
 summary system vocabs.loader combinators present fry vocabs.parser
-classes.struct ;
+classes.struct alien.data ;
 IN: io.sockets
 
 << {

basis/io/sockets/unix/unix.factor

@@ -5,7 +5,7 @@ threads sequences byte-arrays io.binary io.backend.unix
 io.streams.duplex io.backend io.pathnames io.sockets.private
 io.files.private io.encodings.utf8 math.parser continuations
 libc combinators system accessors destructors unix locals init
-classes.struct ;
+classes.struct alien.data ;
 
 EXCLUDE: namespaces => bind ;
 EXCLUDE: io => read write ;

basis/io/sockets/windows/nt/nt.factor

@@ -1,4 +1,4 @@
-USING: alien alien.accessors alien.c-types byte-arrays
+USING: alien alien.accessors alien.c-types alien.data byte-arrays
 continuations destructors io.ports io.timeouts io.sockets
 io.sockets.private io namespaces io.streams.duplex
 io.backend.windows io.sockets.windows io.backend.windows.nt

basis/libc/libc.factor

@@ -2,29 +2,29 @@
 ! Copyright (C) 2007, 2009 Slava Pestov
 ! Copyright (C) 2007, 2008 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien assocs continuations alien.destructors kernel
+USING: alien alien.c-types assocs continuations alien.destructors kernel
 namespaces accessors sets summary destructors destructors.private ;
 IN: libc
 
 : errno ( -- int )
-    "int" "factor" "err_no" { } alien-invoke ;
+    int "factor" "err_no" { } alien-invoke ;
 
 : clear-errno ( -- )
-    "void" "factor" "clear_err_no" { } alien-invoke ;
+    void "factor" "clear_err_no" { } alien-invoke ;
 
 <PRIVATE
 
 : (malloc) ( size -- alien )
-    "void*" "libc" "malloc" { "ulong" } alien-invoke ;
+    void* "libc" "malloc" { ulong } alien-invoke ;
 
 : (calloc) ( count size -- alien )
-    "void*" "libc" "calloc" { "ulong" "ulong" } alien-invoke ;
+    void* "libc" "calloc" { ulong ulong } alien-invoke ;
 
 : (free) ( alien -- )
-    "void" "libc" "free" { "void*" } alien-invoke ;
+    void "libc" "free" { void* } alien-invoke ;
 
 : (realloc) ( alien size -- newalien )
-    "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
+    void* "libc" "realloc" { void* ulong } alien-invoke ;
 
 ! We stick malloc-ptr instances in the global disposables set
 TUPLE: malloc-ptr value continuation ;
@@ -81,15 +81,15 @@ PRIVATE>
     >c-ptr [ delete-malloc ] [ (free) ] bi ;
 
 : memcpy ( dst src size -- )
-    "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
+    void "libc" "memcpy" { void* void* ulong } alien-invoke ;
 
 : memcmp ( a b size -- cmp )
-    "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ;
+    int "libc" "memcmp" { void* void* ulong } alien-invoke ;
 
 : memory= ( a b size -- ? )
     memcmp 0 = ;
 
 : strlen ( alien -- len )
-    "size_t" "libc" "strlen" { "char*" } alien-invoke ;
+    size_t "libc" "strlen" { char* } alien-invoke ;
 
 DESTRUCTOR: free

basis/math/blas/matrices/matrices.factor

@@ -1,10 +1,11 @@
-USING: accessors alien alien.c-types arrays byte-arrays combinators
+USING: accessors alien alien.c-types alien.data arrays
-combinators.short-circuit fry kernel locals macros
+byte-arrays combinators combinators.short-circuit fry
-math math.blas.ffi math.blas.vectors math.blas.vectors.private
+kernel locals macros math math.blas.ffi math.blas.vectors
-math.complex math.functions math.order functors words
+math.blas.vectors.private math.complex math.functions
-sequences sequences.merged sequences.private shuffle
+math.order functors words sequences sequences.merged
-parser prettyprint.backend prettyprint.custom ascii
+sequences.private shuffle parser prettyprint.backend
-specialized-arrays ;
+prettyprint.custom ascii specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: complex-float

basis/math/blas/vectors/vectors.factor

@@ -3,6 +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 ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: complex-float

basis/math/libm/libm.factor

@@ -1,62 +1,62 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien ;
+USING: alien alien.c-types ;
 IN: math.libm
 
 : facos ( x -- y )
-    "double" "libm" "acos" { "double" } alien-invoke ;
+    double "libm" "acos" { double } alien-invoke ;
 
 : fasin ( x -- y )
-    "double" "libm" "asin" { "double" } alien-invoke ;
+    double "libm" "asin" { double } alien-invoke ;
 
 : fatan ( x -- y )
-    "double" "libm" "atan" { "double" } alien-invoke ;
+    double "libm" "atan" { double } alien-invoke ;
 
 : fatan2 ( x y -- z )
-    "double" "libm" "atan2" { "double" "double" } alien-invoke ;
+    double "libm" "atan2" { double double } alien-invoke ;
 
 : fcos ( x -- y )
-    "double" "libm" "cos" { "double" } alien-invoke ;
+    double "libm" "cos" { double } alien-invoke ;
 
 : fsin ( x -- y )
-    "double" "libm" "sin" { "double" } alien-invoke ;
+    double "libm" "sin" { double } alien-invoke ;
 
 : ftan ( x -- y )
-    "double" "libm" "tan" { "double" } alien-invoke ;
+    double "libm" "tan" { double } alien-invoke ;
 
 : fcosh ( x -- y )
-    "double" "libm" "cosh" { "double" } alien-invoke ;
+    double "libm" "cosh" { double } alien-invoke ;
 
 : fsinh ( x -- y )
-    "double" "libm" "sinh" { "double" } alien-invoke ;
+    double "libm" "sinh" { double } alien-invoke ;
 
 : ftanh ( x -- y )
-    "double" "libm" "tanh" { "double" } alien-invoke ;
+    double "libm" "tanh" { double } alien-invoke ;
 
 : fexp ( x -- y )
-    "double" "libm" "exp" { "double" } alien-invoke ;
+    double "libm" "exp" { double } alien-invoke ;
 
 : flog ( x -- y )
-    "double" "libm" "log" { "double" } alien-invoke ;
+    double "libm" "log" { double } alien-invoke ;
 
 : flog10 ( x -- y )
-    "double" "libm" "log10" { "double" } alien-invoke ;
+    double "libm" "log10" { double } alien-invoke ;
 
 : fpow ( x y -- z )
-    "double" "libm" "pow" { "double" "double" } alien-invoke ;
+    double "libm" "pow" { double double } alien-invoke ;
 
 : fsqrt ( x -- y )
-    "double" "libm" "sqrt" { "double" } alien-invoke ;
+    double "libm" "sqrt" { double } alien-invoke ;
     
 ! Windows doesn't have these...
 : flog1+ ( x -- y )
-    "double" "libm" "log1p" { "double" } alien-invoke ;
+    double "libm" "log1p" { double } alien-invoke ;
 
 : facosh ( x -- y )
-    "double" "libm" "acosh" { "double" } alien-invoke ;
+    double "libm" "acosh" { double } alien-invoke ;
 
 : fasinh ( x -- y )
-    "double" "libm" "asinh" { "double" } alien-invoke ;
+    double "libm" "asinh" { double } alien-invoke ;
 
 : fatanh ( x -- y )
-    "double" "libm" "atanh" { "double" } alien-invoke ;
+    double "libm" "atanh" { double } alien-invoke ;

basis/math/vectors/simd/functor/functor.factor

@@ -9,14 +9,16 @@ ERROR: bad-length got expected ;
 
 FUNCTOR: define-simd-128 ( T -- )
 
-N            [ 16 T heap-size /i ]
+T-TYPE       IS ${T}
+
+N            [ 16 T-TYPE heap-size /i ]
 
 A            DEFINES-CLASS ${T}-${N}
 >A           DEFINES >${A}
 A{           DEFINES ${A}{
 
-NTH          [ T dup c-type-getter-boxer array-accessor ]
+NTH          [ T-TYPE dup c-type-getter-boxer array-accessor ]
-SET-NTH      [ T dup c-setter array-accessor ]
+SET-NTH      [ T-TYPE dup c-setter array-accessor ]
 
 A-rep        IS ${A}-rep
 A-vv->v-op   DEFINES-PRIVATE ${A}-vv->v-op
@@ -74,7 +76,9 @@ PRIVATE>
 ! Synthesize 256-bit vectors from a pair of 128-bit vectors
 FUNCTOR: define-simd-256 ( T -- )
 
-N            [ 32 T heap-size /i ]
+T-TYPE       IS ${T}
+
+N            [ 32 T-TYPE heap-size /i ]
 
 N/2          [ N 2 / ]
 A/2          IS ${T}-${N/2}

basis/math/vectors/simd/intrinsics/intrinsics.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel alien alien.c-types cpu.architecture libc ;
+USING: kernel alien alien.data cpu.architecture libc ;
 IN: math.vectors.simd.intrinsics
 
 ERROR: bad-simd-call ;

basis/math/vectors/simd/simd.factor

@@ -5,6 +5,8 @@ kernel math math.functions math.vectors
 math.vectors.simd.functor math.vectors.simd.intrinsics
 math.vectors.specialization parser prettyprint.custom sequences
 sequences.private locals assocs words fry ;
+FROM: alien.c-types => float ;
+QUALIFIED-WITH: math m
 IN: math.vectors.simd
 
 <<
@@ -15,9 +17,9 @@ DEFER: float-8
 DEFER: double-4
 
 "double" define-simd-128
-"float" define-simd-128
+"float"  define-simd-128
 "double" define-simd-256
-"float" define-simd-256
+"float"  define-simd-256
 
 >>
 
@@ -136,7 +138,7 @@ DEFER: double-4
 
 PRIVATE>
 
-\ float-4 \ float-4-with float H{
+\ float-4 \ float-4-with m:float H{
     { v+ [ [ (simd-v+) ] float-4-vv->v-op ] }
     { v- [ [ (simd-v-) ] float-4-vv->v-op ] }
     { v* [ [ (simd-v*) ] float-4-vv->v-op ] }
@@ -146,7 +148,7 @@ PRIVATE>
     { sum [ [ (simd-sum) ] float-4-v->n-op ] }
 } simd-vector-words
 
-\ double-2 \ double-2-with float H{
+\ double-2 \ double-2-with m:float H{
     { v+ [ [ (simd-v+) ] double-2-vv->v-op ] }
     { v- [ [ (simd-v-) ] double-2-vv->v-op ] }
     { v* [ [ (simd-v*) ] double-2-vv->v-op ] }
@@ -156,7 +158,7 @@ PRIVATE>
     { sum [ [ (simd-sum) ] double-2-v->n-op ] }
 } simd-vector-words
 
-\ float-8 \ float-8-with float H{
+\ float-8 \ float-8-with m:float H{
     { v+ [ [ (simd-v+) ] float-8-vv->v-op ] }
     { v- [ [ (simd-v-) ] float-8-vv->v-op ] }
     { v* [ [ (simd-v*) ] float-8-vv->v-op ] }
@@ -166,7 +168,7 @@ PRIVATE>
     { sum [ [ (simd-sum) ] [ + ] float-8-v->n-op ] }
 } simd-vector-words
 
-\ double-4 \ double-4-with float H{
+\ double-4 \ double-4-with m:float H{
     { v+ [ [ (simd-v+) ] double-4-vv->v-op ] }
     { v- [ [ (simd-v-) ] double-4-vv->v-op ] }
     { v* [ [ (simd-v*) ] double-4-vv->v-op ] }

basis/opengl/opengl.factor

@@ -8,6 +8,7 @@ math.parser opengl.gl combinators combinators.smart arrays
 sequences splitting words byte-arrays assocs vocabs
 colors colors.constants accessors generalizations locals fry
 specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: uint
 IN: opengl

basis/opengl/shaders/shaders.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Joe Groff.
 ! 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
+assocs alien alien.data alien.strings libc opengl math sequences combinators
 macros arrays io.encodings.ascii fry specialized-arrays
 destructors accessors ;
 SPECIALIZED-ARRAY: uint

basis/prettyprint/config/config-docs.factor

@@ -19,6 +19,9 @@ HELP: length-limit
 HELP: line-limit
 { $var-description "The maximum number of lines output by the prettyprinter before output is truncated with \"...\". The default is " { $link f } ", denoting unlimited line count." } ;
 
+HELP: number-base
+{ $var-description "The number base in which the prettyprinter will output numeric literals. A value of " { $snippet "2" } " will print integers and ratios in binary with " { $link POSTPONE: BIN: } ", and " { $snippet "8" } " will print them in octal with " { $link POSTPONE: OCT: } ". A value of " { $snippet "16" } " will print all integers, ratios, and floating-point values in hexadecimal with " { $link POSTPONE: HEX: } ". Other values of " { $snippet "number-base" } " will print numbers in decimal, which is the default." } ;
+
 HELP: string-limit?
 { $var-description "Toggles whether printed strings are truncated to the margin." } ;
 

basis/prettyprint/prettyprint-docs.factor

@@ -28,6 +28,7 @@ ARTICLE: "prettyprint-variables" "Prettyprint control variables"
 { $subsection nesting-limit }
 { $subsection length-limit }
 { $subsection line-limit }
+{ $subsection number-base }
 { $subsection string-limit? }
 { $subsection boa-tuples? }
 { $subsection c-object-pointers? }
@@ -202,8 +203,8 @@ HELP: .o
 { $description "Outputs an integer in octal." } ;
 
 HELP: .h
-{ $values { "n" "an integer" } }
+{ $values { "n" "an integer or floating-point value" } }
-{ $description "Outputs an integer in hexadecimal." } ;
+{ $description "Outputs an integer or floating-point value in hexadecimal." } ;
 
 HELP: stack.
 { $values { "seq" "a sequence" } }

basis/random/windows/windows.factor

@@ -1,4 +1,4 @@
-USING: accessors alien.c-types byte-arrays
+USING: accessors alien.c-types alien.data byte-arrays
 combinators.short-circuit continuations destructors init kernel
 locals namespaces random windows.advapi32 windows.errors
 windows.kernel32 math.bitwise ;

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

@@ -4,7 +4,8 @@ specialized-arrays.private sequences alien.c-types accessors
 kernel arrays combinators compiler compiler.units classes.struct
 combinators.smart compiler.tree.debugger math libc destructors
 sequences.private multiline eval words vocabs namespaces
-assocs prettyprint ;
+assocs prettyprint alien.data ;
+FROM: alien.c-types => float ;
 
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAY: bool

basis/specialized-arrays/specialized-arrays.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types assocs byte-arrays classes
+USING: accessors alien alien.c-types alien.data alien.parser assocs
-compiler.units functors kernel lexer libc math
+byte-arrays classes compiler.units functors kernel lexer libc math
 math.vectors.specialization namespaces parser prettyprint.custom
 sequences sequences.private strings summary vocabs vocabs.loader
 vocabs.parser words fry combinators ;
@@ -103,13 +103,21 @@ A T c-type-boxed-class f specialize-vector-words
 
 ;FUNCTOR
 
+GENERIC: (underlying-type) ( c-type -- c-type' )
+
+M: string (underlying-type) c-types get at ;
+M: word (underlying-type) "c-type" word-prop ;
+
 : underlying-type ( c-type -- c-type' )
-    dup c-types get at {
+    dup (underlying-type) {
         { [ dup not ] [ drop no-c-type ] }
-        { [ dup string? ] [ nip underlying-type ] }
+        { [ dup c-type-name? ] [ nip underlying-type ] }
         [ drop ]
     } cond ;
 
+: underlying-type-name ( c-type -- name )
+    underlying-type dup word? [ name>> ] when ;
+
 : specialized-array-vocab ( c-type -- vocab )
     "specialized-arrays.instances." prepend ;
 
@@ -125,31 +133,31 @@ PRIVATE>
     ] ?if ; inline
 
 : define-array-vocab ( type -- vocab )
-    underlying-type
+    underlying-type-name
     [ specialized-array-vocab ] [ '[ _ define-array ] ] bi
     generate-vocab ;
 
-M: string require-c-array define-array-vocab drop ;
+M: c-type-name require-c-array define-array-vocab drop ;
 
 ERROR: specialized-array-vocab-not-loaded c-type ;
 
-M: string c-array-constructor
+M: c-type-name c-array-constructor
-    underlying-type
+    underlying-type-name
     dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
 
-M: string c-(array)-constructor
+M: c-type-name c-(array)-constructor
-    underlying-type
+    underlying-type-name
     dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
 
-M: string c-direct-array-constructor
+M: c-type-name c-direct-array-constructor
-    underlying-type
+    underlying-type-name
     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 ;
+    scan-c-type define-array-vocab use-vocab ;
 
 "prettyprint" vocab [
     "specialized-arrays.prettyprint" require

basis/stack-checker/alien/alien.factor

@@ -19,7 +19,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
 
 : alien-stack ( params extra -- )
     over parameters>> length + consume-d >>in-d
-    dup return>> "void" = 0 1 ? produce-d >>out-d
+    dup return>> void? 0 1 ? produce-d >>out-d
     drop ;
 
 : return-prep-quot ( node -- quot )

basis/tools/deploy/config/config-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax words alien.c-types assocs
+USING: help.markup help.syntax words alien.c-types alien.data assocs
 kernel math ;
 IN: tools.deploy.config
 

basis/tools/disassembler/disassembler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays byte-arrays combinators
 destructors generic io kernel libc math sequences system tr
-vocabs.loader words ;
+vocabs.loader words alien.data ;
 IN: tools.disassembler
 
 GENERIC: disassemble ( obj -- )

basis/tools/disassembler/udis/udis.factor

@@ -4,7 +4,7 @@ USING: tools.disassembler namespaces combinators
 alien alien.syntax alien.c-types lexer parser kernel
 sequences layouts math math.order alien.libraries
 math.parser system make fry arrays libc destructors
-tools.disassembler.utils splitting ;
+tools.disassembler.utils splitting alien.data ;
 IN: tools.disassembler.udis
 
 <<

basis/ui/backend/cocoa/views/views.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings arrays assocs
+USING: accessors alien alien.c-types alien.data alien.strings
-cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes
+arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing
-cocoa.views cocoa.application cocoa.pasteboard cocoa.types
+cocoa.classes cocoa.views cocoa.application cocoa.pasteboard
-cocoa.windows sequences io.encodings.utf8 ui ui.private ui.gadgets
+cocoa.types cocoa.windows sequences io.encodings.utf8 ui ui.private
-ui.gadgets.private ui.gadgets.worlds ui.gestures
+ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
 core-foundation.strings core-graphics core-graphics.types threads
 combinators math.rectangles ;
 IN: ui.backend.cocoa.views

basis/ui/backend/windows/windows.factor

@@ -13,7 +13,7 @@ opengl ui.render math.bitwise locals accessors math.rectangles
 math.order calendar ascii sets io.encodings.utf16n
 windows.errors literals ui.pixel-formats
 ui.pixel-formats.private memoize classes
-specialized-arrays classes.struct ;
+specialized-arrays classes.struct alien.data ;
 SPECIALIZED-ARRAY: POINT
 IN: ui.backend.windows
 

basis/unix/process/process.factor

@@ -1,6 +1,6 @@
-USING: kernel alien.c-types alien.strings sequences math alien.syntax
+USING: kernel alien.c-types alien.data alien.strings sequences
-unix namespaces continuations threads assocs io.backend.unix
+math alien.syntax unix namespaces continuations threads assocs
-io.encodings.utf8 unix.utilities fry ;
+io.backend.unix io.encodings.utf8 unix.utilities fry ;
 IN: unix.process
 
 ! Low-level Unix process launching utilities. These are used

basis/unix/utilities/utilities.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings
+USING: alien alien.c-types alien.data alien.strings
 combinators.short-circuit fry kernel layouts sequences accessors
 specialized-arrays ;
 IN: unix.utilities

basis/unix/utmpx/utmpx.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax combinators continuations
+USING: alien.c-types alien.data alien.syntax combinators
-io.encodings.string io.encodings.utf8 kernel sequences strings
+continuations io.encodings.string io.encodings.utf8 kernel
-unix calendar system accessors unix.time calendar.unix
+sequences strings unix calendar system accessors unix.time
-vocabs.loader ;
+calendar.unix vocabs.loader ;
 IN: unix.utmpx
 
 CONSTANT: EMPTY 0

basis/windows/com/com.factor

@@ -1,6 +1,6 @@
 USING: alien alien.c-types alien.destructors windows.com.syntax
 windows.ole32 windows.types continuations kernel alien.syntax
-libc destructors accessors ;
+libc destructors accessors alien.data ;
 IN: windows.com
 
 LIBRARY: ole32

basis/windows/com/syntax/syntax.factor

@@ -67,7 +67,7 @@ unless
 : (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
     swap
     [ [ second ] map ]
-    [ dup "void" = [ drop { } ] [ 1array ] if ] bi*
+    [ dup void? [ drop { } ] [ 1array ] if ] bi*
     <effect> ;
 
 : (define-word-for-function) ( function interface n -- )

basis/windows/com/wrapper/wrapper.factor

@@ -1,9 +1,9 @@
-USING: alien alien.c-types alien.accessors windows.com.syntax
+USING: alien alien.c-types alien.data alien.accessors
-init windows.com.syntax.private windows.com continuations kernel
+windows.com.syntax init windows.com.syntax.private windows.com
-namespaces windows.ole32 libc vocabs assocs accessors arrays
+continuations kernel namespaces windows.ole32 libc vocabs
-sequences quotations combinators math words compiler.units
+assocs accessors arrays sequences quotations combinators math
-destructors fry math.parser generalizations sets
+words compiler.units destructors fry math.parser generalizations
-specialized-arrays windows.kernel32 classes.struct ;
+sets specialized-arrays windows.kernel32 classes.struct ;
 SPECIALIZED-ARRAY: void*
 IN: windows.com.wrapper
 

basis/windows/dinput/constants/constants.factor

@@ -1,8 +1,9 @@
 USING: windows.dinput windows.kernel32 windows.ole32 windows.com
-windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
+windows.com.syntax alien alien.c-types alien.data alien.syntax
-combinators sequences fry math accessors macros words quotations
+kernel system namespaces combinators sequences fry math accessors
-libc continuations generalizations splitting locals assocs init
+macros words quotations libc continuations generalizations
-specialized-arrays memoize classes.struct ;
+splitting locals assocs init specialized-arrays memoize
+classes.struct strings arrays ;
 SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
 IN: windows.dinput.constants
 
@@ -22,12 +23,17 @@ SYMBOLS:
 MEMO: c-type* ( name -- c-type ) c-type ;
 MEMO: heap-size* ( c-type -- n ) heap-size ;
 
+GENERIC: array-base-type ( c-type -- c-type' )
+M: object array-base-type ;
+M: string array-base-type "[" split1 drop ;
+M: array array-base-type first ;
+
 : (field-spec-of) ( field struct -- field-spec )
     c-type* fields>> [ name>> = ] with find nip ;
 : (offsetof) ( field struct -- offset )
     [ (field-spec-of) offset>> ] [ drop 0 ] if* ;
 : (sizeof) ( field struct -- size )
-    [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ;
+    [ (field-spec-of) type>> array-base-type heap-size* ] [ drop 1 ] if* ;
 
 : (flag) ( thing -- integer )
     {

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

@@ -1,17 +1,16 @@
 USING: alien.strings io.encodings.utf16n windows.com
 windows.com.wrapper combinators windows.kernel32 windows.ole32
-windows.shell32 kernel accessors
+windows.shell32 kernel accessors windows.types
 prettyprint namespaces ui.tools.listener ui.tools.workspace
-alien.c-types alien sequences math ;
+alien.data alien sequences math ;
+SPECIALIZED-ARRAY: WCHAR
 IN: windows.dragdrop-listener
 
-<< "WCHAR" require-c-array >>
-
 : filenames-from-hdrop ( hdrop -- filenames )
     dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files
     [
         2dup f 0 DragQueryFile 1 + ! get size of filename buffer
-        dup "WCHAR" <c-array>
+        dup WCHAR <c-array>
         [ swap DragQueryFile drop ] keep
         utf16n alien>string
     ] with map ;

basis/windows/errors/errors.factor

@@ -1,11 +1,10 @@
-USING: alien.c-types kernel locals math math.bitwise
+USING: alien.data kernel locals math math.bitwise
 windows.kernel32 sequences byte-arrays unicode.categories
 io.encodings.string io.encodings.utf16n alien.strings
-arrays literals ;
+arrays literals windows.types specialized-arrays ;
+SPECIALIZED-ARRAY: TCHAR
 IN: windows.errors
 
-<< "TCHAR" require-c-array >>
-
 CONSTANT: ERROR_SUCCESS                               0
 CONSTANT: ERROR_INVALID_FUNCTION                      1
 CONSTANT: ERROR_FILE_NOT_FOUND                        2
@@ -698,8 +697,6 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK   HEX: 000000FF
 : make-lang-id ( lang1 lang2 -- n )
     10 shift bitor ; inline
 
-<< "TCHAR" require-c-array >>
-
 ERROR: error-message-failed id ;
 :: n>win32-error-string ( id -- string )
     {
@@ -709,7 +706,7 @@ ERROR: error-message-failed id ;
     f
     id
     LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
-    32768 [ "TCHAR" <c-array> ] [ ] bi
+    32768 [ TCHAR <c-array> ] [ ] bi
     f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
     utf16n alien>string [ blank? ] trim ;
 

basis/windows/offscreen/offscreen.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Joe Groff, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel combinators sequences
+USING: alien.c-types alien.data kernel combinators
-math windows.gdi32 windows.types images destructors
+sequences math windows.gdi32 windows.types images
-accessors fry locals classes.struct ;
+destructors accessors fry locals classes.struct ;
 IN: windows.offscreen
 
 : (bitmap-info) ( dim -- BITMAPINFO )

basis/windows/ole32/ole32.factor

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

basis/windows/types/types.factor

@@ -3,6 +3,7 @@
 USING: alien alien.c-types alien.syntax namespaces kernel words
 sequences math math.bitwise math.vectors colors
 io.encodings.utf16n classes.struct accessors ;
+FROM: alien.c-types => float short ;
 IN: windows.types
 
 TYPEDEF: char                CHAR
@@ -69,7 +70,8 @@ TYPEDEF: ulonglong   ULARGE_INTEGER
 TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
 TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
 
-<< { "char*" utf16n } "wchar_t*" typedef >>
+SYMBOL: wchar_t*
+<< { char* utf16n } \ wchar_t* typedef >>
 
 TYPEDEF: wchar_t*  LPCSTR
 TYPEDEF: wchar_t*  LPWSTR

basis/windows/winsock/winsock.factor

@@ -4,6 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax arrays
 byte-arrays kernel literals math sequences windows.types
 windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
 classes.struct windows.com.syntax init ;
+FROM: alien.c-types => short ;
 IN: windows.winsock
 
 TYPEDEF: void* SOCKET

basis/x11/xlib/xlib.factor

@@ -10,9 +10,10 @@
 ! add to this library and are wondering what part of the file to
 ! modify, just find the function or data structure in the manual
 ! and note the section.
-USING: accessors kernel arrays alien alien.c-types alien.strings
+USING: accessors kernel arrays alien alien.c-types alien.data
-alien.syntax classes.struct math math.bitwise words sequences
+alien.strings alien.syntax classes.struct math math.bitwise words
-namespaces continuations io io.encodings.ascii x11.syntax ;
+sequences namespaces continuations io io.encodings.ascii x11.syntax ;
+FROM: alien.c-types => short ;
 IN: x11.xlib
 
 LIBRARY: xlib

core/alien/strings/strings-tests.factor

@@ -1,4 +1,4 @@
-USING: alien.strings alien.c-types tools.test kernel libc
+USING: alien.strings alien.c-types alien.data tools.test kernel libc
 io.encodings.8-bit io.encodings.utf8 io.encodings.utf16
 io.encodings.utf16n io.encodings.ascii alien io.encodings.string ;
 IN: alien.strings.tests

core/math/parser/parser-docs.factor

@@ -61,7 +61,7 @@ HELP: bin>
 $nl
 "Outputs " { $link f } " if the string does not represent a number." } ;
 
-{ bin> POSTPONE: BIN: bin> .b } related-words
+{ >bin POSTPONE: BIN: bin> .b } related-words
 
 HELP: oct>
 { $values { "str" string } { "n/f" "a real number or " { $link f } } }
@@ -69,7 +69,7 @@ HELP: oct>
 $nl
 "Outputs " { $link f } " if the string does not represent a number." } ;
 
-{ oct> POSTPONE: OCT: oct> .o } related-words
+{ >oct POSTPONE: OCT: oct> .o } related-words
 
 HELP: hex>
 { $values { "str" string } { "n/f" "a real number or " { $link f } } }
@@ -77,7 +77,7 @@ HELP: hex>
 $nl
 "Outputs " { $link f } " if the string does not represent a number." } ;
 
-{ hex> POSTPONE: HEX: hex> .h } related-words
+{ >hex POSTPONE: HEX: hex> .h } related-words
 
 HELP: >base
 { $values { "n" real } { "radix" "an integer between 2 and 36" } { "str" string } }

core/syntax/syntax-docs.factor

@@ -593,10 +593,13 @@ HELP: #!
 { $description "Discards all input until the end of the line." } ;
 
 HELP: HEX:
-{ $syntax "HEX: integer" }
+{ $syntax "HEX: NNN" "HEX: NNN.NNNpEEE" }
-{ $values { "integer" "hexadecimal digits (0-9, a-f, A-F)" } }
+{ $values { "N" "hexadecimal digit (0-9, a-f, A-F)" } { "pEEE" "decimal exponent value" } }
-{ $description "Adds an integer read from a hexadecimal literal to the parse tree." }
+{ $description "Adds an integer or floating-point value read from a hexadecimal literal to the parse tree." }
-{ $examples { $example "USE: prettyprint" "HEX: ff ." "255" } } ;
+{ $examples
+    { $example "USE: prettyprint" "HEX: ff ." "255" }
+    { $example "USE: prettyprint" "HEX: 1.8p5 ." "48.0" }
+} ;
 
 HELP: OCT:
 { $syntax "OCT: integer" }

extra/alien/inline/inline.factor

@@ -41,6 +41,11 @@ SYMBOL: c-strings
     [ current-vocab name>> % "_" % % ] "" make ;
 PRIVATE>
 
+: parse-arglist ( parameters return -- types effect )
+    [ 2 group unzip [ "," ?tail drop ] map ]
+    [ [ { } ] [ 1array ] if-void ]
+    bi* <effect> ;
+
 : append-function-body ( prototype-str body -- str )
     [ swap % " {\n" % % "\n}\n" % ] "" make ;
 

extra/alien/inline/syntax/syntax-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Jeremy Hughes.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.inline alien.inline.syntax io.directories io.files
-kernel namespaces tools.test alien.c-types alien.structs ;
+kernel namespaces tools.test alien.c-types alien.data alien.structs ;
 IN: alien.inline.syntax.tests
 
 DELETE-C-LIBRARY: test

extra/alien/inline/types/types.factor

@@ -2,10 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types assocs combinators.short-circuit
 continuations effects fry kernel math memoize sequences
-splitting strings peg.ebnf make ;
+splitting strings peg.ebnf make words ;
 IN: alien.inline.types
 
 : cify-type ( str -- str' )
+    dup word? [ name>> ] when
     { { CHAR: - CHAR: space } } substitute ;
 
 : factorize-type ( str -- str' )

extra/alien/marshall/marshall-docs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Jeremy Hughes.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax kernel quotations sequences
-strings alien alien.c-types math byte-arrays ;
+strings alien alien.c-types alien.data math byte-arrays ;
 IN: alien.marshall
 
 <PRIVATE

extra/alien/marshall/marshall.factor

@@ -3,9 +3,10 @@
 USING: accessors alien alien.c-types alien.inline.types
 alien.marshall.private alien.strings byte-arrays classes
 combinators combinators.short-circuit destructors fry
-io.encodings.utf8 kernel libc sequences
+io.encodings.utf8 kernel libc sequences alien.data
 specialized-arrays strings unix.utilities vocabs.parser
 words libc.private locals generalizations math ;
+FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: bool
 SPECIALIZED-ARRAY: char
 SPECIALIZED-ARRAY: double
@@ -22,7 +23,7 @@ SPECIALIZED-ARRAY: ushort
 SPECIALIZED-ARRAY: void*
 IN: alien.marshall
 
-<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
+<< primitive-types [ [ void* = ] [ bool = ] bi or not ]
 filter [ define-primitive-marshallers ] each >>
 
 TUPLE: alien-wrapper { underlying alien } ;

extra/alien/marshall/private/private.factor

@@ -3,7 +3,7 @@
 USING: accessors alien alien.c-types alien.inline arrays
 combinators fry functors kernel lexer libc macros math
 sequences specialized-arrays libc.private
-combinators.short-circuit ;
+combinators.short-circuit alien.data ;
 SPECIALIZED-ARRAY: void*
 IN: alien.marshall.private