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

did comet-style server push

Browse Source
This commit is contained in:
Danny Yoo 2011-02-21 22:37:03 -05:00
parent 3b15c46dec
commit fceb4f0379
3 changed files with 116 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
assemble.rkt
View File

@ -11,12 +11,22 @@
(: assemble/write-invoke ((Listof Statement) Output-Port -> Void))
(define (assemble/write-invoke stmts op)
(let ([basic-blocks (fracture stmts)])
(fprintf op "function(k) {\n")
(fprintf op "function(success, fail, params) {\n")
(fprintf op "var param;\n")
(for-each (lambda: ([basic-block : BasicBlock])
(displayln (assemble-basic-block basic-block) op)
(newline op))
basic-blocks)
(fprintf op "MACHINE.cont = k;\n")
(fprintf op "MACHINE.cont = success;\n")
(fprintf op "MACHINE.params.currentErrorHandler = function(e) { fail(e); };\n")
(fprintf op #<<EOF
for (param in params) {
if (params.hasOwnProperty(param)) {
MACHINE.params[param] = params[param];
}
}
EOF
)
(fprintf op "trampoline(~a, function() {}, function(e) { MACHINE.params.currentErrorHandler(e)}); }"
(BasicBlock-name (first basic-blocks)))))

170
browser-evaluate.rkt
View File

@ -1,15 +1,16 @@
#lang racket/base
(require net/sendurl
racket/list
(require racket/list
web-server/servlet
web-server/servlet-env
"package.rkt")
;; A hacky way to test the evaluation.
;;
;; TODO: figure out how to do this without so many urls. Push-style from the server
;; should be able to work.
;; Sets up a web server and opens a browser window.
;; The page on screen periodically polls the server to see if a program has
;; come in to be evaluated. Whenever code does come in, evaluates and returns the
;; value to the user, along with the time it took to evaluate.
(provide evaluate)
@ -17,7 +18,7 @@
(define port (+ 8000 (random 8000)))
;; Channel's meant to serialize use of the web server.
;; This channel's meant to serialize use of the web server.
(define ch (make-channel))
@ -29,21 +30,66 @@
(thread (lambda ()
(define (start req)
(cond
[(exists-binding? 'p (request-bindings req))
;; Create a web page whose content contains
;; the script.
(let ([program (channel-get ch)]
[op (open-output-bytes)])
(fprintf op #<<EOF
;; Server-side sync for a program
[(exists-binding? 'poke (request-bindings req))
(handle-poke req)]
;; Normal result came back
[(exists-binding? 'r (request-bindings req))
(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-poke req)
;; Fixme: add timeout protocol.
(let ([program (sync ch)])
(let ([op (open-output-bytes)])
(package-anonymous program op)
(response/full 200 #"Okay"
(current-seconds)
#"text/plain; charset=utf-8"
empty
(list #"" (get-output-bytes op))))))
(define (handle-normal-response req)
(channel-put ch (list (extract-binding/single 'r (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))))
`(html (body (p "ok"))))
(define (handle-error-response req)
(channel-put ch (make-error-happened
(extract-binding/single 'e (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))))
`(html (body (p "ok"))))
(define (make-on-first-load-response)
(let ([op (open-output-bytes)])
(fprintf op #<<EOF
<html>
<head>
<script>
EOF
)
(package program op)
(fprintf op #<<EOF
</script>
<script>
// http://www.quirksmode.org/js/xmlhttp.html
//
function sendRequest(url,callback,postData) {
@ -86,69 +132,50 @@ function createXMLHTTPObject() {
return xmlhttp;
}
var poke = function() {
sendRequest("/eval",
function(req) {
var invoke = eval(req.responseText)();
var output = [];
var startTime, endTime;
var params = { currentDisplayer: function(v) { output.push(String(v)); } };
var onSuccess = function() {
endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(poke, 0); },
"r=" + encodeURIComponent(output.join('')) +
"&t=" + encodeURIComponent(String(endTime - startTime)));
};
var onFail = function(e) {
endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(poke, 0); },
"e=" + encodeURIComponent(String(e)) +
"&t=" + encodeURIComponent(String(endTime - startTime)));
};
startTime = new Date();
invoke(onSuccess, onFail, params);
},
"poke=t");
};
var whenLoaded = function() {
var output = [], startTime, endTime;
MACHINE.params.currentDisplayer = function(v) {
output.push(String(v));
};
MACHINE.params.currentErrorHandler = function(e) {
endTime = new Date();
document.body.appendChild(document.createTextNode(
"Program evaluated; sending back to DrRacket."));
sendRequest("/eval", function(req) {},
"e=" + encodeURIComponent(String(e)) +
"&t=" + encodeURIComponent(String(endTime - startTime)));
};
startTime = new Date();
invoke(
function() {
endTime = new Date();
document.body.appendChild(document.createTextNode(
"Program evaluated; sending back to DrRacket."));
sendRequest("/eval", function(req) {},
"r=" + encodeURIComponent(output.join('')) +
"&t=" + encodeURIComponent(String(endTime - startTime)));
});
setTimeout(poke, 0);
};
</script>
</head>
<body onload="whenLoaded()">
<p>Running program.</p>
<p>Harness loaded. Do not close this window.</p>
</body>
</html>
EOF
)
(response/full 200 #"Okay"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list #"" (get-output-bytes op))))]
;; Normal result came back
[(exists-binding? 'r (request-bindings req))
(channel-put ch (list (extract-binding/single 'r (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))))
`(html (body (p "ok")))]
;; Error occurred
[(exists-binding? 'e (request-bindings req))
(channel-put ch (make-error-happened
(extract-binding/single 'e (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))))
`(html (body (p "ok")))]
[else
`(html (body (p "Loaded")))]))
(serve/servlet start
#:banner? #f
#:launch-browser? #f
#:quit? #f
#:port port
#:servlet-path "/eval"))))
)
(response/full 200 #"Okay"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list #"" (get-output-bytes op)))))
(define-struct error-happened (str t) #:transparent)
@ -159,7 +186,6 @@ EOF
;; 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
(send-url (format "http://localhost:~a/eval?p=t" port) #f)
(channel-put ch e)
(let ([output+time (channel-get ch)])
(cond [(error-happened? output+time)

7
package.rkt
View File

@ -7,7 +7,8 @@
racket/runtime-path
racket/port)
(provide package)
(provide package
package-anonymous)
;; Packager: produce single .js files to be included.
@ -27,3 +28,7 @@
(fprintf op ";\n"))
(define (package-anonymous source-code op)
(fprintf op "(function() {\n")
(package source-code op)
(fprintf op " return invoke; })\n"))