guile/module/ice-9/debugger.scm

;;;; Guile Debugger

;;; Copyright (C) 1999, 2001, 2002, 2006 Free Software Foundation, Inc.
;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

(define-module (ice-9 debugger)
  #:use-module (ice-9 debugger command-loop)
  #:use-module (ice-9 debugger state)
  #:use-module (ice-9 debugger utils)
  #:use-module (ice-9 debugging traps)
  #:use-module (ice-9 format)
  #:export (debug-stack
	    debug
	    debug-last-error
	    debugger-error
	    debugger-quit
	    debugger-input-port
	    debugger-output-port
	    debug-on-error)
  #:no-backtrace)

;;; The old (ice-9 debugger) has been factored into its constituent
;;; parts:
;;;
;;; (ice-9 debugger) - public interface to all of the following
;;;
;;; (... commands) - procedures implementing the guts of the commands
;;;                  provided by the interactive debugger
;;;
;;; (... command-loop) - binding these commands into the interactive
;;;                      debugger command loop
;;;
;;; (... state) - implementation of an object that tracks current
;;;               debugger state
;;;
;;; (... utils) - utilities for printing out frame and stack
;;;               information in various formats
;;;
;;; The division between (... commands) and (... command-loop) exists
;;; because I (NJ) have another generic command loop implementation
;;; under development, and I want to be able to switch easily between
;;; that and the command loop implementation here.  Thus the
;;; procedures in this file delegate to a debugger command loop
;;; implementation via the `debugger-command-loop-*' interface.  The
;;; (ice-9 debugger command-loop) implementation can be replaced by
;;; any other that implements the `debugger-command-loop-*' interface
;;; simply by changing the relevant #:use-module line above.
;;;
;;; - Neil Jerram <neil@ossau.uklinux.net> 2002-10-26, updated 2005-07-09

(define *not-yet-introduced* #t)

(define (debug-stack stack . flags)
  "Invoke the Guile debugger to explore the specified @var{stack}.

@var{flags}, if present, are keywords indicating characteristics of
the debugging session: the valid keywords are as follows.

@table @code
@item #:continuable
Indicates that the debugger is being invoked from a context (such as
an evaluator trap handler) where it is possible to return from the
debugger and continue normal code execution.  This enables the
@dfn{continuing execution} commands, for example @code{continue} and
@code{step}.

@item #:with-introduction
Indicates that the debugger should display an introductory message.
@end table"
  (start-stack 'debugger
    (let ((state (apply make-state stack 0 flags)))
      (with-input-from-port (debugger-input-port)
	(lambda ()
	  (with-output-to-port (debugger-output-port)
	    (lambda ()
	      (if (or *not-yet-introduced*
		      (memq #:with-introduction flags))
		  (let ((ssize (stack-length stack)))
		    (display "This is the Guile debugger -- for help, type `help'.\n")
		    (set! *not-yet-introduced* #f)
		    (if (= ssize 1)
			(display "There is 1 frame on the stack.\n\n")
			(format #t "There are ~A frames on the stack.\n\n" ssize))))
	      (write-state-short state)
	      (debugger-command-loop state))))))))

(define (debug)
  "Invoke the Guile debugger to explore the context of the last error."
  (let ((stack (fluid-ref the-last-stack)))
    (if stack
	(debug-stack stack)
	(display "Nothing to debug.\n"))))

(define debug-last-error debug)

(define (debugger-error message)
  "Signal a debugger usage error with message @var{message}."
  (debugger-command-loop-error message))

(define (debugger-quit)
  "Exit the debugger."
  (debugger-command-loop-quit))

;;; {Debugger Input and Output Ports}

(define debugger-input-port
  (let ((input-port (current-input-port)))
    (make-procedure-with-setter
     (lambda () input-port)
     (lambda (port) (set! input-port port)))))

(define debugger-output-port
  (let ((output-port (current-output-port)))
    (make-procedure-with-setter
     (lambda () output-port)
     (lambda (port) (set! output-port port)))))

;;; {Debug on Error}

(define (debug-on-error syms)
  "Enable or disable debug on error."
  (set! pre-unwind-handler-dispatch
	(if syms
	    (lambda (key . args)
	      (if (memq key syms)
		  (begin
		    (debug-stack (make-stack #t pre-unwind-handler-dispatch)
				 #:with-introduction
				 #:continuable)
		    (throw 'abort key)))
	      (apply default-pre-unwind-handler key args))
	    default-pre-unwind-handler)))

;;; Also provide a `debug-trap' entry point.  This maps from a
;;; trap-context to a debug-stack call.

(define-public (debug-trap trap-context)
  "Invoke the Guile debugger to explore the stack at the specified @var{trap-context}."
  (let* ((stack (tc:stack trap-context))
	 (flags1 (let ((trap-type (tc:type trap-context)))
		   (case trap-type
		     ((#:return #:error)
		      (list trap-type
			    (tc:return-value trap-context)))
		     (else
		      (list trap-type)))))
	 (flags (if (tc:continuation trap-context)
		    (cons #:continuable flags1)
		    flags1)))
    (apply debug-stack stack flags)))

;;; (ice-9 debugger) ends here.