unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* Initial GUD integration for Guile
@ 2014-08-05 13:21 Jan Nieuwenhuizen
  2014-08-05 13:21 ` [PATCH] Initial GUD integration support Jan Nieuwenhuizen
                   ` (2 more replies)
  0 siblings, 3 replies; 8+ messages in thread
From: Jan Nieuwenhuizen @ 2014-08-05 13:21 UTC (permalink / raw)
  To: guile-devel, emacs-devel

From Jan Nieuwenhuizen <janneke@gnu.org> # This line is ignored.
Subject: Initial GUD support for Guile
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Hi,

Here is an experimental patch for Guile to support GUD integration.  It
features a more friendly (more gdb-like) debug prompt for breakpoints
and stepping.  It has some rough edges, hopefully I overlooked some
simple things that can help clean it up.

Following is also its counterpart, a patch for Emacs' Grand Unified
Debugger (GUD).

I'm including gud-break.c that matches examples/gud-break.scm for
GUD (guile/gdb) operation comparison.

What do you think?

(There are of course more goodies to wish for after we can agree upon an
 initial integration).

Greetings, Jan




--- gud-break.c
/*
  Comparing GDB/GUD with experimental Guile/GUD support for Guile REPL
  gcc -g --std=c99 -o gud-break gud-break.c 
  gdb gud-break, or using GUD: M-x gdb RET gud-break RET
  b main
  r
  n
  RET # repeats last command: `n'
  ...
*/
#include <stdio.h>

int
main ()
{
  fprintf (stderr, "%s:%d:hello world\n", __FILE__, __LINE__);
  {
    int a;
    int b;
    a = 1;
    fprintf (stderr, "set: a=%d\n", a);
    b = 2;
    fprintf (stderr, "set: b=%d\n", b);
    {
      int c;
      int d;
      c = 3;
      fprintf (stderr, "set: c=%d\n", c);
      d = 4;
      fprintf (stderr, "set: d=%d\n", d);
    }
    fprintf (stderr, "%s:%d:leaving...\n", __FILE__, __LINE__);
  }
  fprintf (stderr, "%s:%d:goodbye world\n", __FILE__, __LINE__);
}
--- end

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  



^ permalink raw reply	[flat|nested] 8+ messages in thread

* [PATCH] Initial GUD integration support.
  2014-08-05 13:21 Initial GUD integration for Guile Jan Nieuwenhuizen
