From 5331635502d3a670903f04112c84172ad3f81056 Mon Sep 17 00:00:00 2001
From: Matija Pretnar <matija.pretnar@fmf.uni-lj.si>
Date: Mon, 10 Apr 2023 17:41:34 +0200
Subject: [PATCH] Fix all examples apart from delimited control (#27)

- replaced exceptions with tags
- removed let blocks
- removed now unnecessary (unreachable)s

The output of all examples is as before.
---
 .../continuations/examples/actor-lwt.wast     |  60 ++++-----
 proposals/continuations/examples/actor.wast   |  56 ++++-----
 .../continuations/examples/async-await.wast   |  59 ++++-----
 .../continuations/examples/fun-actor-lwt.wast | 118 +++++++++---------
 proposals/continuations/examples/fun-lwt.wast |  16 +--
 5 files changed, 153 insertions(+), 156 deletions(-)

diff --git a/proposals/continuations/examples/actor-lwt.wast b/proposals/continuations/examples/actor-lwt.wast
index ead651eea..160072c09 100644
--- a/proposals/continuations/examples/actor-lwt.wast
+++ b/proposals/continuations/examples/actor-lwt.wast
@@ -73,7 +73,7 @@
   (table $queue 0 (ref null $cont))
   (memory 1)
 
-  (exception $too-many-mailboxes)
+  (tag $too-many-mailboxes)
 
   (global $qdelta i32 (i32.const 10))
 
@@ -190,8 +190,8 @@
 
   (func $log (import "spectest" "print_i32") (param i32))
 
-  (exception $too-many-mailboxes)
-  (exception $too-many-messages)
+  (tag $too-many-mailboxes)
+  (tag $too-many-messages)
 
   (memory 1)
 
@@ -397,8 +397,8 @@
 
   ;; -1 means empty
 
-  (exception $too-many-mailboxes)
-  (exception $too-many-messages)
+  (tag $too-many-mailboxes)
+  (tag $too-many-messages)
 
   (memory 1)
 
@@ -489,6 +489,10 @@
   (elem declare func $actk)
 
   (func $actk (param $mine i32) (param $nextk (ref $cont))
+    (local $ik (ref $i-cont))
+    (local $k (ref $cont))
+    (local $you (ref $cont))
+    (local $yours i32)
     (loop $l
       (block $on_self (result (ref $i-cont))
         (block $on_spawn (result (ref $cont) (ref $i-cont))
@@ -502,39 +506,35 @@
                )
                (return)
             ) ;;   $on_recv (result (ref $i-cont))
-            (let (local $ik (ref $i-cont))
-              ;; block this thread until the mailbox is non-empty
-              (loop $blocked
-                (if (call $empty-mb (local.get $mine))
-                    (then (suspend $yield)
-                          (br $blocked))
-                )
+            (local.set $ik)
+            ;; block this thread until the mailbox is non-empty
+            (loop $blocked
+              (if (call $empty-mb (local.get $mine))
+                  (then (suspend $yield)
+                        (br $blocked))
               )
-              (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik)))
             )
+            (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik)))
             (br $l)
           ) ;;   $on_send (result i32 i32 (ref $cont))
-          (let (param i32 i32) (local $k (ref $cont))
-            (call $send-to-mb)
-            (local.set $nextk (local.get $k))
-          )
+          (local.set $k)
+          (call $send-to-mb)
+          (local.set $nextk (local.get $k))
           (br $l)
         ) ;;   $on_spawn (result (ref $cont) (ref $i-cont))
-        (let (local $you (ref $cont)) (local $ik (ref $i-cont))
-          (call $new-mb)
-          (let (local $yours i32)
-            (suspend $fork (cont.bind (type $cont)
-                                      (local.get $yours)
-                                      (local.get $you)
-                                      (cont.new (type $ic-cont) (ref.func $actk))))
-            (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik)))
-          )
-        )
+        (local.set $ik)
+        (local.set $you)
+        (call $new-mb)
+        (local.set $yours)
+        (suspend $fork (cont.bind (type $cont)
+                                  (local.get $yours)
+                                  (local.get $you)
+                                  (cont.new (type $ic-cont) (ref.func $actk))))
+        (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik)))
         (br $l)
       ) ;;   $on_self (result (ref $i-cont))
