Rename c-type to lookup-c-type. Fixes #230.
parent
f9257959fd
commit
ff69e2f240
|
@ -7,7 +7,7 @@ IN: alien.arrays
|
|||
|
||||
INSTANCE: array value-type
|
||||
|
||||
M: array c-type ;
|
||||
M: array lookup-c-type ;
|
||||
|
||||
M: array c-type-class drop object ;
|
||||
|
||||
|
@ -27,7 +27,7 @@ M: array base-type drop void* base-type ;
|
|||
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 ;
|
||||
|
||||
|
|
|
@ -23,7 +23,7 @@ HELP: no-c-type
|
|||
{ $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." } ;
|
||||
|
@ -172,6 +172,8 @@ $nl
|
|||
POSTPONE: CALLBACK:
|
||||
POSTPONE: TYPEDEF:
|
||||
}
|
||||
"Getting the c-type of a class:"
|
||||
{ $subsections lookup-c-type }
|
||||
{ $heading "Related articles" }
|
||||
{ $subsections
|
||||
"c-types.primitives"
|
||||
|
|
|
@ -13,20 +13,20 @@ UNION-STRUCT: foo
|
|||
{ 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
|
||||
|
||||
|
@ -34,20 +34,20 @@ TYPEDEF: int MyInt
|
|||
|
||||
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
|
||||
|
@ -57,8 +57,8 @@ TYPEDEF: int* MyIntArray
|
|||
|
||||
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 ;
|
||||
|
@ -70,8 +70,8 @@ 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
|
||||
[ t ] [ forward lookup-c-type struct-c-type? ] unit-test
|
||||
[ t ] [ backward lookup-c-type struct-c-type? ] unit-test
|
||||
|
||||
DEFER: struct-redefined
|
||||
|
||||
|
|
|
@ -42,7 +42,7 @@ ERROR: no-c-type word ;
|
|||
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 ;
|
||||
|
@ -55,12 +55,13 @@ UNION: c-type-name
|
|||
|
||||
: 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>> ;
|
||||
|
@ -103,7 +104,7 @@ M: abstract-c-type c-type-align-first align-first>> ;
|
|||
|
||||
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 ;
|
||||
|
||||
|
@ -148,7 +149,7 @@ PROTOCOL: c-type-protocol
|
|||
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 ;
|
||||
|
@ -212,8 +213,8 @@ CONSTANT: primitive-types
|
|||
|
||||
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 ;
|
||||
|
||||
[
|
||||
|
@ -363,18 +364,18 @@ M: pointer c-type
|
|||
\ 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
|
||||
|
@ -426,17 +427,17 @@ M: pointer c-type
|
|||
[ >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
|
||||
|
|
|
@ -22,7 +22,7 @@ M: word enum>number "enum-value" word-prop ;
|
|||
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 ;
|
||||
|
|
|
@ -124,7 +124,7 @@ M: enum-c-type-word synopsis*
|
|||
[ 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>> ;
|
||||
|
|
|
@ -229,7 +229,7 @@ UNION-STRUCT: struct-test-float-and-bits
|
|||
{ 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
|
||||
|
@ -246,7 +246,7 @@ UNION-STRUCT: struct-test-float-and-bits
|
|||
{ 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 } ;
|
||||
|
|
|
@ -173,7 +173,8 @@ TUPLE: struct-c-type < abstract-c-type
|
|||
|
||||
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 ;
|
||||
|
||||
|
@ -274,7 +275,7 @@ M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inlin
|
|||
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 ;
|
||||
|
@ -318,7 +319,7 @@ PRIVATE>
|
|||
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
|
||||
|
|
|
@ -27,7 +27,7 @@ M: x86.64 reserved-stack-space 0 ;
|
|||
|
||||
: 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 ;
|
||||
|
|
|
@ -24,7 +24,7 @@ TUPLE: alien-assembly-params < alien-node-params { quot callable } ;
|
|||
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
|
||||
|
@ -32,7 +32,7 @@ TUPLE: alien-callback-params < alien-node-params xt ;
|
|||
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 ;
|
||||
|
@ -112,10 +112,10 @@ TUPLE: alien-callback-params < alien-node-params xt ;
|
|||
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 ;
|
||||
|
|
Loading…
Reference in New Issue