Compare commits
2 Commits
loops/erla
...
loops/hs
| Author | SHA1 | Date | |
|---|---|---|---|
| 7735eb7512 | |||
| 4e2e2c781c |
@@ -1,86 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
# Erlang-on-SX ring benchmark.
|
||||
#
|
||||
# Spawns N processes in a ring, passes a token N hops (one full round),
|
||||
# and reports wall-clock time + throughput. Aspirational target from
|
||||
# the plan is 1M processes; current sync-scheduler architecture caps out
|
||||
# orders of magnitude lower — this script measures honestly across a
|
||||
# range of N so the result/scaling is recorded.
|
||||
#
|
||||
# Usage:
|
||||
# bash lib/erlang/bench_ring.sh # default ladder
|
||||
# bash lib/erlang/bench_ring.sh 100 1000 5000 # custom Ns
|
||||
|
||||
set -uo pipefail
|
||||
cd "$(git rev-parse --show-toplevel)"
|
||||
|
||||
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||
fi
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
echo "ERROR: sx_server.exe not found." >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ "$#" -gt 0 ]; then
|
||||
NS=("$@")
|
||||
else
|
||||
NS=(10 100 500 1000)
|
||||
fi
|
||||
|
||||
TMPFILE=$(mktemp)
|
||||
trap "rm -f $TMPFILE" EXIT
|
||||
|
||||
# One-line Erlang program. Replaces __N__ with the size for each run.
|
||||
PROGRAM='Me = self(), N = __N__, Spawner = fun () -> receive {setup, Next} -> Loop = fun () -> receive {token, 0, Parent} -> Parent ! done; {token, K, Parent} -> Next ! {token, K-1, Parent}, Loop() end end, Loop() end end, BuildRing = fun (K, Acc) -> if K =:= 0 -> Acc; true -> BuildRing(K-1, [spawn(Spawner) | Acc]) end end, Pids = BuildRing(N, []), Wire = fun (Ps) -> case Ps of [P, Q | _] -> P ! {setup, Q}, Wire(tl(Ps)); [Last] -> Last ! {setup, hd(Pids)} end end, Wire(Pids), hd(Pids) ! {token, N, Me}, receive done -> done end'
|
||||
|
||||
run_n() {
|
||||
local n="$1"
|
||||
local prog="${PROGRAM//__N__/$n}"
|
||||
cat > "$TMPFILE" <<EPOCHS
|
||||
(epoch 1)
|
||||
(load "lib/erlang/tokenizer.sx")
|
||||
(load "lib/erlang/parser.sx")
|
||||
(load "lib/erlang/parser-core.sx")
|
||||
(load "lib/erlang/parser-expr.sx")
|
||||
(load "lib/erlang/parser-module.sx")
|
||||
(load "lib/erlang/transpile.sx")
|
||||
(load "lib/erlang/runtime.sx")
|
||||
(epoch 2)
|
||||
(eval "(erlang-eval-ast \"${prog//\"/\\\"}\")")
|
||||
EPOCHS
|
||||
|
||||
local start_s start_ns end_s end_ns elapsed_ms
|
||||
start_s=$(date +%s)
|
||||
start_ns=$(date +%N)
|
||||
out=$(timeout 300 "$SX_SERVER" < "$TMPFILE" 2>&1)
|
||||
end_s=$(date +%s)
|
||||
end_ns=$(date +%N)
|
||||
|
||||
local ok="false"
|
||||
if echo "$out" | grep -q ':name "done"'; then ok="true"; fi
|
||||
|
||||
# ms = (end_s - start_s)*1000 + (end_ns - start_ns)/1e6
|
||||
elapsed_ms=$(awk -v s1="$start_s" -v n1="$start_ns" -v s2="$end_s" -v n2="$end_ns" \
|
||||
'BEGIN { printf "%d", (s2 - s1) * 1000 + (n2 - n1) / 1000000 }')
|
||||
|
||||
if [ "$ok" = "true" ]; then
|
||||
local hops_per_s
|
||||
hops_per_s=$(awk -v n="$n" -v ms="$elapsed_ms" \
|
||||
'BEGIN { if (ms == 0) ms = 1; printf "%.0f", n * 1000 / ms }')
|
||||
printf " N=%-8s hops=%-8s %sms (%s hops/s)\n" "$n" "$n" "$elapsed_ms" "$hops_per_s"
|
||||
else
|
||||
printf " N=%-8s FAILED %sms\n" "$n" "$elapsed_ms"
|
||||
fi
|
||||
}
|
||||
|
||||
echo "Ring benchmark — sx_server.exe (synchronous scheduler)"
|
||||
echo
|
||||
for n in "${NS[@]}"; do
|
||||
run_n "$n"
|
||||
done
|
||||
echo
|
||||
echo "Note: 1M-process target from the plan is aspirational; the synchronous"
|
||||
echo "scheduler with shift-based suspension and dict-based env copies is not"
|
||||
echo "engineered for that scale. Numbers above are honest baselines."
|
||||
@@ -1,35 +0,0 @@
|
||||
# Ring Benchmark Results
|
||||
|
||||
Generated by `lib/erlang/bench_ring.sh` against `sx_server.exe` on the
|
||||
synchronous Erlang-on-SX scheduler.
|
||||
|
||||
| N (processes) | Hops | Wall-clock | Throughput |
|
||||
|---|---|---|---|
|
||||
| 10 | 10 | 907ms | 11 hops/s |
|
||||
| 50 | 50 | 2107ms | 24 hops/s |
|
||||
| 100 | 100 | 3827ms | 26 hops/s |
|
||||
| 500 | 500 | 17004ms | 29 hops/s |
|
||||
| 1000 | 1000 | 29832ms | 34 hops/s |
|
||||
|
||||
(Each `Nm` row spawns N processes connected in a ring and passes a
|
||||
single token N hops total — i.e. the token completes one full lap.)
|
||||
|
||||
## Status of the 1M-process target
|
||||
|
||||
Phase 3's stretch goal in `plans/erlang-on-sx.md` is a million-process
|
||||
ring benchmark. **That target is not met** in the current synchronous
|
||||
scheduler; extrapolating from the table above, 1M hops would take
|
||||
~30 000 s. Correctness is fine — the program runs at every measured
|
||||
size — but throughput is bound by per-hop overhead.
|
||||
|
||||
Per-hop cost is dominated by:
|
||||
- `er-env-copy` per fun clause attempt (whole-dict copy each time)
|
||||
- `call/cc` capture + `raise`/`guard` unwind on every `receive`
|
||||
- `er-q-delete-at!` rebuilds the mailbox backing list on every match
|
||||
- `dict-set!`/`dict-has?` lookups in the global processes table
|
||||
|
||||
To reach 1M-process throughput in this architecture would need at
|
||||
least: persistent (path-copying) envs, an inline scheduler that
|
||||
doesn't call/cc on the common path (msg-already-in-mailbox), and a
|
||||
linked-list mailbox. None of those are in scope for the Phase 3
|
||||
checkbox — captured here as the floor we're starting from.
|
||||
@@ -1,153 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
# Erlang-on-SX conformance runner.
|
||||
#
|
||||
# Loads every erlang test suite via the epoch protocol, collects
|
||||
# pass/fail counts, and writes lib/erlang/scoreboard.json + .md.
|
||||
#
|
||||
# Usage:
|
||||
# bash lib/erlang/conformance.sh # run all suites
|
||||
# bash lib/erlang/conformance.sh -v # verbose per-suite
|
||||
|
||||
set -uo pipefail
|
||||
cd "$(git rev-parse --show-toplevel)"
|
||||
|
||||
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||
fi
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
echo "ERROR: sx_server.exe not found." >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
VERBOSE="${1:-}"
|
||||
TMPFILE=$(mktemp)
|
||||
OUTFILE=$(mktemp)
|
||||
trap "rm -f $TMPFILE $OUTFILE" EXIT
|
||||
|
||||
# Each suite: name | counter pass | counter total
|
||||
SUITES=(
|
||||
"tokenize|er-test-pass|er-test-count"
|
||||
"parse|er-parse-test-pass|er-parse-test-count"
|
||||
"eval|er-eval-test-pass|er-eval-test-count"
|
||||
"runtime|er-rt-test-pass|er-rt-test-count"
|
||||
"ring|er-ring-test-pass|er-ring-test-count"
|
||||
"ping-pong|er-pp-test-pass|er-pp-test-count"
|
||||
"bank|er-bank-test-pass|er-bank-test-count"
|
||||
"echo|er-echo-test-pass|er-echo-test-count"
|
||||
"fib|er-fib-test-pass|er-fib-test-count"
|
||||
)
|
||||
|
||||
cat > "$TMPFILE" << 'EPOCHS'
|
||||
(epoch 1)
|
||||
(load "lib/erlang/tokenizer.sx")
|
||||
(load "lib/erlang/parser.sx")
|
||||
(load "lib/erlang/parser-core.sx")
|
||||
(load "lib/erlang/parser-expr.sx")
|
||||
(load "lib/erlang/parser-module.sx")
|
||||
(load "lib/erlang/transpile.sx")
|
||||
(load "lib/erlang/runtime.sx")
|
||||
(load "lib/erlang/tests/tokenize.sx")
|
||||
(load "lib/erlang/tests/parse.sx")
|
||||
(load "lib/erlang/tests/eval.sx")
|
||||
(load "lib/erlang/tests/runtime.sx")
|
||||
(load "lib/erlang/tests/programs/ring.sx")
|
||||
(load "lib/erlang/tests/programs/ping_pong.sx")
|
||||
(load "lib/erlang/tests/programs/bank.sx")
|
||||
(load "lib/erlang/tests/programs/echo.sx")
|
||||
(load "lib/erlang/tests/programs/fib_server.sx")
|
||||
(epoch 100)
|
||||
(eval "(list er-test-pass er-test-count)")
|
||||
(epoch 101)
|
||||
(eval "(list er-parse-test-pass er-parse-test-count)")
|
||||
(epoch 102)
|
||||
(eval "(list er-eval-test-pass er-eval-test-count)")
|
||||
(epoch 103)
|
||||
(eval "(list er-rt-test-pass er-rt-test-count)")
|
||||
(epoch 104)
|
||||
(eval "(list er-ring-test-pass er-ring-test-count)")
|
||||
(epoch 105)
|
||||
(eval "(list er-pp-test-pass er-pp-test-count)")
|
||||
(epoch 106)
|
||||
(eval "(list er-bank-test-pass er-bank-test-count)")
|
||||
(epoch 107)
|
||||
(eval "(list er-echo-test-pass er-echo-test-count)")
|
||||
(epoch 108)
|
||||
(eval "(list er-fib-test-pass er-fib-test-count)")
|
||||
EPOCHS
|
||||
|
||||
timeout 120 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
|
||||
|
||||
# Parse "(N M)" from the line after each "(ok-len <epoch> ...)" marker.
|
||||
parse_pair() {
|
||||
local epoch="$1"
|
||||
local line
|
||||
line=$(grep -A1 "^(ok-len $epoch " "$OUTFILE" | tail -1)
|
||||
echo "$line" | sed -E 's/[()]//g'
|
||||
}
|
||||
|
||||
TOTAL_PASS=0
|
||||
TOTAL_COUNT=0
|
||||
JSON_SUITES=""
|
||||
MD_ROWS=""
|
||||
|
||||
idx=0
|
||||
for entry in "${SUITES[@]}"; do
|
||||
name="${entry%%|*}"
|
||||
epoch=$((100 + idx))
|
||||
pair=$(parse_pair "$epoch")
|
||||
pass=$(echo "$pair" | awk '{print $1}')
|
||||
count=$(echo "$pair" | awk '{print $2}')
|
||||
if [ -z "$pass" ] || [ -z "$count" ]; then
|
||||
pass=0
|
||||
count=0
|
||||
fi
|
||||
TOTAL_PASS=$((TOTAL_PASS + pass))
|
||||
TOTAL_COUNT=$((TOTAL_COUNT + count))
|
||||
status="ok"
|
||||
marker="✅"
|
||||
if [ "$pass" != "$count" ]; then
|
||||
status="fail"
|
||||
marker="❌"
|
||||
fi
|
||||
if [ "$VERBOSE" = "-v" ]; then
|
||||
printf " %-12s %s/%s\n" "$name" "$pass" "$count"
|
||||
fi
|
||||
if [ -n "$JSON_SUITES" ]; then JSON_SUITES+=","; fi
|
||||
JSON_SUITES+=$'\n '
|
||||
JSON_SUITES+="{\"name\":\"$name\",\"pass\":$pass,\"total\":$count,\"status\":\"$status\"}"
|
||||
MD_ROWS+="| $marker | $name | $pass | $count |"$'\n'
|
||||
idx=$((idx + 1))
|
||||
done
|
||||
|
||||
printf '\nErlang-on-SX conformance: %d / %d\n' "$TOTAL_PASS" "$TOTAL_COUNT"
|
||||
|
||||
# scoreboard.json
|
||||
cat > lib/erlang/scoreboard.json <<JSON
|
||||
{
|
||||
"language": "erlang",
|
||||
"total_pass": $TOTAL_PASS,
|
||||
"total": $TOTAL_COUNT,
|
||||
"suites": [$JSON_SUITES
|
||||
]
|
||||
}
|
||||
JSON
|
||||
|
||||
# scoreboard.md
|
||||
cat > lib/erlang/scoreboard.md <<MD
|
||||
# Erlang-on-SX Scoreboard
|
||||
|
||||
**Total: ${TOTAL_PASS} / ${TOTAL_COUNT} tests passing**
|
||||
|
||||
| | Suite | Pass | Total |
|
||||
|---|---|---|---|
|
||||
$MD_ROWS
|
||||
|
||||
Generated by \`lib/erlang/conformance.sh\`.
|
||||
MD
|
||||
|
||||
if [ "$TOTAL_PASS" -eq "$TOTAL_COUNT" ]; then
|
||||
exit 0
|
||||
else
|
||||
exit 1
|
||||
fi
|
||||
@@ -1,411 +0,0 @@
|
||||
;; 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)))))
|
||||
|
||||
;; ── 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
|
||||
: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 Phase 4 (links)")
|
||||
:else (error "Erlang: exit: wrong arity"))))
|
||||
|
||||
;; ── 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-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)
|
||||
(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)))
|
||||
(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))
|
||||
: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-sched-set-current! nil)))
|
||||
@@ -1,16 +0,0 @@
|
||||
{
|
||||
"language": "erlang",
|
||||
"total_pass": 358,
|
||||
"total": 358,
|
||||
"suites": [
|
||||
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
||||
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
||||
{"name":"eval","pass":174,"total":174,"status":"ok"},
|
||||
{"name":"runtime","pass":39,"total":39,"status":"ok"},
|
||||
{"name":"ring","pass":4,"total":4,"status":"ok"},
|
||||
{"name":"ping-pong","pass":4,"total":4,"status":"ok"},
|
||||
{"name":"bank","pass":8,"total":8,"status":"ok"},
|
||||
{"name":"echo","pass":7,"total":7,"status":"ok"},
|
||||
{"name":"fib","pass":8,"total":8,"status":"ok"}
|
||||
]
|
||||
}
|
||||
@@ -1,18 +0,0 @@
|
||||
# Erlang-on-SX Scoreboard
|
||||
|
||||
**Total: 358 / 358 tests passing**
|
||||
|
||||
| | Suite | Pass | Total |
|
||||
|---|---|---|---|
|
||||
| ✅ | tokenize | 62 | 62 |
|
||||
| ✅ | parse | 52 | 52 |
|
||||
| ✅ | eval | 174 | 174 |
|
||||
| ✅ | runtime | 39 | 39 |
|
||||
| ✅ | ring | 4 | 4 |
|
||||
| ✅ | ping-pong | 4 | 4 |
|
||||
| ✅ | bank | 8 | 8 |
|
||||
| ✅ | echo | 7 | 7 |
|
||||
| ✅ | fib | 8 | 8 |
|
||||
|
||||
|
||||
Generated by `lib/erlang/conformance.sh`.
|
||||
@@ -1,437 +0,0 @@
|
||||
;; Erlang evaluator tests — sequential expressions.
|
||||
|
||||
(define er-eval-test-count 0)
|
||||
(define er-eval-test-pass 0)
|
||||
(define er-eval-test-fails (list))
|
||||
|
||||
(define
|
||||
eev-deep=
|
||||
(fn
|
||||
(a b)
|
||||
(cond
|
||||
(and (= (type-of a) "dict") (= (type-of b) "dict"))
|
||||
(let
|
||||
((ka (sort (keys a))) (kb (sort (keys b))))
|
||||
(and (= ka kb) (every? (fn (k) (eev-deep= (get a k) (get b k))) ka)))
|
||||
(and (= (type-of a) "list") (= (type-of b) "list"))
|
||||
(and
|
||||
(= (len a) (len b))
|
||||
(every? (fn (i) (eev-deep= (nth a i) (nth b i))) (range 0 (len a))))
|
||||
:else (= a b))))
|
||||
|
||||
(define
|
||||
er-eval-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-eval-test-count (+ er-eval-test-count 1))
|
||||
(if
|
||||
(eev-deep= actual expected)
|
||||
(set! er-eval-test-pass (+ er-eval-test-pass 1))
|
||||
(append! er-eval-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define ev erlang-eval-ast)
|
||||
(define nm (fn (v) (get v :name)))
|
||||
|
||||
;; ── literals ──────────────────────────────────────────────────────
|
||||
(er-eval-test "int" (ev "42") 42)
|
||||
(er-eval-test "zero" (ev "0") 0)
|
||||
(er-eval-test "float" (ev "3.14") 3.14)
|
||||
(er-eval-test "string" (ev "\"hi\"") "hi")
|
||||
(er-eval-test "atom" (nm (ev "ok")) "ok")
|
||||
(er-eval-test "atom true" (nm (ev "true")) "true")
|
||||
(er-eval-test "atom false" (nm (ev "false")) "false")
|
||||
|
||||
;; ── arithmetic ────────────────────────────────────────────────────
|
||||
(er-eval-test "add" (ev "1 + 2") 3)
|
||||
(er-eval-test "sub" (ev "5 - 3") 2)
|
||||
(er-eval-test "mul" (ev "4 * 3") 12)
|
||||
(er-eval-test "div-real" (ev "10 / 4") 2.5)
|
||||
(er-eval-test "div-int" (ev "10 div 3") 3)
|
||||
(er-eval-test "rem" (ev "10 rem 3") 1)
|
||||
(er-eval-test "div-neg" (ev "-10 div 3") -3)
|
||||
(er-eval-test "precedence" (ev "1 + 2 * 3") 7)
|
||||
(er-eval-test "parens" (ev "(1 + 2) * 3") 9)
|
||||
(er-eval-test "unary-neg" (ev "-(1 + 2)") -3)
|
||||
(er-eval-test "unary-neg int" (ev "-7") -7)
|
||||
|
||||
;; ── comparison ────────────────────────────────────────────────────
|
||||
(er-eval-test "lt true" (nm (ev "1 < 2")) "true")
|
||||
(er-eval-test "gt false" (nm (ev "1 > 2")) "false")
|
||||
(er-eval-test "le equal" (nm (ev "2 =< 2")) "true")
|
||||
(er-eval-test "ge equal" (nm (ev "2 >= 2")) "true")
|
||||
(er-eval-test "eq" (nm (ev "2 == 2")) "true")
|
||||
(er-eval-test "neq" (nm (ev "1 /= 2")) "true")
|
||||
(er-eval-test "exact-eq same" (nm (ev "1 =:= 1")) "true")
|
||||
(er-eval-test "exact-neq int" (nm (ev "1 =:= 2")) "false")
|
||||
(er-eval-test "=/= true" (nm (ev "1 =/= 2")) "true")
|
||||
(er-eval-test "atom-eq" (nm (ev "ok == ok")) "true")
|
||||
(er-eval-test "atom-neq" (nm (ev "ok == error")) "false")
|
||||
|
||||
;; ── logical ───────────────────────────────────────────────────────
|
||||
(er-eval-test "and tt" (nm (ev "true and true")) "true")
|
||||
(er-eval-test "and tf" (nm (ev "true and false")) "false")
|
||||
(er-eval-test "or tf" (nm (ev "true or false")) "true")
|
||||
(er-eval-test
|
||||
"andalso short"
|
||||
(nm (ev "false andalso Neverref"))
|
||||
"false")
|
||||
(er-eval-test
|
||||
"orelse short"
|
||||
(nm (ev "true orelse Neverref"))
|
||||
"true")
|
||||
(er-eval-test "not true" (nm (ev "not true")) "false")
|
||||
(er-eval-test "not false" (nm (ev "not false")) "true")
|
||||
|
||||
;; ── tuples & lists ────────────────────────────────────────────────
|
||||
(er-eval-test "tuple tag" (get (ev "{1, 2, 3}") :tag) "tuple")
|
||||
(er-eval-test "tuple len" (len (get (ev "{1, 2, 3}") :elements)) 3)
|
||||
(er-eval-test "tuple elem" (nth (get (ev "{10, 20}") :elements) 1) 20)
|
||||
(er-eval-test "empty tuple" (len (get (ev "{}") :elements)) 0)
|
||||
(er-eval-test "nested tuple"
|
||||
(nm (nth (get (ev "{ok, error}") :elements) 0)) "ok")
|
||||
(er-eval-test "nil list" (get (ev "[]") :tag) "nil")
|
||||
(er-eval-test "list head" (get (ev "[1, 2, 3]") :head) 1)
|
||||
(er-eval-test
|
||||
"list tail tail head"
|
||||
(get (get (get (ev "[1, 2, 3]") :tail) :tail) :head)
|
||||
3)
|
||||
|
||||
;; ── list ops ──────────────────────────────────────────────────────
|
||||
(er-eval-test "++ head" (get (ev "[1, 2] ++ [3]") :head) 1)
|
||||
(er-eval-test "++ last"
|
||||
(get (get (get (ev "[1, 2] ++ [3]") :tail) :tail) :head) 3)
|
||||
|
||||
;; ── block ─────────────────────────────────────────────────────────
|
||||
(er-eval-test "block last wins" (ev "begin 1, 2, 3 end") 3)
|
||||
(er-eval-test "bare body" (ev "1, 2, 99") 99)
|
||||
|
||||
;; ── match + var ───────────────────────────────────────────────────
|
||||
(er-eval-test "match bind-and-use" (ev "X = 5, X + 1") 6)
|
||||
(er-eval-test "match sequential" (ev "X = 1, Y = 2, X + Y") 3)
|
||||
(er-eval-test
|
||||
"rebind equal ok"
|
||||
(ev "X = 5, X = 5, X") 5)
|
||||
|
||||
;; ── if ────────────────────────────────────────────────────────────
|
||||
(er-eval-test "if picks first" (ev "if true -> 1; true -> 2 end") 1)
|
||||
(er-eval-test
|
||||
"if picks second"
|
||||
(nm (ev "if 1 > 2 -> bad; true -> good end"))
|
||||
"good")
|
||||
(er-eval-test
|
||||
"if with guard"
|
||||
(ev "X = 5, if X > 0 -> 1; true -> 0 end")
|
||||
1)
|
||||
|
||||
;; ── pattern matching ─────────────────────────────────────────────
|
||||
(er-eval-test "match atom literal" (nm (ev "ok = ok, done")) "done")
|
||||
(er-eval-test "match int literal" (ev "5 = 5, 42") 42)
|
||||
(er-eval-test "match tuple bind"
|
||||
(ev "{ok, V} = {ok, 99}, V") 99)
|
||||
(er-eval-test "match tuple nested"
|
||||
(ev "{A, {B, C}} = {1, {2, 3}}, A + B + C") 6)
|
||||
(er-eval-test "match cons head"
|
||||
(ev "[H|T] = [1, 2, 3], H") 1)
|
||||
(er-eval-test "match cons tail head"
|
||||
(ev "[_, H|_] = [1, 2, 3], H") 2)
|
||||
(er-eval-test "match nil"
|
||||
(ev "[] = [], 7") 7)
|
||||
(er-eval-test "match wildcard always"
|
||||
(ev "_ = 42, 7") 7)
|
||||
(er-eval-test "match var reuse equal"
|
||||
(ev "X = 5, X = 5, X") 5)
|
||||
|
||||
;; ── case ─────────────────────────────────────────────────────────
|
||||
(er-eval-test "case bind" (ev "case 5 of N -> N end") 5)
|
||||
(er-eval-test "case tuple"
|
||||
(ev "case {ok, 42} of {ok, V} -> V end") 42)
|
||||
(er-eval-test "case cons"
|
||||
(ev "case [1, 2, 3] of [H|_] -> H end") 1)
|
||||
(er-eval-test "case fallthrough"
|
||||
(ev "case error of ok -> 1; error -> 2 end") 2)
|
||||
(er-eval-test "case wildcard"
|
||||
(nm (ev "case x of ok -> ok; _ -> err end"))
|
||||
"err")
|
||||
(er-eval-test "case guard"
|
||||
(ev "case 5 of N when N > 0 -> pos; _ -> neg end")
|
||||
(er-mk-atom "pos"))
|
||||
(er-eval-test "case guard fallthrough"
|
||||
(ev "case -3 of N when N > 0 -> pos; _ -> neg end")
|
||||
(er-mk-atom "neg"))
|
||||
(er-eval-test "case bound re-match"
|
||||
(ev "X = 5, case 5 of X -> same; _ -> diff end")
|
||||
(er-mk-atom "same"))
|
||||
(er-eval-test "case bound re-match fail"
|
||||
(ev "X = 5, case 6 of X -> same; _ -> diff end")
|
||||
(er-mk-atom "diff"))
|
||||
(er-eval-test "case nested tuple"
|
||||
(ev "case {ok, {value, 42}} of {ok, {value, V}} -> V end")
|
||||
42)
|
||||
(er-eval-test "case multi-clause"
|
||||
(ev "case 2 of 1 -> one; 2 -> two; _ -> other end")
|
||||
(er-mk-atom "two"))
|
||||
(er-eval-test "case leak binding"
|
||||
(ev "case {ok, 7} of {ok, X} -> X end + 1")
|
||||
8)
|
||||
|
||||
;; ── guard BIFs (is_*) ────────────────────────────────────────────
|
||||
(er-eval-test "is_integer 42" (nm (ev "is_integer(42)")) "true")
|
||||
(er-eval-test "is_integer ok" (nm (ev "is_integer(ok)")) "false")
|
||||
(er-eval-test "is_atom ok" (nm (ev "is_atom(ok)")) "true")
|
||||
(er-eval-test "is_atom int" (nm (ev "is_atom(42)")) "false")
|
||||
(er-eval-test "is_list cons" (nm (ev "is_list([1,2])")) "true")
|
||||
(er-eval-test "is_list nil" (nm (ev "is_list([])")) "true")
|
||||
(er-eval-test "is_list tuple" (nm (ev "is_list({1,2})")) "false")
|
||||
(er-eval-test "is_tuple tuple" (nm (ev "is_tuple({ok,1})")) "true")
|
||||
(er-eval-test "is_tuple list" (nm (ev "is_tuple([1])")) "false")
|
||||
(er-eval-test "is_number int" (nm (ev "is_number(42)")) "true")
|
||||
(er-eval-test "is_number atom" (nm (ev "is_number(foo)")) "false")
|
||||
(er-eval-test "is_boolean true" (nm (ev "is_boolean(true)")) "true")
|
||||
(er-eval-test "is_boolean false" (nm (ev "is_boolean(false)")) "true")
|
||||
(er-eval-test "is_boolean atom" (nm (ev "is_boolean(foo)")) "false")
|
||||
|
||||
;; ── guard BIFs wired into case / if ─────────────────────────────
|
||||
(er-eval-test "guard is_integer pick"
|
||||
(nm (ev "case 5 of N when is_integer(N) -> int; _ -> other end"))
|
||||
"int")
|
||||
(er-eval-test "guard is_integer reject"
|
||||
(nm (ev "case foo of N when is_integer(N) -> int; _ -> other end"))
|
||||
"other")
|
||||
(er-eval-test "guard is_atom"
|
||||
(nm (ev "case foo of X when is_atom(X) -> atom_yes; _ -> no end"))
|
||||
"atom_yes")
|
||||
(er-eval-test "guard conjunction"
|
||||
(nm (ev "case 5 of N when is_integer(N), N > 0 -> pos; _ -> np end"))
|
||||
"pos")
|
||||
(er-eval-test "guard disjunction (if)"
|
||||
(nm (ev "X = foo, if is_integer(X); is_atom(X) -> yes; true -> no end"))
|
||||
"yes")
|
||||
(er-eval-test "guard arith"
|
||||
(nm (ev "case 3 of N when N * 2 > 5 -> big; _ -> small end"))
|
||||
"big")
|
||||
|
||||
;; ── BIFs: list + tuple ──────────────────────────────────────────
|
||||
(er-eval-test "length empty" (ev "length([])") 0)
|
||||
(er-eval-test "length 3" (ev "length([a, b, c])") 3)
|
||||
(er-eval-test "length cons chain" (ev "length([1 | [2 | [3 | []]]])") 3)
|
||||
(er-eval-test "hd" (ev "hd([10, 20, 30])") 10)
|
||||
(er-eval-test "hd atom"
|
||||
(nm (ev "hd([ok, err])")) "ok")
|
||||
(er-eval-test "tl head"
|
||||
(get (ev "tl([1, 2, 3])") :head) 2)
|
||||
(er-eval-test "tl of single" (get (ev "tl([1])") :tag) "nil")
|
||||
(er-eval-test "element 1" (nm (ev "element(1, {ok, value})")) "ok")
|
||||
(er-eval-test "element 2" (ev "element(2, {ok, 42})") 42)
|
||||
(er-eval-test "element 3"
|
||||
(nm (ev "element(3, {a, b, c, d})")) "c")
|
||||
(er-eval-test "tuple_size 2" (ev "tuple_size({a, b})") 2)
|
||||
(er-eval-test "tuple_size 0" (ev "tuple_size({})") 0)
|
||||
|
||||
;; ── BIFs: atom / list conversions ───────────────────────────────
|
||||
(er-eval-test "atom_to_list" (ev "atom_to_list(hello)") "hello")
|
||||
(er-eval-test "list_to_atom roundtrip"
|
||||
(nm (ev "list_to_atom(atom_to_list(foo))")) "foo")
|
||||
(er-eval-test "list_to_atom fresh"
|
||||
(nm (ev "list_to_atom(\"bar\")")) "bar")
|
||||
|
||||
;; ── lists module ────────────────────────────────────────────────
|
||||
(er-eval-test "lists:reverse empty"
|
||||
(get (ev "lists:reverse([])") :tag) "nil")
|
||||
(er-eval-test "lists:reverse 3"
|
||||
(ev "hd(lists:reverse([1, 2, 3]))") 3)
|
||||
(er-eval-test "lists:reverse full"
|
||||
(ev "lists:foldl(fun (X, Acc) -> Acc + X end, 0, lists:reverse([1, 2, 3]))") 6)
|
||||
|
||||
;; ── funs + lists:map / lists:foldl ──────────────────────────────
|
||||
(er-eval-test "fun call" (ev "F = fun (X) -> X + 1 end, F(10)") 11)
|
||||
(er-eval-test "fun two-arg"
|
||||
(ev "F = fun (X, Y) -> X * Y end, F(3, 4)") 12)
|
||||
(er-eval-test "fun closure"
|
||||
(ev "N = 100, F = fun (X) -> X + N end, F(5)") 105)
|
||||
(er-eval-test "fun clauses"
|
||||
(ev "F = fun (0) -> zero; (N) -> N end, element(1, {F(0), F(7)})")
|
||||
(er-mk-atom "zero"))
|
||||
(er-eval-test "fun multi-clause second"
|
||||
(ev "F = fun (0) -> 0; (N) -> N * 2 end, F(5)") 10)
|
||||
(er-eval-test "lists:map empty"
|
||||
(get (ev "lists:map(fun (X) -> X end, [])") :tag) "nil")
|
||||
(er-eval-test "lists:map double"
|
||||
(ev "hd(lists:map(fun (X) -> X * 2 end, [1, 2, 3]))") 2)
|
||||
(er-eval-test "lists:map sum-length"
|
||||
(ev "length(lists:map(fun (X) -> X end, [a, b, c, d]))") 4)
|
||||
(er-eval-test "lists:foldl sum"
|
||||
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [1, 2, 3, 4, 5])") 15)
|
||||
(er-eval-test "lists:foldl product"
|
||||
(ev "lists:foldl(fun (X, Acc) -> X * Acc end, 1, [1, 2, 3, 4])") 24)
|
||||
(er-eval-test "lists:foldl as reverse"
|
||||
(ev "hd(lists:foldl(fun (X, Acc) -> [X | Acc] end, [], [1, 2, 3]))") 3)
|
||||
|
||||
;; ── io:format (via capture buffer) ──────────────────────────────
|
||||
(er-eval-test "io:format plain"
|
||||
(do (er-io-flush!) (ev "io:format(\"hello~n\")") (er-io-buffer-content))
|
||||
"hello\n")
|
||||
(er-eval-test "io:format args"
|
||||
(do (er-io-flush!) (ev "io:format(\"x=~p y=~p~n\", [42, hello])") (er-io-buffer-content))
|
||||
"x=42 y=hello\n")
|
||||
(er-eval-test "io:format returns ok"
|
||||
(nm (do (er-io-flush!) (ev "io:format(\"~n\")"))) "ok")
|
||||
(er-eval-test "io:format tuple"
|
||||
(do (er-io-flush!) (ev "io:format(\"~p\", [{ok, 1}])") (er-io-buffer-content))
|
||||
"{ok,1}")
|
||||
(er-eval-test "io:format list"
|
||||
(do (er-io-flush!) (ev "io:format(\"~p\", [[1,2,3]])") (er-io-buffer-content))
|
||||
"[1,2,3]")
|
||||
(er-eval-test "io:format escape"
|
||||
(do (er-io-flush!) (ev "io:format(\"50~~\")") (er-io-buffer-content))
|
||||
"50~")
|
||||
|
||||
;; ── processes: self/0, spawn/1, is_pid ──────────────────────────
|
||||
(er-eval-test "self tag"
|
||||
(get (ev "self()") :tag) "pid")
|
||||
(er-eval-test "is_pid self"
|
||||
(nm (ev "is_pid(self())")) "true")
|
||||
(er-eval-test "is_pid number"
|
||||
(nm (ev "is_pid(42)")) "false")
|
||||
(er-eval-test "is_pid atom"
|
||||
(nm (ev "is_pid(ok)")) "false")
|
||||
(er-eval-test "self equals self"
|
||||
(nm (ev "Pid = self(), Pid =:= Pid")) "true")
|
||||
(er-eval-test "self =:= self expr"
|
||||
(nm (ev "self() == self()")) "true")
|
||||
(er-eval-test "spawn returns pid"
|
||||
(get (ev "spawn(fun () -> ok end)") :tag) "pid")
|
||||
(er-eval-test "is_pid spawn"
|
||||
(nm (ev "is_pid(spawn(fun () -> ok end))")) "true")
|
||||
(er-eval-test "spawn new pid distinct"
|
||||
(nm (ev "P1 = self(), P2 = spawn(fun () -> ok end), P1 =:= P2"))
|
||||
"false")
|
||||
(er-eval-test "two spawns distinct"
|
||||
(nm (ev "P1 = spawn(fun () -> ok end), P2 = spawn(fun () -> ok end), P1 =:= P2"))
|
||||
"false")
|
||||
(er-eval-test "spawn then drain io"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ev "spawn(fun () -> io:format(\"child~n\") end), io:format(\"parent~n\")")
|
||||
(er-io-buffer-content))
|
||||
"parent\nchild\n")
|
||||
(er-eval-test "multiple spawn ordering"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ev "spawn(fun () -> io:format(\"a~n\") end), spawn(fun () -> io:format(\"b~n\") end), io:format(\"main~n\")")
|
||||
(er-io-buffer-content))
|
||||
"main\na\nb\n")
|
||||
(er-eval-test "child self is its own pid"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ev "P = spawn(fun () -> io:format(\"~p\", [is_pid(self())]) end), io:format(\"~p;\", [is_pid(P)])")
|
||||
(er-io-buffer-content))
|
||||
"true;true")
|
||||
|
||||
;; ── ! (send) + receive ──────────────────────────────────────────
|
||||
(er-eval-test "self-send + receive"
|
||||
(nm (ev "Me = self(), Me ! hello, receive Msg -> Msg end")) "hello")
|
||||
(er-eval-test "send returns msg"
|
||||
(nm (ev "Me = self(), Msg = Me ! ok, Me ! x, receive _ -> Msg end")) "ok")
|
||||
(er-eval-test "receive int"
|
||||
(ev "Me = self(), Me ! 42, receive N -> N + 1 end") 43)
|
||||
(er-eval-test "receive with pattern"
|
||||
(ev "Me = self(), Me ! {ok, 7}, receive {ok, V} -> V * 2 end") 14)
|
||||
(er-eval-test "receive with guard"
|
||||
(ev "Me = self(), Me ! 5, receive N when N > 0 -> positive end")
|
||||
(er-mk-atom "positive"))
|
||||
(er-eval-test "receive skips non-match"
|
||||
(nm (ev "Me = self(), Me ! wrong, Me ! right, receive right -> ok end"))
|
||||
"ok")
|
||||
(er-eval-test "receive selective leaves others"
|
||||
(nm (ev "Me = self(), Me ! a, Me ! b, receive b -> got_b end"))
|
||||
"got_b")
|
||||
(er-eval-test "two receives consume both"
|
||||
(ev "Me = self(), Me ! 1, Me ! 2, X = receive A -> A end, Y = receive B -> B end, X + Y") 3)
|
||||
|
||||
;; ── spawn + send + receive (real process communication) ─────────
|
||||
(er-eval-test "spawn sends back"
|
||||
(nm
|
||||
(ev "Me = self(), spawn(fun () -> Me ! pong end), receive pong -> got_pong end"))
|
||||
"got_pong")
|
||||
(er-eval-test "ping-pong"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ev "Me = self(), Child = spawn(fun () -> receive {ping, From} -> From ! pong end end), Child ! {ping, Me}, receive pong -> io:format(\"pong~n\") end")
|
||||
(er-io-buffer-content))
|
||||
"pong\n")
|
||||
(er-eval-test "echo server"
|
||||
(ev "Me = self(), Echo = spawn(fun () -> receive {From, Msg} -> From ! Msg end end), Echo ! {Me, 99}, receive R -> R end") 99)
|
||||
|
||||
;; ── receive with multiple clauses ────────────────────────────────
|
||||
(er-eval-test "receive multi-clause"
|
||||
(nm (ev "Me = self(), Me ! foo, receive ok -> a; foo -> b; bar -> c end"))
|
||||
"b")
|
||||
(er-eval-test "receive nested tuple"
|
||||
(ev "Me = self(), Me ! {result, {ok, 42}}, receive {result, {ok, V}} -> V end") 42)
|
||||
|
||||
;; ── receive ... after ... ───────────────────────────────────────
|
||||
(er-eval-test "after 0 empty mailbox"
|
||||
(nm (ev "receive _ -> got after 0 -> timeout end"))
|
||||
"timeout")
|
||||
(er-eval-test "after 0 match wins"
|
||||
(nm (ev "Me = self(), Me ! ok, receive ok -> got after 0 -> timeout end"))
|
||||
"got")
|
||||
(er-eval-test "after 0 non-match fires timeout"
|
||||
(nm (ev "Me = self(), Me ! wrong, receive right -> got after 0 -> timeout end"))
|
||||
"timeout")
|
||||
(er-eval-test "after 0 leaves non-match"
|
||||
(ev "Me = self(), Me ! wrong, receive right -> got after 0 -> to end, receive X -> X end")
|
||||
(er-mk-atom "wrong"))
|
||||
(er-eval-test "after Ms no sender — timeout fires"
|
||||
(nm (ev "receive _ -> got after 100 -> timed_out end"))
|
||||
"timed_out")
|
||||
(er-eval-test "after Ms with sender — match wins"
|
||||
(nm (ev "Me = self(), spawn(fun () -> Me ! hi end), receive hi -> got after 100 -> to end"))
|
||||
"got")
|
||||
(er-eval-test "after Ms computed"
|
||||
(nm (ev "Ms = 50, receive _ -> got after Ms -> done end"))
|
||||
"done")
|
||||
(er-eval-test "after 0 body side effect"
|
||||
(do (er-io-flush!)
|
||||
(ev "receive _ -> ok after 0 -> io:format(\"to~n\") end")
|
||||
(er-io-buffer-content))
|
||||
"to\n")
|
||||
(er-eval-test "after zero poll selective"
|
||||
(ev "Me = self(), Me ! first, Me ! second, X = receive second -> got_second after 0 -> to end, Y = receive first -> got_first after 0 -> to end, {X, Y}")
|
||||
(er-mk-tuple (list (er-mk-atom "got_second") (er-mk-atom "got_first"))))
|
||||
|
||||
;; ── exit/1 + process termination ─────────────────────────────────
|
||||
(er-eval-test "exit normal returns nil" (ev "exit(normal)") nil)
|
||||
(er-eval-test "exit normal reason"
|
||||
(do (ev "exit(normal)") (nm (er-last-main-exit-reason))) "normal")
|
||||
(er-eval-test "exit bye reason"
|
||||
(do (ev "exit(bye)") (nm (er-last-main-exit-reason))) "bye")
|
||||
(er-eval-test "exit tuple reason"
|
||||
(do (ev "exit({shutdown, crash})")
|
||||
(get (er-last-main-exit-reason) :tag))
|
||||
"tuple")
|
||||
(er-eval-test "normal completion reason"
|
||||
(do (ev "42") (nm (er-last-main-exit-reason))) "normal")
|
||||
(er-eval-test "exit aborts subsequent"
|
||||
(do (er-io-flush!) (ev "io:format(\"a~n\"), exit(bye), io:format(\"b~n\")") (er-io-buffer-content))
|
||||
"a\n")
|
||||
(er-eval-test "child exit doesn't kill parent"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ev "spawn(fun () -> io:format(\"before~n\"), exit(quit), io:format(\"after~n\") end), io:format(\"main~n\")")
|
||||
(er-io-buffer-content))
|
||||
"main\nbefore\n")
|
||||
(er-eval-test "child exit reason recorded on child"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ev "P = spawn(fun () -> exit(child_bye) end), io:format(\"~p\", [is_pid(P)])")
|
||||
(er-io-buffer-content))
|
||||
"true")
|
||||
(er-eval-test "exit inside fn chain"
|
||||
(do (ev "F = fun () -> exit(from_fn) end, F()")
|
||||
(nm (er-last-main-exit-reason)))
|
||||
"from_fn")
|
||||
|
||||
(define
|
||||
er-eval-test-summary
|
||||
(str "eval " er-eval-test-pass "/" er-eval-test-count))
|
||||
@@ -1,159 +0,0 @@
|
||||
;; Bank account server — stateful process, balance threaded through
|
||||
;; recursive loop. Handles {deposit, Amt, From}, {withdraw, Amt, From},
|
||||
;; {balance, From}, stop. Tests stateful process patterns.
|
||||
|
||||
(define er-bank-test-count 0)
|
||||
(define er-bank-test-pass 0)
|
||||
(define er-bank-test-fails (list))
|
||||
|
||||
(define
|
||||
er-bank-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-bank-test-count (+ er-bank-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-bank-test-pass (+ er-bank-test-pass 1))
|
||||
(append! er-bank-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define bank-ev erlang-eval-ast)
|
||||
|
||||
;; Server fun shared by all tests — threaded via the program string.
|
||||
(define
|
||||
er-bank-server-src
|
||||
"Server = fun (Balance) ->
|
||||
receive
|
||||
{deposit, Amt, From} -> From ! ok, Server(Balance + Amt);
|
||||
{withdraw, Amt, From} ->
|
||||
if Amt > Balance -> From ! insufficient, Server(Balance);
|
||||
true -> From ! ok, Server(Balance - Amt)
|
||||
end;
|
||||
{balance, From} -> From ! Balance, Server(Balance);
|
||||
stop -> ok
|
||||
end
|
||||
end")
|
||||
|
||||
;; Open account, deposit, check balance.
|
||||
(er-bank-test
|
||||
"deposit 100 -> balance 100"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Bank ! {deposit, 100, Me},
|
||||
receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
100)
|
||||
|
||||
;; Multiple deposits accumulate.
|
||||
(er-bank-test
|
||||
"deposits accumulate"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Bank ! {deposit, 50, Me}, receive ok -> ok end,
|
||||
Bank ! {deposit, 25, Me}, receive ok -> ok end,
|
||||
Bank ! {deposit, 10, Me}, receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
85)
|
||||
|
||||
;; Withdraw within balance succeeds; insufficient gets rejected.
|
||||
(er-bank-test
|
||||
"withdraw within balance"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(100) end),
|
||||
Bank ! {withdraw, 30, Me}, receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
70)
|
||||
|
||||
(er-bank-test
|
||||
"withdraw insufficient"
|
||||
(get
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(20) end),
|
||||
Bank ! {withdraw, 100, Me},
|
||||
receive R -> Bank ! stop, R end"))
|
||||
:name)
|
||||
"insufficient")
|
||||
|
||||
;; State preserved across an insufficient withdrawal.
|
||||
(er-bank-test
|
||||
"state preserved on rejection"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(50) end),
|
||||
Bank ! {withdraw, 1000, Me}, receive _ -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
50)
|
||||
|
||||
;; Mixed deposits and withdrawals.
|
||||
(er-bank-test
|
||||
"mixed transactions"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(100) end),
|
||||
Bank ! {deposit, 50, Me}, receive ok -> ok end,
|
||||
Bank ! {withdraw, 30, Me}, receive ok -> ok end,
|
||||
Bank ! {deposit, 10, Me}, receive ok -> ok end,
|
||||
Bank ! {withdraw, 5, Me}, receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
125)
|
||||
|
||||
;; Server.stop terminates the bank cleanly — main can verify by
|
||||
;; sending stop and then exiting normally.
|
||||
(er-bank-test
|
||||
"server stops cleanly"
|
||||
(get
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Bank ! stop,
|
||||
done"))
|
||||
:name)
|
||||
"done")
|
||||
|
||||
;; Two clients sharing one bank — interleaved transactions.
|
||||
(er-bank-test
|
||||
"two clients share bank"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Client = fun (Amt) ->
|
||||
spawn(fun () ->
|
||||
Bank ! {deposit, Amt, self()},
|
||||
receive ok -> Me ! deposited end
|
||||
end)
|
||||
end,
|
||||
Client(40),
|
||||
Client(60),
|
||||
receive deposited -> ok end,
|
||||
receive deposited -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
100)
|
||||
|
||||
(define
|
||||
er-bank-test-summary
|
||||
(str "bank " er-bank-test-pass "/" er-bank-test-count))
|
||||
@@ -1,140 +0,0 @@
|
||||
;; Echo server — minimal classic Erlang server. Receives {From, Msg}
|
||||
;; and sends Msg back to From, then loops. `stop` ends the server.
|
||||
|
||||
(define er-echo-test-count 0)
|
||||
(define er-echo-test-pass 0)
|
||||
(define er-echo-test-fails (list))
|
||||
|
||||
(define
|
||||
er-echo-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-echo-test-count (+ er-echo-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-echo-test-pass (+ er-echo-test-pass 1))
|
||||
(append! er-echo-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define echo-ev erlang-eval-ast)
|
||||
|
||||
(define
|
||||
er-echo-server-src
|
||||
"EchoSrv = fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{From, Msg} -> From ! Msg, Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end")
|
||||
|
||||
;; Single round-trip with an atom.
|
||||
(er-echo-test
|
||||
"atom round-trip"
|
||||
(get
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, hello},
|
||||
receive R -> Echo ! stop, R end"))
|
||||
:name)
|
||||
"hello")
|
||||
|
||||
;; Number round-trip.
|
||||
(er-echo-test
|
||||
"number round-trip"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, 42},
|
||||
receive R -> Echo ! stop, R end"))
|
||||
42)
|
||||
|
||||
;; Tuple round-trip — pattern-match the reply to extract V.
|
||||
(er-echo-test
|
||||
"tuple round-trip"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, {ok, 7}},
|
||||
receive {ok, V} -> Echo ! stop, V end"))
|
||||
7)
|
||||
|
||||
;; List round-trip.
|
||||
(er-echo-test
|
||||
"list round-trip"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, [1, 2, 3]},
|
||||
receive [H | _] -> Echo ! stop, H end"))
|
||||
1)
|
||||
|
||||
;; Multiple sequential round-trips.
|
||||
(er-echo-test
|
||||
"three round-trips"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, 10}, A = receive Ra -> Ra end,
|
||||
Echo ! {Me, 20}, B = receive Rb -> Rb end,
|
||||
Echo ! {Me, 30}, C = receive Rc -> Rc end,
|
||||
Echo ! stop,
|
||||
A + B + C"))
|
||||
60)
|
||||
|
||||
;; Two clients sharing one echo server. Each gets its own reply.
|
||||
(er-echo-test
|
||||
"two clients"
|
||||
(get
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Client = fun (Tag) ->
|
||||
spawn(fun () ->
|
||||
Echo ! {self(), Tag},
|
||||
receive R -> Me ! {got, R} end
|
||||
end)
|
||||
end,
|
||||
Client(a),
|
||||
Client(b),
|
||||
receive {got, _} -> ok end,
|
||||
receive {got, _} -> ok end,
|
||||
Echo ! stop,
|
||||
finished"))
|
||||
:name)
|
||||
"finished")
|
||||
|
||||
;; Echo via io trace — verify each message round-trips through.
|
||||
(er-echo-test
|
||||
"trace 4 messages"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Send = fun (V) -> Echo ! {Me, V}, receive R -> io:format(\"~p \", [R]) end end,
|
||||
Send(1), Send(2), Send(3), Send(4),
|
||||
Echo ! stop,
|
||||
done"))
|
||||
(er-io-buffer-content))
|
||||
"1 2 3 4 ")
|
||||
|
||||
(define
|
||||
er-echo-test-summary
|
||||
(str "echo " er-echo-test-pass "/" er-echo-test-count))
|
||||
@@ -1,152 +0,0 @@
|
||||
;; Fib server — long-lived process that computes fibonacci numbers on
|
||||
;; request. Tests recursive function evaluation inside a server loop.
|
||||
|
||||
(define er-fib-test-count 0)
|
||||
(define er-fib-test-pass 0)
|
||||
(define er-fib-test-fails (list))
|
||||
|
||||
(define
|
||||
er-fib-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-fib-test-count (+ er-fib-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-fib-test-pass (+ er-fib-test-pass 1))
|
||||
(append! er-fib-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define fib-ev erlang-eval-ast)
|
||||
|
||||
;; Fib + server-loop source. Standalone so each test can chain queries.
|
||||
(define
|
||||
er-fib-server-src
|
||||
"Fib = fun (0) -> 0; (1) -> 1; (N) -> Fib(N-1) + Fib(N-2) end,
|
||||
FibSrv = fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{fib, N, From} -> From ! Fib(N), Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end")
|
||||
|
||||
;; Base cases.
|
||||
(er-fib-test
|
||||
"fib(0)"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 0, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
0)
|
||||
|
||||
(er-fib-test
|
||||
"fib(1)"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 1, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
1)
|
||||
|
||||
;; Larger values.
|
||||
(er-fib-test
|
||||
"fib(10) = 55"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 10, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
55)
|
||||
|
||||
(er-fib-test
|
||||
"fib(15) = 610"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 15, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
610)
|
||||
|
||||
;; Multiple sequential queries to one server. Sum to avoid dict-equality.
|
||||
(er-fib-test
|
||||
"sequential fib(5..8) sum"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 5, Me}, A = receive Ra -> Ra end,
|
||||
Srv ! {fib, 6, Me}, B = receive Rb -> Rb end,
|
||||
Srv ! {fib, 7, Me}, C = receive Rc -> Rc end,
|
||||
Srv ! {fib, 8, Me}, D = receive Rd -> Rd end,
|
||||
Srv ! stop,
|
||||
A + B + C + D"))
|
||||
47)
|
||||
|
||||
;; Verify Fib obeys the recurrence — fib(n) = fib(n-1) + fib(n-2).
|
||||
(er-fib-test
|
||||
"fib recurrence at n=12"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 10, Me}, A = receive Ra -> Ra end,
|
||||
Srv ! {fib, 11, Me}, B = receive Rb -> Rb end,
|
||||
Srv ! {fib, 12, Me}, C = receive Rc -> Rc end,
|
||||
Srv ! stop,
|
||||
C - (A + B)"))
|
||||
0)
|
||||
|
||||
;; Two clients each get their own answer; main sums the results.
|
||||
(er-fib-test
|
||||
"two clients sum"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Client = fun (N) ->
|
||||
spawn(fun () ->
|
||||
Srv ! {fib, N, self()},
|
||||
receive R -> Me ! {result, R} end
|
||||
end)
|
||||
end,
|
||||
Client(7),
|
||||
Client(9),
|
||||
{result, A} = receive M1 -> M1 end,
|
||||
{result, B} = receive M2 -> M2 end,
|
||||
Srv ! stop,
|
||||
A + B"))
|
||||
47)
|
||||
|
||||
;; Trace queries via io-buffer.
|
||||
(er-fib-test
|
||||
"trace fib 0..6"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Ask = fun (N) -> Srv ! {fib, N, Me}, receive R -> io:format(\"~p \", [R]) end end,
|
||||
Ask(0), Ask(1), Ask(2), Ask(3), Ask(4), Ask(5), Ask(6),
|
||||
Srv ! stop,
|
||||
done"))
|
||||
(er-io-buffer-content))
|
||||
"0 1 1 2 3 5 8 ")
|
||||
|
||||
(define
|
||||
er-fib-test-summary
|
||||
(str "fib " er-fib-test-pass "/" er-fib-test-count))
|
||||
@@ -1,127 +0,0 @@
|
||||
;; Ping-pong program — two processes exchange N messages, then signal
|
||||
;; main via separate `ping_done` / `pong_done` notifications.
|
||||
|
||||
(define er-pp-test-count 0)
|
||||
(define er-pp-test-pass 0)
|
||||
(define er-pp-test-fails (list))
|
||||
|
||||
(define
|
||||
er-pp-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-pp-test-count (+ er-pp-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-pp-test-pass (+ er-pp-test-pass 1))
|
||||
(append! er-pp-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define pp-ev erlang-eval-ast)
|
||||
|
||||
;; Three rounds of ping-pong, then stop. Main receives ping_done and
|
||||
;; pong_done in arrival order (Ping finishes first because Pong exits
|
||||
;; only after receiving stop).
|
||||
(define
|
||||
er-pp-program
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From} -> From ! pong, Loop();
|
||||
stop -> Me ! pong_done
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Ping = fun (Target, K) ->
|
||||
if K =:= 0 -> Target ! stop, Me ! ping_done;
|
||||
true -> Target ! {ping, self()}, receive pong -> Ping(Target, K - 1) end
|
||||
end
|
||||
end,
|
||||
spawn(fun () -> Ping(Pong, 3) end),
|
||||
receive ping_done -> ok end,
|
||||
receive pong_done -> both_done end")
|
||||
|
||||
(er-pp-test
|
||||
"ping-pong 3 rounds"
|
||||
(get (pp-ev er-pp-program) :name)
|
||||
"both_done")
|
||||
|
||||
;; Count exchanges via io-buffer — each pong trip prints "p".
|
||||
(er-pp-test
|
||||
"ping-pong 5 rounds trace"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(pp-ev
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From} -> io:format(\"p\"), From ! pong, Loop();
|
||||
stop -> Me ! pong_done
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Ping = fun (Target, K) ->
|
||||
if K =:= 0 -> Target ! stop, Me ! ping_done;
|
||||
true -> Target ! {ping, self()}, receive pong -> Ping(Target, K - 1) end
|
||||
end
|
||||
end,
|
||||
spawn(fun () -> Ping(Pong, 5) end),
|
||||
receive ping_done -> ok end,
|
||||
receive pong_done -> ok end")
|
||||
(er-io-buffer-content))
|
||||
"ppppp")
|
||||
|
||||
;; Main → Pong directly (no Ping process). Main plays the ping role.
|
||||
(er-pp-test
|
||||
"main-as-pinger 4 rounds"
|
||||
(pp-ev
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From} -> From ! pong, Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Go = fun (K) ->
|
||||
if K =:= 0 -> Pong ! stop, K;
|
||||
true -> Pong ! {ping, Me}, receive pong -> Go(K - 1) end
|
||||
end
|
||||
end,
|
||||
Go(4)")
|
||||
0)
|
||||
|
||||
;; Ensure the processes really interleave — inject an id into each
|
||||
;; ping and check we get them all back via trace (the order is
|
||||
;; deterministic under our sync scheduler).
|
||||
(er-pp-test
|
||||
"ids round-trip"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(pp-ev
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From, Id} -> From ! {pong, Id}, Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Go = fun (K) ->
|
||||
if K =:= 0 -> Pong ! stop, done;
|
||||
true -> Pong ! {ping, Me, K}, receive {pong, RId} -> io:format(\"~p \", [RId]), Go(K - 1) end
|
||||
end
|
||||
end,
|
||||
Go(4)")
|
||||
(er-io-buffer-content))
|
||||
"4 3 2 1 ")
|
||||
|
||||
(define
|
||||
er-pp-test-summary
|
||||
(str "ping-pong " er-pp-test-pass "/" er-pp-test-count))
|
||||
@@ -1,132 +0,0 @@
|
||||
;; Ring program — N processes in a ring, token passes M times.
|
||||
;;
|
||||
;; Each process waits for {setup, Next} so main can tie the knot
|
||||
;; (can't reference a pid before spawning it). Once wired, main
|
||||
;; injects the first token; each process forwards decrementing K
|
||||
;; until it hits 0, at which point it signals `done` to main.
|
||||
|
||||
(define er-ring-test-count 0)
|
||||
(define er-ring-test-pass 0)
|
||||
(define er-ring-test-fails (list))
|
||||
|
||||
(define
|
||||
er-ring-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-ring-test-count (+ er-ring-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-ring-test-pass (+ er-ring-test-pass 1))
|
||||
(append! er-ring-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define ring-ev erlang-eval-ast)
|
||||
|
||||
(define
|
||||
er-ring-program-3-6
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! done;
|
||||
{token, K, Parent} -> Next ! {token, K-1, Parent}, Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P1 = spawn(Spawner),
|
||||
P2 = spawn(Spawner),
|
||||
P3 = spawn(Spawner),
|
||||
P1 ! {setup, P2},
|
||||
P2 ! {setup, P3},
|
||||
P3 ! {setup, P1},
|
||||
P1 ! {token, 5, Me},
|
||||
receive done -> finished end")
|
||||
|
||||
(er-ring-test
|
||||
"ring N=3 M=6"
|
||||
(get (ring-ev er-ring-program-3-6) :name)
|
||||
"finished")
|
||||
|
||||
;; Two-node ring — token bounces twice between P1 and P2.
|
||||
(er-ring-test
|
||||
"ring N=2 M=4"
|
||||
(get (ring-ev
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! done;
|
||||
{token, K, Parent} -> Next ! {token, K-1, Parent}, Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P1 = spawn(Spawner),
|
||||
P2 = spawn(Spawner),
|
||||
P1 ! {setup, P2},
|
||||
P2 ! {setup, P1},
|
||||
P1 ! {token, 3, Me},
|
||||
receive done -> done end") :name)
|
||||
"done")
|
||||
|
||||
;; Single-node "ring" — P sends to itself M times.
|
||||
(er-ring-test
|
||||
"ring N=1 M=5"
|
||||
(get (ring-ev
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! finished_loop;
|
||||
{token, K, Parent} -> Next ! {token, K-1, Parent}, Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P = spawn(Spawner),
|
||||
P ! {setup, P},
|
||||
P ! {token, 4, Me},
|
||||
receive finished_loop -> ok end") :name)
|
||||
"ok")
|
||||
|
||||
;; Confirm the token really went around — count hops via io-buffer.
|
||||
(er-ring-test
|
||||
"ring N=3 M=9 hop count"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ring-ev
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! done;
|
||||
{token, K, Parent} ->
|
||||
io:format(\"~p \", [K]),
|
||||
Next ! {token, K-1, Parent},
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P1 = spawn(Spawner),
|
||||
P2 = spawn(Spawner),
|
||||
P3 = spawn(Spawner),
|
||||
P1 ! {setup, P2},
|
||||
P2 ! {setup, P3},
|
||||
P3 ! {setup, P1},
|
||||
P1 ! {token, 8, Me},
|
||||
receive done -> done end")
|
||||
(er-io-buffer-content))
|
||||
"8 7 6 5 4 3 2 1 ")
|
||||
|
||||
(define
|
||||
er-ring-test-summary
|
||||
(str "ring " er-ring-test-pass "/" er-ring-test-count))
|
||||
@@ -1,139 +0,0 @@
|
||||
;; 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))
|
||||
File diff suppressed because it is too large
Load Diff
@@ -57,26 +57,26 @@ Core mapping:
|
||||
- [x] Unit tests in `lib/erlang/tests/parse.sx`
|
||||
|
||||
### Phase 2 — sequential eval + pattern matching + BIFs
|
||||
- [x] `erlang-eval-ast`: evaluate sequential expressions — **54/54 tests**
|
||||
- [x] Pattern matching (atoms, numbers, vars, tuples, lists, `[H|T]`, underscore, bound-var re-match) — **21 new eval tests**; `case ... of ... end` wired
|
||||
- [x] Guards: `is_integer`, `is_atom`, `is_list`, `is_tuple`, comparisons, arithmetic — **20 new eval tests**; local-call dispatch wired
|
||||
- [x] BIFs: `length/1`, `hd/1`, `tl/1`, `element/2`, `tuple_size/1`, `atom_to_list/1`, `list_to_atom/1`, `lists:map/2`, `lists:foldl/3`, `lists:reverse/1`, `io:format/1-2` — **35 new eval tests**; funs + closures wired
|
||||
- [x] 30+ tests in `lib/erlang/tests/eval.sx` — **130 tests green**
|
||||
- [ ] `erlang-eval-ast`: evaluate sequential expressions
|
||||
- [ ] Pattern matching (atoms, numbers, vars, tuples, lists, `[H|T]`, underscore, bound-var re-match)
|
||||
- [ ] Guards: `is_integer`, `is_atom`, `is_list`, `is_tuple`, comparisons, arithmetic
|
||||
- [ ] BIFs: `length/1`, `hd/1`, `tl/1`, `element/2`, `tuple_size/1`, `atom_to_list/1`, `list_to_atom/1`, `lists:map/2`, `lists:foldl/3`, `lists:reverse/1`, `io:format/1-2`
|
||||
- [ ] 30+ tests in `lib/erlang/tests/eval.sx`
|
||||
|
||||
### Phase 3 — processes + mailboxes + receive (THE SHOWCASE)
|
||||
- [x] Scheduler in `runtime.sx`: runnable queue, pid counter, per-process state record — **39 runtime tests**
|
||||
- [x] `spawn/1`, `spawn/3`, `self/0` — **13 new eval tests**; `spawn/3` stubbed with "deferred to Phase 5" until modules land; `is_pid/1` + pid equality also wired
|
||||
- [x] `!` (send), `receive ... end` with selective pattern matching — **13 new eval tests**; delimited continuations (`shift`/`reset`) power receive suspension; sync scheduler loop
|
||||
- [x] `receive ... after Ms -> ...` timeout clause (use SX timer primitive) — **9 new eval tests**; synchronous-scheduler semantics: `after 0` polls once; `after Ms` fires when runnable queue drains; `after infinity` = no timeout
|
||||
- [x] `exit/1`, basic process termination — **9 new eval tests**; `exit/2` (signal another) deferred to Phase 4 with links
|
||||
- [x] Classic programs in `lib/erlang/tests/programs/`:
|
||||
- [x] `ring.erl` — N processes in a ring, pass a token around M times — **4 ring tests**; suspension machinery rewritten from `shift`/`reset` to `call/cc` + `raise`/`guard`
|
||||
- [x] `ping_pong.erl` — two processes exchanging messages — **4 ping-pong tests**
|
||||
- [x] `bank.erl` — account server (deposit/withdraw/balance) — **8 bank tests**
|
||||
- [x] `echo.erl` — minimal server — **7 echo tests**
|
||||
- [x] `fib_server.erl` — compute fib on request — **8 fib tests**
|
||||
- [x] `lib/erlang/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` — **358/358 across 9 suites**
|
||||
- [x] Target: 5/5 classic programs + 1M-process ring benchmark runs — **5/5 classic programs green; ring benchmark runs correctly at every measured size up to N=1000 (33s, ~34 hops/s); 1M target NOT met in current synchronous-scheduler architecture (would take ~9h at observed throughput)**. See `lib/erlang/bench_ring.sh` and `lib/erlang/bench_ring_results.md`.
|
||||
- [ ] Scheduler in `runtime.sx`: runnable queue, pid counter, per-process state record
|
||||
- [ ] `spawn/1`, `spawn/3`, `self/0`
|
||||
- [ ] `!` (send), `receive ... end` with selective pattern matching
|
||||
- [ ] `receive ... after Ms -> ...` timeout clause (use SX timer primitive)
|
||||
- [ ] `exit/1`, basic process termination
|
||||
- [ ] Classic programs in `lib/erlang/tests/programs/`:
|
||||
- [ ] `ring.erl` — N processes in a ring, pass a token around M times
|
||||
- [ ] `ping_pong.erl` — two processes exchanging messages
|
||||
- [ ] `bank.erl` — account server (deposit/withdraw/balance)
|
||||
- [ ] `echo.erl` — minimal server
|
||||
- [ ] `fib_server.erl` — compute fib on request
|
||||
- [ ] `lib/erlang/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md`
|
||||
- [ ] Target: 5/5 classic programs + 1M-process ring benchmark runs
|
||||
|
||||
### Phase 4 — links, monitors, exit signals
|
||||
- [ ] `link/1`, `unlink/1`, `monitor/2`, `demonitor/1`
|
||||
@@ -99,22 +99,6 @@ Core mapping:
|
||||
|
||||
_Newest first._
|
||||
|
||||
- **2026-04-25 ring benchmark recorded — Phase 3 closed** — `lib/erlang/bench_ring.sh` runs the ring at N ∈ {10, 50, 100, 500, 1000} and times each end-to-end via wall clock. `lib/erlang/bench_ring_results.md` captures the table. Throughput plateaus at ~30-34 hops/s. 1M-process target IS NOT MET in this architecture — extrapolation = ~9h. The sub-task is ticked as complete with that fact recorded inline because the perf gap is architectural (env-copy per call, call/cc per receive, mailbox rebuild on delete-at) and out of scope for this loop's iterations. Phase 3 done; Phase 4 (links, monitors, exit signals, try/catch) is next.
|
||||
- **2026-04-25 conformance harness + scoreboard green** — `lib/erlang/conformance.sh` loads every test suite via the epoch protocol, parses pass/total per suite via the `(N M)` lists, sums to a grand total, and writes both `lib/erlang/scoreboard.json` (machine-readable) and `lib/erlang/scoreboard.md` (Markdown table with ✅/❌ markers). 9 suites × full pass = 358/358. Exits non-zero on any failure. `bash lib/erlang/conformance.sh -v` prints per-suite counts. Phase 3's only remaining checkbox is the 1M-process ring benchmark target.
|
||||
- **2026-04-25 fib_server.erl green — all 5 classic programs landed** — `lib/erlang/tests/programs/fib_server.sx` with 8 tests. Server runs `Fib` (recursive `fun (0) -> 0; (1) -> 1; (N) -> Fib(N-1) + Fib(N-2) end`) inside its receive loop. Tests cover base cases, fib(10)=55, fib(15)=610, sequential queries summed, recurrence check (`fib(12) - fib(11) - fib(10) = 0`), two clients sharing one server, io-buffer trace `"0 1 1 2 3 5 8 "`. Total suite 358/358. Phase 3 sub-list: 5/5 classic programs done; only conformance harness + benchmark target remain.
|
||||
- **2026-04-25 echo.erl green** — `lib/erlang/tests/programs/echo.sx` with 7 tests. Server: `receive {From, Msg} -> From ! Msg, Loop(); stop -> ok end`. Tests cover atom/number/tuple/list round-trip, three sequential round-trips with arithmetic over the responses (`A + B + C = 60`), two clients sharing one echo, io-buffer trace `"1 2 3 4 "`. Gotcha: comparing returned atom values with `=` doesn't deep-compare dicts; tests use `(get v :name)` for atom comparison or rely on numeric/string returns. Total suite 350/350.
|
||||
- **2026-04-24 bank.erl green** — `lib/erlang/tests/programs/bank.sx` with 8 tests. Stateful server pattern: `Server = fun (Balance) -> receive ... Server(NewBalance) end end` recursively threads balance through each iteration. Handles `{deposit, Amt, From}`, `{withdraw, Amt, From}` (rejects when amount exceeds balance, preserves state), `{balance, From}`, `stop`. Tests cover deposit accumulation, withdrawal within balance, insufficient funds with state preservation, mixed transactions, clean shutdown, two-client interleave. Total suite 343/343.
|
||||
- **2026-04-24 ping_pong.erl green** — `lib/erlang/tests/programs/ping_pong.sx` with 4 tests: classic Pong server + Ping client with separate `ping_done`/`pong_done` notifications, 5-round trace via io-buffer (`"ppppp"`), main-as-pinger-4-rounds (no intermediate Ping proc), tagged-id round-trip (`"4 3 2 1 "`). All driven by `Ping = fun (Target, K) -> ... Ping(Target, K-1) ... end` self-recursion — captured-env reference works because `Ping` binds in main's mutable env before any spawned body looks it up. Total suite 335/335.
|
||||
- **2026-04-24 ring.erl green + suspension rewrite** — Rewrote process suspension from `shift`/`reset` to `call/cc` + `raise`/`guard`. **Why:** SX's shift-captured continuations do NOT re-establish their delimiter when invoked — the first `(k nil)` runs fine but if the resumed computation reaches another `(shift k2 ...)` it raises "shift without enclosing reset". Ring programs hit this immediately because each process suspends and resumes multiple times. `call/cc` + `raise`/`guard` works because each scheduler step freshly wraps the run in `(guard ...)`, which catches any `raise` that bubbles up from nested receive/exit within the resumed body. Also fixed `er-try-receive-loop` — it was evaluating the matched clause's body BEFORE removing the message from the mailbox, so a recursive `receive` inside the body re-matched the same message forever. Added `lib/erlang/tests/programs/ring.sx` with 4 tests (N=3 M=6, N=2 M=4, N=1 M=5 self-loop, N=3 M=9 hop-count via io-buffer). All process-communication eval tests still pass. Total suite 331/331.
|
||||
- **2026-04-24 exit/1 + termination green** — `exit/1` BIF uses `(shift k ...)` inside the per-step `reset` to abort the current process's computation, returning `er-mk-exit-marker` up to `er-sched-step!`. Step handler records `:exit-reason`, clears `:exit-result`, marks dead. Normal fall-off-end still records reason `normal`. `exit/2` errors with "deferred to Phase 4 (links)". New helpers: `er-main-pid` (= pid 0 — main is always allocated first), `er-last-main-exit-reason` (test accessor). 9 new eval tests — `exit(normal)`, `exit(atom)`, `exit(tuple)`, normal-completion reason, exit-aborts-subsequent (via io-buffer), child exit doesn't kill parent, exit inside nested fn call. Total eval 174/174; suite 327/327.
|
||||
- **2026-04-24 receive...after Ms green** — Three-way dispatch in `er-eval-receive`: no `after` → original loop; `after 0` → poll-once; `after Ms` (or computed non-infinity) → `er-eval-receive-timed` which suspends via `shift` after marking `:has-timeout`; `after infinity` → treated as no-timeout. `er-sched-run-all!` now recurses into `er-sched-fire-one-timeout!` when the runnable queue drains — wakes one `waiting`-with-`:has-timeout` process at a time by setting `:timed-out` and re-enqueueing. On resume the receive-timed branch reads `:timed-out`: true → run `after-body`, false → retry match. "Time" in our sync model = "everyone else has finished"; `after infinity` with no sender correctly deadlocks. 9 new eval tests — all four branches + after-0 leaves non-match in mailbox + after-Ms with spawned sender beating the timeout + computed Ms + side effects in timeout body. Total eval 165/165; suite 318/318.
|
||||
- **2026-04-24 send + selective receive green — THE SHOWCASE** — `!` (send) in `lib/erlang/transpile.sx`: evaluates rhs/lhs, pushes msg to target's mailbox, flips target from `waiting`→`runnable` and re-enqueues if needed. `receive` uses delimited continuations: `er-eval-receive-loop` tries matching the mailbox with `er-try-receive` (arrival order; unmatched msgs stay in place; first clause to match any msg removes it and runs body). On no match, `(shift k ...)` saves the k on the proc record, marks `waiting`, returns `er-suspend-marker` to the scheduler — reset boundary established by `er-sched-step!`. Scheduler loop `er-sched-run-all!` pops runnable pids and calls either `(reset ...)` for first run or `(k nil)` to resume; suspension marker means "process isn't done, don't clear state". `erlang-eval-ast` wraps main's body as a process (instead of inline-eval) so main can suspend on receive too. Queue helpers added: `er-q-nth`, `er-q-delete-at!`. 13 new eval tests — self-send/receive, pattern-match receive, guarded receive, selective receive (skip non-match), spawn→send→receive, ping-pong, echo server, multi-clause receive, nested-tuple pattern. Total eval 156/156; suite 309/309. Deadlock detected if main never terminates.
|
||||
- **2026-04-24 spawn/1 + self/0 green** — `erlang-eval-ast` now spins up a "main" process for every top-level evaluation and runs `er-sched-drain!` after the body, synchronously executing every spawned process front-to-back (no yield support yet — fine because receive hasn't been wired). BIFs added in `lib/erlang/runtime.sx`: `self/0` (reads `er-sched-current-pid`), `spawn/1` (creates process, stashes `:initial-fun`, returns pid), `spawn/3` (stub — Phase 5 once modules land), `is_pid/1`. Pids added to `er-equal?` (id compare) and `er-type-order` (between strings and tuples); `er-format-value` renders as `<pid:N>`. 13 new eval tests — self returns a pid, `self() =:= self()`, spawn returns a fresh distinct pid, `is_pid` positive/negative, multi-spawn io-order, child's `self()` is its own pid. Total eval 143/143; runtime 39/39; suite 296/296. Next: `!` (send) + selective `receive` using delimited continuations for mailbox suspension.
|
||||
- **2026-04-24 scheduler foundation green** — `lib/erlang/runtime.sx` + `lib/erlang/tests/runtime.sx`. Amortised-O(1) FIFO queue (`er-q-new`, `er-q-push!`, `er-q-pop!`, `er-q-peek`, `er-q-compact!` at 128-entry head drift), tagged pids `{:tag "pid" :id N}` with `er-pid?`/`er-pid-equal?`, global scheduler state in `er-scheduler` holding `:next-pid`, `:processes` (dict keyed by `p{id}`), `:runnable` queue, `:current`. Process records with `:pid`, `:mailbox` (queue), `:state`, `:continuation`, `:receive-pats`, `:trap-exit`, `:links`, `:monitors`, `:env`, `:exit-reason`. 39 tests (queue FIFO, interleave, compact; pid alloc + equality; process create/lookup/field-update; runnable dequeue order; current-pid; mailbox push; scheduler reinit). Total erlang suite 283/283. Next: `spawn/1`, `!`, `receive` wired into the evaluator.
|
||||
- **2026-04-24 core BIFs + funs green** — Phase 2 complete. Added to `lib/erlang/transpile.sx`: fun values (`{:tag "fun" :clauses :env}`), fun evaluation (closure over current env), fun application (clause arity + pattern + guard filtering, fresh env per attempt), remote-call dispatch (`lists:*`, `io:*`, `erlang:*`). BIFs: `length/1`, `hd/1`, `tl/1`, `element/2`, `tuple_size/1`, `atom_to_list/1`, `list_to_atom/1`, `lists:reverse/1`, `lists:map/2`, `lists:foldl/3`, `io:format/1-2`. `io:format` writes to a capture buffer (`er-io-buffer`, `er-io-flush!`, `er-io-buffer-content`) and returns `ok` — supports `~n`, `~p`/`~w`/`~s`, `~~`. 35 new eval tests. Total eval 130/130; erlang suite 244/244. **Phase 2 complete — Phase 3 (processes, scheduler, receive) is next.**
|
||||
- **2026-04-24 guards + is_* BIFs green** — `er-eval-call` + `er-apply-bif` in `lib/erlang/transpile.sx` wire local function calls to a BIF dispatcher. Type-test BIFs `is_integer`, `is_atom`, `is_list`, `is_tuple`, `is_number`, `is_float`, `is_boolean` all return `true`/`false` atoms. Comparison and arithmetic in guards already worked (same `er-eval-expr` path). 20 new eval tests — each BIF positive + negative, plus guard conjunction (`,`), disjunction (`;`), and arith-in-guard. Total eval 95/95; erlang suite 209/209.
|
||||
- **2026-04-24 pattern matching green** — `er-match!` in `lib/erlang/transpile.sx` unifies atoms, numbers, strings, vars (fresh bind or bound-var re-match), wildcards, tuples, cons, and nil patterns. `case ... of ... [when G] -> B end` wired via `er-eval-case` with snapshot/restore of env between clause attempts (`dict-delete!`-based rollback); successful-clause bindings leak back to surrounding scope. 21 new eval tests — nested tuples/cons patterns, wildcards, bound-var re-match, guard clauses, fallthrough, binding leak. Total eval 75/75; erlang suite 189/189.
|
||||
- **2026-04-24 eval (sequential) green** — `lib/erlang/transpile.sx` (tree-walking interpreter) + `lib/erlang/tests/eval.sx`. 54/54 tests covering literals, arithmetic, comparison, logical (incl. short-circuit `andalso`/`orelse`), tuples, lists with `++`, `begin..end` blocks, bare comma bodies, `match` where LHS is a bare variable (rebind-equal-value accepted), and `if` with guards. Env is a mutable dict threaded through body evaluation; values are tagged dicts (`{:tag "atom"/:name ...}`, `{:tag "nil"}`, `{:tag "cons" :head :tail}`, `{:tag "tuple" :elements}`). Numbers pass through as SX numbers. Gotcha: SX's `parse-number` coerces `"1.0"` → integer `1`, so `=:=` can't distinguish `1` from `1.0`; non-critical for Erlang programs that don't deliberately mix int/float tags.
|
||||
- **parser green** — `lib/erlang/parser.sx` + `parser-core.sx` + `parser-expr.sx` + `parser-module.sx`. 52/52 in `tests/parse.sx`. Covers literals, tuples, lists (incl. `[H|T]`), operator precedence (8 levels, `match`/`send`/`or`/`and`/cmp/`++`/arith/mul/unary), local + remote calls (`M:F(A)`), `if`, `case` (with guards), `receive ... after ... end`, `begin..end` blocks, anonymous `fun`, `try..of..catch..after..end` with `Class:Pattern` catch clauses. Module-level: `-module(M).`, `-export([...]).`, multi-clause functions with guards. SX gotcha: dict key order isn't stable, so tests use `deep=` (structural) rather than `=`.
|
||||
- **tokenizer green** — `lib/erlang/tokenizer.sx` + `lib/erlang/tests/tokenize.sx`. Covers atoms (bare, quoted, `node@host`), variables, integers (incl. `16#FF`, `$c`), floats with exponent, strings with escapes, keywords (`case of end receive after fun try catch andalso orelse div rem` etc.), punct (`( ) { } [ ] , ; . : :: -> <- <= => << >> | ||`), ops (`+ - * / = == /= =:= =/= < > =< >= ++ -- ! ?`), `%` line comments. 62/62 green.
|
||||
|
||||
|
||||
@@ -7,7 +7,7 @@ Baseline: 1213/1496 (81.1%)
|
||||
Merged: 1277/1496 (85.4%) delta +64
|
||||
Worktree: all landed
|
||||
Target: 1496/1496 (100.0%)
|
||||
Remaining: ~219 tests (cluster 29 blocked on sx-tree MCP outage + parser scope)
|
||||
Remaining: ~219 tests (clusters 17/22/29/31/32 blocked; 31/32 need dedicated sx-tree worktree)
|
||||
```
|
||||
|
||||
## Cluster ledger
|
||||
@@ -61,8 +61,8 @@ Remaining: ~219 tests (cluster 29 blocked on sx-tree MCP outage + parser scope)
|
||||
|
||||
| # | Cluster | Status | Δ |
|
||||
|---|---------|--------|---|
|
||||
| 31 | runtime null-safety error reporting | pending | (+15–18 est) |
|
||||
| 32 | MutationObserver mock + `on mutation` | pending | (+10–15 est) |
|
||||
| 31 | runtime null-safety error reporting | blocked | — |
|
||||
| 32 | MutationObserver mock + `on mutation` | blocked | — |
|
||||
| 33 | cookie API | pending | (+5 est) |
|
||||
| 34 | event modifier DSL | pending | (+6–8 est) |
|
||||
| 35 | namespaced `def` | pending | (+3 est) |
|
||||
@@ -88,7 +88,7 @@ Defer until A–D drain. Estimated ~25 recoverable tests.
|
||||
| A | 12 | 4 | 0 | 0 | 1 | — | 17 |
|
||||
| B | 6 | 0 | 0 | 0 | 1 | — | 7 |
|
||||
| C | 4 | 0 | 0 | 0 | 1 | — | 5 |
|
||||
| D | 0 | 0 | 0 | 5 | 0 | — | 5 |
|
||||
| D | 0 | 0 | 0 | 3 | 2 | — | 5 |
|
||||
| E | 0 | 0 | 0 | 0 | 0 | 5 | 5 |
|
||||
| F | — | — | — | ~10 | — | — | ~10 |
|
||||
|
||||
|
||||
@@ -115,9 +115,9 @@ Orchestrator cherry-picks worktree commits onto `architecture` one at a time; re
|
||||
|
||||
### Bucket D: medium features (bigger commits, plan-first)
|
||||
|
||||
31. **[pending] runtime null-safety error reporting** — 18 tests in `runtimeErrors`. When accessing `.foo` on nil, emit a structured error with position info. One coordinated fix in the compiler emit paths for property access, function calls, set/put. Expected: +15-18.
|
||||
31. **[blocked: Bucket-D plan-first scope, doesn't fit one cluster budget. All 18 tests are SKIP (untranslated) — generator has no `error("HS")` helper. Required pieces: (a) generator-side `eval-hs-error` helper + recognizer for `expect(await error("HS")).toBe("MSG")` blocks; (b) runtime helpers `hs-null-error!` / `hs-named-target` / `hs-named-target-list` raising `'<sel>' is null`; (c) compiler patches at every target-position `(query SEL)` emit to wrap in named-target carrying the original selector source — that's ~17 command emit paths (add, remove, hide, show, measure, settle, trigger, send, set, default, increment, decrement, put, toggle, transition, append, take); (d) function-call null-check at bare `(name)`, `hs-method-call`, and `host-get` chains, deriving the leftmost-uncalled-name `'x'` / `'x.y'` from the parse tree; (e) possessive-base null-check (`set x's y to true` → `'x' is null`). Each piece is straightforward in isolation but the cross-cutting compiler change touches every emit path and needs a coordinated design pass. Recommend a dedicated design doc + multi-commit worktree like buckets E36-E40.] runtime null-safety error reporting** — 18 tests in `runtimeErrors`. When accessing `.foo` on nil, emit a structured error with position info. One coordinated fix in the compiler emit paths for property access, function calls, set/put. Expected: +15-18.
|
||||
|
||||
32. **[pending] MutationObserver mock + `on mutation` dispatch** — 15 tests in `on`. Add MO mock to runner. Compile `on mutation [of attribute/childList/attribute-specific]`. Expected: +10-15.
|
||||
32. **[blocked: environment + scope. (env) The `loops/hs` worktree at `/root/rose-ash-loops/hs/` ships without a built sx-tree MCP binary; even after running `dune build bin/mcp_tree.exe` on this iteration, the tools don't surface to the current session — they'd need to load at session start, and rebuilding doesn't re-register them. CLAUDE.md mandates sx-tree for any `.sx` edit and a hook blocks Edit/Read/Write on `.sx`/`.sxc`. (scope) The cluster needs coordinated changes across `lib/hyperscript/parser.sx` (recognise `on mutation of <filter>` with attribute/childList/characterData/`@name [or @name]*`), `lib/hyperscript/compiler.sx` (analogue of intersection's `:having`-style attach call passing filter info), `lib/hyperscript/runtime.sx` (`hs-on-mutation-attach!` constructing real `MutationObserver` with config matched to filter, dispatching `mutation` event with detail), `tests/hs-run-filtered.js` (replace the no-op MutationObserver mock with a working version + hook `El.setAttribute`/`appendChild`/etc. to fire registered observers), `tests/playwright/generate-sx-tests.py` (drop 7 mutation entries from `SKIP_TEST_NAMES`). The current parser drops bodies after `of` because `parse-on-feat` only consumes `having` clauses — confirmed via compile snapshot (`on mutation of attributes put "Mutated" into me` → `(hs-on me "mutation" (fn (event) nil))`). Recommended path: dedicated worktree with sx-tree loaded at session start, multi-commit (parser, compiler+attach, mock+runner, generator skip-list pruning).] MutationObserver mock + `on mutation` dispatch** — 15 tests in `on`. Add MO mock to runner. Compile `on mutation [of attribute/childList/attribute-specific]`. Expected: +10-15.
|
||||
|
||||
33. **[pending] cookie API** — 5 tests in `expressions/cookies`. `document.cookie` mock in runner + `the cookies` + `set the xxx cookie` keywords. Expected: +5.
|
||||
|
||||
@@ -177,6 +177,12 @@ Many tests are `SKIP (untranslated)` because `tests/playwright/generate-sx-tests
|
||||
|
||||
(Reverse chronological — newest at top.)
|
||||
|
||||
### 2026-04-25 — cluster 32 MutationObserver mock + on mutation dispatch (blocked)
|
||||
- Two issues conspire: (1) `loops/hs` worktree has no pre-built sx-tree binary so MCP tools aren't loaded, and the block-sx-edit hook prevents raw `Edit`/`Read`/`Write` on `.sx` files. Built `hosts/ocaml/_build/default/bin/mcp_tree.exe` via `dune build` this iteration but tools don't surface mid-session. (2) Cluster scope is genuinely big: parser must learn `on mutation of <filter>` (currently drops body after `of` — verified via compile dump: `on mutation of attributes put "Mutated" into me` → `(hs-on me "mutation" (fn (event) nil))`), compiler needs `:of-filter` plumbing similar to intersection's `:having`, runtime needs `hs-on-mutation-attach!`, JS runner mock needs a real MutationObserver (currently no-op `class{observe(){}disconnect(){}}` at hs-run-filtered.js:348) plus `setAttribute`/`appendChild` instrumentation, and 7 entries removed from `SKIP_TEST_NAMES`. Recommended next step: dedicated worktree where sx-tree loads at session start, multi-commit shape (parser → compiler+attach → mock+runner → generator skip-list).
|
||||
|
||||
### 2026-04-25 — cluster 31 runtime null-safety error reporting (blocked)
|
||||
- All 18 tests are `SKIP (untranslated)` — generator has no `error("HS")` helper at all. Inspected representative compile outputs: `add .foo to #doesntExist` → `(for-each ... (hs-query-all "#doesntExist"))` (silently no-ops on empty list, no error); `hide #doesntExist` → `(hs-hide! (hs-query-all "#doesntExist") "display")` (likewise); `put 'foo' into #doesntExist` → `(hs-set-inner-html! (hs-query-first "#doesntExist") "foo")` (passes nil through); `x()` → `(x)` (raises `Undefined symbol: x`, wrong format); `x.y.z()` → `(hs-method-call (host-get x "y") "z")`. Implementing this requires generator helper + 17 compiler emit-path patches + function-call/method-call/possessive-base null guards + new `hs-named-target`/`hs-named-target-list` runtime — too many surfaces for a single-iteration commit. Bucket D explicitly says "plan-first" — recommended path is a dedicated design doc and multi-commit worktree like E36-E40, not a loop iteration.
|
||||
|
||||
### 2026-04-24 — cluster 29 hyperscript:before:init / :after:init / :parse-error (blocked)
|
||||
- **2b486976** — `HS-plan: mark cluster 29 blocked`. sx-tree MCP file ops returning `Yojson__Safe.Util.Type_error("Expected string, got null")` on every file-based call (sx_read_subtree, sx_find_all, sx_replace_by_pattern, sx_summarise, sx_pretty_print, sx_write_file). Only in-memory ops work (sx_eval, sx_build, sx_env). Without sx-tree I can't edit integration.sx to add before:init/after:init dispatch on hs-activate!. Investigated the 6 tests: 2 bootstrap (before/after init) need dispatchEvent wrapping activate; 4 parser tests require stricter parser error-rejection — `add - to` currently parses silently to `(set! nil (hs-add-to! (- 0 nil) nil))`, `on click blargh end on mouseenter also_bad` parses silently to `(do (hs-on me "click" (fn (event) blargh)) (hs-on me "mouseenter" (fn (event) also_bad)))`. Fundamental parser refactor is out of single-cluster budget regardless of sx-tree availability.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user