Rename c-type to lookup-c-type. Fixes #230.

db4
Doug Coleman 2011-10-24 14:31:10 -07:00
parent f9257959fd
commit ff69e2f240
10 changed files with 59 additions and 55 deletions

View File

@ -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 ;

View File

@ -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"

View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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>> ;

View File

@ -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 } ;

View File

@ -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

View File

@ -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 ;

View File

@ -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 ;