diff options
author | David Thompson <dthompson2@worcester.edu> | 2022-10-08 09:24:43 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2022-10-08 09:24:43 -0400 |
commit | f782e70390525fa2e5bfdf8e2ff249ece1640a98 (patch) | |
tree | f32636a96e590ec98d52d72c7e86ecc70ab18c45 /chickadee/cli | |
parent | 1578a7025c3c70cbbdb110aa42125c9acb57aeda (diff) |
Update error handling to use Guile's new exception API.
Diffstat (limited to 'chickadee/cli')
-rw-r--r-- | chickadee/cli/play.scm | 45 |
1 files changed, 22 insertions, 23 deletions
diff --git a/chickadee/cli/play.scm b/chickadee/cli/play.scm index 7745008..4e18b31 100644 --- a/chickadee/cli/play.scm +++ b/chickadee/cli/play.scm @@ -21,6 +21,7 @@ #:use-module (chickadee async-repl) #:use-module (chickadee cli) #:use-module (chickadee config) + #:use-module (ice-9 exceptions) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -195,29 +196,24 @@ Resume the game loop without entering a debugger." (repl-opt (set! repl (make-async-repl)) (start-async-repl repl abort-game))))))))) - (define (handle-error stack key args) + (define (handle-error e stack) ;; Setup the REPL debug object. - (let* ((tag (and (pair? (fluid-ref %stacks)) - (cdr (fluid-ref %stacks)))) - (stack (narrow-stack->vector - stack - ;; Take the stack from the given frame, cutting 0 - ;; frames. - 0 - ;; Narrow the end of the stack to the most recent - ;; start-stack. - ;;tag - ;; And one more frame, because %start-stack - ;; invoking the start-stack thunk has its own frame - ;; too. - 0 (and tag 1) - )) - (error-string (call-with-output-string - (lambda (port) - (let ((frame (and (< 0 (vector-length stack)) - (vector-ref stack 0)))) - (print-exception port frame key args)))))) - (set! debug (make-debug stack 0 error-string)) + (let* ((frame (stack-ref stack 0)) + (error-string + (format #f "~a: In procedure: ~a:~%In procedure: ~a: ~a~%" + (match (frame-source frame) + ((_ file-name line . column) + (format #f "~a:~a:~a" (basename file-name) line column)) + (_ "unknown")) + (frame-procedure-name frame) + (if (exception-with-origin? e) + (exception-origin e) + "unknown") + (if (and (exception-with-message? e) + (exception-with-irritants? e)) + (apply format #f (exception-message e) (exception-irritants e)) + "")))) + (set! debug (make-debug (narrow-stack->vector stack 0) 0 error-string)) ;; Just update the REPL endlessly until the developer says to ;; resume. (let* ((window (current-window)) @@ -264,7 +260,10 @@ Resume the game loop without entering a debugger." button) #:controller-move (trampoline controller-move controller axis value) - #:error (if repl handle-error #f)) + #:error (if (or (assq-ref opts 'repl) + (assq-ref opts 'repl-server)) + handle-error + #f)) (when (async-repl? repl) (close-async-repl repl)))) |