mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-24 12:35:05 +02:00
WIP
This commit is contained in:
parent
41548f4d64
commit
a7c660d52a
1 changed files with 32 additions and 8 deletions
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue