From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: "Jose A. Ortega Ruiz" Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] Add new debug meta-command ,error Date: Tue, 31 Aug 2010 04:30:18 +0200 Message-ID: <87aao34ipx.fsf@newton.homeunix.net> References: <1283143931-6220-1-git-send-email-jao@gnu.org> <87aao36gag.fsf@newton.homeunix.net> <8762yr6d9v.fsf@newton.homeunix.net> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1283221840 27521 80.91.229.12 (31 Aug 2010 02:30:40 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Tue, 31 Aug 2010 02:30:40 +0000 (UTC) Cc: guile-devel@gnu.org To: Andy Wingo Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Aug 31 04:30:36 2010 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1OqGcM-0001Ur-AL for guile-devel@m.gmane.org; Tue, 31 Aug 2010 04:30:35 +0200 Original-Received: from localhost ([127.0.0.1]:39915 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OqGcL-0004al-AV for guile-devel@m.gmane.org; Mon, 30 Aug 2010 22:30:33 -0400 Original-Received: from [140.186.70.92] (port=43497 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OqGcC-0004ag-B4 for guile-devel@gnu.org; Mon, 30 Aug 2010 22:30:25 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1OqGcA-0001Xt-OX for guile-devel@gnu.org; Mon, 30 Aug 2010 22:30:24 -0400 Original-Received: from mail-ww0-f49.google.com ([74.125.82.49]:35771) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OqGcA-0001Xk-Fc for guile-devel@gnu.org; Mon, 30 Aug 2010 22:30:22 -0400 Original-Received: by wwb24 with SMTP id 24so3612530wwb.30 for ; Mon, 30 Aug 2010 19:30:21 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=domainkey-signature:received:received:sender:received:from:to:cc :subject:in-reply-to:references:user-agent:x-attribution:x-url:date :message-id:mime-version:content-type; bh=NCiIR0d5D9QvEKR2But2etxZCfL+3PD8Fpiz0Ky9X9U=; b=mZsgPZwNTQaLNKQ43ybN1M9+8Y5fG03N99Y2RDsq9zJwjlmGpnj1RdDrRQ1xAcXmwK d1/WhZf233XcBg0hZp+lRbnaNf+aMxl4LMOBEL5PrzE12fod7+aNP4y3+pf5c4HG06cZ ARY3DLKbXHdYHAqELaG7YZt5+wcC7Q6fPWLts= DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma; h=sender:from:to:cc:subject:in-reply-to:references:user-agent :x-attribution:x-url:date:message-id:mime-version:content-type; b=gY5Pv6HXBmXjuJuIqI7D1Xx15tQ95O8xefOlMTxqP2Yu6YuQOf9S7TmCEDyLEVu/nk w0jjdr71hO2AkF5cdxegFZ/52LiLIbnzTgyNFirOvUY7zJSjCRr0uRf9ehiham8gHzOc zTeDXwBznewbDZKablEq0dGjXWxjPgddthv5g= Original-Received: by 10.216.90.139 with SMTP id e11mr1048119wef.82.1283221821447; Mon, 30 Aug 2010 19:30:21 -0700 (PDT) Original-Received: from newton.homeunix.net ([83.50.71.238]) by mx.google.com with ESMTPS id v11sm4904591weq.16.2010.08.30.19.30.20 (version=TLSv1/SSLv3 cipher=RC4-MD5); Mon, 30 Aug 2010 19:30:20 -0700 (PDT) Original-Received: from localhost ([127.0.0.1] helo=newton.homeunix.net ident=jao) by newton.homeunix.net with esmtp (Exim 4.72) (envelope-from ) id 1OqGc6-0002pJ-W9; Tue, 31 Aug 2010 04:30:19 +0200 In-Reply-To: (Andy Wingo's message of "Mon, 30 Aug 2010 18:54:35 -0700") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) X-Attribution: jao X-URL: X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:10817 Archived-At: --=-=-= On Tue, Aug 31 2010, Andy Wingo wrote: [...] > I would prefer ,error-message and ,error, I think; I feel like we could > use ,e for other things (eval, expand, ...). Ah, makes sense. So ,error it is. Should i commit to master? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Add-new-debug-meta-command-error-message.patch >From 9f601e08e40e2d90f2425e6a5dc7a142cac4ae35 Mon Sep 17 00:00:00 2001 From: Jose A. Ortega Ruiz Date: Mon, 30 Aug 2010 06:37:24 +0200 Subject: [PATCH] Add new debug meta-command ,error-message * module/system/repl/error-handling.scm: use the error string to construct the instance. * module/system/repl/command.scm: new debug command `error-message' that extracts the new field, available to stack commands as `message'. * doc/ref/scheme-using.texi: documentation for new command. * module/system/repl/debug.scm: stores the error string in a new field. Signed-off-by: Jose A. Ortega Ruiz --- doc/ref/scheme-using.texi | 7 +++++++ module/system/repl/command.scm | 28 +++++++++++++++++++--------- module/system/repl/debug.scm | 4 ++-- module/system/repl/error-handling.scm | 26 ++++++++++++++++---------- 4 files changed, 44 insertions(+), 21 deletions(-) diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index e07b148..a89b152 100644 --- a/doc/ref/scheme-using.texi +++ b/doc/ref/scheme-using.texi @@ -311,6 +311,13 @@ Show local variables. Show locally-bound variables in the selected frame. @end deffn +@deffn {REPL Command} error-message [error] +Show error message. + +Display the message associated with the error that started the current +debugging REPL. +@end deffn + @c FIXME: whenever we regain support for stepping, here are the docs.. @c The commands in this subsection all apply only when the stack is diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 8a62a16..c98d328 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -6,12 +6,12 @@ ;; 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 @@ -55,7 +55,7 @@ (disassemble x) (disassemble-file xx)) (profile (time t) (profile pr) (trace tr)) (debug (backtrace bt) (up) (down) (frame fr) - (procedure proc) (locals)) + (procedure proc) (locals) (error-message error)) (inspect (inspect i) (pretty-print pp)) (system (gc) (statistics stat) (option o) (quit q continue cont)))) @@ -171,7 +171,7 @@ (format #t "Throw to key `~a' with args `~s' while reading ~@[ argument `~A' of ~]command `~A'.\n" key args form-name 'name))) (abort)) - + (% (let* ((expression0 (catch #t (lambda () @@ -463,6 +463,8 @@ Trace execution." (letrec-syntax ((#,(datum->syntax #'repl 'frames) (identifier-syntax (debug-frames debug))) + (#,(datum->syntax #'repl 'message) + (identifier-syntax (debug-error-message debug))) (#,(datum->syntax #'repl 'index) (identifier-syntax (id (debug-index debug)) @@ -474,6 +476,14 @@ Trace execution." body body* ...) (format #t "Nothing to debug.~%")))))))) +(define-stack-command (error-message repl) + "error-message +Show error message. + +Display the message associated with the error that started the current +debugging REPL." + (format #t "~a~%" (if (string? message) message "No error message"))) + (define-stack-command (backtrace repl #:optional count #:key (width 72) full?) "backtrace [COUNT] [#:width W] [#:full? F] @@ -481,11 +491,11 @@ Print a backtrace. Print a backtrace of all stack frames, or innermost COUNT frames. If COUNT is negative, the last COUNT frames will be shown." - (print-frames frames + (print-frames frames #:count count #:width width #:full? full?)) - + (define-stack-command (up repl #:optional (count 1)) "up [COUNT] Select a calling stack frame. @@ -548,14 +558,14 @@ With an argument, select a frame by index, then show it." "procedure Print the procedure for the selected frame." (repl-print repl (frame-procedure cur))) - + (define-stack-command (locals repl) "locals Show local variables. Show locally-bound variables in the selected frame." (print-locals cur)) - + ;;; ;;; Inspection commands @@ -581,7 +591,7 @@ Pretty-print the result(s) of evaluating EXP." ;;; -;;; System commands +;;; System commands ;;; (define guile:gc gc) diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm index 293b790..1876d31 100644 --- a/module/system/repl/debug.scm +++ b/module/system/repl/debug.scm @@ -30,7 +30,7 @@ #:use-module ((system vm inspect) #:select ((inspect . %inspect))) #:use-module (system vm program) #:export ( - make-debug debug? debug-frames debug-index + make-debug debug? debug-frames debug-index debug-error-message print-locals print-frame print-frames frame->module stack->vector narrow-stack->vector)) @@ -66,7 +66,7 @@ ;;; accessors, and provides some helper functions. ;;; -(define-record frames index) +(define-record frames index error-message) diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm index db0beeb..e77ea96 100644 --- a/module/system/repl/error-handling.scm +++ b/module/system/repl/error-handling.scm @@ -32,6 +32,16 @@ ;;; Error handling via repl debugging ;;; +(define (error-string stack key args) + (with-output-to-string + (lambda () + (pmatch args + ((,subr ,msg ,args . ,rest) + (display-error (vector-ref stack 0) (current-output-port) + subr msg args rest)) + (else + (format #t "Throw to key `~a' with args `~s'." key args)))))) + (define* (call-with-error-handling thunk #:key (on-error 'debug) (post-error 'catch) (pass-keys '(quit))) @@ -45,7 +55,7 @@ (lambda () (with-error-to-port err thunk)))))) - + (catch #t (lambda () (%start-stack #t thunk)) @@ -75,7 +85,7 @@ (if (procedure? post-error) post-error ; a handler proc (error "Unknown post-error strategy" post-error)))) - + (case on-error ((debug) (lambda (key . args) @@ -85,22 +95,18 @@ (make-stack #t) ;; Cut three frames from the top of the stack: ;; make-stack, this one, and the throw handler. - 3 + 3 ;; Narrow the end of the stack to the most recent ;; start-stack. tag ;; And one more frame, because %start-stack invoking ;; the start-stack thunk has its own frame too. 0 (and tag 1))) - (debug (make-debug stack 0))) + (error-msg (error-string stack key args)) + (debug (make-debug stack 0 error-msg))) (with-saved-ports (lambda () - (pmatch args - ((,subr ,msg ,args . ,rest) - (display-error (vector-ref stack 0) (current-output-port) - subr msg args rest)) - (else - (format #t "Throw to key `~a' with args `~s'." key args))) + (format #t error-msg) (format #t "Entering a new prompt. ") (format #t "Type `,bt' for a backtrace or `,q' to continue.\n") ((@ (system repl repl) start-repl) #:debug debug)))))) -- 1.7.1 --=-=-=--