stack-checker.alien: generate a declaration for input parameter types
parent
fd1aad71bd
commit
723d780703
|
|
@ -526,3 +526,18 @@ USING: alien alien.c-types ;
|
||||||
[ int { } cdecl [ 2 2 + ] alien-callback ]
|
[ int { } cdecl [ 2 2 + ] alien-callback ]
|
||||||
{ + } inlined?
|
{ + } inlined?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
[ double { double double } cdecl [ + ] alien-callback ]
|
||||||
|
\ + inlined?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ f ] [
|
||||||
|
[ double { double double } cdecl [ + ] alien-callback ]
|
||||||
|
\ float+ inlined?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ f ] [
|
||||||
|
[ char { char char } cdecl [ + ] alien-callback ]
|
||||||
|
\ fixnum+fast inlined?
|
||||||
|
] unit-test
|
||||||
|
|
|
||||||
|
|
@ -6,6 +6,7 @@ alien.private alien.c-types fry quotations strings
|
||||||
stack-checker.backend stack-checker.errors stack-checker.visitor
|
stack-checker.backend stack-checker.errors stack-checker.visitor
|
||||||
stack-checker.dependencies stack-checker.state
|
stack-checker.dependencies stack-checker.state
|
||||||
compiler.utilities effects ;
|
compiler.utilities effects ;
|
||||||
|
FROM: kernel.private => declare ;
|
||||||
IN: stack-checker.alien
|
IN: stack-checker.alien
|
||||||
|
|
||||||
TUPLE: alien-node-params
|
TUPLE: alien-node-params
|
||||||
|
|
@ -113,13 +114,16 @@ TUPLE: alien-callback-params < alien-node-params xt ;
|
||||||
: callback-return-quot ( ctype -- quot )
|
: callback-return-quot ( ctype -- quot )
|
||||||
return>> [ [ ] ] [ c-type c-type-unboxer-quot ] if-void ;
|
return>> [ [ ] ] [ c-type c-type-unboxer-quot ] if-void ;
|
||||||
|
|
||||||
: callback-prep-quot ( params -- quot )
|
: callback-parameter-quot ( params -- quot )
|
||||||
parameters>> [ c-type c-type-boxer-quot ] map spread>quot ;
|
parameters>> [ c-type ] map
|
||||||
|
[ [ c-type-class ] map '[ _ declare ] ]
|
||||||
|
[ [ c-type-boxer-quot ] map spread>quot ]
|
||||||
|
bi append ;
|
||||||
|
|
||||||
GENERIC: wrap-callback-quot ( params quot -- quot' )
|
GENERIC: wrap-callback-quot ( params quot -- quot' )
|
||||||
|
|
||||||
M: callable wrap-callback-quot
|
M: callable wrap-callback-quot
|
||||||
swap [ callback-prep-quot ] [ callback-return-quot ] bi surround
|
swap [ callback-parameter-quot ] [ callback-return-quot ] bi surround
|
||||||
yield-hook get
|
yield-hook get
|
||||||
'[ _ _ do-callback ]
|
'[ _ _ do-callback ]
|
||||||
>quotation ;
|
>quotation ;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue