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

268
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,105 +13,132 @@
;; 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:
(thread (lambda () ;;
(define (start req) ;; (make-evaluate (lambda (program op)
(cond ;; (fprintf op "(function() {
;; Server-side sync for a program ;; return function(success, fail, params) {
[(exists-binding? 'poke (request-bindings req)) ;; success('ok');
(handle-poke req)] ;; }})")))
;;
;; Normal result came back ;; is a do-nothing evaluator that will always give back 'ok'.
[(exists-binding? 'r (request-bindings req)) ;;
(handle-normal-response req)] ;; At the moment, the evaluator will pass in a parameter that binds 'currentDisplayer' to a function
;; that captures output.
;; Error occurred (define (make-evaluate javascript-compiler)
[(exists-binding? 'e (request-bindings req)) (define port (+ 8000 (random 8000)))
(handle-error-response req)]
[else ;; This channel's meant to serialize use of the web server.
(make-on-first-load-response)])) (define ch (make-channel))
(serve/servlet start ;; start up the web server
#:banner? #f ;; The web server responds to two types of requests
#:launch-browser? #t ;; ?comet Starting up the comet request path.
#:quit? #f ;; ?v Getting a value back from evaluation.
#:port port ;; ?e Got an error.
#:servlet-path "/eval")))) (void
(thread (lambda ()
(define (handle-poke req) (define (start req)
;; FIXME: how do we handle timeouts? (cond
(let/ec return ;; Server-side sync for a program
(let ([program (sync ch)] [(exists-binding? 'comet (request-bindings req))
[op (open-output-bytes)]) (handle-comet req)]
(with-handlers ([exn:fail? (lambda (exn)
(let ([sentinel ;; Normal result came back
(format [(exists-binding? 'v (request-bindings req))
#<<EOF (handle-normal-response req)]
;; Error occurred
[(exists-binding? 'e (request-bindings req))
(handle-error-response req)]
[else
(make-on-first-load-response)]))
(serve/servlet start
#:banner? #f
#:launch-browser? #t
#:quit? #f
#:port port
#:servlet-path "/eval"))))
(define (handle-comet req)
;; FIXME: how do we handle timeouts?
(let/ec return
(let ([program (sync ch)]
[op (open-output-bytes)])
(with-handlers ([exn:fail? (lambda (exn)
(let ([sentinel
(format
#<<EOF
(function () { (function () {
return function(success, fail, params) { return function(success, fail, params) {
fail(~s); fail(~s);
} }
}); });
EOF EOF
(exn-message exn))]) (exn-message exn))])
(return (return
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
#"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)
#"text/plain; charset=utf-8" #"text/plain; charset=utf-8"
empty empty
(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
empty empty
(list #"" #"<html><head></head><body><p>ok</p></body></html>"))) (list #"" #"<html><head></head><body><p>ok</p></body></html>")))
(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))
(string->number (extract-binding/single 'v (request-bindings req))
(extract-binding/single 't (request-bindings req))))) (string->number
(ok-response)) (extract-binding/single 't (request-bindings req)))))
(ok-response))
(define (handle-error-response req)
(channel-put ch (make-error-happened (define (handle-error-response req)
(extract-binding/single 'e (request-bindings req)) (channel-put ch (make-error-happened
(string->number (extract-binding/single 'e (request-bindings req))
(extract-binding/single 't (request-bindings req))))) (string->number
(ok-response)) (extract-binding/single 't (request-bindings req)))))
(ok-response))
(define (make-on-first-load-response)
(let ([op (open-output-bytes)]) (define (make-on-first-load-response)
(fprintf op #<<EOF (let ([op (open-output-bytes)])
(fprintf op #<<EOF
<html> <html>
<head> <head>
<script> <script>
@ -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>
@ -209,26 +237,26 @@ var whenLoaded = function() {
</body> </body>
</html> </html>
EOF EOF
) )
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
TEXT/HTML-MIME-TYPE TEXT/HTML-MIME-TYPE
empty empty
(list #"" (get-output-bytes op))))) (list #"" (get-output-bytes op)))))
;; evaluate: sexp -> (values string number)
;; 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.
(define (evaluate e)
;; Send the program to the web browser, and wait for the thread to send back
(channel-put ch e)
(let ([result (channel-get ch)])
(cond [(error-happened? result)
(raise result)]
[else
result])))
evaluate)
(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.
;; Returns the captured result of stdout, plus # of milliseconds it took to execute.
(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)]
[else
(values (first output+time)
(second output+time))])))

16
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)])
(unless (string=? output exp) (let ([output (evaluated-stdout result)])
(printf " error!\n") (unless (string=? output exp)
(raise-syntax-error #f (format "Expected ~s, got ~s" exp output) (printf " error!\n")
#'stx))) (raise-syntax-error #f (format "Expected ~s, got ~s" exp output)
#'stx))))
(printf " ok\n"))))])) (printf " ok\n"))))]))