diff options
| -rw-r--r-- | starling/repl.scm | 74 |
1 files changed, 50 insertions, 24 deletions
diff --git a/starling/repl.scm b/starling/repl.scm index b972b5f..bd8f504 100644 --- a/starling/repl.scm +++ b/starling/repl.scm @@ -82,34 +82,60 @@ (set! (text label) (ring-buffer-ref log i)) (loop (+ i 1) rest))))))) +(define-method (print-backtrace (repl <repl>) stack) + (let loop ((i (- (stack-length stack) 1))) + (when (>= i 0) + (let ((frame (stack-ref stack i))) + (print repl + (match (frame-source frame) + ((_ file line . column) + (format #f "~d: In ~a:~% ~d:~d ~a" + i file line column + (frame-procedure-name frame))) + (#f + (format #f "~d: In unknown file:~% ~a" + i + (frame-procedure-name frame))))) + (loop (- i 1)))))) + (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))) + (let/ec cancel + (with-exception-handler + (lambda (exception) + (print repl + (with-output-to-string + (lambda () + (print-exception (current-output-port) #f + (exception-kind exception) + (exception-args exception)) + (newline)))) + (let ((tag (match (fluid-ref %stacks) + ((_ . tag) tag) + (_ 0)))) + (print-backtrace repl (make-stack #t 3 tag))) + (cancel)) + (lambda () + (print repl + (with-output-to-string + (lambda () + (start-stack 'repl-stack + (set! result + (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 "")))) + (print repl (text (& repl prompt))) + (let ((result (eval-user-text repl))) + ;;(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)))) |