rose-ash/lib/erlang/runtime.sx

;; 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)))

;; Read the i'th entry (relative to head) without popping.
(define
  er-q-nth
  (fn (q i) (nth (get q :items) (+ (get q :head-idx) i))))

;; Remove entry at logical index i, shift tail in.
(define
  er-q-delete-at!
  (fn
    (q i)
    (let
      ((h (get q :head-idx)) (items (get q :items)) (new (list)))
      (for-each
        (fn
          (j)
          (when (not (= j (+ h i))) (append! new (nth items j))))
        (range h (len items)))
      (dict-set! q :items new)
      (dict-set! q :head-idx 0))))

;; ── 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)))))

;; ── refs ─────────────────────────────────────────────────────────
(define er-mk-ref (fn (id) {:id id :tag "ref"}))
(define er-ref? (fn (v) (er-is-tagged? v "ref")))
(define
  er-ref-equal?
  (fn (a b) (and (er-ref? a) (er-ref? b) (= (get a :id) (get b :id)))))

(define
  er-ref-new!
  (fn
    ()
    (let
      ((s (er-sched)))
      (let
        ((n (get s :next-ref)))
        (dict-set! s :next-ref (+ n 1))
        (er-mk-ref n)))))

;; ── scheduler state ──────────────────────────────────────────────
(define er-scheduler (list nil))

(define
  er-sched-init!
  (fn
    ()
    (set-nth!
      er-scheduler
      0
      {:next-pid 0
        :next-ref 0
        :current nil
        :processes {}
        :registered {}
        :ets {}
        :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)
            :monitored-by (list)
            :continuation nil
            :receive-pats nil
            :trap-exit false
            :has-timeout false
            :timed-out 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))))

;; Main process is always pid 0 (scheduler starts with next-pid 0 and
;; erlang-eval-ast calls er-proc-new! first). Returns nil if no eval
;; has run.
(define
  er-main-pid
  (fn () (er-mk-pid 0)))

(define
  er-last-main-exit-reason
  (fn
    ()
    (if
      (er-proc-exists? (er-main-pid))
      (er-proc-field (er-main-pid) :exit-reason)
      nil)))

;; ── process BIFs ────────────────────────────────────────────────
(define
  er-bif-is-pid
  (fn (vs) (er-bool (er-pid? (er-bif-arg1 vs "is_pid")))))

(define
  er-bif-self
  (fn
    (vs)
    (if
      (not (= (len vs) 0))
      (error "Erlang: self/0: arity")
      (let
        ((pid (er-sched-current-pid)))
        (if
          (= pid nil)
          (error "Erlang: self/0: no current process")
          pid)))))

(define
  er-bif-spawn
  (fn
    (vs)
    (cond
      (= (len vs) 1) (er-spawn-fun (nth vs 0))
      (= (len vs) 3) (error
        "Erlang: spawn/3: module-based spawn deferred to Phase 5 (modules)")
      :else (error "Erlang: spawn: wrong arity"))))

(define
  er-spawn-fun
  (fn
    (fv)
    (if
      (not (er-fun? fv))
      (error "Erlang: spawn/1: not a fun")
      (let
        ((proc (er-proc-new! (er-env-new))))
        (dict-set! proc :initial-fun fv)
        (get proc :pid)))))

(define
  er-bif-exit
  (fn
    (vs)
    (cond
      (= (len vs) 1) (raise (er-mk-exit-marker (nth vs 0)))
      (= (len vs) 2)
      (error
        "Erlang: exit/2 (signal another process) deferred to next Phase 4 step (signal propagation)")
      :else (error "Erlang: exit: wrong arity"))))

;; ── links / monitors / refs ─────────────────────────────────────
(define
  er-bif-is-reference
  (fn (vs) (er-bool (er-ref? (er-bif-arg1 vs "is_reference")))))

;; ── name registry ─────────────────────────────────────────────
(define er-registered (fn () (get (er-sched) :registered)))

(define
  er-bif-register
  (fn
    (vs)
    (if
      (not (= (len vs) 2))
      (error "Erlang: register/2: arity")
      (let
        ((name (nth vs 0)) (pid (nth vs 1)))
        (cond
          (not (er-atom? name))
          (raise (er-mk-error-marker (er-mk-atom "badarg")))
          (not (er-pid? pid))
          (raise (er-mk-error-marker (er-mk-atom "badarg")))
          (not (er-proc-exists? pid))
          (raise (er-mk-error-marker (er-mk-atom "badarg")))
          (dict-has? (er-registered) (get name :name))
          (raise (er-mk-error-marker (er-mk-atom "badarg")))
          :else (do
            (dict-set! (er-registered) (get name :name) pid)
            (er-mk-atom "true")))))))

(define
  er-bif-unregister
  (fn
    (vs)
    (let
      ((name (er-bif-arg1 vs "unregister")))
      (cond
        (not (er-atom? name))
        (raise (er-mk-error-marker (er-mk-atom "badarg")))
        (not (dict-has? (er-registered) (get name :name)))
        (raise (er-mk-error-marker (er-mk-atom "badarg")))
        :else (do
          (dict-delete! (er-registered) (get name :name))
          (er-mk-atom "true"))))))

(define
  er-bif-whereis
  (fn
    (vs)
    (let
      ((name (er-bif-arg1 vs "whereis")))
      (cond
        (not (er-atom? name))
        (raise (er-mk-error-marker (er-mk-atom "badarg")))
        (dict-has? (er-registered) (get name :name))
        (get (er-registered) (get name :name))
        :else (er-mk-atom "undefined")))))

(define
  er-bif-registered
  (fn
    (vs)
    (if
      (not (= (len vs) 0))
      (error "Erlang: registered/0: arity")
      (let
        ((ks (keys (er-registered))) (out (er-mk-nil)))
        (for-each
          (fn
            (i)
            (let
              ((k (nth ks (- (- (len ks) 1) i))))
              (set! out (er-mk-cons (er-mk-atom k) out))))
          (range 0 (len ks)))
        out))))

;; Find the registered name for a pid, if any. Returns string or nil.
(define
  er-find-registration
  (fn
    (pid)
    (let
      ((reg (er-registered)) (ks (keys reg)) (found (list nil)))
      (for-each
        (fn
          (i)
          (when
            (= (nth found 0) nil)
            (let
              ((k (nth ks i)))
              (when (er-pid-equal? (get reg k) pid) (set-nth! found 0 k)))))
        (range 0 (len ks)))
      (nth found 0))))

;; Drop pid from the registry (called on process death).
(define
  er-unregister-pid!
  (fn
    (pid)
    (let
      ((name (er-find-registration pid)))
      (when (not (= name nil)) (dict-delete! (er-registered) name)))))

(define
  er-bif-process-flag
  (fn
    (vs)
    (if
      (not (= (len vs) 2))
      (error "Erlang: process_flag/2: arity")
      (let
        ((flag (nth vs 0))
          (val (nth vs 1))
          (me (er-sched-current-pid)))
        (cond
          (and (er-atom? flag) (= (get flag :name) "trap_exit"))
          (let
            ((old (er-proc-field me :trap-exit)))
            (er-proc-set! me :trap-exit (er-truthy? val))
            (er-bool old))
          :else (error
            (str
              "Erlang: process_flag: unsupported flag '"
              (er-format-value flag)
              "'")))))))

(define
  er-bif-make-ref
  (fn
    (vs)
    (if
      (not (= (len vs) 0))
      (error "Erlang: make_ref/0: arity")
      (er-ref-new!))))

;; Add `target` to `pid`'s :links list if not already there.
(define
  er-link-add-one!
  (fn
    (pid target)
    (let
      ((links (er-proc-field pid :links)))
      (when
        (not (er-link-has? links target))
        (append! links target)))))

(define
  er-link-has?
  (fn
    (links target)
    (cond
      (= (len links) 0) false
      (er-pid-equal? (nth links 0) target) true
      :else (er-link-has? (er-slice-list links 1) target))))

(define
  er-link-remove-one!
  (fn
    (pid target)
    (let
      ((old (er-proc-field pid :links)) (out (list)))
      (for-each
        (fn
          (i)
          (let
            ((p (nth old i)))
            (when (not (er-pid-equal? p target)) (append! out p))))
        (range 0 (len old)))
      (er-proc-set! pid :links out))))

(define
  er-bif-link
  (fn
    (vs)
    (let
      ((target (er-bif-arg1 vs "link")) (me (er-sched-current-pid)))
      (cond
        (not (er-pid? target)) (error "Erlang: link: not a pid")
        (er-pid-equal? target me) (er-mk-atom "true")
        (not (er-proc-exists? target))
        (raise (er-mk-exit-marker (er-mk-atom "noproc")))
        :else (do
          (er-link-add-one! me target)
          (er-link-add-one! target me)
          (er-mk-atom "true"))))))

