adding module reload library

This commit is contained in:
Alex Shinn 2012-05-15 22:57:18 +09:00
parent 610af03429
commit d8e0abc3cb
2 changed files with 72 additions and 0 deletions

63
lib/chibi/reload.scm Normal file
View file

@ -0,0 +1,63 @@
(define last-modified-time (current-seconds))
(define reload-verbose? (make-parameter #f))
(define (warn msg . args)
(let ((err (current-error-port)))
(display msg err)
(display ":" err)
(for-each (lambda (a)
(display " " err)
(if (string? a) (display a err) (write a err)))
args)
(newline err)))
(define (reload module-name)
(if (reload-verbose?)
(warn "Reloading module" module-name))
(let ((old-module (find-module module-name)))
;; Remove old entry in modules list.
(delete-module! module-name)
(guard (exn (else (warn "Error loading module definition" module-name)
(print-exception exn)
(print-stack-trace)
(add-module! module-name old-module)))
(load-module-definition module-name)
(let ((module (find-module module-name)))
(cond
((not module) (warn "Couldn't find module" module-name))
(else
(guard (exn (else (warn "Error loading module" module-name)
(print-exception exn)
(print-stack-trace)
(delete-module! module-name)
(add-module! module-name old-module)))
(let ((env (eval-module module-name module)))
(%import (module-env module) env (module-exports module) #f)
))))))))
(define (file-modified? path)
(and path (> (file-modification-time path) last-modified-time)))
(define (module-definition-modified? module-name module)
(file-modified? (find-module-file (module-name->file module-name))))
(define (module-includes-modified? module)
(any
(lambda (x)
(and (pair? x) (memq (car x) '(include include-ci))
(any file-modified? (map find-module-file (cdr x)))))
(module-meta-data module)))
(define (module-modified? module-name module)
(or (module-definition-modified? module-name module)
(module-includes-modified? module)))
(define (reload-modified-modules)
(for-each
(lambda (x)
(if (module-modified? (car x) (cdr x))
(reload (car x))))
*modules*)
(set! last-modified-time (current-seconds)))

9
lib/chibi/reload.sld Normal file
View file

@ -0,0 +1,9 @@
(define-library (chibi reload)
(import (scheme)
(meta)
(srfi 39)
(only (chibi time) current-seconds)
(only (chibi filesystem) file-modification-time))
(include "reload.scm")
(export reload reload-modified-modules reload-verbose?))