diff options
author | Andy Wingo <wingo@pobox.com> | 2008-11-01 12:44:21 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-11-01 12:44:21 +0100 |
commit | 00d04892052f345a844c967adbe77c258896c1e7 (patch) | |
tree | 6e99b35f9d7d6ac1fe7b452bcad96cfb20f055b8 /module/ice-9/debugging/load-hooks.scm | |
parent | 5192c9e89bc18e5f6b33741aceed66bf28d56823 (diff) | |
download | guile-00d04892052f345a844c967adbe77c258896c1e7.tar.gz |
move ice-9/ and oop/ under module/
Moved ice-9/ and oop/ under module/, with the idea being that we have
only scheme under module/. Adjusted configure.in and Makefile.am
appropriately. Put oop/ at the end of the compilation order.
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)) |