This commit is contained in:
Justin Ethier 2020-04-22 19:13:21 -04:00
parent 41548f4d64
commit a7c660d52a

View file

@ -20,6 +20,19 @@
(define-syntax define-foreign-lambda (define-syntax define-foreign-lambda
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
;; Temporary definition, this does not stay here!
(define (scm->c code type)
(case type
((int integer)
(string-append "obj_obj2int(" code ")"))
((bool)
(string-append "(" code " == boolean_f)"))
((string)
(string-append "string_str(" code ")"))
(else
(error "scm->c unable to convert scheme object of type " type))))
(let* ((scm-fnc (cadr expr)) (let* ((scm-fnc (cadr expr))
(c-fnc (cadddr expr)) (c-fnc (cadddr expr))
(rv-type (caddr expr)) (rv-type (caddr expr))
@ -28,7 +41,11 @@
(map (map
(lambda (type) (lambda (type)
(let ((var (mangle (gensym 'arg)))) (let ((var (mangle (gensym 'arg))))
(cons var (string-append "string_str(" var ")")))) (cons
var
(scm->c var type)
;(string-append "string_str(" var ")")
)))
arg-types)) arg-types))
;(arg-strings ;(arg-strings
; (map ; (map
@ -64,9 +81,15 @@
;; Unbox scheme object ;; Unbox scheme object
(define (scm->c code type) (define (scm->c code type)
(cond (case type
((int integer)
(string-append "obj_obj2int(" code ")"))
((bool)
(string-append "(" code " == boolean_f)"))
((string)
(string-append "string_str(" code ")"))
(else (else
(error "scm->c unable to convert" type)))) (error "scm->c unable to convert scheme object of type " type))))
;; Box C object, basically the meat of (foreign-value) ;; Box C object, basically the meat of (foreign-value)
(define (c->scm code type) (define (c->scm code type)
@ -75,12 +98,13 @@
(string-append "obj_int2obj(" code ")")) (string-append "obj_int2obj(" code ")"))
((bool) ((bool)
(string-append "(" code " == 0 ? boolean_f : boolean_t)")) (string-append "(" code " == 0 ? boolean_f : boolean_t)"))
((string) ; ((string)
TODO: how to handle the allocation here? ; TODO: how to handle the allocation here?
(string-append " ; may need to return a c-code pair???
)) ; (string-append "
; ))
(else (else
(error "c->scm unable to convert" type)))) (error "c->scm unable to convert C object of type " type))))
;(define-c foreign-value ;(define-c foreign-value