erlang: scheduler + process record foundation (+39 tests)

lib/erlang/runtime.sx

@@ -0,0 +1,210 @@
+;; Erlang runtime — scheduler, process records, mailbox queue.
+;; Phase 3 foundation. spawn/send/receive build on these primitives.
+;;
+;; Scheduler is a single global dict in `er-scheduler` holding:
+;;   :next-pid    INT    — counter for fresh pid allocation
+;;   :processes   DICT   — pid-key (string) -> process record
+;;   :runnable    QUEUE  — FIFO of pids ready to run
+;;   :current     PID    — pid currently executing, or nil
+;;
+;; A pid value is tagged: {:tag "pid" :id INT}. Pids compare by id.
+;;
+;; Process record fields:
+;;   :pid             — this process's pid
+;;   :mailbox         — queue of received messages (arrival order)
+;;   :state           — "runnable" | "running" | "waiting" | "exiting" | "dead"
+;;   :continuation    — saved k (for receive suspension); nil otherwise
+;;   :receive-pats    — patterns the process is blocked on; nil otherwise
+;;   :trap-exit       — bool
+;;   :links           — list of pids
+;;   :monitors        — list of {:ref :pid}
+;;   :env             — Erlang env at the last yield
+;;   :exit-reason     — nil until the process exits
+;;
+;; Queue — amortised-O(1) FIFO with head-pointer + slab-compact:
+;;   {:items (list...) :head-idx INT}
+
+;; ── queue ────────────────────────────────────────────────────────
+(define er-q-new (fn () {:head-idx 0 :items (list)}))
+
+(define er-q-push! (fn (q x) (append! (get q :items) x)))
+
+(define
+  er-q-pop!
+  (fn
+    (q)
+    (let
+      ((h (get q :head-idx)) (items (get q :items)))
+      (if
+        (>= h (len items))
+        nil
+        (let
+          ((x (nth items h)))
+          (dict-set! q :head-idx (+ h 1))
+          (er-q-compact! q)
+          x)))))
+
+(define
+  er-q-peek
+  (fn
+    (q)
+    (let
+      ((h (get q :head-idx)) (items (get q :items)))
+      (if (>= h (len items)) nil (nth items h)))))
+
+(define
+  er-q-len
+  (fn (q) (- (len (get q :items)) (get q :head-idx))))
+
+(define er-q-empty? (fn (q) (= (er-q-len q) 0)))
+
+;; Compact the backing list when the head pointer gets large so the
+;; queue doesn't grow without bound. Threshold chosen to amortise the
+;; O(n) copy — pops are still amortised O(1).
+(define
+  er-q-compact!
+  (fn
+    (q)
+    (let
+      ((h (get q :head-idx)) (items (get q :items)))
+      (when
+        (> h 128)
+        (let
+          ((new (list)))
+          (for-each
+            (fn (i) (append! new (nth items i)))
+            (range h (len items)))
+          (dict-set! q :items new)
+          (dict-set! q :head-idx 0))))))
+
+(define
+  er-q-to-list
+  (fn
+    (q)
+    (let
+      ((h (get q :head-idx)) (items (get q :items)) (out (list)))
+      (for-each
+        (fn (i) (append! out (nth items i)))
+        (range h (len items)))
+      out)))
+
+;; ── pids ─────────────────────────────────────────────────────────
+(define er-mk-pid (fn (id) {:id id :tag "pid"}))
+(define er-pid? (fn (v) (er-is-tagged? v "pid")))
+(define er-pid-id (fn (pid) (get pid :id)))
+(define er-pid-key (fn (pid) (str "p" (er-pid-id pid))))
+(define
+  er-pid-equal?
+  (fn (a b) (and (er-pid? a) (er-pid? b) (= (er-pid-id a) (er-pid-id b)))))
+
+;; ── scheduler state ──────────────────────────────────────────────
+(define er-scheduler (list nil))
+
+(define
+  er-sched-init!
+  (fn
+    ()
+    (set-nth!
+      er-scheduler
+      0
+      {:next-pid 0
+        :current nil
+        :processes {}
+        :runnable (er-q-new)})))
+
+(define er-sched (fn () (nth er-scheduler 0)))
+
+(define
+  er-pid-new!
+  (fn
+    ()
+    (let
+      ((s (er-sched)))
+      (let
+        ((n (get s :next-pid)))
+        (dict-set! s :next-pid (+ n 1))
+        (er-mk-pid n)))))
+
+(define
+  er-sched-runnable
+  (fn () (get (er-sched) :runnable)))
+
+(define
+  er-sched-processes
+  (fn () (get (er-sched) :processes)))
+
+(define
+  er-sched-enqueue!
+  (fn (pid) (er-q-push! (er-sched-runnable) pid)))
+
+(define
+  er-sched-next-runnable!
+  (fn () (er-q-pop! (er-sched-runnable))))
+
+(define
+  er-sched-runnable-count
+  (fn () (er-q-len (er-sched-runnable))))
+
+(define
+  er-sched-set-current!
+  (fn (pid) (dict-set! (er-sched) :current pid)))
+
+(define er-sched-current-pid (fn () (get (er-sched) :current)))
+
+(define
+  er-sched-process-count
+  (fn () (len (keys (er-sched-processes)))))
+
+;; ── process records ──────────────────────────────────────────────
+(define
+  er-proc-new!
+  (fn
+    (env)
+    (let
+      ((pid (er-pid-new!)))
+      (let
+        ((proc
+          {:pid pid
+            :env env
+            :links (list)
+            :mailbox (er-q-new)
+            :state "runnable"
+            :monitors (list)
+            :continuation nil
+            :receive-pats nil
+            :trap-exit false
+            :exit-reason nil}))
+        (dict-set! (er-sched-processes) (er-pid-key pid) proc)
+        (er-sched-enqueue! pid)
+        proc))))
+
+(define
+  er-proc-get
+  (fn (pid) (get (er-sched-processes) (er-pid-key pid))))
+
+(define
+  er-proc-exists?
+  (fn (pid) (dict-has? (er-sched-processes) (er-pid-key pid))))
+
+(define
+  er-proc-field
+  (fn (pid field) (get (er-proc-get pid) field)))
+
+(define
+  er-proc-set!
+  (fn
+    (pid field val)
+    (let
+      ((p (er-proc-get pid)))
+      (if
+        (= p nil)
+        (error (str "Erlang: no such process " (er-pid-key pid)))
+        (dict-set! p field val)))))
+
+(define
+  er-proc-mailbox-push!
+  (fn (pid msg) (er-q-push! (er-proc-field pid :mailbox) msg)))
+
+(define
+  er-proc-mailbox-size
+  (fn (pid) (er-q-len (er-proc-field pid :mailbox))))

