mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
8746959cd3
* debugging/trc.scm: New file. * debugging/traps.scm: New file. * debugging/trace.scm: New file. * debugging/steps.scm: New file. * debugging/load-hooks.scm: New file. * debugging/ice-9-debugger-extensions.scm: New file. * debugging/example-fns.scm: New file. * debugging/breakpoints.scm: New file. * debugging/Makefile.am: New. * Makefile.am (SUBDIRS): Add debugging.
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))
|