Merge loops/erlang into architecture — 530/530 tests, all phases complete

This commit is contained in:
2026-05-05 10:42:07 +00:00
16 changed files with 5541 additions and 234 deletions

86
lib/erlang/bench_ring.sh Executable file
View File

@@ -0,0 +1,86 @@
#!/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."

View File

@@ -0,0 +1,35 @@
# 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.

153
lib/erlang/conformance.sh Executable file
View File

@@ -0,0 +1,153 @@
#!/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

View File

@@ -237,6 +237,8 @@
(er-parse-fun-expr st)
(er-is? st "keyword" "try")
(er-parse-try st)
(er-is? st "punct" "<<")
(er-parse-binary st)
:else (error
(str
"Erlang parse: unexpected "
@@ -281,12 +283,56 @@
(fn
(st)
(er-expect! st "punct" "[")
(if
(cond
(er-is? st "punct" "]")
(do (er-advance! st) {:type "nil"})
(let
((elems (list (er-parse-expr-prec st 0))))
(er-parse-list-tail st elems)))))
:else (let
((first (er-parse-expr-prec st 0)))
(cond
(er-is? st "punct" "||") (er-parse-list-comp st first)
:else (er-parse-list-tail st (list first)))))))
(define
er-parse-list-comp
(fn
(st head)
(er-advance! st)
(let
((quals (list (er-parse-lc-qualifier st))))
(er-parse-list-comp-tail st head quals))))
(define
er-parse-list-comp-tail
(fn
(st head quals)
(cond
(er-is? st "punct" ",")
(do
(er-advance! st)
(append! quals (er-parse-lc-qualifier st))
(er-parse-list-comp-tail st head quals))
(er-is? st "punct" "]")
(do (er-advance! st) {:head head :qualifiers quals :type "lc"})
:else (error
(str
"Erlang parse: expected ',' or ']' in list comprehension, got '"
(er-cur-value st)
"'")))))
(define
er-parse-lc-qualifier
(fn
(st)
(let
((e (er-parse-expr-prec st 0)))
(cond
(er-is? st "punct" "<-")
(do
(er-advance! st)
(let
((source (er-parse-expr-prec st 0)))
{:kind "gen" :pattern e :source source}))
:else {:kind "filter" :expr e}))))
(define
er-parse-list-tail
@@ -532,3 +578,63 @@
((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
(er-expect! st "punct" "->")
(let ((body (er-parse-body st))) {:pattern pat :body body :class klass :guards guards}))))))
;; ── binary literals / patterns ────────────────────────────────
;; `<< [Seg {, Seg}] >>` where Seg = Value [: Size] [/ Spec]. Size is
;; a literal integer (multiple of 8 supported); Spec is `integer`
;; (default) or `binary` (rest-of-binary tail). Sufficient for the
;; common `<<A:8, B:16, Rest/binary>>` patterns.
(define
er-parse-binary
(fn
(st)
(er-expect! st "punct" "<<")
(cond
(er-is? st "punct" ">>")
(do (er-advance! st) {:segments (list) :type "binary"})
:else (let
((segs (list (er-parse-binary-segment st))))
(er-parse-binary-tail st segs)))))
(define
er-parse-binary-tail
(fn
(st segs)
(cond
(er-is? st "punct" ",")
(do
(er-advance! st)
(append! segs (er-parse-binary-segment st))
(er-parse-binary-tail st segs))
(er-is? st "punct" ">>")
(do (er-advance! st) {:segments segs :type "binary"})
:else (error
(str
"Erlang parse: expected ',' or '>>' in binary, got '"
(er-cur-value st)
"'")))))
(define
er-parse-binary-segment
(fn
(st)
;; Use `er-parse-primary` for the value so a leading `:` falls
;; through to the segment's size suffix instead of being eaten
;; by `er-parse-postfix-loop` as a `Mod:Fun` remote call.
(let
((v (er-parse-primary st)))
(let
((size (cond
(er-is? st "punct" ":")
(do (er-advance! st) (er-parse-primary st))
:else nil))
(spec (cond
(er-is? st "op" "/")
(do
(er-advance! st)
(let
((tok (er-cur st)))
(er-advance! st)
(get tok :value)))
:else "integer")))
{:size size :spec spec :value v}))))

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,16 @@
{
"language": "erlang",
"total_pass": 530,
"total": 530,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
{"name":"eval","pass":346,"total":346,"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"}
]
}

18
lib/erlang/scoreboard.md Normal file
View File

@@ -0,0 +1,18 @@
# Erlang-on-SX Scoreboard
**Total: 530 / 530 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
| ✅ | tokenize | 62 | 62 |
| ✅ | parse | 52 | 52 |
| ✅ | eval | 346 | 346 |
| ✅ | 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`.

1130
lib/erlang/tests/eval.sx Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,159 @@
;; 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))

View File

@@ -0,0 +1,140 @@
;; 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))

View File

@@ -0,0 +1,152 @@
;; 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))

View File

@@ -0,0 +1,127 @@
;; 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))

View File

@@ -0,0 +1,132 @@
;; 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))

139
lib/erlang/tests/runtime.sx Normal file
View File

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

1913
lib/erlang/transpile.sx Normal file

File diff suppressed because it is too large Load Diff