INSTANCE: array value-type
-M: array c-type ;
+M: array lookup-c-type ;
M: array c-type-class drop object ;
PREDICATE: string-type < pair
first2 [ c-string = ] [ word? ] bi* and ;
-M: string-type c-type ;
+M: string-type lookup-c-type ;
M: string-type c-type-class drop object ;
{ $description "Throws a " { $link no-c-type } " error." }
{ $error-description "Thrown by " { $link c-type } " if a given word is not a C type." } ;
-HELP: c-type
+HELP: lookup-c-type
{ $values { "name" c-type-name } { "c-type" c-type } }
{ $description "Looks up a C type by name." }
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist, or the word is not a C type." } ;
POSTPONE: CALLBACK:
POSTPONE: TYPEDEF:
}
+"Getting the c-type of a class:"
+{ $subsections lookup-c-type }
{ $heading "Related articles" }
{ $subsections
"c-types.primitives"
{ a int }
{ b int } ;
-[ t ] [ pointer: void c-type void* c-type = ] unit-test
-[ t ] [ pointer: int c-type void* c-type = ] unit-test
-[ t ] [ pointer: int* c-type void* c-type = ] unit-test
-[ f ] [ pointer: foo c-type void* c-type = ] unit-test
-[ t ] [ pointer: foo* c-type void* c-type = ] unit-test
+[ t ] [ pointer: void lookup-c-type void* lookup-c-type = ] unit-test
+[ t ] [ pointer: int lookup-c-type void* lookup-c-type = ] unit-test
+[ t ] [ pointer: int* lookup-c-type void* lookup-c-type = ] unit-test
+[ f ] [ pointer: foo lookup-c-type void* lookup-c-type = ] unit-test
+[ t ] [ pointer: foo* lookup-c-type void* lookup-c-type = ] unit-test
-[ t ] [ c-string c-type c-string c-type = ] unit-test
+[ t ] [ c-string lookup-c-type c-string lookup-c-type = ] unit-test
[ t ] [ foo heap-size int heap-size = ] unit-test
TYPEDEF: int MyInt
-[ t ] [ int c-type MyInt c-type = ] unit-test
-[ t ] [ void* c-type pointer: MyInt c-type = ] unit-test
+[ t ] [ int lookup-c-type MyInt lookup-c-type = ] unit-test
+[ t ] [ void* lookup-c-type pointer: MyInt lookup-c-type = ] unit-test
[ 32 ] [ { int 8 } heap-size ] unit-test
TYPEDEF: char MyChar
-[ t ] [ pointer: void c-type pointer: MyChar c-type = ] unit-test
+[ t ] [ pointer: void lookup-c-type pointer: MyChar lookup-c-type = ] unit-test
TYPEDEF: { c-string ascii } MyFunkyString
-[ { c-string ascii } ] [ MyFunkyString c-type ] unit-test
+[ { c-string ascii } ] [ MyFunkyString lookup-c-type ] unit-test
TYPEDEF: c-string MyString
-[ t ] [ c-string c-type MyString c-type = ] unit-test
-[ t ] [ void* c-type pointer: MyString c-type = ] unit-test
+[ t ] [ c-string lookup-c-type MyString lookup-c-type = ] unit-test
+[ t ] [ void* lookup-c-type pointer: MyString lookup-c-type = ] unit-test
TYPEDEF: int* MyIntArray
-[ t ] [ void* c-type MyIntArray c-type = ] unit-test
+[ t ] [ void* lookup-c-type MyIntArray lookup-c-type = ] unit-test
[ 0 ] [ -10 uchar c-type-clamp ] unit-test
[ 12 ] [ 12 uchar c-type-clamp ] unit-test
C-TYPE: opaque
-[ t ] [ void* c-type pointer: opaque c-type = ] unit-test
-[ opaque c-type ] [ no-c-type? ] must-fail-with
+[ t ] [ void* lookup-c-type pointer: opaque lookup-c-type = ] unit-test
+[ opaque lookup-c-type ] [ no-c-type? ] must-fail-with
[ """
USING: alien.syntax ;
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
+[ t ] [ forward lookup-c-type struct-c-type? ] unit-test
+[ t ] [ backward lookup-c-type struct-c-type? ] unit-test
DEFER: struct-redefined
M: no-c-type summary drop "Not a C type" ;
! C type protocol
-GENERIC: c-type ( name -- c-type ) foldable
+GENERIC: lookup-c-type ( name -- c-type ) foldable
PREDICATE: c-type-word < word
"c-type" word-prop ;
: resolve-typedef ( name -- c-type )
dup void? [ no-c-type ] when
- dup c-type-name? [ c-type ] when ;
+ dup c-type-name? [ lookup-c-type ] when ;
-M: word c-type
+M: word lookup-c-type
dup "c-type" word-prop resolve-typedef
[ ] [ no-c-type ] ?if ;
+
GENERIC: c-type-class ( name -- class )
M: abstract-c-type c-type-class class>> ;
GENERIC: base-type ( c-type -- c-type )
-M: c-type-name base-type c-type ;
+M: c-type-name base-type lookup-c-type ;
M: c-type base-type ;
heap-size ;
CONSULT: c-type-protocol c-type-name
- c-type ;
+ lookup-c-type ;
PREDICATE: typedef-word < c-type-word
"c-type" word-prop [ c-type-name? ] [ array? ] bi or ;
PRIVATE>
-M: pointer c-type
- [ \ void* c-type ] dip
+M: pointer lookup-c-type
+ [ \ void* lookup-c-type ] dip
to>> dup primitive-pointer-type? [ drop ] [ (pointer-c-type) ] if ;
[
\ ulonglong typedef
os windows? [
- \ int c-type \ long typedef
- \ uint c-type \ ulong typedef
+ \ int lookup-c-type \ long typedef
+ \ uint lookup-c-type \ ulong typedef
] [
- \ longlong c-type \ long typedef
- \ ulonglong c-type \ ulong typedef
+ \ longlong lookup-c-type \ long typedef
+ \ ulonglong lookup-c-type \ ulong typedef
] if
- \ longlong c-type \ ptrdiff_t typedef
- \ longlong c-type \ intptr_t typedef
+ \ longlong lookup-c-type \ ptrdiff_t typedef
+ \ longlong lookup-c-type \ intptr_t typedef
- \ ulonglong c-type \ uintptr_t typedef
- \ ulonglong c-type \ size_t typedef
+ \ ulonglong lookup-c-type \ uintptr_t typedef
+ \ ulonglong lookup-c-type \ size_t typedef
] [
<c-type>
integer >>class
[ >integer ] >>unboxer-quot
\ ulonglong typedef
- \ int c-type \ long typedef
- \ uint c-type \ ulong typedef
+ \ int lookup-c-type \ long typedef
+ \ uint lookup-c-type \ ulong typedef
- \ int c-type \ ptrdiff_t typedef
- \ int c-type \ intptr_t typedef
+ \ int lookup-c-type \ ptrdiff_t typedef
+ \ int lookup-c-type \ intptr_t typedef
- \ uint c-type \ uintptr_t typedef
- \ uint c-type \ size_t typedef
+ \ uint lookup-c-type \ uintptr_t typedef
+ \ uint lookup-c-type \ size_t typedef
] if
- cpu ppc? os macosx? and \ uint \ uchar ? c-type clone
+ cpu ppc? os macosx? and \ uint \ uchar ? lookup-c-type clone
[ >c-bool ] >>unboxer-quot
[ c-bool> ] >>boxer-quot
object >>boxed-class
PRIVATE>
MACRO: number>enum ( enum-c-type -- )
- c-type members>> enum-boxer ;
+ lookup-c-type members>> enum-boxer ;
M: enum-c-type c-type-boxed-class drop object ;
M: enum-c-type c-type-boxer-quot members>> enum-boxer ;
[ seeing-word ]
[ definer. ]
[ pprint-word ]
- [ c-type base-type>> dup int eq? [ drop ] [ "<" text pprint-word ] if ]
+ [ lookup-c-type base-type>> dup int eq? [ drop ] [ "<" text pprint-word ] if ]
} cleave ;
M: enum-c-type-word definition
- c-type members>> ;
+ lookup-c-type members>> ;
{ type bool }
{ class object }
}
-} ] [ struct-test-foo c-type fields>> ] unit-test
+} ] [ struct-test-foo lookup-c-type fields>> ] unit-test
[ {
T{ struct-slot-spec
{ class $[ cell 4 = integer fixnum ? ] }
{ initial 0 }
}
-} ] [ struct-test-float-and-bits c-type fields>> ] unit-test
+} ] [ struct-test-float-and-bits lookup-c-type fields>> ] unit-test
STRUCT: struct-test-equality-1
{ x int } ;
INSTANCE: struct-c-type value-type
-M: struct-c-type c-type ;
+! M: struct-c-type c-type ;
+M: struct-c-type lookup-c-type ;
M: struct-c-type base-type ;
bi ;
: check-struct-slots ( slots -- )
- [ type>> c-type drop ] each ;
+ [ type>> lookup-c-type drop ] each ;
: redefine-struct-tuple-class ( class -- )
[ struct f define-tuple-class ] [ make-final ] bi ;
ERROR: invalid-struct-slot token ;
: struct-slot-class ( c-type -- class' )
- c-type c-type-boxed-class
+ lookup-c-type c-type-boxed-class
dup \ byte-array = [ drop \ c-ptr ] when ;
M: struct-class reset-class
: flatten-small-struct ( c-type -- seq )
struct-types&offset split-struct [
- [ c-type c-type-rep reg-class-of ] map
+ [ lookup-c-type c-type-rep reg-class-of ] map
int-regs swap member? int-rep double-rep ?
f f 3array
] map ;
TUPLE: alien-callback-params < alien-node-params xt ;
: param-prep-quot ( params -- quot )
- parameters>> [ c-type c-type-unboxer-quot ] map deep-spread>quot ;
+ parameters>> [ lookup-c-type c-type-unboxer-quot ] map deep-spread>quot ;
: alien-stack ( params extra -- )
over parameters>> length + consume-d >>in-d
drop ;
: return-prep-quot ( params -- quot )
- return>> [ [ ] ] [ c-type c-type-boxer-quot ] if-void ;
+ return>> [ [ ] ] [ lookup-c-type c-type-boxer-quot ] if-void ;
: infer-return ( params -- )
return-prep-quot infer-quot-here ;
xt>> '[ _ callback-xt { alien } declare ] infer-quot-here ;
: callback-return-quot ( ctype -- quot )
- return>> [ [ ] ] [ c-type c-type-unboxer-quot ] if-void ;
+ return>> [ [ ] ] [ lookup-c-type c-type-unboxer-quot ] if-void ;
: callback-parameter-quot ( params -- quot )
- parameters>> [ c-type ] map
+ parameters>> [ lookup-c-type ] map
[ [ c-type-class ] map '[ _ declare ] ]
[ [ c-type-boxer-quot ] map deep-spread>quot ]
bi append ;