Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 12:35: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 (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
(let* ((scm-fnc (cadr expr)) (let* ((scm-fnc (cadr expr))
(scm-fnc-wrapper (gensym 'scm-fnc))
(c-fnc (cadddr expr)) (c-fnc (cadddr expr))
(rv-type (caddr 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-types (cddddr expr))
(arg-syms/unbox (arg-syms/unbox
(map (map
@ -190,7 +199,9 @@
(c->scm (c->scm
(string-append (string-append
c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")") 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-alloc (car returns))
(return-expr (cdr returns)) (return-expr (cdr returns))
(args (string-append (args (string-append
@ -207,7 +218,16 @@
return-alloc return-alloc
"return_closcall1(data, k, " return-expr ");")) "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) ; '(c-define scm-strlen int "strlen" string)
; list ; list

6
libs/test-foreign.scm
View file

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