suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

generalized the browser-evaluate code so I should be able to tie it to different evaluators for comparison.

Browse Source
This commit is contained in:
Danny Yoo 2011-02-25 16:10:47 -05:00
parent c92b6d4c43
commit 5ab3ae1a89
2 changed files with 158 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
browser-evaluate.rkt
View File

@ -2,8 +2,8 @@
(require racket/list
web-server/servlet
web-server/servlet-env
"package.rkt")
web-server/servlet-env)
;; A hacky way to test the evaluation.
;;
@ -13,8 +13,33 @@
;; value to the user, along with the time it took to evaluate.
(provide evaluate)
(provide make-evaluate
(struct-out error-happened)
(struct-out evaluated))
(define-struct error-happened (str t) #:transparent)
(define-struct evaluated (stdout value t) #:transparent)
;; make-evaluate: (Any output-port) -> void
;; Produce a JavaScript evaluator that cooperates with a browser.
;; The JavaScript-compiler is expected to write out a thunk. When invoked,
;; the thunk should return a function that consumes three values, corresponding
;; to success, failure, and other parameters to evaluation. For example:
;;
;; (make-evaluate (lambda (program op)
;; (fprintf op "(function() {
;; return function(success, fail, params) {
;; success('ok');
;; }})")))
;;
;; is a do-nothing evaluator that will always give back 'ok'.
;;
;; At the moment, the evaluator will pass in a parameter that binds 'currentDisplayer' to a function
;; that captures output.
(define (make-evaluate javascript-compiler)
(define port (+ 8000 (random 8000)))
@ -24,18 +49,19 @@
;; start up the web server
;; The web server responds to two types of requests
;; ?p Inputting a program
;; ?r Getting a response
;; ?comet Starting up the comet request path.
;; ?v Getting a value back from evaluation.
;; ?e Got an error.
(void
(thread (lambda ()
(define (start req)
(cond
;; Server-side sync for a program
[(exists-binding? 'poke (request-bindings req))
(handle-poke req)]
[(exists-binding? 'comet (request-bindings req))
(handle-comet req)]
;; Normal result came back
[(exists-binding? 'r (request-bindings req))
[(exists-binding? 'v (request-bindings req))
(handle-normal-response req)]
;; Error occurred
@ -53,7 +79,7 @@
#:port port
#:servlet-path "/eval"))))
(define (handle-poke req)
(define (handle-comet req)
;; FIXME: how do we handle timeouts?
(let/ec return
(let ([program (sync ch)]
@ -76,7 +102,7 @@ EOF
#"text/plain; charset=utf-8"
empty
(list #"" (string->bytes/utf-8 sentinel))))))])
(package-anonymous program op))
(javascript-compiler program op))
(response/full 200 #"Okay"
(current-seconds)
@ -95,7 +121,8 @@ EOF
(define (handle-normal-response req)
(channel-put ch (list (extract-binding/single 'r (request-bindings req))
(channel-put ch (make-evaluated (extract-binding/single 'o (request-bindings req))
(extract-binding/single 'v (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))))
(ok-response))
@ -171,7 +198,7 @@ function createXMLHTTPObject() {
return xmlhttp;
}
var poke = function() {
var comet = function() {
sendRequest("/eval",
function(req) {
var invoke = eval(req.responseText)();
@ -179,27 +206,28 @@ var poke = function() {
var startTime, endTime;
var params = { currentDisplayer: function(v) { output.push(String(v)); } };
var onSuccess = function() {
var onSuccess = function(v) {
endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(poke, 0); },
"r=" + encodeURIComponent(output.join('')) +
sendRequest("/eval", function(req) { setTimeout(comet, 0); },
"v=" + encodeURIComponent(String(v)) +
"&o=" + encodeURIComponent(output.join('')) +
"&t=" + encodeURIComponent(String(endTime - startTime)));
};
var onFail = function(e) {
endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(poke, 0); },
sendRequest("/eval", function(req) { setTimeout(comet, 0); },
"e=" + encodeURIComponent(String(e)) +
"&t=" + encodeURIComponent(String(endTime - startTime)));
};
startTime = new Date();
invoke(onSuccess, onFail, params);
},
"poke=t");
"comet=t");
};
var whenLoaded = function() {
setTimeout(poke, 0);
setTimeout(comet, 0);
};
</script>
@ -217,8 +245,6 @@ EOF
(list #"" (get-output-bytes op)))))
(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.
@ -226,9 +252,11 @@ EOF
(define (evaluate e)
;; Send the program to the web browser, and wait for the thread to send back
(channel-put ch e)
(let ([output+time (channel-get ch)])
(cond [(error-happened? output+time)
(raise output+time)]
(let ([result (channel-get ch)])
(cond [(error-happened? result)
(raise result)]
[else
(values (first output+time)
(second output+time))])))
result])))
evaluate)

10
test-browser-evaluate.rkt
View File

@ -1,5 +1,8 @@
#lang racket
(require "browser-evaluate.rkt")
(require "browser-evaluate.rkt"
"package.rkt")
(define evaluate (make-evaluate package-anonymous))
;; test-find-toplevel-variables
(define-syntax (test stx)
@ -9,11 +12,12 @@
(syntax/loc #'stx
(begin
(printf "running test...")
(let-values ([(output time) (evaluate s)])
(let ([result (evaluate s)])
(let ([output (evaluated-stdout result)])
(unless (string=? output exp)
(printf " error!\n")
(raise-syntax-error #f (format "Expected ~s, got ~s" exp output)
#'stx)))
#'stx))))
(printf " ok\n"))))]))