summaryrefslogtreecommitdiff
path: root/module/ice-9/debugger/utils.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/ice-9/debugger/utils.scm')
-rw-r--r--module/ice-9/debugger/utils.scm203
1 files changed, 0 insertions, 203 deletions
diff --git a/module/ice-9/debugger/utils.scm b/module/ice-9/debugger/utils.scm
deleted file mode 100644
index dfef25b1f..000000000
--- a/module/ice-9/debugger/utils.scm
+++ /dev/null
@@ -1,203 +0,0 @@
-
-(define-module (ice-9 debugger utils)
- #:use-module (ice-9 debugger state)
- #:export (display-position
- source-position
- write-frame-args-long
- write-frame-index-long
- write-frame-short/expression
- write-frame-short/application
- write-frame-long
- write-state-long
- write-state-short))
-
-;;; Procedures in this module print information about a stack frame.
-;;; The available information is as follows.
-;;;
-;;; * Source code location.
-;;;
-;;; For an evaluation frame, this is the location recorded at the time
-;;; that the expression being evaluated was read, if the 'positions
-;;; read option was enabled at that time.
-;;;
-;;; For an application frame, I'm not yet sure. Some applications
-;;; seem to have associated source expressions.
-;;;
-;;; * Whether frame is still evaluating its arguments.
-;;;
-;;; Only applies to an application frame. For example, an expression
-;;; like `(+ (* 2 3) 4)' goes through the following stages of
-;;; evaluation.
-;;;
-;;; (+ (* 2 3) 4) -- evaluation
-;;; [+ ... -- application; the car of the evaluation
-;;; has been evaluated and found to be a
-;;; procedure; before this procedure can
-;;; be applied, its arguments must be evaluated
-;;; [+ 6 ... -- same application after evaluating the
-;;; first argument
-;;; [+ 6 4] -- same application after evaluating all
-;;; arguments
-;;; 10 -- result
-;;;
-;;; * Whether frame is real or tail-recursive.
-;;;
-;;; If a frame is tail-recursive, its containing frame as shown by the
-;;; debugger backtrace doesn't really exist as far as the Guile
-;;; evaluator is concerned. The effect of this is that when a
-;;; tail-recursive frame returns, it looks as though its containing
-;;; frame returns at the same time. (And if the containing frame is
-;;; also tail-recursive, _its_ containing frame returns at that time
-;;; also, and so on ...)
-;;;
-;;; A `real' frame is one that is not tail-recursive.
-
-
-(define (write-state-short state)
- (let* ((frame (stack-ref (state-stack state) (state-index state)))
- (source (frame-source frame))
- (position (and source (source-position source))))
- (format #t "Frame ~A at " (frame-number frame))
- (if position
- (display-position position)
- (display "unknown source location"))
- (newline)
- (write-char #\tab)
- (write-frame-short frame)
- (newline)))
-
-(define (write-state-short* stack index)
- (write-frame-index-short stack index)
- (write-char #\space)
- (write-frame-short (stack-ref stack index))
- (newline))
-
-(define (write-frame-index-short stack index)
- (let ((s (number->string (frame-number (stack-ref stack index)))))
- (display s)
- (write-char #\:)
- (write-chars #\space (- 4 (string-length s)))))
-
-(define (write-frame-short frame)
- (if (frame-procedure? frame)
- (write-frame-short/application frame)
- (write-frame-short/expression frame)))
-
-(define (write-frame-short/application frame)
- (write-char #\[)
- (write (let ((procedure (frame-procedure frame)))
- (or (and (procedure? procedure)
- (procedure-name procedure))
- procedure)))
- (if (frame-evaluating-args? frame)
- (display " ...")
- (begin
- (for-each (lambda (argument)
- (write-char #\space)
- (write argument))
- (frame-arguments frame))
- (write-char #\]))))
-
-;;; Use builtin function instead:
-(set! write-frame-short/application
- (lambda (frame)
- (display-application frame (current-output-port) 12)))
-
-(define (write-frame-short/expression frame)
- (write (let* ((source (frame-source frame))
- (copy (source-property source 'copy)))
- (if (pair? copy)
- copy
- (unmemoize-expr source)))))
-
-(define (write-state-long state)
- (let ((index (state-index state)))
- (let ((frame (stack-ref (state-stack state) index)))
- (write-frame-index-long frame)
- (write-frame-long frame))))
-
-(define (write-frame-index-long frame)
- (display "Stack frame: ")
- (write (frame-number frame))
- (if (frame-real? frame)
- (display " (real)"))
- (newline))
-
-(define (write-frame-long frame)
- (if (frame-procedure? frame)
- (write-frame-long/application frame)
- (write-frame-long/expression frame)))
-
-(define (write-frame-long/application frame)
- (display "This frame is an application.")
- (newline)
- (if (frame-source frame)
- (begin
- (display "The corresponding expression is:")
- (newline)
- (display-source frame)
- (newline)))
- (display "The procedure being applied is: ")
- (write (let ((procedure (frame-procedure frame)))
- (or (and (procedure? procedure)
- (procedure-name procedure))
- procedure)))
- (newline)
- (display "The procedure's arguments are")
- (if (frame-evaluating-args? frame)
- (display " being evaluated.")
- (begin
- (display ": ")
- (write (frame-arguments frame))))
- (newline))
-
-(define (display-source frame)
- (let* ((source (frame-source frame))
- (copy (source-property source 'copy)))
- (cond ((source-position source)
- => (lambda (p) (display-position p) (display ":\n"))))
- (display " ")
- (write (or copy (unmemoize-expr source)))))
-
-(define (source-position source)
- (let ((fname (source-property source 'filename))
- (line (source-property source 'line))
- (column (source-property source 'column)))
- (and fname
- (list fname line column))))
-
-(define (display-position pos)
- (format #t "~A:~D:~D" (car pos) (+ 1 (cadr pos)) (+ 1 (caddr pos))))
-
-(define (write-frame-long/expression frame)
- (display "This frame is an evaluation.")
- (newline)
- (display "The expression being evaluated is:")
- (newline)
- (display-source frame)
- (newline))
-
-(define (write-frame-args-long frame)
- (if (frame-procedure? frame)
- (let ((arguments (frame-arguments frame)))
- (let ((n (length arguments)))
- (display "This frame has ")
- (write n)
- (display " argument")
- (if (not (= n 1))
- (display "s"))
- (write-char (if (null? arguments) #\. #\:))
- (newline))
- (for-each (lambda (argument)
- (display " ")
- (write argument)
- (newline))
- arguments))
- (begin
- (display "This frame is an evaluation frame; it has no arguments.")
- (newline))))
-
-(define (write-chars char n)
- (do ((i 0 (+ i 1)))
- ((>= i n))
- (write-char char)))