[plt-scheme] Persistent variables

Hi all,

I have played a little with the concept of persistent variables. The values
of persistent variable are automagically written to disk, on the next run
of the program the persistent variables are (automatically) read from disk.

In order to avoid excessive disk activity, I have refrained from writing 
the
value to disk on every change, and in stead write in 10 seconds intervals.
This implies that one needs to end the program with a 
(save-all-persistent-variables).
In order not to forget it, the current exit handler is extended to save 
the save the
variable on exit.

This leads to the question: What should I do to call 
save-all-persistent-variables,
when DrScheme stops the running program (e.g. when the run-button is 
clicked).


;;; persistent.scm  --  Jens Axel Søgaard  --  20th oct 2005

; TODO
;  1) Make sure define-persistent is used at top-level
;  2) Make sure a name is only defined as a persistent
;     variable once

(require (lib "serialize.ss"))

; a PERSISTENT-VAR is a
(define-struct persistent-var (name path saver))
; where
;   name is a symbol,
;   path is a path
;   saver is a thunk

; registry holds all persistent variables
(define registry (make-hash-table))

; save-all : ->
;   save all persistent variables on disk
(define (save-all-persistent-variables)
  (hash-table-for-each registry
    (lambda (name pvar)
      ((persistent-var-saver pvar)))))


(begin-for-syntax
  ; (temp stx-for-symbol string)
  ;   make temporary name for debugging
  (define (temp stx str)
    (string->symbol
     (string-append
      (symbol->string (syntax-object->datum stx))
      str))))

; syntax: (define-persistent name path initial-expr)
;   Define NAME as a persistent variable.
;   If a value for NAME has been serialized to PATH before,
;   that variable is read from disk;
;   otherwise set name to result of evaluting initial-expr.
;   A thread is started in the background, which
;   serializes the variable to disk, with 10 seconds intervals.
(define-syntax (define-persistent stx)
  (syntax-case stx ()
    [(define-persistent name path init)
     (with-syntax ([(name-var name-saver name-save-thread name-dirty?)
                    (generate-temporaries
                     #`(#,(temp #'name "-var")
                        #,(temp #'name "-saver")
                        #,(temp #'name "-save-thread")
                        #,(temp #'name "-dirty?")))])
       #'(begin
           ; name-var holds the value
           (define name-var (void))
           ; name-saver saves the current value to disk
           (define (name-saver)
             (call-with-output-file path
               (lambda (op) (write name-var op))
               'replace))
           ; flag indicating, whether name-var needs to written to disk
           (define name-dirty? #f)
           (define-syntax name
             (make-set!-transformer
              (lambda (so)
                (syntax-case so (set!)
                  ; (set! name val) sets the value, and triggers a save 
to disk
                  [(set! n expr)
                   #'(begin
                       (set! name-var expr)
                       (set! name-dirty? #t)
                       (name-saver))]
                  ; name references name-var
                  [id
                   (identifier? #'id)
                   #'name-var]))))
           ; register the persistent variable
           (hash-table-put! registry 'name (make-persistent-var 'name 
path name-saver))
           ; set the initial value to either the disk value or the 
result of init
           (set! name-var  
                 (cond
                   [(file-exists? path) (call-with-input-file path
                                          (lambda (ip) (read ip)))]
                   [else                init]))
           ; start the saving background thread
           (thread
            (lambda ()
              (let loop ()
                (if name-dirty?
                    (begin
                      (set! name-dirty? #f)
                      (name-saver)))
                (sleep 1)
                (loop))))
           ; make sure the variable is saved on exit
           (exit-handler
            (lambda (o)
              (name-saver)
              (call-with-output-file "on-exit-test"
                  (lambda (op)
                    (write '!!! op)))
              ((exit-handler o))))
           ; return void
           (void)))]))


(define-persistent foo "persistent/foo" 42)
(display (format "~a is ~a\n" 'foo foo))
(save-all-persistent-variables)