summaryrefslogtreecommitdiff
path: root/module/ice-9/debugging/load-hooks.scm
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))