Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 13:05: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) (caddr rv-cust-type)
#f)) #f))
(arg-types (cddddr expr)) (arg-types (cddddr expr))
(arg-cust-convert #f)
(arg-syms/unbox (arg-syms/unbox
(map (map
(lambda (type) (lambda (type)
@ -200,9 +201,13 @@
var var
(scm->c (scm->c
var var
(if arg-cust-type (cond
(car arg-cust-type) (arg-cust-type
type)) (if (= 3 (length arg-cust-type))
(set! arg-cust-convert #t))
(car arg-cust-type))
(else
type)))
;(string-append "string_str(" var ")") ;(string-append "string_str(" var ")")
))) )))
arg-types)) arg-types))
@ -230,15 +235,32 @@
"return_closcall1(data, k, " return-expr ");")) "return_closcall1(data, k, " return-expr ");"))
) )
(cond (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. ;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 ; also need to handle case where there are custom arg conversion but not a custom return type conversion
(rv-cust-convert ((or rv-cust-convert arg-cust-convert)
(let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types))) (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 `(begin
(define-c ,scm-fnc-wrapper ,args ,body) (define-c ,scm-fnc-wrapper ,args ,body)
(define (,scm-fnc ,@arg-syms) (define (,scm-fnc ,@(map car arg-syms))
(,rv-cust-convert (,rv-cust-convert
(,scm-fnc-wrapper ,@arg-syms)))))) (,scm-fnc-wrapper ,@(map cdr arg-syms)))))))
(else (else
`(define-c ,scm-fnc ,args ,body))) `(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-string string)
(c-define-type my-integer integer) (c-define-type my-integer integer)
(c-define-type my-integer-as-string integer string->number number->string) (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-group "foreign value"
(test 3 (c-value "1 + 2" integer)) (test 3 (c-value "1 + 2" integer))
@ -43,11 +44,13 @@
;(c-define scm-strlen "int" "strlen" string) ;(c-define scm-strlen "int" "strlen" string)
(c-define scm-strlend double "strlen" string) (c-define scm-strlend double "strlen" string)
(c-define scm-strlen2 integer "strlen" my-string) (c-define scm-strlen2 integer "strlen" my-string)
(c-define scm-strlen3 integer "strlen" my-integer-as-string)
(test-group "foreign lambda" (test-group "foreign lambda"
(test 15 (scm-strlen "testing 1, 2, 3")) (test 15 (scm-strlen "testing 1, 2, 3"))
(test 15 (scm-strlen2 "testing 1, 2, 3")) (test 15 (scm-strlen2 "testing 1, 2, 3"))
(test 15.0 (scm-strlend "testing 1, 2, 3")) (test 15.0 (scm-strlend "testing 1, 2, 3"))
(test "15" (scm-strlen-str "testing 1, 2, 3")) (test "15" (scm-strlen-str "testing 1, 2, 3"))
(test 3 (scm-strlen3 255))
) )
(test-exit) (test-exit)