From 123f4fbc3004eeb991a1e9bb9e7cf50b43aca975 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 27 Sep 2009 22:11:51 -0500 Subject: [PATCH] redefine C-TYPE: to forward declare opaque C types; make C type definition and redefinition a little more robust --- basis/alien/c-types/c-types-docs.factor | 12 ++++- basis/alien/c-types/c-types-tests.factor | 63 +++++++++++++++++++----- basis/alien/c-types/c-types.factor | 21 ++++---- basis/alien/parser/parser.factor | 17 +++++-- basis/alien/syntax/syntax-docs.factor | 12 ++++- basis/alien/syntax/syntax.factor | 2 +- 6 files changed, 98 insertions(+), 29 deletions(-) diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index 4f70836737..eb4be08764 100755 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -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 diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index f48ed50a34..d134d57189 100755 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -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 + diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index ab1c9df77e..dec7f92501 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -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 ; diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 16a994a8a7..89e83a1d9b 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -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 ] diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor index e04f6a471d..dbfc067bc6 100644 --- a/basis/alien/syntax/syntax-docs.factor +++ b/basis/alien/syntax/syntax-docs.factor @@ -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, ..." } } } diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index 85b763ba51..e27a5ef122 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -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 ;