steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/alien/arrays/arrays.factor
View File

@ -7,7 +7,7 @@ IN: alien.arrays
INSTANCE: array value-type INSTANCE: array value-type
M: array c-type ; M: array lookup-c-type ;
M: array c-type-class drop object ; M: array c-type-class drop object ;
@ -27,7 +27,7 @@ M: array base-type drop void* base-type ;
PREDICATE: string-type < pair PREDICATE: string-type < pair
first2 [ c-string = ] [ word? ] bi* and ; 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 ; M: string-type c-type-class drop object ;

4
basis/alien/c-types/c-types-docs.factor
View File

@ -23,7 +23,7 @@ HELP: no-c-type
{ $description "Throws a " { $link no-c-type } " error." } { $description "Throws a " { $link no-c-type } " error." }
{ $error-description "Thrown by " { $link c-type } " if a given word is not a C type." } ; { $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 } } { $values { "name" c-type-name } { "c-type" c-type } }
{ $description "Looks up a C type by name." } { $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." } ; { $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: CALLBACK:
POSTPONE: TYPEDEF: POSTPONE: TYPEDEF:
} }
"Getting the c-type of a class:"
{ $subsections lookup-c-type }
{ $heading "Related articles" } { $heading "Related articles" }
{ $subsections { $subsections
"c-types.primitives" "c-types.primitives"

34
basis/alien/c-types/c-types-tests.factor
View File

@ -13,20 +13,20 @@ UNION-STRUCT: foo
{ a int } { a int }
{ b int } ; { b int } ;
[ t ] [ pointer: void c-type void* c-type = ] unit-test [ t ] [ pointer: void lookup-c-type void* lookup-c-type = ] unit-test
[ t ] [ pointer: int c-type void* c-type = ] unit-test [ t ] [ pointer: int lookup-c-type void* lookup-c-type = ] unit-test
[ t ] [ pointer: int* c-type void* c-type = ] unit-test [ t ] [ pointer: int* lookup-c-type void* lookup-c-type = ] unit-test
[ f ] [ pointer: foo c-type void* c-type = ] unit-test [ f ] [ pointer: foo lookup-c-type void* lookup-c-type = ] unit-test
[ t ] [ pointer: foo* c-type void* 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 [ t ] [ foo heap-size int heap-size = ] unit-test
TYPEDEF: int MyInt TYPEDEF: int MyInt
[ t ] [ int c-type MyInt c-type = ] unit-test [ t ] [ int lookup-c-type MyInt lookup-c-type = ] unit-test
[ t ] [ void* c-type pointer: MyInt c-type = ] unit-test [ t ] [ void* lookup-c-type pointer: MyInt lookup-c-type = ] unit-test
[ 32 ] [ { int 8 } heap-size ] unit-test [ 32 ] [ { int 8 } heap-size ] unit-test
@ -34,20 +34,20 @@ TYPEDEF: int MyInt
TYPEDEF: char MyChar 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 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 TYPEDEF: c-string MyString
[ t ] [ c-string c-type MyString c-type = ] unit-test [ t ] [ c-string lookup-c-type MyString lookup-c-type = ] unit-test
[ t ] [ void* c-type pointer: MyString c-type = ] unit-test [ t ] [ void* lookup-c-type pointer: MyString lookup-c-type = ] unit-test
TYPEDEF: int* MyIntArray 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 [ 0 ] [ -10 uchar c-type-clamp ] unit-test
[ 12 ] [ 12 uchar c-type-clamp ] unit-test [ 12 ] [ 12 uchar c-type-clamp ] unit-test
@ -57,8 +57,8 @@ TYPEDEF: int* MyIntArray
C-TYPE: opaque C-TYPE: opaque
[ t ] [ void* c-type pointer: opaque c-type = ] unit-test [ t ] [ void* lookup-c-type pointer: opaque lookup-c-type = ] unit-test
[ opaque c-type ] [ no-c-type? ] must-fail-with [ opaque lookup-c-type ] [ no-c-type? ] must-fail-with
[ """ [ """
USING: alien.syntax ; USING: alien.syntax ;
@ -70,8 +70,8 @@ C-TYPE: forward
STRUCT: backward { x forward* } ; STRUCT: backward { x forward* } ;
STRUCT: forward { x backward* } ; STRUCT: forward { x backward* } ;
[ t ] [ forward c-type struct-c-type? ] unit-test [ t ] [ forward lookup-c-type struct-c-type? ] unit-test
[ t ] [ backward c-type struct-c-type? ] unit-test [ t ] [ backward lookup-c-type struct-c-type? ] unit-test
DEFER: struct-redefined DEFER: struct-redefined

45
basis/alien/c-types/c-types.factor
View File

@ -42,7 +42,7 @@ ERROR: no-c-type word ;
M: no-c-type summary drop "Not a C type" ; M: no-c-type summary drop "Not a C type" ;
! C type protocol ! C type protocol
GENERIC: c-type ( name -- c-type ) foldable GENERIC: lookup-c-type ( name -- c-type ) foldable
PREDICATE: c-type-word < word PREDICATE: c-type-word < word
"c-type" word-prop ; "c-type" word-prop ;
@ -55,12 +55,13 @@ UNION: c-type-name
: resolve-typedef ( name -- c-type ) : resolve-typedef ( name -- c-type )
dup void? [ no-c-type ] when 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 dup "c-type" word-prop resolve-typedef
[ ] [ no-c-type ] ?if ; [ ] [ no-c-type ] ?if ;
GENERIC: c-type-class ( name -- class ) GENERIC: c-type-class ( name -- class )
M: abstract-c-type c-type-class 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 ) 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 ; M: c-type base-type ;
@ -148,7 +149,7 @@ PROTOCOL: c-type-protocol
heap-size ; heap-size ;
CONSULT: c-type-protocol c-type-name CONSULT: c-type-protocol c-type-name
c-type ; lookup-c-type ;
PREDICATE: typedef-word < c-type-word PREDICATE: typedef-word < c-type-word
"c-type" word-prop [ c-type-name? ] [ array? ] bi or ; "c-type" word-prop [ c-type-name? ] [ array? ] bi or ;
@ -212,8 +213,8 @@ CONSTANT: primitive-types
PRIVATE> PRIVATE>
M: pointer c-type M: pointer lookup-c-type
[ \ void* c-type ] dip [ \ void* lookup-c-type ] dip
to>> dup primitive-pointer-type? [ drop ] [ (pointer-c-type) ] if ; to>> dup primitive-pointer-type? [ drop ] [ (pointer-c-type) ] if ;
[ [
@ -363,18 +364,18 @@ M: pointer c-type
\ ulonglong typedef \ ulonglong typedef
os windows? [ os windows? [
\ int c-type \ long typedef \ int lookup-c-type \ long typedef
\ uint c-type \ ulong typedef \ uint lookup-c-type \ ulong typedef
] [ ] [
\ longlong c-type \ long typedef \ longlong lookup-c-type \ long typedef
\ ulonglong c-type \ ulong typedef \ ulonglong lookup-c-type \ ulong typedef
] if ] if
\ longlong c-type \ ptrdiff_t typedef \ longlong lookup-c-type \ ptrdiff_t typedef
\ longlong c-type \ intptr_t typedef \ longlong lookup-c-type \ intptr_t typedef
\ ulonglong c-type \ uintptr_t typedef \ ulonglong lookup-c-type \ uintptr_t typedef
\ ulonglong c-type \ size_t typedef \ ulonglong lookup-c-type \ size_t typedef
] [ ] [
<c-type> <c-type>
integer >>class integer >>class
@ -426,17 +427,17 @@ M: pointer c-type
[ >integer ] >>unboxer-quot [ >integer ] >>unboxer-quot
\ ulonglong typedef \ ulonglong typedef
\ int c-type \ long typedef \ int lookup-c-type \ long typedef
\ uint c-type \ ulong typedef \ uint lookup-c-type \ ulong typedef
\ int c-type \ ptrdiff_t typedef \ int lookup-c-type \ ptrdiff_t typedef
\ int c-type \ intptr_t typedef \ int lookup-c-type \ intptr_t typedef
\ uint c-type \ uintptr_t typedef \ uint lookup-c-type \ uintptr_t typedef
\ uint c-type \ size_t typedef \ uint lookup-c-type \ size_t typedef
] if ] 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 ] >>unboxer-quot
[ c-bool> ] >>boxer-quot [ c-bool> ] >>boxer-quot
object >>boxed-class object >>boxed-class

2
basis/alien/enums/enums.factor
View File

@ -22,7 +22,7 @@ M: word enum>number "enum-value" word-prop ;
PRIVATE> PRIVATE>
MACRO: number>enum ( enum-c-type -- ) 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-boxed-class drop object ;
M: enum-c-type c-type-boxer-quot members>> enum-boxer ; M: enum-c-type c-type-boxer-quot members>> enum-boxer ;

4
basis/alien/prettyprint/prettyprint.factor
View File

@ -124,7 +124,7 @@ M: enum-c-type-word synopsis*
[ seeing-word ] [ seeing-word ]
[ definer. ] [ definer. ]
[ pprint-word ] [ 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 ; } cleave ;
M: enum-c-type-word definition M: enum-c-type-word definition
c-type members>> ; lookup-c-type members>> ;

4
basis/classes/struct/struct-tests.factor
View File

@ -229,7 +229,7 @@ UNION-STRUCT: struct-test-float-and-bits
{ type bool } { type bool }
{ class object } { class object }
} }
} ] [ struct-test-foo c-type fields>> ] unit-test } ] [ struct-test-foo lookup-c-type fields>> ] unit-test
[ { [ {
T{ struct-slot-spec T{ struct-slot-spec
@ -246,7 +246,7 @@ UNION-STRUCT: struct-test-float-and-bits
{ class $[ cell 4 = integer fixnum ? ] } { class $[ cell 4 = integer fixnum ? ] }
{ initial 0 } { 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 STRUCT: struct-test-equality-1
{ x int } ; { x int } ;

7
basis/classes/struct/struct.factor
View File

@ -173,7 +173,8 @@ TUPLE: struct-c-type < abstract-c-type
INSTANCE: struct-c-type value-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 ; M: struct-c-type base-type ;
@ -274,7 +275,7 @@ M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inlin
bi ; bi ;
: check-struct-slots ( slots -- ) : check-struct-slots ( slots -- )
[ type>> c-type drop ] each ; [ type>> lookup-c-type drop ] each ;
: redefine-struct-tuple-class ( class -- ) : redefine-struct-tuple-class ( class -- )
[ struct f define-tuple-class ] [ make-final ] bi ; [ struct f define-tuple-class ] [ make-final ] bi ;
@ -318,7 +319,7 @@ PRIVATE>
ERROR: invalid-struct-slot token ; ERROR: invalid-struct-slot token ;
: struct-slot-class ( c-type -- class' ) : 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 ; dup \ byte-array = [ drop \ c-ptr ] when ;
M: struct-class reset-class M: struct-class reset-class

2
basis/cpu/x86/64/unix/unix.factor
View File

@ -27,7 +27,7 @@ M: x86.64 reserved-stack-space 0 ;
: flatten-small-struct ( c-type -- seq ) : flatten-small-struct ( c-type -- seq )
struct-types&offset split-struct [ 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 ? int-regs swap member? int-rep double-rep ?
f f 3array f f 3array
] map ; ] map ;

8
basis/stack-checker/alien/alien.factor
View File

@ -24,7 +24,7 @@ TUPLE: alien-assembly-params < alien-node-params { quot callable } ;
TUPLE: alien-callback-params < alien-node-params xt ; TUPLE: alien-callback-params < alien-node-params xt ;
: param-prep-quot ( params -- quot ) : 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 -- ) : alien-stack ( params extra -- )
over parameters>> length + consume-d >>in-d over parameters>> length + consume-d >>in-d
@ -32,7 +32,7 @@ TUPLE: alien-callback-params < alien-node-params xt ;
drop ; drop ;
: return-prep-quot ( params -- quot ) : 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 -- ) : infer-return ( params -- )
return-prep-quot infer-quot-here ; 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 ; xt>> '[ _ callback-xt { alien } declare ] infer-quot-here ;
: callback-return-quot ( ctype -- quot ) : 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 ) : callback-parameter-quot ( params -- quot )
parameters>> [ c-type ] map parameters>> [ lookup-c-type ] map
[ [ c-type-class ] map '[ _ declare ] ] [ [ c-type-class ] map '[ _ declare ] ]
[ [ c-type-boxer-quot ] map deep-spread>quot ] [ [ c-type-boxer-quot ] map deep-spread>quot ]
bi append ; bi append ;