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}
;;> ]
(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)
(let* ((in (cond ((memq 'in: o) => cadr) (else (current-input-port))))
(out (cond ((memq 'out: o) => cadr) (else (current-output-port))))
@ -221,15 +228,16 @@
;; The outer guard in the parent thread catches read
;; errors and errors in the repl logic itself.
(guard (exn (else (print-exception exn (current-error-port))))
(let* ((expr (call-with-input-string line
(lambda (in2)
;; Ugly wrapper to account for the
;; implicit state mutation implied by
;; the #!fold-case read syntax.
(set-port-fold-case! in2 (port-fold-case? in))
(let ((expr (read/ss in2)))
(set-port-fold-case! in (port-fold-case? in2))
expr))))
(let* ((expr-list
(call-with-input-string line
(lambda (in2)
;; Ugly wrapper to account for the
;; implicit state mutation implied by
;; the #!fold-case read syntax.
(set-port-fold-case! in2 (port-fold-case? in))
(let ((expr-list (read/ss/all in2)))
(set-port-fold-case! in (port-fold-case? in2))
expr-list))))
(thread
(make-thread
(lambda ()
@ -238,11 +246,23 @@
(guard
(exn
(else (print-exception exn (current-output-port))))
(let ((res (eval expr env)))
(cond
((not (eq? res (if #f #f)))
(write/ss res out)
(newline out)))))))))
(for-each
(lambda (expr)
(call-with-values
(lambda ()
(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
;; still running, terminate it, otherwise wait for it
;; to complete.