fed-sx-m1: Step 5a — pure-functional registry (new/register/lookup/list) + 14 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
This commit is contained in:
69
next/kernel/registry.erl
Normal file
69
next/kernel/registry.erl
Normal file
@@ -0,0 +1,69 @@
|
|||||||
|
-module(registry).
|
||||||
|
-export([new/0, kinds/0, register/4, lookup/3, list/2]).
|
||||||
|
|
||||||
|
%% Pure-functional registry for the seven bootstrap kinds.
|
||||||
|
%%
|
||||||
|
%% State is a property list keyed by kind atom; each kind's value
|
||||||
|
%% is itself a property list of {Name, Entry} pairs. Entry is
|
||||||
|
%% opaque — typically a proplist with :cid, :schema, :semantics,
|
||||||
|
%% :supersedes fields, but the registry doesn't enforce that here.
|
||||||
|
%%
|
||||||
|
%% A gen_server wrapper (Step 5b) will own the global registry
|
||||||
|
%% process; the pure functions in this module remain the canonical
|
||||||
|
%% API and are usable for tests and for offline projection-replay.
|
||||||
|
%%
|
||||||
|
%% Return shapes:
|
||||||
|
%% new/0 -> State
|
||||||
|
%% kinds/0 -> [Atom, ...]
|
||||||
|
%% register/4 -> {ok, NewState} | {error, unknown_kind}
|
||||||
|
%% lookup/3 -> {ok, Entry} | not_found | {error, unknown_kind}
|
||||||
|
%% list/2 -> [{Name, Entry}, ...] | {error, unknown_kind}
|
||||||
|
|
||||||
|
new() -> [].
|
||||||
|
|
||||||
|
kinds() ->
|
||||||
|
[activity_types, object_types, projections,
|
||||||
|
validators, codecs, sig_suites, audience].
|
||||||
|
|
||||||
|
register(Kind, Name, Entry, State) ->
|
||||||
|
case is_valid_kind(Kind) of
|
||||||
|
false -> {error, unknown_kind};
|
||||||
|
true ->
|
||||||
|
Entries = kind_entries(Kind, State),
|
||||||
|
Updated = put_pair(Name, Entry, Entries),
|
||||||
|
{ok, set_kind_entries(Kind, Updated, State)}
|
||||||
|
end.
|
||||||
|
|
||||||
|
lookup(Kind, Name, State) ->
|
||||||
|
case is_valid_kind(Kind) of
|
||||||
|
false -> {error, unknown_kind};
|
||||||
|
true ->
|
||||||
|
find_pair(Name, kind_entries(Kind, State))
|
||||||
|
end.
|
||||||
|
|
||||||
|
list(Kind, State) ->
|
||||||
|
case is_valid_kind(Kind) of
|
||||||
|
false -> {error, unknown_kind};
|
||||||
|
true -> kind_entries(Kind, State)
|
||||||
|
end.
|
||||||
|
|
||||||
|
%% ── Internal ────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
is_valid_kind(K) -> lists:member(K, kinds()).
|
||||||
|
|
||||||
|
kind_entries(Kind, State) ->
|
||||||
|
case find_pair(Kind, State) of
|
||||||
|
not_found -> [];
|
||||||
|
{ok, V} -> V
|
||||||
|
end.
|
||||||
|
|
||||||
|
set_kind_entries(Kind, Entries, State) ->
|
||||||
|
put_pair(Kind, Entries, State).
|
||||||
|
|
||||||
|
put_pair(K, V, []) -> [{K, V}];
|
||||||
|
put_pair(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
|
||||||
|
put_pair(K, V, [P | Rest]) -> [P | put_pair(K, V, Rest)].
|
||||||
|
|
||||||
|
find_pair(_, []) -> not_found;
|
||||||
|
find_pair(K, [{K, V} | _]) -> {ok, V};
|
||||||
|
find_pair(K, [_ | Rest]) -> find_pair(K, Rest).
|
||||||
135
next/tests/registry_pure.sh
Executable file
135
next/tests/registry_pure.sh
Executable file
@@ -0,0 +1,135 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
# next/tests/registry_pure.sh — Step 5a acceptance test.
|
||||||
|
#
|
||||||
|
# Exercises the pure-functional registry API: new/0, kinds/0,
|
||||||
|
# register/4, lookup/3, list/2. State threading is verified
|
||||||
|
# by chaining register calls and inspecting the final state.
|
||||||
|
# 13 cases.
|
||||||
|
|
||||||
|
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:-}"
|
||||||
|
PASS=0; FAIL=0; ERRORS=""
|
||||||
|
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
||||||
|
|
||||||
|
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/vm/dispatcher.sx")
|
||||||
|
|
||||||
|
(epoch 2)
|
||||||
|
(eval "(get (erlang-load-module (file-read \"next/kernel/registry.erl\")) :name)")
|
||||||
|
|
||||||
|
;; new/0 returns []
|
||||||
|
(epoch 10)
|
||||||
|
(eval "(get (erlang-eval-ast \"registry:new() =:= []\") :name)")
|
||||||
|
|
||||||
|
;; kinds/0 has 7 entries
|
||||||
|
(epoch 11)
|
||||||
|
(eval "(erlang-eval-ast \"length(registry:kinds())\")")
|
||||||
|
|
||||||
|
;; kinds/0 includes activity_types
|
||||||
|
(epoch 12)
|
||||||
|
(eval "(get (erlang-eval-ast \"lists:member(activity_types, registry:kinds())\") :name)")
|
||||||
|
|
||||||
|
;; register + lookup round-trip
|
||||||
|
(epoch 13)
|
||||||
|
(eval "(get (erlang-eval-ast \"{ok, S} = registry:register(activity_types, create, [{cid, c1}], registry:new()), registry:lookup(activity_types, create, S) =:= {ok, [{cid, c1}]}\") :name)")
|
||||||
|
|
||||||
|
;; lookup on empty registry returns not_found
|
||||||
|
(epoch 14)
|
||||||
|
(eval "(get (erlang-eval-ast \"registry:lookup(activity_types, anything, registry:new()) =:= not_found\") :name)")
|
||||||
|
|
||||||
|
;; lookup on unknown kind returns {error, unknown_kind}
|
||||||
|
(epoch 15)
|
||||||
|
(eval "(get (erlang-eval-ast \"case registry:lookup(bogus_kind, foo, registry:new()) of {error, unknown_kind} -> ok; _ -> bad end\") :name)")
|
||||||
|
|
||||||
|
;; register on unknown kind returns {error, unknown_kind}
|
||||||
|
(epoch 16)
|
||||||
|
(eval "(get (erlang-eval-ast \"case registry:register(bogus_kind, foo, bar, registry:new()) of {error, unknown_kind} -> ok; _ -> bad end\") :name)")
|
||||||
|
|
||||||
|
;; list of empty kind returns []
|
||||||
|
(epoch 17)
|
||||||
|
(eval "(get (erlang-eval-ast \"registry:list(activity_types, registry:new()) =:= []\") :name)")
|
||||||
|
|
||||||
|
;; Three registers + list returns 3 pairs
|
||||||
|
(epoch 18)
|
||||||
|
(eval "(erlang-eval-ast \"{ok, S1} = registry:register(activity_types, create, e1, registry:new()), {ok, S2} = registry:register(activity_types, update, e2, S1), {ok, S3} = registry:register(activity_types, delete, e3, S2), length(registry:list(activity_types, S3))\")")
|
||||||
|
|
||||||
|
;; Re-registering same name overrides previous entry
|
||||||
|
(epoch 19)
|
||||||
|
(eval "(get (erlang-eval-ast \"{ok, S1} = registry:register(activity_types, create, v1, registry:new()), {ok, S2} = registry:register(activity_types, create, v2, S1), registry:lookup(activity_types, create, S2) =:= {ok, v2}\") :name)")
|
||||||
|
|
||||||
|
;; Re-registering same name keeps list length at 1
|
||||||
|
(epoch 20)
|
||||||
|
(eval "(erlang-eval-ast \"{ok, S1} = registry:register(activity_types, create, v1, registry:new()), {ok, S2} = registry:register(activity_types, create, v2, S1), length(registry:list(activity_types, S2))\")")
|
||||||
|
|
||||||
|
;; Different kinds are independent
|
||||||
|
(epoch 21)
|
||||||
|
(eval "(erlang-eval-ast \"{ok, S1} = registry:register(activity_types, x, 1, registry:new()), {ok, S2} = registry:register(object_types, x, 2, S1), {registry:lookup(activity_types, x, S2), registry:lookup(object_types, x, S2)} =:= {{ok, 1}, {ok, 2}}\")")
|
||||||
|
|
||||||
|
;; list on unknown kind returns {error, unknown_kind}
|
||||||
|
(epoch 22)
|
||||||
|
(eval "(get (erlang-eval-ast \"case registry:list(bogus_kind, registry:new()) of {error, unknown_kind} -> ok; _ -> bad end\") :name)")
|
||||||
|
EPOCHS
|
||||||
|
|
||||||
|
OUTPUT=$(timeout 120 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||||
|
|
||||||
|
check() {
|
||||||
|
local epoch="$1" desc="$2" expected="$3"
|
||||||
|
local actual
|
||||||
|
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
|
||||||
|
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
|
||||||
|
$0 ~ "^\\(ok " e " " { print; exit }
|
||||||
|
$0 ~ "^\\(error " e " " { print; exit }
|
||||||
|
')
|
||||||
|
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
|
||||||
|
if echo "$actual" | grep -qF -- "$expected"; then
|
||||||
|
PASS=$((PASS+1))
|
||||||
|
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
|
||||||
|
else
|
||||||
|
FAIL=$((FAIL+1))
|
||||||
|
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
|
||||||
|
"
|
||||||
|
fi
|
||||||
|
}
|
||||||
|
|
||||||
|
check 2 "module load name" "registry"
|
||||||
|
check 10 "new/0 returns []" "true"
|
||||||
|
check 11 "kinds/0 length" "7"
|
||||||
|
check 12 "kinds/0 includes activity_types" "true"
|
||||||
|
check 13 "register + lookup round-trip" "true"
|
||||||
|
check 14 "lookup empty -> not_found" "true"
|
||||||
|
check 15 "lookup bogus kind" "ok"
|
||||||
|
check 16 "register bogus kind" "ok"
|
||||||
|
check 17 "list empty kind -> []" "true"
|
||||||
|
check 18 "three registers, list returns 3" "3"
|
||||||
|
check 19 "re-register overrides entry" "true"
|
||||||
|
check 20 "re-register doesn't grow list" "1"
|
||||||
|
check 21 "different kinds independent" "true"
|
||||||
|
check 22 "list bogus kind" "ok"
|
||||||
|
|
||||||
|
TOTAL=$((PASS+FAIL))
|
||||||
|
if [ $FAIL -eq 0 ]; then
|
||||||
|
echo "ok $PASS/$TOTAL next/tests/registry_pure.sh passed"
|
||||||
|
else
|
||||||
|
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
|
||||||
|
echo "$ERRORS"
|
||||||
|
fi
|
||||||
|
[ $FAIL -eq 0 ]
|
||||||
@@ -337,6 +337,12 @@ created with a known stable CID.
|
|||||||
|
|
||||||
## Step 5 — Registry mechanism + bootstrap dispatch
|
## Step 5 — Registry mechanism + bootstrap dispatch
|
||||||
|
|
||||||
|
**Sub-deliverables:**
|
||||||
|
- [x] **5a** — Pure-functional `next/kernel/registry.erl`: `new/0`, `kinds/0`, `register/4`, `lookup/3`, `list/2`. State is a property list keyed by kind atom; per-kind storage is a property list of `{Name, Entry}`. Unknown kinds rejected with `{error, unknown_kind}`. `next/tests/registry_pure.sh` (14 cases).
|
||||||
|
- [ ] **5b** — gen_server wrapper around the pure registry: `start_link/0`, registered name `registry`, the pure API delegated through `gen_server:call`.
|
||||||
|
- [ ] **5c** — `bootstrap:load_genesis/1` (Step 4e) populates the registry from `read_genesis` output. Dispatches by section atom → kind.
|
||||||
|
- [ ] **5d** — define-registry projection fold integration: incoming `Create{Define*}` activities are routed through the projection scheduler (Step 7) and update the registry.
|
||||||
|
|
||||||
**Deliverables:**
|
**Deliverables:**
|
||||||
|
|
||||||
Registries are gen_servers, one per kind, each holding the active version map:
|
Registries are gen_servers, one per kind, each holding the active version map:
|
||||||
@@ -955,6 +961,7 @@ A few things still under-specified; resolve as work begins.
|
|||||||
Newest first. One line per sub-deliverable commit. Erlang conformance gate
|
Newest first. One line per sub-deliverable commit. Erlang conformance gate
|
||||||
(`bash lib/erlang/conformance.sh`) must remain 729/729 on every entry.
|
(`bash lib/erlang/conformance.sh`) must remain 729/729 on every entry.
|
||||||
|
|
||||||
|
- **2026-05-28** — Step 5a: `next/kernel/registry.erl` — pure-functional registry. State is `[{Kind, [{Name, Entry}, ...]}, ...]` keyed by the same seven section atoms as Step 4c (activity_types, object_types, projections, validators, codecs, sig_suites, audience). API: `new/0`, `kinds/0`, `register/4`, `lookup/3`, `list/2`. Unknown kinds rejected with `{error, unknown_kind}`; missing names return `not_found`; re-registering the same name overrides without growing the list. `next/tests/registry_pure.sh` 14/14. Step 5 broken into 5a–5d on the plan. Erlang conformance 729/729.
|
||||||
- **2026-05-28** — Step 4d: `bootstrap:build_genesis/1` + `verify_genesis/2` + `.cidhash` helpers in `next/kernel/bootstrap.erl`. Bundle CID delegated to host `cid:to_string` over `{genesis_bundle, Sections}` — deterministic, ~59 byte CIDv1 binary. `verify_genesis/2` returns `ok` on match, `{error, {cid_mismatch, Got, Expected}}` on drift. `write_cidhash`/`read_cidhash` persist the CID to a `.cidhash` sibling file (path hand-spelled `<<...,47,46,99,...>>` per the string-literal-in-binary substrate quirk). `next/tests/bootstrap_build.sh` 12/12. Erlang conformance 729/729.
|
- **2026-05-28** — Step 4d: `bootstrap:build_genesis/1` + `verify_genesis/2` + `.cidhash` helpers in `next/kernel/bootstrap.erl`. Bundle CID delegated to host `cid:to_string` over `{genesis_bundle, Sections}` — deterministic, ~59 byte CIDv1 binary. `verify_genesis/2` returns `ok` on match, `{error, {cid_mismatch, Got, Expected}}` on drift. `write_cidhash`/`read_cidhash` persist the CID to a `.cidhash` sibling file (path hand-spelled `<<...,47,46,99,...>>` per the string-literal-in-binary substrate quirk). `next/tests/bootstrap_build.sh` 12/12. Erlang conformance 729/729.
|
||||||
- **2026-05-27** — Step 4c: `next/kernel/bootstrap.erl` — Erlang module that enumerates the genesis bundle by walking seven hardcoded section subdirs via `file:list_dir/1`, filters `.sx` files via byte-pattern suffix match (`ends_with_sx/1`), reads each into a binary via `file:read_file/1`. Returns `{ok, [{Section, [{Name, Bytes}, ...]}]}`. Hits the same SX-parser substrate gap as Step 3b — kept the surface byte-only; parsing happens via SX-side helpers in later steps. Port gotchas: `fun name/arity` references unsupported (use anonymous fun wrappers); `<<"...">>` string-literal segments truncate to one byte (paths hand-spelled as integer-segment binaries). `next/tests/bootstrap_read.sh` 15/15. Erlang conformance 729/729.
|
- **2026-05-27** — Step 4c: `next/kernel/bootstrap.erl` — Erlang module that enumerates the genesis bundle by walking seven hardcoded section subdirs via `file:list_dir/1`, filters `.sx` files via byte-pattern suffix match (`ends_with_sx/1`), reads each into a binary via `file:read_file/1`. Returns `{ok, [{Section, [{Name, Bytes}, ...]}]}`. Hits the same SX-parser substrate gap as Step 3b — kept the surface byte-only; parsing happens via SX-side helpers in later steps. Port gotchas: `fun name/arity` references unsupported (use anonymous fun wrappers); `<<"...">>` string-literal segments truncate to one byte (paths hand-spelled as integer-segment binaries). `next/tests/bootstrap_read.sh` 15/15. Erlang conformance 729/729.
|
||||||
- **2026-05-27** — Step 4b-cod: bootstrap codecs + sig-suites + audience predicates complete. 3 `DefineCodec` files (dag-cbor + raw + dag-json, dag-cbor + dag-json deferring to host-codec primitive when wired), 2 `DefineSigSuite` files (rsa-sha256-2018 PEM-keyed, ed25519-2020 multibase-keyed, both :verify returning false as m2-deferred stand-in), 3 `DefineAudience` files (Public/Followers/Direct member-of predicates per design §16). Manifest now lists 26 bootstrap files across all eight sections; `next/tests/genesis_parse.sh` 50/50. Step 4b complete; remaining Step 4 is bundler code (4c–4e). Erlang conformance 729/729.
|
- **2026-05-27** — Step 4b-cod: bootstrap codecs + sig-suites + audience predicates complete. 3 `DefineCodec` files (dag-cbor + raw + dag-json, dag-cbor + dag-json deferring to host-codec primitive when wired), 2 `DefineSigSuite` files (rsa-sha256-2018 PEM-keyed, ed25519-2020 multibase-keyed, both :verify returning false as m2-deferred stand-in), 3 `DefineAudience` files (Public/Followers/Direct member-of predicates per design §16). Manifest now lists 26 bootstrap files across all eight sections; `next/tests/genesis_parse.sh` 50/50. Step 4b complete; remaining Step 4 is bundler code (4c–4e). Erlang conformance 729/729.
|
||||||
|
|||||||
Reference in New Issue
Block a user