[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-163-gffe911f

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=ffe911f714d7064a42bb4e34e1add4e0a7ea398b

The branch, master has been updated
       via  ffe911f714d7064a42bb4e34e1add4e0a7ea398b (commit)
       via  0ddbd88321fbddb581f642eea12bd713555d2f87 (commit)
       via  97b3800e881887eb6b344a6be6f49f123edb1000 (commit)
       via  3ae78d95e62e36078bb86e22450f2e7830ea2ddf (commit)
      from  33df2ec719d281c70a5c7595dceee9f47770e910 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit ffe911f714d7064a42bb4e34e1add4e0a7ea398b
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 9 18:58:01 2010 +0200

    avoid running the debugger during parsing or compilation at the repl
    
    * module/system/repl/repl.scm (abort-on-error): New helper.
      (run-repl): Don't enter the debugger during parsing or compilation of
      a repl expression. If you want to debug compilation, run compilation
      from the repl, not as part of the repl.

commit 0ddbd88321fbddb581f642eea12bd713555d2f87
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 9 18:39:15 2010 +0200

    fix up a repl command docstring
    
    * module/system/repl/command.scm (procedure): Fix up docstring.

commit 97b3800e881887eb6b344a6be6f49f123edb1000
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 9 18:34:24 2010 +0200

    tweaks to print-locals
    
    * module/system/repl/debug.scm (print-locals): Run the before-print-hook
      on the values, so we can hook into (ice-9 history) if available. Don't
      bother printing binding indices. Give a little per-line-prefix.

commit 3ae78d95e62e36078bb86e22450f2e7830ea2ddf
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 9 18:22:08 2010 +0200

    tweaks to new repl
    
    * module/system/repl/command.scm (read-command): Remove a pk.
    * module/system/repl/repl.scm (run-repl): Export. Use % and abort to
      implement the prompt.

-----------------------------------------------------------------------

Summary of changes:
 module/system/repl/command.scm |    6 +--
 module/system/repl/debug.scm   |   20 +++----
 module/system/repl/repl.scm    |  106 ++++++++++++++++++++++++----------------
 3 files changed, 74 insertions(+), 58 deletions(-)

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 7b092e6..54a9ef5 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -128,7 +128,7 @@
 
 (define (read-command repl)
   (catch #t
-    (lambda () (read (pk (repl-inport repl))))
+    (lambda () (read (repl-inport repl)))
     (lambda (key . args)
       (pmatch args
         ((,subr ,msg ,args . ,rest)
@@ -550,9 +550,7 @@ With an argument, select a frame by index, then show it."
 
 (define-stack-command (procedure repl)
   "procedure
-Print the procedure for the selected frame.
-
-Foo."
+Print the procedure for the selected frame."
   (repl-print repl (frame-procedure cur)))
       
 (define-stack-command (locals repl)
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index f9b6af2..361498a 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -57,7 +57,7 @@
     ret))
 
 (define* (print-locals frame #:optional (port (current-output-port))
-                       #:key (width 72) (per-line-prefix ""))
+                       #:key (width 72) (per-line-prefix "  "))
   (let ((bindings (frame-bindings frame)))
     (cond
      ((null? bindings)
@@ -66,16 +66,14 @@
       (format port "~aLocal variables:~%" per-line-prefix)
       (for-each
        (lambda (binding)
-         (format port "~a~4d ~a~:[~; (boxed)~] = ~v:@y\n"
-                 per-line-prefix
-                 (binding:index binding)
-                 (binding:name binding)
-                 (binding:boxed? binding)
-                 width
-                 (let ((x (frame-local-ref frame (binding:index binding))))
-                   (if (binding:boxed? binding)
-                       (variable-ref x)
-                       x))))
+         (let ((v (let ((x (frame-local-ref frame (binding:index binding))))
+                    (if (binding:boxed? binding)
+                        (variable-ref x)
+                        x))))
+           (display per-line-prefix port)
+           (run-hook before-print-hook v)
+           (format port "~a~:[~; (boxed)~] = ~v:@y\n"
+                   (binding:name binding) (binding:boxed? binding) width v)))
        (frame-bindings frame))))))
 
 (define* (print-frame frame #:optional (port (current-output-port))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index ce309a9..fba6776 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -28,7 +28,8 @@
   #:use-module (system repl error-handling)
   #:use-module (system repl common)
   #:use-module (system repl command)
-  #:export (start-repl))
+  #:use-module (ice-9 control)
+  #:export (start-repl run-repl))
 
 
 
@@ -88,50 +89,69 @@
 (define* (start-repl #:optional (lang (current-language)) #:key debug)
   (run-repl (make-repl lang debug)))
 
+;; (put 'abort-on-error 'scheme-indent-function 1)
+(define-syntax abort-on-error
+  (syntax-rules ()
+    ((_ string exp)
+     (catch #t
+       (lambda () exp)
+       (lambda (key . args)
+         (format #t "While ~A:~%" string)
+         (pmatch args
+           ((,subr ,msg ,args . ,rest)
+            (display-error #f (current-output-port) subr msg args rest))
+           (else
+            (format #t "ERROR: Throw to key `~a' with args `~s'.\n" key args)))
+         (force-output)
+         (abort))))))
+
 (define (run-repl repl)
-  (let ((tag (make-prompt-tag "repl ")))
-    (call-with-prompt
-     tag
-     (lambda ()
-       (with-fluids ((*repl-stack*
-                      (cons repl (or (fluid-ref *repl-stack*) '()))))
-         (if (null? (cdr (fluid-ref *repl-stack*)))
-             (repl-welcome repl))
-         (let prompt-loop ()
-           (let ((exp (prompting-meta-read repl)))
-             (cond
-              ((eqv? exp *unspecified*))   ; read error, pass
-              ((eq? exp meta-command-token)
-               (catch 'quit
-                 (lambda () (meta-command repl))
-                 (lambda (k . args)
-                   (abort-to-prompt tag args))))
-              ((eof-object? exp)
-               (newline)
-               (abort-to-prompt tag '()))
-              (else
-               ;; since the input port is line-buffered, consume up to the
-               ;; newline
-               (flush-to-newline)
-               (call-with-error-handling
-                (lambda ()
-                  (catch 'quit
-                    (lambda ()
-                      (call-with-values
-                          (lambda ()
-                            (run-hook before-eval-hook exp)
-                            (start-stack #t
-                                         (repl-eval repl (repl-parse repl 
exp))))
-                        (lambda l
-                          (for-each (lambda (v)
-                                      (repl-print repl v))
-                                    l))))
-                    (lambda (k . args)
-                      (abort-to-prompt tag args)))))))
-             (next-char #f) ;; consume trailing whitespace
-             (prompt-loop)))))
+  (% (with-fluids ((*repl-stack*
+                    (cons repl (or (fluid-ref *repl-stack*) '()))))
+       (if (null? (cdr (fluid-ref *repl-stack*)))
+           (repl-welcome repl))
+       (let prompt-loop ()
+         (let ((exp (prompting-meta-read repl)))
+           (cond
+            ((eqv? exp *unspecified*))  ; read error, pass
+            ((eq? exp meta-command-token)
+             (catch 'quit
+               (lambda () (meta-command repl))
+               (lambda (k . args)
+                 (abort args))))
+            ((eof-object? exp)
+             (newline)
+             (abort '()))
+            (else
+             ;; since the input port is line-buffered, consume up to the
+             ;; newline
+             (flush-to-newline)
+             (call-with-error-handling
+              (lambda ()
+                (catch 'quit
+                  (lambda ()
+                    (call-with-values
+                        (lambda ()
+                          (% (let ((thunk
+                                    (abort-on-error "compiling expression"
+                                      (repl-prepare-eval-thunk
+                                       repl
+                                       (abort-on-error "parsing expression"
+                                         (repl-parse repl exp))))))
+                               (run-hook before-eval-hook exp)
+                               (with-error-handling
+                                 (start-stack #t (% (thunk)))))
+                             (lambda (k) (values))))
+                      (lambda l
+                        (for-each (lambda (v)
+                                    (repl-print repl v))
+                                  l))))
+                  (lambda (k . args)
+                    (abort args)))))))
+           (next-char #f) ;; consume trailing whitespace
+           (prompt-loop))))
      (lambda (k status)
-       status))))
+       status)))
 
 (define (next-char wait)
   (if (or wait (char-ready?))


hooks/post-receive
-- 
GNU Guile