;;; Sly
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;;
;;; Sly is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Sly 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 General Public
;;; License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Garbage collector for foreign objects.
;;
;;; Code:

(define-module (sly guardian)
  #:use-module (ice-9 match)
  #:use-module (sly agenda)
  #:export (register-finalizer
            guard
            run-guardian))

(define-syntax-rule (push! variable value)
  (set! variable (cons value variable)))

(define %guardian (make-guardian))

(define %finalizers '())

(define (register-finalizer predicate finalizer)
  "Register FINALIZER, a procedure that frees a foreign resource, to
be used for objects that satisfy PREDICATE."
  (push! %finalizers (cons predicate finalizer)))

(define (guard obj)
  "Protect OBJ from garbage collection until its finalizer has been
applied.  OBJ is returned unmodified."
  (%guardian obj)
  obj)

(define (lookup-finalizer obj)
  "Return the finalization procedure for OBJ, or #f if none is found."
  (let loop ((finalizers %finalizers))
    (match finalizers
      (() #f)
      (((predicate . finalizer) . rest)
       (if (predicate obj)
           finalizer
           (loop rest))))))

(define (run-guardian)
  "Start the guardian worker coroutine on the current agenda."
  (schedule-each
   (lambda ()
     (let loop ((obj (%guardian)))
       (when obj
         (let ((finalizer (lookup-finalizer obj)))
           (if finalizer
               (finalizer obj)
               (error "no finalizer found for object" obj)))
         (loop (%guardian)))))))