diff options
Diffstat (limited to 'break.scm')
| -rw-r--r-- | break.scm | 24 |
1 files changed, 11 insertions, 13 deletions
@@ -1,9 +1,9 @@ ;;;; "break.scm" Breakpoints for debugging in Scheme. -;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer. +;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer ; -;Permission to copy this software, to redistribute it, and to use it -;for any purpose is granted, subject to the following restrictions and -;understandings. +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. ; ;1. Any copy made of this software must include this copyright notice ;in full. @@ -35,6 +35,7 @@ (apply apply) (qpn qpn) (cons cons) (length length)) (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) (apply qpn "BREAKPOINT:" args) (let ((ans (call-with-current-continuation @@ -71,14 +72,14 @@ (define bkpt debug:breakpoint) (define continue debug:continue) -(define debug:breakf +(define breakf (let ((null? null?) ;These bindings are so that (not not) ;breakf will not break on parts (car car) (cdr cdr) ;of itself. (eq? eq?) (+ +) (zero? zero?) (modulo modulo) (apply apply) (display display) (breakpoint debug:breakpoint)) (lambda (function . optname) -;;; (set! debug:indent 0) + ;; (set! trace:indent 0) (let ((name (if (null? optname) function (car optname)))) (lambda args (cond ((and (not (null? args)) @@ -92,8 +93,8 @@ ;;; the reason I use a symbol for debug:unbreak-object is so ;;; that functions can still be unbreaked if this file is read in twice. -(define (debug:unbreakf function) -;;; (set! debug:indent 0) +(define (unbreakf function) + ;; (set! trace:indent 0) (function 'debug:unbreak-object)) ;;;;The break: functions wrap around the debug: functions to provide @@ -117,7 +118,7 @@ (cond ((and p (eq? (cdr p) fun)) fun) (else - (let ((tfun (debug:breakf fun sym))) + (let ((tfun (breakf fun sym))) (set! *breakd-procedures* (break:adder *breakd-procedures* sym tfun)) tfun))))))) @@ -128,12 +129,9 @@ (cond ((not (procedure? fun)) fun) ((not p) fun) ((eq? (cdr p) fun) - (debug:unbreakf fun)) + (unbreakf fun)) (else fun)))) -(define breakf debug:breakf) -(define unbreakf debug:unbreakf) - ;;;; Finally, the macros break and unbreak (defmacro break xs |