From 652f48c062cbc82fc4c7d3028cd1ae8c1bf31f9f Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sat, 26 Jun 2010 22:28:21 +0200
Subject: [PATCH] use *repl-stack* instead of *repl-level*

* module/ice-9/boot-9.scm (*repl-stack*): Instead of repl-level, have a
  stack.
  (batch-mode?): Change to poke the stack.

* module/ice-9/deprecated.scm (set-batch-mode?!): Update deprecation
  method.

* module/system/repl/common.scm (repl-prompt): Update to poke
  *repl-stack* to get the level.

* module/system/repl/repl.scm (start-repl): Bind *repl-stack*
  appropriately.
---
 module/ice-9/boot-9.scm       |  4 ++--
 module/ice-9/deprecated.scm   |  2 +-
 module/system/repl/common.scm |  2 +-
 module/system/repl/repl.scm   | 17 +++++++++++------
 4 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index c7358164f..f8b3eb064 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2684,14 +2684,14 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Running Repls}
 ;;;
 
-(define *repl-level* (make-fluid))
+(define *repl-stack* (make-fluid))
 
 ;; Programs can call `batch-mode?' to see if they are running as part of a
 ;; script or if they are running interactively. REPL implementations ensure that
 ;; `batch-mode?' returns #f during their extent.
 ;;
 (define (batch-mode?)
-  (negative? (or (fluid-ref *repl-level*) -1)))
+  (null? (or (fluid-ref *repl-stack*) '())))
 
 ;; Programs can re-enter batch mode, for example after a fork, by calling
 ;; `ensure-batch-mode!'. It's not a great interface, though; it would be better
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 1ce98f244..d809b736d 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -616,7 +616,7 @@ the `(system repl common)' module.")
    (else
     (issue-deprecation-warning
      "`set-batch-mode?!' with an argument of `#f' is deprecated. Use the
-`*repl-level*' fluid instead.")
+`*repl-stack*' fluid instead.")
     #t)))
 
 (define (repl read evaler print)
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index b60a2c448..97a8a7fbf 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -130,7 +130,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
    (else
     (format #f "~A@~A~A> " (language-name (repl-language repl))
             (module-name (current-module))
-            (let ((level (or (fluid-ref *repl-level*) 0)))
+            (let ((level (length (or (fluid-ref *repl-stack*) '()))))
               (if (zero? level) "" (format #f " [~a]" level)))))))
 
 (define (repl-read repl)
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 503191fdd..48c6eb0f8 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -60,18 +60,23 @@
                                (current-module))))
    #:on-error 'pass))
 
-(define* (start-repl #:optional (lang (current-language)) #:key
-                     (level (1+ (or (fluid-ref *repl-level*) -1)))
-                     (welcome (equal? level 0)))
+
+
+;;;
+;;; The repl
+;;;
+
+(define* (start-repl #:optional (lang (current-language)))
   (let ((repl (make-repl lang))
         (status #f))
-    (if welcome
-        (repl-welcome repl))
-    (with-fluids ((*repl-level* level)
+    (with-fluids ((*repl-stack* (cons repl
+                                      (or (fluid-ref *repl-stack*) '())))
                   (*debug-input-port*
                    (or (fluid-ref *debug-input-port*) (current-input-port)))
                   (*debug-output-port*
                    (or (fluid-ref *debug-output-port*) (current-output-port))))
+      (if (null? (cdr (fluid-ref *repl-stack*)))
+          (repl-welcome repl))
       (let prompt-loop ()
         (let ((exp (prompting-meta-read repl)))
           (cond