erlang: send + selective receive via shift/reset (+13 tests)

lib/erlang/transpile.sx

@@ -64,20 +64,27 @@
         ((body (er-parse-body st)))
         (er-sched-init!)
         (let
-          ((main (er-proc-new! (er-env-new))))
-          (er-sched-next-runnable!)
-          (er-sched-set-current! (get main :pid))
-          (er-proc-set! (get main :pid) :state "running")
+          ((env (er-env-new)))
           (let
-            ((result (er-eval-body body (get main :env))))
-            (er-proc-set! (get main :pid) :state "dead")
-            (er-proc-set!
-              (get main :pid)
-              :exit-reason
-              (er-mk-atom "normal"))
-            (er-sched-set-current! nil)
-            (er-sched-drain!)
-            result))))))
+            ((main-fun
+              (er-mk-fun
+                (list
+                  {:patterns (list)
+                    :body body
+                    :guards (list)
+                    :name nil})
+                env)))
+            (let
+              ((main-proc (er-proc-new! env)))
+              (dict-set! main-proc :initial-fun main-fun)
+              (er-sched-run-all!)
+              (let
+                ((main-pid (get main-proc :pid)))
+                (if
+                  (not (= (er-proc-field main-pid :state) "dead"))
+                  (error
+                    "Erlang: deadlock — main process never terminated")
+                  (er-proc-field main-pid :exit-result))))))))))
 
 (define
   er-eval-body
@@ -113,6 +120,8 @@
         (= ty "case") (er-eval-case node env)
         (= ty "call") (er-eval-call node env)
         (= ty "fun") (er-eval-fun node env)
+        (= ty "send") (er-eval-send node env)
+        (= ty "receive") (er-eval-receive node env)
         (= ty "match") (er-eval-match node env)
         :else (error (str "Erlang eval: unsupported node type '" ty "'"))))))
 
@@ -917,3 +926,94 @@
             (append! out (er-format-value (nth elems i))))
           (range 1 (len elems)))
         (reduce str "" out)))))
+
+;; ── send: Pid ! Msg ──────────────────────────────────────────────
+(define
+  er-eval-send
+  (fn
+    (node env)
+    (let
+      ((to-val (er-eval-expr (get node :to) env))
+        (msg-val (er-eval-expr (get node :msg) env)))
+      (if
+        (not (er-pid? to-val))
+        (error "Erlang: '!': target is not a pid")
+        (do
+          (when
+            (er-proc-exists? to-val)
+            (er-proc-mailbox-push! to-val msg-val)
+            (when
+              (= (er-proc-field to-val :state) "waiting")
+              (er-proc-set! to-val :state "runnable")
+              (er-sched-enqueue! to-val)))
+          msg-val)))))
+
+;; ── receive (selective, delimited-continuation suspension) ──────
+(define
+  er-eval-receive
+  (fn
+    (node env)
+    (let
+      ((pid (er-sched-current-pid)))
+      (er-eval-receive-loop node pid env))))
+
+(define
+  er-eval-receive-loop
+  (fn
+    (node pid env)
+    (let
+      ((r (er-try-receive (get node :clauses) pid env)))
+      (if
+        (get r :matched)
+        (get r :value)
+        (do
+          (shift
+            k
+            (do
+              (er-proc-set! pid :continuation k)
+              (er-proc-set! pid :state "waiting")
+              er-suspend-marker))
+          (er-eval-receive-loop node pid env))))))
+
+;; Scan mailbox in arrival order. For each msg, try every clause.
+;; On first match: remove that msg from mailbox and return body value.
+(define
+  er-try-receive
+  (fn
+    (clauses pid env)
+    (let
+      ((mbox (er-proc-field pid :mailbox)))
+      (er-try-receive-loop clauses mbox env 0))))
+
+(define
+  er-try-receive-loop
+  (fn
+    (clauses mbox env i)
+    (if
+      (>= i (er-q-len mbox))
+      {:matched false}
+      (let
+        ((msg (er-q-nth mbox i))
+          (cr (er-try-receive-clauses clauses msg env 0)))
+        (if
+          (get cr :matched)
+          (do (er-q-delete-at! mbox i) cr)
+          (er-try-receive-loop clauses mbox env (+ i 1)))))))
+
+(define
+  er-try-receive-clauses
+  (fn
+    (clauses msg env i)
+    (if
+      (>= i (len clauses))
+      {:matched false}
+      (let
+        ((c (nth clauses i)) (snap (er-env-copy env)))
+        (if
+          (and
+            (er-match! (get c :pattern) msg env)
+            (er-eval-guards (get c :guards) env))
+          {:value (er-eval-body (get c :body) env) :matched true}
+          (do
+            (er-env-restore! env snap)
+            (er-try-receive-clauses clauses msg env (+ i 1))))))))