Re: (guix git) and guile-git finalizers.

[Mathieu Othacehe <m.othacehe@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 581 bytes --]


Hi !

I may have found something that replaces finalizers. I followed Andy and
Amirouche advices and used guardians, as in guile-sqlite3.

The idea here is to create a guardian per pointer-type to finalize. A
pumper function that operates on this guardian is also created. This
pumper function knows the git_libgit2_xxx function to call to free the
pointers stored in guardians.

Finally, all pumpers are registered into a hook that is run before
shutting down.

I tried it on "repository" pointers but it can be easily extended to the
other finalizers.

WDYT ?

Thanks,

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Replace-pointer-finalizer-by-guardians.patch --]
[-- Type: text/x-diff, Size: 3269 bytes --]

From 84bd5aa7f1c5bd01c721d475f8fdfad5533c71b5 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Mon, 19 Jun 2017 17:48:08 +0200
Subject: [PATCH] Replace pointer finalizer by guardians.

* git/bindings.scm (%pumpers-hook): New exported variable,
(define-element-guardian): New exported macro.
* git/repository.scm (%repository-free): Remove and replace by a call
  to define-element-guardian macro.
 (pointer->repository): Do not set a pointer finalizer and add the
  pointer to the guardian generated by define-element-guardian
  instead.
---
 git/bindings.scm   | 37 ++++++++++++++++++++++++++++++++++---
 git/repository.scm |  4 ++--
 2 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/git/bindings.scm b/git/bindings.scm
index 189369e..29eab73 100644
--- a/git/bindings.scm
+++ b/git/bindings.scm
@@ -30,7 +30,9 @@
             make-buffer
             free-buffer
             buffer-content
-            buffer-content/string))
+            buffer-content/string
+            %pumpers-hook
+            define-element-guardian))
 
 ;; DRAFT!
 
@@ -207,8 +209,37 @@
 (define libgit2-opts
   (libgit2->procedure int "git_libgit2_init" `(,int)))
 
-(define-public libgit2-shutdown
-  (libgit2->procedure int "git_libgit2_shutdown" '()))
+(define %pumpers-hook (make-hook))
+
+(define-syntax define-element-guardian
+  (lambda (x)
+    (define-syntax-rule (id ctx parts ...)
+      "Assemble PARTS into a raw (unhygienic)  identifier."
+      (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
+    (syntax-case x ()
+      ((_ element finalizer hook)
+       (with-syntax
+           ((finalizer-name (id #'element #'element #'-free))
+            (guardian-name  (id #'element #'element #'-guardian))
+            (pumper-name    (id #'element #'pump- #'element #'-guardian)))
+         #'(begin
+             (define finalizer-name
+               (let ((proc (libgit2->procedure void finalizer '(*))))
+                 (lambda (pointer)
+                   (proc pointer))))
+             (define guardian-name (make-guardian))
+             (define (pumper-name)
+               (let ((pointer (guardian-name)))
+                 (when pointer
+                   (finalizer-name pointer)
+                   (pumper-name))))
+             (add-hook! hook pumper-name)))))))
+
+(define-public (libgit2-shutdown)
+  ;; Before shutting down, try to finalize pointers kept in guardians.
+  (run-hook %pumpers-hook)
+  (let ((proc (libgit2->procedure int "git_libgit2_shutdown" '())))
+    (proc)))
 
 (define libgit2-version
   (let ((proc (libgit2->procedure void "git_libgit2_version" '(* * *))))
diff --git a/git/repository.scm b/git/repository.scm
index f82dff4..646dbe4 100644
--- a/git/repository.scm
+++ b/git/repository.scm
@@ -89,10 +89,10 @@
 
 ;; FIXME: https://libgit2.github.com/libgit2/#HEAD/group/repository/git_repository_fetchhead_foreach
 
-(define %repository-free (dynamic-func "git_repository_free" libgit2))
+(define-element-guardian repository "git_repository_free" %pumpers-hook)
 
 (define (pointer->repository! pointer)
-  (set-pointer-finalizer! pointer %repository-free)
+  (repository-guardian pointer)
   (pointer->repository pointer))
 
 (define repository-get-namespace
-- 
2.1.4