diff options
Diffstat (limited to 'repl.scm')
| -rw-r--r-- | repl.scm | 81 |
1 files changed, 41 insertions, 40 deletions
@@ -1,5 +1,5 @@ ; "repl.scm", read-eval-print-loop for Scheme -; Copyright (c) 1993, Aubrey Jaffer +; Copyright (c) 1993, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -17,9 +17,13 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require 'values) (require 'dynamic-wind) +(require-if 'compiling 'qp) +(require-if 'compiling 'debug) +;@ (define (repl:quit) (slib:error "not in repl:repl")) - +;@ (define (repl:top-level repl:eval) (repl:repl (lambda () (display "> ") (force-output (current-output-port)) @@ -49,44 +53,41 @@ (repl:eval o)) (set! *load-pathname* old-load-pathname)))))) (repl:restart #f) - (values? (provided? 'values)) (has-char-ready? (provided? 'char-ready?)) (repl:error (lambda args (require 'debug) (apply qpn args) (repl:restart #f)))) (dynamic-wind - (lambda () - (set! load repl:load) - (set! slib:eval repl:eval) - (set! slib:error repl:error) - (set! repl:quit - (lambda () (let ((cont repl:restart)) - (set! repl:restart #f) - (cont #t))))) - (lambda () - (do () ((call-with-current-continuation - (lambda (cont) - (set! repl:restart cont) - (do ((obj (repl:read) (repl:read))) - ((eof-object? obj) (repl:quit)) - (cond - (has-char-ready? - (let loop () - (cond ((char-ready?) - (let ((c (peek-char))) - (cond - ((eof-object? c)) - ((char=? #\newline c) (read-char)) - ((char-whitespace? c) - (read-char) (loop)) - (else (newline))))))))) - (if values? - (call-with-values (lambda () (repl:eval obj)) - repl:print) - (repl:print (repl:eval obj))))))))) - (lambda () (cond (repl:restart - (display ">>ERROR<<") (newline) - (repl:restart #f))) - (set! load old-load) - (set! slib:eval old-eval) - (set! slib:error old-error) - (set! repl:quit old-quit))))) + (lambda () + (set! load repl:load) + (set! slib:eval repl:eval) + (set! slib:error repl:error) + (set! repl:quit + (lambda () (let ((cont repl:restart)) + (set! repl:restart #f) + (cont #t))))) + (lambda () + (do () ((call-with-current-continuation + (lambda (cont) + (set! repl:restart cont) + (do ((obj (repl:read) (repl:read))) + ((eof-object? obj) (repl:quit)) + (cond + (has-char-ready? + (let loop () + (cond ((char-ready?) + (let ((c (peek-char))) + (cond + ((eof-object? c)) + ((char=? #\newline c) (read-char)) + ((char-whitespace? c) + (read-char) (loop)) + (else (newline))))))))) + (call-with-values (lambda () (repl:eval obj)) + repl:print))))))) + (lambda () (cond (repl:restart + (display ">>ERROR<<") (newline) + (repl:restart #f))) + (set! load old-load) + (set! slib:eval old-eval) + (set! slib:error old-error) + (set! repl:quit old-quit))))) |