recursive repl support

* module/system/repl/common.scm (*repl-level*): New public fluid.
  (repl-prompt): If *repl-level* is a positive integer, add it to the
  prompt.

* module/system/repl/repl.scm (start-repl): The `lang' argument is now
  optional, and defaults to (current-language). New kwargs level and
  welcome; level defaults to 0, or 1+ the existing level, and the
  welcome is a boolean, true if level is 0. Parameterize *repl-level*
  during the dynamic extent of this repl. Also, parameterize
  the-last-stack to #f for the duration of this repl.

* module/system/vm/debug.scm (frame->module, debugger-repl): Stubs of a
  recursive repl implementation. The idea is to be a repl in the lexical
  context of the error; but it would be nice to be able to operate in
  the module of the proc too, for example to export bindings. Hmm.

module/system/repl/common.scm

@@ -29,7 +29,8 @@
             repl-welcome repl-prompt repl-read repl-compile repl-eval
             repl-parse repl-print repl-option-ref repl-option-set!
             puts ->string user-error
-            *warranty* *copying* *version*))
+            *warranty* *copying* *version*
+            *repl-level*))
 
 (define *version*
   (format #f "GNU Guile ~A
@@ -93,6 +94,8 @@ copy of the Program in return for a fee.
 
 See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
 
+(define *repl-level* (make-fluid))
+
 
 ;;;
 ;;; Repl type
@@ -118,8 +121,10 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
   (display "Enter `,help' for help.\n"))
 
 (define (repl-prompt repl)
-  (format #f "~A@~A> " (language-name (repl-language repl))
+  (format #f "~A@~A~A> " (language-name (repl-language repl))
-          (module-name (current-module))))
+          (module-name (current-module))
+          (let ((level (or (fluid-ref *repl-level*) 0)))
+            (if (zero? level) "" (format #f " [~a]" level)))))
 
 (define (repl-read repl)
   ((language-reader (repl-language repl)) (current-input-port)

module/system/repl/repl.scm

@@ -1,6 +1,6 @@
 ;;; Read-Eval-Print Loop
 
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 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
@@ -92,10 +92,15 @@
 (define-macro (with-backtrace form)
   `(call-with-backtrace (lambda () ,form)))
 
-(define (start-repl lang)
+(define* (start-repl #:optional (lang (current-language)) #:key
+                     (level (1+ (or (fluid-ref *repl-level*) -1)))
+                     (welcome (equal? level 0)))
   (let ((repl (make-repl lang))
         (status #f))
-    (repl-welcome repl)
+    (if welcome
+        (repl-welcome repl))
+    (with-fluids ((*repl-level* level)
+                  (the-last-stack #f))
       (let prompt-loop ()
         (let ((exp (with-backtrace (prompting-meta-read repl))))
           (cond
@@ -127,7 +132,7 @@
           (or status
               (begin
                 (next-char #f) ;; consume trailing whitespace
-              (prompt-loop)))))))
+                (prompt-loop))))))))
 
 (define (next-char wait)
   (if (or wait (char-ready?))

module/system/vm/debug.scm

@@ -21,6 +21,7 @@
 (define-module (system vm debug)
   #:use-module (system base pmatch)
   #:use-module (system base syntax)
+  #:use-module (system base language)
   #:use-module (system vm vm)
   #:use-module (system vm frame)
   #:use-module (ice-9 rdelim)
@@ -139,6 +140,15 @@
                               #:per-line-prefix "     "))
             (lp (+ i inc) (or file last-file)))))))
 
+(define (frame->module frame)
+  (let ((proc (frame-procedure frame)))
+    (if (program? proc)
+        (let* ((mod (or (program-module proc) (current-module )))
+               (mod* (make-module)))
+          (module-use! mod* mod)
+          mod*)
+        (current-module))))
+
 
 ;;;
 ;;; Debugger
@@ -289,6 +299,13 @@ With an argument, select a frame by index, then show it."
             (format #t "No such frame.~%"))))
          (else (show-frame))))
 
+      (define-command ((commands repl r))
+        "Run a new REPL in the context of the current frame."
+        (save-module-excursion
+         (lambda ()
+           (set-current-module (frame->module cur))
+           ((@ (system repl repl) start-repl)))))
+
       (define-command ((commands procedure proc))
         "Print the procedure for the selected frame."
         (print* (frame-procedure cur)))