lib/erlang/tests/runtime.sx

@@ -0,0 +1,139 @@
+;; Erlang runtime tests — scheduler + process-record primitives.
+
+(define er-rt-test-count 0)
+(define er-rt-test-pass 0)
+(define er-rt-test-fails (list))
+
+(define
+  er-rt-test
+  (fn
+    (name actual expected)
+    (set! er-rt-test-count (+ er-rt-test-count 1))
+    (if
+      (= actual expected)
+      (set! er-rt-test-pass (+ er-rt-test-pass 1))
+      (append! er-rt-test-fails {:actual actual :expected expected :name name}))))
+
+;; ── queue ─────────────────────────────────────────────────────────
+(er-rt-test "queue empty len" (er-q-len (er-q-new)) 0)
+(er-rt-test "queue empty?" (er-q-empty? (er-q-new)) true)
+
+(define q1 (er-q-new))
+(er-q-push! q1 "a")
+(er-q-push! q1 "b")
+(er-q-push! q1 "c")
+(er-rt-test "queue push len" (er-q-len q1) 3)
+(er-rt-test "queue empty? after push" (er-q-empty? q1) false)
+(er-rt-test "queue peek" (er-q-peek q1) "a")
+(er-rt-test "queue pop 1" (er-q-pop! q1) "a")
+(er-rt-test "queue pop 2" (er-q-pop! q1) "b")
+(er-rt-test "queue len after pops" (er-q-len q1) 1)
+(er-rt-test "queue pop 3" (er-q-pop! q1) "c")
+(er-rt-test "queue empty again" (er-q-empty? q1) true)
+(er-rt-test "queue pop empty" (er-q-pop! q1) nil)
+
+;; Queue FIFO under interleaved push/pop
+(define q2 (er-q-new))
+(er-q-push! q2 1)
+(er-q-push! q2 2)
+(er-q-pop! q2)
+(er-q-push! q2 3)
+(er-rt-test "queue interleave peek" (er-q-peek q2) 2)
+(er-rt-test "queue to-list" (er-q-to-list q2) (list 2 3))
+
+;; ── scheduler init ─────────────────────────────────────────────
+(er-sched-init!)
+(er-rt-test "sched process count 0" (er-sched-process-count) 0)
+(er-rt-test "sched runnable count 0" (er-sched-runnable-count) 0)
+(er-rt-test "sched current nil" (er-sched-current-pid) nil)
+
+;; ── pid allocation ─────────────────────────────────────────────
+(define pa (er-pid-new!))
+(define pb (er-pid-new!))
+(er-rt-test "pid tag" (get pa :tag) "pid")
+(er-rt-test "pid ids distinct" (= (er-pid-id pa) (er-pid-id pb)) false)
+(er-rt-test "pid? true" (er-pid? pa) true)
+(er-rt-test "pid? false" (er-pid? 42) false)
+(er-rt-test
+  "pid-equal same"
+  (er-pid-equal? pa (er-mk-pid (er-pid-id pa)))
+  true)
+(er-rt-test "pid-equal diff" (er-pid-equal? pa pb) false)
+
+;; ── process lifecycle ──────────────────────────────────────────
+(er-sched-init!)
+(define p1 (er-proc-new! {}))
+(define p2 (er-proc-new! {}))
+(er-rt-test "proc count 2" (er-sched-process-count) 2)
+(er-rt-test "runnable count 2" (er-sched-runnable-count) 2)
+(er-rt-test
+  "proc state runnable"
+  (er-proc-field (get p1 :pid) :state)
+  "runnable")
+(er-rt-test
+  "proc mailbox empty"
+  (er-proc-mailbox-size (get p1 :pid))
+  0)
+(er-rt-test
+  "proc lookup"
+  (er-pid-equal? (get (er-proc-get (get p1 :pid)) :pid) (get p1 :pid))
+  true)
+(er-rt-test "proc exists" (er-proc-exists? (get p1 :pid)) true)
+(er-rt-test
+  "proc no-such-pid"
+  (er-proc-exists? (er-mk-pid 9999))
+  false)
+
+;; runnable queue dequeue order
+(er-rt-test
+  "dequeue first"
+  (er-pid-equal? (er-sched-next-runnable!) (get p1 :pid))
+  true)
+(er-rt-test
+  "dequeue second"
+  (er-pid-equal? (er-sched-next-runnable!) (get p2 :pid))
+  true)
+(er-rt-test "dequeue empty" (er-sched-next-runnable!) nil)
+
+;; current-pid get/set
+(er-sched-set-current! (get p1 :pid))
+(er-rt-test
+  "current pid set"
+  (er-pid-equal? (er-sched-current-pid) (get p1 :pid))
+  true)
+
+;; ── mailbox push ──────────────────────────────────────────────
+(er-proc-mailbox-push! (get p1 :pid) {:tag "atom" :name "ping"})
+(er-proc-mailbox-push! (get p1 :pid) 42)
+(er-rt-test "mailbox size 2" (er-proc-mailbox-size (get p1 :pid)) 2)
+
+;; ── field update ──────────────────────────────────────────────
+(er-proc-set! (get p1 :pid) :state "waiting")
+(er-rt-test
+  "proc state waiting"
+  (er-proc-field (get p1 :pid) :state)
+  "waiting")
+(er-proc-set! (get p1 :pid) :trap-exit true)
+(er-rt-test
+  "proc trap-exit"
+  (er-proc-field (get p1 :pid) :trap-exit)
+  true)
+
+;; ── fresh scheduler ends in clean state ───────────────────────
+(er-sched-init!)
+(er-rt-test
+  "sched init resets count"
+  (er-sched-process-count)
+  0)
+(er-rt-test
+  "sched init resets queue"
+  (er-sched-runnable-count)
+  0)
+(er-rt-test
+  "sched init resets current"
+  (er-sched-current-pid)
+  nil)
+
+(define
+  er-rt-test-summary
+  (str "runtime " er-rt-test-pass "/" er-rt-test-count))