diff --git a/assemble.rkt b/assemble.rkt index 4e363a9..0633d40 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -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 #<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 #< - -

Running program.

+

Harness loaded. Do not close this window.

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) diff --git a/package.rkt b/package.rkt index f715ff1..d63536d 100644 --- a/package.rkt +++ b/package.rkt @@ -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")) \ No newline at end of file