(define
  er-bif-unlink
  (fn
    (vs)
    (let
      ((target (er-bif-arg1 vs "unlink")) (me (er-sched-current-pid)))
      (cond
        (not (er-pid? target)) (error "Erlang: unlink: not a pid")
        :else (do
          (er-link-remove-one! me target)
          (when
            (er-proc-exists? target)
            (er-link-remove-one! target me))
          (er-mk-atom "true"))))))

(define
  er-bif-monitor
  (fn
    (vs)
    (if
      (not (= (len vs) 2))
      (error "Erlang: monitor/2: arity")
      (let
        ((kind (nth vs 0))
          (target (nth vs 1))
          (me (er-sched-current-pid)))
        (cond
          (not (and (er-atom? kind) (= (get kind :name) "process")))
          (error "Erlang: monitor: only 'process' supported")
          (not (er-pid? target)) (error "Erlang: monitor: not a pid")
          :else (let
            ((ref (er-ref-new!)))
            (append!
              (er-proc-field me :monitors)
              {:ref ref :pid target})
            (when
              (er-proc-exists? target)
              (append!
                (er-proc-field target :monitored-by)
                {:from me :ref ref}))
            ref))))))

(define
  er-bif-demonitor
  (fn
    (vs)
    (let
      ((ref (er-bif-arg1 vs "demonitor")) (me (er-sched-current-pid)))
      (if
        (not (er-ref? ref))
        (error "Erlang: demonitor: not a reference")
        (do
          (er-demonitor-purge! me ref)
          (er-mk-atom "true"))))))

(define
  er-demonitor-purge!
  (fn
    (me ref)
    (let
      ((old (er-proc-field me :monitors)) (out (list)) (target-ref (list nil)))
      (for-each
        (fn
          (i)
          (let
            ((m (nth old i)))
            (if
              (er-ref-equal? (get m :ref) ref)
              (set-nth! target-ref 0 (get m :pid))
              (append! out m))))
        (range 0 (len old)))
      (er-proc-set! me :monitors out)
      (when
        (and
          (not (= (nth target-ref 0) nil))
          (er-proc-exists? (nth target-ref 0)))
        (let
          ((target (nth target-ref 0))
            (oldby (er-proc-field (nth target-ref 0) :monitored-by))
            (out2 (list)))
          (for-each
            (fn
              (i)
              (let
                ((m (nth oldby i)))
                (when
                  (not (er-ref-equal? (get m :ref) ref))
                  (append! out2 m))))
            (range 0 (len oldby)))
          (er-proc-set! target :monitored-by out2))))))

;; ── scheduler loop ──────────────────────────────────────────────
;; Each scheduler step wraps the process body in `guard`. `receive`
;; with no match captures a `call/cc` continuation onto the proc
;; record and then `raise`s `er-suspend-marker`; the guard catches
;; the raise and the scheduler moves on. `exit/1` raises an exit
;; marker the same way. Resumption from a saved continuation also
;; runs under a fresh `guard` so a resumed receive that needs to
;; suspend again has a handler to unwind to. `shift`/`reset` aren't
;; usable here because SX's captured delimited continuations don't
;; re-establish their own reset boundary when invoked — a second
;; suspension during replay raises "shift without enclosing reset".
(define er-suspend-marker {:tag "er-suspend-marker"})

(define
  er-suspended?
  (fn
    (v)
    (and
      (= (type-of v) "dict")
      (= (get v :tag) "er-suspend-marker"))))

(define
  er-exited?
  (fn
    (v)
    (and
      (= (type-of v) "dict")
      (= (get v :tag) "er-exit-marker"))))

(define
  er-mk-exit-marker
  (fn (reason) {:tag "er-exit-marker" :reason reason}))

(define
  er-mk-throw-marker
  (fn (reason) {:tag "er-throw-marker" :reason reason}))

(define
  er-mk-error-marker
  (fn (reason) {:tag "er-error-marker" :reason reason}))

(define
  er-thrown?
  (fn
    (v)
    (and
      (= (type-of v) "dict")
      (= (get v :tag) "er-throw-marker"))))

(define
  er-errored?
  (fn
    (v)
    (and
      (= (type-of v) "dict")
      (= (get v :tag) "er-error-marker"))))

