Binding finalizers. Handling multiple implicit or explicit calls to finalizers.

This commit is contained in:
Alex Shinn 2013-01-23 23:06:39 +09:00
parent 7dfad8a293
commit fa44ad7cf8

View file

@ -1399,7 +1399,10 @@
" " (type-id-name name) " " (type-id-name name)
" = sexp_register_c_type(ctx, name, " " = sexp_register_c_type(ctx, name, "
(cond ((memq 'finalizer: type) (cond ((memq 'finalizer: type)
=> (lambda (x) (generate-stub-name (cadr x)))) => (lambda (x)
(let ((name (cadr x)))
(generate-stub-name
(if (pair? name) (car name) name)))))
(else "sexp_finalize_c_type")) (else "sexp_finalize_c_type"))
");\n") ");\n")
(cond (cond
@ -1484,12 +1487,21 @@
(cond (cond
((memq 'finalizer: type) ((memq 'finalizer: type)
=> (lambda (x) => (lambda (x)
(cat "static sexp " (generate-stub-name (cadr x)) (let* ((y (cadr x))
" (sexp ctx, sexp self, sexp_sint_t n, sexp x) {\n" (scheme-name (if (pair? y) (car y) y))
" if (sexp_cpointer_freep(x))\n" (cname (if (pair? y) (cadr y) y)))
" " (cadr x) "(sexp_cpointer_value(x));\n" (cat "static sexp " (generate-stub-name scheme-name)
" return SEXP_VOID;\n" " (sexp ctx, sexp self, sexp_sint_t n, sexp x) {\n"
"}\n\n")))) " if (sexp_cpointer_freep(x)) {\n"
" " cname "(sexp_cpointer_value(x));\n"
;; TODO: keep track of open/close separately from ownership
" sexp_cpointer_freep(x) = 0;\n"
" }\n"
" return SEXP_VOID;\n"
"}\n\n")
;; make the finalizer available
(set! *funcs*
(cons (parse-func `(void ,(cadr x) (,name))) *funcs*))))))
;; maybe write constructor ;; maybe write constructor
(cond (cond
((memq 'constructor: type) ((memq 'constructor: type)