@ 2014-08-05 13:21 ` Jan Nieuwenhuizen
  2014-08-05 13:21 ` [PATCH] Initial Guile REPL (guiler) debugger support for GUD Jan Nieuwenhuizen
  2014-08-08 20:34 ` Initial GUD integration for Guile Jan Nieuwenhuizen
  2 siblings, 0 replies; 8+ messages in thread
From: Jan Nieuwenhuizen @ 2014-08-05 13:21 UTC (permalink / raw)
  To: guile-devel, emacs-devel

	* examples/gud-break.scm: New example; showing initial GUD
	integration.

	* module/system/repl/debug.scm (debug-prompt): New procedure;
	gdb-like debug prompt.  Experimental!

	* module/system/repl/error-handling.scm (call-with-error-handling):
	* module/system/repl/command.scm (step, step-instruction, next)
	(next-instruction): Use it.
---
 examples/gud-break.scm                | 56 +++++++++++++++++++++++++++++++
 module/system/repl/command.scm        |  8 ++---
 module/system/repl/debug.scm          | 62 +++++++++++++++++++++++++++++++++++
 module/system/repl/error-handling.scm |  3 +-
 4 files changed, 124 insertions(+), 5 deletions(-)
 create mode 100644 examples/gud-break.scm

diff --git a/examples/gud-break.scm b/examples/gud-break.scm
new file mode 100644
index 0000000..8378a0c
--- /dev/null
+++ b/examples/gud-break.scm
@@ -0,0 +1,56 @@
+#! /bin/sh
+# -*-scheme-*-
+exec guile -e main -s "$0" "$@"
+!#
+;; Experimental GUD support for Guile REPL
+;; Find a gud.el that you want to patch, e.g.
+;;     zcat /usr/share/emacs/24.3/lisp/progmodes/gud.el.gz > ~/.emacs.d/gud.el
+;; or
+;;     M-x find-function gdb RET
+;;     C-x C-w ~/.emacs.d/gud.el RET
+;; Patch it
+;;     patch ~/.emacs.d/gud.el < 0001-Initial-Guile-REPL-guiler-debugger-support-for-GUD.patch
+;; M-x load-library ~/.emacs.d/gud.el RET
+;; M-x guiler RET
+;; ,m gud-break
+;; ,br main
+;; ,r
+;; ,n
+;; ,n # no easy RET shortcut yet
+;;
+;; And see |> marker in Emac's left margin track the program's execution.
+
+(read-set! keywords 'prefix)
+
+(define (main . args)
+  (eval '(main (command-line)) (resolve-module '(gud-break))))
+
+(define-module (gud-break)
+  :export (main))
+
+(define (stderr fmt . args)
+  (apply format (cons (current-error-port) (cons* fmt args)))
+  (force-output (current-error-port)))
+
+(define (main . args) 
+  (stderr "~a:hello world\n" (current-source-location))
+  (let
+      ((a #f)
+       (b #f))
+    (set! a 1)
+    (stderr "set: a=~a\n" a)
+    (set! b 2)
+    (stderr "set: b=~a\n" b)
+    (let
+        ((c #f)
+         (d #f))
+      (set! c 3)
+      (stderr "set: c=~a\n" c)
+      (set! d 4)
+      (stderr "set: d=~a\n" d))
+    (stderr "~a:leaving...\n" (current-source-location)))
+  (stderr "~a:goodbye world\n" (current-source-location)))
+
+
+
+
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 62bc297..3999c5e 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -740,7 +740,7 @@ Resume execution, breaking when the current frame finishes."
 Step until control reaches a different source location.
 
 Step until control reaches a different source location."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #t #:instruction? #f)
     (throw 'quit)))
@@ -750,7 +750,7 @@ Step until control reaches a different source location."
 Step until control reaches a different instruction.
 
 Step until control reaches a different VM instruction."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #t #:instruction? #t)
     (throw 'quit)))
@@ -760,7 +760,7 @@ Step until control reaches a different VM instruction."
 Step until control reaches a different source location in the current frame.
 
 Step until control reaches a different source location in the current frame."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #f #:instruction? #f)
     (throw 'quit)))
@@ -770,7 +770,7 @@ Step until control reaches a different source location in the current frame."
 Step until control reaches a different instruction in the current frame.
 
 Step until control reaches a different VM instruction in the current frame."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #f #:instruction? #t)
     (throw 'quit)))
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 300145d..5e47d19 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -24,6 +24,7 @@
   #:use-module (system base language)
   #:use-module (system vm vm)
   #:use-module (system vm frame)
+  #:use-module (ice-9 and-let-star)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 format)
@@ -32,6 +33,7 @@
   #:export (<debug>
             make-debug debug?
             debug-frames debug-index debug-error-message
+            debug-prompt
             terminal-width
             print-registers print-locals print-frame print-frames frame->module
             stack->vector narrow-stack->vector
@@ -160,6 +162,66 @@
             (lp (+ i inc)
                 (frame-source frame)))))))
 
+(define *source-alist* '())
+(define (source-add file-name source)
+  (set! *source-alist* (assoc-set! *source-alist* file-name source))
+  source)
+
+(define* (gulp-port #:optional (port current-input-port)) 
+  (or (and-let* ((result (read-delimited "" port))
+                 ((string? result)))
+                result)
+      ""))
+
+(define (gulp-file file-name)
+  (gulp-port (open-input-file (format #f "~a" file-name))))
+
+(define (read-source-file file-name)
+  (or (assoc-ref *source-alist* file-name)
+      (and-let* ((source (gulp-file file-name))
+                 (lines (string-split source #\newline)))
+                (source-add file-name lines))))
+
+(define (fs-find-file file-name)
+  (let loop ((path (cons "." %load-path )))
+    (if (null? path)
+        #f
+        (let* ((dir (car path)) 
+               (fs-file-name (string-join (list dir file-name) "/")))
+          (if (file-exists? fs-file-name)
+              fs-file-name
+              (loop (cdr path)))))))
+
+(define (source-code file-name line-number)
+  (or (and-let* ((file-name file-name)
+                 (line-number line-number)
+                 (lines (read-source-file file-name)))
+                (list-ref lines line-number))
+      ""))
+
+(define *last-source* #f)
+(define* (debug-prompt frame #:optional (last-source *last-source*) (message ""))
+  "A gdb,pydb-like debug prompt."
+  (define (source:pretty-file source)
+    (if source
+        (or (source:file source) "current input")
+        "unknown file"))
+  (let* ((source (frame-source frame))
+         (file (source:pretty-file source))
+         (file-name (fs-find-file file))
+         (line (and=> source source:line))
+         (col (and=> source source:column))
+         (code (source-code file-name line))
+         (line-column (format #f "~a~a" (if line (1+ line) "") 
+                              (if col (format #f ":~a" col) ""))))
+    (set! *last-source* source)
+    (string-append
+     (if (and file (not (equal? file (source:pretty-file last-source))))
+         (format #f "~&~a:~a:~a~&" file-name line-column message) ;;GNU standard!
+         ;;(format #f "~&In ~a:~a~&" file-name message) ;;or awkward Guile convention?
+         "")
+     (format #f "~&~10a~a" line-column code))))
+
 ;; Ideally here we would have something much more syntactic, in that a set! to a
 ;; local var that is not settable would raise an error, and export etc forms
 ;; would modify the module in question: but alack, this is what we have now.
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index 94a9f2a..1777854 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -80,7 +80,8 @@
                (begin
                  (format #t "~a~%" error-msg)
                  (format #t "Entering a new prompt.  ")
-                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")))
+                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
+                 (format #t "~a~&" (debug-prompt frame #f))))
            ((@ (system repl repl) start-repl) #:debug debug)))))
 
     (define (null-trap-handler frame trap-idx trap-name)
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  




^ permalink raw reply related	[flat|nested] 8+ messages in thread

* [PATCH] Initial Guile REPL (guiler) debugger support for GUD.
  2014-08-05 13:21 Initial GUD integration for Guile Jan Nieuwenhuizen
  2014-08-05 13:21 ` [PATCH] Initial GUD integration support Jan Nieuwenhuizen
