vm no longer measures bogoclock or times, relies on os for that
[bpt/guile.git] / module / system / repl / repl.scm
index 93f20c5..a3496f3 100644 (file)
@@ -1,26 +1,26 @@
 ;;; Read-Eval-Print Loop
 
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
 
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; This library is free software; you can redistribute it and/or
+;; 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 program is distributed in the hope that it will be useful,
+;; 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 General Public License for more details.
+;; 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 General Public License
-;; along with this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; 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
+;; 02110-1301 USA
 
 ;;; Code:
 
 (define-module (system repl repl)
-  #:use-syntax (system base syntax)
+  #:use-module (system base syntax)
   #:use-module (system base pmatch)
   #:use-module (system base compile)
   #:use-module (system base language)
   #:use-module (system repl command)
   #:use-module (system vm vm)
   #:use-module (system vm debug)
-  #:use-module (ice-9 rdelim)
   #:export (start-repl call-with-backtrace))
 
 (define meta-command-token (cons 'meta 'command))
 
-(define (meta-reader read)
+(define (meta-reader read env)
   (lambda read-args
-    (with-input-from-port
-        (if (pair? read-args) (car read-args) (current-input-port))
-      (lambda ()
-        (if (eqv? (next-char #t) #\,)
-            (begin (read-char) meta-command-token)
-            (read))))))
+    (let ((port (if (pair? read-args) (car read-args) (current-input-port))))
+      (with-input-from-port port
+        (lambda ()
+          (let ((ch (next-char #t)))
+            (cond ((eof-object? ch)
+                   ;; apparently sometimes even if this is eof, read will
+                   ;; wait on somethingorother. strange.
+                   ch)
+                  ((eqv? ch #\,)
+                   (read-char port)
+                   meta-command-token)
+                  (else (read port env)))))))))
         
 ;; repl-reader is a function defined in boot-9.scm, and is replaced by
 ;; something else if readline has been activated. much of this hoopla is
 ;; to be able to re-use the existing readline machinery.
 (define (prompting-meta-read repl)
-  (let ((prompt (lambda () (repl-prompt repl)))
-        (lread (language-reader (repl-language repl))))
-    (with-fluid* current-reader (meta-reader lread)
-      (lambda () (repl-reader (lambda () (repl-prompt repl)))))))
+  (repl-reader (lambda () (repl-prompt repl))
+               (meta-reader (language-reader (repl-language repl))
+                            (current-module))))
 
 (define (default-catch-handler . args)
   (pmatch args
@@ -83,7 +87,7 @@
   (catch #t
          (lambda () (%start-stack #t thunk))
          default-catch-handler
-         pre-unwind-handler-dispatch))
+         default-pre-unwind-handler))
 
 (define-macro (with-backtrace form)
   `(call-with-backtrace (lambda () ,form)))
         (cond
          ((eqv? exp (if #f #f))) ; read error, pass
          ((eq? exp meta-command-token)
-          (with-backtrace (meta-command repl (read-line))))
+          (with-backtrace (meta-command repl)))
          ((eof-object? exp)
           (newline)
           (set! status '()))
          (else
+          ;; since the input port is line-buffered, consume up to the
+          ;; newline
+          (flush-to-newline)
           (with-backtrace
            (catch 'quit
                   (lambda ()
              ((char-whitespace? ch) (read-char) (next-char wait))
              (else ch)))
       #f))
+
+(define (flush-to-newline) 
+  (if (char-ready?)
+      (let ((ch (peek-char)))
+        (if (and (not (eof-object? ch)) (char-whitespace? ch))
+            (begin
+              (read-char)
+              (if (not (char=? ch #\newline))
+                  (flush-to-newline)))))))
+          
+          
\ No newline at end of file