diff options
author | Andy Wingo <wingo@pobox.com> | 2025-05-02 15:26:37 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2025-05-02 16:03:13 +0200 |
commit | 75c7f79abc2f18bb7d9ae0b607fd82c8818dfae9 (patch) | |
tree | 8101990b1e5aca7f228df493d0b8c7add6d736db /module/system | |
parent | 604a8e8540d2fc27052e1b4383c165c3e156ad70 (diff) | |
download | guile-75c7f79abc2f18bb7d9ae0b607fd82c8818dfae9.tar.gz |
Add (system finalizers)
This will replace an internal interface in (system foreign-objects).
* module/system/finalizers.scm: New file.
* am/bootstrap.am (SOURCES): Add new file.
* libguile/foreign-object.h:
* libguile/foreign-object.c (invoke_finalizer):
(sys_add_finalizer_x):
(scm_init_foreign_object):
(scm_register_foreign_object): Remove.
* libguile/init.c (scm_i_init_guile): Register finalizers instead of
foreign-object.
* module/system/foreign-object.scm (allocate-instance): Use finalizers
module.
* libguile/finalizers.c (invoke_finalizer):
(scm_sys_add_finalizer): New helper.
Diffstat (limited to 'module/system')
-rw-r--r-- | module/system/finalizers.scm | 34 | ||||
-rw-r--r-- | module/system/foreign-object.scm | 9 |
2 files changed, 37 insertions, 6 deletions
diff --git a/module/system/finalizers.scm b/module/system/finalizers.scm new file mode 100644 index 000000000..1193439e5 --- /dev/null +++ b/module/system/finalizers.scm @@ -0,0 +1,34 @@ +;;; Copyright (C) 2025 Free Software Foundation, Inc. +;;; +;;; This library is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + + +(define-module (system finalizers) + #:export (add-finalizer! + %guardian-finalizer-priority + %default-finalizer-priority)) + +(eval-when (expand load eval) + (load-extension (string-append "libguile-" (effective-version)) + "scm_init_finalizers_module")) + +(define %guardian-finalizer-priority 1) +(define %default-finalizer-priority 0) + +(define* (add-finalizer! obj proc + #:optional (priority %default-finalizer-priority)) + "Add a finalizer @var{proc} to object @var{obj}, with priority +@var{priority}. Return the finalizer object." + (%add-finalizer! obj proc priority)) diff --git a/module/system/foreign-object.scm b/module/system/foreign-object.scm index 3f05ccaad..2e613d406 100644 --- a/module/system/foreign-object.scm +++ b/module/system/foreign-object.scm @@ -1,6 +1,6 @@ ;;; Wrapping foreign objects in Scheme -;;; Copyright (C) 2014, 2015, 2024 Free Software Foundation, Inc. +;;; Copyright (C) 2014, 2015, 2024, 2025 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -24,13 +24,10 @@ (define-module (system foreign-object) #:use-module (oop goops) + #:use-module (system finalizers) #:export (make-foreign-object-type define-foreign-object-type)) -(eval-when (eval load expand) - (load-extension (string-append "libguile-" (effective-version)) - "scm_init_foreign_object")) - (define-class <foreign-class> (<class>)) (define-class <foreign-class-with-finalizer> (<foreign-class>) @@ -42,7 +39,7 @@ (let ((instance (next-method)) (finalizer (finalizer class))) (when finalizer - (%add-finalizer! instance finalizer)) + (add-finalizer! instance finalizer)) instance)) (define* (make-foreign-object-type name slots #:key finalizer |