From 28743c9ab1f98617046018c97c3b437fdddad767 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Fri, 7 Jan 2022 00:08:57 +0000 Subject: [PATCH 1/4] interop: add $/async and $/await --- .../racketscript/compiler/assembler.rkt | 6 ++++++ .../racketscript/compiler/il-analyze.rkt | 14 +++++++++++++ .../racketscript/compiler/il.rkt | 2 ++ .../racketscript/compiler/transform.rkt | 12 ++++++++--- .../racketscript/interop.rkt | 20 +++++++++++++++++++ 5 files changed, 51 insertions(+), 3 deletions(-) diff --git a/racketscript-compiler/racketscript/compiler/assembler.rkt b/racketscript-compiler/racketscript/compiler/assembler.rkt index 952d497d..4c9786f8 100644 --- a/racketscript-compiler/racketscript/compiler/assembler.rkt +++ b/racketscript-compiler/racketscript/compiler/assembler.rkt @@ -125,6 +125,12 @@ (emit "typeof(") (assemble-expr expr out) (emit ")")] + [(ILAsync expr) + (emit "async ") + (assemble-expr expr out)] + [(ILAwait expr) + (emit "await ") + (assemble-expr expr out)] [(ILValue v) (assemble-value v out)] [(ILNull) (emit "null")] diff --git a/racketscript-compiler/racketscript/compiler/il-analyze.rkt b/racketscript-compiler/racketscript/compiler/il-analyze.rkt index f6bb7ebe..c09728ff 100644 --- a/racketscript-compiler/racketscript/compiler/il-analyze.rkt +++ b/racketscript-compiler/racketscript/compiler/il-analyze.rkt @@ -75,6 +75,8 @@ [(ILIndex expr field-expr) (ILIndex (traverse-expr expr) (traverse-expr field-expr))] [(ILNew e) (ILNew (cast (traverse-expr e) (U ILApp ILLValue)))] + [(ILAsync e) (ILAsync (traverse-expr e))] + [(ILAwait e) (ILAwait (traverse-expr e))] [(ILInstanceOf expr type) (ILInstanceOf (traverse-expr expr) (traverse-expr type))] [(ILTypeOf expr) (ILTypeOf (traverse-expr expr))] @@ -202,6 +204,8 @@ (ILTypeOf (handle-expr expr))] [(ILNew v) (ILNew (cast (handle-expr v) (U Symbol ILRef ILIndex ILApp)))] + [(ILAsync v) (ILAsync (handle-expr v))] + [(ILAwait v) (ILAwait (handle-expr v))] [(ILValue v) e] [(ILUndefined) e] [(ILArguments) e] @@ -670,6 +674,8 @@ [(ILThis) e] [(ILNull) e] [(ILNew v) e] + [(ILAsync expr) (ILAsync (handle-expr/general expr))] + [(ILAwait expr) (ILAwait (handle-expr/general expr))] [(? symbol? v) e])) (: handle-stm (-> ILStatement ILResult)) @@ -895,6 +901,8 @@ [(ILUndefined) (list (set) (set))] [(ILNull) (list (set) (set))] [(ILNew e) (find e defs)] + [(ILAsync e) (find e defs)] + [(ILAwait e) (find e defs)] [(? symbol? v) (list (set) (if (set-member? defs v) @@ -978,6 +986,8 @@ [(ILUndefined) #f] [(ILNull) #f] [(ILNew _) #t] + [(ILAsync _) #t] + [(ILAwait _) #t] [(ILInstanceOf expr type) (or (has-application? expr) (has-application? type))] [(ILTypeOf expr) (has-application? expr)] @@ -1100,6 +1110,8 @@ [(ILThis) (list (set) (set))] [(ILNull) (list (set) (set))] [(ILNew e) (used+defined/statement e)] + [(ILAsync e) (used+defined/statement e)] + [(ILAwait e) (used+defined/statement e)] [(? symbol? v) (list (set v) (set))])) @@ -1203,6 +1215,8 @@ (flatten-if-else/expr fieldexpr))] [(ILNew expr*) (ILNew (cast (flatten-if-else/expr expr*) (U ILLValue ILApp)))] + [(ILAsync expr) (ILAsync (flatten-if-else/expr expr))] + [(ILAwait expr) (ILAwait (flatten-if-else/expr expr))] [(ILInstanceOf expr* type) (ILInstanceOf (flatten-if-else/expr expr*) (flatten-if-else/expr type))] [(ILTypeOf expr) (ILTypeOf (flatten-if-else/expr expr))] diff --git a/racketscript-compiler/racketscript/compiler/il.rkt b/racketscript-compiler/racketscript/compiler/il.rkt index f44973a2..5b72fc31 100644 --- a/racketscript-compiler/racketscript/compiler/il.rkt +++ b/racketscript-compiler/racketscript/compiler/il.rkt @@ -56,6 +56,8 @@ (ILInstanceOf [expr : ILExpr] [type : ILExpr]) (ILTypeOf [expr : ILExpr]) + (ILAsync [expr : ILExpr]) + (ILAwait [expr : ILExpr]) ;; Should be ideally in values (ILNull) diff --git a/racketscript-compiler/racketscript/compiler/transform.rkt b/racketscript-compiler/racketscript/compiler/transform.rkt index 6d2e72d7..ed1ad7a1 100644 --- a/racketscript-compiler/racketscript/compiler/transform.rkt +++ b/racketscript-compiler/racketscript/compiler/transform.rkt @@ -388,6 +388,12 @@ [(list (Quote 'typeof) e) (define-values (stms val) (absyn-expr->il e #f)) (values stms (ILTypeOf val))] + [(list (Quote 'async) e) + (define-values (stms val) (absyn-expr->il e #f)) + (values stms (ILAsync val))] + [(list (Quote 'await) e) + (define-values (stms val) (absyn-expr->il e #f)) + (values stms (ILAwait val))] [(list (Quote 'instanceof) e t) ;;TODO: Not ANF. (define-values (stms val) (absyn-expr->il e #f)) @@ -407,7 +413,7 @@ (values '() (ILArguments))] [(list (Quote 'this)) (values '() (ILThis))] - [_ (error 'absyn-expr->il "unknown ffi form" args)])] + [_ (error 'absyn-expr->il "unknown ffi form: ~a" args)])] [(PlainApp lam args) ;;NOTE: Comparision operators work only on two operands TODO @@ -583,7 +589,7 @@ (values stms result-id)] [(VarRef _) (values '() (absyn-value->il '#%variable-reference))] - [_ (error (~a "unsupported expr " expr))])) + [_ (error 'absyn-expr->il "unsupported expr ~a" expr)])) (: absyn-binding->il (-> Binding ILStatement*)) @@ -667,7 +673,7 @@ (void? d) (real? d)) (ILValue d)] - [else (error (~a "unsupported value" d))])) + [else (error 'absyn-value->il "unsupported value ~a" d)])) (: expand-normal-case-lambda (-> (Listof PlainLambda) (Listof PlainLambda) diff --git a/racketscript-compiler/racketscript/interop.rkt b/racketscript-compiler/racketscript/interop.rkt index 8796e7c8..5c6d19f4 100644 --- a/racketscript-compiler/racketscript/interop.rkt +++ b/racketscript-compiler/racketscript/interop.rkt @@ -22,6 +22,9 @@ $/+ $/str $/this + $/async + $/define/async + $/await =>$ js-string js-string->string @@ -206,6 +209,23 @@ [(_ e) #'e] [(_ e . rst) #'($/binop + e ($/+ . rst))])) +(define-syntax ($/async stx) + (syntax-parse stx + [(_ e:expr) + #`(#%js-ffi 'async e)])) + +(define-syntax ($/define/async stx) + (syntax-parse stx + [(_ (name . args) . body) + #'(define name + ($/async + (lambda args . body)))])) + +(define-syntax ($/await stx) + (syntax-parse stx + [(_ e:expr) + #`(#%js-ffi 'await e)])) + (define (js-string e) ($$ e.toString)) From 80575a9b44f51f3b5e9e452a44955a638b9968dd Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Fri, 7 Jan 2022 00:09:31 +0000 Subject: [PATCH 2/4] add $/async $/await tests --- tests/ffi/async.rkt | 22 ++++++++++++++++++++++ tests/ffi/async.rkt.expected | 3 +++ tests/ffi/promise-handlers.rkt | 23 +++++++++++++++++++++++ tests/ffi/promises.rkt | 16 ++++++++++++++++ tests/ffi/promises.rkt.expected | 5 +++++ 5 files changed, 69 insertions(+) create mode 100644 tests/ffi/async.rkt create mode 100644 tests/ffi/async.rkt.expected create mode 100644 tests/ffi/promise-handlers.rkt create mode 100644 tests/ffi/promises.rkt create mode 100644 tests/ffi/promises.rkt.expected diff --git a/tests/ffi/async.rkt b/tests/ffi/async.rkt new file mode 100644 index 00000000..16e85337 --- /dev/null +++ b/tests/ffi/async.rkt @@ -0,0 +1,22 @@ +#lang racketscript/base +(require "promise-handlers.rkt" + racketscript/interop) + +;; see also promises.rkt + +;; ## prints (everything after err is aborted) +;; Initial +;; handler1: +;; do that (from catch) + +;; using async/await +($/define/async (go) + (define result ($/await (mkpromise))) + (define res2 ($/await (handler1 result))) + (define res3 ($/await (handler2 result))) ;; skipped + (#js*.console.log #js"final result:") ;; skipped + (#js*.console.log res3)) + +($> (go) + (catch errhandle)) + diff --git a/tests/ffi/async.rkt.expected b/tests/ffi/async.rkt.expected new file mode 100644 index 00000000..33d73f52 --- /dev/null +++ b/tests/ffi/async.rkt.expected @@ -0,0 +1,3 @@ +Initial +handler 1 + do that diff --git a/tests/ffi/promise-handlers.rkt b/tests/ffi/promise-handlers.rkt new file mode 100644 index 00000000..27421ea5 --- /dev/null +++ b/tests/ffi/promise-handlers.rkt @@ -0,0 +1,23 @@ +#lang racketscript/base +(provide (all-defined-out)) + +;; see also promises.rkt and async.rkt + +(define (mkpromise) + ($/new + (#js*.Promise + (lambda (resolve reject) + (#js*.console.log #js"Initial") + (resolve null))))) +(define (handler1 res) + (#js*.console.log #js"handler 1") + ($/throw ($/new (#js*.Error #js"Something failed"))) + (#js*.console.log #js" skipped thing")) ; gets skipped + +(define (handler2 res) + (#js*.console.log #js"handler 2") + (#js*.console.log #js" do this no matter what") + #js"final res") + +(define (errhandle err) + (#js*.console.log #js" do that")) diff --git a/tests/ffi/promises.rkt b/tests/ffi/promises.rkt new file mode 100644 index 00000000..d8629ffd --- /dev/null +++ b/tests/ffi/promises.rkt @@ -0,0 +1,16 @@ +#lang racketscript/base +(require "promise-handlers.rkt") + +;; see also async.rkt + +($> (mkpromise) + (then handler1) + (catch errhandle) + (then handler2)) + +;; ## prints: +;; Initial +;; handler1: +;; do that (from catch) +;; handler2: +;; do this no matter what (from last then) diff --git a/tests/ffi/promises.rkt.expected b/tests/ffi/promises.rkt.expected new file mode 100644 index 00000000..9cab23b8 --- /dev/null +++ b/tests/ffi/promises.rkt.expected @@ -0,0 +1,5 @@ +Initial +handler 1 + do that +handler 2 + do this no matter what From df4665a009e1388543bd7b920a861bc73bc12811 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Fri, 7 Jan 2022 00:10:03 +0000 Subject: [PATCH 3/4] racketscript/htdp/image: try to use promises --- .../racketscript/htdp/image.rkt | 78 +++++++++++++++++++ 1 file changed, 78 insertions(+) diff --git a/racketscript-extras/racketscript/htdp/image.rkt b/racketscript-extras/racketscript/htdp/image.rkt index 8d30aba6..73ec6954 100644 --- a/racketscript-extras/racketscript/htdp/image.rkt +++ b/racketscript-extras/racketscript/htdp/image.rkt @@ -5,6 +5,7 @@ (require (for-syntax racketscript/base syntax/parse) + racketscript/interop racket/bool "private/color.rkt" "../private/jscommon.rkt") @@ -478,6 +479,74 @@ (- (half #js.image.width)) (- (half #js.image.height)))))]) +;; from: https://github.com/mdn/js-examples/blob/master/promises-test/index.html +;; function imgLoad(url) { +;; // Create new promise with the Promise() constructor; +;; // This has as its argument a function +;; // with two parameters, resolve and reject +;; return new Promise(function(resolve, reject) { +;; // Standard XHR to load an image +;; var request = new XMLHttpRequest(); +;; request.open('GET', url); +;; request.responseType = 'blob'; +;; // When the request loads, check whether it was successful +;; request.onload = function() { +;; if (request.status === 200) { +;; // If successful, resolve the promise by passing back the request response +;; resolve(request.response); +;; } else { +;; // If it fails, reject the promise with a error message +;; reject(Error('Image didn\'t load successfully; error code:' + request.statusText)); +;; } +;; }; +;; request.onerror = function() { +;; // Also deal with the case when the entire request fails to begin with +;; // This is probably a network error, so reject the promise with an appropriate message +;; reject(Error('There was a network error.')); +;; }; +;; // Send the request +;; request.send(); +;; }); +;; } +(define (imgLoad url) + ($/new + (#js*.Promise + (lambda (resolve reject) + (define request ($/new (#js*.XMLHttpRequest))) + (#js.request.open #js"GET" url) + ($/:= #js.request.responseType #js"blob") + ($/:= #js.request.onload + (lambda () + (if ($/binop === #js.request.status 200) + (resolve #js.request.response) + (reject (#js*.Error #js"Image didnt load successfully"))))) + ($/:= #js.request.onerror + (lambda () ($/throw (#js*.Error #js"There was a network error")))) + (#js.request.send))))) + +;; doesnt work, images rendered in wrong order +(define-proto UrlBitmap + (λ (data) + #:with-this this + (set-object! this + [image + ($/new + (#js*.Promise + (lambda (resolve reject) + (define image (new #js*.Image)) + (:= #js.image.crossOrigin #js"anonymous") + (:= #js.image.src (js-string data)) + (resolve image))))])) + [render + (λ (ctx x y) + #:with-this this + ($> #js.this.image + (then + (lambda (image) + (with-origin ctx [x y] + (#js.ctx.drawImage image + (- (half #js.image.width)) + (- (half #js.image.height))))))))]) (define-proto Freeze (λ (img) @@ -680,6 +749,15 @@ (define (bitmap/url url) (new (Bitmap url))) +;; doesnt work, images rendered in wrong order +#;(define (bitmap/url url) + (new (UrlBitmap url))) + +;; doesnt work, "render" is not a function" +#;($/define/async (bitmap/url url) + (define blob ($/await (imgLoad url))) + (new (Bitmap (#js*.window.URL.createObjectURL blob)))) + (define (frame img) (color-frame "black" img)) From cd1933f62b7115a499397456a63a2420a625fec1 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Thu, 13 Jan 2022 20:35:30 +0000 Subject: [PATCH 4/4] fix big-bang bitmap/url async image fetch --- .../racketscript/htdp/image.rkt | 61 +++++++++---------- .../racketscript/htdp/universe.rkt | 14 +++-- .../racketscript/private/jscommon.rkt | 13 +++- 3 files changed, 51 insertions(+), 37 deletions(-) diff --git a/racketscript-extras/racketscript/htdp/image.rkt b/racketscript-extras/racketscript/htdp/image.rkt index 73ec6954..1bdb6e69 100644 --- a/racketscript-extras/racketscript/htdp/image.rkt +++ b/racketscript-extras/racketscript/htdp/image.rkt @@ -1,7 +1,7 @@ #lang racketscript/base -;; Emulates 2htdp/image library as much as possible. Also see -;; Whalesong's implementation, which we have referrred +;; Emulates 2htdp/image library as much as possible. +;; Borrows from Whalesong's implementation (require (for-syntax racketscript/base syntax/parse) @@ -48,6 +48,7 @@ bitmap/data bitmap/url freeze + ready print-image color @@ -524,29 +525,32 @@ (lambda () ($/throw (#js*.Error #js"There was a network error")))) (#js.request.send))))) -;; doesnt work, images rendered in wrong order +($/define/async (ready obj) + (when ($/defined? #js.obj.ready) (#js.obj.ready))) + (define-proto UrlBitmap (λ (data) #:with-this this - (set-object! this - [image - ($/new - (#js*.Promise - (lambda (resolve reject) - (define image (new #js*.Image)) - (:= #js.image.crossOrigin #js"anonymous") - (:= #js.image.src (js-string data)) - (resolve image))))])) - [render - (λ (ctx x y) - #:with-this this - ($> #js.this.image - (then - (lambda (image) - (with-origin ctx [x y] - (#js.ctx.drawImage image - (- (half #js.image.width)) - (- (half #js.image.height))))))))]) + (set-object! this [loaded-image (imgLoad data)])) + [ready + ($/async + (λ () #:with-this this + (define data ($/await #js.this.loaded-image)) + (define image (new #js*.Image)) + (:= #js.image.crossOrigin #js"anonymous") + (:= #js.image.src (#js*.window.URL.createObjectURL data)) + (set-object! this + [image image] + [width #js.image.width] + [height #js.image.height])))] + [render + (λ (ctx x y) + #:with-this this + (define image #js.this.image) + (with-origin ctx [x y] + (#js.ctx.drawImage image + (- (half #js.image.width)) + (- (half #js.image.height)))))]) (define-proto Freeze (λ (img) @@ -747,16 +751,9 @@ (new (Bitmap data))) (define (bitmap/url url) - (new (Bitmap url))) - -;; doesnt work, images rendered in wrong order -#;(define (bitmap/url url) - (new (UrlBitmap url))) - -;; doesnt work, "render" is not a function" -#;($/define/async (bitmap/url url) - (define blob ($/await (imgLoad url))) - (new (Bitmap (#js*.window.URL.createObjectURL blob)))) + (define b (new (UrlBitmap url))) + (register-async-obj b) + b) (define (frame img) (color-frame "black" img)) diff --git a/racketscript-extras/racketscript/htdp/universe.rkt b/racketscript-extras/racketscript/htdp/universe.rkt index 7785578b..a705a5e9 100644 --- a/racketscript-extras/racketscript/htdp/universe.rkt +++ b/racketscript-extras/racketscript/htdp/universe.rkt @@ -21,9 +21,11 @@ (new (BigBang init-world handlers))) (define (big-bang init-world . handlers) - ($> (make-big-bang init-world handlers) + #;($> (make-big-bang init-world handlers) (setup) - (start))) + (start)) + (define bb (make-big-bang init-world handlers)) + ($> (#js.bb.setup) (then #js.bb.start))) (define-proto BigBang (λ (init-world handlers) @@ -39,7 +41,7 @@ (:= #js.this.-stopped #t) (:= #js.this.-events ($/array))) [setup - (λ () + ($/async (λ () #:with-this this ;; Create canvas DOM element and add to screen (define canvas (#js.document.createElement #js"canvas")) @@ -60,6 +62,8 @@ (define draw-handler ($ #js.this.-active-handlers #js"to-draw")) (unless draw-handler (error 'big-bang "to-draw handle not provided")) + + (define (finish-setup res) (define img ($$ draw-handler.callback #js.this.world)) (:= #js.canvas.width #js.img.width) (:= #js.canvas.height #js.img.height) @@ -68,7 +72,9 @@ ;; callbacks gets invoked at start of big-bang (#js.this.change-world #js.this.world) - this)] + this) + + ($> (await-async-objs) (then finish-setup))))] [register-handlers (λ () #:with-this this diff --git a/racketscript-extras/racketscript/private/jscommon.rkt b/racketscript-extras/racketscript/private/jscommon.rkt index 5950e320..f55128ac 100644 --- a/racketscript-extras/racketscript/private/jscommon.rkt +++ b/racketscript-extras/racketscript/private/jscommon.rkt @@ -1,7 +1,8 @@ #lang racketscript/base (require (for-syntax racketscript/base - syntax/parse)) + syntax/parse) + racketscript/interop) (provide := *this* @@ -12,6 +13,8 @@ set-object! schedule-method schedule-animation-frame + register-async-obj + await-async-objs document console Math @@ -75,6 +78,14 @@ (#js*.window.requestAnimationFrame (λ () (($ self step)))))) +;; global table of promises that must be await'ed +;; TODO: this should go somewhere in big-bang obj? +(define ASYNC-OBJS ($/array)) +(define (register-async-obj obj) + (#js.ASYNC-OBJS.push obj)) +($/define/async (await-async-objs) + (#js*.Promise.all (#js.ASYNC-OBJS.map (lambda (x) (#js.x.ready))))) + ;;----------------------------------------------------------------------------- ;; Helper functions