Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-14 16:37:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Patch from Alan Watson for nicer handling of multiple value results

Browse source 
in the repl, and also evaling multiple sexps on the same input line.
This commit is contained in:
Alex Shinn 2012-07-16 17:46:13 +09:00
parent 582a3295d4
commit 89dfe9ab35
1 changed files with 34 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
lib/chibi/repl.scm
View file

@ -104,6 +104,13 @@
;;> @item{@scheme|{@exit}| - exit the REPL} ;;> @item{@scheme|{@exit}| - exit the REPL}
;;> ] ;;> ]
(define (read/ss/all port)
(let loop ((l '()))
(let ((x (read/ss port)))
(if (eof-object? x)
(reverse l)
(loop (cons x l))))))
(define (repl . o) (define (repl . o)
(let* ((in (cond ((memq 'in: o) => cadr) (else (current-input-port)))) (let* ((in (cond ((memq 'in: o) => cadr) (else (current-input-port))))
(out (cond ((memq 'out: o) => cadr) (else (current-output-port)))) (out (cond ((memq 'out: o) => cadr) (else (current-output-port))))
@ -221,15 +228,16 @@
;; The outer guard in the parent thread catches read ;; The outer guard in the parent thread catches read
;; errors and errors in the repl logic itself. ;; errors and errors in the repl logic itself.
(guard (exn (else (print-exception exn (current-error-port)))) (guard (exn (else (print-exception exn (current-error-port))))
(let* ((expr (call-with-input-string line (let* ((expr-list
(lambda (in2) (call-with-input-string line
;; Ugly wrapper to account for the (lambda (in2)
;; implicit state mutation implied by ;; Ugly wrapper to account for the
;; the #!fold-case read syntax. ;; implicit state mutation implied by
(set-port-fold-case! in2 (port-fold-case? in)) ;; the #!fold-case read syntax.
(let ((expr (read/ss in2))) (set-port-fold-case! in2 (port-fold-case? in))
(set-port-fold-case! in (port-fold-case? in2)) (let ((expr-list (read/ss/all in2)))
expr)))) (set-port-fold-case! in (port-fold-case? in2))
expr-list))))
(thread (thread
(make-thread (make-thread
(lambda () (lambda ()
@ -238,11 +246,23 @@
(guard (guard
(exn (exn
(else (print-exception exn (current-output-port)))) (else (print-exception exn (current-output-port))))
(let ((res (eval expr env))) (for-each
(cond (lambda (expr)
((not (eq? res (if #f #f))) (call-with-values
(write/ss res out) (lambda ()
(newline out))))))))) (eval (list 'begin expr) env))
(lambda res-list
(cond
((not (or (null? res-list)
(equal? res-list (list (if #f #f)))))
(write/ss (car res-list) out)
(for-each
(lambda (res)
(write-char #\space out)
(write/ss res out))
(cdr res-list))
(newline out))))))
expr-list))))))
;; If an interrupt occurs while the child thread is ;; If an interrupt occurs while the child thread is
;; still running, terminate it, otherwise wait for it ;; still running, terminate it, otherwise wait for it
;; to complete. ;; to complete.