guile-guardian


Using guardians with Guile

by uriel.

Quoting from Guile's documentation:

Guardians  provide  a  way  to  be notified  about  objects  that  would
otherwise be  collected as garbage.  Guarding them prevents  the objects
from being collected  and cleanup actions can be  performed on them, for
example. 

To avoid naming conflict between basic Guile values and instances of classes of the GOOPS object system: let's call the basic values SMOBs (SMall OBjects). A reference to an instance of GOOPS class is itself a SMOB.

A guardian handles two collections of objects: a set of guarded objects and a queue of marked objects. To understand guardians we have to acknowledge that:

To make a guardian we use make-guardian, it returns a function that can be called with one or zero arguments:

The basic mechanism

Let's see a simple, useless, example of code that uses a guardian:

 (define stuff-guardian (make-guardian)) 
  
 (stuff-guardian 'one-thing) 
 (gc) 
  
 (format #t "Guarded object: ~A~%" (stuff-guardian)) 
 (format #t "This is false: ~A~%" (stuff-guardian)) 

this is what happens:

  1. a new guardian's procedure is stored into stuff-guardian;
  2. the symbol one-thing is registered in the guarded set;
  3. gc is used to trigger synchronously a run of the garbage collector: this run finds that the one-thing SMOB is not referenced by anything but the guardian, so it removes the SMOB from the guarded set and puts it into the marked queue;
  4. the first call to stuff-guardian returns one-thing;
  5. the second call to stuff-guardian finds the marked queue empty, so it returns #f;

the output of this script is:

Guarded object: one-thing
This is false: #f

Now it is obvious that the script:

 (define stuff-guardian (make-guardian)) 
 (stuff-guardian 'one-thing) 
 (stuff-guardian 'other-thing) 
 (gc) 
 (format #t "Guarded object: ~A~%" (stuff-guardian)) 
 (format #t "Guarded object: ~A~%" (stuff-guardian)) 
 (format #t "This is false: ~A~%" (stuff-guardian)) 

will output:

Guarded object: one-thing
Guarded object: other-thing
This is false: #f

and the script:

 (define stuff-guardian (make-guardian)) 
 (gc) 
 (format #t "This is false: ~A~%" (stuff-guardian)) 
 (stuff-guardian 'one-thing) 
 (gc) 
 (format #t "Guarded object: ~A~%" (stuff-guardian)) 
 (format #t "This is false: ~A~%" (stuff-guardian)) 

will output:

This is false: #f
Guarded object: one-thing
This is false: #f

Using after-gc-hook

It is understandable that most of the times we do not want to explicitly invoke the guardian's extractor function: we need a mechanism to tell Guile to automatically invoke the guardian's extractor when a guarded object is marked.

SMOBs are moved from the guarded set to the marked queue at garbage collection time, so a good moment to invoke the extractor is right after a garbage collection run: this is exactly what the after-gc-hook is for.

We register a hook function that invokes the guardian's extractor until #f is returned:

 (define stuff-guardian (make-guardian)) 
  
 (define (stuff-guardian-hook) 
   (do ((smob (stuff-guardian) (stuff-guardian))) 
       ((not smob)) 
     (format #t "Guarded object: ~A~%" smob))) 
  
 (add-hook! after-gc-hook stuff-guardian-hook) 
  
 (stuff-guardian 'one-thing) 
 (stuff-guardian 'other-thing) 
 (format #t "First run...~%") 
 (gc) 
  
 (format #t "Second run...~%") 
 (gc) 
  
 (stuff-guardian 'one-more-thing) 
 (format #t "Third run...~%") 
 (gc) 

the output will be:

First run...
Guarded object: one-thing
Guarded object: other-thing
Second run...
Third run...
Guarded object: one-more-thing

Please notice that the script:

 (define stuff-guardian (make-guardian)) 
  
 (define (stuff-guardian-hook) 
   (do ((smob (stuff-guardian) (stuff-guardian))) 
       ((not smob)) 
     (format #t "Guarded object: ~A~%" smob))) 
  
 (add-hook! after-gc-hook stuff-guardian-hook) 
  
 (stuff-guardian 'one-thing) 
 (stuff-guardian 'other-thing) 

outputs nothing: after-gc-hook is not invoked by Guile when the script exits; to overcome this limitation we can use exit-hook to run a garbage collection synchronously, by modifying the script in this way:

 (define stuff-guardian (make-guardian)) 
  
 (define (stuff-guardian-hook) 
   (do ((smob (stuff-guardian) (stuff-guardian))) 
       ((not smob)) 
     (format #t "Guarded object: ~A~%" smob))) 
  
 (add-hook! after-gc-hook stuff-guardian-hook) 
 (add-hook! exit-hook gc) 
  
 (stuff-guardian 'one-thing) 
 (stuff-guardian 'other-thing) 
  
 (format #t "Exiting...~%") 
 (run-hook exit-hook) 

the exit-hook must be run explicitly. exit-hook must invoke the garbage collector, not stuff-guardian-hook: that way we can process SMOBs that are already unreferenced by the script's state but not yet put in the marked queue.

Handling asynchronous resources

Here we see how to use a guardian to handle asynchronous resources whose reference is embedded in a GOOPS class slot. To make it simple: let's see the case in which the asynchronous resource is a file created by the object initialiser and deleted by an object destructor.

The class we use is this:

 (define-class <thing> () 
   (filename #:init-value #f #:init-keyword #:filename) 
   (port #:init-value #f)) 

To create a file we specialise the class' initialize method:

 (define-method (initialize (o <thing>) args) 
   (next-method) 
   (let-keywords args #t ((filename #f)) 
     (catch #t 
       (lambda () 
         (slot-set! o 'port (open-file filename "w+"))) 
       (lambda (key . args) 
         (slot-set! o 'filename #f) 
         (apply scm-error key args))) 
     (stuff-guardian o))) 

in which: next-method builds the object filling the slots with default values and values from the arguments of make, then the file is opened and the object registered in the guarded set.

To close the port and delete the file we use a specific function called delete! as destructor; using delete! as name seems appropriate, but it already is a primitive function of Guile, so we first redefine it as a generic function:

 (define saved-delete! delete!) 
 (define-generic delete!) 
 (define-method (delete! . args) 
   (apply saved-delete! args)) 

the destructor is:

 (define-method (delete! (o <thing>)) 
   (cond ((slot-ref o 'port) 
          (close (slot-ref o 'port)))) 
   (cond ((slot-ref o 'filename) 
          (delete-file (slot-ref o 'filename))))) 

we can invoke this function explicitly to destroy objects of class <thing>.

The full script is (warning: the following script creates the file /tmp/proof.1 and then deletes it):

 (define-module (this-one) 
   #:use-module (oop goops) 
   #:use-module (ice-9 optargs) 
   #:duplicates merge-generics) 
  
 (define saved-delete! delete!) 
 (define-generic delete!) 
 (define-method (delete! . args) 
   (apply saved-delete! args)) 
  
 ;; ------------------------------------------------------------ 
  
 (define stuff-guardian (make-guardian)) 
  
 (define (stuff-guardian-hook) 
   (do ((smob (stuff-guardian) (stuff-guardian))) 
       ((not smob)) 
     (format #t "Guarded object: ~A~%" smob) 
     (delete! smob))) 
  
 (add-hook! after-gc-hook stuff-guardian-hook) 
 (add-hook! exit-hook gc) 
  
 ;; ------------------------------------------------------------ 
  
 (define-class <thing> () 
   (filename #:init-value #f #:init-keyword #:filename) 
   (port #:init-value #f)) 
  
 (define-method (initialize (o <thing>) args) 
   (next-method) 
   (let-keywords args #t ((filename #f)) 
     (catch #t 
       (lambda () 
         (slot-set! o 'port (open-file filename "w+"))) 
       (lambda (key . args) 
         (slot-set! o 'filename #f) 
         (apply scm-error key args))) 
     (stuff-guardian o))) 
  
 (define-method (delete! (o <thing>)) 
   (cond ((slot-ref o 'port) 
          (format #t "closing port...~%") 
          (close (slot-ref o 'port)))) 
   (cond ((slot-ref o 'filename) 
          (format #t "deleting file...~%") 
          (delete-file (slot-ref o 'filename))))) 
    
 ;; ------------------------------------------------------------ 
  
 (let ((thing (make <thing> 
                #:filename "/tmp/proof.1"))) 
   (format #t "Ciao!~%")) 
  
 (format #t "Exiting...~%") 
 (run-hook exit-hook) 

Nothing prevents us from using the same guardian with more than one class: we only have to define a delete! generic method specialised for the other class, following this model:

 (define-class <widget> () 
   (resource #:init-value #f)) 
  
 (define-method (initialize (o <widget>) args) 
   (next-method) 
   (slot-set! o 'resource (make-resource)) 
   (stuff-guardian o)) 
  
 (define-method (delete! (o <widget>)) 
   (delete-resource (slot-ref o 'resource))) 

category-guile