diff options
Diffstat (limited to 'break.scm')
| -rw-r--r-- | break.scm | 29 |
1 files changed, 12 insertions, 17 deletions
@@ -1,5 +1,5 @@ ;;;; "break.scm" Breakpoints for debugging in Scheme. -;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer +;;; Copyright (C) 1991, 1992, 1993, 1995, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -18,6 +18,7 @@ ;each case. (require 'qp) +(require 'alist) ;;;; BREAKPOINTS @@ -29,8 +30,8 @@ ;;; of breakpoint:continuation-stack and returns #f to it. (define breakpoint:continuation-stack '()) - -(define debug:breakpoint +;@ +(define breakpoint (let ((call-with-current-continuation call-with-current-continuation) (apply apply) (qpn qpn) (cons cons) (length length)) @@ -45,8 +46,8 @@ (debug:top-continuation (length breakpoint:continuation-stack)))))) (cond ((not (eq? ans breakpoint:continuation-stack)) ans)))))) - -(define debug:continue +;@ +(define continue (let ((null? null?) (car car) (cdr cdr)) (lambda args (cond ((null? breakpoint:continuation-stack) @@ -63,21 +64,17 @@ (if (provided? 'abort) (lambda (val) (display val) (newline) (abort)) (begin (display "; type (init-debug)") #f))) - +;@ (define (init-debug) (call-with-current-continuation (lambda (x) (set! debug:top-continuation x)))) - -(define breakpoint debug:breakpoint) -(define bkpt debug:breakpoint) -(define continue debug:continue) - +;@ (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)) + (apply apply) (display display) (breakpoint breakpoint)) (lambda (function . optname) ;; (set! trace:indent 0) (let ((name (if (null? optname) function (car optname)))) @@ -92,7 +89,7 @@ ;;; 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 (unbreakf function) ;; (set! trace:indent 0) (function 'debug:unbreak-object)) @@ -101,7 +98,6 @@ ;;; niceties like keeping track of breakd functions and dealing with ;;; redefinition. -(require 'alist) (define break:adder (alist-associator eq?)) (define break:deler (alist-remover eq?)) @@ -131,9 +127,8 @@ ((eq? (cdr p) fun) (unbreakf fun)) (else fun)))) - ;;;; Finally, the macros break and unbreak - +;@ (defmacro break xs (if (null? xs) `(begin ,@(map (lambda (x) `(set! ,x (break:breakf ,x ',x))) |