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-12 17:51:47 -04:00
parent a7bdb80964
commit 1bd664b813
2 changed files with 34 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
libs/cyclone/foreign.sld
View file

@ -187,6 +187,7 @@
(caddr rv-cust-type)
#f))
(arg-types (cddddr expr))
(arg-cust-convert #f)
(arg-syms/unbox
(map
(lambda (type)
@ -200,9 +201,13 @@
var
(scm->c
var
(if arg-cust-type
(car arg-cust-type)
type))
(cond
(arg-cust-type
(if (= 3 (length arg-cust-type))
(set! arg-cust-convert #t))
(car arg-cust-type))
(else
type)))
;(string-append "string_str(" var ")")
)))
arg-types))
@ -230,15 +235,32 @@
"return_closcall1(data, k, " return-expr ");"))
)
(cond
TODO: need to know if there any custom types for args with an arg-convert function, and need to handle those in case below.
also need to handle case where there are custom arg conversion but not a custom return type conversion
(rv-cust-convert
(let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types)))
;TODO: need to know if there any custom types for args with an arg-convert function, and need to handle those in case below.
; also need to handle case where there are custom arg conversion but not a custom return type conversion
((or rv-cust-convert arg-cust-convert)
(if (not rv-cust-convert)
(set! rv-cust-convert 'begin))
(let ((arg-syms
(map
(lambda (type)
(let* ((sym (gensym 'arg))
(arg-cust-type (eval `(with-handler
(lambda X #f)
(hash-table-ref *foreign-types* (quote ,type)))))
(pass-arg
(if (and arg-cust-type
(= 3 (length arg-cust-type)))
`(,(caddr arg-cust-type) ,sym)
sym)) )
(cons
sym ;; Arg
pass-arg)));; Passing arg to internal func
arg-types)))
`(begin
(define-c ,scm-fnc-wrapper ,args ,body)
(define (,scm-fnc ,@arg-syms)
(define (,scm-fnc ,@(map car arg-syms))
(,rv-cust-convert
(,scm-fnc-wrapper ,@arg-syms))))))
(,scm-fnc-wrapper ,@(map cdr arg-syms)))))))
(else
`(define-c ,scm-fnc ,args ,body)))
))))

3
libs/test-foreign.scm
View file

@ -14,6 +14,7 @@
(c-define-type my-string string)
(c-define-type my-integer integer)
(c-define-type my-integer-as-string integer string->number number->string)
(c-define-type string-as-integer string number->string string->number)
(test-group "foreign value"
(test 3 (c-value "1 + 2" integer))
@ -43,11 +44,13 @@
;(c-define scm-strlen "int" "strlen" string)
(c-define scm-strlend double "strlen" string)
(c-define scm-strlen2 integer "strlen" my-string)
(c-define scm-strlen3 integer "strlen" my-integer-as-string)
(test-group "foreign lambda"
(test 15 (scm-strlen "testing 1, 2, 3"))
(test 15 (scm-strlen2 "testing 1, 2, 3"))
(test 15.0 (scm-strlend "testing 1, 2, 3"))
(test "15" (scm-strlen-str "testing 1, 2, 3"))
(test 3 (scm-strlen3 255))
)
(test-exit)