From 76115cc01975250b72f6d1336a6d026e37b4a84d Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@hashcollision.org>
Date: Tue, 5 Mar 2013 17:03:28 -0700
Subject: [PATCH] minimal error handling just so failure isn't quiet.

---
 whalesong/repl-prototype/htdocs/repl.js | 41 ++++++++++++---
 whalesong/repl-prototype/server.rkt     | 69 +++++++++++++------------
 2 files changed, 72 insertions(+), 38 deletions(-)

diff --git a/whalesong/repl-prototype/htdocs/repl.js b/whalesong/repl-prototype/htdocs/repl.js
index 1370ff5..1d6a409 100644
--- a/whalesong/repl-prototype/htdocs/repl.js
+++ b/whalesong/repl-prototype/htdocs/repl.js
@@ -78,6 +78,18 @@ $(document).ready(function() {
     };
 
 
+    // writeErrorMessage: string -> void
+    // Write out an error message.
+    var writeErrorMessage = function(msg) {
+        $("<span/>")
+            .text(''+msg)
+            .css("color", "red")
+            .appendTo(output);
+        $("<br/>").appendTo(output);
+    };
+
+
+
     // Print: Racket value -> void
     // Prints the racket value out.
     var print = function(elt) {
@@ -103,6 +115,24 @@ $(document).ready(function() {
         $("<tt/>").text('> ' + src).appendTo(output);
         $("<br/>").appendTo(output);
         var onCompile = function(compiledResult) {
+            if (compiledResult.type === 'repl') {
+                return onGoodReplCompile(compiledResult);
+            } else if (compiledResult.type === 'module') {
+                alert('internal error: module unexpected');
+                after();
+            } else if (compiledResult.type === 'error') {
+                return onCompileTimeError(compiledResult);
+            }
+        };
+
+
+        var onCompileTimeError = function(compiledResult) {
+            writeErrorMessage(compiledResult.message);
+            after();
+        };
+
+
+        var onGoodReplCompile = function(compiledResult) {
             // compiledResult.compiledCodes is an array of function chunks.
             // The evaluation leaves the value register of the machine
             // to contain the list of values from toplevel evaluation.
@@ -124,11 +154,7 @@ $(document).ready(function() {
                                  console.log(err.stack);
                              }
                              if (err.message) { 
-                                 $("<span/>")
-                                     .text(err.message)
-                                     .css("color", "red")
-                                     .appendTo(output);
-                                 $("<br/>").appendTo(output);
+                                 writeErrorMessage(err.message);
                              }
 
                              after();
@@ -137,8 +163,11 @@ $(document).ready(function() {
                      },
                      after);
         };
+        var onCompileError = function(err) {
+        };
+
         var onServerError = function(err) {
-            console.log("error", err);
+            writeErrorMessage("internal server error");
             after();
         };
 
diff --git a/whalesong/repl-prototype/server.rkt b/whalesong/repl-prototype/server.rkt
index d0b08b3..cdeb6b1 100644
--- a/whalesong/repl-prototype/server.rkt
+++ b/whalesong/repl-prototype/server.rkt
@@ -62,38 +62,43 @@
                      #t]
                     [else #f]))
   ;; Compile the program here...
-  
-  (cond [(not as-mod?)
-         (define ip (open-input-string text-src))
-         (port-count-lines! ip)
-         (define assembled-codes
-           (let loop () 
-             (define sexp (read-syntax #f ip))
-             (cond [(eof-object? sexp)
-                    '()]
-                   [else
-                    (define raw-bytecode (repl-compile sexp #:lang language))
-                    (define op (open-output-bytes))
-                    (write raw-bytecode op)
-                    (define whalesong-bytecode (parse-bytecode (open-input-bytes (get-output-bytes op))))
-                    (pretty-print whalesong-bytecode)
-                    (define compiled-bytecode (compile-for-repl whalesong-bytecode))
-                    (pretty-print compiled-bytecode)
-                    (define assembled-op (open-output-string))
-                    (define assembled (assemble/write-invoke compiled-bytecode assembled-op 'with-preemption))
-                    (cons (get-output-string assembled-op) (loop))])))
-         (printf "assembled codes ~a\n" assembled-codes)
-         (write-json (hash 'compiledCodes assembled-codes)
-                     op)]
-        [else
-         (define program-port (open-output-string))
-         (package (SexpSource (parameterize ([read-accept-reader #t])
-                                (read (open-input-string (string-append "#lang whalesong\n" text-src)))))
-                  #:should-follow-children? (lambda (src) #f)
-                  #:output-port  program-port)
-         (write-json (hash 'compiledModule (get-output-string program-port))
-                     op)
-         ])
+  (with-handlers ([exn:fail? (lambda (exn)
+                               (write-json (hash 'type "error"
+                                                 'message (exn-message exn))
+                                           op))])
+    (cond [(not as-mod?)
+           (define ip (open-input-string text-src))
+           (port-count-lines! ip)
+           (define assembled-codes
+             (let loop () 
+               (define sexp (read-syntax #f ip))
+               (cond [(eof-object? sexp)
+                      '()]
+                     [else
+                      (define raw-bytecode (repl-compile sexp #:lang language))
+                      (define op (open-output-bytes))
+                      (write raw-bytecode op)
+                      (define whalesong-bytecode (parse-bytecode (open-input-bytes (get-output-bytes op))))
+                      (pretty-print whalesong-bytecode)
+                      (define compiled-bytecode (compile-for-repl whalesong-bytecode))
+                      (pretty-print compiled-bytecode)
+                      (define assembled-op (open-output-string))
+                      (define assembled (assemble/write-invoke compiled-bytecode assembled-op 'with-preemption))
+                      (cons (get-output-string assembled-op) (loop))])))
+           (printf "assembled codes ~a\n" assembled-codes)
+           (write-json (hash 'type "repl"
+                             'compiledCodes assembled-codes)
+                       op)]
+          [else
+           (define program-port (open-output-string))
+           (package (SexpSource (parameterize ([read-accept-reader #t])
+                                  (read (open-input-string (string-append "#lang whalesong\n" text-src)))))
+                    #:should-follow-children? (lambda (src) #f)
+                    #:output-port  program-port)
+           (write-json (hash 'type "module"
+                             'compiledModule (get-output-string program-port))
+                       op)
+           ]))
   ;; Send it back as json text....
 
   (close-output-port op)