module/ice-9/debugging/load-hooks.scm

   1
   2 (define-module (ice-9 debugging load-hooks)
   3   #:export (before-load-hook
   4             after-load-hook
   5             install-load-hooks
   6             uninstall-load-hooks))
   7
   8 ;; real-primitive-load: holds the real (C-implemented) definition of
   9 ;; primitive-load, when the load hooks are installed.
  10 (define real-primitive-load #f)
  11
  12 ;; The load hooks themselves.  These are called with one argument, the
  13 ;; name of the file concerned.
  14 (define before-load-hook (make-hook 1))
  15 (define after-load-hook (make-hook 1))
  16
  17 ;; primitive-load-with-hooks: our new definition for primitive-load.
  18 (define (primitive-load-with-hooks filename)
  19   (run-hook before-load-hook filename)
  20   (real-primitive-load filename)
  21   (run-hook after-load-hook filename))
  22
  23 (define (install-load-hooks)
  24   (if real-primitive-load
  25       (error "load hooks are already installed"))
  26   (set! real-primitive-load primitive-load)
  27   (set! primitive-load primitive-load-with-hooks))
  28
  29 (define (uninstall-load-hooks)
  30   (or real-primitive-load
  31       (error "load hooks are not installed"))
  32   (set! primitive-load real-primitive-load)
  33   (set! real-primitive-load #f))