From c87e4f74f03c134590f8398186085ed124b0e03c Mon Sep 17 00:00:00 2001
From: Vivianne Langdon <puttabutta@gmail.com>
Date: Wed, 11 Sep 2024 21:59:02 -0400
Subject: [PATCH] Initial implementation and readme

---
 README.org        | 22 ++++++++++++++++++++++
 tests/weakref.scm | 25 +++++++++++++++++++++++++
 weakref.scm       | 40 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 87 insertions(+)
 create mode 100644 README.org
 create mode 100644 tests/weakref.scm
 create mode 100644 weakref.scm

diff --git a/README.org b/README.org
new file mode 100644
index 0000000..e8ad00b
--- /dev/null
+++ b/README.org
@@ -0,0 +1,22 @@
+#+TITLE:Guile Weak References
+
+This is a simple little library that makes use of the weak hash table functionality in core Guile
+to hackily implement weak references, objects which weakly point to other objects.
+
+The interface is very simple:
+
+(make-weakref obj)
+- Create a weak reference, which will not count as a reference, so the object can be garbage collected
+
+(weakref-object obj)
+- Get the object, or #f if it has been garbage collected.
+
+* Implementation
+This is a very simple implementation. There's a globally incremented ID associated with each object, and
+the object is stored in two global weak hash tables, one id-to-object and another object-to-id. The weak
+reference is a record type that stores the ID and also a tombstone property to cache whether the object
+has been collected to avoid the need to look it up after that point.
+
+I created this because I needed an interface outside of the hash tables to refer to single objects instead
+of creating a bunch of weak dictionaries. Also, Guile Hoot does not yet support iteration through weak key
+hash tables, so this will allow me to create a list of weak refs to iterate over instead.
diff --git a/tests/weakref.scm b/tests/weakref.scm
new file mode 100644
index 0000000..c7186f5
--- /dev/null
+++ b/tests/weakref.scm
@@ -0,0 +1,25 @@
+(define-module (tests weakref)
+  #:use-module (weakref)
+  #:use-module (srfi srfi-64))
+
+(test-begin "tests-weakref")
+
+(define a (cons 'foo 'bar))
+(define refa (make-weakref a))
+(define refb (make-weakref a))
+
+(define b (cons 'foo 'bar))
+(define refc (make-weakref b))
+
+(test-assert a (weakref-object refa))
+(test-assert a (weakref-object refb))
+(test-assert b (weakref-object refc))
+
+(format #t "~s\n" refc)
+
+(test-eq (weakref-object refa) (weakref-object refb))
+(test-assert (not (eq? (weakref-object refb) (weakref-object refc))))
+
+;; no way to reliably force GC for a test I'm afraid
+
+(test-end "tests-weakref")
diff --git a/weakref.scm b/weakref.scm
new file mode 100644
index 0000000..51c3507
--- /dev/null
+++ b/weakref.scm
@@ -0,0 +1,40 @@
+(define-module (weakref)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-64)
+  #:export (make-weakref
+            weakref?
+            weakref-object))
+
+(define *next-id* 0)
+(define *ids-to-objects* (make-weak-value-hash-table))
+(define *objects-to-ids* (make-weak-key-hash-table))
+
+(define-record-type <weakref>
+  (_make-weakref id tombstone)
+  weakref?
+  (id weakref-id)
+  (tombstone weakref-tombstone set-weakref-tombstone!))
+
+(set-record-type-printer!
+ <weakref>
+ (lambda (ref port)
+   (format port "#<weakref: ~a id=~a>" (or (weakref-object ref) "[gone]") (weakref-id ref))))
+
+(define (make-weakref obj)
+  (_make-weakref
+   (or (hashq-ref *objects-to-ids* obj)
+       (let ((id *next-id*))
+         (set! *next-id* (1+ *next-id*))
+         (hashq-set! *ids-to-objects* id obj)
+         (hashq-set! *objects-to-ids* obj id)
+         id))
+   #f))
+
+(define (weakref-object ref)
+  (if (weakref-tombstone ref)
+      #f
+      (or (hashq-ref *ids-to-objects* (weakref-id ref))
+          (begin
+            (set-weakref-tombstone! ref #t)
+            #f))))