@ 2014-08-05 13:21 ` Jan Nieuwenhuizen
  2014-08-09 15:35   ` Stefan Monnier
  2014-08-08 20:34 ` Initial GUD integration for Guile Jan Nieuwenhuizen
  2 siblings, 1 reply; 8+ messages in thread
From: Jan Nieuwenhuizen @ 2014-08-05 13:21 UTC (permalink / raw)
  To: guile-devel, emacs-devel

	* progmodes/gud.el (guiler): New function.  Starts the Guile REPL;
	add Guile debugger support for GUD.
---
 lisp/ChangeLog        |  5 +++
 lisp/progmodes/gud.el | 89 ++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 89 insertions(+), 5 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b6f16ea..b3da957 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2014-08-05  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+	* progmodes/gud.el (guiler): New function.  Starts the Guile REPL;
+	add Guile debugger support for GUD.
+
 2014-08-03  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Don't mishandle year-9999 dates (Bug#18176).
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index c6fc944..fd57e62 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -34,7 +34,8 @@
 ;; and added a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX
 ;; kluge with the gud-xdb-directories hack producing gud-dbx-directories.
 ;; Derek L. Davies <ddavies@world.std.com> added support for jdb (Java
-;; debugger.)
+;; debugger.)  Jan Nieuwenhuizen added support for the Guile REPL (Guile
+;; debugger).
 
 ;;; Code:
 
@@ -140,7 +141,7 @@ Used to gray out relevant toolbar icons.")
 			       (display-graphic-p)
 			       (fboundp 'x-show-tip))
 		  :visible (memq gud-minor-mode
-				'(gdbmi dbx sdb xdb pdb))
+				'(gdbmi guiler dbx sdb xdb pdb))
 	          :button (:toggle . gud-tooltip-mode))
     ([refresh]	"Refresh" . gud-refresh)
     ([run]	menu-item "Run" gud-run
@@ -170,11 +171,11 @@ Used to gray out relevant toolbar icons.")
     ([up]	menu-item "Up Stack" gud-up
 		  :enable (not gud-running)
 		  :visible (memq gud-minor-mode
-				 '(gdbmi gdb dbx xdb jdb pdb)))
+				 '(gdbmi gdb guiler dbx xdb jdb pdb)))
     ([down]	menu-item "Down Stack" gud-down
 		  :enable (not gud-running)
 		  :visible (memq gud-minor-mode
-				 '(gdbmi gdb dbx xdb jdb pdb)))
+				 '(gdbmi gdb guiler dbx xdb jdb pdb)))
     ([pp]	menu-item "Print S-expression" gud-pp
                   :enable (and (not gud-running)
 				  (bound-and-true-p gdb-active-process))
@@ -195,7 +196,7 @@ Used to gray out relevant toolbar icons.")
     ([finish]	menu-item "Finish Function" gud-finish
                   :enable (not gud-running)
 		  :visible (memq gud-minor-mode
-				 '(gdbmi gdb xdb jdb pdb)))
+				 '(gdbmi gdb guiler xdb jdb pdb)))
     ([stepi]	menu-item "Step Instruction" gud-stepi
                   :enable (not gud-running)
 		  :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
@@ -1704,6 +1705,83 @@ and source-file directory for your debugger."
   (run-hooks 'pdb-mode-hook))
 \f
 ;; ======================================================================
+;; Guile REPL (guiler) functions
+
+;; History of argument lists passed to guiler.
+(defvar gud-guiler-history nil)
+
+(defvar gud-guiler-lastfile nil)
+
+(defun gud-guiler-marker-filter (string)
+  (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))
+
+  (let ((start 0))
+    (while
+	(cond
+	 ((string-match "^In \\(.*\\):" gud-marker-acc start)
+          (setq gud-guiler-lastfile (match-string 1 gud-marker-acc)))
+	 ((string-match "^\\([^:\n]+\\):\\([0-9]+\\):\\([0-9]+\\):[^\n]*"
+			gud-marker-acc start)
+          (setq gud-guiler-lastfile (match-string 1 gud-marker-acc))
+          (setq gud-last-frame
+                (cons gud-guiler-lastfile
+                      (string-to-number (match-string 2 gud-marker-acc)))))
+	 ((string-match "^[ ]*\\([0-9]+\\):\\([0-9]+\\)  [^\n]*"
+			gud-marker-acc start)
+          (if gud-guiler-lastfile
+              (setq gud-last-frame
+                    (cons gud-guiler-lastfile
+                          (string-to-number (match-string 1 gud-marker-acc))))))
+	 ((string-match comint-prompt-regexp gud-marker-acc start) t)
+         ((string= (substring gud-marker-acc start) "") nil)
+         (t nil))
+      (setq start (match-end 0)))
+
+    ;; Search for the last incomplete line in this chunk
+    (while (string-match "\n" gud-marker-acc start)
+      (setq start (match-end 0)))
+
+    ;; If we have an incomplete line, store it in gud-marker-acc.
+    (setq gud-marker-acc (substring gud-marker-acc (or start 0))))
+  string)
+
+
+(defcustom gud-guiler-command-name "guile"
+  "File name for executing the Guile debugger.
+This should be an executable on your path, or an absolute file name."
+  :type 'string
+  :group 'gud)
+
+;;;###autoload
+(defun guiler (command-line)
+  "Run guiler on program FILE in buffer `*gud-FILE*'.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger."
+  (interactive
+   (list (gud-query-cmdline 'guiler)))
+
+  (gud-common-init command-line nil 'gud-guiler-marker-filter)
+  (set (make-local-variable 'gud-minor-mode) 'guiler)
+
+;; FIXME: absolute file-names are not grokked yet by Guile's ,break-at-source
+;; and relative file names only when relative to %load-path.
+;;  (gud-def gud-break  ",break-at-source %d%f %l"  "\C-b" "Set breakpoint at current line.")
+  (gud-def gud-break  ",break-at-source %f %l"  "\C-b" "Set breakpoint at current line.")
+;; FIXME: remove breakpoint with file-line not yet supported by Guile
+;;  (gud-def gud-remove ",delete ---> %d%f:%l"  "\C-d" "Remove breakpoint at current line")
+  (gud-def gud-step   ",step"         "\C-s" "Step one source line with display.")
+  (gud-def gud-next   ",next"         "\C-n" "Step one line (skip functions).")
+;;  (gud-def gud-cont   "continue"     "\C-r" "Continue with display.")
+  (gud-def gud-finish ",finish"       "\C-f" "Finish executing current function.")
+  (gud-def gud-up     ",up"           "<" "Up one stack frame.")
+  (gud-def gud-down   ",down"         ">" "Down one stack frame.")
+  (gud-def gud-print  "%e"            "\C-p" "Evaluate Guile expression at point.")
+
+  (setq comint-prompt-regexp "^scheme@([^>]+> ")
+  (setq paragraph-start comint-prompt-regexp)
+  (run-hooks 'guiler-mode-hook))
+\f
+;; ======================================================================
 ;;
 ;; JDB support.
 ;;
@@ -3450,6 +3528,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
   "Return a suitable command to print the expression EXPR."
   (pcase gud-minor-mode
     (`gdbmi (concat "-data-evaluate-expression \"" expr "\""))
+    (`guiler expr)
     (`dbx (concat "print " expr))
     ((or `xdb `pdb) (concat "p " expr))
     (`sdb (concat expr "/"))))
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  




^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: Initial GUD integration for Guile
  2014-08-05 13:21 Initial GUD integration for Guile Jan Nieuwenhuizen
  2014-08-05 13:21 ` [PATCH] Initial GUD integration support Jan Nieuwenhuizen
  2014-08-05 13:21 ` [PATCH] Initial Guile REPL (guiler) debugger support for GUD Jan Nieuwenhuizen
@ 2014-08-08 20:34 ` Jan Nieuwenhuizen
  2 siblings, 0 replies; 8+ messages in thread
From: Jan Nieuwenhuizen @ 2014-08-08 20:34 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 204 bytes --]

Jan Nieuwenhuizen writes:

After chatting with davexunit and seeing a remark from Andy,
here's a somewhat less clueless version.

Worries about sources-alist, *last-source* etc remain...

Greetings, Jan


[-- Attachment #2: 0001-Initial-GUD-integration-support.patch --]
[-- Type: text/x-diff, Size: 8490 bytes --]

From 7ce14e739ba2ada7bc1e46a9821ae6c83871b14c Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 5 Aug 2014 12:34:09 +0200
Subject: [PATCH] Initial GUD integration support.

        * examples/gud-break.scm: New example; showing initial GUD
        integration.

        * module/system/repl/debug.scm (debug-prompt): New procedure;
        gdb-like debug prompt.  Experimental!

        * module/system/repl/error-handling.scm (call-with-error-handling):
        * module/system/repl/command.scm (step, step-instruction, next)
        (next-instruction): Use it.
---
 examples/gud-break.scm                | 56 +++++++++++++++++++++++++++++++++++
 module/system/repl/command.scm        |  8 ++---
 module/system/repl/debug.scm          | 48 ++++++++++++++++++++++++++++++
 module/system/repl/error-handling.scm |  3 +-
 4 files changed, 110 insertions(+), 5 deletions(-)
 create mode 100644 examples/gud-break.scm

diff --git a/examples/gud-break.scm b/examples/gud-break.scm
new file mode 100644
index 0000000..8378a0c
--- /dev/null
+++ b/examples/gud-break.scm
@@ -0,0 +1,56 @@
+#! /bin/sh
+# -*-scheme-*-
+exec guile -e main -s "$0" "$@"
+!#
+;; Experimental GUD support for Guile REPL
+;; Find a gud.el that you want to patch, e.g.
+;;     zcat /usr/share/emacs/24.3/lisp/progmodes/gud.el.gz > ~/.emacs.d/gud.el
+;; or
+;;     M-x find-function gdb RET
+;;     C-x C-w ~/.emacs.d/gud.el RET
+;; Patch it
+;;     patch ~/.emacs.d/gud.el < 0001-Initial-Guile-REPL-guiler-debugger-support-for-GUD.patch
+;; M-x load-library ~/.emacs.d/gud.el RET
+;; M-x guiler RET
+;; ,m gud-break
+;; ,br main
+;; ,r
+;; ,n
+;; ,n # no easy RET shortcut yet
+;;
+;; And see |> marker in Emac's left margin track the program's execution.
+
+(read-set! keywords 'prefix)
+
+(define (main . args)
+  (eval '(main (command-line)) (resolve-module '(gud-break))))
+
+(define-module (gud-break)
+  :export (main))
+
+(define (stderr fmt . args)
+  (apply format (cons (current-error-port) (cons* fmt args)))
+  (force-output (current-error-port)))
+
+(define (main . args) 
+  (stderr "~a:hello world\n" (current-source-location))
+  (let
+      ((a #f)
+       (b #f))
+    (set! a 1)
+    (stderr "set: a=~a\n" a)
+    (set! b 2)
+    (stderr "set: b=~a\n" b)
+    (let
+        ((c #f)
+         (d #f))
+      (set! c 3)
+      (stderr "set: c=~a\n" c)
+      (set! d 4)
+      (stderr "set: d=~a\n" d))
+    (stderr "~a:leaving...\n" (current-source-location)))
+  (stderr "~a:goodbye world\n" (current-source-location)))
+
+
+
+
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 62bc297..3999c5e 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -740,7 +740,7 @@ Resume execution, breaking when the current frame finishes."
 Step until control reaches a different source location.
 
 Step until control reaches a different source location."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #t #:instruction? #f)
     (throw 'quit)))
@@ -750,7 +750,7 @@ Step until control reaches a different source location."
 Step until control reaches a different instruction.
 
 Step until control reaches a different VM instruction."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #t #:instruction? #t)
     (throw 'quit)))
@@ -760,7 +760,7 @@ Step until control reaches a different VM instruction."
 Step until control reaches a different source location in the current frame.
 
 Step until control reaches a different source location in the current frame."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #f #:instruction? #f)
     (throw 'quit)))
@@ -770,7 +770,7 @@ Step until control reaches a different source location in the current frame."
 Step until control reaches a different instruction in the current frame.
 
 Step until control reaches a different VM instruction in the current frame."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #f #:instruction? #t)
     (throw 'quit)))
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 300145d..c6b796d 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -24,6 +24,7 @@
   #:use-module (system base language)
   #:use-module (system vm vm)
   #:use-module (system vm frame)
+  #:use-module (ice-9 and-let-star)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 format)
@@ -32,6 +33,7 @@
   #:export (<debug>
             make-debug debug?
             debug-frames debug-index debug-error-message
+            debug-prompt
             terminal-width
             print-registers print-locals print-frame print-frames frame->module
             stack->vector narrow-stack->vector
@@ -160,6 +162,52 @@
             (lp (+ i inc)
                 (frame-source frame)))))))
 
+(define *source-alist* '())
+(define (source-add file-name source)
+  (set! *source-alist* (assoc-set! *source-alist* file-name source))
+  source)
+
+(define (read-source-file file-name)
+  (or (assoc-ref *source-alist* file-name)
+      (and-let* ((source (with-input-from-file file-name read-string))
+                 (lines (string-split source #\newline)))
+                (source-add file-name lines))))
+
+(define (fs-find-file file-name)
+  (if (file-exists? file-name) 
+      file-name
+      (%search-load-path file-name)))
+
+(define (source-code file-name line-number)
+  (or (and-let* ((file-name file-name)
+                 (line-number line-number)
+                 (lines (read-source-file file-name)))
+                (list-ref lines line-number))
+      ""))
+
+(define *last-source* #f)
+(define* (debug-prompt frame #:optional (last-source *last-source*) (message ""))
+  "A gdb,pydb-like debug prompt."
+  (define (source:pretty-file source)
+    (if source
+        (or (source:file source) "current input")
+        "unknown file"))
+  (let* ((source (frame-source frame))
+         (file (source:pretty-file source))
+         (file-name (fs-find-file file))
+         (line (and=> source source:line))
+         (col (and=> source source:column))
+         (code (source-code file-name line))
+         (line-column (format #f "~a~a" (if line (1+ line) "") 
+                              (if col (format #f ":~a" col) ""))))
+    (set! *last-source* source)
+    (string-append
+     (if (and file (not (equal? file (source:pretty-file last-source))))
+         (format #f "~&~a:~a:~a~&" file-name line-column message) ;;GNU standard!
+         ;;(format #f "~&In ~a:~a~&" file-name message) ;;or awkward Guile convention?
+         "")
+     (format #f "~&~10a~a" line-column code))))
+
 ;; Ideally here we would have something much more syntactic, in that a set! to a
 ;; local var that is not settable would raise an error, and export etc forms
 ;; would modify the module in question: but alack, this is what we have now.
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index 94a9f2a..1777854 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -80,7 +80,8 @@
                (begin
                  (format #t "~a~%" error-msg)
                  (format #t "Entering a new prompt.  ")
-                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")))
+                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
+                 (format #t "~a~&" (debug-prompt frame #f))))
            ((@ (system repl repl) start-repl) #:debug debug)))))
 
     (define (null-trap-handler frame trap-idx trap-name)
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  


[-- Attachment #3: Type: text/plain, Size: 154 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: [PATCH] Initial Guile REPL (guiler) debugger support for GUD.
  2014-08-05 13:21 ` [PATCH] Initial Guile REPL (guiler) debugger support for GUD Jan Nieuwenhuizen
@ 2014-08-09 15:35   ` Stefan Monnier
  2014-08-09 16:10     ` Jan Nieuwenhuizen
  0 siblings, 1 reply; 8+ messages in thread
From: Stefan Monnier @ 2014-08-09 15:35 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guile-devel, emacs-devel

> 	* progmodes/gud.el (guiler): New function.  Starts the Guile REPL;
> 	add Guile debugger support for GUD.

Looks OK, tho please use the new `setq-local' when setting variables
buffer-locally.


        Stefan



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] Initial Guile REPL (guiler) debugger support for GUD.
  2014-08-09 15:35   ` Stefan Monnier
@ 2014-08-09 16:10     ` Jan Nieuwenhuizen
  0 siblings, 0 replies; 8+ messages in thread
From: Jan Nieuwenhuizen @ 2014-08-09 16:10 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: guile-devel, emacs-devel

[-- Attachment #1: Type: text/plain, Size: 320 bytes --]

Stefan Monnier writes:

>> 	* progmodes/gud.el (guiler): New function.  Starts the Guile REPL;
>> 	add Guile debugger support for GUD.
>
> Looks OK, 

That's great, we're going to guile support in GUD!

> tho please use the new `setq-local' when setting variables
> buffer-locally.

New patch attached.

Greetings, Jan


[-- Attachment #2: 0001-Initial-Guile-REPL-guiler-debugger-support-for-GUD.patch --]
[-- Type: text/x-diff, Size: 7013 bytes --]

From 3db1acfeb281f6fbbc8df19164b7f313e37b81ee Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Mon, 4 Aug 2014 11:15:59 +0200
Subject: [PATCH] Initial Guile REPL (guiler) debugger support for GUD.

	* lisp/progmodes/gud.el (guiler): New function.  Starts the
	Guile REPL; add Guile debugger support for GUD.
---
 lisp/ChangeLog        |  5 +++
 lisp/progmodes/gud.el | 89 ++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 89 insertions(+), 5 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b6f16ea..b3da957 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2014-08-05  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+	* progmodes/gud.el (guiler): New function.  Starts the Guile REPL;
+	add Guile debugger support for GUD.
+
 2014-08-03  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Don't mishandle year-9999 dates (Bug#18176).
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index c6fc944..09085f7 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -34,7 +34,8 @@
 ;; and added a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX
 ;; kluge with the gud-xdb-directories hack producing gud-dbx-directories.
 ;; Derek L. Davies <ddavies@world.std.com> added support for jdb (Java
-;; debugger.)
+;; debugger.)  Jan Nieuwenhuizen added support for the Guile REPL (Guile
+;; debugger).
 
 ;;; Code:
 
@@ -140,7 +141,7 @@ Used to gray out relevant toolbar icons.")
 			       (display-graphic-p)
 			       (fboundp 'x-show-tip))
 		  :visible (memq gud-minor-mode
-				'(gdbmi dbx sdb xdb pdb))
+				'(gdbmi guiler dbx sdb xdb pdb))
 	          :button (:toggle . gud-tooltip-mode))
     ([refresh]	"Refresh" . gud-refresh)
     ([run]	menu-item "Run" gud-run
@@ -170,11 +171,11 @@ Used to gray out relevant toolbar icons.")
     ([up]	menu-item "Up Stack" gud-up
 		  :enable (not gud-running)
 		  :visible (memq gud-minor-mode
-				 '(gdbmi gdb dbx xdb jdb pdb)))
+				 '(gdbmi gdb guiler dbx xdb jdb pdb)))
     ([down]	menu-item "Down Stack" gud-down
 		  :enable (not gud-running)
 		  :visible (memq gud-minor-mode
-				 '(gdbmi gdb dbx xdb jdb pdb)))
+				 '(gdbmi gdb guiler dbx xdb jdb pdb)))
     ([pp]	menu-item "Print S-expression" gud-pp
                   :enable (and (not gud-running)
 				  (bound-and-true-p gdb-active-process))
@@ -195,7 +196,7 @@ Used to gray out relevant toolbar icons.")
     ([finish]	menu-item "Finish Function" gud-finish
                   :enable (not gud-running)
 		  :visible (memq gud-minor-mode
-				 '(gdbmi gdb xdb jdb pdb)))
+				 '(gdbmi gdb guiler xdb jdb pdb)))
     ([stepi]	menu-item "Step Instruction" gud-stepi
                   :enable (not gud-running)
 		  :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
@@ -1704,6 +1705,83 @@ and source-file directory for your debugger."
   (run-hooks 'pdb-mode-hook))
 \f
 ;; ======================================================================
+;; Guile REPL (guiler) functions
+
+;; History of argument lists passed to guiler.
+(defvar gud-guiler-history nil)
+
+(defvar gud-guiler-lastfile nil)
+
+(defun gud-guiler-marker-filter (string)
+  (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))
+
+  (let ((start 0))
+    (while
+	(cond
+	 ((string-match "^In \\(.*\\):" gud-marker-acc start)
+          (setq gud-guiler-lastfile (match-string 1 gud-marker-acc)))
+	 ((string-match "^\\([^:\n]+\\):\\([0-9]+\\):\\([0-9]+\\):[^\n]*"
+			gud-marker-acc start)
+          (setq gud-guiler-lastfile (match-string 1 gud-marker-acc))
+          (setq gud-last-frame
+                (cons gud-guiler-lastfile
+                      (string-to-number (match-string 2 gud-marker-acc)))))
+	 ((string-match "^[ ]*\\([0-9]+\\):\\([0-9]+\\)  [^\n]*"
+			gud-marker-acc start)
+          (if gud-guiler-lastfile
+              (setq gud-last-frame
+                    (cons gud-guiler-lastfile
+                          (string-to-number (match-string 1 gud-marker-acc))))))
+	 ((string-match comint-prompt-regexp gud-marker-acc start) t)
+         ((string= (substring gud-marker-acc start) "") nil)
+         (t nil))
+      (setq start (match-end 0)))
+
+    ;; Search for the last incomplete line in this chunk
+    (while (string-match "\n" gud-marker-acc start)
+      (setq start (match-end 0)))
+
+    ;; If we have an incomplete line, store it in gud-marker-acc.
+    (setq gud-marker-acc (substring gud-marker-acc (or start 0))))
+  string)
+
+
+(defcustom gud-guiler-command-name "guile"
+  "File name for executing the Guile debugger.
+This should be an executable on your path, or an absolute file name."
+  :type 'string
+  :group 'gud)
+
+;;;###autoload
+(defun guiler (command-line)
+  "Run guiler on program FILE in buffer `*gud-FILE*'.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger."
+  (interactive
+   (list (gud-query-cmdline 'guiler)))
+
+  (gud-common-init command-line nil 'gud-guiler-marker-filter)
+  (setq-local gud-minor-mode 'guiler)
+
+;; FIXME: absolute file-names are not grokked yet by Guile's ,break-at-source
+;; and relative file names only when relative to %load-path.
+;;  (gud-def gud-break  ",break-at-source %d%f %l"  "\C-b" "Set breakpoint at current line.")
+  (gud-def gud-break  ",break-at-source %f %l"  "\C-b" "Set breakpoint at current line.")
+;; FIXME: remove breakpoint with file-line not yet supported by Guile
+;;  (gud-def gud-remove ",delete ---> %d%f:%l"  "\C-d" "Remove breakpoint at current line")
+  (gud-def gud-step   ",step"         "\C-s" "Step one source line with display.")
+  (gud-def gud-next   ",next"         "\C-n" "Step one line (skip functions).")
+;;  (gud-def gud-cont   "continue"     "\C-r" "Continue with display.")
+  (gud-def gud-finish ",finish"       "\C-f" "Finish executing current function.")
+  (gud-def gud-up     ",up"           "<" "Up one stack frame.")
+  (gud-def gud-down   ",down"         ">" "Down one stack frame.")
+  (gud-def gud-print  "%e"            "\C-p" "Evaluate Guile expression at point.")
+
+  (setq comint-prompt-regexp "^scheme@([^>]+> ")
+  (setq paragraph-start comint-prompt-regexp)
+  (run-hooks 'guiler-mode-hook))
+\f
+;; ======================================================================
 ;;
 ;; JDB support.
 ;;
@@ -3450,6 +3528,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
   "Return a suitable command to print the expression EXPR."
   (pcase gud-minor-mode
     (`gdbmi (concat "-data-evaluate-expression \"" expr "\""))
+    (`guiler expr)
     (`dbx (concat "print " expr))
     ((or `xdb `pdb) (concat "p " expr))
     (`sdb (concat expr "/"))))
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  


[-- Attachment #3: Type: text/plain, Size: 154 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* [PATCH] Initial GUD integration support.
@ 2016-09-25 20:09 Jan Nieuwenhuizen
  2017-03-09 20:49 ` Andy Wingo
  0 siblings, 1 reply; 8+ messages in thread
From: Jan Nieuwenhuizen @ 2016-09-25 20:09 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 1925 bytes --]

Hi!

I'm trying to resurrect and finish my Emacs' Grand Unified Debugger
(GUD) integration patch, but I cannot get latest Guile master's debugger
to respect breakpoints?

This patch mainly tries to have Guile use GNU style error messages when
printing backtraces.  Meanwhile, the Emacs side of thes patches has been
integrated so that should be easier to test now.

With attached patch, try:

$ meta/guile -L ../examples

GNU Guile 2.1.4
Copyright (C) 1995-2016 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> ,m (gud-break)
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling ../examples/gud-break.scm
;;; compiled /home/janneke/src/guile/build/cache/guile/ccache/2.2-LE-8-3.9/home/janneke/src/guile/examples/gud-break.scm.go
scheme@(gud-break)> ,br main
Trap 0: Breakpoint at #<procedure main args>.
scheme@(gud-break)> (main)
((line . 35) (column . 29) (filename . gud-break.scm)):hello world
set: a=1
set: b=2
set: c=3
set: d=4
((line . 50) (column . 30) (filename . gud-break.scm)):leaving...
((line . 51) (column . 31) (filename . gud-break.scm)):goodbye world
scheme@(gud-break)> ,break-at /home/janneke/src/guile/examples/gud-break.scm 36

;;; WARNING (no instructions found for /home/janneke/src/guile/examples/gud-break.scm : 35)
Trap 1: Breakpoint at /home/janneke/src/guile/examples/gud-break.scm:36.
scheme@(gud-break)> (main)
((line . 35) (column . 29) (filename . gud-break.scm)):hello world
set: a=1
set: b=2
set: c=3
set: d=4
((line . 50) (column . 30) (filename . gud-break.scm)):leaving...
((line . 51) (column . 31) (filename . gud-break.scm)):goodbye world
scheme@(gud-break)>

Greetings,
Jan


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Initial-GUD-integration-support.patch --]
[-- Type: text/x-patch, Size: 9321 bytes --]

From 0b220974b0288a0de1d892b7111165ce609033b1 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 5 Aug 2014 12:34:09 +0200
Subject: [PATCH] Initial GUD integration support.

* examples/gud-break.scm: New example; showing initial GUD
integration.
* module/system/repl/debug.scm (debug-prompt): New procedure;
gdb-like debug prompt.  Experimental!
* module/system/repl/error-handling.scm (call-with-error-handling):
* module/system/repl/command.scm (step, step-instruction, next)
(next-instruction): Use it.
---
 examples/gud-break.scm                | 56 ++++++++++++++++++++++++
 module/system/repl/command.scm        |  8 ++--
 module/system/repl/debug.scm          | 80 +++++++++++++++++++++++++++++++++++
 module/system/repl/error-handling.scm |  3 +-
 4 files changed, 142 insertions(+), 5 deletions(-)
 create mode 100644 examples/gud-break.scm

diff --git a/examples/gud-break.scm b/examples/gud-break.scm
new file mode 100644
index 0000000..dbef6f3
--- /dev/null
+++ b/examples/gud-break.scm
@@ -0,0 +1,56 @@
+#! /bin/sh
+# -*-scheme-*-
+exec guile -e main -s "$0" "$@"
+!#
+;; Experimental GUD support for Guile REPL
+;; Find a gud.el that you want to patch, e.g.
+;;     zcat /usr/share/emacs/24.3/lisp/progmodes/gud.el.gz > ~/.emacs.d/gud.el
+;; or
+;;     M-x find-function gdb RET
+;;     C-x C-w ~/.emacs.d/gud.el RET
+;; Patch it
+;;     patch ~/.emacs.d/gud.el < 0001-Initial-Guile-REPL-guiler-debugger-support-for-GUD.patch
+;; M-x load-library ~/.emacs.d/gud.el RET
+;; M-x guiler RET
+;; ,m gud-break
+;; ,br main
+;; (main)
+;; ,n
+;; ,n # no easy RET shortcut yet
+;;
+;; And see |> marker in Emac's left margin track the program's execution.
+
+(read-set! keywords 'prefix)
+
+(define (main . args)
+  (eval '(main (command-line)) (resolve-module '(gud-break))))
+
+(define-module (gud-break)
+  :export (main))
+
+(define (stderr fmt . args)
+  (apply format (cons (current-error-port) (cons* fmt args)))
+  (force-output (current-error-port)))
+
+(define (main . args) 
+  (stderr "~a:hello world\n" (current-source-location))
+  (let
+      ((a #f)
+       (b #f))
+    (set! a 1)
+    (stderr "set: a=~a\n" a)
+    (set! b 2)
+    (stderr "set: b=~a\n" b)
+    (let
+        ((c #f)
+         (d #f))
+      (set! c 3)
+      (stderr "set: c=~a\n" c)
+      (set! d 4)
+      (stderr "set: d=~a\n" d))
+    (stderr "~a:leaving...\n" (current-source-location)))
+  (stderr "~a:goodbye world\n" (current-source-location)))
+
+
+
+
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index acb18e0..6be9ba3 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -735,7 +735,7 @@ Resume execution, breaking when the current frame finishes."
 Step until control reaches a different source location.
 
 Step until control reaches a different source location."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #t #:instruction? #f)
     (throw 'quit)))
@@ -745,7 +745,7 @@ Step until control reaches a different source location."
 Step until control reaches a different instruction.
 
 Step until control reaches a different VM instruction."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #t #:instruction? #t)
     (throw 'quit)))
@@ -755,7 +755,7 @@ Step until control reaches a different VM instruction."
 Step until control reaches a different source location in the current frame.
 
 Step until control reaches a different source location in the current frame."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #f #:instruction? #f)
     (throw 'quit)))
@@ -765,7 +765,7 @@ Step until control reaches a different source location in the current frame."
 Step until control reaches a different instruction in the current frame.
 
 Step until control reaches a different VM instruction in the current frame."
-  (let ((msg (format #f "Step into ~a" cur)))
+  (let ((msg (debug-prompt cur)))
     (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                   #:into? #f #:instruction? #t)
     (throw 'quit)))
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 55062d7..90e4724 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -27,6 +27,7 @@
   #:use-module (system vm debug)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 and-let-star)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 pretty-print)
   #:use-module ((system vm inspect) #:select ((inspect . %inspect)))
@@ -34,6 +35,7 @@
   #:export (<debug>
             make-debug debug?
             debug-frames debug-index debug-error-message
+            debug-prompt
             terminal-width
             print-registers print-locals print-frame print-frames
             stack->vector narrow-stack->vector
@@ -164,6 +166,84 @@
             (lp (+ i inc)
                 (frame-source frame)))))))
 
+(define *source-alist* '())
+(define (source-add file-name source)
+  (set! *source-alist* (assoc-set! *source-alist* file-name source))
+  source)
+
+(define (read-source-file file-name)
+  (or (assoc-ref *source-alist* file-name)
+      (and-let* ((source (with-input-from-file file-name read-string))
+                 (lines (string-split source #\newline)))
+                (source-add file-name lines))))
+
+(define (fs-find-file file-name)
+  (if (file-exists? file-name) 
+      file-name
+      (%search-load-path file-name)))
+
+(define (relative-file-name file-name)
+  (let ((cwd (getcwd)))
+    (if (and file-name (string-prefix? cwd file-name))
+        (string-drop file-name (1+ (string-length cwd)))
+        file-name)))
+
+(define (source-code file-name line-number)
+  (or (and-let* ((file-name file-name)
+                 (line-number line-number)
+                 (lines (read-source-file file-name)))
+                (list-ref lines line-number))
+      ""))
+
+(define *last-source* #f)
+(define* (debug-prompt frame #:optional (last-source *last-source*) (message ""))
+  "A gdb,pydb-like debug prompt."
+  (define (source:pretty-file source)
+    (if source
+        (or (source:file source) "current input")
+        "unknown file"))
+  (let* ((source (frame-source frame))
+         (file (source:pretty-file source))
+         (file-name (relative-file-name (fs-find-file file)))
+         (line (and=> source source:line))
+         (col (and=> source source:column))
+         (code (source-code file-name line))
+         (line-column (format #f "~a~a" (if line (1+ line) "") 
+                              (if col (format #f ":~a" col) ""))))
+    (set! *last-source* source)
+    (string-append
+     (if (and file (not (equal? file (source:pretty-file last-source))))
+         (format #f "~&~a:~a:~a~&" file-name line-column message) ;;GNU standard!
+         ;;(format #f "~&In ~a:~a~&" file-name message) ;;or awkward Guile convention?
+         "")
+     (format #f "~&~10a~a" line-column code))))
+
+;; Ideally here we would have something much more syntactic, in that a set! to a
+;; local var that is not settable would raise an error, and export etc forms
+;; would modify the module in question: but alack, this is what we have now.
+;; Patches welcome!
+(define (frame->module frame)
+  (let ((proc (frame-procedure frame)))
+    (if #f
+        ;; FIXME: program-module does not exist.
+        (let* ((mod (or (program-module proc) (current-module)))
+               (mod* (make-module)))
+          (module-use! mod* mod)
+          (for-each
+           (lambda (binding)
+             (let* ((x (frame-local-ref frame (binding-slot binding)))
+                    (var (if (variable? x) x (make-variable x))))
+               (format #t
+                       "~:[Read-only~;Mutable~] local variable ~a = ~70:@y\n"
+                       (not (variable? x))
+                       (binding-name binding)
+                       (if (variable-bound? var) (variable-ref var) var))
+               (module-add! mod* (binding-name binding) var)))
+           (frame-bindings frame))
+          mod*)
+        (current-module))))
+
+
 (define (stack->vector stack)
   (let* ((len (stack-length stack))
          (v (make-vector len)))
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index 94a9f2a..1777854 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -80,7 +80,8 @@
                (begin
                  (format #t "~a~%" error-msg)
                  (format #t "Entering a new prompt.  ")
-                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")))
+                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
+                 (format #t "~a~&" (debug-prompt frame #f))))
            ((@ (system repl repl) start-repl) #:debug debug)))))
 
     (define (null-trap-handler frame trap-idx trap-name)
-- 
2.9.3


[-- Attachment #3: Type: text/plain, Size: 154 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: [PATCH] Initial GUD integration support.
  2016-09-25 20:09 [PATCH] Initial GUD integration support Jan Nieuwenhuizen
@ 2017-03-09 20:49 ` Andy Wingo
  0 siblings, 0 replies; 8+ messages in thread
From: Andy Wingo @ 2017-03-09 20:49 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guile-devel

On Sun 25 Sep 2016 22:09, Jan Nieuwenhuizen <janneke@gnu.org> writes:

> I'm trying to resurrect and finish my Emacs' Grand Unified Debugger
> (GUD) integration patch, but I cannot get latest Guile master's debugger
> to respect breakpoints?

Sorry for breaking this!  It is fixed in master and will be in 2.1.8.

Andy



^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2017-03-09 20:49 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-08-05 13:21 Initial GUD integration for Guile Jan Nieuwenhuizen
2014-08-05 13:21 ` [PATCH] Initial GUD integration support Jan Nieuwenhuizen
2014-08-05 13:21 ` [PATCH] Initial Guile REPL (guiler) debugger support for GUD Jan Nieuwenhuizen
2014-08-09 15:35   ` Stefan Monnier
2014-08-09 16:10     ` Jan Nieuwenhuizen
2014-08-08 20:34 ` Initial GUD integration for Guile Jan Nieuwenhuizen
  -- strict thread matches above, loose matches on Subject: below --
2016-09-25 20:09 [PATCH] Initial GUD integration support Jan Nieuwenhuizen
2017-03-09 20:49 ` Andy Wingo

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).