redefine C-TYPE: to forward declare opaque C types; make C type definition and redefinition a little more robust
Joe Groff
parent
b742928d8f
commit
123f4fbc30
|
|
@ -88,16 +88,24 @@ HELP: uint
|
|||
{ $description "This C type represents a four-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 32 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: long
|
||||
{ $description "This C type represents a four- or eight-byte signed integer type. On Windows and on 32-bit Unix platforms, it will be four bytes. On 64-bit Unix platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: intptr_t
|
||||
{ $description "This C type represents a signed integer type large enough to hold any pointer value; that is, on 32-bit platforms, it will be four bytes, and on 64-bit platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: ulong
|
||||
{ $description "This C type represents a four- or eight-byte unsigned integer type. On Windows and on 32-bit Unix platforms, it will be four bytes. On 64-bit Unix platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: uintptr_t
|
||||
{ $description "This C type represents an unsigned integer type large enough to hold any pointer value; that is, on 32-bit platforms, it will be four bytes, and on 64-bit platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: ptrdiff_t
|
||||
{ $description "This C type represents a signed integer type large enough to hold the distance between two pointer values; that is, on 32-bit platforms, it will be four bytes, and on 64-bit platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: size_t
|
||||
{ $description "This C type represents unsigned size values of the size expected by the platform's standard C library (usually four bytes on a 32-bit platform, and eight on a 64-bit platform). Input values will be converted to " { $link math:integer } "s and truncated to the appropriate size; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: longlong
|
||||
{ $description "This C type represents an eight-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: ulonglong
|
||||
{ $description "This C type represents an eight-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ;
|
||||
HELP: void
|
||||
{ $description "This symbol is not a valid C type, but it can be used as the return type for a " { $link POSTPONE: FUNCTION: } " or " { $link POSTPONE: CALLBACK: } " definition, or an " { $link alien-invoke } " or " { $link alien-callback } " call." } ;
|
||||
{ $description "This symbol is not a valid C type, but it can be used as the return type for a " { $link POSTPONE: FUNCTION: } " or " { $link POSTPONE: CALLBACK: } " definition or for an " { $link alien-invoke } " or " { $link alien-callback } " call." } ;
|
||||
HELP: void*
|
||||
{ $description "This C type represents a pointer to C memory. " { $link byte-array } " and " { $link alien } " values can be passed as inputs, but see " { $link "byte-arrays-gc" } " for notes about passing byte arrays into C functions. Output values are returned as " { $link alien } "s." } ;
|
||||
{ $description "This C type represents a pointer to C memory. " { $link byte-array } " and " { $link alien } " values can be passed as " { $snippet "void*" } " function inputs, but see " { $link "byte-arrays-gc" } " for notes about passing byte arrays into C functions. " { $snippet "void*" } " output values are returned as " { $link alien } "s." } ;
|
||||
HELP: char*
|
||||
{ $description "This C type represents a pointer to a C string. See " { $link "c-strings" } " for details about using strings with the FFI." } ;
|
||||
HELP: float
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: alien alien.syntax alien.c-types alien.parser
|
||||
kernel tools.test sequences system libc alien.strings
|
||||
io.encodings.utf8 math.constants classes.struct ;
|
||||
eval kernel tools.test sequences system libc alien.strings
|
||||
io.encodings.utf8 math.constants classes.struct classes ;
|
||||
IN: alien.c-types.tests
|
||||
|
||||
CONSTANT: xyz 123
|
||||
|
|
@ -15,28 +15,28 @@ UNION-STRUCT: foo
|
|||
{ a int }
|
||||
{ b int } ;
|
||||
|
||||
[ f ] [ "char*" parse-c-type c-type void* c-type eq? ] unit-test
|
||||
[ t ] [ "char**" parse-c-type c-type void* c-type eq? ] unit-test
|
||||
[ f ] [ char resolve-pointer-type c-type void* c-type eq? ] unit-test
|
||||
[ t ] [ char* resolve-pointer-type c-type void* c-type eq? ] unit-test
|
||||
|
||||
[ t ] [ foo heap-size int heap-size = ] unit-test
|
||||
|
||||
TYPEDEF: int MyInt
|
||||
|
||||
[ t ] [ int c-type MyInt c-type eq? ] unit-test
|
||||
[ t ] [ void* c-type "MyInt*" parse-c-type c-type eq? ] unit-test
|
||||
[ t ] [ int c-type MyInt c-type eq? ] unit-test
|
||||
[ t ] [ void* c-type MyInt resolve-pointer-type c-type eq? ] unit-test
|
||||
|
||||
TYPEDEF: char MyChar
|
||||
|
||||
[ t ] [ char c-type MyChar c-type eq? ] unit-test
|
||||
[ f ] [ void* c-type "MyChar*" parse-c-type c-type eq? ] unit-test
|
||||
[ t ] [ "char*" parse-c-type c-type "MyChar*" parse-c-type c-type eq? ] unit-test
|
||||
[ t ] [ char c-type MyChar c-type eq? ] unit-test
|
||||
[ f ] [ void* c-type MyChar resolve-pointer-type c-type eq? ] unit-test
|
||||
[ t ] [ char* c-type MyChar resolve-pointer-type c-type eq? ] unit-test
|
||||
|
||||
[ 32 ] [ { int 8 } heap-size ] unit-test
|
||||
|
||||
TYPEDEF: char* MyString
|
||||
|
||||
[ t ] [ char* c-type MyString c-type eq? ] unit-test
|
||||
[ t ] [ void* c-type "MyString*" parse-c-type c-type eq? ] unit-test
|
||||
[ t ] [ char* c-type MyString c-type eq? ] unit-test
|
||||
[ t ] [ void* c-type MyString resolve-pointer-type c-type eq? ] unit-test
|
||||
|
||||
TYPEDEF: int* MyIntArray
|
||||
|
||||
|
|
@ -59,3 +59,44 @@ os windows? cpu x86.64? and [
|
|||
[ -10 ] [ -10 char c-type-clamp ] unit-test
|
||||
[ 127 ] [ 230 char c-type-clamp ] unit-test
|
||||
[ t ] [ pi dup float c-type-clamp = ] unit-test
|
||||
|
||||
C-TYPE: opaque
|
||||
|
||||
[ t ] [ void* c-type opaque resolve-pointer-type c-type eq? ] unit-test
|
||||
[ opaque c-type ] [ no-c-type? ] must-fail-with
|
||||
|
||||
[ """
|
||||
USING: alien.syntax ;
|
||||
IN: alien.c-types.tests
|
||||
FUNCTION: opaque return_opaque ( ) ;
|
||||
""" eval( -- ) ] [ no-c-type? ] must-fail-with
|
||||
|
||||
C-TYPE: forward
|
||||
STRUCT: backward { x forward* } ;
|
||||
STRUCT: forward { x backward* } ;
|
||||
|
||||
[ t ] [ forward c-type struct-c-type? ] unit-test
|
||||
[ t ] [ backward c-type struct-c-type? ] unit-test
|
||||
|
||||
DEFER: struct-redefined
|
||||
|
||||
[ f ]
|
||||
[
|
||||
|
||||
"""
|
||||
USING: alien.c-types classes.struct ;
|
||||
IN: alien.c-types.tests
|
||||
|
||||
STRUCT: struct-redefined { x int } ;
|
||||
""" eval( -- )
|
||||
|
||||
"""
|
||||
USING: alien.syntax ;
|
||||
IN: alien.c-types.tests
|
||||
|
||||
C-TYPE: struct-redefined
|
||||
""" eval( -- )
|
||||
|
||||
\ struct-redefined class?
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ ERROR: no-c-type name ;
|
|||
PREDICATE: c-type-word < word
|
||||
"c-type" word-prop ;
|
||||
|
||||
UNION: c-type-name string word ;
|
||||
UNION: c-type-name string c-type-word ;
|
||||
|
||||
! C type protocol
|
||||
GENERIC: c-type ( name -- c-type ) foldable
|
||||
|
|
@ -62,6 +62,9 @@ GENERIC: resolve-pointer-type ( name -- c-type )
|
|||
|
||||
<< \ void \ void* "pointer-c-type" set-word-prop >>
|
||||
|
||||
: void? ( c-type -- ? )
|
||||
{ void "void" } member? ;
|
||||
|
||||
M: word resolve-pointer-type
|
||||
dup "pointer-c-type" word-prop
|
||||
[ ] [ drop void* ] ?if ;
|
||||
|
|
@ -75,6 +78,7 @@ M: string resolve-pointer-type
|
|||
] if ;
|
||||
|
||||
: resolve-typedef ( name -- c-type )
|
||||
dup void? [ no-c-type ] when
|
||||
dup c-type-name? [ c-type ] when ;
|
||||
|
||||
: parse-array-type ( name -- dims c-type )
|
||||
|
|
@ -91,10 +95,8 @@ M: string c-type ( name -- c-type )
|
|||
] if ;
|
||||
|
||||
M: word c-type
|
||||
"c-type" word-prop resolve-typedef ;
|
||||
|
||||
: void? ( c-type -- ? )
|
||||
{ void "void" } member? ;
|
||||
dup "c-type" word-prop resolve-typedef
|
||||
[ ] [ no-c-type ] ?if ;
|
||||
|
||||
GENERIC: c-struct? ( c-type -- ? )
|
||||
|
||||
|
|
@ -310,7 +312,7 @@ CONSTANT: primitive-types
|
|||
}
|
||||
|
||||
SYMBOLS:
|
||||
ptrdiff_t intptr_t size_t
|
||||
ptrdiff_t intptr_t uintptr_t size_t
|
||||
char* uchar* ;
|
||||
|
||||
[
|
||||
|
|
@ -471,9 +473,10 @@ SYMBOLS:
|
|||
[ >float ] >>unboxer-quot
|
||||
\ double define-primitive-type
|
||||
|
||||
\ long \ ptrdiff_t typedef
|
||||
\ long \ intptr_t typedef
|
||||
\ ulong \ size_t typedef
|
||||
\ long c-type \ ptrdiff_t typedef
|
||||
\ long c-type \ intptr_t typedef
|
||||
\ ulong c-type \ uintptr_t typedef
|
||||
\ ulong c-type \ size_t typedef
|
||||
] with-compilation-unit
|
||||
|
||||
M: char-16-rep rep-component-type drop char ;
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types arrays assocs
|
||||
combinators combinators.short-circuit effects grouping
|
||||
kernel parser sequences splitting words fry locals lexer
|
||||
namespaces summary math vocabs.parser ;
|
||||
USING: accessors alien alien.c-types arrays assocs classes
|
||||
combinators combinators.short-circuit compiler.units effects
|
||||
grouping kernel parser sequences splitting words fry locals
|
||||
lexer namespaces summary math vocabs.parser ;
|
||||
IN: alien.parser
|
||||
|
||||
: parse-c-type-name ( name -- word )
|
||||
|
|
@ -25,10 +25,17 @@ IN: alien.parser
|
|||
[ parse-c-type ] if ;
|
||||
|
||||
: reset-c-type ( word -- )
|
||||
dup "struct-size" word-prop
|
||||
[ dup [ forget-class ] [ { "struct-size" } reset-props ] bi ] when
|
||||
{ "c-type" "pointer-c-type" "callback-effect" "callback-abi" } reset-props ;
|
||||
|
||||
: CREATE-C-TYPE ( -- word )
|
||||
scan current-vocab create dup reset-c-type ;
|
||||
scan current-vocab create {
|
||||
[ fake-definition ]
|
||||
[ set-word ]
|
||||
[ reset-c-type ]
|
||||
[ ]
|
||||
} cleave ;
|
||||
|
||||
: normalize-c-arg ( type name -- type' name' )
|
||||
[ length ]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: alien.syntax
|
||||
USING: alien alien.c-types alien.parser classes.struct help.markup help.syntax ;
|
||||
USING: alien alien.c-types alien.parser classes.struct help.markup help.syntax see ;
|
||||
|
||||
HELP: DLL"
|
||||
{ $syntax "DLL\" path\"" }
|
||||
|
|
@ -65,6 +65,16 @@ HELP: C-ENUM:
|
|||
{ $code "CONSTANT: red 0" "CONSTANT: green 1" "CONSTANT: blue 2" }
|
||||
} ;
|
||||
|
||||
HELP: C-TYPE:
|
||||
{ $syntax "C-TYPE: type" }
|
||||
{ $values { "type" "a new C type" } }
|
||||
{ $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link POSTPONE: FUNCTION: } " or as a slot of a " { $link POSTPONE: STRUCT: } ". However, it can be used as the type of a pointer (that is, as " { $snippet "type*" } ")." $nl
|
||||
{ $snippet "C-TYPE:" } " can also be used to forward-declare C types to enable circular dependencies. For example:"
|
||||
{ $code """C-TYPE: forward
|
||||
STRUCT: backward { x forward* } ;
|
||||
STRUCT: forward { x backward* } ; """ } }
|
||||
{ $notes "Primitive C types are also displayed using " { $snippet "C-TYPE:" } " syntax when they are displayed by " { $link see } "." } ;
|
||||
|
||||
HELP: CALLBACK:
|
||||
{ $syntax "CALLBACK: return type ( parameters ) ;" }
|
||||
{ $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ SYNTAX: C-ENUM:
|
|||
[ [ create-in ] dip define-constant ] each-index ;
|
||||
|
||||
SYNTAX: C-TYPE:
|
||||
"Primitive C type definition not supported" throw ;
|
||||
void CREATE-C-TYPE typedef ;
|
||||
|
||||
ERROR: no-such-symbol name library ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue