racketscript · stchang · Jan 7, 2022 · Jan 7, 2022 · Jan 7, 2022 · Jan 13, 2022
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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))
 

diff --git a/racketscript-extras/racketscript/htdp/image.rkt b/racketscript-extras/racketscript/htdp/image.rkt
@@ -1,10 +1,11 @@
 #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)
+         racketscript/interop
          racket/bool
          "private/color.rkt"
          "../private/jscommon.rkt")
@@ -47,6 +48,7 @@
          bitmap/data
          bitmap/url
          freeze
+         ready
 
          print-image
          color
@@ -478,6 +480,77 @@
                             (- (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)))))
+
+($/define/async (ready obj)
+  (when ($/defined? #js.obj.ready) (#js.obj.ready)))
+
+(define-proto UrlBitmap
+  (λ (data)
+    #:with-this this
+    (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)
@@ -678,7 +751,9 @@
   (new (Bitmap data)))
 
 (define (bitmap/url url)
-  (new (Bitmap url)))
+  (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
@@ -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
@@ -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
 

diff --git a/tests/ffi/async.rkt 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
@@ -0,0 +1,3 @@
+Initial
+handler 1
+  do that
diff --git a/tests/ffi/promise-handlers.rkt 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"))