Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-21 22:59:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

[No code change] Formatted foreign.sld and removed unused commented code

Browse source
This commit is contained in:
Arthur Maciel 2021-01-30 17:19:58 -03:00
parent f5ad1ca6a2
commit b4febc8073
1 changed files with 258 additions and 291 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
libs/cyclone/foreign.sld
View file

@ -10,21 +10,15 @@
(import
(scheme base)
(scheme eval)
(scheme cyclone util)
;(scheme write) ;; TODO: debugging only!
)
(scheme cyclone util))
(export
c-code
c-value
c-define
c->scm
scm->c
c-define-type
)
c-define-type)
(begin
;;
;;(eval `(define *foreign-types* (list)))
;; (c-define-type name type (pack (unpack)))
(define-syntax c-define-type
(er-macro-transformer
@ -37,8 +31,6 @@
;; handlers to check if variables are defined in that environment.
;;
(unless (eval '(with-handler (lambda X #f) *foreign-types*))
;(write "no foreign type table" (current-error-port))
;(newline (current-error-port))
(eval `(define *foreign-types* (make-hash-table))))
(eval `(hash-table-set! *foreign-types* (quote ,name) (quote ,type)))
#f))))
@ -50,28 +42,15 @@
(type-arg (caddr expr))
(c-type (eval `(with-handler
(lambda X #f)
(hash-table-ref *foreign-types* (quote ,type-arg))
)))
(c-ret-convert #f)
)
(hash-table-ref *foreign-types* (quote ,type-arg)))))
(c-ret-convert #f))
(when c-type
;(write `(defined c type ,c-type) (current-error-port))
;(newline (current-error-port))
(set! type-arg (car c-type))
(if (= 3 (length c-type))
(set! c-ret-convert (caddr c-type))))
;(for-each
; (lambda (arg)
; (if (not (string? arg))
; (error "c-value" "Invalid argument: string expected, received " arg)))
; (cdr expr))
(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))))
)
))))
`((lambda () (Cyc-foreign-value ,code-arg ,(symbol->string type-arg)))))))))
(define-syntax c-code
(er-macro-transformer
@ -151,8 +130,7 @@
(cons
(string-append
"make_double(" var ", " ,code ");")
(string-append "&" var)
)))
(string-append "&" var))))
((bignum bigint)
(let ((var (mangle (gensym 'var))))
(cons
@ -173,16 +151,14 @@
(cons
(string-append
"make_utf8_string(data," var ", " ,code ");")
(string-append "&" var)
)))
(string-append "&" var))))
((bytevector)
(let ((var (mangle (gensym 'var))))
(cons
(string-append
"make_empty_bytevector(" var ");"
var "->data = " ,code ";")
(string-append "&" var)
)))
(string-append "&" var))))
((opaque)
(let ((var (mangle (gensym 'var))))
(cons
@ -247,9 +223,7 @@
(let ((var (mangle (gensym 'arg)))
(arg-cust-type (eval `(with-handler
(lambda X #f)
(hash-table-ref *foreign-types* (quote ,type))
)))
)
(hash-table-ref *foreign-types* (quote ,type))))))
(cons
var
(scm->c
@ -260,9 +234,7 @@
(set! arg-cust-convert #t))
(car arg-cust-type))
(else
type)))
;(string-append "string_str(" var ")")
)))
type))))))
arg-types))
(returns
(c->scm
@ -296,8 +268,7 @@
(string-append
type-checks
return-alloc
"return_closcall1(data, k, " return-expr ");"))
)
"return_closcall1(data, k, " return-expr ");")))
(cond
;; If there are any custom type conversion functions we need to create
;; a wrapper function in Scheme to perform those conversions
@ -327,8 +298,4 @@
(,scm-fnc-wrapper ,@(map cdr arg-syms)))))))
;; Simpler case, just define the function directly
(else
`(define-c ,scm-fnc ,args ,body)))
))))
)
)
`(define-c ,scm-fnc ,args ,body)))))))))