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

WIP

Browse source
This commit is contained in:
Justin Ethier 2020-04-21 18:11:31 -04:00
parent 82d6379cdf
commit 3a9777735a
1 changed files with 27 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
test-foreign.scm
View file

@ -15,43 +15,53 @@
(cdr expr)) (cdr expr))
`(Cyc-foreign-code ,@(cdr expr))))) `(Cyc-foreign-code ,@(cdr expr)))))
(pretty-print ;(pretty-print
( ;(
;(define-syntax define-foreign-code (define-syntax define-foreign-code
; (er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (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))
(arg-types (cddddr expr)) (arg-types (cddddr expr))
(arg-syms (arg-syms/unbox
(map (map
(lambda (type) (lambda (type)
(mangle (gensym type))) (let ((var (mangle (gensym 'arg))))
(cons var (string-append "string_str(" var ")"))))
arg-types)) arg-types))
(arg-strings ;(arg-strings
(map ; (map
(lambda (sym) ; (lambda (sym)
(string-append " object " sym) ; (string-append " object " sym)
) ; )
arg-syms)) ; arg-syms))
; TODO: append mangled args to other args ; TODO: append mangled args to other args
; cyclone> (string-join '("a" "b" "c") ",") ; cyclone> (string-join '("a" "b" "c") ",")
; "a,b,c" ; "a,b,c"
(args "(void *data, int argc, closure _, object k)") (args (string-append
"(void *data, int argc, closure _, object k "
(apply string-append
(map
(lambda (sym/unbox)
(string-append "," (car sym/unbox)))
arg-syms/unbox))
")"))
(body (body
;; TODO: need to unbox all args, pass to C function, then box up the result ;; TODO: need to unbox all args, pass to C function, then box up the result
(string-append (string-append
"return_closcall1(data, k, obj_int2obj(" "str" "));")) "return_closcall1(data, k, obj_int2obj(" c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")));"))
) )
`((define-c ,scm-fnc ,args ,body) `((define-c ,scm-fnc ,args ,body)
))) )))
'(define-foreign-lambda scm-strlen int "strlen" string dummy dummy) ; '(define-foreign-lambda scm-strlen int "strlen" string)
list ; list
list) ; list)
) )
(define-foreign-lambda scm-strlen int "strlen" string)
(display (scm-strlen "testing 1, 2, 3"))
(newline) (newline)
;(define-c foreign-value ;(define-c foreign-value