added exception catching

assemble.rkt

@@ -17,7 +17,7 @@
                 (newline op))
               basic-blocks)
     (fprintf op "MACHINE.cont = k;\n")
-    (fprintf op "trampoline(~a, function() {}); }"
+    (fprintf op "trampoline(~a, function() {}, function(e) { MACHINE.params.currentErrorHandler(e)}); }"
              (BasicBlock-name (first basic-blocks)))))
 
 

browser-evaluate.rkt

@@ -83,22 +83,28 @@ function createXMLHTTPObject() {
 
 
 var whenLoaded = function() {
-    var output = [];
+    var output = [], startTime, endTime;
     MACHINE.params.currentDisplayer = function(v) {
         output.push(String(v));
     };
-    setTimeout(
+    MACHINE.params.currentErrorHandler = function(e) {
+        endTime = new Date();
+        document.body.appendChild(document.createTextNode(
+           "Program evaluated; sending back to DrRacket."));
+        sendRequest("/eval", function(req) {},
+                    "e=" + encodeURIComponent(String(e)) +
+                    "&t=" + encodeURIComponent(String(endTime - startTime)));
+    };
+    startTime = new Date();
+    invoke(
         function() {
-            var startTime = new Date();
+            endTime = new Date();
-            invoke(function() {
-                var endTime = new Date();
             document.body.appendChild(document.createTextNode(
                "Program evaluated; sending back to DrRacket."));
             sendRequest("/eval", function(req) {},
                         "r=" + encodeURIComponent(output.join('')) +
                         "&t=" + encodeURIComponent(String(endTime - startTime)));
         });
-        }, 0); 
 };
 </script>
 </head>
@@ -114,12 +120,21 @@ EOF
                                 empty 
                                 (list #"" (get-output-bytes op))))]
 
-         
+              ;; Normal result came back
-              
               [(exists-binding? 'r (request-bindings req))
                (channel-put ch (list (extract-binding/single 'r (request-bindings req))
-                                     (extract-binding/single 't (request-bindings req))))
+                                     (string->number
+                                      (extract-binding/single 't (request-bindings req)))))
                `(html (body (p "ok")))]
+
+              ;; Error occurred
+              [(exists-binding? 'e (request-bindings req))
+               (channel-put ch (make-error-happened 
+                                (extract-binding/single 'e (request-bindings req))
+                                (string->number
+                                 (extract-binding/single 't (request-bindings req)))))
+               `(html (body (p "ok")))]
+              
               [else
                `(html (body (p "Loaded")))]))
           
@@ -131,6 +146,8 @@ EOF
                          #:servlet-path "/eval"))))
 
 
+(define-struct error-happened (str t) #:transparent)
+
 
 ;; evaluate: sexp -> (values string number)
 ;; A little driver to test the evalution of expressions, using a browser to help.
@@ -140,5 +157,8 @@ EOF
   (send-url (format "http://localhost:~a/eval?p=t" port) #f)
   (channel-put ch e)
   (let ([output+time (channel-get ch)])
+    (cond [(error-happened? output+time)
+           (raise output+time)]
+          [else
            (values (first output+time)
-            (string->number (second output+time)))))
+                   (second output+time))])))

runtime.js

@@ -92,7 +92,7 @@ var Closure = function(env, label) {
 // JavaScript toplevel.
 Closure.prototype.adaptToJs = function() {
     var that = this;
-    return function(args, k) {
+    return function(args, success, fail) {
         var oldEnv = MACHINE.env;
 	var oldCont = MACHINE.cont;
 	var oldProc = MACHINE.proc;
@@ -114,12 +114,15 @@ Closure.prototype.adaptToJs = function() {
 		    MACHINE.proc = oldProc;
 		    MACHINE.argl = oldArgl;
 		    MACHINE.val = oldVal;
-                    k(result);
+                    success(result);
 		};
 		
 		proc.label();
             },
             function() {
+            },
+            function(e) {
+		return fail(e);
 	    });
     }
 };
@@ -133,11 +136,11 @@ var MACHINE={callsBeforeTrampoline: 100,
              val:undefined,
              cont:undefined,
              stack: [],
-             params: {currentDisplayer: function(v) {}}};
+             params: {currentDisplayer: function(v) {},
+		      currentErrorHandler: function(e) {}}};
 
 
-// harness: (->) (->) -> void
+var trampoline = function(initialJump, success, fail) {
-var trampoline = function(initialJump, k) {
     var thunk = initialJump;
     MACHINE.callsBeforeTrampoline = 100;
     while(thunk) {
@@ -149,9 +152,9 @@ var trampoline = function(initialJump, k) {
                 thunk = e;
                 MACHINE.callsBeforeTrampoline = 100;
             } else {
-	        throw e;
+	        return fail(e);
             }
         }
     }
-    k();
+    return success();
 };

test-browser-evaluate.rkt

@@ -1,24 +1,29 @@
-#lang racket/base
+#lang racket
 (require "browser-evaluate.rkt")
 
-(evaluate '(begin (define (f x) 
+;; test-find-toplevel-variables
+(define-syntax (test stx)
+  (syntax-case stx ()
+    [(_ s exp)
+     (with-syntax ([stx stx])
+       (syntax/loc #'stx
+         (let-values ([(output time) (evaluate s)])
+           (unless (string=? output exp)
+             (raise-syntax-error #f (format "Expected ~s, got ~s" exp output)
+                                 #'stx)))))]))
+
+
+(test '(begin (define (f x) 
                 (if (= x 0)
-                                    1
+                    0
                     (+ x (f (- x 1)))))
               (display (f 3))
               (display "\n")
               (display (f 4))
               (display "\n")
-                              (display (f 10000))))
+              (display (f 10000)))
+      "6\n10\n50005000")
 
 
 
-(evaluate '(begin (define (f x) 
+"ok"
-                                (if (= x 0)
-                                    1
-                                    (+ x (f (- x 1)))))
-                              (display (f 3))
-                              (display "\n")
-                              (display (f 4))
-                              (display "\n")
-                              (display (f 100000))))