-      (let (local $ik (ref $i-cont))
-        (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik)))
-      )
+      (local.set $ik)
+      (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik)))
       (br $l)
     )
   )
diff --git a/proposals/continuations/examples/actor.wast b/proposals/continuations/examples/actor.wast
index 3a8d36f48..9f86e8e0d 100644
--- a/proposals/continuations/examples/actor.wast
+++ b/proposals/continuations/examples/actor.wast
@@ -73,7 +73,7 @@
   (table $queue 0 (ref null $cont))
   (memory 1)
 
-  (exception $too-many-mailboxes)
+  (tag $too-many-mailboxes)
 
   (global $qdelta i32 (i32.const 10))
 
@@ -190,8 +190,8 @@
 
   (func $log (import "spectest" "print_i32") (param i32))
 
-  (exception $too-many-mailboxes)
-  (exception $too-many-messages)
+  (tag $too-many-mailboxes)
+  (tag $too-many-messages)
 
   (memory 1)
 
@@ -317,6 +317,10 @@
 
   (func $run (export "run") (param $nextk (ref null $cont))
     (local $mine i32)                ;; current mailbox
+    (local $ik (ref $i-cont))
+    (local $k (ref $cont))
+    (local $you (ref $cont))
+    (local $yours i32)
     (call $init)
     (local.set $mine (call $new-mb))
     (loop $l
@@ -335,38 +339,34 @@
                (local.set $nextk (call $dequeue-k))
                (br $l)
             ) ;;   $on_recv (result (ref $i-cont))
-            (let (local $ik (ref $i-cont))
-              ;; block this thread until the mailbox is non-empty
-              (if (call $empty-mb (local.get $mine))
-                  (then (call $enqueue-mb (local.get $mine))
-                        (call $enqueue-k (call $recv-again (local.get $ik)))
-                        (local.set $mine (call $dequeue-mb))
-                        (local.set $nextk (call $dequeue-k))
-                        (br $l))
-              )
-              (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik)))
+            (local.set $ik)
+            ;; block this thread until the mailbox is non-empty
+            (if (call $empty-mb (local.get $mine))
+                (then (call $enqueue-mb (local.get $mine))
+                      (call $enqueue-k (call $recv-again (local.get $ik)))
+                      (local.set $mine (call $dequeue-mb))
+                      (local.set $nextk (call $dequeue-k))
+                      (br $l))
             )
+            (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik)))
             (br $l)
           ) ;;   $on_send (result i32 i32 (ref $cont))
-          (let (param i32 i32) (local $k (ref $cont))
-            (call $send-to-mb)
-            (local.set $nextk (local.get $k))
-          )
+          (local.set $k)
+          (call $send-to-mb)
+          (local.set $nextk (local.get $k))
           (br $l)
         ) ;;   $on_spawn (result (ref $cont) (ref $i-cont))
-        (let (local $you (ref $cont)) (local $ik (ref $i-cont))
-          (call $new-mb)
-          (let (local $yours i32)
-            (call $enqueue-mb (local.get $yours))
-            (call $enqueue-k (local.get $you))
-            (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik)))
-          )
-        )
+        (local.set $ik)
+        (local.set $you)
+        (call $new-mb)
+        (local.set $yours)
+        (call $enqueue-mb (local.get $yours))
+        (call $enqueue-k (local.get $you))
+        (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik)))
         (br $l)
       ) ;;   $on_self (result (ref $i-cont))
-      (let (local $ik (ref $i-cont))
-        (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik)))
-      )
+      (local.set $ik)
+      (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik)))
       (br $l)
     )
   )
diff --git a/proposals/continuations/examples/async-await.wast b/proposals/continuations/examples/async-await.wast
index 514ed4170..fa2ea9dcf 100644
--- a/proposals/continuations/examples/async-await.wast
+++ b/proposals/continuations/examples/async-await.wast
@@ -163,8 +163,8 @@
   ;; a simplistic implementation of promises that assumes a maximum of
   ;; 1000 promises and a maximum of one observer per promise
 
-  (exception $too-many-promises)
-  (exception $too-many-observers)
+  (tag $too-many-promises)
+  (tag $too-many-observers)
 
   (global $num-promises (mut i32) (i32.const 0))
   (global $max-promises i32 (i32.const 1000))
@@ -254,6 +254,11 @@
   (func $fulfill-promise (import "promise" "fulfill") (param $p i32) (param $v i32) (result (ref null $cont)))
 
   (func $run (export "run") (param $nextk (ref null $cont))
+    (local $p i32)
+    (local $v i32)
+    (local $ik (ref $i-cont))
+    (local $ak (ref $i-cont))
+    (local $k (ref null $cont))
     (loop $l
       (if (ref.is_null (local.get $nextk)) (then (return)))
       (block $on_yield (result (ref $cont))
@@ -269,38 +274,36 @@
               (local.set $nextk (call $dequeue))
               (br $l)  ;; thread terminated
             ) ;;   $on_await (result i32 (ref $i-cont))
-            (let (local $p i32) (local $ik (ref $i-cont))
-              (if (call $promise-fulfilled (local.get $p))
-                 ;; if promise fulfilled then run continuation partially applied to value
-                 (then (local.set $nextk (cont.bind (type $cont) (call $promise-value (local.get $p)) (local.get $ik))))
-                 ;; else add continuation to promise and run next continuation from the queue
-                 (else (call $await-promise (local.get $p) (local.get $ik))
-                       (local.set $nextk (call $dequeue)))
-              )
+            (local.set $ik)
+            (local.set $p)
+            (if (call $promise-fulfilled (local.get $p))
+                ;; if promise fulfilled then run continuation partially applied to value
+                (then (local.set $nextk (cont.bind (type $cont) (call $promise-value (local.get $p)) (local.get $ik))))
+                ;; else add continuation to promise and run next continuation from the queue
+                (else (call $await-promise (local.get $p) (local.get $ik))
+                      (local.set $nextk (call $dequeue)))
             )
             (br $l)
           ) ;;   $on_async (result (ref $i-func) (ref $i-cont))
-          (let (local $ak (ref $i-cont)) (local $ik (ref $i-cont))
-             ;; create new promise
-             (call $new-promise)
-             (let (local $p i32)
-                ;; enqueue continuation partially applied to promise
-                (call $enqueue (cont.bind (type $cont) (local.get $p) (local.get $ik)))
-                ;; run computation partially applied to promise
-                (local.set $nextk (cont.bind (type $cont) (local.get $p) (local.get $ak)))
-             )
-          )
+          (local.set $ik)
+          (local.set $ak)
+            ;; create new promise
+            (call $new-promise)
+            (local.set $p)
+            ;; enqueue continuation partially applied to promise
+            (call $enqueue (cont.bind (type $cont) (local.get $p) (local.get $ik)))
+            ;; run computation partially applied to promise
+            (local.set $nextk (cont.bind (type $cont) (local.get $p) (local.get $ak)))
           (br $l)
         ) ;;   $on_fulfill (result i32 i32 (ref $cont))
         (local.set $nextk)
-        (let (local $p i32) (local $v i32)
-           (call $fulfill-promise (local.get $p) (local.get $v))
-           (let (local $k (ref null $cont))
-              (if (ref.is_null (local.get $k))
-                (then)
-                (else (call $enqueue (local.get $k)))
-              )
-           )
+        (local.set $v)
+        (local.set $p)
+        (call $fulfill-promise (local.get $p) (local.get $v))
+        (local.set $k)
+        (if (ref.is_null (local.get $k))
+          (then)
+          (else (call $enqueue (local.get $k)))
         )
         (br $l)
       ) ;;   $on_yield (result (ref $cont))
diff --git a/proposals/continuations/examples/fun-actor-lwt.wast b/proposals/continuations/examples/fun-actor-lwt.wast
index 2b1f95fd8..d79296fa8 100644
--- a/proposals/continuations/examples/fun-actor-lwt.wast
+++ b/proposals/continuations/examples/fun-actor-lwt.wast
@@ -169,8 +169,8 @@
 
   ;; -1 means empty
 
-  (exception $too-many-mailboxes)
-  (exception $too-many-messages)
+  (tag $too-many-mailboxes)
+  (tag $too-many-messages)
 
   (memory 1)
 
@@ -253,6 +253,9 @@
 
   ;; resume with $ik applied to $res
   (func $act-res (param $mine i32) (param $res i32) (param $ik (ref $i-cont))
+    (local $yours i32)
+    (local $k (ref $cont))
+    (local $you (ref $cont))
     (block $on_self (result (ref $i-cont))
       (block $on_spawn (result (ref $cont) (ref $i-cont))
         (block $on_send (result i32 i32 (ref $cont))
@@ -267,45 +270,42 @@
              )
              (return)
           ) ;;   $on_recv (result (ref $i-cont))
-          (let (local $ik (ref $i-cont))
-            ;; block this thread until the mailbox is non-empty
-            (loop $l
-              (if (call $empty-mb (local.get $mine))
-                  (then (suspend $yield)
-                        (br $l))
-              )
+          (local.set $ik)
+          ;; block this thread until the mailbox is non-empty
+          (loop $l
+            (if (call $empty-mb (local.get $mine))
+                (then (suspend $yield)
+                      (br $l))
             )
-            (call $recv-from-mb (local.get $mine))
-            (local.set $res)
-            (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik)))
-          (unreachable)
+          )
+          (call $recv-from-mb (local.get $mine))
+          (local.set $res)
+          (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))
         ) ;;   $on_send (result i32 i32 (ref $cont))
-        (let (param i32 i32) (local $k (ref $cont))
-          (call $send-to-mb)
-          (return_call $act-nullary (local.get $mine) (local.get $k)))
-        (unreachable)
+        (local.set $k)
+        (call $send-to-mb)
+        (return_call $act-nullary (local.get $mine) (local.get $k))
       ) ;;   $on_spawn (result (ref $cont) (ref $i-cont))
-      (let (local $you (ref $cont)) (local $ik (ref $i-cont))
-        (call $new-mb)
-        (let (local $yours i32)
-          (suspend $fork (cont.bind (type $cont)
-                                    (local.get $yours)
-                                    (local.get $you)
-                                    (cont.new (type $icont-cont) (ref.func $act-nullary))))
-          (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik))
-        )
-      )
-      (unreachable)
+      (local.set $ik)
+      (local.set $you)
+      (call $new-mb)
+      (local.set $yours)
+      (suspend $fork (cont.bind (type $cont)
+                                (local.get $yours)
+                                (local.get $you)
+                                (cont.new (type $icont-cont) (ref.func $act-nullary))))
+      (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik))
     ) ;;   $on_self (result (ref $i-cont))
-    (let (local $ik (ref $i-cont))
-      (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik))
-    )
-    (unreachable)
+    (local.set $ik)
+    (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik))
   )
 
   ;; resume with nullary continuation
   (func $act-nullary (param $mine i32) (param $k (ref $cont))
     (local $res i32)
+    (local $ik (ref $i-cont))
+    (local $you (ref $cont))
+    (local $yours i32)
     (block $on_self (result (ref $i-cont))
       (block $on_spawn (result (ref $cont) (ref $i-cont))
         (block $on_send (result i32 i32 (ref $cont))
@@ -320,40 +320,34 @@
              )
              (return)
           ) ;;   $on_recv (result (ref $i-cont))
-          (let (local $ik (ref $i-cont))
-            ;; block this thread until the mailbox is non-empty
-            (loop $l
-              (if (call $empty-mb (local.get $mine))
-                  (then (suspend $yield)
-                        (br $l))
-              )
+          (local.set $ik)
+          ;; block this thread until the mailbox is non-empty
+          (loop $l
+            (if (call $empty-mb (local.get $mine))
+                (then (suspend $yield)
+                      (br $l))
             )
-            (call $recv-from-mb (local.get $mine))
-            (local.set $res)
-            (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik)))
-          (unreachable)
+          )
+          (call $recv-from-mb (local.get $mine))
+          (local.set $res)
+          (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))
         ) ;;   $on_send (result i32 i32 (ref $cont))
