stack-checker.alien: generate a declaration for input parameter types

diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index 4947cb365d544b9c269e4382ec67b76750090b5b..2c5c469201708b6186e795a63830d1373ac7e2ec 100644 (file)
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -526,3 +526,18 @@ USING: alien alien.c-types ;
     [ int { } cdecl [ 2 2 + ] alien-callback ]
     { + } inlined?
 ] 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

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index 5489db00ab1643ef03dec630b01f8ca5a88c6d0c..6e9314792fa1433745905dc9d0a4fe7c95d5a79e 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -6,6 +6,7 @@ alien.private alien.c-types fry quotations strings
 stack-checker.backend stack-checker.errors stack-checker.visitor
 stack-checker.dependencies stack-checker.state
 compiler.utilities effects ;
+FROM: kernel.private => declare ;
 IN: stack-checker.alien
 
 TUPLE: alien-node-params
@@ -113,13 +114,16 @@ TUPLE: alien-callback-params < alien-node-params xt ;
 : callback-return-quot ( ctype -- quot )
     return>> [ [ ] ] [ c-type c-type-unboxer-quot ] if-void ;
 
-: callback-prep-quot ( params -- quot )
-    parameters>> [ c-type c-type-boxer-quot ] map spread>quot ;
+: callback-parameter-quot ( params -- 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' )
 
 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
     '[ _ _ do-callback ]
     >quotation ;