diff options
| -rw-r--r-- | starling/repl.scm | 66 |
1 files changed, 42 insertions, 24 deletions
diff --git a/starling/repl.scm b/starling/repl.scm index 47947c0..b972b5f 100644 --- a/starling/repl.scm +++ b/starling/repl.scm @@ -27,6 +27,7 @@ #:use-module (chickadee math rect) #:use-module (chickadee math vector) #:use-module (chickadee scripting) + #:use-module (ice-9 control) #:use-module (ice-9 eval-string) #:use-module (ice-9 format) #:use-module (ice-9 match) @@ -63,35 +64,52 @@ (modify-user-text repl (substring text 0 (max (- (string-length text) 1) 0))))) -(define-method (eval-user-text (repl <repl>)) - (let* ((result #f) - (output (with-output-to-string - (lambda () - (set! result (eval-string (user-text repl) - #:module (module repl)))))) - (log (log repl))) - (for-each (lambda (line) - (ring-buffer-put! log line)) - (let ((result-text (if (unspecified? result) - "" - (with-output-to-string - (lambda () - (display "=> ") - (write result)))))) - (match (string-split (string-append (text (& repl prompt)) - "\n" output result-text) - #\newline) - ;; Drop trailing newlines - ((lines ... "") lines) - (lines lines)))) +(define-method (print (repl <repl>) s) + (for-each (lambda (line) + (ring-buffer-put! (log repl) line)) + (match (string-split s #\newline) + ;; Drop trailing newlines + ((lines ... "") lines) + (lines lines)))) + +(define-method (flush-log (repl <repl>)) + (let ((log (log repl))) (let loop ((i 0) (labels (lines repl))) (when (< i (ring-buffer-length log)) (match labels ((label . rest) (set! (text label) (ring-buffer-ref log i)) - (loop (+ i 1) rest))))) - (modify-user-text repl ""))) + (loop (+ i 1) rest))))))) + +(define-method (eval-user-text (repl <repl>)) + (let ((result *unspecified*)) + (values (with-output-to-string + (lambda () + (set! result + (let/ec cancel + (start-stack 'repl-stack + (with-exception-handler (lambda (exception) + ;;(backtrace) + (display exception) + (cancel *unspecified*)) + (lambda () + (eval-string (user-text repl) + #:module (module repl))))))))) + result))) + +(define-method (eval-and-print (repl <repl>)) + (call-with-values (lambda () (eval-user-text repl)) + (lambda (output result) + (print repl (text (& repl prompt))) + (print repl output) + (unless (unspecified? result) + (print repl (with-output-to-string + (lambda () + (display "=> ") + (write result))))) + (flush-log repl) + (modify-user-text repl "")))) (define-method (on-boot (repl <repl>)) (let* ((res (resolution (car (cameras repl)))) @@ -138,7 +156,7 @@ (match key ('escape (close-repl repl)) ('backspace (backward-delete repl)) - ('return (eval-user-text repl)) + ('return (eval-and-print repl)) (_ #f))) (define-method (on-text-input (repl <repl>) text) |