(define
  er-sched-run-all!
  (fn
    ()
    (let
      ((pid (er-sched-next-runnable!)))
      (cond
        (not (= pid nil))
        (do (er-sched-step! pid) (er-sched-run-all!))
        ;; Queue empty — fire one pending receive-with-timeout and go again.
        (er-sched-fire-one-timeout!) (er-sched-run-all!)
        :else nil))))

;; Wake one waiting process whose receive had an `after Ms` clause.
;; Returns true if one fired. In our synchronous model "time passes"
;; once the runnable queue drains — timeouts only fire then.
(define
  er-sched-fire-one-timeout!
  (fn
    ()
    (let
      ((ks (keys (er-sched-processes))) (fired (list false)))
      (for-each
        (fn
          (k)
          (when
            (not (nth fired 0))
            (let
              ((p (get (er-sched-processes) k)))
              (when
                (and
                  (= (get p :state) "waiting")
                  (get p :has-timeout))
                (dict-set! p :timed-out true)
                (dict-set! p :has-timeout false)
                (dict-set! p :state "runnable")
                (er-sched-enqueue! (get p :pid))
                (set-nth! fired 0 true)))))
        ks)
      (nth fired 0))))

(define
  er-sched-step!
  (fn
    (pid)
    (cond
      (= (er-proc-field pid :state) "dead") nil
      :else (er-sched-step-alive! pid))))

(define
  er-sched-step-alive!
  (fn
    (pid)
    (er-sched-set-current! pid)
    (er-proc-set! pid :state "running")
    (let
      ((prev-k (er-proc-field pid :continuation))
        (result-ref (list nil)))
      (guard
        (c
          ((er-suspended? c) (set-nth! result-ref 0 c))
          ((er-exited? c) (set-nth! result-ref 0 c))
          ((er-thrown? c)
            (set-nth!
              result-ref
              0
              (er-mk-exit-marker
                (er-mk-tuple
                  (list (er-mk-atom "nocatch") (get c :reason))))))
          ((er-errored? c)
            (set-nth! result-ref 0 (er-mk-exit-marker (get c :reason)))))
        (set-nth!
          result-ref
          0
          (if
            (= prev-k nil)
            (er-apply-fun (er-proc-field pid :initial-fun) (list))
            (do (er-proc-set! pid :continuation nil) (prev-k nil)))))
      (let
        ((r (nth result-ref 0)))
        (cond
          (er-suspended? r) nil
          (er-exited? r)
          (do
            (er-proc-set! pid :state "dead")
            (er-proc-set! pid :exit-reason (get r :reason))
            (er-proc-set! pid :exit-result nil)
            (er-proc-set! pid :continuation nil)
            (er-unregister-pid! pid)
            (er-propagate-exit! pid (get r :reason)))
          :else (do
            (er-proc-set! pid :state "dead")
            (er-proc-set! pid :exit-reason (er-mk-atom "normal"))
            (er-proc-set! pid :exit-result r)
            (er-proc-set! pid :continuation nil)
            (er-unregister-pid! pid)
            (er-propagate-exit! pid (er-mk-atom "normal"))))))
    (er-sched-set-current! nil)))

;; ── exit-signal propagation ─────────────────────────────────────
;; Called when `pid` finishes (normally or via exit). Walks the
;; process's `:monitored-by` and `:links` lists to deliver `{'DOWN'}`
;; messages and exit signals respectively. Linked processes without
;; `trap_exit` cascade-die with the same reason; those with
;; `trap_exit` true receive an `{'EXIT', From, Reason}` message.
(define
  er-propagate-exit!
  (fn
    (pid reason)
    (er-fire-monitors! pid reason)
    (er-fire-links! pid reason)))

(define
  er-fire-monitors!
  (fn
    (pid reason)
    (let
      ((mons (er-proc-field pid :monitored-by)))
      (for-each
        (fn
          (i)
          (let
            ((m (nth mons i)))
            (let
              ((from (get m :from)) (ref (get m :ref)))
              (when
                (and (er-proc-exists? from)
                  (not (= (er-proc-field from :state) "dead")))
                (let
                  ((msg
                    (er-mk-tuple
                      (list
                        (er-mk-atom "DOWN")
                        ref
                        (er-mk-atom "process")
                        pid
                        reason))))
                  (er-proc-mailbox-push! from msg)
                  (when
                    (= (er-proc-field from :state) "waiting")
                    (er-proc-set! from :state "runnable")
                    (er-sched-enqueue! from)))))))
        (range 0 (len mons))))))

