diff --git a/browser-evaluate.rkt b/browser-evaluate.rkt index 56e3f40..31e8a63 100644 --- a/browser-evaluate.rkt +++ b/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) { - alert('ok'); + var output = []; + 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))); }); }; @@ -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")))])) diff --git a/runtime.js b/runtime.js index 9a44291..a139c55 100644 --- a/runtime.js +++ b/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 diff --git a/test-browser-evaluate.rkt b/test-browser-evaluate.rkt new file mode 100644 index 0000000..a52d963 --- /dev/null +++ b/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)))) \ No newline at end of file diff --git a/test-package.rkt b/test-package.rkt new file mode 100644 index 0000000..6db0597 --- /dev/null +++ b/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)))))) \ No newline at end of file