[nongnu] elpa/emacsql e9efb0803e 185/427: Oops, include the reap source.

[ELPA Syncer]

branch: elpa/emacsql
commit e9efb0803e2d9b5d310a1645a690973dd74ad73b
Author: Christopher Wellons <wellons@nullprogram.com>
Commit: Christopher Wellons <wellons@nullprogram.com>

    Oops, include the reap source.
---
 emacsql-reap.el | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)

diff --git a/emacsql-reap.el b/emacsql-reap.el
new file mode 100644
index 0000000000..b076081f28
--- /dev/null
+++ b/emacsql-reap.el
@@ -0,0 +1,66 @@
+;;; emacsql-reap.el --- callbacks for garbage-collected objects -*- 
lexical-binding: t; -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;; Commentary:
+
+;; This package is for immediately running a callback after a lisp
+;; object is garbage collected. An optional token can be passed to the
+;; callback to provide a hint as to what was collected, since the
+;; original object obviously can't be passed.
+
+;; It works by exploiting Emacs Lisp's weak hash tables and hooking
+;; the `post-gc-hook'.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar emacsql-reap-objects ()
+  "Collection of all objects being watched by the reaper.")
+
+(defun emacsql-reap--ref (thing)
+  "Create a weak reference to THING."
+  (let ((ref (make-hash-table :test 'eq :size 1 :weakness 'value)))
+    (prog1 ref
+      (setf (gethash t ref) thing))))
+
+(defun emacsql-reap--deref (ref)
+  "Retrieve value from REF."
+  (gethash t ref))
+
+(defun emacsql-reap--empty-p (ref)
+  "Return non-nil if value behind REF is still there."
+  (zerop (hash-table-count ref)))
+
+(cl-defun emacsql-reap-register (object callback &optional (token nil token-p))
+  "Run CALLBACK with TOKEN when OBJECT is garbage collected.
+Do *not* use OBJECT for TOKEN because it will not get collected."
+  (let ((ref (emacsql-reap--ref object))
+        (rich-token (and token-p (vector token))))
+    ;; Rich-token could be instead captured in a closure, but
+    ;; establishing a closure here would require this package to be
+    ;; byte-compiled in order to operate properly. Interpreted
+    ;; closures capture the entire environment.
+    (push (list callback rich-token ref) emacsql-reap-objects)))
+
+(defun emacsql-reap-single (entry)
+  "Cleanup ENTRY and return non-nil if ENTRY has been garbage collected."
+  (cl-destructuring-bind (callback token ref) entry
+    (when (emacsql-reap--empty-p ref)
+      (prog1 t
+        (ignore-errors
+          (if token
+              (funcall callback (elt token 0))
+            (funcall callback)))))))
+
+(defun emacsql-reap ()
+  "Run callbacks for garbage collected objects."
+  (setf emacsql-reap-objects
+        (cl-delete-if #'emacsql-reap-single emacsql-reap-objects)))
+
+(add-hook 'post-gc-hook #'emacsql-reap)
+
+(provide 'emacsql-reap)
+
+;;; emacsql-reap.el ends here