diff options
Diffstat (limited to 'module/ice-9/debugging/load-hooks.scm')
-rw-r--r-- | module/ice-9/debugging/load-hooks.scm | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/module/ice-9/debugging/load-hooks.scm b/module/ice-9/debugging/load-hooks.scm new file mode 100644 index 000000000..fb869ed23 --- /dev/null +++ b/module/ice-9/debugging/load-hooks.scm @@ -0,0 +1,33 @@ + +(define-module (ice-9 debugging load-hooks) + #:export (before-load-hook + after-load-hook + install-load-hooks + uninstall-load-hooks)) + +;; real-primitive-load: holds the real (C-implemented) definition of +;; primitive-load, when the load hooks are installed. +(define real-primitive-load #f) + +;; The load hooks themselves. These are called with one argument, the +;; name of the file concerned. +(define before-load-hook (make-hook 1)) +(define after-load-hook (make-hook 1)) + +;; primitive-load-with-hooks: our new definition for primitive-load. +(define (primitive-load-with-hooks filename) + (run-hook before-load-hook filename) + (real-primitive-load filename) + (run-hook after-load-hook filename)) + +(define (install-load-hooks) + (if real-primitive-load + (error "load hooks are already installed")) + (set! real-primitive-load primitive-load) + (set! primitive-load primitive-load-with-hooks)) + +(define (uninstall-load-hooks) + (or real-primitive-load + (error "load hooks are not installed")) + (set! primitive-load real-primitive-load) + (set! real-primitive-load #f)) |