Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 08:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Allow c-values to support ret-convert from c-define-type

Browse source
This commit is contained in:
Justin Ethier 2020-05-10 18:41:04 -04:00
parent 4a6919e153
commit ab6ee6c16d
2 changed files with 13 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
libs/cyclone/foreign.sld
View file

@ -32,7 +32,7 @@
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
(let ((name (cadr expr)) (let ((name (cadr expr))
(type (caddr expr))) (type (cddr expr)))
(unless (eval '(with-handler (lambda X #f) *foreign-types*)) (unless (eval '(with-handler (lambda X #f) *foreign-types*))
(write "no foreign type table" (current-error-port)) (write "no foreign type table" (current-error-port))
(newline (current-error-port)) (newline (current-error-port))
@ -49,18 +49,26 @@
(lambda X #f) (lambda X #f)
(hash-table-ref *foreign-types* (quote ,type-arg)) (hash-table-ref *foreign-types* (quote ,type-arg))
))) )))
(c-ret-convert #f)
) )
(when c-type (when c-type
(write `(defined c type ,c-type) (current-error-port)) (write `(defined c type ,c-type) (current-error-port))
(newline (current-error-port)) (newline (current-error-port))
(set! type-arg c-type)) (set! type-arg (car c-type))
(if (= 3 (length c-type))
(set! c-ret-convert (caddr c-type))))
;(for-each ;(for-each
; (lambda (arg) ; (lambda (arg)
; (if (not (string? arg)) ; (if (not (string? arg))
; (error "c-value" "Invalid argument: string expected, received " arg))) ; (error "c-value" "Invalid argument: string expected, received " arg)))
; (cdr expr)) ; (cdr expr))
`((lambda () (Cyc-foreign-value ,code-arg ,(symbol->string type-arg))))))))
(if c-ret-convert
`((lambda () (,c-ret-convert (Cyc-foreign-value ,code-arg ,(symbol->string type-arg)))))
`((lambda () (Cyc-foreign-value ,code-arg ,(symbol->string type-arg))))
)
))))
(define-syntax c-code (define-syntax c-code
(er-macro-transformer (er-macro-transformer

3
libs/test-foreign.scm
View file

@ -12,11 +12,12 @@
(define *my-global* #f) (define *my-global* #f)
(c-define-type my-integer integer) (c-define-type my-integer integer)
(c-define-type my-integer2 integer) (c-define-type my-integer-as-string integer string->number number->string)
(test-group "foreign value" (test-group "foreign value"
(test 3 (c-value "1 + 2" integer)) (test 3 (c-value "1 + 2" integer))
(test 4 (c-value "2 + 2" my-integer)) (test 4 (c-value "2 + 2" my-integer))
(test "4" (c-value "2 + 2" my-integer-as-string))
) )
(test-group "foreign code" (test-group "foreign code"