Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 04:25:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Convert functions to macros

Browse source
This commit is contained in:
Justin Ethier 2020-04-28 15:56:32 -04:00
parent 739486b9e3
commit c747e8c8e1
1 changed files with 47 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
test-foreign.scm
View file

@ -2,7 +2,6 @@
(scheme base) (scheme base)
(scheme write) (scheme write)
(cyclone test) (cyclone test)
(scheme cyclone cgen)
(scheme cyclone util) (scheme cyclone util)
(scheme cyclone pretty-print)) (scheme cyclone pretty-print))
@ -16,14 +15,6 @@
(cdr expr)) (cdr expr))
`(Cyc-foreign-code ,@(cdr expr))))) `(Cyc-foreign-code ,@(cdr expr)))))
;(pretty-print (
(define-syntax define-foreign-lambda
(er-macro-transformer
(lambda (expr rename compare)
;; Temporary definition, this does not stay here!
;; TODO: extract these out, probably into cgen!
;; Unbox scheme object ;; Unbox scheme object
;; ;;
;; scm->c :: string -> symbol -> string ;; scm->c :: string -> symbol -> string
@ -33,16 +24,21 @@
;; - type - Data type of the Scheme object ;; - type - Data type of the Scheme object
;; Returns: ;; Returns:
;; - C code used to unbox the data ;; - C code used to unbox the data
(define (scm->c code type) ;(define (scm->c code type)
(case type (define-syntax scm->c
(er-macro-transformer
(lambda (expr rename compare)
(let ((code (cadr expr))
(type (caddr expr)))
`(case ,type
((int integer) ((int integer)
(string-append "obj_obj2int(" code ")")) (string-append "obj_obj2int(" ,code ")"))
((bool) ((bool)
(string-append "(" code " == boolean_f)")) (string-append "(" ,code " == boolean_f)"))
((string) ((string)
(string-append "string_str(" code ")")) (string-append "string_str(" ,code ")"))
(else (else
(error "scm->c unable to convert scheme object of type " 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)
;; ;;
@ -54,32 +50,39 @@
;; Returns: ;; Returns:
;; - Allocation code? ;; - Allocation code?
;; - C code ;; - C code
(define (c->scm code type) (define-syntax c->scm
(case type (er-macro-transformer
(lambda (expr rename compare)
(let ((code (cadr expr))
(type (caddr expr)))
`(case ,type
((int integer) ((int integer)
(cons (cons
"" ""
(string-append "obj_int2obj(" code ")"))) (string-append "obj_int2obj(" ,code ")")))
((float double) ((float double)
(let ((var (mangle (gensym 'var)))) (let ((var (mangle (gensym 'var))))
(cons (cons
(string-append (string-append
"make_double(" var ", " code ");") "make_double(" var ", " ,code ");")
(string-append "&" var) (string-append "&" var)
))) )))
((bool) ((bool)
(cons (cons
"" ""
(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?
; may need to return a c-code pair??? ; may need to return a c-code pair???
; (string-append " ; (string-append "
; )) ; ))
(else (else
(error "c->scm unable to convert C object of type " type)))) (error "c->scm unable to convert C object of type " ,type)))))))
;(pretty-print (
(define-syntax define-foreign-lambda
(er-macro-transformer
(lambda (expr rename compare)
(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))