(define
  er-fire-links!
  (fn
    (pid reason)
    (let
      ((links (er-proc-field pid :links))
        (is-normal (er-is-atom-named? reason "normal")))
      (for-each
        (fn
          (i)
          (let
            ((target (nth links i)))
            (when
              (and (er-proc-exists? target)
                (not (= (er-proc-field target :state) "dead")))
              (let
                ((trap (er-proc-field target :trap-exit)))
                (cond
                  trap (er-deliver-exit-msg! target pid reason)
                  is-normal nil
                  :else (er-cascade-exit! target reason))))))
        (range 0 (len links))))))

(define
  er-deliver-exit-msg!
  (fn
    (target from reason)
    (let
      ((msg
        (er-mk-tuple (list (er-mk-atom "EXIT") from reason))))
      (er-proc-mailbox-push! target msg)
      (when
        (= (er-proc-field target :state) "waiting")
        (er-proc-set! target :state "runnable")
        (er-sched-enqueue! target)))))

(define
  er-cascade-exit!
  (fn
    (target reason)
    (er-proc-set! target :state "dead")
    (er-proc-set! target :exit-reason reason)
    (er-proc-set! target :exit-result nil)
    (er-proc-set! target :continuation nil)
    (er-propagate-exit! target reason)))

;; ── module registry ─────────────────────────────────────────────
;; Global mutable dict from module name -> module env (which itself
;; binds each function name to a fun value capturing the same env, so
;; sibling functions can call each other recursively).
(define er-modules (list {}))
(define er-modules-get (fn () (nth er-modules 0)))
(define er-modules-reset! (fn () (set-nth! er-modules 0 {})))

;; Load an Erlang module declaration. Source must start with
;; `-module(Name).` and contain function definitions. Functions
;; sharing a name (different arities) get their clauses concatenated
;; into a single fun value — `er-apply-fun-clauses` already filters
;; by arity, so multi-arity dispatch falls out for free.
(define
  erlang-load-module
  (fn
    (src)
    (let
      ((module-ast (er-parse-module src)))
      (let
        ((mod-name (get module-ast :name))
          (functions (get module-ast :functions))
          (mod-env (er-env-new))
          (by-name {}))
        (for-each
          (fn
            (i)
            (let
              ((f (nth functions i)))
              (let
                ((name (get f :name)) (clauses (get f :clauses)))
                (if
                  (dict-has? by-name name)
                  (let
                    ((existing (get by-name name)))
                    (for-each
                      (fn (j) (append! existing (nth clauses j)))
                      (range 0 (len clauses))))
                  (let
                    ((init (list)))
                    (for-each
                      (fn (j) (append! init (nth clauses j)))
                      (range 0 (len clauses)))
                    (dict-set! by-name name init))))))
          (range 0 (len functions)))
        (for-each
          (fn
            (k)
            (let
              ((all-clauses (get by-name k)))
              (er-env-bind! mod-env k (er-mk-fun all-clauses mod-env))))
          (keys by-name))
        (dict-set! (er-modules-get) mod-name mod-env)
        (er-mk-atom mod-name)))))

(define
  er-apply-user-module
  (fn
    (mod name vs)
    (let
      ((mod-env (get (er-modules-get) mod)))
      (if
        (not (dict-has? mod-env name))
        (raise
          (er-mk-error-marker
            (er-mk-tuple
              (list
                (er-mk-atom "undef")
                (er-mk-atom mod)
                (er-mk-atom name)))))
        (er-apply-fun (get mod-env name) vs)))))