-        (let (param i32 i32) (local $k (ref $cont))
-          (call $send-to-mb)
-          (return_call $act-nullary (local.get $mine) (local.get $k)))
-        (unreachable)
+        (local.set $k)
+        (call $send-to-mb)
+        (return_call $act-nullary (local.get $mine) (local.get $k))
       ) ;;   $on_spawn (result (ref $cont) (ref $i-cont))
-      (let (local $you (ref $cont)) (local $ik (ref $i-cont))
-        (call $new-mb)
-        (let (local $yours i32)
-          (suspend $fork (cont.bind (type $cont)
-                                    (local.get $yours)
-                                    (local.get $you)
-                                    (cont.new (type $icont-cont) (ref.func $act-nullary))))
-          (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik))
-        )
-      )
-      (unreachable)
+      (local.set $ik)
+      (local.set $you)
+      (call $new-mb)
+      (local.set $yours)
+      (suspend $fork (cont.bind (type $cont)
+                                (local.get $yours)
+                                (local.get $you)
+                                (cont.new (type $icont-cont) (ref.func $act-nullary))))
+      (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik))
     ) ;;   $on_self (result (ref $i-cont))
-    (let (local $ik (ref $i-cont))
-      (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik))
-    )
-    (unreachable)
+    (local.set $ik)
+    (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik))
   )
 
   (func $act (export "act") (param $k (ref $cont))
diff --git a/proposals/continuations/examples/fun-lwt.wast b/proposals/continuations/examples/fun-lwt.wast
index 0da82ee55..943b8804f 100644
--- a/proposals/continuations/examples/fun-lwt.wast
+++ b/proposals/continuations/examples/fun-lwt.wast
@@ -139,9 +139,9 @@
         )
         (return_call $sync (call $dequeue))
       ) ;;   $on_fork (result (ref $func) (ref $cont))
-      (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont))
+      (local.set $nextk)
       (call $enqueue)
-      (return_call $sync (local.get $nextk)))
+      (return_call $sync (local.get $nextk))
     ) ;;   $on_yield (result (ref $cont))
     (return_call $sync)
   )
@@ -166,9 +166,9 @@
         )
         (return_call $tk (call $dequeue))
       ) ;;   $on_fork (result (ref $func) (ref $cont))
-      (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont))
+      (local.set $nextk)
       (call $enqueue)
-      (return_call $tk (local.get $nextk)))
+      (return_call $tk (local.get $nextk))
     ) ;;   $on_yield (result (ref $cont))
     (call $enqueue)
     (return_call $tk (call $dequeue))
@@ -213,16 +213,16 @@
 
   ;; yield on fork, new thread first
   (func $ytk (export "ytk") (param $nextk (ref null $cont))
+    (local $k (ref $cont))
     (if (ref.is_null (local.get $nextk)) (then (return)))
     (block $on_yield (result (ref $cont))
       (block $on_fork (result (ref $cont) (ref $cont))
         (resume (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk))
         (return_call $ytk (call $dequeue))
       ) ;;   $on_fork (result (ref $cont) (ref $cont))
-      (let (param (ref $cont)) (local $k (ref $cont))
-        (call $enqueue)
-        (call $enqueue (local.get $k))
-      )
+      (local.set $k)
+      (call $enqueue)
+      (call $enqueue (local.get $k))
       (return_call $ytk (call $dequeue))
     ) ;;   $on_yield (result (ref $cont))
     (call $enqueue)