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

Bug fixes

Browse source
This commit is contained in:
Justin Ethier 2020-05-11 21:28:52 -04:00
parent 9bd5a94ec4
commit b6509b442a
1 changed files with 8 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
libs/cyclone/foreign.sld
View file

@ -176,10 +176,12 @@
(scm-fnc-wrapper (gensym 'scm-fnc)) (scm-fnc-wrapper (gensym 'scm-fnc))
(c-fnc (cadddr expr)) (c-fnc (cadddr expr))
(rv-type (caddr expr)) (rv-type (caddr expr))
;; boolean - Are we returning a custom (user-defined) type?
(rv-cust-type (eval `(with-handler (rv-cust-type (eval `(with-handler
(lambda X #f) (lambda X #f)
(hash-table-ref *foreign-types* (quote ,rv-type)) (hash-table-ref *foreign-types* (quote ,rv-type))
))) )))
;; boolean - Does the custom return type have a conversion function?
(rv-cust-convert (rv-cust-convert
(if (and rv-cust-type (= 3 (length rv-cust-type))) (if (and rv-cust-type (= 3 (length rv-cust-type)))
(caddr rv-cust-type) (caddr rv-cust-type)
@ -218,16 +220,16 @@
return-alloc return-alloc
"return_closcall1(data, k, " return-expr ");")) "return_closcall1(data, k, " return-expr ");"))
) )
(if rv-cust-type (cond
(rv-cust-convert
(let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types))) (let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types)))
`(begin `(begin
(define-c ,scm-fnc-wrapper ,args ,body) (define-c ,scm-fnc-wrapper ,args ,body)
(define (,scm-fnc ,@arg-syms) (define (,scm-fnc ,@arg-syms)
(,rv-cust-convert TODO: if rv-cust-convert is not #f, (,rv-cust-convert
(,scm-fnc-wrapper ,@arg-syms))) (,scm-fnc-wrapper ,@arg-syms))))))
)) (else
`(define-c ,scm-fnc ,args ,body) `(define-c ,scm-fnc ,args ,body)))
)
)))) ))))
; '(c-define scm-strlen int "strlen" string) ; '(c-define scm-strlen int "strlen" string)
; list ; list