Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2020-05-11 17:43:36 -04:00
parent 1c7e03e9d1
commit 9bd5a94ec4
2 changed files with 25 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
libs/cyclone/foreign.sld
View file

@ -173,8 +173,17 @@
(er-macro-transformer
(lambda (expr rename compare)
(let* ((scm-fnc (cadr expr))
(scm-fnc-wrapper (gensym 'scm-fnc))
(c-fnc (cadddr expr))
(rv-type (caddr expr))
(rv-cust-type (eval `(with-handler
(lambda X #f)
(hash-table-ref *foreign-types* (quote ,rv-type))
)))
(rv-cust-convert
(if (and rv-cust-type (= 3 (length rv-cust-type)))
(caddr rv-cust-type)
#f))
(arg-types (cddddr expr))
(arg-syms/unbox
(map
@ -190,7 +199,9 @@
(c->scm
(string-append
c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")")
rv-type))
(if rv-cust-type
(car rv-cust-type)
rv-type)))
(return-alloc (car returns))
(return-expr (cdr returns))
(args (string-append
@ -207,7 +218,16 @@
return-alloc
"return_closcall1(data, k, " return-expr ");"))
)
`(define-c ,scm-fnc ,args ,body)
(if rv-cust-type
(let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types)))
`(begin
(define-c ,scm-fnc-wrapper ,args ,body)
(define (,scm-fnc ,@arg-syms)
(,rv-cust-convert TODO: if rv-cust-convert is not #f,
(,scm-fnc-wrapper ,@arg-syms)))
))
`(define-c ,scm-fnc ,args ,body)
)
))))
; '(c-define scm-strlen int "strlen" string)
; list

6
libs/test-foreign.scm
View file

@ -33,9 +33,9 @@
;; Must be top-level
TODO: support custom types (arg and ret) for c-define.
Also need to be able to support arg/ret convert optional type arguments
Would need to generate scheme wrappers to handle these conversions
;TODO: support custom types (arg and ret) for c-define.
; Also need to be able to support arg/ret convert optional type arguments
; Would need to generate scheme wrappers to handle these conversions
(c-define scm-strlen my-integer "strlen" string)
;(c-define scm-strlen "int" "strlen" string)