mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
68 lines
2.5 KiB
Scheme
68 lines
2.5 KiB
Scheme
;; reload.scm -- automatic module reloading
|
|
;; Copyright (c) 2012 Alex Shinn. All rights reserved.
|
|
;; BSD-style license: http://synthcode.com/license.txt
|
|
|
|
(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)
|
|
(protect (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
|
|
(protect (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 (env-exports env) #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-name module)
|
|
(let ((dir (module-name-prefix module-name)))
|
|
(any
|
|
(lambda (x)
|
|
(and (pair? x) (memq (car x) '(include include-ci))
|
|
(any file-modified?
|
|
(map (lambda (f) (find-module-file (string-append dir f)))
|
|
(cdr x)))))
|
|
(module-meta-data module))))
|
|
|
|
(define (module-modified? module-name module)
|
|
(or (module-definition-modified? module-name module)
|
|
(module-includes-modified? module-name 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)))
|