summaryrefslogtreecommitdiff
path: root/module/ice-9/debugging/load-hooks.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-11-01 12:44:21 +0100
committerAndy Wingo <wingo@pobox.com>2008-11-01 12:44:21 +0100
commit00d04892052f345a844c967adbe77c258896c1e7 (patch)
tree6e99b35f9d7d6ac1fe7b452bcad96cfb20f055b8 /module/ice-9/debugging/load-hooks.scm
parent5192c9e89bc18e5f6b33741aceed66bf28d56823 (diff)
downloadguile-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.scm33
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))