Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Also tracking slot names for FFI types.

Browse source
This commit is contained in:
Alex Shinn 2014-12-13 16:04:07 +09:00
parent 7f3c503dcd
commit b7265fcc49
1 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
tools/chibi-ffi
View file

@ -1507,14 +1507,19 @@
" tmp = sexp_string_to_symbol(ctx, name);\n" " tmp = sexp_string_to_symbol(ctx, name);\n"
" sexp_env_define(ctx, env, tmp, " (type-id-name name) ");\n") " sexp_env_define(ctx, env, tmp, " (type-id-name name) ");\n")
(if (pair? (struct-fields type)) (if (pair? (struct-fields type))
(let ((len (make-integer (length (struct-fields type)))) (let ((len (make-integer (length (struct-fields type)))))
(getters (string-append "sexp_type_getters(" (cat " sexp_type_slots(" (type-id-name name) ") = SEXP_NULL;\n"
(x->string (type-id-name name)) ")")) (lambda ()
(setters (string-append "sexp_type_setters(" (do ((ls (reverse (struct-fields type)) (cdr ls)))
(x->string (type-id-name name)) ")"))) ((not (pair? ls)))
(cat " " getters (cat " sexp_push(ctx, sexp_type_slots("
(type-id-name name) "), "
"sexp_intern(ctx, "
(lambda () (write (x->string (cadr (car ls)))))
", -1));\n")))
" sexp_type_getters(" (type-id-name name) ")"
" = sexp_make_vector(ctx, " len ", SEXP_FALSE);\n" " = sexp_make_vector(ctx, " len ", SEXP_FALSE);\n"
" " setters " sexp_type_setters(" (type-id-name name) ")"
" = sexp_make_vector(ctx, " len ", SEXP_FALSE);\n"))) " = sexp_make_vector(ctx, " len ", SEXP_FALSE);\n")))
(cond (cond
((memq 'predicate: type) ((memq 'predicate: type)