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

108
browser-evaluate.rkt
View File

@ -2,8 +2,8 @@
(require racket/list (require racket/list
web-server/servlet web-server/servlet
web-server/servlet-env web-server/servlet-env)
"package.rkt")
;; A hacky way to test the evaluation. ;; A hacky way to test the evaluation.
;; ;;
@ -13,29 +13,55 @@
;; value to the user, along with the time it took to evaluate. ;; value to the user, along with the time it took to evaluate.
(provide evaluate) (provide make-evaluate
(struct-out error-happened)
(define port (+ 8000 (random 8000))) (struct-out evaluated))
;; This channel's meant to serialize use of the web server.
(define ch (make-channel)) (define-struct error-happened (str t) #:transparent)
(define-struct evaluated (stdout value t) #:transparent)
;; start up the web server ;; make-evaluate: (Any output-port) -> void
;; The web server responds to two types of requests ;; Produce a JavaScript evaluator that cooperates with a browser.
;; ?p Inputting a program ;; The JavaScript-compiler is expected to write out a thunk. When invoked,
;; ?r Getting a response ;; the thunk should return a function that consumes three values, corresponding
(void ;; 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)))
;; This channel's meant to serialize use of the web server.
(define ch (make-channel))
;; start up the web server
;; The web server responds to two types of requests
;; ?comet Starting up the comet request path.
;; ?v Getting a value back from evaluation.
;; ?e Got an error.
(void
(thread (lambda () (thread (lambda ()
(define (start req) (define (start req)
(cond (cond
;; Server-side sync for a program ;; Server-side sync for a program
[(exists-binding? 'poke (request-bindings req)) [(exists-binding? 'comet (request-bindings req))
(handle-poke req)] (handle-comet req)]
;; Normal result came back ;; Normal result came back
[(exists-binding? 'r (request-bindings req)) [(exists-binding? 'v (request-bindings req))
(handle-normal-response req)] (handle-normal-response req)]
;; Error occurred ;; Error occurred
@ -53,7 +79,7 @@
#:port port #:port port
#:servlet-path "/eval")))) #:servlet-path "/eval"))))
(define (handle-poke req) (define (handle-comet req)
;; FIXME: how do we handle timeouts? ;; FIXME: how do we handle timeouts?
(let/ec return (let/ec return
(let ([program (sync ch)] (let ([program (sync ch)]
@ -76,7 +102,7 @@ EOF
#"text/plain; charset=utf-8" #"text/plain; charset=utf-8"
empty empty
(list #"" (string->bytes/utf-8 sentinel))))))]) (list #"" (string->bytes/utf-8 sentinel))))))])
(package-anonymous program op)) (javascript-compiler program op))
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
@ -85,7 +111,7 @@ EOF
(list #"" (get-output-bytes op)))))) (list #"" (get-output-bytes op))))))
(define (ok-response) (define (ok-response)
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
TEXT/HTML-MIME-TYPE TEXT/HTML-MIME-TYPE
@ -94,14 +120,15 @@ EOF
(define (handle-normal-response req) (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 (string->number
(extract-binding/single 't (request-bindings req))))) (extract-binding/single 't (request-bindings req)))))
(ok-response)) (ok-response))
(define (handle-error-response req) (define (handle-error-response req)
(channel-put ch (make-error-happened (channel-put ch (make-error-happened
(extract-binding/single 'e (request-bindings req)) (extract-binding/single 'e (request-bindings req))
(string->number (string->number
@ -109,7 +136,7 @@ EOF
(ok-response)) (ok-response))
(define (make-on-first-load-response) (define (make-on-first-load-response)
(let ([op (open-output-bytes)]) (let ([op (open-output-bytes)])
(fprintf op #<<EOF (fprintf op #<<EOF
<html> <html>
@ -171,7 +198,7 @@ function createXMLHTTPObject() {
return xmlhttp; return xmlhttp;
} }
var poke = function() { var comet = function() {
sendRequest("/eval", sendRequest("/eval",
function(req) { function(req) {
var invoke = eval(req.responseText)(); var invoke = eval(req.responseText)();
@ -179,27 +206,28 @@ var poke = function() {
var startTime, endTime; var startTime, endTime;
var params = { currentDisplayer: function(v) { output.push(String(v)); } }; var params = { currentDisplayer: function(v) { output.push(String(v)); } };
var onSuccess = function() { var onSuccess = function(v) {
endTime = new Date(); endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(poke, 0); }, sendRequest("/eval", function(req) { setTimeout(comet, 0); },
"r=" + encodeURIComponent(output.join('')) + "v=" + encodeURIComponent(String(v)) +
"&o=" + encodeURIComponent(output.join('')) +
"&t=" + encodeURIComponent(String(endTime - startTime))); "&t=" + encodeURIComponent(String(endTime - startTime)));
}; };
var onFail = function(e) { var onFail = function(e) {
endTime = new Date(); endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(poke, 0); }, sendRequest("/eval", function(req) { setTimeout(comet, 0); },
"e=" + encodeURIComponent(String(e)) + "e=" + encodeURIComponent(String(e)) +
"&t=" + encodeURIComponent(String(endTime - startTime))); "&t=" + encodeURIComponent(String(endTime - startTime)));
}; };
startTime = new Date(); startTime = new Date();
invoke(onSuccess, onFail, params); invoke(onSuccess, onFail, params);
}, },
"poke=t"); "comet=t");
}; };
var whenLoaded = function() { var whenLoaded = function() {
setTimeout(poke, 0); setTimeout(comet, 0);
}; };
</script> </script>
@ -217,18 +245,18 @@ EOF
(list #"" (get-output-bytes op))))) (list #"" (get-output-bytes op)))))
(define-struct error-happened (str t) #:transparent)
;; evaluate: sexp -> (values string number)
;; evaluate: sexp -> (values string number) ;; A little driver to test the evalution of expressions, using a browser to help.
;; A little driver to test the evalution of expressions, using a browser to help. ;; Returns the captured result of stdout, plus # of milliseconds it took to execute.
;; Returns the captured result of stdout, plus # of milliseconds it took to execute. (define (evaluate e)
(define (evaluate e)
;; Send the program to the web browser, and wait for the thread to send back ;; Send the program to the web browser, and wait for the thread to send back
(channel-put ch e) (channel-put ch e)
(let ([output+time (channel-get ch)]) (let ([result (channel-get ch)])
(cond [(error-happened? output+time) (cond [(error-happened? result)
(raise output+time)] (raise result)]
[else [else
(values (first output+time) result])))
(second output+time))])))
evaluate)

10
test-browser-evaluate.rkt
View File

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