quick-and-dirty way to test expressions at the browser and get back results

browser-evaluate.rkt

@@ -7,6 +7,7 @@
          "package.rkt")
 
 ;; A hacky way to test the evaluation.
+(provide evaluate)
 
 
 ;; Channel's meant to serialize use of the web server.
@@ -43,7 +44,6 @@ function sendRequest(url,callback,postData) {
 	if (!req) return;
 	var method = (postData) ? "POST" : "GET";
 	req.open(method,url,true);
-	req.setRequestHeader('User-Agent','XMLHTTP/1.0');
 	if (postData) {
   	    req.setRequestHeader('Content-type','application/x-www-form-urlencoded');
         }
@@ -81,10 +81,17 @@ function createXMLHTTPObject() {
 
 
 var whenLoaded = function() {
-    invoke(function(v) {
+    var output = [];
-        alert('ok'); 
+    MACHINE.params.currentDisplayer = function(v) {
+        output.push(String(v));
+    };
+    var startTime = new Date();
+    invoke(function() {
+        var endTime = new Date();
+        document.body.appendChild(document.createTextNode("Program evaluated; sending back."));
         sendRequest("/eval", function(req) {},
-                    "r=" + encodeURIComponent(v));
+                    "r=" + encodeURIComponent(output.join('')) +
+                    "&t=" + encodeURIComponent(String(endTime - startTime)));
     });
 };
 </script>
@@ -104,7 +111,8 @@ EOF
          
               
               [(exists-binding? 'r (request-bindings req))
-               (channel-put ch (extract-binding/single 'r (request-bindings req)))
+               (channel-put ch (list (extract-binding/single 'r (request-bindings req))
+                                     (extract-binding/single 't (request-bindings req))))
                `(html (body (p "ok")))]
               [else
                `(html (body (p "Loaded")))]))

runtime.js

@@ -26,6 +26,12 @@ var Primitives = {
     
     '/': function(argl) {
 	return argl[0] / argl[1][0];
+    },
+    'display': function(argl) {
+        MACHINE.params.currentDisplayer(argl[0]);
+    },
+    'newline': function(argl) {
+        MACHINE.params.currentDisplayer("\n");
     }
 };
 
@@ -126,7 +132,8 @@ var MACHINE={callsBeforeTrampoline: 100,
              argl:undefined,
              val:undefined,
              cont:undefined,
-             stack: []};
+             stack: [],
+             params: {currentDisplayer: function(v) {}}};
 
 
 // harness: (->) (->) -> void

test-browser-evaluate.rkt

@@ -0,0 +1,24 @@
+#lang racket/base
+(require "browser-evaluate.rkt")
+
+(evaluate '(begin (define (f x) 
+                                (if (= x 0)
+                                    1
+                                    (+ x (f (- x 1)))))
+                              (display (f 3))
+                              (display "\n")
+                              (display (f 4))
+                              (display "\n")
+                              (display (f 10000))))
+
+
+
+(evaluate '(begin (define (f x) 
+                                (if (= x 0)
+                                    1
+                                    (+ x (f (- x 1)))))
+                              (display (f 3))
+                              (display "\n")
+                              (display (f 4))
+                              (display "\n")
+                              (display (f 100000))))

test-package.rkt

@@ -0,0 +1,32 @@
+#lang racket/base
+
+(require "package.rkt")
+
+(define (test s-exp)
+  (package s-exp (current-output-port)))
+
+
+(test '(define (factorial n)
+           (if (= n 0)
+               1
+               (* (factorial (- n 1))
+                  n))))
+(test '(begin
+         (define (factorial n)
+           (fact-iter n 1))
+         (define (fact-iter n acc)
+           (if (= n 0)
+               acc
+               (fact-iter (- n 1) (* acc n))))))
+
+(test '(define (gauss n)
+         (if (= n 0)
+             0
+             (+ (gauss (- n 1))
+                n))))
+
+(test '(define (fib n)
+           (if (< n 2)
+               1
+               (+ (fib (- n 1))
+                  (fib (- n 2))))))