alien.parser: make make-callback-type have the same signature as make-function
parent
6f705c4944
commit
69f667edc8
|
@ -1,38 +1,47 @@
|
||||||
! (c)2009 Joe Groff bsd license
|
! (c)2009 Joe Groff bsd license
|
||||||
USING: accessors alien.c-types alien.parser alien.syntax
|
USING: accessors alien.c-types alien.parser alien.parser.private
|
||||||
compiler.units continuations debugger eval kernel namespaces parser
|
alien.syntax compiler.units continuations debugger eval fry kernel
|
||||||
sequences sets tools.test vocabs.parser words ;
|
lexer namespaces parser sequences sets tools.test vocabs.parser words
|
||||||
|
;
|
||||||
IN: alien.parser.tests
|
IN: alien.parser.tests
|
||||||
|
|
||||||
|
: with-parsing ( lines quot -- )
|
||||||
|
[ <lexer> ] [ '[ _ with-compilation-unit ] ] bi* with-lexer ; inline
|
||||||
|
|
||||||
! (CREATE-C-TYPE)
|
! (CREATE-C-TYPE)
|
||||||
{ "hello" } [
|
{ "hello" } [
|
||||||
[ "hello" (CREATE-C-TYPE) ] with-compilation-unit
|
{ "hello" } [ CREATE-C-TYPE name>> ] with-parsing
|
||||||
name>>
|
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! Check that it deletes from old-definitions
|
! Check that it deletes from old-definitions
|
||||||
{ 0 } [
|
{ 0 } [
|
||||||
[
|
{ } [
|
||||||
"hello" current-vocab create-word
|
"hello" current-vocab create-word
|
||||||
old-definitions get first adjoin
|
old-definitions get first adjoin
|
||||||
"hello" (CREATE-C-TYPE) drop
|
"hello" (CREATE-C-TYPE) drop
|
||||||
old-definitions get first cardinality
|
old-definitions get first cardinality
|
||||||
] with-compilation-unit
|
] with-parsing
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! make-callback-type
|
! make-callback-type
|
||||||
{ "what-type" } [
|
{ "what-type" } [
|
||||||
[ f void "what-type" { } { } make-callback-type ] with-compilation-unit
|
{ } [
|
||||||
2drop name>>
|
void "what-type" f { } { } make-callback-type 2drop name>>
|
||||||
|
] with-parsing
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ 0 } [
|
{ 0 } [
|
||||||
[
|
{ } [
|
||||||
"hello" current-vocab create-word
|
"hello" current-vocab create-word
|
||||||
old-definitions get first adjoin
|
old-definitions get first adjoin
|
||||||
f void "hello" { } { } make-callback-type 3drop
|
void "hello" f { } { } make-callback-type 3drop
|
||||||
old-definitions get first cardinality
|
old-definitions get first cardinality
|
||||||
] with-compilation-unit
|
] with-parsing
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! parse-enum-name
|
||||||
|
{ t } [
|
||||||
|
{ "ayae" } [ parse-enum-name new-definitions get first in? ] with-parsing
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
TYPEDEF: char char2
|
TYPEDEF: char char2
|
||||||
|
|
|
@ -145,16 +145,15 @@ PRIVATE>
|
||||||
: callback-quot ( return types abi -- quot )
|
: callback-quot ( return types abi -- quot )
|
||||||
'[ [ _ _ _ ] dip alien-callback ] ;
|
'[ [ _ _ _ ] dip alien-callback ] ;
|
||||||
|
|
||||||
:: make-callback-type ( lib return type-name types names -- word quot effect )
|
:: make-callback-type ( return function library types names -- word quot effect )
|
||||||
type-name (CREATE-C-TYPE) :> type-word
|
function (CREATE-C-TYPE) :> type-word
|
||||||
void* type-word typedef
|
void* type-word typedef
|
||||||
type-word names return function-effect "callback-effect" set-word-prop
|
type-word names return function-effect "callback-effect" set-word-prop
|
||||||
type-word lib "callback-library" set-word-prop
|
type-word library "callback-library" set-word-prop
|
||||||
type-word return types lib library-abi callback-quot ( quot -- alien ) ;
|
type-word return types library library-abi callback-quot ( quot -- alien ) ;
|
||||||
|
|
||||||
: (CALLBACK:) ( -- word quot effect )
|
: (CALLBACK:) ( -- word quot effect )
|
||||||
current-library get
|
(FUNCTION:) make-callback-type ;
|
||||||
scan-function-name scan-c-args make-callback-type ;
|
|
||||||
|
|
||||||
PREDICATE: alien-function-alias-word < word
|
PREDICATE: alien-function-alias-word < word
|
||||||
def>> {
|
def>> {
|
||||||
|
|
|
@ -180,9 +180,9 @@ M: type type>data-type
|
||||||
|
|
||||||
: def-callback-type ( callback -- )
|
: def-callback-type ( callback -- )
|
||||||
{
|
{
|
||||||
[ drop current-library get ]
|
|
||||||
[ return>> return-c-type ]
|
[ return>> return-c-type ]
|
||||||
[ c-type>> ]
|
[ c-type>> ]
|
||||||
|
[ drop current-library get ]
|
||||||
[ ?suffix-parameters-with-error parameter-names&types ]
|
[ ?suffix-parameters-with-error parameter-names&types ]
|
||||||
} cleave make-callback-type define-inline ;
|
} cleave make-callback-type define-inline ;
|
||||||
|
|
||||||
|
@ -258,9 +258,9 @@ M: array-type field-type>c-type type>c-type ;
|
||||||
|
|
||||||
:: def-signal ( signal type -- )
|
:: def-signal ( signal type -- )
|
||||||
signal {
|
signal {
|
||||||
[ drop current-library get ]
|
|
||||||
[ return>> return-c-type ]
|
[ return>> return-c-type ]
|
||||||
[ type signal-name ]
|
[ type signal-name ]
|
||||||
|
[ drop current-library get ]
|
||||||
[
|
[
|
||||||
parameters>> type type>parameter prefix
|
parameters>> type type>parameter prefix
|
||||||
user-data-parameter suffix parameter-names&types
|
user-data-parameter suffix parameter-names&types
|
||||||
|
|
Loading…
Reference in New Issue