mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 04:10:18 +02:00
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.
33 lines
1.1 KiB
Scheme
33 lines
1.1 KiB
Scheme
|
|
(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))
|