Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-06 20:56:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding 'reloader?: keyword to memoize-file-loader.

Browse source
This commit is contained in:
Alex Shinn 2013-09-26 19:57:20 +09:00
parent b27143a96c
commit fbfe1f1b5b
1 changed files with 19 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
lib/chibi/memoize.scm
View file

@ -106,21 +106,31 @@
;;> must be a pathname. If the corresponding file has been modified ;;> must be a pathname. If the corresponding file has been modified
;;> since the memoized value, the value is recomputed. Useful to ;;> since the memoized value, the value is recomputed. Useful to
;;> automatically reflect external changes to a file-backed resource. ;;> automatically reflect external changes to a file-backed resource.
;;> The additional keyword argument \scheme{reloader?:}, if true,
;;> indicates that the result of loading is itself a procedure which
;;> should check for updates on each call.
(define (memoize-file-loader proc . o) (define (memoize-file-loader proc . o)
(let* ((f (lambda (file . rest) (let* ((f (lambda (file . rest)
(let ((mtime (file-modification-time file))) (let ((mtime (file-modification-time file)))
(cons mtime (apply proc file rest))))) (cons mtime (apply proc file rest)))))
(g (apply memoize f o))) (g (apply memoize f o))
(reloader? (cond ((memq 'reloader?: o) => cdr) (else #f))))
(lambda (file . rest) (lambda (file . rest)
(let ((cell (apply g file rest)) (let ((cell (apply g file rest)))
(mtime (file-modification-time file))) (let-syntax ((update!
(if (> mtime (car cell)) (syntax-rules ()
(let ((res (apply proc file rest))) ((update! default)
(set-car! cell mtime) (let ((mtime (file-modification-time file)))
(set-cdr! cell res) (if (> mtime (car cell))
res) (let ((res (apply proc file rest)))
(cdr cell)))))) (set-car! cell mtime)
(set-cdr! cell res)
res)
default))))))
(update! (if (and reloader? (procedure? (cdr cell)))
(lambda args (apply (update! (cdr cell)) args))
(cdr cell))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; persistent memoization ;; persistent memoization