suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adding catchall exception handler.

Browse Source
This commit is contained in:
Danny Yoo 2011-10-03 14:19:17 -04:00
parent a254acf05f
commit 8fb599b926
2 changed files with 171 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/compiler.rkt
View File

@ -26,7 +26,6 @@
(: -compile (Expression Target Linkage -> (Listof Statement))) (: -compile (Expression Target Linkage -> (Listof Statement)))
;; Generates the instruction-sequence stream. ;; Generates the instruction-sequence stream.
;; Note: the toplevel generates the lambda body streams at the head, and then the ;; Note: the toplevel generates the lambda body streams at the head, and then the

30
whalesong-helpers.rkt
View File

@ -40,6 +40,20 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (with-catchall-exception-handler thunk)
(with-handlers
[(void (lambda (exn)
(printf "ERROR: Whalesong has encountered an internal error.\n\n")
(printf "Please send the following error report log to dyoo@hashcollision.org.\n\n")
(define op (open-output-string))
(parameterize ([current-error-port op])
((error-display-handler) (exn-message exn) exn))
(printf "------------------\n")
(displayln (get-output-string op))
(printf "------------------\n")
(printf "\nAborting compilation.\n")
(exit)))]
(thunk)))
@ -66,6 +80,8 @@
(loop))))))) (loop)))))))
(define (build-standalone-xhtml f) (define (build-standalone-xhtml f)
(with-catchall-exception-handler
(lambda ()
(turn-on-logger!) (turn-on-logger!)
(let-values ([(base filename dir?) (let-values ([(base filename dir?)
(split-path f)]) (split-path f)])
@ -105,11 +121,13 @@
(make-MainModuleSource (make-MainModuleSource
(normalize-path (build-path f))) (normalize-path (build-path f)))
op)) op))
#:exists 'replace))))) #:exists 'replace)))))))
(define (build-html-and-javascript f) (define (build-html-and-javascript f)
(with-catchall-exception-handler
(lambda ()
(turn-on-logger!) (turn-on-logger!)
(define written-js-paths '()) (define written-js-paths '())
@ -218,20 +236,24 @@
#:exists 'replace) #:exists 'replace)
(define stop-time (current-inexact-milliseconds)) (define stop-time (current-inexact-milliseconds))
(fprintf (current-timing-port) "Time taken: ~a milliseconds\n" (- stop-time start-time)))) (fprintf (current-timing-port) "Time taken: ~a milliseconds\n" (- stop-time start-time))))))
(define (print-the-runtime) (define (print-the-runtime)
(with-catchall-exception-handler
(lambda ()
(turn-on-logger!) (turn-on-logger!)
(display (get-runtime) (current-output-port))) (display (get-runtime) (current-output-port)))))
(define (get-javascript-code filename) (define (get-javascript-code filename)
(with-catchall-exception-handler
(lambda ()
(turn-on-logger!) (turn-on-logger!)
(display (get-standalone-code (display (get-standalone-code
(make-MainModuleSource (make-MainModuleSource
(normalize-path (build-path filename)))) (normalize-path (build-path filename))))
(current-output-port))) (current-output-port)))))