Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 00:07:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Issue #370 - Added type checking to c-define

Browse source
This commit is contained in:
Justin Ethier 2021-01-26 22:50:42 -05:00
parent e06cd94354
commit d435ec6728
1 changed files with 35 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
libs/cyclone/foreign.sld
View file

@ -197,6 +197,32 @@
(define-syntax c-define
(er-macro-transformer
(lambda (expr rename compare)
(define (emit-type-check arg type)
(case type
((int integer)
(string-append "Cyc_check_fixnum(data," arg ");"))
((double float)
(string-append "Cyc_check_double(data," arg ");"))
((bignum bigint)
(string-append "Cyc_check_type(data,Cyc_is_bignum,bignum_tag," arg ");"))
((bool)
(string-append "Cyc_check_type(data,Cyc_is_boolean,boolean_tag," arg ");"))
((char)
(string-append
" if ((boolean_f == make_boolean(obj_is_char(" arg ")))) {"
"Cyc_rt_raise2(data, \"Invalid type: expected char, found \", " arg "); } "))
((string)
(string-append "Cyc_check_str(data," arg ");"))
((symbol)
(string-append "Cyc_check_sym(data," arg ");"))
((bytevector)
(string-append "Cyc_check_bvec(data," arg ");"))
((opaque)
(string-append "Cyc_check_opaque(data," arg ");"))
((c-void)
(string-append "Cyc_check_type(data,Cyc_is_void,void_tag," arg ");"))
(else "")))
(let* ((scm-fnc (cadr expr))
(scm-fnc-wrapper (gensym 'scm-fnc))
(c-fnc (cadddr expr))
@ -253,8 +279,17 @@
(string-append ", object " (car sym/unbox)))
arg-syms/unbox))
")"))
(type-checks
(apply
string-append
(map
(lambda (arg type)
(emit-type-check arg type))
(map car arg-syms/unbox)
arg-types) ))
(body
(string-append
type-checks
return-alloc
"return_closcall1(data, k, " return-expr ");"))
)