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

changing the abort so it doesn't kill us so easily

Browse Source
This commit is contained in:
Danny Yoo 2012-05-04 15:44:25 -04:00
parent 90105502ec
commit 1fb1530289
3 changed files with 18 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
js-assembler/check-valid-module-source.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(provide check-valid-module-source)
(provide check-valid-module-source
[struct-out exn:invalid-module-source])
(require syntax/kerncase
syntax/modresolve
@ -9,9 +10,13 @@
"../parser/path-rewriter.rkt")
(define (abort-abort)
(struct exn:invalid-module-source exn:fail ())
(define (abort-abort #:reason (reason "Invalid module source"))
(fprintf (current-report-port) "Aborting compilation.\n")
(exit))
(raise (exn:invalid-module-source reason
(current-continuation-marks))))
(define ns (make-base-namespace))

2
whalesong-gui.rkt
View File

@ -95,7 +95,7 @@
(thread (lambda ()
(parameterize ([current-report-port (open-output-text-editor t)])
(build-html-and-javascript source-path)
(fprintf (current-report-port) "Build complete.")))))
(fprintf (current-report-port) "Done.\n")))))

11
whalesong-helpers.rkt
View File

@ -15,6 +15,7 @@
"resource/structs.rkt"
"logger.rkt"
"parameters.rkt"
"js-assembler/check-valid-module-source.rkt"
planet/version
(for-syntax racket/base))
@ -47,7 +48,13 @@
(define (with-catchall-exception-handler thunk)
(with-handlers
[(void (lambda (exn)
([exn:invalid-module-source?
(lambda (exn)
(fprintf (current-report-port) "~a\n"
(exn-message exn))
(fprintf (current-report-port) "------------------\n")
(fprintf (current-report-port) "\nAborting compilation.\n"))]
[void (lambda (exn)
(fprintf (current-report-port) "ERROR: Whalesong has encountered an internal error.\n\n")
(fprintf (current-report-port) "Please send the following error report log to dyoo@hashcollision.org.\n\n")
(define op (open-output-string))
@ -56,7 +63,7 @@
(fprintf (current-report-port) "------------------\n")
(displayln (get-output-string op) (current-report-port))
(fprintf (current-report-port) "------------------\n")
(fprintf (current-report-port) "\nAborting compilation.\n")))]
(fprintf (current-report-port) "\nAborting compilation.\n"))])
(thunk)))