blob: fb869ed23c85b4c7df2289053a8235cc1204a488 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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))
|