~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to ice-9/debugger/commands.scm

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
ImportĀ upstreamĀ versionĀ 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;;; (ice-9 debugger commands) -- debugger commands
 
2
 
 
3
;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
 
4
;;;
 
5
;; This library is free software; you can redistribute it and/or
 
6
;; modify it under the terms of the GNU Lesser General Public
 
7
;; License as published by the Free Software Foundation; either
 
8
;; version 2.1 of the License, or (at your option) any later version.
 
9
;; 
 
10
;; This library is distributed in the hope that it will be useful,
 
11
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
13
;; Lesser General Public License for more details.
 
14
;; 
 
15
;; You should have received a copy of the GNU Lesser General Public
 
16
;; License along with this library; if not, write to the Free Software
 
17
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
18
 
 
19
(define-module (ice-9 debugger commands)
 
20
  #:use-module (ice-9 debug)
 
21
  #:use-module (ice-9 debugger)
 
22
  #:use-module (ice-9 debugger state)
 
23
  #:use-module (ice-9 debugger utils)
 
24
  #:export (backtrace
 
25
            evaluate
 
26
            info-args
 
27
            info-frame
 
28
            position
 
29
            up
 
30
            down
 
31
            frame))
 
32
 
 
33
(define (backtrace state n-frames)
 
34
  "Print backtrace of all stack frames, or innermost COUNT frames.
 
35
With a negative argument, print outermost -COUNT frames.
 
36
If the number of frames isn't explicitly given, the debug option
 
37
`depth' determines the maximum number of frames printed."
 
38
  (let ((stack (state-stack state)))
 
39
    ;; Kludge around lack of call-with-values.
 
40
    (let ((values
 
41
           (lambda (start end)
 
42
             (display-backtrace stack
 
43
                                (current-output-port)
 
44
                                (if (memq 'backwards (debug-options))
 
45
                                    start
 
46
                                    (- end 1))
 
47
                                (- end start))
 
48
             )))
 
49
      (let ((end (stack-length stack)))
 
50
        (cond ((not n-frames) ;(>= (abs n-frames) end))
 
51
               (values 0 (min end (cadr (memq 'depth (debug-options))))))
 
52
              ((>= n-frames 0)
 
53
               (values 0 n-frames))
 
54
              (else
 
55
               (values (+ end n-frames) end)))))))
 
56
 
 
57
(define (eval-handler key . args)
 
58
  (let ((stack (make-stack #t eval-handler)))
 
59
    (if (= (length args) 4)
 
60
        (apply display-error stack (current-error-port) args)
 
61
        ;; We want display-error to be the "final common pathway"
 
62
        (catch #t
 
63
               (lambda ()
 
64
                 (apply bad-throw key args))
 
65
               (lambda (key . args)
 
66
                 (apply display-error stack (current-error-port) args)))))
 
67
  (throw 'continue))
 
68
 
 
69
(define (evaluate state expression)
 
70
  "Evaluate an expression.
 
71
The expression must appear on the same line as the command,
 
72
however it may be continued over multiple lines."
 
73
  (let ((source (frame-source (stack-ref (state-stack state)
 
74
                                         (state-index state)))))
 
75
    (if (not source)
 
76
        (display "No environment for this frame.\n")
 
77
        (catch 'continue
 
78
               (lambda ()
 
79
                 (lazy-catch #t
 
80
                             (lambda ()
 
81
                               (let* ((expr
 
82
                                       ;; We assume that no one will
 
83
                                       ;; really want to evaluate a
 
84
                                       ;; string (since it is
 
85
                                       ;; self-evaluating); so if we
 
86
                                       ;; have a string here, read the
 
87
                                       ;; expression to evaluate from
 
88
                                       ;; it.
 
89
                                       (if (string? expression)
 
90
                                           (with-input-from-string expression
 
91
                                                                   read)
 
92
                                           expression))
 
93
                                      (env (memoized-environment source))
 
94
                                      (value (local-eval expr env)))
 
95
                                 (write expr)
 
96
                                 (display " => ")
 
97
                                 (write value)
 
98
                                 (newline)))
 
99
                             eval-handler))
 
100
               (lambda args args)))))
 
101
 
 
102
(define (info-args state)
 
103
  "Argument variables of current stack frame."
 
104
  (let ((index (state-index state)))
 
105
    (let ((frame (stack-ref (state-stack state) index)))
 
106
      (write-frame-index-long frame)
 
107
      (write-frame-args-long frame))))
 
108
 
 
109
(define (info-frame state)
 
110
  "All about selected stack frame."
 
111
  (write-state-long state))
 
112
 
 
113
(define (position state)
 
114
  "Display the position of the current expression."
 
115
  (let* ((frame (stack-ref (state-stack state) (state-index state)))
 
116
         (source (frame-source frame)))
 
117
    (if (not source)
 
118
        (display "No source available for this frame.")
 
119
        (let ((position (source-position source)))
 
120
          (if (not position)
 
121
              (display "No position information available for this frame.")
 
122
              (display-position position)))))
 
123
  (newline))
 
124
 
 
125
(define (up state n)
 
126
  "Move @var{n} frames up the stack.  For positive @var{n}, this
 
127
advances toward the outermost frame, to higher frame numbers, to
 
128
frames that have existed longer.  @var{n} defaults to one."
 
129
  (set-stack-index! state (+ (state-index state) (or n 1)))
 
130
  (write-state-short state))
 
131
 
 
132
(define (down state n)
 
133
  "Move @var{n} frames down the stack.  For positive @var{n}, this
 
134
advances toward the innermost frame, to lower frame numbers, to frames
 
135
that were created more recently.  @var{n} defaults to one."
 
136
  (set-stack-index! state (- (state-index state) (or n 1)))
 
137
  (write-state-short state))
 
138
 
 
139
(define (frame state n)
 
140
  "Select and print a stack frame.
 
141
With no argument, print the selected stack frame.  (See also \"info frame\").
 
142
An argument specifies the frame to select; it must be a stack-frame number."
 
143
  (if n (set-stack-index! state (frame-number->index n (state-stack state))))
 
144
  (write-state-short state))
 
145
 
 
146
;;; (ice-9 debugger commands) ends here.