Adding catchall exception handler.

compiler/compiler.rkt

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

whalesong-helpers.rkt

@@ -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)))))))
 
 (define (build-standalone-xhtml f)
+  (with-catchall-exception-handler
+   (lambda ()
      (turn-on-logger!)
      (let-values ([(base filename dir?)
                    (split-path f)])
@@ -105,11 +121,13 @@
                                       (make-MainModuleSource 
                                        (normalize-path (build-path f)))
                                       op))
-                                #:exists 'replace)))))
+                                   #:exists 'replace)))))))
 
 
 
 (define (build-html-and-javascript f)
+  (with-catchall-exception-handler
+   (lambda ()
      (turn-on-logger!)
 
      (define written-js-paths '())
@@ -218,20 +236,24 @@
                                #:exists 'replace)
        (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)
+  (with-catchall-exception-handler
+   (lambda ()
      (turn-on-logger!)
-  (display (get-runtime) (current-output-port)))
+     (display (get-runtime) (current-output-port)))))
 
 
 
 (define (get-javascript-code filename)
+  (with-catchall-exception-handler
+   (lambda ()
      (turn-on-logger!)
      (display (get-standalone-code
                (make-MainModuleSource 
                 (normalize-path (build-path filename))))
-           (current-output-port)))
+              (current-output-port)))))