~ chicken-core (chicken-5) 90e27f3bca6a79d0cf30d7b7ceba73d1d6751f75
commit 90e27f3bca6a79d0cf30d7b7ceba73d1d6751f75
Author: megane <meganeka@gmail.com>
AuthorDate: Sun Dec 1 09:50:18 2019 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Fri Dec 27 10:43:21 2019 -0600
chicken-ffi-syntax.scm: Convert foreign-primitive to use annotate-foreign-procedure
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/chicken-ffi-syntax.scm b/chicken-ffi-syntax.scm
index e11a6a28..b6ec4d5b 100644
--- a/chicken-ffi-syntax.scm
+++ b/chicken-ffi-syntax.scm
@@ -217,8 +217,11 @@
`(##core#the
(procedure ,(map (cut chicken.compiler.support#foreign-type->scrutiny-type <> 'arg)
(chicken.syntax#strip-syntax argtypes))
- ,(chicken.compiler.support#foreign-type->scrutiny-type
- (chicken.syntax#strip-syntax rtype) 'result))
+ ,@(if rtype
+ (list (chicken.compiler.support#foreign-type->scrutiny-type
+ (chicken.syntax#strip-syntax rtype) 'result))
+ ;; special case for C_values(...). Only triggered by foreign-primitive.
+ '*))
#f
,e))
@@ -245,17 +248,12 @@
(lambda (form r c)
(##sys#check-syntax 'foreign-primitive form '(_ _ . _))
(let* ((hasrtype (and (pair? (cddr form)) (not (string? (caddr form)))))
- (rtype (and hasrtype (chicken.syntax#strip-syntax (cadr form))))
- (args (chicken.syntax#strip-syntax (if hasrtype (caddr form) (cadr form))))
+ (rtype (and hasrtype (cadr form)))
+ (args (if hasrtype (caddr form) (cadr form)))
(argtypes (map car args)))
- `(##core#the (procedure
- ,(map (cut chicken.compiler.support#foreign-type->scrutiny-type <> 'arg)
- argtypes)
- ,@(if (not rtype)
- '* ; special case for C_values(...)
- (list (chicken.compiler.support#foreign-type->scrutiny-type rtype 'result))))
- #f
- (##core#foreign-primitive ,@(cdr form)))))))
+ (annotate-foreign-procedure `(##core#foreign-primitive ,@(cdr form))
+ argtypes
+ rtype)))))
(##sys#extend-macro-environment
'foreign-lambda
Trap