;; ── gen_server (OTP-lite) ───────────────────────────────────────
;; A minimal gen_server behaviour — `start_link/2`, `call/2`, `cast/2`,
;; `stop/1`, plus the receive loop dispatching `Mod:handle_call/3`,
;; `Mod:handle_cast/2`, `Mod:handle_info/2`. Loaded into the user
;; module registry on demand via `(er-load-gen-server!)`.
(define
  er-gen-server-source
  "-module(gen_server).
   start_link(Mod, Args) ->
     spawn(fun () ->
       case Mod:init(Args) of
         {ok, State} -> gen_server:loop(Mod, State);
         {stop, Reason} -> exit(Reason)
       end
     end).
   call(Pid, Req) ->
     Ref = make_ref(),
     Pid ! {'$gen_call', {self(), Ref}, Req},
     receive {Ref, Reply} -> Reply end.
   cast(Pid, Msg) ->
     Pid ! {'$gen_cast', Msg},
     ok.
   stop(Pid) ->
     gen_server:call(Pid, '$gen_stop').
   loop(Mod, State) ->
     receive
       {'$gen_call', {From, Ref}, '$gen_stop'} ->
         From ! {Ref, ok};
       {'$gen_call', {From, Ref}, Req} ->
         case Mod:handle_call(Req, From, State) of
           {reply, Reply, NewState} ->
             From ! {Ref, Reply},
             gen_server:loop(Mod, NewState);
           {noreply, NewState} ->
             gen_server:loop(Mod, NewState);
           {stop, Reason, Reply, NewState} ->
             From ! {Ref, Reply},
             exit(Reason)
         end;
       {'$gen_cast', Msg} ->
         case Mod:handle_cast(Msg, State) of
           {noreply, NewState} -> gen_server:loop(Mod, NewState);
           {stop, Reason, NewState} -> exit(Reason)
         end;
       Other ->
         case Mod:handle_info(Other, State) of
           {noreply, NewState} -> gen_server:loop(Mod, NewState);
           {stop, Reason, NewState} -> exit(Reason)
         end
     end.")

(define
  er-load-gen-server!
  (fn () (erlang-load-module er-gen-server-source)))

;; ── supervisor (OTP-lite, one-for-one) ──────────────────────────
;; Each child spec is `{Id, StartFn}` — `StartFn/0` returns the
;; child's pid. The supervisor `process_flag(trap_exit, true)`,
;; links to every child, and on `{'EXIT', DeadPid, _}` calls the
;; matching `StartFn` to bring up a fresh replacement. Strategy is
;; one-for-one: only the dead child restarts; siblings keep running.
(define
  er-supervisor-source
  "-module(supervisor).
   start_link(Mod, Args) ->
     spawn(fun () ->
       process_flag(trap_exit, true),
       case Mod:init(Args) of
         {ok, ChildSpecs} ->
           Children = lists:map(
             fun (Spec) -> supervisor:start_child(Spec) end,
             ChildSpecs),
           supervisor:loop(Children)
       end
     end).
   start_child({Id, StartFn}) ->
     P = StartFn(),
     link(P),
     {Id, StartFn, P}.
   which_children(Sup) ->
     Sup ! {'$sup_which', self()},
     receive {'$sup_children', Cs} -> Cs end.
   stop(Sup) ->
     Sup ! '$sup_stop',
     ok.
   loop(Children) ->
     receive
       {'EXIT', Dead, _Reason} ->
         supervisor:loop(supervisor:restart(Children, Dead));
       {'$sup_which', From} ->
         From ! {'$sup_children', Children},
         supervisor:loop(Children);
       '$sup_stop' ->
         ok
     end.
   restart([], _) -> [];
   restart([{Id, SF, P} | T], Dead) ->
     case P =:= Dead of
       true ->
         NewP = SF(),
         link(NewP),
         [{Id, SF, NewP} | T];
       false ->
         [{Id, SF, P} | supervisor:restart(T, Dead)]
     end.")

(define
  er-load-supervisor!
  (fn () (erlang-load-module er-supervisor-source)))

;; ── ETS-lite ────────────────────────────────────────────────────
;; Each table is a mutable list of tuples; key is the tuple's first
;; element (keypos=1, the default). Tables live on the scheduler
;; under `:ets` keyed by the registering atom name. Set semantics:
;; `insert/2` replaces an existing entry with the same key.
(define er-ets-tables (fn () (get (er-sched) :ets)))

(define
  er-bif-ets-new
  (fn
    (vs)
    (cond
      (not (= (len vs) 2)) (error "Erlang: ets:new/2: arity")
      :else (let
        ((name (nth vs 0)))
        (cond
          (not (er-atom? name))
          (raise (er-mk-error-marker (er-mk-atom "badarg")))
          (dict-has? (er-ets-tables) (get name :name))
          (raise
            (er-mk-error-marker
              (er-mk-tuple (list (er-mk-atom "badarg") name))))
          :else (do
            (dict-set! (er-ets-tables) (get name :name) (list))
            name))))))

(define
  er-ets-resolve
  (fn
    (id)
    (cond
      (not (er-atom? id))
      (raise (er-mk-error-marker (er-mk-atom "badarg")))
      (not (dict-has? (er-ets-tables) (get id :name)))
      (raise (er-mk-error-marker (er-mk-atom "badarg")))
      :else (get (er-ets-tables) (get id :name)))))

(define
  er-bif-ets-insert
  (fn
    (vs)
    (cond
      (not (= (len vs) 2)) (error "Erlang: ets:insert/2: arity")
      :else (let
        ((tab (er-ets-resolve (nth vs 0)))
          (entry (nth vs 1)))
        (cond
          (not (er-tuple? entry))
          (raise (er-mk-error-marker (er-mk-atom "badarg")))
          (= (len (get entry :elements)) 0)
          (raise (er-mk-error-marker (er-mk-atom "badarg")))
          :else (do
            (er-ets-replace-or-append! tab entry)
            (er-mk-atom "true")))))))

(define
  er-ets-replace-or-append!
  (fn
    (tab entry)
    (let
      ((key (nth (get entry :elements) 0))
        (replaced (list false)))
      (for-each
        (fn
          (i)
          (when
            (er-equal? (nth (get (nth tab i) :elements) 0) key)
            (set-nth! tab i entry)
            (set-nth! replaced 0 true)))
        (range 0 (len tab)))
      (when (not (nth replaced 0)) (append! tab entry)))))

(define
  er-bif-ets-lookup
  (fn
    (vs)
    (cond
      (not (= (len vs) 2)) (error "Erlang: ets:lookup/2: arity")
      :else (let
        ((tab (er-ets-resolve (nth vs 0)))
          (key (nth vs 1))
          (out (er-mk-nil)))
        (for-each
          (fn
            (i)
            (let
              ((j (- (- (len tab) 1) i))
                (entry (nth tab (- (- (len tab) 1) i))))
              (when
                (er-equal? (nth (get entry :elements) 0) key)
                (set! out (er-mk-cons entry out)))))
          (range 0 (len tab)))
        out))))

(define
  er-bif-ets-delete
  (fn
    (vs)
    (cond
      (= (len vs) 1) (er-ets-delete-table! (nth vs 0))
      (= (len vs) 2) (er-ets-delete-key! (nth vs 0) (nth vs 1))
      :else (error "Erlang: ets:delete: arity"))))

(define
  er-ets-delete-table!
  (fn
    (id)
    (cond
      (not (er-atom? id))
      (raise (er-mk-error-marker (er-mk-atom "badarg")))
      (not (dict-has? (er-ets-tables) (get id :name)))
      (raise (er-mk-error-marker (er-mk-atom "badarg")))
      :else (do
        (dict-delete! (er-ets-tables) (get id :name))
        (er-mk-atom "true")))))

(define
  er-ets-delete-key!
  (fn
    (id key)
    (let
      ((tab (er-ets-resolve id)) (out (list)))
      (for-each
        (fn
          (i)
          (let
            ((entry (nth tab i)))
            (when
              (not (er-equal? (nth (get entry :elements) 0) key))
              (append! out entry))))
        (range 0 (len tab)))
      (dict-set! (er-ets-tables) (get id :name) out)
      (er-mk-atom "true"))))

(define
  er-bif-ets-tab2list
  (fn
    (vs)
    (let
      ((tab (er-ets-resolve (er-bif-arg1 vs "ets:tab2list"))) (out (er-mk-nil)))
      (for-each
        (fn
          (i)
          (let
            ((j (- (- (len tab) 1) i)))
            (set! out (er-mk-cons (nth tab j) out))))
        (range 0 (len tab)))
      out)))

(define
  er-bif-ets-info
  (fn
    (vs)
    (cond
      (= (len vs) 2)
      (let
        ((tab (er-ets-resolve (nth vs 0))) (key (nth vs 1)))
        (cond
          (and (er-atom? key) (= (get key :name) "size")) (len tab)
          :else (er-mk-atom "undefined")))
      :else (error "Erlang: ets:info: arity"))))

(define
  er-apply-ets-bif
  (fn
    (name vs)
    (cond
      (= name "new") (er-bif-ets-new vs)
      (= name "insert") (er-bif-ets-insert vs)
      (= name "lookup") (er-bif-ets-lookup vs)
      (= name "delete") (er-bif-ets-delete vs)
      (= name "tab2list") (er-bif-ets-tab2list vs)
      (= name "info") (er-bif-ets-info vs)
      :else (error
        (str "Erlang: undefined 'ets:" name "/" (len vs) "'")))))