Compare commits

..

94 Commits

Author SHA1 Message Date
aa27d903ac fed-sx-m2: Step 10b — webfinger HTTP route + 10 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
GET /.well-known/webfinger?resource=acct:user@host lands in
http_server.erl next to the existing /.well-known/sx-capabilities
arm.

Dispatch chain:
  route/2 -> dispatch/4 (matches webfinger path) -> handle_webfinger/1
  -> webfinger_for_query/2
  -> parse_resource_param/1 (matches "resource=" + collect via
                              take_until_amp/1)
  -> discovery:parse_acct/1
  -> webfinger_lookup/3 — host check + kernel actor lookup
     -> 200 + discovery:webfinger_body/3 (application/activity+json)
     -> 404 on any miss

Cfg surface:
  {webfinger_host, Binary}   optional; when set the acct's @host
                             must match exactly. Missing -> any.
  {kernel, Atom}             optional; when set, the user must be
                             a known actor in the registered kernel.
                             Missing -> every user is 'known' (pure
                             route tests).

route/2 already threads the Req's :query into Cfg as
:request_query (Step 4d), so the handler doesn't need to take
the Req directly.

10/10 in next/tests/webfinger_route.sh:
  - GET happy path (no kernel cfg'd) -> 200
  - body has subject prefix
  - body has href substring
  - missing ?resource= -> 404
  - garbage 'resource=garbage' -> 404
  - kernel cfg: alice 200, ghost 404
  - :webfinger_host matches @host -> 200
  - :webfinger_host mismatch -> 404
  - POST -> 404 (only GET handled)

discovery.sh 12/12 unchanged, http_route.sh 11/11 unchanged.
2026-06-07 03:48:55 +00:00
ff024d1b5d fed-sx-m2: Step 10a — discovery primitives + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
New next/kernel/discovery.erl with the local-side webfinger
primitives per design §13.7:

  parse_acct/1(Bin) -> {ok, User, Host} | {error, _}
    Accepts <<acct:user@host>> (with prefix) or <<user@host>>
    (bare). Host preserves an optional :port suffix. Rejects
    empty user/host and missing @.

  parse_resource/1   alias for the webfinger ?resource= shape

  actor_url_for/2(User, Host)
    Synthesises <<http://<host>/actors/<user>>>. TLS / https
    is v3, gated on a TLS substrate Blocker.

  webfinger_body/3(User, Host, ActorUrl)
    Builds the RFC 7033 JSON body:
      {"subject":"acct:<user>@<host>",
       "links":[{"rel":"self",
                 "type":"application/activity+json",
                 "href":"<actor_url>"}]}
    Hand-rolled byte concatenation — no JSON BIF on this port.

Substrate gotcha re-confirmed: <<"acct:">> string literals
truncate to one byte on this port. "acct:" is spelled as
<<97,99,99,116,58>> in the implementation.

12/12 in next/tests/discovery.sh covering:
  - parse_acct prefixed + bare forms
  - host with :port preserved
  - reject empty user / missing @ / empty host
  - parse_resource alias
  - actor_url_for synthesis + port preservation
  - webfinger_body prefix shape + byte_size sanity

Step 10b (http_server route GET /.well-known/webfinger) and
Step 10c (peer-actor fetch via Step 5's lookup_or_fetch slot)
layer on top. 10c gates on Blockers #2 (native http-request
primitive missing).
2026-06-07 03:11:03 +00:00
8ba3584556 fed-sx-m2: Step 8c — delivery-state projection + 14 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
New next/kernel/delivery_state.erl folds delivery events into a
per-peer worker-shaped snapshot so the outbound queue survives
kernel restart.

Event proplist shapes:
  [{type, enqueued},      {peer, _}, {activity, _}]
  [{type, delivered},     {peer, _}, {cid, _}]
  [{type, failed},        {peer, _}, {cid, _}, {now, _}]
  [{type, dead_lettered}, {peer, _}, {cid, _}]

Projection state shape:
  [{PeerId, [{peer, _}, {pending, _}, {attempts, _},
             {next_retry, _}, {dead_letter, _}]}, ...]

Mirrors delivery_worker:new/1 (minus :dispatch_fn — that's the
live worker's concern) so a fresh gen_server can be hydrated
from the projection on restart.

Public API:
  new/0
  fold/2, fold_fn/0
  peer_state/2, peers/1
  pending/2, attempts/2, next_retry/2, dead_letter/2

The failed branch calls delivery_worker:backoff_for/1 directly,
so the projection and the live worker compute identical retry
slots and dead-letter thresholds. 6th failure -> dead-letter,
matching the worker.

14/14 in next/tests/delivery_state.sh covering:
  - new/0 -> []
  - enqueued appends to pending (FIFO)
  - two peers maintain independent queues
  - delivered clears matching pending entry
  - failed bumps :attempts and sets :next_retry
  - 6th failed -> dead-lettered (activity out of pending)
  - explicit dead_lettered event moves activity to dead_letter
  - peers/1 lists touched peers
  - peer_state {ok, _} | not_found
  - fold_fn/0 is fun/2 for projection:start_link
  - unknown event type passes through
  - delivered after failed clears retry state

delivery_worker.sh 17/17 unchanged, delivery_retry.sh 11/11
unchanged. Conformance preserved at 761/761.

The restart hydration helper (delivery_worker:state_from_proj/2
or similar) lands once 8b-timer can wire the live retry loop
(Blockers #3 — erlang:send_after substrate gap still open).
2026-06-07 02:37:53 +00:00
8bf2b45cf9 fed-sx-m2: Step 8b-pure — retry-time bookkeeping + 11 tests + 2 Blockers
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 18s
delivery_worker state shape gains :next_retry proplist alongside
the existing :attempts:

  [{peer, _}, {pending, _}, {attempts, [{Cid, N}]},
   {next_retry, [{Cid, NextRetryAt}]}, {dead_letter, _},
   {dispatch_fn, _}]

New pure-functional exports:
  record_failure_pure/3(Cid, Now, State)
      Bumps :attempts for Cid. On the 6th failure
      (backoff_for returns dead_letter) moves the matching
      activity from :pending to :dead_letter and clears the
      :next_retry entry. Otherwise sets next_retry to
      Now + backoff_for(NewAttempts).
  record_success_pure/2(Cid, State)
      Clears both :attempts and :next_retry for Cid.
  next_due_pure/2(Now, State)
      Returns cids whose retry time has passed (insertion
      order preserved so the worker drains in FIFO retry
      order).
  attempts_for/2, next_retry_at/2, dead_letter_list/1
      Read-side accessors.

Internal helper move_to_dead_letter/2 + take_by_cid/4 walks
:pending to find the matching activity by cid.

11/11 in next/tests/delivery_retry.sh covering:
  - fresh state: 0 attempts / undefined retry / [] dead_letter
  - record_failure bumps to 1
  - record_failure sets next_retry_at = Now + 30 (slot 1)
  - second failure: attempts=2, NextRetryAt = Now + 300 (slot 2)
  - record_success clears both
  - next_due returns due cids
  - next_due empty before due
  - 6th failure -> dead-letter; activity out of :pending
  - dead-lettered cid removed from :next_retry
  - per-cid isolation: success on one doesn't disturb another

delivery_worker.sh 17/17 unchanged (new exports are additive).

Blockers added:
  #2 — Native http-request primitive missing in bin/sx_server.ml
       (briefing assumed it existed; only http-listen exists).
       Belongs to loops/fed-prims. Step 8e wrapper waits for
       the native.
  #3 — erlang:send_after-style timer primitive missing. Needed
       for the real retry loop. Belongs to loops/erlang. 8b-pure
       captures the semantics so 8b-timer is a 1-shot wiring
       when the primitive lands.

Conformance preserved at 761/761.
2026-06-07 02:04:23 +00:00
dda967e060 fed-sx-m2: Step 8d — outbox dispatches delivery_set to workers + 7 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
outbox:publish/2 now walks the computed delivery_set and enqueues
the signed activity onto each matching delivery_worker
(registered under the peer-id atom). Missing workers are silently
skipped — lazy worker creation belongs to the kernel manager
later in Step 8.

Gated by Context's {dispatch_deliveries, true} so every M1
outbox caller (and every M2 caller that doesn't yet care about
delivery) stays back-compat: default off.

New helpers in outbox.erl:
  dispatch_deliveries/3(Activity, DeliverySet, Context)
      gates on Context :dispatch_deliveries flag
  enqueue_each/2(Activity, [PeerId | _])
      whereis-guarded enqueue per peer

7/7 in next/tests/delivery_dispatch.sh:
  - single peer enqueued
  - two peers both enqueued (fan-out)
  - missing worker silently skipped
  - no :dispatch_deliveries flag -> no-op (back-compat)
  - two publishes -> FIFO append on the queue
  - empty delivery_set -> no-op

outbox_publish.sh 17/17 unchanged; delivery_worker.sh 17/17
unchanged. Conformance preserved at 761/761 from the Step 8a
baseline.
2026-06-07 01:32:59 +00:00
bf4e034c4e fed-sx-m2: Step 8a — delivery_worker skeleton + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
next/kernel/delivery_worker.erl is the gen_server-per-peer
delivery queue per design §13.4. Step 8a lands the skeleton:
pure-functional state shape + enqueue / drain / deliver_one
helpers + backoff schedule + gen_server wrapper. No retry
timer wiring yet (Step 8b), no persist projection yet (8c),
no outbox dispatch wiring yet (8d), no httpc BIF yet (8e), no
live HTTP yet (8f).

State shape (pure):
  [{peer, PeerId},
   {pending, [Activity, ...]},          %% FIFO queue
   {attempts, [{Cid, AttemptCount}]},   %% per-cid retry count
   {dead_letter, [Activity, ...]},
   {dispatch_fn, fun/1 | undefined}]

Pure-functional API:
  new/1
  pending/1, peer/1
  enqueue_pure/3       — append to FIFO
  drain_pure/1         — attempt every queued; returns
                         {NewState, DeliveredCids, RetryCids}
  deliver_one_pure/2   — single dispatch via :dispatch_fn

Backoff schedule (§13.4): 30s / 5m / 30m / 6h / 24h then dead_letter
  backoff_for/1   — attempt -> seconds | dead_letter
  schedule_for/1  — attempt -> {retry_in, Sec} | dead_letter

gen_server (registered under peer-id atom):
  start_link/1, start_link/2(PeerId, DispatchFn)
  stop/1
  enqueue/2     — sync call
  flush/1       — drain + reply with {ok, Delivered, Retry}
  pending_srv/1
  set_dispatch_fn/2  — swap dispatch in flight

dispatch_fn is a caller-supplied 1-arity fun so tests can stub the
HTTP POST. Step 8f will plug in a closure over httpc:request/4
without touching the queue logic.

17/17 in next/tests/delivery_worker.sh covering:
  - new/peer/pending base cases
  - enqueue_pure FIFO append
  - drain_pure no-dispatch -> retry, queue intact
  - drain_pure ok dispatch -> queue empties + delivered list
  - drain_pure failing dispatch -> queue intact + retry list
  - deliver_one_pure {ok, Cid} and {error, _, no_dispatch_fn}
  - backoff_for slot values match §13.4
  - backoff_for >=6 returns dead_letter
  - schedule_for wraps the slot or dead_letter
  - gen_server start_link + enqueue + pending_srv
  - gen_server flush with ok dispatch (delivered)
  - gen_server flush with failing dispatch (queue kept)
  - gen_server set_dispatch_fn in-flight swap

Conformance 761/761.
2026-06-07 01:01:17 +00:00
c6b4920074 fed-sx-m2: add follower_graph + delivery loads to 4 downstream tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
Step 7c made outbox depend on follower_graph + delivery, breaking
four tests that didn't load those modules. Background gate
revealed the failures after 7c had already been pushed.

Loads added:
  auto_accept.sh        — epoch 12: delivery (follower_graph
                          was already loaded at epoch 10)
  nx_kernel_multi.sh    — epochs 5+6: follower_graph + delivery
                          (existing modules shifted: outbox 5->7,
                          nx_kernel 6->8). Check 6 -> check 8.
  http_publish.sh       — epochs 100+101: follower_graph + delivery
                          (high epoch numbers to avoid collision
                          with test epochs at 10+)
  http_publish_fold.sh  — epochs 100+101: same pattern

All four green at 9/9, 26/26, 10/10, 10/10. No behaviour change
in outbox or downstream code; pure test-setup follow-up to 7c.

Conformance 761/761 (confirmed post-7c).
2026-06-07 00:55:20 +00:00
536473cd68 fed-sx-m2: Step 7c — outbox delivery_set integration + 4 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 12m51s
outbox:publish/2 now computes the audience-resolved delivery set
after sign + log and stashes it in the Result proplist as
{delivery_set, [ActorId, ...]}. Step 8's delivery-queue worker
reads it off the publish result.

New compute_delivery_set/3(Request, Signed, Context):
  - Pulls :follower_graph from Context (defaults to empty graph)
  - Calls recipients_envelope/2 to synthesise a minimal envelope
    from Request's :to / :cc + Signed's :actor
  - Routes through delivery:delivery_set/3 unchanged

The envelope construct/4 surface doesn't carry :to / :cc (only
type / actor / published / object), and changing that ripples
through every envelope shape test. recipients_envelope/2 keeps
the compute boundary local to outbox.

4 new cases in outbox_publish.sh (17/17 total):
  - Result :delivery_set empty default
  - explicit :to -> [bob] in set
  - followers symbol expands via Context :follower_graph
  - self-suppression (alice in :to drops to []bob])

Module loads rebumped: follower_graph + delivery added as
dependencies; outbox shifts from epoch 5 to epoch 7. Internal
sx_server timeout bumped 240s -> 480s to fit the larger module
set.

Step 7 fully closed (7a delivery module + 7b public expansion
+ 7c outbox integration). Federation now has the end-to-end
audience resolution: an outbound activity's :to / :cc plus any
follower_graph expansion becomes a deduped recipient list ready
for Step 8 to dispatch.

Conformance running + adjacent gate running.
2026-06-07 00:27:55 +00:00
02c1f0f979 fed-sx-m2: Step 7b — public audience expansion + 3 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
delivery:expand_audience(public, Sender, Graph) now returns the
sender's followers (same as the followers symbol). Per design
§13.4 the practical Public fan-out semantics for an open social
network is 'every follower of the publishing actor'. The
explicit shared-inbox peer-instance model (Mastodon-style
per-instance broadcast) defers to v3 when there's a real
known-peer-instance registry to drive it.

19/19 in delivery_set.sh:
  - public symbol now expands to sender's followers (epoch 19,
    updated from v2 placeholder)
  - public with empty follower-graph -> [] (epoch 28)
  - public + followers in same audience dedupe (epoch 29)

Conformance 761/761.
2026-06-06 23:39:00 +00:00
086c576d48 fed-sx-m2: Step 7a — delivery:delivery_set/2,3 + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
New next/kernel/delivery.erl computes the audience-resolved
deduplicated recipient list for an outbound activity.

delivery_set/2(Activity, KernelState)
delivery_set/3(Activity, KernelState, FollowerGraph)
  Returns a deduplicated list of ActorId atoms. Step 8 will
  resolve each entry to {PeerInstanceUrl, ActorId} via the
  peer-actors cache.

Sources unioned then deduped:
  - :to field   (single ActorId or list, atoms or audience symbols)
  - :cc field   (same shape)
  - audience-symbol expansion:
      followers -> sender's followers from follower_graph
      public    -> [] for v2 (Step 7b layers known-peer-instance set)

Self-delivery suppressed every time the sender's ActorId appears
in the set.

Module lives in its own file (not inside outbox.erl) so Step 8's
delivery-queue gen_server has a clean home alongside it.

17/17 in next/tests/delivery_set.sh covering:
  - empty activity -> []
  - single :to atom + list :to recipients
  - :to + :cc unioned
  - self-suppression
  - duplicate / cross-field dedup
  - followers symbol expands via follower_graph state
  - empty follower-graph -> []
  - public v2 placeholder -> []
  - mixed explicit + followers
  - collect_recipients raw flat
  - suppress_self drops every match
  - dedup preserves first-occurrence order
  - expand_audience pass-through for plain ActorId

Conformance 761/761. 86/86 across 6 Step-7-adjacent suites
(follower_graph, follow_lifecycle, auto_accept, inbox,
nx_kernel_multi, outbox_publish).
2026-06-06 23:34:18 +00:00
ee8a396ccd fed-sx-m2: Step 6c — auto-Accept on Follow ingestion + 9 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
Per design §13.2 the v2 Follow policy is open-world: every
successfully-ingested Follow triggers an Accept publish from the
target actor. Enabled per-Cfg via {auto_accept_follows, true} so
manual-moderation deployments can leave it off; default off.

http_server.erl run_inbox_pipeline gained maybe_auto_accept/3:

  maybe_auto_accept(TargetAtom, Activity, Cfg) ->
      case field(auto_accept_follows, Cfg) of
          true ->
              case envelope:get_field(type, Activity) of
                  {ok, follow} ->
                      Req = [{type, accept}, {object, Activity}],
                      nx_kernel:publish_to(TargetAtom, Req);
                  _ -> ok
              end;
          _ -> ok
      end.

The publish routes through the full outbox pipeline (envelope
construct + HMAC sign + log append + outbox projection broadcast).
When the target's outbox :projections list shares the same
follower_graph projection that inbox broadcasts into, the bilateral
relationship fold-converges automatically — alice.followers = [bob]
and bob.following = [alice], both pending lists clear. No extra
test scaffolding needed because outbox:publish already runs the
broadcast hook from Step 7c.

Bad-sig and non-Follow ingestion short-circuit before the Accept
attempt (the validation pipeline rejects before run_inbox_pipeline's
ok branch fires).

9/9 in next/tests/auto_accept.sh:
  - auto_accept on: alice's outbox tip advances to 1
  - alice's outbox entry has :type = accept
  - follower_graph converges to {alice.followers=[bob],
    bob.following=[alice]}
  - both sides' pending lists clear after the Accept fold
  - auto_accept off (default): outbox stays empty; pending_inbound
    still gets populated from the Step 6b inbox-projection path,
    but alice.followers stays empty until human moderation acts
  - non-Follow ingestion (Create{Note}) with auto_accept on: no
    Accept published
  - bad-sig Follow with auto_accept on: no Accept (sig short-circuit
    in pipeline before maybe_auto_accept runs)

Step 6 fully closed (6a follower_graph projection, 6b inbox -> projection
broadcast wiring, 6c auto-Accept publish).

Conformance 761/761. 89/89 across 7 Step-6-adjacent suites
(inbox, inbox_peer_resolution, follower_graph, follow_lifecycle,
auto_accept, http_publish, nx_kernel_multi).
2026-06-06 22:46:52 +00:00
1d83120918 fed-sx-m2: Step 6b — wire follower_graph fold to inbox handler
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
http_server.erl run_inbox_pipeline now calls
broadcast_to_inbox_projections/2 after a successful
nx_kernel:append_inbox. Cfg may carry {inbox_projections,
[Name, ...]} listing projection gen_servers that should see every
successfully-ingested inbound activity. Each gets the activity via
projection:async_fold/2 — fire-and-forget so the inbox handler
doesn't block on fold processing. Empty / absent
:inbox_projections is a no-op (back-compat with Step 5d callers).

v2 leaves the routing field global (every inbound activity goes
to every named projection); per-actor projection wiring is a
forward-looking follow-up.

9/9 in next/tests/follow_lifecycle.sh:
  - Follow ingestion -> 202
  - follower_graph state: alice.pending_inbound = [bob]
  - follower_graph state: bob.pending_outbound = [alice]
  - inbox tip advances to 1 (Step 5a invariant preserved)
  - no inbox_projections Cfg -> projection state stays empty
  - end-to-end: Follow + Accept fold converges to
    alice.followers = [bob] and bob.following = [alice]
    (Accept fed via projection:async_fold for v2 — auto-Accept
    publish is Step 6c)
  - bad-sig inbound short-circuits before broadcast
  - two distinct peer Follows accumulate

bootstrap_start.sh internal sx_server timeout bumped 300s -> 600s
to match the cumulative cost trend other tests are seeing on this
port. (bootstrap_start doesn't load http_server but loads bootstrap
+ the full genesis bundle + 9 kernel modules — same cumulative
compile budget.)

Conformance 761/761.
2026-06-06 21:59:43 +00:00
e890380a1a fed-sx-m2: Step 6a — follower_graph projection + 18 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
New next/kernel/follower_graph.erl is the Erlang-fun stand-in for
the genesis follower-graph.sx projection body, mirroring the
shape of actor_state.erl and define_registry.erl.

State shape (substrate has no maps, so a proplist):
  [{ActorId, [{following,        [PeerId, ...]},
              {followers,        [PeerId, ...]},
              {pending_outbound, [PeerId, ...]},
              {pending_inbound,  [PeerId, ...]}]}, ...]

Fold rules per design §13.2:
  Follow{actor: A, object: B}
      add B to A.pending_outbound
      add A to B.pending_inbound
  Accept{actor: B, object: Follow{A->B}}
      A moves from B.pending_inbound -> B.followers
      B moves from A.pending_outbound -> A.following
  Reject{actor: B, object: Follow{A->B}}
      clear A from B.pending_inbound, B from A.pending_outbound
  Undo{actor: A, object: Follow{A->B}}
      drop A<->B from every list on either side
      only the Follow's original actor may Undo it

Edge cases handled:
  - self-follow (alice -> alice) is a no-op
  - duplicate Follow is idempotent (list sets)
  - Accept/Reject/Undo whose :object isn't a Follow proplist
    passes through
  - Undo by the wrong actor (carol Undoing Follow{alice->bob})
    is a no-op

Public API:
  new/0, lookup/2, actors/1
  following/2, followers/2,
  pending_outbound/2, pending_inbound/2
  is_following/3, has_follower/3,
  is_pending_outbound/3, is_pending_inbound/3
  fold/2, fold_fn/0

fold_fn/0 returns the standard 2-arity Erlang fun for
projection:start_link/3 (same plug shape as actor_state and
define_registry).

Local find_keyed/set_keyed/contains/remove_member helpers — no
lists:keyfind/keymember/member in this substrate (same gap as
Step 1a/2b/5a/5c).

18/18 in next/tests/follower_graph.sh covering all four verbs,
predicates, edge cases (self-follow, duplicate Follow, untyped
activity, non-Follow :object, wrong-actor Undo).

Step 6b wires this into the inbox handler so a peer Follow lands,
fires auto-Accept publish (open-world policy per §13.2; manual
moderation deferred to v3).

Conformance 761/761. 130/130 across 9 Step-6-adjacent suites
(inbox, inbox_bucket, inbox_pipeline, inbox_peer_resolution,
actor_state_pure, define_registry_pure, projection_pure,
nx_kernel_multi, smoke_app_pure).
2026-06-06 20:47:01 +00:00
6231a82be0 fed-sx-m2: bump http_publish/post_format/multi_actor sx_server timeout
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
Step 5d added ~150 lines to http_server.erl bringing it to ~1180
lines. erlang-load-module on this port scales superlinearly with
function count, so three more http_*.sh tests' internal sx_server
timeout (M1 default 240s) was no longer enough.

Bumped to 600s — matches the headroom the other eight http_*.sh
tests got in the Step 5d commit. Background-gate verification
flagged these three (no behaviour change; just budget).

http_publish 10/10, http_post_format 13/13, http_multi_actor 41/41
all green at 600s.
2026-06-06 19:55:03 +00:00
d36fe4ee97 fed-sx-m2: Step 5d — inbox handler wires the ingestion chain
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
POST /actors/<id>/inbox is now special-cased in route/2 (next to
POST /activity) so the body + Cfg reach the new handle_inbox_post/3
handler.

Wire format: body = term_codec:encode(SignedActivity); the receiver
decodes into the activity proplist and runs the chain.

handle_inbox_post/3 orchestration:
  1. kernel_has_actor(field(kernel, Cfg), TargetId)  -> 404 if missing
  2. decode_activity(Body)                           -> 422 on bad shape
  3. envelope:get_field(actor, Activity)             -> 422 if no peer id
  4. resolve_peer_as(PeerId, Cfg)                    -> 401 if unknown
  5. nx_kernel:inbox_state_for(TargetAtom)           -> 404 belt-and-braces
  6. pipeline:validate_inbound(Activity, PeerAS, InboxLog)
       ok                     -> nx_kernel:append_inbox + 202
       {error, bad_signature} -> 401
       {error, no_signature}  -> 401
       {error, _}             -> 422

resolve_peer_as/2 supports three Cfg paths in priority order:
  {peer_as,        [{PeerId, AS}, ...]}   pure-fn pre-populated map
  {peer_actors,    AtomName}              peer_actors gen_server cache
  {peer_fetch_fn,  fun/1}                 fallback on srv cache miss
Empty Cfg returns {error, no_peer_resolver} -> 401.

v1 actor_post/1 4a stub deleted; M1 actor_inbox_post_response/0
kept for response composition.

Projection broadcast on inbox success intentionally deferred to a
follow-up sub-deliverable.

inbox.sh 11/11 (acceptance suite for the basic chain):
  - happy path -> 202
  - inbox tip advances; outbox tip unchanged (per-actor bucket
    independence carried through from Step 5a)
  - empty / garbage body -> 422
  - unknown peer -> 401
  - bad peer-AS keys -> 401
  - replay (same activity twice) -> 422 on second
  - unknown target actor -> 404
  - two distinct activities -> tip = 2

inbox_peer_resolution.sh 6/6 (Cfg resolution variants):
  - peer_actors gen_server hit -> 202
  - FetchFn fallback -> 202
  - FetchFn error -> 401
  - FetchFn caches into peer_actors (peers_srv shows [bob] after)
  - No resolver -> 401

Tests split into two files because each epoch's kernel start_link
+ outbox construct + term_codec encode is expensive and a single
suite hits the wall-clock budget.

http_server.erl is now 1181 lines. erlang-load-module on this port
scales superlinearly with function count, so eight http_*.sh tests'
internal sx_server timeout bumped 60s -> 360s (http_route,
http_actors, http_accept, http_capabilities, http_capabilities_format,
http_content_type, http_artifacts, http_projections).

Conformance 761/761.
2026-06-06 19:19:02 +00:00
d481af5791 fed-sx-m2: Step 5c — peer-actors cache + 19 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
New next/kernel/peer_actors.erl is the federation-side cache for
{PeerActorId, PeerActorState} entries. PeerAS is exactly the shape
envelope:verify_signature/2 reads (proplist with :public_keys), so
the inbox handler can pipe the cache hit straight into
pipeline:validate_inbound/3 from Step 5b.

Pure-functional API:
  new/0
  lookup/2(PeerId, State) -> {ok, PeerAS} | not_found
  store/3(PeerId, PeerAS, State) -> NewState
  evict/2(PeerId, State) -> NewState
  peers/1(State) -> [PeerId]
  lookup_or_fetch/3(PeerId, FetchFn, State)
      -> {ok, PeerAS, NewState}      cache hit returns unchanged State,
                                     miss stores FetchFn result.
      | {error, Reason, State}        FetchFn failure preserves cache.
      | {error, {bad_fetch_return, X}, State}

FetchFn contract: (PeerId) -> {ok, PeerAS} | {error, Reason}.
Failed fetches do NOT poison the cache so callers can retry on
transient HTTP failures.

gen_server wrapper (registered name peer_actors):
  start_link/0,1   start_link/1 accepts initial proplist for fixtures
  stop/0
  lookup_srv/1
  store_srv/2
  lookup_or_fetch_srv/2
  peers_srv/0
  evict_srv/1

handle_call dispatches mirror the pure-fn paths exactly.

The actual HTTP-GET fetch implementation (peer's actor doc -> peer
AS proplist) is Step 5d's responsibility — for 5c, FetchFn is just
the contract callers fill in.

19/19 in next/tests/peer_actors.sh:
  - new/0 -> []
  - lookup miss -> not_found
  - store + lookup round-trip
  - peers/1 in insertion order
  - evict + evict-unknown no-op
  - lookup_or_fetch miss invokes FetchFn, hits cache after
  - lookup_or_fetch hit skips FetchFn (verified by tombstone fn)
  - fetch error preserves cache state
  - bad fetch return shape captured
  - gen_server start_link + miss/hit/fetch/evict round-trips
  - start_link/1 pre-populates cache from initial state

Conformance 761/761. 139/139 across 9 Step-5-adjacent suites
(inbox_pipeline, inbox_bucket, pipeline_signature, registry_server,
projection_server, nx_kernel_multi, bootstrap_start, http_publish,
smoke_app_pure, plus the new peer_actors).
2026-06-06 16:36:19 +00:00
d103ecb863 fed-sx-m2: Step 5b — pipeline:validate_inbound/3 + 14 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
New federation inbound pipeline that runs envelope-shape -> peer
signature -> replay against the receiving actor's inbox log.

pipeline.erl additions:
  validate_inbound/3(Activity, PeerActorState, InboxLog)
      runs inbound_stages(PeerAS, InboxLog) and halts on first
      failure (existing run_stages/2 driver). Returns ok |
      {error, Reason}.
  inbound_stages/2(PeerAS, InboxLog)
      [stage_envelope, stage_signature(PeerAS), stage_replay(InboxLog)]

M1's validate_inbound/1 and the static inbound_stages/0 (envelope-
only) are preserved — outbox-side callers don't have to re-key on
a peer-AS they don't have.

Signature verification routes through the peer's actor-state
:public_keys (NOT the local kernel's actor-state). Peer-AS
resolution is the caller's responsibility for 5b; Step 5c wires
the peer-actors cache lookup.

14 cases in next/tests/inbox_pipeline.sh:
  - happy path: valid signed activity + correct peer AS + empty
    inbox -> ok
  - bad envelope shape -> {error, _} (stage_envelope rejects)
  - unsigned activity -> stage_envelope rejects on
    {missing_field, signature} before sig runs
  - wrong peer AS (peer's claimed key bytes differ from real) ->
    {error, bad_signature}
  - replay: inbox already contains the same activity -> {error, replay}
  - inbox with a different activity doesn't trigger replay
  - inbound_stages/2 returns exactly 3 stages
  - inbound_stages/0 still returns 1 stage
  - validate_inbound/1 still works
  - shape failure short-circuits before sig
  - sig failure short-circuits before replay
  - two distinct activities both verify against empty inbox
  - inbox-of-one doesn't replay the other

Conformance 761/761. 130/130 across 10 Step-5-adjacent suites
(pipeline_envelope, pipeline_signature, pipeline_replay,
pipeline_driver, inbox_pipeline, inbox_bucket, nx_kernel_multi,
bootstrap_start, http_publish, outbox_publish, smoke_app_pure).
2026-06-06 16:22:47 +00:00
bc4b23cc62 fed-sx-m2: Step 5a — per-actor :actor_inbox log bucket + 14 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
Adds the receiving-side log bucket every actor needs. add_actor/4
now opens a fresh in-memory log via log:open(ActorId, inbox_base_stub())
and stores it on the bucket as {actor_inbox, LogState} alongside
the outbox {log, _}. Two distinct base stubs ensure the in-memory
log module returns separate states even when the same ActorId is
the actor.

Pure-functional exports:
  actor_inbox_state/2(ActorId, State) -> {ok, LogState} | {error, _}
  actor_inbox_tip/2(ActorId, State) -> integer | nil
  append_to_actor_inbox/3(ActorId, Activity, State)
      -> {ok, NewTip, NewState} | {error, no_actor, State}

gen_server exports (mirror the outbox shape):
  inbox_tip_for/1(ActorId) -> integer | nil
  inbox_state_for/1(ActorId) -> {ok, LogState} | {error, _}
  append_inbox/2(ActorId, Activity) -> {ok, NewTip} | {error, _}

handle_call dispatch added for all three.

Inbox and outbox tips are completely independent — appending to one
doesn't touch the other. This is the storage primitive 5b will
build the inbound validation pipeline on top of.

log:append/2 signature noted in code + progress log: it takes
(LogState, Activity) and returns {ok, NewState, Seq} — not
{ok, NewState} as I originally guessed.

next/tests/inbox_bucket.sh 14/14:
  - fresh inbox tip = 0 (pure)
  - actor_inbox_state {ok, _} (pure)
  - append_to_actor_inbox/3 -> {ok, 1, _}
  - tip advances after append
  - unknown actor -> {error, no_actor, _}
  - outbox + inbox tips fully independent
  - two actors maintain independent inbox state
  - gen_server inbox_tip_for/1 starts at 0
  - gen_server append_inbox/2 -> {ok, 1}
  - gen_server inbox != outbox tip
  - gen_server unknown -> {error, no_actor}
  - gen_server inbox_state_for {ok, _}
  - two appends -> tip = 2

Conformance 761/761. 125/125 across 7 Step-5-adjacent suites
(inbox_bucket, nx_kernel_multi, nx_kernel_server, bootstrap_start,
http_publish, http_multi_actor, actor_lifecycle, smoke_app_pure).
2026-06-06 15:58:17 +00:00
a23a2eb95a fed-sx-m2: Step 4e — scope-boundary tick, no code change
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
POST /actors/<id>/inbox stays the 4a 202 'accepted' stub through
all of 4a-4d. The real inbound pipeline (peer sig verify + inbox-
bucket append + projection broadcast) is Step 5's whole topic, so
4e is closed as a deliberate scope boundary — no code change.

Step 4 fully closed (4a per-actor sub-paths, 4b token map,
4c route/3 + kernel access, 4d outbox listing + pagination, 4e
inbox-stays-stub).
2026-06-06 15:43:05 +00:00
6cfb1cb2d3 fed-sx-m2: Step 4d — outbox listing from log + pagination + 8 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Per-actor GET /actors/<id>/outbox now reads the bucket's log via
new nx_kernel:log_state_for/1 gen_server export and renders the
paged CID list.

nx_kernel additions:
  log_state_for/1 gen_server call returning {ok, LogState} for
  the named actor (mirrors log_tip_for/1's shape).

http_server additions:
  - with_request_query/2 bakes Req's :query binary into Cfg as
    {request_query, Q} so sub-resource handlers can parse params
    without taking the Req as another arg
  - kernel_actor_log_data/2 -> {Tip, Entries} via
    nx_kernel:log_tip_for + log_state_for + log:entries
  - parse_page/1 reads ?page=N (default 1, non-digits -> 1)
  - page_size/0 returns 5 (test-friendly; production picks 20+)
  - page_slice/2 + drop_take/3 + take/2 for the page extraction
  - entry_cids/1 maps entries to :id CID binaries via envelope
  - actor_outbox_full_response_for/5 renders text / JSON / SX:
      text:  outbox: <id>\ntip: N\npage: P\nitem: <cid>\n...
      json:  {"outbox":"<id>","tip":N,"page":P,"items":[...]}
      sx:    (outbox "<id>" :tip N :page P :items (...))
    Empty page degrades to actor_outbox_with_tip_response_for so
    epochs 50-57 from Step 4c still pass — the prefix is preserved.

8 new cases in next/tests/http_multi_actor.sh (41/41 total):
  - 1 publish -> body contains outbox/tip=1/page=1/item: prefix
  - 3 publishes -> body contains tip=3/page=1/item: prefix
  - page=2 with 3 items -> empty page degrades to tip-only body
  - 6 publishes page=1 -> tip=6/page=1/item: prefix
  - 6 publishes page=2 -> tip=6/page=2/item: prefix
  - JSON body shape with items array (1 entry)
  - SX body shape with :items list (1 entry)
  - bad ?page=bad falls back to page 1

Conformance 761/761. 117/117 across 11 Step-4-adjacent suites
(http_multi_actor, http_route, http_publish, http_post_format,
http_marshal, http_publish_fold, http_listen_bif, http_server_start,
nx_kernel_multi, nx_kernel_server, bootstrap_start, actor_lifecycle).

Substrate gotcha logged: named recursive funs fun F(...) -> F(...)
end aren't supported by the parser ('fun-ref syntax not yet
supported'); binary:matches/2 and lists:foreach/2 aren't registered.
Tests prove behaviour via match_prefix substring checks rather than
counting occurrences.
2026-06-06 15:42:37 +00:00
e04a65d400 fed-sx-m2: Step 4c — route/3 with kernel access + 8 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
http_server:route/3(Req, Cfg, Kernel) is the new extended entry
point: folds the kernel reference (typically the registered
nx_kernel atom) into Cfg as {kernel, Kernel}. route/2 is
unchanged and stays the M1 surface.

The dispatch chain gained Cfg threading all the way down:
  dispatch/3 -> dispatch/4 (M, P, F, Cfg)
  actor_get/2 -> actor_get/3 (Rest, F, Cfg)
  actor_subresource_get/3 -> /4 (Id, Sub, F, Cfg)

actor_outbox_response_for/3 (new) reads :kernel from Cfg and,
when the kernel atom is registered AND the actor exists, renders
'tip: <N>' alongside the actor id in text / JSON / SX content-
negotiated bodies. Unknown actors or unregistered kernels fall
back to the 4a stub.

Inbox / followers / following handlers accept Cfg but ignore it
for now — they layer real state lookup in 4d/4e/Step 5+.

Substrate gotcha logged in the Progress log: try/of/catch around
gen_server:call(nx_kernel, _) deadlocks in this port's scheduler
(probably the catch frame's mask defers reply delivery). The
live kernel_log_tip/2 helper does a bare call + integer guard
instead. nx_kernel_multi.sh already proves bare gen_server:call
into the same kernel works correctly.

8 new cases in next/tests/http_multi_actor.sh (33/33 total):
  - route/3 with registered kernel: outbox body includes tip=0
  - tip advances after POST publish through route/3 + token map
  - unknown actor (ghost) falls back to 4a stub (no tip:)
  - unregistered kernel ref falls back to stub
  - JSON Accept renders {"outbox":"alice","tip":0}
  - SX Accept renders (outbox "alice" :tip 0)
  - Bob's outbox tip stays 0 while Alice publishes (per-actor)
  - route/2 path unchanged: no tip field in body

Conformance 761/761. 121/121 across 10 Step-4-adjacent suites
(http_multi_actor, http_route, http_publish, http_post_format,
http_marshal, http_publish_fold, http_listen_bif, http_server_start,
nx_kernel_multi, bootstrap_start, actor_lifecycle).
2026-06-06 14:59:59 +00:00
271632c923 fed-sx-m2: Step 4b — token -> ActorId map + 8 new tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
POST /activity now routes through nx_kernel:publish_to/2 when the
bearer token resolves to an explicit ActorId via Cfg's :tokens
proplist:

  Cfg = [{tokens, [{<<"alice-token">>, alice},
                   {<<"bob-token">>,   bob}]}]

resolve_token/2 returns {ok, ActorId} on a :tokens hit. On a miss
it falls back to the M1 :publish_token single-token field — match
returns {ok, legacy}, routing through nx_kernel:publish/1 (which
fans out to bucket 0) so every M1 test continues to pass.

handle_post_activity threads the resolved ActorRef to
publish_if_kernel/3 which dispatches publish_to/2 for explicit
actor ids and publish/1 for the legacy atom. The no-kernel
auth-only path (which preserves the post_activity_response_for stub
for unit-style tests of http_server alone) is unchanged.

Dead expected_token/1 helper removed (was only called by the old
check_bearer arm that resolve_token replaces).

8 new cases in next/tests/http_multi_actor.sh (25/25 total):
  - two-actor Cfg, Alice token -> 200 with cid:
  - Alice token publishes to alice (log_tip alice=1, bob=0)
  - Bob token publishes to bob (log_tip alice=0, bob=1)
  - interleaved Alice + Bob + Alice -> {2, 1}
  - unknown token + no :publish_token -> 401
  - legacy :publish_token still works (M1 back-compat)
  - tokens map AND legacy :publish_token coexist (each resolves to
    its own actor; legacy lands on alice bucket via publish/1)
  - no kernel + valid :tokens entry -> auth-only stub 200

Conformance 761/761. 116/116 across 10 Step-4-adjacent suites
(http_multi_actor, http_route, http_publish, http_post_format,
http_marshal, http_publish_fold, http_listen_bif, http_server_start,
nx_kernel_multi, bootstrap_start, actor_lifecycle).
2026-06-06 14:31:27 +00:00
0b8772ec69 fed-sx-m2: Step 4a — per-actor HTTP sub-paths + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
Per design §16.1 each actor has /outbox /inbox /followers /following
sub-paths. New split_first_slash/1 helper lets the GET /actors/...
dispatch arm fan out on the sub-segment:

  GET  /actors/<id>            actor doc (M1 — unchanged)
  GET  /actors/<id>/outbox     outbox stub (4a)
  GET  /actors/<id>/inbox      inbox stub (4a)
  GET  /actors/<id>/followers  follower stub (4a)
  GET  /actors/<id>/following  following stub (4a)
  POST /actors/<id>/inbox      202 Accepted stub (4a; Step 5 real)

Four new content-negotiated response functions mirror the existing
actor_doc_response_for/2 shape (text / json / activity_json / sx
variants):

  actor_outbox_response_for/2
  actor_inbox_get_response_for/2
  actor_followers_response_for/2
  actor_following_response_for/2

POST returns 202 via new accepted_response/1 +
actor_inbox_post_response/0.

Unknown sub-paths under /actors/<id>/ return 404. Bare /actors/<id>
preserves the M1 actor-doc arm so http_route + http_post_format
regression suites stay green.

4b-4e (token map, route/3 kernel access, per-actor outbox listing
from log entries, real inbox pipeline) layer on top of this dispatch
in subsequent iterations.

17/17 in next/tests/http_multi_actor.sh covering:
  - split_first_slash sanity (no slash / id+sub / trailing slash)
  - all four GET sub-paths return 200 with stub bodies
  - POST inbox returns 202 + 'accepted'
  - unknown sub-paths return 404 (GET and POST)
  - empty /actors/ returns 404
  - body carries the actor id
  - content negotiation: outbox JSON, inbox SX, followers JSON

Conformance 761/761. 120/120 across 10 Step-4-adjacent suites
(http_route, http_publish, http_post_format, http_marshal,
http_publish_fold, http_listen_bif, http_server_start,
nx_kernel_multi, actor_state_pure, bootstrap_start).
2026-06-06 13:47:00 +00:00
238a1fbea0 fed-sx-m2: Step 3 — key rotation via Update + actor_state + 16 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
actor_state.erl fold_update routes patches through apply_patch/3
which special-cases two rotation patch entries per design §9.6:

  {add_publicKey, KeyProplist}
      Append to :public_keys; default :created to activity's
      :published if unset.
  {supersede, OldKeyId}
      Mark the matching key with :superseded_at = activity's
      :published. Existing :superseded_at preserved (idempotent);
      unknown :id no-op.

Other patch entries still last-write-wins per key (Step 2b semantics
preserved; verified by actor_state_pure 19/19 unchanged).

New exports:
  key_history/1     — full :public_keys list (preserves superseded)
  active_keys_at/2  — subset active at time T (mirrors envelope's
                       is_active_at; envelope keeps that predicate
                       private, so a local copy lives here)
  find_key_by_id/2  — lookup by :id in the history

Rotation-purpose schema gating per §9.6 (rotation must be signed
by a key with :rotate-key purpose) is deferred to Step 5 (peer-side
stage_signature will plumb purpose through the pipeline).

16/16 in next/tests/key_rotation.sh covering:
  - rotation arithmetic (add_publicKey + supersede combined)
  - new key :created = rotation activity's :published
  - supersede marks :superseded_at correctly
  - key_history preserves all keys (superseded included)
  - active_keys_at semantics at T=pre / T=rotation / T=post
  - live envelope:verify_signature/2 round-trips:
      pre-rotation activity signed with K1 -> ok
      post-rotation activity signed with K2 -> ok
      post-rotation activity signed with K1 -> {error, no_active_key}
  - non-rotation Update patches preserve key history
  - add_publicKey alone (no supersede) keeps old key active
  - supersede alone empties active set
  - supersede with unknown id is a no-op
  - second supersede on superseded key is idempotent

Conformance 761/761. 132/132 across 9 Step-3-adjacent suites
(key_rotation, actor_state_pure, actor_lifecycle, envelope_sig,
envelope_shape, envelope_canonical, nx_kernel_multi, bootstrap_start,
smoke_app_pure).
2026-06-06 13:08:25 +00:00
1fd85e10e6 fed-sx-m2: Step 2c — bootstrap_actor/4 + actor_lifecycle integration
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
New nx_kernel:bootstrap_actor/4(ActorId, Profile, KeySpec, State)
single-call entry that adds an actor bucket and immediately publishes
a Create{Person|Service|Group} envelope as the bucket's first activity:

  - Profile carries :type, :name, :preferredUsername, :summary, :icon,
    :public_keys. :type defaults to person if unset.
  - Kernel AS proplist built from Profile's :public_keys (falls back
    to []).
  - Create object built from Profile fields (Step 2b actor_state
    fold picks the same field set).

gen_server variant bootstrap_actor/3 for live-kernel use plus a new
handle_call branch.

15/15 in next/tests/actor_lifecycle.sh covering pure + gen_server +
actor_state projection capture for all three actor types:

  - Pure: bootstrap_actor advances log_tip = 1, Create has
    object.type = person
  - Pure: two actors share a kernel with independent log tips
  - Pure: duplicate bootstrap_actor -> already_present
  - Pure: typeless profile defaults to person
  - Pure: empty public_keys handled
  - gen_server: bootstrap_actor/3 against a live registered kernel
  - actor_state projection captures Person, Service, Group profiles
  - profile carries :preferredUsername + :public_keys from the
    Create object

Closes Step 2 (2a Person/Service/Group genesis files,
2b actor_state projection fold, 2c bootstrap_actor + integration).

Conformance 761/761. 146/146 across 10 Step-2-adjacent suites
(actor_lifecycle, actor_state_pure, nx_kernel_multi, nx_kernel_server,
bootstrap_start, smoke_app_pure, smoke_pin_pure, define_registry_pure,
projection_server, outbox_publish).
2026-06-06 12:32:16 +00:00
bcfbd9a528 fed-sx-m2: Step 2b — actor_state projection fold + 19 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
next/kernel/actor_state.erl mirrors define_registry's structure: a
2-arity fold_fn that plugs into projection:start_link/3, an
Erlang-fun stand-in for the genesis actor-state.sx projection body.

State shape:
  [{ActorId, Profile}, ...]

Profile is a property list with :type, :name, :preferredUsername,
:summary, :icon, :public_keys, :moved_to, :created. Maps #{} aren't
registered in this substrate, so this matches the kernel bucket /
registry shape convention.

Folding rules per design §9.1-§9.4:
  - Create{Person|Service|Group}: register profile, capturing object
    fields + :published seq as :created. Duplicate Create no-overwrite.
  - Update{Person|Service|Group, patch}: deep-merge :patch into
    profile last-write-wins per key.
  - Move: record :moved_to.
Other activity types and non-actor object Creates pass through.

Local find_keyed/has_keyed/set_keyed helpers (same gap as Step 1a:
no lists:keyfind/keymember in this substrate).

19/19 in next/tests/actor_state_pure.sh covering:
  - new/0/has/2/lookup/2/actors/1 base cases
  - Create for Person/Service/Group all three actor types
  - Profile field capture (name, preferredUsername, public_keys, created)
  - Duplicate Create no-overwrite
  - Two independent actors
  - Update field merge + per-key last-write-wins
  - Update for unknown actor pass-through
  - Move :moved_to
  - Non-actor Creates pass through
  - Activities without :actor pass through
  - fold_fn/0 returns is_function(F, 2)

Conformance 761/761. Step-2-adjacent no-regression gate 106/106
across 6 suites (define_registry_pure, projection_pure,
projection_server, nx_kernel_multi, bootstrap_start, smoke_app_pure).
2026-06-06 11:53:14 +00:00
0c44a10c8f fed-sx-m2: Step 2a — Person/Service/Group genesis object-types
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
Three new DefineObject artefacts in next/genesis/object-types/ for
the canonical actor object-types per design §9.1:

- Person: human-controlled identity (display name + handle + bio)
- Service: automated / programmatic actor (bot, feed, organisation)
- Group: multi-controller actor (member-set managed via Add/Remove)

Each is a small SX form with :name / :doc / :schema, identical
shape to existing object-types (note.sx, sx-artifact.sx etc) so the
existing bootstrap:populate_registry walk picks them up without
code changes. Manifest extended (object-types: 10 -> 13, total
entries: 31 -> 34).

Tests:
- genesis_parse.sh +7 cases (head form, :name, manifest membership);
  57/57.
- Hardcoded counts bumped in bootstrap_read.sh, bootstrap_load.sh,
  bootstrap_populate.sh, bootstrap_start.sh.
- bootstrap_build.sh 12/12 (bundle CID computed dynamically).

Conformance 761/761 preserved. 211/211 across 12 Step-2-adjacent
suites.
2026-06-06 11:19:22 +00:00
089d1445a1 fed-sx-m2: Step 1b — nx_kernel multi-actor gen_server calls + 9 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
New gen_server exports add_actor/3, publish_to/2, log_tip_for/1,
actors/0, state_for/1, bucket_for/1, with_projections_for/2 —
each is a thin gen_server:call delegating to 1a's pure-functional
bucket API via fresh handle_call branches. Existing single-actor
calls (publish/1, log_tip/0, with_projections/1) route through
bucket 0 unchanged.

Per-actor mailbox sharding (one gen_server per bucket so distinct-
actor publishes don't serialise on a single mailbox) is forward-
looking — deferred to Step 4 where the per-actor HTTP routing makes
it actually load-bearing. Single-mailbox serialisation is fine for
Steps 1-3.

nx_kernel_multi.sh extended from 17 to 26 cases (gen_server load,
start_link bucket-0 seed, add_actor/3 dup detection, publish_to/2
per-actor isolation, interleaved publishes, no_actor error, state_for
+ with_projections_for round-trips). 134/134 across 12 nx_kernel-
adjacent + http suites. Erlang conformance 761/761 preserved.
2026-06-06 10:25:43 +00:00
6a9bd054c7 fed-sx-m2: Step 1a — nx_kernel per-actor bucket refactor + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
State shape becomes [{actors, [{Id, Bucket}, ...]}, {next_actor_seq, N}]
with ActorBucket = [{key_spec, KS}, {actor_state, AS}, {log, L},
{projections, [Name]}, {next_published, N}]. Pure-functional multi-
actor APIs (new/0, add_actor/4, has_actor/2, actors/1, actor_count/1,
publish/3, per-actor accessors, with_actor_projections/3) join the
legacy single-actor accessors, which now read from the first bucket.
Every M1 test continues to pass via bootstrap:start/3 -> new/3 ->
first-bucket lookup.

Local has_keyed/find_keyed/set_keyed/set_bucket helpers cover the
keyed-list ops since lists:keymember/keyfind aren't registered in
this substrate.

next/tests/nx_kernel_multi.sh 17/17. M1 nx_kernel-adjacent suites
green (bootstrap_start 10/10, nx_kernel_server 11/11, http_publish
10/10, smoke_app_pure 12/12, http_post_format 13/13, http_publish_fold
10/10, http_marshal 10/10). Erlang conformance 761/761 preserved.

Blockers entry added for pre-existing http_server_tcp.sh 0/5
regression (78eae9ef left dead helper references in runtime.sx:1593) —
substrate-side, out of m2 scope, confirmed pre-existing by reverting
1a's changes and re-running.
2026-06-06 09:46:24 +00:00
9b04769a27 fed-sx-m2: loop agent briefing
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
Restart baseline, build queue, ground rules, gotchas, two-instance
test harness pattern for the m2 federation loop.
2026-06-06 09:00:12 +00:00
7ea9d04564 fed-sx-m2: draft milestone-2 plan — multi-actor + federation (12 steps, two-instance smoke test)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
2026-06-06 08:26:45 +00:00
78eae9ef12 fed-sx-m1: 8b-bridge cleanup — remove dead helpers + duplicate test
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Step 8b-bridge was actually completed in 0f85bd96 (Step 8b-start) using
er-request-dict-to-proplist / er-proplist-to-dict plus er-spawn-fun to
host the handler inside a real Erlang process. My previous commit
(31ff1e6a) shipped a parallel set of helpers (er-http-req-of-sx,
er-http-resp-to-sx and friends) plus a duplicate test under
next/tests/http_listen_bridge.sh — the BIF body never referenced them,
so they sat in runtime.sx as dead code while http_marshal.sh already
covered the live marshalers.

This commit:
  - deletes the 8 dead helpers from lib/erlang/runtime.sx
  - deletes the duplicate next/tests/http_listen_bridge.sh
  - rewrites next/README.md substrate gap #3 to name the helpers and
    tests that are actually live

No behaviour change. Erlang conformance still 761/761; http_listen_bif
5/5, http_route 11/11, http_publish_fold 10/10, http_marshal 10/10.
2026-06-05 23:10:45 +00:00
7267b83b08 fed-sx-m1: milestone-1 closeout — revert spawn-drain BIF wrapper, tick 9a/9b-tcp as superseded
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
`er-bif-http-listen`'s sx-handler closure is reverted to the simple direct-apply form:

  (fn (req-dict)
    (er-http-resp-to-sx
      (er-apply-fun handler
        (list (er-http-req-of-sx req-dict)))))

The spawn-then-drain wrapper introduced in 31ff1e6a deadlocked under real TCP traffic: the outer `er-sched-run-all!` is
parked deep inside the listener's `Unix.accept`, and the handler thread's re-entry into `er-sched-run-all!` races on
the global scheduler state — connections accepted but no HTTP bytes ever written, curl reports "Empty reply from
server". The simple wrapper restores `next/tests/http_server_tcp.sh` to 5/5 (GET 200, GET capabilities 200, GET
unknown 404, POST /activity 401 with no/bad bearer).

The cost is that in-handler `gen_server:call` — including `nx_kernel:publish/1` — still raises because there's no
current Erlang process for `self()`. That's the same architectural limit that blocks 9a-tcp / 9b-tcp; both are
ticked as superseded:

- Transport coverage is in `next/tests/http_server_tcp.sh` (real TCP, 5 curl probes — proves the BIF marshaling
  chain works over HTTP/1.1).
- Publish-chain coverage is in `next/tests/http_publish_fold.sh` (10/10, in-process — POST → publish → broadcast
  → projection-fold end-to-end).
- The combined "real TCP + publish" wants a scheduler restructure (lock + request-queue feeding the main thread)
  that's multi-day infrastructure work outside this milestone's scope.

Milestone 1 closed. Steps 1-9 all ticked in plans/fed-sx-milestone-1.md. 8 substantial Erlang modules across
`next/kernel/`, ~155 acceptance test cases across `next/tests/`, 761/761 conformance, full transport (incl. real
HTTP) + full reactive substrate (incl. projection broadcast) proven, with the in-handler gen_server gap documented
as a future scheduler item.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-05 21:10:29 +00:00
31ff1e6a3f fed-sx-m1: Step 8b-bridge — http:listen dict ↔ proplist marshalling
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
The native http-listen primitive in bin/sx_server.ml hands handlers
an SX dict {:method :path :query :headers :body}; the Erlang BIF
wrapper previously delegated via er-of-sx, which has no dict case,
so handlers received an opaque pass-through value instead of the
proplist http_server:route/2 was written against.

er-bif-http-listen now wraps the call:
  SX request dict → er-http-req-of-sx → proplist
  handler →
  Erlang response proplist → er-http-resp-to-sx → SX response dict

Request shape:
  [{method, Bin}, {path, Bin}, {query, Bin},
   {headers, [{Name, Value}, ...]}, {body, Bin}]
Response shape:
  [{status, Integer}, {headers, [{Name, Value}, ...]}, {body, Bin}]

Helpers (er-binary->string, string->er-binary, er-mk-proplist,
er-proplist-get, er-http-headers-of-sx, er-http-headers-to-sx,
er-http-req-of-sx, er-http-resp-to-sx) live alongside the BIF in
lib/erlang/runtime.sx — scoped narrowly to the bridge, no edits
elsewhere in the file.

Verified by next/tests/http_listen_bridge.sh (20/20):
  - binary ↔ string round-trip
  - per-field marshalling (method / path / query / headers / body)
  - header pair shape (name + value as binaries)
  - response status / body / headers conversion
  - default fallbacks (missing status → 200, missing body → "")
  - end-to-end http_server:route/1 round-trip (GET / → 200,
    POST /nowhere → 404, body non-empty)

Existing http_listen_bif.sh (5/5), http_route.sh (11/11),
http_publish_fold.sh (10/10) unchanged. Erlang-on-SX conformance
761/761. WASM boot green (no lib/sx_primitives.ml changes).

Unblocks Step 8b-start (TCP listener spawn) and the curl-driven
9a-tcp / 9b-tcp smoke tests.
2026-06-05 20:46:38 +00:00
0f85bd963a fed-sx-m1: Step 8b-start — http_server:start/1 + dict↔proplist marshaling; live TCP smoke 5/5
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
`next/kernel/http_server.erl` gains `start/1(Port)` + `start/2(Port, Cfg)`. Both spawn an Erlang process that hosts
the native `http:listen/2` accept loop with the Cfg-aware `route/2` as the handler.

The blocker — the BIF wrapper in `lib/erlang/runtime.sx` had no dict↔proplist marshaling, so Erlang handler funs
couldn't pattern-match on an opaque SX request dict — is resolved by a new family of helpers added next to `er-of-sx`
(which is left untouched so non-HTTP callers see no behavioural drift):

  er-request-dict-to-proplist   request dict -> [{method,<<>>},{path,<<>>},...] (atom keys)
  er-of-sx-deep                 recursive marshal: dicts -> binary-keyed proplist
  er-dict-to-header-proplist    headers: [{<<"content-type">>,<<"text/plain">>},...]
                                 (binary keys keep arbitrary user input out of the atom table)
  er-proplist-to-dict           response proplist -> SX dict for native serialiser
  er-proplist-fill!             dict-set! walker over a cons-of-2-tuples
  er-to-sx-deep                 recursive marshal: cons-of-2-tuples -> nested dict
  er-proplist-2tuple?           predicate distinguishing a header proplist from a binary body

`er-bif-http-listen`'s body is updated to route through the new pair instead of `er-of-sx` / `er-to-sx`. Existing
`http_listen_bif.sh` (Step 8a) still passes — the BIF's external contract (port + handler validation, registration)
hasn't changed, only the request/response shape the handler sees.

This commit also lands a small pre-existing unstaged refactor that was sitting in the same file (er-binary->string
helper above er-bif-http-listen, a "Register everything at load time." comment move, and the binary_to_list /
list_to_binary / er-iolist-walk! defines reshuffled into the er-register-builtin-bifs! body). The refactor was
agreed-out-of-scope earlier in the loop but was unblocked this iteration when the user OK'd progress on 8b-start.
Bundling it here keeps the lib/erlang/runtime.sx diff coherent.

Tests:
- `next/tests/http_marshal.sh` (10 cases) — marshaling unit tests: request dict → cons proplist; method as
  <<"GET">> via SX-side proplist walker; path-as-string roundtrip; nested headers reach through binary keys;
  response status/body field marshaling; nested headers reconstruct dict; full round-trip preserves status.
- `next/tests/http_server_start.sh` (6 cases) — structural verification: http_server module loaded, start bound
  in module env, marshalers defined as lambdas, http:listen BIF registered. Can't invoke spawn in an Erlang test
  because the cooperative scheduler (`er-sched-run-all!`) drains every runnable process before returning to the
  caller, and the listener's accept loop never exits.
- `next/tests/http_server_tcp.sh` (5 cases) — **first live end-to-end transport test in the milestone**: boots
  sx_server in background with FIFO-held stdin (~10s boot for all lib/erlang/*.sx loads + module compile +
  Unix.bind), then drives the listener via shell-side curl over real TCP. Verifies GET / → 200, GET
  /.well-known/sx-capabilities → 200, GET unknown → 404, POST /activity → 401 with no/bad bearer. Doubles as the
  smoke surface for 9a-tcp / 9b-tcp.

Erlang conformance **761/761** unchanged. All standing suites stay green (http_listen_bif 5/5, log_disk 12/12,
log_rotate 10/10, term_codec 18/18).

Step 8b-start ticked in plans/fed-sx-milestone-1.md. Remaining in the milestone: 9a-tcp / 9b-tcp — partly covered
by http_server_tcp.sh's smoke probes; the full curl-driven publish flows are the next iteration.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-05 20:30:15 +00:00
e1336986cd fed-sx-m1: tick Step 6e as superseded by 8c-post-publish-http
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
The "HTTP handler for POST /activity glue" bullet (6e) pre-dates the Step 8 dispatch refactor that landed the same
functionality with broader test coverage. `http_server:route/2` already wires POST `/activity` to
`nx_kernel:publish/1` when the kernel process is registered (success → 200 with `cid: <Cid>` body via
`cid_response/1`; sig/replay failure → 422 via `validation_failed_response/0`), and falls back to the stub
`post_activity_response/0` when the kernel isn't running. Per-format response variants (json / sx / cbor /
activity+json) followed in 8d-dispatch-post via `cid_response_for/2` + `post_activity_response_for/1`.

Verified by the standing suites: `next/tests/http_publish.sh` 10/10 and `next/tests/http_post_format.sh` 13/13.

Plan-only commit — no source changes, no test changes. Routes the next iteration past 6e onto the next genuinely
unticked sub-deliverable.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-05 08:03:42 +00:00
ed9f180d12 fed-sx-m1: Step 3c.b gen_server-mediated concurrent appends — next/kernel/log_server.erl + 15/15 log_server tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
`next/kernel/log_server.erl` (behaviour gen_server) wraps the pure Step 3c.a `log` substrate behind a per-actor process so
concurrent writers serialise through `gen_server:call` instead of racing on the disk segment writer.

API mirrors the pure log substrate:
  start_link(ActorId, BasePath)        -> Pid
  start_link(ActorId, BasePath, Opts)  -> Pid     %% Opts forwarded to log:open_disk/3
  append(Pid, Activity)                -> {ok, Seq}
  tip(Pid)                             -> Seq
  entries(Pid)                         -> [Activity, ...]
  replay(Pid, InitAcc, Fun)            -> Acc
  segments(Pid)                        -> [SegLen, ...]
  stop(Pid)                            -> ok

Per the port's gen_server convention, `gen_server:start_link/2` returns a raw Pid (not `{ok, Pid}`); the API takes the Pid
directly so multiple per-actor servers coexist without a registered-name collision.

`init/1` dispatches on the Opts arg to call either `log:open_disk/2` (default 1 GiB threshold = effectively no rotation) or
`log:open_disk/3` (opt-in `{segment_size, N}`). `handle_call/3` translates each public op to the corresponding pure log call
and threads the new state through.

New `next/tests/log_server.sh` (15 cases):
- API smoke: start_link returns a Pid, single append+tip+entries round-trip, replay/3 chronological, segments visible
  through the wrapper, rotation through wrapper with opt-in `{segment_size, 16}`, stop returns ok.
- Five concurrent-writer tests, each: spawn N=3 writers, each firing M=2 appends of `{I, J}`, parent waits on N `{done,_}`
  messages via a Y-combinator-shaped receive loop. Assertions cover (a) tip = N*M, (b) length(entries) = N*M, (c) every
  `{I, J}` pair appears exactly once via `lists:all/2` membership (no losses, no dupes), (d) reopening from disk via
  `log:open_disk/2` reproduces a byte-equal entries list, (e) every writer's index appears in the entries list
  (interleaving witnessed).

Erlang-port gotchas worked around this iteration:
(a) Named recursive fun `fun WaitFn(0) -> ok; WaitFn(K) -> ... end` errors as "fun-ref syntax not yet supported" — rewritten
    as `fun (_, 0) -> ok; (Self, K) -> ... Self(Self, K - 1) end` then called as `Wait(Wait, N)`.
(b) `lists:foreach/2` isn't registered (only `lists:map/2`) — use `lists:map/2` and discard the result list when running
    side-effecting closures.
(c) gen_server message round-trip in this interpreter is ~2s per call, so concurrent N*M was tuned to 6 (`N=3, M=2`) to
    keep the whole 15-test suite under 60s wall clock; the test's correctness assertions don't depend on N*M magnitude.

Erlang conformance **761/761** unchanged (log_server.erl is in next/, not lib/erlang/). Step 3c (both .a and .b) now
fully ticked in plans/fed-sx-milestone-1.md.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-05 07:59:40 +00:00
897449cb35 fed-sx-m1: Step 3c.a segment rotation — log:open_disk/3, <ActorId>-NNNNNN.log filename, threshold-driven rotation; 10/10 log_rotate tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
`next/kernel/log.erl` rewritten around a `seg_lens :: [N0, N1, ...]` per-segment entry-count list + a `seg_size` byte threshold. Filename
scheme moved from `<ActorId>.log` to `<ActorId>-NNNNNN.log` (6-digit zero-padded) so `file:list_dir`'s alphabetical sort coincides
with numeric order.

`open_disk/3(ActorId, BasePath, [{segment_size, N}])` opts a caller into a smaller rotation threshold; `open_disk/2` keeps a 1 GiB
default that effectively never rotates (preserves Step 3b acceptance — log_disk.sh unchanged in behaviour).

Rotation rule in `place_append/4`: if the active segment's pre-append encoded size is already >= threshold AND it holds at least one
entry, the new activity opens a fresh segment; otherwise it extends the current active segment. A single huge entry that exceeds
the threshold stays alone — never rotated recursively.

On reopen, `load_all_segments` lists the dir, filters `<ActorId>-NNNNNN.log`, sorts numerically (insertion sort — `lists:sort/1`
isn't registered in this port, only `lists:append/2`/`lists:reverse/1`/`lists:filter/2`/etc.), reads each via `try_read_segment`,
and concatenates the entries to rebuild flat `entries` + `seg_lens`.

Erlang-port gotchas worked around during this iteration:
(a) String literals like `"foo"` in this port are NOT charlists — `[H|T] = "foo"` badmatches and `length("foo")` errors as "not a
    proper list". `parse_segment_name` builds prefix/suffix from `atom_to_list/1` + explicit `[$-]` / `[$., $l, $o, $g]` cons.
(b) Cross-arg variable repetition (`strip_prefix([C | Rest], [C | PRest])`) was rewritten to explicit `case C =:= P` for robustness.
(c) `Pattern = Binding` syntax in a case clause (`[_|_] = Lst when length(Lst) > 1 -> ...`) errors as "unsupported pattern type
    'match'" — replaced with `Lst when is_list(Lst), length(Lst) > 1`.

Tests:
- new `next/tests/log_rotate.sh` (10 cases): no-opt single-seg-after-3, rotation-fires-on-threshold, rotated-chronological,
  reopen-rebuilds-history, reopen-rebuilds-same-seg-shape, huge-single-entry-stays-1-seg, append-after-huge-keeps-order,
  tip-monotonic-across-rotations.
- `next/tests/log_disk.sh` updated to the new filename (`corrupted-000000.log`); stays 12/12.
- Erlang conformance 761/761 unchanged (log.erl is in next/, not lib/erlang/).

3c.a ticked in plans/fed-sx-milestone-1.md; 3c.b (gen_server-mediated concurrent appends) is the next iteration.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-05 07:40:48 +00:00
595c15a3fb fed-sx-m1: Step 3b on-disk log — open_disk/2 + write-through append/2 + length-framed segments; 12/12 log_disk tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
2026-06-05 07:20:29 +00:00
6d7f0a3f15 fed-sx-m1: Step 3b substrate fix #4 — integer literals truncate to strict int (was float; broke integer->char)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
2026-06-05 07:19:56 +00:00
076b8ae7f7 fed-sx-m1: Step 3b codec — next/kernel/term_codec.erl encode/decode + 18 round-trip tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
2026-06-05 06:56:31 +00:00
4852cca9eb fed-sx-m1: Step 3b substrate fix #3 — atom_to_list/integer_to_list as Erlang charlists; list_to_* accept both (+9 net eval, 759/759)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
2026-06-05 06:49:40 +00:00
3d80bd8ce6 fed-sx-m1: Step 3b substrate fix #2 — $X char literals decode to char code in tokenizer (+12 eval, 750/750)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
2026-06-04 22:50:35 +00:00
24e3bf53b0 fed-sx-m1: Step 3b substrate fix — binary_to_list/1 + list_to_binary/1 BIFs (+9 ffi, 738/738)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m51s
2026-06-04 22:44:02 +00:00
24763c5199 fed-sx-m1: refresh next/README with module map, test inventory, substrate gaps + resume order
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
2026-05-28 20:28:22 +00:00
004a88c03c fed-sx-m1: Step 4f-consolidate — bootstrap:start/3 one-call boot + 10 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
2026-05-28 20:05:02 +00:00
e8ca0590a3 fed-sx-m1: Step 7d-pure — sandbox:eval_pure/2,/3 + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
2026-05-28 19:26:34 +00:00
559ed68907 fed-sx-m1: Step 9b-pure — reactive smoke test in-process (trigger match+derive end-to-end) + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
2026-05-28 18:50:21 +00:00
1496136d12 fed-sx-m1: Step 9a-pure — Pin smoke test in-process (verb extensibility end-to-end) + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
2026-05-28 18:12:03 +00:00
5940b98878 fed-sx-m1: Step 5d-pure — define_registry meta-projection fold + 16 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
2026-05-28 17:38:16 +00:00
6137904368 fed-sx-m1: Step 6c-schema-pure — pipeline:stage_schema/1,/2 with SchemaLookup callback + 14 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-05-28 17:02:57 +00:00
2a14b37c6c fed-sx-m1: Step 8d-dispatch-get — format-aware actor/artifact/projection/list responses + dispatch/3 refactor + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
2026-05-28 16:28:07 +00:00
dd7b7d7a2d fed-sx-m1: Step 8d-dispatch-post — format-aware POST /activity (cid_response_for + post_activity_response_for) + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
2026-05-28 15:39:23 +00:00
1aaede4272 fed-sx-m1: Step 8d-content-type — content_type_for/1 + ok_response/2 + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
2026-05-28 15:04:46 +00:00
3c945b9104 fed-sx-m1: Step 8d-dispatch-cap — capabilities_body_for + Accept-aware route + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
2026-05-28 14:31:59 +00:00
fa064093f5 fed-sx-m1: Step 8d-accept — Accept header parsing (accept_format/1 + accept_format_from/1) + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
2026-05-28 13:57:48 +00:00
cd7693d443 fed-sx-m1: Step 5c-populate — bootstrap:populate_registry into gen_server + 14 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
2026-05-28 13:22:45 +00:00
285dd64dc2 fed-sx-m1: Step 9-pre-fold — HTTP POST -> publish -> projection-fold end-to-end (10 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
2026-05-28 12:44:47 +00:00
05100ef050 fed-sx-m1: Step 8c-post-publish-http — POST /activity wires through nx_kernel:publish + 10 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
2026-05-28 12:12:30 +00:00
ccceb4a0b3 fed-sx-m1: Step 8c-post-publish-srv — gen_server-wrapped nx_kernel (start_link + publish/query/log_tip) + 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
2026-05-28 11:39:48 +00:00
e9a905eb5f fed-sx-m1: Step 8c-post-publish-pure — nx_kernel pure orchestrator (new/3 + publish/2) + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-05-28 11:08:47 +00:00
f2aa294f00 fed-sx-m1: Step 8c-post-auth — POST /activity bearer-token gate + route/2 + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
2026-05-28 10:38:36 +00:00
212bf53a03 fed-sx-m1: Step 8c-proj — GET /projections + /projections/{name} routes + 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
2026-05-28 10:09:33 +00:00
2aeab806fb fed-sx-m1: Step 8c-art — GET /artifacts/{cid} route reusing match_prefix + 9 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
2026-05-28 09:41:41 +00:00
a4905a3e71 fed-sx-m1: Step 8c-actors-doc — match_prefix + GET /actors/{id} route + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
2026-05-28 09:12:28 +00:00
d15f4d229e fed-sx-m1: Step 8c-cap — GET /.well-known/sx-capabilities route + 8 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
2026-05-28 08:42:02 +00:00
b45ea2aa16 fed-sx-m1: Step 8b-route — http_server:route/1 pure dispatch + ok/not_found helpers + 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-05-28 08:06:01 +00:00
81efa1d8f0 fed-sx-m1: Step 8a — http:listen/2 BIF wrapper in runtime.sx (BRIEFING-EXCEPTION) + 5 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
2026-05-28 07:35:48 +00:00
1ea47681b2 fed-sx-m1: Step 7c — outbox:publish broadcasts to projection processes + 14 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
2026-05-28 06:57:36 +00:00
c91683b885 fed-sx-m1: Step 7b — gen_server-per-projection (start_link/3 + async_fold + query) + 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-05-28 06:22:11 +00:00
4956a6d8ae fed-sx-m1: Step 7a — pure-functional projection driver + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
2026-05-28 05:48:30 +00:00
c5481d06aa fed-sx-m1: Step 6d-publish — outbox:publish/2 orchestration (construct+sign+validate+append) + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-05-28 05:14:11 +00:00
6e12f539fd fed-sx-m1: Step 6d-cs — outbox:construct + sign + cid_of + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
2026-05-28 04:39:49 +00:00
8c592c41b8 fed-sx-m1: Step 6c-replay — pipeline:stage_replay/1,/2 (factory + direct) + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
2026-05-28 04:08:50 +00:00
b7f7915c2a fed-sx-m1: Step 6b-sig — pipeline:stage_signature/1,/2 (factory + direct) + 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
2026-05-28 03:36:25 +00:00
460257f2bb fed-sx-m1: Step 6b-env — pipeline:stage_envelope wired against envelope:validate_shape + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
2026-05-28 03:03:55 +00:00
9cb002c856 fed-sx-m1: Step 6a — pipeline:run_stages driver + validate_inbound/outbound + 10 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
2026-05-28 02:32:06 +00:00
aa6b01f430 fed-sx-m1: Step 5b — gen_server-wrapped registry + named-process API + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
2026-05-28 01:59:55 +00:00
1aab9eff7d fed-sx-m1: Step 4e — bootstrap:load_genesis/strip_sx_suffix bridges read_genesis -> registry + 15 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
2026-05-28 01:28:06 +00:00
d1a2ebd709 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
2026-05-28 00:46:54 +00:00
203a3a3c67 fed-sx-m1: Step 4d — bootstrap:build_genesis/verify_genesis + cidhash helpers + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
2026-05-28 00:19:11 +00:00
73a1a55572 fed-sx-m1: Step 4c — bootstrap:read_genesis/0,1 + 5 helpers + 15 read tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 14m10s
2026-05-27 23:50:45 +00:00
ae5df5cfa1 fed-sx-m1: Step 4b-cod — 8 bootstrap codecs/sig-suites/audience files + manifest complete + 14 new parse tests (50 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
2026-05-27 23:21:20 +00:00
5d7b167a93 fed-sx-m1: Step 4b-vld — 3 bootstrap validators + manifest update + 5 new parse tests (36 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
2026-05-27 23:10:11 +00:00
cfdb9cd875 fed-sx-m1: Step 4b-proj — 7 bootstrap projections + manifest update + 9 new parse tests (31 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
2026-05-27 22:52:54 +00:00
4c0295cdff fed-sx-m1: Step 4b-obj — 10 bootstrap object-types + manifest update + 12 new parse tests (22 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
2026-05-27 19:48:26 +00:00
b308ddb9b0 fed-sx-m1: Step 4b-act — Update + Delete activity-types + manifest update + 5 new parse tests (10 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
2026-05-27 07:44:20 +00:00
28168b16aa fed-sx-m1: Step 4a — genesis manifest + Create activity-type seed + 5 parse tests; Step 3b parked (substrate term-codec gap)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 16s
2026-05-27 07:18:04 +00:00
ab159dface fed-sx-m1: Step 3a — in-memory log:open/append/tip/replay + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
2026-05-27 07:06:40 +00:00
53b4a4c1fd fed-sx-m1: Step 2c — envelope:verify_signature/2 (time-aware key lookup + HMAC stand-in) + 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
2026-05-26 21:00:39 +00:00
65dfdd0ba4 fed-sx-m1: Step 2b — envelope:canonical_bytes/1 + 8 determinism tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
2026-05-26 20:41:27 +00:00
e11e8b941f fed-sx-m1: Step 2a — envelope:validate_shape/1 + get_field/2 + 15 shape tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
2026-05-26 20:29:25 +00:00
9cbf14fe8c fed-sx-m1: Step 1b — nx_cid kernel module + 13 canonical CID tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 6m22s
2026-05-26 19:55:13 +00:00
11ed4ddf27 fed-sx-m1: Step 1a — next/ skeleton + README + gitignore
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 14s
2026-05-26 19:44:56 +00:00
198 changed files with 17189 additions and 14444 deletions

View File

@@ -1 +1 @@
{"sessionId":"bf20a443-9df8-4cb9-932e-8c6f4c4625c2","pid":1303602,"procStart":"253831081","acquiredAt":1779865895644}
{"sessionId":"31c80255-eb92-43e4-8997-84ad84e27326","pid":90960,"procStart":"564684","acquiredAt":1777049890282}

View File

@@ -2,7 +2,7 @@
"mcpServers": {
"sx-tree": {
"type": "stdio",
"command": "/root/rose-ash/hosts/ocaml/_build/default/bin/mcp_tree.exe"
"command": "./hosts/ocaml/_build/default/bin/mcp_tree.exe"
},
"rose-ash-services": {
"type": "stdio",

View File

@@ -956,8 +956,118 @@
(= ty "nil") (er-mk-nil)
:else v))))
;; ── HTTP request/response marshaling (Step 8b-start) ────────────
;; The native `http-listen` primitive hands the handler an SX dict
;; {:method :path :query :headers :body}
;; and expects an SX dict back
;; {:status :headers :body}
;; This layer converts so Erlang handlers see proper proplists:
;; [{method, <<"GET">>}, {path, <<"/foo">>}, {query, <<>>},
;; {headers, [{<<"content-type">>, <<"text/plain">>}, ...]},
;; {body, <<...>>}]
;; Headers ride as a nested proplist with binary keys — header names
;; are arbitrary user input, so they stay out of the atom table. The
;; outer request keys (method/path/query/headers/body) are fixed and
;; small, so they become atoms (cheap to pattern-match against).
(define er-of-sx-deep
(fn (v)
(cond
(= (type-of v) "dict") (er-dict-to-header-proplist v)
:else (er-of-sx v))))
(define er-dict-to-header-proplist
(fn (d)
(let ((ks (keys d)) (out (er-mk-nil)))
(for-each
(fn (i)
(let ((idx (- (- (len ks) 1) i)))
(let ((k (nth ks idx)))
(let ((v (get d k)))
(set!
out
(er-mk-cons
(er-mk-tuple
(list
(er-mk-binary (map char->integer (string->list k)))
(er-of-sx-deep v)))
out))))))
(range 0 (len ks)))
out)))
(define er-request-dict-to-proplist
(fn (d)
(cond
(not (= (type-of d) "dict")) (er-of-sx d)
:else
(let ((ks (keys d)) (out (er-mk-nil)))
(for-each
(fn (i)
(let ((idx (- (- (len ks) 1) i)))
(let ((k (nth ks idx)))
(let ((v (get d k)))
(set!
out
(er-mk-cons
(er-mk-tuple
(list (er-mk-atom k) (er-of-sx-deep v)))
out))))))
(range 0 (len ks)))
out))))
;; Inverse: handler's proplist response -> SX dict for native send.
;; Value rules:
;; Erlang binary -> SX string (bytes joined)
;; Erlang integer -> SX number passthrough
;; Erlang cons of 2-tuples -> nested SX dict (e.g. headers)
;; Erlang cons (other shapes) -> SX list via er-to-sx
;; anything else -> er-to-sx passthrough
(define er-proplist-2tuple?
(fn (v)
(cond
(er-nil? v) true
(er-cons? v)
(let ((h (get v :head)))
(cond
(and (er-tuple? h) (= (len (get h :elements)) 2))
(er-proplist-2tuple? (get v :tail))
:else false))
:else false)))
(define er-to-sx-deep
(fn (v)
(cond
(er-binary? v) (list->string (map integer->char (get v :bytes)))
(and (er-cons? v) (er-proplist-2tuple? v)) (er-proplist-to-dict v)
:else (er-to-sx v))))
(define er-proplist-to-dict
(fn (pl)
(let ((d (dict)))
(er-proplist-fill! pl d)
d)))
(define er-proplist-fill!
(fn (pl d)
(cond
(er-nil? pl) nil
(er-cons? pl)
(let ((head (get pl :head)) (tail (get pl :tail)))
(cond
(and (er-tuple? head) (= (len (get head :elements)) 2))
(let ((kv (get head :elements)))
(let ((k (nth kv 0)) (v (nth kv 1)))
(let ((key-str
(cond
(er-atom? k) (get k :name)
(er-binary? k)
(list->string (map integer->char (get k :bytes)))
:else (str k))))
(dict-set! d key-str (er-to-sx-deep v))
(er-proplist-fill! tail d))))
:else (er-proplist-fill! tail d)))
:else nil)))
;; Load an Erlang module declaration. Source must start with
;; `-module(Name).` and contain function definitions. Functions
@@ -1468,9 +1578,26 @@
;; entry is keyed by "Module/Name/Arity"; multi-arity BIFs register
;; once per arity. Called eagerly at the end of runtime.sx so the
;; registry is ready before any erlang-eval-ast call.
(define er-register-builtin-bifs!
(fn ()
;; erlang module — type predicates (all pure)
(define
er-bif-http-listen
(fn
(vs)
(let
((port (nth vs 0)) (handler (nth vs 1)))
(cond
(not (= (type-of port) "number"))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
(not (er-fun? handler))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (let
((sx-handler (fn (req-dict) (er-http-resp-to-sx (er-apply-fun handler (list (er-http-req-of-sx req-dict)))))))
(http-listen port sx-handler))))))
;; Register everything at load time.
(define
er-register-builtin-bifs!
(fn
()
(er-register-pure-bif! "erlang" "is_integer" 1 er-bif-is-integer)
(er-register-pure-bif! "erlang" "is_atom" 1 er-bif-is-atom)
(er-register-pure-bif! "erlang" "is_list" 1 er-bif-is-list)
@@ -1479,27 +1606,61 @@
(er-register-pure-bif! "erlang" "is_float" 1 er-bif-is-float)
(er-register-pure-bif! "erlang" "is_boolean" 1 er-bif-is-boolean)
(er-register-pure-bif! "erlang" "is_pid" 1 er-bif-is-pid)
(er-register-pure-bif! "erlang" "is_reference" 1 er-bif-is-reference)
(er-register-pure-bif!
"erlang"
"is_reference"
1
er-bif-is-reference)
(er-register-pure-bif! "erlang" "is_binary" 1 er-bif-is-binary)
(er-register-pure-bif! "erlang" "is_function" 1 er-bif-is-function)
(er-register-pure-bif! "erlang" "is_function" 2 er-bif-is-function)
;; erlang module — pure data ops
(er-register-pure-bif!
"erlang"
"is_function"
1
er-bif-is-function)
(er-register-pure-bif!
"erlang"
"is_function"
2
er-bif-is-function)
(er-register-pure-bif! "erlang" "length" 1 er-bif-length)
(er-register-pure-bif! "erlang" "hd" 1 er-bif-hd)
(er-register-pure-bif! "erlang" "tl" 1 er-bif-tl)
(er-register-pure-bif! "erlang" "element" 2 er-bif-element)
(er-register-pure-bif! "erlang" "tuple_size" 1 er-bif-tuple-size)
(er-register-pure-bif! "erlang" "byte_size" 1 er-bif-byte-size)
(er-register-pure-bif! "erlang" "atom_to_list" 1 er-bif-atom-to-list)
(er-register-pure-bif! "erlang" "list_to_atom" 1 er-bif-list-to-atom)
(er-register-pure-bif!
"erlang"
"atom_to_list"
1
er-bif-atom-to-list)
(er-register-pure-bif!
"erlang"
"list_to_atom"
1
er-bif-list-to-atom)
(er-register-pure-bif! "erlang" "abs" 1 er-bif-abs)
(er-register-pure-bif! "erlang" "min" 2 er-bif-min)
(er-register-pure-bif! "erlang" "max" 2 er-bif-max)
(er-register-pure-bif! "erlang" "tuple_to_list" 1 er-bif-tuple-to-list)
(er-register-pure-bif! "erlang" "list_to_tuple" 1 er-bif-list-to-tuple)
(er-register-pure-bif! "erlang" "integer_to_list" 1 er-bif-integer-to-list)
(er-register-pure-bif! "erlang" "list_to_integer" 1 er-bif-list-to-integer)
;; erlang module — process / runtime (side-effecting)
(er-register-pure-bif!
"erlang"
"tuple_to_list"
1
er-bif-tuple-to-list)
(er-register-pure-bif!
"erlang"
"list_to_tuple"
1
er-bif-list-to-tuple)
(er-register-pure-bif!
"erlang"
"integer_to_list"
1
er-bif-integer-to-list)
(er-register-pure-bif!
"erlang"
"list_to_integer"
1
er-bif-list-to-integer)
(er-register-bif! "erlang" "self" 0 er-bif-self)
(er-register-bif! "erlang" "spawn" 1 er-bif-spawn)
(er-register-bif! "erlang" "spawn" 3 er-bif-spawn)
@@ -1515,12 +1676,16 @@
(er-register-bif! "erlang" "unregister" 1 er-bif-unregister)
(er-register-bif! "erlang" "whereis" 1 er-bif-whereis)
(er-register-bif! "erlang" "registered" 0 er-bif-registered)
;; erlang module — exception raising (modelled as side-effecting)
(er-register-bif! "erlang" "throw" 1
(er-register-bif!
"erlang"
"throw"
1
(fn (vs) (raise (er-mk-throw-marker (er-bif-arg1 vs "throw")))))
(er-register-bif! "erlang" "error" 1
(er-register-bif!
"erlang"
"error"
1
(fn (vs) (raise (er-mk-error-marker (er-bif-arg1 vs "error")))))
;; lists module — all pure
(er-register-pure-bif! "lists" "reverse" 1 er-bif-lists-reverse)
(er-register-pure-bif! "lists" "map" 2 er-bif-lists-map)
(er-register-pure-bif! "lists" "foldl" 3 er-bif-lists-foldl)
@@ -1534,11 +1699,13 @@
(er-register-pure-bif! "lists" "filter" 2 er-bif-lists-filter)
(er-register-pure-bif! "lists" "any" 2 er-bif-lists-any)
(er-register-pure-bif! "lists" "all" 2 er-bif-lists-all)
(er-register-pure-bif! "lists" "duplicate" 2 er-bif-lists-duplicate)
;; io module — side-effecting (writes to io buffer)
(er-register-pure-bif!
"lists"
"duplicate"
2
er-bif-lists-duplicate)
(er-register-bif! "io" "format" 1 er-bif-io-format)
(er-register-bif! "io" "format" 2 er-bif-io-format)
;; ets module — side-effecting (mutates table state)
(er-register-bif! "ets" "new" 2 er-bif-ets-new)
(er-register-bif! "ets" "insert" 2 er-bif-ets-insert)
(er-register-bif! "ets" "lookup" 2 er-bif-ets-lookup)
@@ -1546,82 +1713,88 @@
(er-register-bif! "ets" "delete" 2 er-bif-ets-delete)
(er-register-bif! "ets" "tab2list" 1 er-bif-ets-tab2list)
(er-register-bif! "ets" "info" 2 er-bif-ets-info)
;; code module — side-effecting (mutates module registry, kills procs)
(er-register-bif! "code" "load_binary" 3 er-bif-code-load-binary)
(er-register-bif! "code" "purge" 1 er-bif-code-purge)
(er-register-bif! "code" "soft_purge" 1 er-bif-code-soft-purge)
(er-register-bif! "code" "which" 1 er-bif-code-which)
(er-register-bif! "code" "is_loaded" 1 er-bif-code-is-loaded)
(er-register-bif! "code" "all_loaded" 0 er-bif-code-all-loaded)
;; file module
(er-register-bif! "file" "read_file" 1 er-bif-file-read-file)
(er-register-bif! "file" "write_file" 2 er-bif-file-write-file)
(er-register-bif! "file" "delete" 1 er-bif-file-delete)
;; Phase 8 FFI — host-primitive BIFs (loops/fed-prims)
(er-register-pure-bif! "crypto" "hash" 2 er-bif-crypto-hash)
(er-register-pure-bif! "cid" "from_bytes" 1 er-bif-cid-from-bytes)
(er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string)
;; ── binary_to_list / list_to_binary (Step 3b — term codec) ──────
;; Standard Erlang semantics:
;; binary_to_list(<<B1,B2,...>>) -> [B1, B2, ...] (Erlang cons of ints)
;; list_to_binary(IoList) -> <<...>> (flattens nested
;; iolists; elements are byte ints 0-255 or binaries)
;; Bad arg / out-of-range byte / non-iolist element -> error:badarg.
(define er-bif-binary-to-list
(fn (vs)
(let ((v (nth vs 0)))
(cond
(not (er-binary? v))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((bs (get v :bytes)) (out (er-mk-nil)))
(for-each
(fn (i)
(set! out (er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
(range 0 (len bs)))
out)))))
;; Walk an Erlang iolist, appending bytes to `acc` (a mutable SX list).
;; Accepts: nil, cons-of-X, binary, integer in 0..255. Anything else
;; signals failure by setting (nth fail 0) to true.
(define er-iolist-walk!
(fn (v acc fail)
(cond
(nth fail 0) nil
(er-nil? v) nil
(er-cons? v)
(do (er-iolist-walk! (get v :head) acc fail)
(er-iolist-walk! (get v :tail) acc fail))
(er-binary? v)
(for-each
(fn (i) (append! acc (nth (get v :bytes) i)))
(range 0 (len (get v :bytes))))
(= (type-of v) "number")
(define
er-bif-binary-to-list
(fn
(vs)
(let
((v (nth vs 0)))
(cond
(not (er-binary? v))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (let
((bs (get v :bytes)) (out (er-mk-nil)))
(for-each
(fn
(i)
(set!
out
(er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
(range 0 (len bs)))
out)))))
(define
er-iolist-walk!
(fn
(v acc fail)
(cond
(and (>= v 0) (<= v 255)) (append! acc v)
:else (set-nth! fail 0 true))
:else (set-nth! fail 0 true))))
(define er-bif-list-to-binary
(fn (vs)
(let ((v (nth vs 0)) (acc (list)) (fail (list false)))
(cond
(not (or (er-nil? v) (er-cons? v) (er-binary? v)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(nth fail 0)
nil
(er-nil? v)
nil
(er-cons? v)
(do
(er-iolist-walk! v acc fail)
(cond
(nth fail 0)
(er-iolist-walk! (get v :head) acc fail)
(er-iolist-walk! (get v :tail) acc fail))
(er-binary? v)
(for-each
(fn (i) (append! acc (nth (get v :bytes) i)))
(range 0 (len (get v :bytes))))
(= (type-of v) "number")
(cond
(and (>= v 0) (<= v 255))
(append! acc v)
:else (set-nth! fail 0 true))
:else (set-nth! fail 0 true))))
(define
er-bif-list-to-binary
(fn
(vs)
(let
((v (nth vs 0)) (acc (list)) (fail (list false)))
(cond
(not (or (er-nil? v) (er-cons? v) (er-binary? v)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (do
(er-iolist-walk! v acc fail)
(cond
(nth fail 0)
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (er-mk-binary acc)))))))
:else (er-mk-binary acc)))))))
(er-register-bif! "file" "list_dir" 1 er-bif-file-list-dir)
(er-register-pure-bif! "erlang" "binary_to_list" 1 er-bif-binary-to-list)
(er-register-pure-bif! "erlang" "list_to_binary" 1 er-bif-list-to-binary)
(er-register-pure-bif!
"erlang"
"binary_to_list"
1
er-bif-binary-to-list)
(er-register-pure-bif!
"erlang"
"list_to_binary"
1
er-bif-list-to-binary)
(er-mk-atom "ok")))
;; Register everything at load time.
(er-register-bif! "http" "listen" 2 er-bif-http-listen)
(er-register-builtin-bifs!)

View File

@@ -1,38 +0,0 @@
; feed/acl — per-viewer visibility filtering. The same candidate stream yields
; different timelines for different viewers, so ACL is applied per request and
; pre-ACL timelines are never cached.
;
; permit? is injected: (permit? viewer activity) -> bool. Wire a real acl-sx
; predicate here; feed/permit-acl? is a self-contained default that reads an
; optional :visible-to allowlist on the activity.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem?), lib/feed/rank.sx (feed/top).
; default permit: actor always sees own activity; absent/nil :visible-to is
; public; otherwise viewer must be in the allowlist.
(define
feed/permit-acl?
(fn
(viewer a)
(or
(equal? viewer (get a :actor))
(let
((allowed (get a :visible-to nil)))
(if (= allowed nil) true (feed/-elem? viewer allowed))))))
(define feed/permit-public? (fn (viewer a) true))
; filter a stream to what viewer may read
(define
feed/visible
(fn
(stream viewer permit?)
(feed/filter stream (fn (a) (permit? viewer a)))))
; the capstone: candidate stream -> ACL for viewer -> rank -> top-N
(define
feed/timeline
(fn
(stream viewer permit? score-fn n)
(feed/top (feed/visible stream viewer permit?) score-fn n)))

View File

@@ -1,62 +0,0 @@
; feed/aggregate — group-by / counting via key-reduce. Keys must be strings
; (dict keys), so composite keys (actor, day) are joined into one string.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx.
; group activities into a dict: key-string -> (list of activities), order-preserving
(define
feed/group-by
(fn
(stream key-fn)
(reduce
(fn
(g a)
(let
((k (key-fn a)))
(assoc g k (append (get g k (list)) (list a)))))
{}
(feed/items stream))))
; key-string -> count
(define
feed/group-count
(fn
(stream key-fn)
(reduce
(fn
(g a)
(let
((k (key-fn a)))
(assoc g k (+ (get g k 0) 1))))
{}
(feed/items stream))))
; --- composite keys ---------------------------------------------------------
(define feed/day (fn (at window) (floor (/ at window))))
; (actor, day-bucket) -> "actor#day"
(define
feed/actor-day-key
(fn
(window)
(fn
(a)
(string-append
(get a :actor)
"#"
(number->string (feed/day (get a :at) window))))))
(define
feed/by-actor-day
(fn (stream window) (feed/group-count stream (feed/actor-day-key window))))
; per-actor activity counts
(define
feed/actor-counts
(fn (stream) (feed/group-count stream feed/actor)))
; per-object activity counts (engagement)
(define
feed/object-counts
(fn (stream) (feed/group-count stream feed/object)))

View File

@@ -1,24 +0,0 @@
; feed/api — ergonomic API over the stream layer for non-APL callers.
; A single mutable activity log; post appends, all returns it as a stream.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx (loaded by harness).
(define feed/-log (list))
; post — normalize then append. Returns the stored activity.
(define
feed/post
(fn
(raw)
(let
((a (feed/normalize raw)))
(begin (set! feed/-log (append feed/-log (list a))) a))))
; all — the whole log as a stream (insertion order)
(define feed/all (fn () (feed/stream feed/-log)))
; reset! — clear the log (test hygiene)
(define feed/reset! (fn () (begin (set! feed/-log (list)) nil)))
; size — number of posted activities
(define feed/size (fn () (len feed/-log)))

View File

@@ -1,125 +0,0 @@
#!/usr/bin/env bash
# lib/feed/conformance.sh — run feed test suites, emit scoreboard.json + scoreboard.md.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="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
SUITES=(basic fanout rank integration content notify home dedupe trending mute page thread)
OUT_JSON="lib/feed/scoreboard.json"
OUT_MD="lib/feed/scoreboard.md"
run_suite() {
local suite=$1
local file="lib/feed/tests/${suite}.sx"
local TMP
TMP=$(mktemp)
cat > "$TMP" << EPOCHS
(epoch 1)
(load "spec/stdlib.sx")
(load "lib/r7rs.sx")
(load "lib/apl/runtime.sx")
(load "lib/feed/normalize.sx")
(load "lib/feed/stream.sx")
(load "lib/feed/api.sx")
(load "lib/feed/fanout.sx")
(load "lib/feed/dedupe.sx")
(load "lib/feed/aggregate.sx")
(load "lib/feed/rank.sx")
(load "lib/feed/acl.sx")
(load "lib/feed/fed.sx")
(load "lib/feed/content.sx")
(load "lib/feed/notify.sx")
(load "lib/feed/home.sx")
(load "lib/feed/trending.sx")
(load "lib/feed/mute.sx")
(load "lib/feed/page.sx")
(load "lib/feed/thread.sx")
(epoch 2)
(eval "(define feed-test-pass 0)")
(eval "(define feed-test-fail 0)")
(eval "(define feed-test (fn (name got expected) (if (= got expected) (set! feed-test-pass (+ feed-test-pass 1)) (set! feed-test-fail (+ feed-test-fail 1)))))")
(epoch 3)
(load "${file}")
(epoch 4)
(eval "(list feed-test-pass feed-test-fail)")
EPOCHS
local OUTPUT
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
rm -f "$TMP"
local LINE
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
if [ -z "$LINE" ]; then
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
| sed -E 's/^\(ok 4 //; s/\)$//')
fi
local P F
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
P=${P:-0}
F=${F:-0}
echo "${P} ${F}"
}
declare -A SUITE_PASS
declare -A SUITE_FAIL
TOTAL_PASS=0
TOTAL_FAIL=0
echo "Running feed conformance suite..." >&2
for s in "${SUITES[@]}"; do
read -r p f < <(run_suite "$s")
SUITE_PASS[$s]=$p
SUITE_FAIL[$s]=$f
TOTAL_PASS=$((TOTAL_PASS + p))
TOTAL_FAIL=$((TOTAL_FAIL + f))
printf " %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
done
# scoreboard.json
{
printf '{\n'
printf ' "suites": {\n'
first=1
for s in "${SUITES[@]}"; do
if [ $first -eq 0 ]; then printf ',\n'; fi
printf ' "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
first=0
done
printf '\n },\n'
printf ' "total_pass": %d,\n' "$TOTAL_PASS"
printf ' "total_fail": %d,\n' "$TOTAL_FAIL"
printf ' "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
printf '}\n'
} > "$OUT_JSON"
# scoreboard.md
{
printf '# feed Conformance Scoreboard\n\n'
printf '_Generated by `lib/feed/conformance.sh`_\n\n'
printf '| Suite | Pass | Fail | Total |\n'
printf '|-------|-----:|-----:|------:|\n'
for s in "${SUITES[@]}"; do
p=${SUITE_PASS[$s]}
f=${SUITE_FAIL[$s]}
printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
done
printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
} > "$OUT_MD"
echo "Wrote $OUT_JSON and $OUT_MD" >&2
echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
[ "$TOTAL_FAIL" -eq 0 ]

View File

@@ -1,68 +0,0 @@
; feed/content — TF-IDF relevance over activity :tags. Rare tags carry more
; signal, so an activity matching an uncommon tag ranks above one matching a
; common tag. Composes with rank.sx: feed/tfidf-score is just another scorer.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-distinct), lib/feed/rank.sx (feed/rank).
; document frequency: tag -> number of activities whose :tags contain it
; (a tag repeated within one activity counts once toward df)
(define
feed/tag-df
(fn
(stream)
(reduce
(fn
(df a)
(reduce
(fn (d t) (assoc d t (+ (get d t 0) 1)))
df
(feed/-distinct (get a :tags))))
{}
(feed/items stream))))
; inverse document frequency: tag -> log(N / df)
(define
feed/tag-idf
(fn
(stream)
(let
((n (feed/count stream)) (df (feed/tag-df stream)))
(reduce
(fn (idf t) (assoc idf t (log (/ n (get df t)))))
{}
(keys df)))))
; term frequency within one activity: tag -> occurrence count
(define
feed/-tf
(fn
(a)
(reduce
(fn (tf t) (assoc tf t (+ (get tf t 0) 1)))
{}
(get a :tags))))
; relevance of an activity to a query (list of tags) given precomputed idf:
; sum over query tags of tf(tag in activity) * idf(tag in corpus)
(define
feed/tfidf-score
(fn
(idf query)
(fn
(a)
(let
((tf (feed/-tf a)))
(reduce
(fn
(acc t)
(+ acc (* (get tf t 0) (get idf t 0))))
0
query)))))
; rank a stream by relevance to query tags (idf computed over the stream itself)
(define
feed/by-relevance
(fn
(stream query)
(feed/rank stream (feed/tfidf-score (feed/tag-idf stream) query))))

View File

@@ -1,76 +0,0 @@
; feed/dedupe — collapse duplicate items, keeping first occurrence per key.
; Each verb may want its own key (see briefing): "alice posted X" keys on
; (actor verb object) — distinct per actor; "alice liked X / bob liked X"
; collapse on (verb object) so the cross-actor likes fold into one.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem? lives in fanout.sx).
; generic: dedupe a stream by key-fn, first occurrence wins (stable)
(define
feed/-dedup-by
(fn
(items key-fn)
(get
(reduce
(fn
(st x)
(let
((k (key-fn x)))
(if (feed/-elem? k (get st :seen)) st {:seen (append (get st :seen) (list k)) :out (append (get st :out) (list x))})))
{:seen (list) :out (list)}
items)
:out)))
(define
feed/dedupe
(fn
(stream key-fn)
(feed/stream (feed/-dedup-by (feed/items stream) key-fn))))
; --- keys -------------------------------------------------------------------
(define
feed/activity-key
(fn (a) (list (get a :actor) (get a :verb) (get a :object))))
; collapse cross-actor duplicates of the same verb+object (e.g. likes)
(define feed/collapse-key (fn (a) (list (get a :verb) (get a :object))))
; per-receiver inbox key — one inbox event per (receiver, actor, verb, object)
(define
feed/event-key
(fn
(ev)
(let
((a (get ev :activity)))
(list (get ev :to) (get a :actor) (get a :verb) (get a :object)))))
; verbs whose duplicates collapse across actors (reactions, not authorship).
; rebindable: callers can (set! feed/collapse-verbs ...) to tune the policy.
(define
feed/collapse-verbs
(list "like" "favourite" "follow" "boost" "repost"))
; per-verb key: collapse-verbs fold on (verb object); the rest key on
; (actor verb object).
(define
feed/smart-key
(fn
(a)
(if
(feed/-elem? (get a :verb) feed/collapse-verbs)
(feed/collapse-key a)
(feed/activity-key a))))
; --- ready-made dedupers ----------------------------------------------------
(define feed/dedupe-activities (fn (s) (feed/dedupe s feed/activity-key)))
(define feed/dedupe-collapse (fn (s) (feed/dedupe s feed/collapse-key)))
; verb-aware: reactions collapse cross-actor, posts stay distinct per actor
(define feed/dedupe-smart (fn (s) (feed/dedupe s feed/smart-key)))
; dedupe an inbox: at most one event per receiver per (actor verb object)
(define feed/dedupe-inbox (fn (inbox) (feed/dedupe inbox feed/event-key)))

View File

@@ -1,114 +0,0 @@
; feed/fanout — THE SHOWCASE. Fan activities out to followers via the APL outer
; product (∘.×). activities ∘.× audience → an (activity × follower) matrix of
; inbox events; flatten to a vector; guard-keep only real follow edges.
;
; Requires: lib/apl/runtime.sx, lib/feed/normalize.sx, lib/feed/stream.sx.
;
; NOTE: apl-outer's combiner result is run through (if (scalar? r) (disclose r) r).
; A bare dict counts as a scalar (shape ()) and disclose nils it — so the combiner
; must (enclose ...) its event dict; apl-outer then discloses it back intact.
; --- graph: {followee -> (list of followers)} -------------------------------
(define feed/followers (fn (graph user) (get graph user (list))))
; build a graph from (follower followee) edges: "follower follows followee"
(define
feed/follow-graph
(fn
(edges)
(reduce
(fn
(g e)
(let
((follower (first e)) (followee (nth e 1)))
(assoc
g
followee
(append (feed/followers g followee) (list follower)))))
{}
edges)))
; --- helpers ----------------------------------------------------------------
; unwrap an apl-scalar (has :ravel) back to its value; pass activities through
(define
feed/-val
(fn
(x)
(if (and (= (type-of x) "dict") (has-key? x :ravel)) (disclose x) x)))
(define feed/-elem? (fn (x lst) (some (fn (y) (equal? x y)) lst)))
(define
feed/-distinct
(fn
(lst)
(if
(= (len lst) 0)
(list)
(get (apl-unique (make-array (list (len lst)) lst)) :ravel))))
; rank-2 matrix -> rank-1 stream of its ravel
(define feed/-flatten (fn (arr) (feed/stream (get arr :ravel))))
; distinct receivers across the whole graph, sorted for determinism
; (dict key order is unspecified, so sort to pin audience/recipient ordering)
(define
feed/audience
(fn
(graph)
(sort
(feed/-distinct
(reduce
(fn (acc k) (append acc (feed/followers graph k)))
(list)
(keys graph))))))
; --- the outer product ------------------------------------------------------
; one (activity, follower) inbox event, enclosed so apl-outer keeps the dict
(define feed/-mk-event (fn (a f) (enclose {:activity (feed/-val a) :to (feed/-val f)})))
; keep events where :to actually follows the activity's actor
(define
feed/-edge?
(fn
(graph)
(fn
(ev)
(feed/-elem?
(get ev :to)
(feed/followers graph (get (get ev :activity) :actor))))))
; fanout — activities ∘.× audience, flatten, guard-keep real edges
(define
feed/fanout
(fn
(stream graph)
(let
((matrix (apl-outer feed/-mk-event stream (feed/stream (feed/audience graph)))))
(feed/filter (feed/-flatten matrix) (feed/-edge? graph)))))
; --- inbox queries ----------------------------------------------------------
(define
feed/inbox-for
(fn
(inbox user)
(feed/filter inbox (fn (ev) (equal? (get ev :to) user)))))
(define
feed/recipients
(fn
(inbox)
(feed/-distinct (map (fn (ev) (get ev :to)) (feed/items inbox)))))
; the activities (unwrapped) destined for a user
(define
feed/inbox-activities
(fn
(inbox user)
(map
(fn (ev) (get ev :activity))
(feed/items (feed/inbox-for inbox user)))))

View File

@@ -1,60 +0,0 @@
; feed/fed — federation. Outbound: a local post fans out, then splits into local
; vs remote inboxes; remote events are handed to an injected send-fn. Inbound:
; peer activities merge into the local stream, deduped. Backfill: pull peer
; history via an injected fetch-fn and merge.
;
; remote? / send-fn / fetch-fn are injected so real fed-sx transport wires in here
; without feed depending on it.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx,
; lib/feed/dedupe.sx.
; --- merge / ingest ---------------------------------------------------------
(define
feed/merge
(fn (s1 s2) (feed/stream (append (feed/items s1) (feed/items s2)))))
; merge a peer stream into local, dropping (actor verb object) duplicates
(define
feed/ingest
(fn (local peer) (feed/dedupe-activities (feed/merge local peer))))
; --- inbound ----------------------------------------------------------------
; peer pushes raw activities to the local inbox; normalize + ingest
(define
feed/inbound
(fn
(local raw-activities)
(feed/ingest local (feed/stream (map feed/normalize raw-activities)))))
; backfill on subscribe: pull peer history via fetch-fn, normalize, ingest
(define
feed/backfill
(fn (local fetch-fn peer-id) (feed/inbound local (fetch-fn peer-id))))
; --- outbound ---------------------------------------------------------------
; split an inbox into local vs remote deliveries by viewer-id predicate
(define feed/partition-inbox (fn (inbox remote?) {:local (feed/filter inbox (fn (ev) (not (remote? (get ev :to))))) :remote (feed/filter inbox (fn (ev) (remote? (get ev :to))))}))
; fan a stream out over the graph, then partition by locality
(define
feed/federate
(fn
(stream graph remote?)
(feed/partition-inbox (feed/fanout stream graph) remote?)))
; deliver: hand each remote event to send-fn, return the local inbox to enqueue
(define
feed/deliver
(fn
(stream graph remote? send-fn)
(let
((parts (feed/federate stream graph remote?)))
(begin
(for-each
(fn (ev) (send-fn (get ev :to) (get ev :activity)))
(feed/items (get parts :remote)))
(get parts :local)))))

View File

@@ -1,23 +0,0 @@
; feed/home — the capstone. A user's home timeline is the whole pipeline as one
; line: fan all activities out over the follow graph, take the events landing in
; the viewer's inbox, dedupe cross-posts, apply the viewer's ACL, rank, take N.
;
; Requires: fanout.sx, dedupe.sx, acl.sx (feed/timeline), rank.sx, stream.sx.
; the activities in a user's inbox, as a stream
(define
feed/inbox-stream
(fn (inbox user) (feed/stream (feed/inbox-activities inbox user))))
; fanout ∘ inbox ∘ dedupe ∘ ACL ∘ rank ∘ take
(define
feed/home
(fn
(stream graph viewer permit? score-fn n)
(feed/timeline
(feed/dedupe-activities
(feed/inbox-stream (feed/fanout stream graph) viewer))
viewer
permit?
score-fn
n)))

View File

@@ -1,44 +0,0 @@
; feed/mute — viewer-controlled filtering. ACL (acl.sx) is author-controlled
; visibility; mute is the reader's own preference: hide muted actors or tags.
; Like ACL it is per-viewer and applied per request, never cached.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem?).
; drop activities authored by a muted actor
(define
feed/mute-actors
(fn
(stream actors)
(feed/filter
stream
(fn (a) (not (feed/-elem? (get a :actor) actors))))))
; drop activities carrying any muted tag
(define
feed/mute-tags
(fn
(stream tags)
(feed/filter
stream
(fn (a) (not (some (fn (t) (feed/-elem? t tags)) (get a :tags)))))))
; drop activities about a muted object (thread mute)
(define
feed/mute-objects
(fn
(stream objects)
(feed/filter
stream
(fn (a) (not (feed/-elem? (get a :object) objects))))))
; apply a viewer preference bag: {:mute-actors (...) :mute-tags (...) :mute-objects (...)}
(define
feed/apply-prefs
(fn
(stream prefs)
(feed/mute-objects
(feed/mute-tags
(feed/mute-actors stream (get prefs :mute-actors (list)))
(get prefs :mute-tags (list)))
(get prefs :mute-objects (list)))))

View File

@@ -1,31 +0,0 @@
; feed/normalize — coerce arbitrary input into the canonical activity record.
; An activity is a small dict {:actor :verb :object :at :tags}; a stream is an
; APL vector of such dicts (see stream.sx). Extra keys on the raw input survive
; (e.g. :visible-to for ACL, peer metadata for federation) — :tags is the
; flexible bag but the record is not closed.
(define feed/activity-keys (list :actor :verb :object :at :tags))
(define
feed/normalize
(fn
(raw)
(let
((d (if (= (type-of raw) "dict") raw {})))
(merge d {:actor (get d :actor "") :object (get d :object nil) :at (get d :at 0) :tags (let ((t (get d :tags (list)))) (if (list? t) t (list t))) :verb (get d :verb "post")}))))
(define
feed/activity
(fn (actor verb object at tags) (feed/normalize {:actor actor :object object :at at :tags tags :verb verb})))
(define feed/actor (fn (a) (get a :actor)))
(define feed/verb (fn (a) (get a :verb)))
(define feed/object (fn (a) (get a :object)))
(define feed/at (fn (a) (get a :at)))
(define feed/tags (fn (a) (get a :tags)))
(define
feed/activity?
(fn
(a)
(and (= (type-of a) "dict") (has-key? a :actor) (has-key? a :verb))))

View File

@@ -1,45 +0,0 @@
; feed/notify — a notification feed is a thin layer over a recipient's inbox:
; the events directed at a user, optionally verb-filtered, and a digest that
; collapses "alice, bob and 1 other liked X" by (verb, object).
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/inbox-for, feed/-elem?).
; all inbox events for a user (their raw notifications)
(define feed/notifications (fn (inbox user) (feed/inbox-for inbox user)))
; restrict to notification-worthy verbs (e.g. (list "like" "reply" "follow"))
(define
feed/notify-verbs
(fn
(inbox user verbs)
(feed/filter
(feed/inbox-for inbox user)
(fn (ev) (feed/-elem? (get (get ev :activity) :verb) verbs)))))
; group key "verb|object" — deterministic, sortable
(define
feed/-notify-key
(fn
(ev)
(let
((a (get ev :activity)))
(string-append (get a :verb) "|" (get a :object)))))
; digest: one entry per (verb, object) with the distinct actors and a count,
; ordered by key for determinism.
(define
feed/notify-digest
(fn
(inbox user)
(let
((events (feed/items (feed/inbox-for inbox user))))
(let
((groups (reduce (fn (g ev) (let ((a (get ev :activity)) (k (feed/-notify-key ev))) (let ((cur (get g k {:object (get a :object) :actors (list) :verb (get a :verb)}))) (assoc g k (assoc cur :actors (append (get cur :actors) (list (get a :actor)))))))) {} events)))
(map
(fn
(k)
(let
((grp (get groups k)))
(assoc grp :count (len (get grp :actors)))))
(sort (keys groups)))))))

View File

@@ -1,50 +0,0 @@
; feed/page — pagination. Offset/limit for indexed access, and cursor-based
; (by :at) for recency feeds, which is stable under inserts: a cursor is the
; :at of the last item seen, and the next page is the newest items older than it.
;
; Requires: lib/feed/stream.sx (feed/recent, feed/take, feed/filter).
; --- offset / limit ---------------------------------------------------------
(define
feed/page
(fn
(stream offset limit)
(feed/stream (take (drop (feed/items stream) offset) limit))))
(define
feed/page-count
(fn (stream limit) (ceil (/ (feed/count stream) limit))))
; --- cursor (recency feeds) -------------------------------------------------
; activities strictly older than cursor (scroll down / load older)
(define
feed/before
(fn
(stream cursor)
(feed/filter stream (fn (a) (< (get a :at) cursor)))))
; activities strictly newer than cursor (load newer / "N new posts")
(define
feed/after
(fn
(stream cursor)
(feed/filter stream (fn (a) (> (get a :at) cursor)))))
; one page: the `limit` newest activities older than cursor, newest first
(define
feed/page-before
(fn
(stream cursor limit)
(feed/take (feed/recent (feed/before stream cursor)) limit)))
; cursor to fetch the next (older) page: :at of the last item of a page,
; or nil when the page is empty (end of feed)
(define
feed/next-cursor
(fn
(page)
(let
((items (feed/items page)))
(if (= (len items) 0) nil (get (last items) :at)))))

View File

@@ -1,92 +0,0 @@
; feed/rank — scoring + ranking. Scorers are (activity -> number). Ranking is a
; stable two-pass grade-down: first by :at descending (the tiebreak), then by
; score descending — so ties resolve by recency, then by input order. Fully
; deterministic on ties.
;
; Requires: lib/apl/runtime.sx, lib/feed/normalize.sx, lib/feed/stream.sx.
; --- scorers ----------------------------------------------------------------
; recency: half-life decay. score = 0.5 ^ (age / half-life). at==now -> 1.0.
(define
feed/recency
(fn
(now half-life)
(fn (a) (expt 0.5 (/ (- now (get a :at)) half-life)))))
; velocity: how many of this actor's activities fall in (at-window, at] —
; a burst of recent activity scores higher.
(define
feed/velocity
(fn
(stream window)
(fn
(a)
(len
(filter
(fn
(b)
(and
(equal? (get b :actor) (get a :actor))
(<= (get b :at) (get a :at))
(> (get b :at) (- (get a :at) window))))
(feed/items stream))))))
; engagement: how many activities in the stream touch this activity's :object
(define
feed/engagement
(fn
(stream)
(fn
(a)
(len
(filter
(fn (b) (equal? (get b :object) (get a :object)))
(feed/items stream))))))
; composite: weighted sum. parts = (list (list weight scorer) ...)
(define
feed/composite
(fn
(parts)
(fn
(a)
(reduce
(fn (acc p) (+ acc (* (first p) ((nth p 1) a))))
0
parts))))
; --- ranking ----------------------------------------------------------------
; stable reorder of items by key-fn, descending (grade-down is stable)
(define
feed/-desc-by
(fn
(items key-fn)
(let
((keys (make-array (list (len items)) (map key-fn items))))
(let
((order (get (apl-grade-down keys) :ravel)))
(map (fn (i) (nth items (- i 1))) order)))))
; rank by score descending; ties -> :at descending -> input order
(define
feed/rank
(fn
(stream score-fn)
(let
((by-at (feed/-desc-by (feed/items stream) feed/at)))
(feed/stream (feed/-desc-by by-at score-fn)))))
; attach a :score to each activity (for inspection / debugging)
(define
feed/with-scores
(fn
(stream score-fn)
(feed/stream
(map (fn (a) (assoc a :score (score-fn a))) (feed/items stream)))))
; top-N ranked timeline
(define
feed/top
(fn (stream score-fn n) (feed/take (feed/rank stream score-fn) n)))

View File

@@ -1,19 +0,0 @@
{
"suites": {
"basic": {"pass": 30, "fail": 0},
"fanout": {"pass": 29, "fail": 0},
"rank": {"pass": 24, "fail": 0},
"integration": {"pass": 22, "fail": 0},
"content": {"pass": 15, "fail": 0},
"notify": {"pass": 8, "fail": 0},
"home": {"pass": 6, "fail": 0},
"dedupe": {"pass": 9, "fail": 0},
"trending": {"pass": 11, "fail": 0},
"mute": {"pass": 9, "fail": 0},
"page": {"pass": 14, "fail": 0},
"thread": {"pass": 12, "fail": 0}
},
"total_pass": 189,
"total_fail": 0,
"total": 189
}

View File

@@ -1,19 +0,0 @@
# feed Conformance Scoreboard
_Generated by `lib/feed/conformance.sh`_
| Suite | Pass | Fail | Total |
|-------|-----:|-----:|------:|
| basic | 30 | 0 | 30 |
| fanout | 29 | 0 | 29 |
| rank | 24 | 0 | 24 |
| integration | 22 | 0 | 22 |
| content | 15 | 0 | 15 |
| notify | 8 | 0 | 8 |
| home | 6 | 0 | 6 |
| dedupe | 9 | 0 | 9 |
| trending | 11 | 0 | 11 |
| mute | 9 | 0 | 9 |
| page | 14 | 0 | 14 |
| thread | 12 | 0 | 12 |
| **Total** | **189** | **0** | **189** |

View File

@@ -1,75 +0,0 @@
; feed/stream — a stream is an APL vector (rank-1 array) whose ravel holds
; activity dicts. Operations lift APL primitives onto this shape: filter via
; compress (/), sort via grade (⍋), take via ↑, reverse via ⌽.
;
; Requires: lib/apl/runtime.sx, lib/feed/normalize.sx (loaded by harness).
(define feed/stream (fn (acts) (make-array (list (len acts)) acts)))
(define feed/items (fn (s) (get s :ravel)))
(define feed/count (fn (s) (len (get s :ravel))))
(define feed/empty (feed/stream (list)))
(define feed/empty? (fn (s) (= (feed/count s) 0)))
; filter — bool mask ∘ compress. pred : activity -> truthy
(define
feed/filter
(fn
(s pred)
(let
((items (get s :ravel)))
(let
((mask (make-array (list (len items)) (map (fn (a) (if (pred a) 1 0)) items))))
(apl-compress mask s)))))
; sort-by — ascending, stable on ties (grade-up is stable). key-fn : activity -> number
(define
feed/sort-by
(fn
(s key-fn)
(let
((items (get s :ravel)))
(let
((keys (make-array (list (len items)) (map key-fn items))))
(let
((order (get (apl-grade-up keys) :ravel)))
(feed/stream (map (fn (i) (nth items (- i 1))) order)))))))
(define feed/sort-by-at (fn (s) (feed/sort-by s feed/at)))
; newest-first: ascending sort then reverse (⌽)
(define feed/recent (fn (s) (apl-reverse (feed/sort-by-at s))))
; take N (↑), clamped to stream length so it never over-takes/pads
(define
feed/take
(fn
(s n)
(let
((c (feed/count s)))
(if (>= n c) s (apl-take (apl-scalar n) s)))))
(define feed/reverse (fn (s) (apl-reverse s)))
; common predicates
(define
feed/by-actor
(fn (s actor) (feed/filter s (fn (a) (equal? (get a :actor) actor)))))
(define
feed/by-verb
(fn (s verb) (feed/filter s (fn (a) (equal? (get a :verb) verb)))))
(define
feed/by-object
(fn
(s object)
(feed/filter s (fn (a) (equal? (get a :object) object)))))
; activities at or after timestamp t
(define
feed/since
(fn (s t) (feed/filter s (fn (a) (>= (get a :at) t)))))

View File

@@ -1,118 +0,0 @@
; Phase 1 — normalize, stream ops, api. Uses the feed-test harness
; (feed-test name got expected) provided by conformance.sh.
; ---------- normalize ----------
(feed-test
"normalize default actor"
(feed/actor (feed/normalize {}))
"")
(feed-test
"normalize default verb"
(feed/verb (feed/normalize {}))
"post")
(feed-test
"normalize default at"
(feed/at (feed/normalize {}))
0)
(feed-test
"normalize default object"
(feed/object (feed/normalize {}))
nil)
(feed-test
"normalize default tags"
(feed/tags (feed/normalize {}))
(list))
(feed-test
"normalize keeps actor"
(feed/actor (feed/normalize {:actor "alice"}))
"alice")
(feed-test
"normalize keeps verb"
(feed/verb (feed/normalize {:verb "like"}))
"like")
(feed-test
"normalize scalar tag -> list"
(feed/tags (feed/normalize {:tags "x"}))
(list "x"))
(feed-test
"normalize list tags kept"
(feed/tags (feed/normalize {:tags (list "a" "b")}))
(list "a" "b"))
(feed-test
"activity constructor at"
(feed/at (feed/activity "a" "post" "o" 5 (list)))
5)
(feed-test
"activity? on activity"
(feed/activity? (feed/normalize {:actor "a"}))
true)
(feed-test "activity? on number" (feed/activity? 5) false)
(feed-test "activity? on bare dict" (feed/activity? {:foo 1}) false)
; ---------- stream ----------
(define
S
(feed/stream
(list
(feed/activity "alice" "post" "p1" 30 (list))
(feed/activity "bob" "like" "p1" 10 (list))
(feed/activity "alice" "post" "p2" 20 (list)))))
(feed-test "stream count" (feed/count S) 3)
(feed-test "stream items len" (len (feed/items S)) 3)
(feed-test
"sort-by-at actors asc"
(map feed/actor (feed/items (feed/sort-by-at S)))
(list "bob" "alice" "alice"))
(feed-test
"recent newest first"
(map feed/at (feed/items (feed/recent S)))
(list 30 20 10))
(feed-test
"take 2 of recent"
(feed/count (feed/take (feed/recent S) 2))
2)
(feed-test
"take clamps past end"
(feed/count (feed/take S 10))
3)
(feed-test
"by-actor alice count"
(feed/count (feed/by-actor S "alice"))
2)
(feed-test
"by-verb like actor"
(map feed/actor (feed/items (feed/by-verb S "like")))
(list "bob"))
(feed-test
"by-object p1 count"
(feed/count (feed/by-object S "p1"))
2)
(feed-test
"since 20 count"
(feed/count (feed/since S 20))
2)
(feed-test
"reverse ats"
(map feed/at (feed/items (feed/reverse S)))
(list 20 10 30))
(feed-test "empty? on empty" (feed/empty? feed/empty) true)
(feed-test
"empty? on filtered-out"
(feed/empty? (feed/by-actor S "zzz"))
true)
; ---------- api ----------
(feed/reset!)
(feed/post {:actor "x" :at 1 :verb "post"})
(feed/post {:actor "y" :at 2 :verb "like"})
(feed-test "api size after posts" (feed/size) 2)
(feed-test "api all count" (feed/count (feed/all)) 2)
(feed-test
"post returns normalized verb"
(feed/verb (feed/post {:actor "z"}))
"post")
(feed-test "api size after third post" (feed/size) 3)

View File

@@ -1,85 +0,0 @@
; Follow-up — TF-IDF content ranking over :tags. (feed-test name got expected)
(define
corpus
(feed/stream
(list
(feed/normalize {:actor "u" :object "o1" :at 10 :tags (list "cats" "funny")})
(feed/normalize {:actor "u" :object "o2" :at 20 :tags (list "cats" "news")})
(feed/normalize {:actor "u" :object "o3" :at 30 :tags (list "politics" "news")})
(feed/normalize {:actor "u" :object "o4" :at 40 :tags (list "cats")}))))
; ---------- document frequency ----------
(feed-test "df cats" (get (feed/tag-df corpus) "cats") 3)
(feed-test "df news" (get (feed/tag-df corpus) "news") 2)
(feed-test "df funny" (get (feed/tag-df corpus) "funny") 1)
(feed-test "df politics" (get (feed/tag-df corpus) "politics") 1)
(feed-test "df full" (feed/tag-df corpus) {:news 2 :funny 1 :politics 1 :cats 3})
; ---------- inverse document frequency ----------
(feed-test
"idf news = log(4/2)"
(get (feed/tag-idf corpus) "news")
(log 2))
(feed-test
"idf funny = log(4/1)"
(get (feed/tag-idf corpus) "funny")
(log 4))
(feed-test
"rarer tag has higher idf"
(>
(get (feed/tag-idf corpus) "funny")
(get (feed/tag-idf corpus) "cats"))
true)
; ---------- tf-idf scoring ----------
(define idf (feed/tag-idf corpus))
(feed-test
"score query funny on o1"
((feed/tfidf-score idf (list "funny")) (feed/normalize {:actor "u" :object "x" :tags (list "cats" "funny")}))
(log 4))
(feed-test
"score query funny on non-match"
((feed/tfidf-score idf (list "funny")) (feed/normalize {:actor "u" :object "x" :tags (list "cats")}))
0)
(feed-test
"unknown query tag scores 0"
((feed/tfidf-score idf (list "zzz")) (feed/normalize {:actor "u" :object "x" :tags (list "cats")}))
0)
; ---------- ranking by relevance ----------
; query news: o2,o3 match (score log2), o1,o4 don't (0); ties break by :at desc
(feed-test
"by-relevance news order"
(map
(fn (a) (get a :object))
(feed/items (feed/by-relevance corpus (list "news"))))
(list "o3" "o2" "o4" "o1"))
; query funny: only o1 matches -> ranks first
(feed-test
"by-relevance funny first"
(get
(nth (feed/items (feed/by-relevance corpus (list "funny"))) 0)
:object)
"o1")
; query (cats news): o2 carries both tags -> highest combined tf-idf
(feed-test
"by-relevance cats+news top"
(get
(nth
(feed/items (feed/by-relevance corpus (list "cats" "news")))
0)
:object)
"o2")
(feed-test
"by-relevance preserves count"
(feed/count (feed/by-relevance corpus (list "cats")))
4)

View File

@@ -1,56 +0,0 @@
; Follow-up — verb-aware (smart) dedupe. (feed-test name got expected)
; reactions (like/follow) collapse cross-actor; posts stay distinct per actor
(define
M
(feed/stream
(list
(feed/activity "alice" "like" "X" 1 (list))
(feed/activity "bob" "like" "X" 2 (list))
(feed/activity "alice" "post" "P" 3 (list))
(feed/activity "bob" "post" "P" 4 (list))
(feed/activity "alice" "follow" "C" 5 (list))
(feed/activity "bob" "follow" "C" 6 (list))))) ; collapses
(feed-test
"smart dedupe total"
(feed/count (feed/dedupe-smart M))
4)
(feed-test
"smart keeps both posts"
(feed/count (feed/by-verb (feed/dedupe-smart M) "post"))
2)
(feed-test
"smart collapses likes to one"
(feed/count (feed/by-verb (feed/dedupe-smart M) "like"))
1)
(feed-test
"smart collapses follows to one"
(feed/count (feed/by-verb (feed/dedupe-smart M) "follow"))
1)
(feed-test
"collapsed like keeps first actor"
(map feed/actor (feed/items (feed/by-verb (feed/dedupe-smart M) "like")))
(list "alice"))
; contrast: plain activity dedupe keeps cross-actor likes distinct
(feed-test
"activity dedupe keeps both likes"
(feed/count (feed/by-verb (feed/dedupe-activities M) "like"))
2)
; contrast: blanket collapse folds the two posts (same verb+object) too
(feed-test
"collapse dedupe folds posts"
(feed/count (feed/by-verb (feed/dedupe-collapse M) "post"))
1)
; smart-key dispatch
(feed-test
"smart-key reaction -> (verb object)"
(feed/smart-key (feed/activity "alice" "like" "X" 0 (list)))
(list "like" "X"))
(feed-test
"smart-key post -> (actor verb object)"
(feed/smart-key (feed/activity "alice" "post" "P" 0 (list)))
(list "alice" "post" "P"))

View File

@@ -1,187 +0,0 @@
; Phase 2 — fanout via outer product + dedupe. (feed-test name got expected)
; ---------- graph ----------
; edges: (follower followee). bob,carol follow alice; carol,dave follow bob.
(define
G
(feed/follow-graph
(list
(list "bob" "alice")
(list "carol" "alice")
(list "carol" "bob")
(list "dave" "bob"))))
(feed-test "followers alice" (feed/followers G "alice") (list "bob" "carol"))
(feed-test "followers bob" (feed/followers G "bob") (list "carol" "dave"))
(feed-test "followers unknown" (feed/followers G "zzz") (list))
(feed-test "audience distinct" (feed/audience G) (list "bob" "carol" "dave"))
; ---------- fanout ----------
(define
S
(feed/stream
(list
(feed/activity "alice" "post" "p1" 10 (list))
(feed/activity "alice" "post" "p2" 20 (list))
(feed/activity "bob" "like" "p1" 30 (list)))))
(define IB (feed/fanout S G))
(feed-test "fanout total edges" (feed/count IB) 6)
(feed-test
"inbox bob count"
(feed/count (feed/inbox-for IB "bob"))
2)
(feed-test
"inbox carol count"
(feed/count (feed/inbox-for IB "carol"))
3)
(feed-test
"inbox dave count"
(feed/count (feed/inbox-for IB "dave"))
1)
(feed-test
"inbox alice (follows none)"
(feed/count (feed/inbox-for IB "alice"))
0)
(feed-test
"recipients order"
(feed/recipients IB)
(list "bob" "carol" "dave"))
(feed-test
"bob inbox objects"
(map (fn (a) (get a :object)) (feed/inbox-activities IB "bob"))
(list "p1" "p2"))
(feed-test
"dave inbox objects"
(map (fn (a) (get a :object)) (feed/inbox-activities IB "dave"))
(list "p1"))
(feed-test
"dave inbox verb"
(map (fn (a) (get a :verb)) (feed/inbox-activities IB "dave"))
(list "like"))
; empty graph → no audience → no edges
(feed-test
"empty graph fanout"
(feed/count (feed/fanout S {}))
0)
; actor nobody follows produces no edges
(define
Sghost
(feed/stream (list (feed/activity "ghost" "post" "g1" 5 (list)))))
(feed-test
"unfollowed actor fanout"
(feed/count (feed/fanout Sghost G))
0)
; ---------- high fanout (popular actor) ----------
(define
Gstar
(feed/follow-graph
(list
(list "u1" "star")
(list "u2" "star")
(list "u3" "star")
(list "u4" "star")
(list "u5" "star"))))
(define
Sstar
(feed/stream (list (feed/activity "star" "post" "s1" 1 (list)))))
(feed-test
"star fanout count"
(feed/count (feed/fanout Sstar Gstar))
5)
(feed-test "star audience size" (len (feed/audience Gstar)) 5)
; ---------- mutual follow ----------
(define Gmut (feed/follow-graph (list (list "a" "b") (list "b" "a"))))
(define
Smut
(feed/stream
(list
(feed/activity "a" "post" "pa" 1 (list))
(feed/activity "b" "post" "pb" 2 (list)))))
(define IBmut (feed/fanout Smut Gmut))
(feed-test "mutual total" (feed/count IBmut) 2)
(feed-test
"mutual a gets pb"
(map (fn (x) (get x :object)) (feed/inbox-activities IBmut "a"))
(list "pb"))
(feed-test
"mutual b gets pa"
(map (fn (x) (get x :object)) (feed/inbox-activities IBmut "b"))
(list "pa"))
; ---------- dedupe ----------
(define
Sdup2
(feed/stream
(list
(feed/activity "alice" "post" "p1" 1 (list))
(feed/activity "alice" "post" "p1" 9 (list))
(feed/activity "alice" "post" "p2" 2 (list)))))
(feed-test
"dedupe-activities collapses dup"
(feed/count (feed/dedupe-activities Sdup2))
2)
(feed-test
"dedupe-activities keeps distinct"
(map
(fn (a) (get a :object))
(feed/items (feed/dedupe-activities Sdup2)))
(list "p1" "p2"))
(define
Slikes
(feed/stream
(list
(feed/activity "alice" "like" "X" 1 (list))
(feed/activity "bob" "like" "X" 2 (list))
(feed/activity "carol" "like" "Y" 3 (list)))))
(feed-test
"collapse cross-actor likes"
(feed/count (feed/dedupe-collapse Slikes))
2)
(feed-test
"collapse keeps distinct objects"
(map
(fn (a) (get a :object))
(feed/items (feed/dedupe-collapse Slikes)))
(list "X" "Y"))
(feed-test
"activity-key shape"
(feed/activity-key (feed/activity "a" "post" "o" 0 (list)))
(list "a" "post" "o"))
(feed-test
"collapse-key shape"
(feed/collapse-key (feed/activity "a" "like" "o" 0 (list)))
(list "like" "o"))
; cross-post: alice posts p1 twice → bob's inbox has it twice → dedupe-inbox → once
(define
Scross
(feed/stream
(list
(feed/activity "alice" "post" "p1" 1 (list))
(feed/activity "alice" "post" "p1" 5 (list)))))
(define IBcross (feed/fanout Scross G))
(feed-test
"cross-post raw bob count"
(feed/count (feed/inbox-for IBcross "bob"))
2)
(feed-test
"cross-post deduped bob count"
(feed/count (feed/inbox-for (feed/dedupe-inbox IBcross) "bob"))
1)
(feed-test
"dedupe-inbox keeps distinct receivers"
(feed/count (feed/dedupe-inbox IBcross))
2)

View File

@@ -1,73 +0,0 @@
; Follow-up — feed/home capstone pipeline. (feed-test name got expected)
; alice follows star and bob (edges: follower followee)
(define
G
(feed/follow-graph (list (list "alice" "star") (list "alice" "bob"))))
; star posts s1 then s2; bob posts b1; star re-posts s1 (cross-post dup);
; zoe posts z1 (alice does NOT follow zoe)
(define
S
(feed/stream
(list
(feed/activity "star" "post" "s1" 10 (list))
(feed/activity "star" "post" "s2" 20 (list))
(feed/activity "bob" "post" "b1" 15 (list))
(feed/activity "star" "post" "s1" 5 (list))
(feed/activity "zoe" "post" "z1" 30 (list)))))
(define rec (feed/recency 100 10))
(feed-test
"home count (deduped, followed only)"
(feed/count (feed/home S G "alice" feed/permit-public? rec 10))
3)
(feed-test
"home order by recency"
(map
(fn (a) (get a :object))
(feed/items (feed/home S G "alice" feed/permit-public? rec 10)))
(list "s2" "b1" "s1"))
(feed-test
"home excludes unfollowed zoe"
(feed/-elem?
"z1"
(map
(fn (a) (get a :object))
(feed/items (feed/home S G "alice" feed/permit-public? rec 10))))
false)
(feed-test
"home top-2"
(map
(fn (a) (get a :object))
(feed/items (feed/home S G "alice" feed/permit-public? rec 2)))
(list "s2" "b1"))
(feed-test
"home dedupes cross-post (one s1)"
(len
(filter
(fn (o) (equal? o "s1"))
(map
(fn (a) (get a :object))
(feed/items
(feed/home S G "alice" feed/permit-public? rec 10)))))
1)
; ACL applied per-viewer in the home pipeline
(define
Sacl
(feed/stream
(list (feed/normalize {:actor "star" :object "pub" :at 20}) (feed/normalize {:actor "star" :object "sec" :visible-to (list "carol") :at 25}))))
(define Gacl (feed/follow-graph (list (list "alice" "star"))))
(feed-test
"home hides activity alice not permitted"
(map
(fn (a) (get a :object))
(feed/items (feed/home Sacl Gacl "alice" feed/permit-acl? rec 10)))
(list "pub"))

View File

@@ -1,155 +0,0 @@
; Phase 4 — visibility (ACL) + federation, and the end-to-end timeline.
; (feed-test name got expected)
; ---------- ACL visibility ----------
; pub: public. sec: bob, allows carol. dm: frank, allows dave.
(define
C
(feed/stream
(list
(feed/normalize {:actor "alice" :object "pub" :at 10})
(feed/normalize {:actor "bob" :object "sec" :visible-to (list "carol") :at 20})
(feed/normalize {:actor "frank" :object "dm" :visible-to (list "dave") :at 30}))))
(feed-test
"public visible to anyone"
(feed/count (feed/visible C "zoe" feed/permit-acl?))
1)
(feed-test
"carol sees allowlisted + public"
(feed/count (feed/visible C "carol" feed/permit-acl?))
2)
(feed-test
"dave sees dm + public"
(feed/count (feed/visible C "dave" feed/permit-acl?))
2)
(feed-test
"author always sees own private"
(feed/count (feed/visible C "frank" feed/permit-acl?))
2)
(feed-test
"permit-public? lets all through"
(feed/count (feed/visible C "zoe" feed/permit-public?))
3)
(feed-test
"visible objects for dave"
(map
(fn (a) (get a :object))
(feed/items (feed/visible C "dave" feed/permit-acl?)))
(list "pub" "dm"))
; per-viewer: same stream, different timelines
(feed-test
"zoe timeline differs from carol"
(not
(=
(feed/count (feed/visible C "zoe" feed/permit-acl?))
(feed/count (feed/visible C "carol" feed/permit-acl?))))
true)
; ---------- federation: merge / ingest ----------
(define
L
(feed/stream
(list
(feed/activity "alice" "post" "p1" 10 (list))
(feed/activity "alice" "post" "p2" 20 (list)))))
(define
P
(feed/stream
(list
(feed/activity "alice" "post" "p2" 20 (list))
(feed/activity "peer" "post" "p9" 25 (list)))))
(feed-test "merge concatenates" (feed/count (feed/merge L P)) 4)
(feed-test
"ingest dedupes overlap"
(feed/count (feed/ingest L P))
3)
(feed-test
"inbound normalizes + ingests"
(feed/count (feed/inbound L (list {:actor "peer" :object "p9" :at 25} {:actor "alice" :object "p1" :at 10})))
3)
; backfill via injected fetch-fn
(define peer-history (fn (peer-id) (list {:actor peer-id :object "h1" :at 1} {:actor peer-id :object "h2" :at 2})))
(feed-test
"backfill merges peer history"
(feed/count (feed/backfill L peer-history "remote"))
4)
(feed-test
"backfill objects present"
(map
(fn (a) (get a :object))
(feed/items
(feed/by-actor (feed/backfill L peer-history "remote") "remote")))
(list "h1" "h2"))
; ---------- federation: outbound partition ----------
; bob (local), alice@remote + carol@remote (remote) follow star
(define
Gf
(feed/follow-graph
(list
(list "bob" "star")
(list "alice@remote" "star")
(list "carol@remote" "star"))))
(define
Sf
(feed/stream (list (feed/activity "star" "post" "s1" 1 (list)))))
(define
remote?
(fn (id) (feed/-elem? id (list "alice@remote" "carol@remote"))))
(define parts (feed/federate Sf Gf remote?))
(feed-test "local deliveries" (feed/count (get parts :local)) 1)
(feed-test "remote deliveries" (feed/count (get parts :remote)) 2)
(feed-test
"local recipient is bob"
(feed/recipients (get parts :local))
(list "bob"))
; deliver: send-fn receives each remote event, local inbox returned
(define sent (list))
(define send-fn (fn (to act) (set! sent (append sent (list to)))))
(define local-inbox (feed/deliver Sf Gf remote? send-fn))
(feed-test "deliver returns local inbox" (feed/count local-inbox) 1)
(feed-test "deliver sent to both remotes" (len sent) 2)
(feed-test "deliver remote targets" sent (list "alice@remote" "carol@remote"))
; ---------- end-to-end: federated, ACL-filtered, ranked timeline ----------
(define
base
(feed/stream
(list
(feed/normalize {:actor "alice" :object "a1" :at 100})
(feed/normalize {:actor "bob" :object "b1" :visible-to (list "carol") :at 90})
(feed/normalize {:actor "eve" :object "e1" :visible-to (list "dave") :at 80}))))
(define federated (feed/inbound base (list {:actor "peer" :object "x1" :at 110})))
(define rec (feed/recency 120 10))
(define
carol-tl
(feed/timeline federated "carol" feed/permit-acl? rec 3))
; eve's :visible-to excludes carol -> filtered out; peer/alice public, bob allows carol
(feed-test "carol federated timeline count" (feed/count carol-tl) 3)
(feed-test
"carol timeline order (recency)"
(map (fn (a) (get a :object)) (feed/items carol-tl))
(list "x1" "a1" "b1"))
(feed-test
"eve dm excluded from carol"
(feed/-elem? "e1" (map (fn (a) (get a :object)) (feed/items carol-tl)))
false)
(feed-test
"dave sees eve dm not bob"
(map
(fn (a) (get a :object))
(feed/items
(feed/timeline federated "dave" feed/permit-acl? rec 5)))
(list "x1" "a1" "e1"))

View File

@@ -1,68 +0,0 @@
; Follow-up — viewer mute/block filtering. (feed-test name got expected)
(define
S
(feed/stream
(list
(feed/normalize {:actor "alice" :object "P1" :at 1 :tags (list "news")})
(feed/normalize {:actor "bob" :object "P2" :at 2 :tags (list "spam")})
(feed/normalize {:actor "alice" :object "P3" :at 3 :tags (list "cats")})
(feed/normalize {:actor "carol" :object "P4" :at 4 :tags (list "news" "spam")}))))
; ---------- mute actors ----------
(feed-test
"mute bob drops his post"
(map
(fn (a) (get a :object))
(feed/items (feed/mute-actors S (list "bob"))))
(list "P1" "P3" "P4"))
(feed-test
"mute alice drops two"
(feed/count (feed/mute-actors S (list "alice")))
2)
(feed-test
"mute nobody keeps all"
(feed/count (feed/mute-actors S (list)))
4)
; ---------- mute tags ----------
(feed-test
"mute spam tag drops two"
(map
(fn (a) (get a :object))
(feed/items (feed/mute-tags S (list "spam"))))
(list "P1" "P3"))
(feed-test
"mute news+cats leaves spam-only"
(map
(fn (a) (get a :object))
(feed/items (feed/mute-tags S (list "news" "cats"))))
(list "P2"))
; ---------- mute objects ----------
(feed-test
"mute object P3 (thread mute)"
(feed/count (feed/mute-objects S (list "P3")))
3)
; ---------- combined prefs ----------
(feed-test
"apply-prefs actors + tags"
(map
(fn (a) (get a :object))
(feed/items (feed/apply-prefs S {:mute-actors (list "bob") :mute-tags (list "cats")})))
(list "P1" "P4"))
(feed-test
"apply-prefs empty keeps all"
(feed/count (feed/apply-prefs S {}))
4)
(feed-test
"apply-prefs all three filters"
(map
(fn (a) (get a :object))
(feed/items (feed/apply-prefs S {:mute-objects (list "P3") :mute-actors (list "carol") :mute-tags (list "spam")})))
(list "P1"))

View File

@@ -1,69 +0,0 @@
; Follow-up — notification feed over an inbox. (feed-test name got expected)
; an inbox is a stream of {:to receiver :activity act} events
(define mk-ev (fn (to act) {:activity act :to to}))
(define
IB
(feed/stream
(list
(mk-ev "alice" (feed/activity "bob" "like" "P" 10 (list)))
(mk-ev "alice" (feed/activity "carol" "like" "P" 20 (list)))
(mk-ev "alice" (feed/activity "dave" "reply" "Q" 30 (list)))
(mk-ev "bob" (feed/activity "eve" "like" "R" 40 (list))))))
; ---------- raw notifications ----------
(feed-test
"alice notification count"
(feed/count (feed/notifications IB "alice"))
3)
(feed-test
"bob notification count"
(feed/count (feed/notifications IB "bob"))
1)
(feed-test
"zoe no notifications"
(feed/count (feed/notifications IB "zoe"))
0)
; ---------- verb filtering ----------
(feed-test
"alice likes only"
(feed/count (feed/notify-verbs IB "alice" (list "like")))
2)
(feed-test
"alice replies only"
(feed/count (feed/notify-verbs IB "alice" (list "reply")))
1)
(feed-test
"alice like+reply"
(feed/count (feed/notify-verbs IB "alice" (list "like" "reply")))
3)
(feed-test
"alice follow (none)"
(feed/count (feed/notify-verbs IB "alice" (list "follow")))
0)
; ---------- digest ----------
(define dig (feed/notify-digest IB "alice"))
(feed-test "digest group count" (len dig) 2)
(feed-test
"digest sorted by key (like|P before reply|Q)"
(map (fn (g) (get g :object)) dig)
(list "P" "Q"))
(feed-test
"like group actors"
(get (nth dig 0) :actors)
(list "bob" "carol"))
(feed-test "like group count" (get (nth dig 0) :count) 2)
(feed-test "like group verb" (get (nth dig 0) :verb) "like")
(feed-test "reply group count" (get (nth dig 1) :count) 1)
(feed-test
"reply group actors"
(get (nth dig 1) :actors)
(list "dave"))
(feed-test "empty digest for zoe" (feed/notify-digest IB "zoe") (list))

View File

@@ -1,86 +0,0 @@
; Follow-up — pagination (offset + cursor). (feed-test name got expected)
; ---------- offset / limit ----------
(define
O
(feed/stream
(list
(feed/activity "u" "post" "o1" 1 (list))
(feed/activity "u" "post" "o2" 2 (list))
(feed/activity "u" "post" "o3" 3 (list))
(feed/activity "u" "post" "o4" 4 (list))
(feed/activity "u" "post" "o5" 5 (list)))))
(feed-test
"page 1"
(map
(fn (a) (get a :object))
(feed/items (feed/page O 0 2)))
(list "o1" "o2"))
(feed-test
"page 2"
(map
(fn (a) (get a :object))
(feed/items (feed/page O 2 2)))
(list "o3" "o4"))
(feed-test
"page 3 (partial)"
(map
(fn (a) (get a :object))
(feed/items (feed/page O 4 2)))
(list "o5"))
(feed-test
"page past end empty"
(feed/count (feed/page O 10 2))
0)
(feed-test "page-count 5/2 = 3" (feed/page-count O 2) 3)
(feed-test "page-count 5/5 = 1" (feed/page-count O 5) 1)
; ---------- cursor (recency) ----------
(define
R
(feed/stream
(list
(feed/activity "u" "post" "a" 50 (list))
(feed/activity "u" "post" "b" 40 (list))
(feed/activity "u" "post" "c" 30 (list))
(feed/activity "u" "post" "d" 20 (list))
(feed/activity "u" "post" "e" 10 (list)))))
(define p1 (feed/page-before R 100 2))
(feed-test
"cursor page 1 newest first"
(map (fn (a) (get a :object)) (feed/items p1))
(list "a" "b"))
(feed-test "next cursor after page 1" (feed/next-cursor p1) 40)
(define p2 (feed/page-before R (feed/next-cursor p1) 2))
(feed-test
"cursor page 2"
(map (fn (a) (get a :object)) (feed/items p2))
(list "c" "d"))
(feed-test "next cursor after page 2" (feed/next-cursor p2) 20)
(define p3 (feed/page-before R (feed/next-cursor p2) 2))
(feed-test
"cursor page 3 (partial)"
(map (fn (a) (get a :object)) (feed/items p3))
(list "e"))
(feed-test
"empty page nil cursor"
(feed/next-cursor (feed/page-before R 5 2))
nil)
(feed-test
"after cursor loads newer"
(map
(fn (a) (get a :object))
(feed/items (feed/recent (feed/after R 30))))
(list "a" "b"))
(feed-test
"before cursor count"
(feed/count (feed/before R 30))
2)

View File

@@ -1,160 +0,0 @@
; Phase 3 — aggregation + ranking. (feed-test name got expected)
; ---------- aggregation ----------
(define
A
(feed/stream
(list
(feed/activity "alice" "post" "p1" 5 (list))
(feed/activity "alice" "post" "p2" 15 (list))
(feed/activity "bob" "post" "p3" 25 (list))
(feed/activity "alice" "like" "p1" 35 (list)))))
(feed-test "actor-counts" (feed/actor-counts A) {:alice 3 :bob 1})
(feed-test "object-counts" (feed/object-counts A) {:p2 1 :p3 1 :p1 2})
(feed-test
"group-by actor alice len"
(len (get (feed/group-by A feed/actor) "alice"))
3)
(feed-test
"group-count empty"
(feed/group-count feed/empty feed/actor)
{})
; day bucketing
(define
D
(feed/stream
(list
(feed/activity "alice" "post" "p1" 5 (list))
(feed/activity "alice" "post" "p2" 8 (list))
(feed/activity "alice" "post" "p3" 12 (list)))))
(feed-test "feed/day floor" (feed/day 12 10) 1)
(feed-test "feed/day same bucket" (feed/day 8 10) 0)
(feed-test "by-actor-day" (feed/by-actor-day D 10) {:alice#0 2 :alice#1 1})
; ---------- recency ----------
(define rec (feed/recency 100 10))
(feed-test
"recency at=now -> 1"
(rec (feed/activity "x" "post" "o" 100 (list)))
1)
(feed-test
"recency age=hl -> .5"
(rec (feed/activity "x" "post" "o" 90 (list)))
0.5)
(feed-test
"recency age=2hl -> .25"
(rec (feed/activity "x" "post" "o" 80 (list)))
0.25)
; ---------- velocity ----------
(define vel (feed/velocity D 10))
(feed-test
"velocity burst (at=12)"
(vel (feed/activity "alice" "post" "z" 12 (list)))
3)
(feed-test
"velocity mid (at=8)"
(vel (feed/activity "alice" "post" "z" 8 (list)))
2)
(feed-test
"velocity first (at=5)"
(vel (feed/activity "alice" "post" "z" 5 (list)))
1)
(feed-test
"velocity other actor"
(vel (feed/activity "bob" "post" "z" 12 (list)))
0)
; ---------- engagement ----------
(define eng (feed/engagement A))
(feed-test
"engagement p1"
(eng (feed/activity "x" "post" "p1" 0 (list)))
2)
(feed-test
"engagement p2"
(eng (feed/activity "x" "post" "p2" 0 (list)))
1)
; ---------- composite ----------
(define
cmp1
(feed/composite (list (list 2 (fn (a) (get a :at))))))
(feed-test
"composite single part"
(cmp1 (feed/activity "x" "post" "o" 5 (list)))
10)
(define
cmp2
(feed/composite
(list
(list 2 (fn (a) (get a :at)))
(list 3 (fn (a) 1)))))
(feed-test
"composite two parts"
(cmp2 (feed/activity "x" "post" "o" 5 (list)))
13)
; ---------- ranking ----------
(define
R
(feed/stream
(list
(feed/activity "u" "post" "oC" 80 (list))
(feed/activity "u" "post" "oA" 100 (list))
(feed/activity "u" "post" "oB" 90 (list)))))
(feed-test
"rank by recency objects"
(map (fn (a) (get a :object)) (feed/items (feed/rank R rec)))
(list "oA" "oB" "oC"))
(feed-test
"top-2 by recency"
(map (fn (a) (get a :object)) (feed/items (feed/top R rec 2)))
(list "oA" "oB"))
(feed-test "top-2 count" (feed/count (feed/top R rec 2)) 2)
; constant score -> tiebreak by :at descending
(define
T
(feed/stream
(list
(feed/activity "u" "post" "f" 10 (list))
(feed/activity "u" "post" "g" 30 (list))
(feed/activity "u" "post" "h" 20 (list)))))
(feed-test
"tiebreak at-desc"
(map
(fn (a) (get a :object))
(feed/items (feed/rank T (fn (a) 0))))
(list "g" "h" "f"))
; equal score AND equal :at -> stable input order
(define
E
(feed/stream
(list
(feed/activity "u" "post" "first" 50 (list))
(feed/activity "u" "post" "second" 50 (list)))))
(feed-test
"stable equal-key input order"
(map
(fn (a) (get a :object))
(feed/items (feed/rank E (fn (a) 0))))
(list "first" "second"))
(feed-test
"with-scores attaches score"
(get (nth (feed/items (feed/with-scores R rec)) 1) :score)
1)
(feed-test "rank preserves count" (feed/count (feed/rank A rec)) 4)

View File

@@ -1,49 +0,0 @@
; Follow-up — conversation threading via :reply-to closure. (feed-test name got expected)
(define
S
(feed/stream
(list
(feed/normalize {:actor "a" :object "root" :at 1})
(feed/normalize {:actor "b" :object "r1" :at 2 :verb "reply" :reply-to "root"})
(feed/normalize {:actor "c" :object "r2" :at 3 :verb "reply" :reply-to "root"})
(feed/normalize {:actor "d" :object "r3" :at 4 :verb "reply" :reply-to "r1"})
(feed/normalize {:actor "e" :object "x" :at 5}))))
; ---------- direct replies ----------
(feed-test "direct replies to root" (feed/reply-count S "root") 2)
(feed-test "direct replies to r1" (feed/reply-count S "r1") 1)
(feed-test "no replies to r3" (feed/reply-count S "r3") 0)
(feed-test
"replies objects to root"
(map (fn (a) (get a :object)) (feed/items (feed/replies S "root")))
(list "r1" "r2"))
; ---------- thread closure ----------
(feed-test
"thread objects root (transitive)"
(feed/thread-objects S "root")
(list "root" "r1" "r2" "r3"))
(feed-test
"thread root chronological"
(map (fn (a) (get a :object)) (feed/items (feed/thread S "root")))
(list "root" "r1" "r2" "r3"))
(feed-test "thread size root" (feed/thread-size S "root") 4)
(feed-test
"thread excludes unrelated x"
(feed/-elem?
"x"
(map (fn (a) (get a :object)) (feed/items (feed/thread S "root"))))
false)
; ---------- sub-thread ----------
(feed-test
"thread from r1 (sub-tree)"
(map (fn (a) (get a :object)) (feed/items (feed/thread S "r1")))
(list "r1" "r3"))
(feed-test "thread size r1" (feed/thread-size S "r1") 2)
(feed-test "leaf thread is itself" (feed/thread-size S "r3") 1)
(feed-test "unrelated thread is itself" (feed/thread-size S "x") 1)

View File

@@ -1,82 +0,0 @@
; Follow-up — trending objects/actors by recent activity. (feed-test name got expected)
; window (50,100]: X@60,X@70 (a), Y@80 (b), Z@90 (c); W@40 is too old
(define
S
(feed/stream
(list
(feed/activity "a" "post" "X" 60 (list))
(feed/activity "a" "post" "X" 70 (list))
(feed/activity "b" "post" "Y" 80 (list))
(feed/activity "c" "post" "Z" 90 (list))
(feed/activity "d" "post" "W" 40 (list)))))
; ---------- trending objects ----------
(feed-test
"trending count (3 in window)"
(len (feed/trending S 100 50 10))
3)
(feed-test
"trending top object"
(get
(nth (feed/trending S 100 50 10) 0)
:object)
"X")
(feed-test
"trending top count"
(get
(nth (feed/trending S 100 50 10) 0)
:count)
2)
(feed-test
"trending order (count desc, key asc tiebreak)"
(map
(fn (e) (get e :object))
(feed/trending S 100 50 10))
(list "X" "Y" "Z"))
(feed-test
"trending top-2"
(map
(fn (e) (get e :object))
(feed/trending S 100 50 2))
(list "X" "Y"))
(feed-test
"old object W excluded"
(feed/-elem?
"W"
(map
(fn (e) (get e :object))
(feed/trending S 100 50 10)))
false)
(feed-test
"narrow window keeps only newest"
(map
(fn (e) (get e :object))
(feed/trending S 100 15 10))
(list "Z"))
(feed-test
"empty window -> nothing"
(feed/trending S 100 5 10)
(list))
; ---------- trending actors ----------
(feed-test
"trending actor top"
(get
(nth (feed/trending-actors S 100 50 10) 0)
:actor)
"a")
(feed-test
"trending actor count"
(get
(nth (feed/trending-actors S 100 50 10) 0)
:count)
2)
(feed-test
"trending actors order"
(map
(fn (e) (get e :actor))
(feed/trending-actors S 100 50 10))
(list "a" "b" "c"))

View File

@@ -1,59 +0,0 @@
; feed/thread — conversation threading. A reply carries :reply-to <parent-object>
; (normalize preserves it). A thread is the transitive closure over :reply-to from
; a root object: root + replies + replies-to-replies, gathered chronologically.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem?, feed/-distinct).
; direct replies to an object
(define
feed/replies
(fn
(stream object)
(feed/filter stream (fn (a) (equal? (get a :reply-to) object)))))
(define
feed/reply-count
(fn (stream object) (feed/count (feed/replies stream object))))
; iterate f from x until the result stops growing (set-closure fixpoint)
(define
feed/-fixpoint
(fn
(f x)
(let
((nx (f x)))
(if (= (len nx) (len x)) x (feed/-fixpoint f nx)))))
; the set of object-ids in the thread rooted at `root`
(define
feed/thread-objects
(fn
(stream root)
(let
((all (feed/items stream)))
(feed/-fixpoint
(fn
(acc)
(feed/-distinct
(append
acc
(map
(fn (a) (get a :object))
(filter (fn (a) (feed/-elem? (get a :reply-to) acc)) all)))))
(list root)))))
; the full thread as a chronological stream (root + all descendants)
(define
feed/thread
(fn
(stream root)
(let
((objs (feed/thread-objects stream root)))
(feed/sort-by-at
(feed/filter stream (fn (a) (feed/-elem? (get a :object) objs)))))))
; how many activities are in the thread (root counts as 1)
(define
feed/thread-size
(fn (stream root) (feed/count (feed/thread stream root))))

View File

@@ -1,42 +0,0 @@
; feed/trending — what's hot right now: objects (or actors) ranked by activity
; count within a recency window. Deterministic: count descending, ties broken by
; key ascending (entries are pre-sorted by key, then stable grade-down by count).
;
; Requires: lib/feed/stream.sx, lib/feed/aggregate.sx (object/actor-counts),
; lib/feed/rank.sx (feed/-desc-by).
; activities within (now-window, now]
(define
feed/-recent
(fn
(stream now window)
(feed/filter
stream
(fn (a) (and (<= (get a :at) now) (> (get a :at) (- now window)))))))
; counts dict -> top-N entries {label key, :count n}, count desc, key asc
(define
feed/-top-counts
(fn
(counts label n)
(let
((entries (map (fn (k) (assoc {:count (get counts k)} label k)) (sort (keys counts)))))
(take (feed/-desc-by entries (fn (e) (get e :count))) n))))
; top-N trending objects in the window
(define
feed/trending
(fn
(stream now window n)
(feed/-top-counts
(feed/object-counts (feed/-recent stream now window))
:object n)))
; top-N most active actors in the window
(define
feed/trending-actors
(fn
(stream now window n)
(feed/-top-counts
(feed/actor-counts (feed/-recent stream now window))
:actor n)))

View File

@@ -1,141 +0,0 @@
#!/usr/bin/env bash
# Go-on-SX conformance runner.
#
# Loads every Go-on-SX test suite via the epoch protocol, collects
# pass/fail counts, and writes lib/go/scoreboard.json + .md.
#
# Usage:
# bash lib/go/conformance.sh # run all suites
# bash lib/go/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 | pass-counter | total-counter
SUITES=(
"lex|go-test-pass|go-test-count"
"parse|go-parse-test-pass|go-parse-test-count"
"types|go-types-test-pass|go-types-test-count"
"eval|go-eval-test-pass|go-eval-test-count"
"runtime|go-rt-test-pass|go-rt-test-count"
"stdlib|go-std-test-pass|go-std-test-count"
"e2e|go-e2e-test-pass|go-e2e-test-count"
)
cat > "$TMPFILE" <<'EPOCHS'
(epoch 1)
(load "lib/guest/lex.sx")
(load "lib/guest/ast.sx")
(load "lib/guest/pratt.sx")
(load "lib/go/lex.sx")
(load "lib/go/parse.sx")
(load "lib/go/types.sx")
(load "lib/go/sched.sx")
(load "lib/go/eval.sx")
(load "lib/go/std/strings.sx")
(load "lib/go/std/strconv.sx")
(load "lib/go/tests/lex.sx")
(load "lib/go/tests/parse.sx")
(load "lib/go/tests/types.sx")
(load "lib/go/tests/eval.sx")
(load "lib/go/tests/runtime.sx")
(load "lib/go/tests/stdlib.sx")
(load "lib/go/tests/e2e.sx")
EPOCHS
idx=0
for entry in "${SUITES[@]}"; do
name="${entry%%|*}"
pass_var=$(echo "$entry" | awk -F'|' '{print $2}')
total_var=$(echo "$entry" | awk -F'|' '{print $3}')
epoch=$((100 + idx))
echo "(epoch $epoch)" >> "$TMPFILE"
echo "(eval \"(list $pass_var $total_var)\")" >> "$TMPFILE"
idx=$((idx + 1))
done
"$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
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 '\nGo-on-SX conformance: %d / %d\n' "$TOTAL_PASS" "$TOTAL_COUNT"
cat > lib/go/scoreboard.json <<JSON
{
"language": "go",
"total_pass": $TOTAL_PASS,
"total": $TOTAL_COUNT,
"suites": [$JSON_SUITES]
}
JSON
cat > lib/go/scoreboard.md <<MD
# Go-on-SX Scoreboard
**Total: ${TOTAL_PASS} / ${TOTAL_COUNT} tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
$MD_ROWS
Generated by \`lib/go/conformance.sh\`.
MD
if [ "$TOTAL_PASS" -eq "$TOTAL_COUNT" ]; then
exit 0
else
exit 1
fi

File diff suppressed because it is too large Load Diff

View File

@@ -1,476 +0,0 @@
;; lib/go/lex.sx — Go tokenizer with automatic semicolon insertion.
;;
;; Consumes lib/guest/lex.sx character-class predicates.
;;
;; Tokens: {:type T :value V :pos P}
;; Types:
;; "ident" — identifiers (foo, _bar, mixedCase)
;; "keyword" — one of the 25 Go keywords
;; "int" — integer literals (decimal, 0x.. hex, 0b.. binary, 0o.. octal,
;; legacy 0123 octal; underscores between digits allowed)
;; "float" — decimal float literals (3.14, .5, 1., 1e10, 1.5e-3, 1E5)
;; "imag" — imaginary literals (2i, 3.14i, 1e2i)
;; "string" — interpreted string literals "..." OR raw string literals `...`
;; "rune" — rune literals 'x' (single char + simple escapes)
;; "op" — operators & punctuation; :value is the literal text
;; "semi" — explicit ';' or auto-inserted (Go spec § Semicolons)
;; "eof" — end-of-input sentinel
;;
;; ASI (Go spec § Semicolons): a newline (or EOF, or a block comment
;; containing a newline) emits a ";semi" if the previous emitted token's
;; type is ident/int/float/imag/string/rune, or its value is one of
;; {break, continue, fallthrough, return, ++, --, ), ], }}.
;;
;; All scanner locals are gl- prefixed: SX host primitives (peek/emit/etc.)
;; silently shadow guest-language defines. See feedback_sx_bind_clash.
(define
go-keywords
(list
"break"
"case"
"chan"
"const"
"continue"
"default"
"defer"
"else"
"fallthrough"
"for"
"func"
"go"
"goto"
"if"
"import"
"interface"
"map"
"package"
"range"
"return"
"select"
"struct"
"switch"
"type"
"var"))
(define go-keyword? (fn (s) (some (fn (k) (= k s)) go-keywords)))
(define go-asi-keywords (list "break" "continue" "fallthrough" "return"))
(define go-asi-ops (list "++" "--" ")" "]" "}"))
(define go-asi-lit-types (list "ident" "int" "float" "imag" "string" "rune"))
(define
go-asi-trigger?
(fn
(tok)
(if
(= tok nil)
false
(let
((ty (get tok :type)) (v (get tok :value)))
(or
(some (fn (lt) (= lt ty)) go-asi-lit-types)
(and (= ty "keyword") (some (fn (k) (= k v)) go-asi-keywords))
(and (= ty "op") (some (fn (o) (= o v)) go-asi-ops)))))))
(define
go-tokenize
(fn
(src)
(let
((tokens (list)) (pos 0) (src-len (len src)))
(define
gl-peek
(fn
(offset)
(if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
(define gl-cur (fn () (gl-peek 0)))
(define gl-advance! (fn (n) (set! pos (+ pos n))))
(define
gl-last
(fn
()
(if
(= (len tokens) 0)
nil
(nth tokens (- (len tokens) 1)))))
(define gl-emit! (fn (type value start) (append! tokens {:type type :value value :pos start})))
(define
gl-maybe-asi!
(fn
(at)
(when (go-asi-trigger? (gl-last)) (gl-emit! "semi" "\n" at))))
(define
gl-oct-digit?
(fn (c) (and (not (= c nil)) (>= c "0") (<= c "7"))))
(define gl-bin-digit? (fn (c) (or (= c "0") (= c "1"))))
(define
gl-skip-line!
(fn
()
(when
(and (< pos src-len) (not (= (gl-cur) "\n")))
(gl-advance! 1)
(gl-skip-line!))))
(define
gl-skip-block!
(fn
(saw-nl)
(cond
(>= pos src-len)
saw-nl
(and (= (gl-cur) "*") (= (gl-peek 1) "/"))
(do (gl-advance! 2) saw-nl)
:else (let
((is-nl (= (gl-cur) "\n")))
(gl-advance! 1)
(gl-skip-block! (or saw-nl is-nl))))))
(define
gl-read-ident!
(fn
(start)
(when
(and (< pos src-len) (lex-ident-char? (gl-cur)))
(gl-advance! 1)
(gl-read-ident! start))
(slice src start pos)))
(define
gl-read-digit-run!
(fn
(digit?)
(when
(and (< pos src-len) (or (digit? (gl-cur)) (= (gl-cur) "_")))
(gl-advance! 1)
(gl-read-digit-run! digit?))))
(define
gl-finish-number!
(fn
(has-fraction?)
(let
((typ (if has-fraction? "float" "int")))
(when
(or (= (gl-cur) "e") (= (gl-cur) "E"))
(gl-advance! 1)
(when
(or (= (gl-cur) "+") (= (gl-cur) "-"))
(gl-advance! 1))
(gl-read-digit-run! lex-digit?)
(set! typ "float"))
(cond
(= (gl-cur) "i")
(do (gl-advance! 1) "imag")
:else typ))))
(define
gl-read-number!
(fn
()
(cond
(and (= (gl-cur) ".") (lex-digit? (gl-peek 1)))
(do
(gl-advance! 1)
(gl-read-digit-run! lex-digit?)
(gl-finish-number! true))
(and
(= (gl-cur) "0")
(or
(= (gl-peek 1) "x")
(= (gl-peek 1) "X")))
(do
(gl-advance! 2)
(gl-read-digit-run! lex-hex-digit?)
"int")
(and
(= (gl-cur) "0")
(or
(= (gl-peek 1) "b")
(= (gl-peek 1) "B")))
(do
(gl-advance! 2)
(gl-read-digit-run! gl-bin-digit?)
"int")
(and
(= (gl-cur) "0")
(or
(= (gl-peek 1) "o")
(= (gl-peek 1) "O")))
(do
(gl-advance! 2)
(gl-read-digit-run! gl-oct-digit?)
"int")
:else (do
(gl-read-digit-run! lex-digit?)
(cond
(and (= (gl-cur) ".") (not (= (gl-peek 1) ".")))
(do
(gl-advance! 1)
(gl-read-digit-run! lex-digit?)
(gl-finish-number! true))
:else (gl-finish-number! false))))))
(define
gl-read-string!
(fn
()
(gl-advance! 1)
(let
((chars (list)))
(define
gl-string-loop
(fn
()
(cond
(>= pos src-len)
nil
(= (gl-cur) "\"")
(gl-advance! 1)
(= (gl-cur) "\\")
(do
(gl-advance! 1)
(when
(< pos src-len)
(let
((ch (gl-cur)))
(cond
(= ch "n")
(append! chars "\n")
(= ch "t")
(append! chars "\t")
(= ch "r")
(append! chars "\r")
(= ch "\\")
(append! chars "\\")
(= ch "\"")
(append! chars "\"")
(= ch "'")
(append! chars "'")
:else (append! chars ch))
(gl-advance! 1)))
(gl-string-loop))
:else (do
(append! chars (gl-cur))
(gl-advance! 1)
(gl-string-loop)))))
(gl-string-loop)
(join "" chars))))
(define
gl-read-raw-string!
(fn
()
(gl-advance! 1)
(let
((chars (list)))
(define
gl-raw-loop
(fn
()
(cond
(>= pos src-len)
nil
(= (gl-cur) "`")
(gl-advance! 1)
(= (gl-cur) "\r")
(do (gl-advance! 1) (gl-raw-loop))
:else (do
(append! chars (gl-cur))
(gl-advance! 1)
(gl-raw-loop)))))
(gl-raw-loop)
(join "" chars))))
(define
gl-read-rune!
(fn
()
(gl-advance! 1)
(let
((chars (list)))
(cond
(and (< pos src-len) (= (gl-cur) "\\"))
(do
(gl-advance! 1)
(when
(< pos src-len)
(let
((ch (gl-cur)))
(cond
(= ch "n")
(append! chars "\n")
(= ch "t")
(append! chars "\t")
(= ch "r")
(append! chars "\r")
(= ch "\\")
(append! chars "\\")
(= ch "'")
(append! chars "'")
(= ch "\"")
(append! chars "\"")
:else (append! chars ch))
(gl-advance! 1))))
(< pos src-len)
(do (append! chars (gl-cur)) (gl-advance! 1)))
(when
(and (< pos src-len) (= (gl-cur) "'"))
(gl-advance! 1))
(join "" chars))))
(define
gl-match-op
(fn
()
(let
((c0 (gl-cur))
(c1 (gl-peek 1))
(c2 (gl-peek 2)))
(cond
(and (= c0 "<") (= c1 "<") (= c2 "="))
"<<="
(and (= c0 ">") (= c1 ">") (= c2 "="))
">>="
(and (= c0 "&") (= c1 "^") (= c2 "="))
"&^="
(and (= c0 ".") (= c1 ".") (= c2 "."))
"..."
(and (= c0 "=") (= c1 "="))
"=="
(and (= c0 "!") (= c1 "="))
"!="
(and (= c0 "<") (= c1 "="))
"<="
(and (= c0 ">") (= c1 "="))
">="
(and (= c0 "&") (= c1 "&"))
"&&"
(and (= c0 "|") (= c1 "|"))
"||"
(and (= c0 "+") (= c1 "+"))
"++"
(and (= c0 "-") (= c1 "-"))
"--"
(and (= c0 "<") (= c1 "<"))
"<<"
(and (= c0 ">") (= c1 ">"))
">>"
(and (= c0 "+") (= c1 "="))
"+="
(and (= c0 "-") (= c1 "="))
"-="
(and (= c0 "*") (= c1 "="))
"*="
(and (= c0 "/") (= c1 "="))
"/="
(and (= c0 "%") (= c1 "="))
"%="
(and (= c0 "&") (= c1 "="))
"&="
(and (= c0 "|") (= c1 "="))
"|="
(and (= c0 "^") (= c1 "="))
"^="
(and (= c0 ":") (= c1 "="))
":="
(and (= c0 "<") (= c1 "-"))
"<-"
(and (= c0 "&") (= c1 "^"))
"&^"
(or
(= c0 "+")
(= c0 "-")
(= c0 "*")
(= c0 "/")
(= c0 "%")
(= c0 "&")
(= c0 "|")
(= c0 "^")
(= c0 "<")
(= c0 ">")
(= c0 "=")
(= c0 "!")
(= c0 "(")
(= c0 ")")
(= c0 "{")
(= c0 "}")
(= c0 "[")
(= c0 "]")
(= c0 ",")
(= c0 ".")
(= c0 ":")
(= c0 "~"))
c0
:else nil))))
(define
gl-scan!
(fn
()
(cond
(>= pos src-len)
nil
(= (gl-cur) "\n")
(do (gl-maybe-asi! pos) (gl-advance! 1) (gl-scan!))
(lex-space? (gl-cur))
(do (gl-advance! 1) (gl-scan!))
(and (= (gl-cur) "/") (= (gl-peek 1) "/"))
(do (gl-advance! 2) (gl-skip-line!) (gl-scan!))
(and (= (gl-cur) "/") (= (gl-peek 1) "*"))
(do
(gl-advance! 2)
(let
((saw-nl (gl-skip-block! false)))
(when saw-nl (gl-maybe-asi! pos)))
(gl-scan!))
(= (gl-cur) ";")
(do
(gl-emit! "semi" ";" pos)
(gl-advance! 1)
(gl-scan!))
(lex-ident-start? (gl-cur))
(do
(let
((start pos))
(gl-read-ident! start)
(let
((word (slice src start pos)))
(gl-emit!
(if (go-keyword? word) "keyword" "ident")
word
start)))
(gl-scan!))
(lex-digit? (gl-cur))
(do
(let
((start pos) (typ (gl-read-number!)))
(gl-emit! typ (slice src start pos) start))
(gl-scan!))
(and (= (gl-cur) ".") (lex-digit? (gl-peek 1)))
(do
(let
((start pos) (typ (gl-read-number!)))
(gl-emit! typ (slice src start pos) start))
(gl-scan!))
(= (gl-cur) "\"")
(let
((start pos) (v (gl-read-string!)))
(gl-emit! "string" v start)
(gl-scan!))
(= (gl-cur) "`")
(let
((start pos) (v (gl-read-raw-string!)))
(gl-emit! "string" v start)
(gl-scan!))
(= (gl-cur) "'")
(let
((start pos) (v (gl-read-rune!)))
(gl-emit! "rune" v start)
(gl-scan!))
:else (let
((op (gl-match-op)))
(cond
op
(do
(gl-emit! "op" op pos)
(gl-advance! (len op))
(gl-scan!))
:else (do (gl-advance! 1) (gl-scan!)))))))
(gl-scan!)
(gl-maybe-asi! pos)
(gl-emit! "eof" nil pos)
tokens)))

File diff suppressed because it is too large Load Diff

View File

@@ -1,66 +0,0 @@
;; lib/go/sched.sx — Go scheduler primitives: channels + goroutines.
;;
;; This is **the independent implementation** referenced by
;; plans/lib-guest-scheduler.md. The shape that emerges here informs
;; the eventual sister kit; this file's structures are the Phase 5
;; "first-consumer" cut.
;;
;; v0 concurrency model — IMPORTANT
;;
;; SX has no first-class continuations exposed to guest code, so we
;; can't suspend a goroutine mid-statement. v0 runs `go f()` SYNCHRO-
;; NOUSLY (it's an immediate call whose return value is dropped). This
;; preserves the right semantics for patterns where the spawned
;; goroutine simply pushes to a channel that the main goroutine then
;; receives — because the spawned goroutine runs to completion first
;; and leaves the value in the channel buffer.
;;
;; True preemption with blocking sends/recvs is a Phase 5b refinement.
;; The sister-plan diary tracks the design insight (single
;; sched-spawn primitive, channel-op direction tag) so the eventual
;; kit doesn't bake in v0's synchronous limitation.
;;
;; Channel representation
;;
;; (list :go-chan ACCESSORS-FN-LIST)
;;
;; ACCESSORS-FN-LIST is a list of closures sharing a mutable buffer
;; and a closed flag. The closures expose:
;; index 1: send-fn — (lambda (val) ...)
;; index 2: recv-fn — (lambda () val-or-:empty)
;; index 3: closed?-fn — (lambda () bool)
;; index 4: close!-fn — (lambda () ...)
;;
;; Channel identity: distinct calls to go-make-chan produce closures
;; with distinct identity — `(= ch1 ch2)` is false for distinct
;; channels, matching Go spec § Channel types.
(define
go-make-chan
(fn
()
(let
((buf (list)) (closed false))
(list
:go-chan (fn (v) (append! buf v) nil)
(fn
()
(cond
(= (len buf) 0)
:empty :else
(let ((v (first buf))) (set! buf (rest buf)) v)))
(fn () closed)
(fn () (set! closed true) nil)
(fn () (len buf))))))
(define
go-chan?
(fn
(v)
(and (list? v) (not (= (len v) 0)) (= (first v) :go-chan))))
(define go-chan-send! (fn (ch val) ((nth ch 1) val)))
(define go-chan-recv! (fn (ch) ((nth ch 2))))
(define go-chan-closed? (fn (ch) ((nth ch 3))))
(define go-chan-close! (fn (ch) ((nth ch 4))))
(define go-chan-len (fn (ch) ((nth ch 5))))

View File

@@ -1,13 +0,0 @@
{
"language": "go",
"total_pass": 609,
"total": 609,
"suites": [
{"name":"lex","pass":129,"total":129,"status":"ok"},
{"name":"parse","pass":179,"total":179,"status":"ok"},
{"name":"types","pass":102,"total":102,"status":"ok"},
{"name":"eval","pass":106,"total":106,"status":"ok"},
{"name":"runtime","pass":40,"total":40,"status":"ok"},
{"name":"stdlib","pass":41,"total":41,"status":"ok"},
{"name":"e2e","pass":12,"total":12,"status":"ok"}]
}

View File

@@ -1,16 +0,0 @@
# Go-on-SX Scoreboard
**Total: 609 / 609 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
| ✅ | lex | 129 | 129 |
| ✅ | parse | 179 | 179 |
| ✅ | types | 102 | 102 |
| ✅ | eval | 106 | 106 |
| ✅ | runtime | 40 | 40 |
| ✅ | stdlib | 41 | 41 |
| ✅ | e2e | 12 | 12 |
Generated by `lib/go/conformance.sh`.

View File

@@ -1,71 +0,0 @@
;; lib/go/std/strconv.sx — Go's `strconv` package, v0 subset.
(define
go-strconv-itoa
;; Itoa(n) → string. Real Go returns the decimal representation.
(fn (args)
(cond
(not (= (len args) 1))
(list :eval-error :strconv-itoa-arity (len args))
:else
(let ((n (first args)))
(cond
(not (number? n)) (list :eval-error :strconv-itoa-not-number n)
:else (str n))))))
(define
go-strconv-atoi
;; Atoi(s) → (int, error). v0 returns just the int on success or
;; an :eval-error on failure (multi-return is a later refinement).
(fn (args)
(cond
(not (= (len args) 1))
(list :eval-error :strconv-atoi-arity (len args))
:else
(let ((s (first args)))
(cond
(not (string? s)) (list :eval-error :strconv-atoi-not-string s)
(= (len s) 0) (list :eval-error :strconv-atoi-empty)
:else (go-strconv-parse-int s 0 (= (nth s 0) "-") 0))))))
(define
go-strconv-parse-int
;; Parse a (possibly signed) base-10 integer literal. Stops on the
;; first non-digit char and returns the parsed prefix, or :eval-error
;; if no digits were consumed.
(fn (s start neg acc)
(let ((i (cond (= start 0) (cond neg 1 :else 0) :else start)))
(cond
(>= i (len s))
(cond
(= (cond neg (- i 1) :else i) 0)
(list :eval-error :strconv-atoi-no-digits s)
:else
(cond neg (- 0 acc) :else acc))
:else
(let ((d (go-strconv-digit (nth s i))))
(cond
(< d 0)
(cond
(= (cond neg (- i 1) :else i) 0)
(list :eval-error :strconv-atoi-no-digits s)
:else
(cond neg (- 0 acc) :else acc))
:else
(go-strconv-parse-int s (+ i 1) neg (+ (* acc 10) d))))))))
(define
go-strconv-digit
(fn (c)
(cond
(= c "0") 0 (= c "1") 1 (= c "2") 2 (= c "3") 3
(= c "4") 4 (= c "5") 5 (= c "6") 6 (= c "7") 7
(= c "8") 8 (= c "9") 9
:else -1)))
(define
go-std-strconv
(list :go-package "strconv"
(list
(list "Itoa" (list :go-builtin-fn go-strconv-itoa))
(list "Atoi" (list :go-builtin-fn go-strconv-atoi)))))

View File

@@ -1,386 +0,0 @@
;; lib/go/std/strings.sx — Go's `strings` package, v0 subset.
;;
;; Exposed as `go-std-strings`, a (:go-package "strings" ENTRIES) value.
;; Register with `(go-env-extend env "strings" go-std-strings)` to make
;; `strings.X(...)` call sites work in evaluated Go code.
;;
;; Each entry is (FIELD-NAME (list :go-fn PARAMS BODY)) — the same
;; shape user-defined Go functions get. Bodies are written in SX
;; directly via go-builtin closures wrapping host-level string ops
;; for speed, OR as parsed Go source for fidelity. v0 uses
;; go-builtin wrappers — simpler and fast.
;; ── helpers: implement go-std-strings entries as builtins ────────
(define
go-strings-contains
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-contains-arity (len args))
:else
(let ((s (first args)) (sub (nth args 1)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(not (string? sub)) (list :eval-error :strings-not-string sub)
:else
(go-strings-index-of s sub 0))))))
(define
go-strings-index-of
;; Returns true if SUB appears in S at or after START, else false.
(fn (s sub start)
(let ((slen (len s)) (sublen (len sub)))
(cond
(= sublen 0) true
(> (+ start sublen) slen) false
(go-strings-match-at s sub start 0) true
:else (go-strings-index-of s sub (+ start 1))))))
(define
go-strings-match-at
(fn (s sub start k)
(cond
(>= k (len sub)) true
(= (nth s (+ start k)) (nth sub k))
(go-strings-match-at s sub start (+ k 1))
:else false)))
(define
go-strings-has-prefix
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-hasprefix-arity (len args))
:else
(let ((s (first args)) (p (nth args 1)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(not (string? p)) (list :eval-error :strings-not-string p)
(> (len p) (len s)) false
:else (go-strings-match-at s p 0 0))))))
(define
go-strings-has-suffix
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-hassuffix-arity (len args))
:else
(let ((s (first args)) (suf (nth args 1)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(not (string? suf)) (list :eval-error :strings-not-string suf)
(> (len suf) (len s)) false
:else
(go-strings-match-at s suf (- (len s) (len suf)) 0))))))
(define
go-strings-index
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-index-arity (len args))
:else
(let ((s (first args)) (sub (nth args 1)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(not (string? sub)) (list :eval-error :strings-not-string sub)
:else (go-strings-index-loop s sub 0))))))
(define
go-strings-index-loop
(fn (s sub start)
(let ((slen (len s)) (sublen (len sub)))
(cond
(= sublen 0) 0
(> (+ start sublen) slen) -1
(go-strings-match-at s sub start 0) start
:else (go-strings-index-loop s sub (+ start 1))))))
(define
go-strings-repeat
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-repeat-arity (len args))
:else
(let ((s (first args)) (n (nth args 1)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(< n 0) (list :eval-error :strings-repeat-negative n)
:else (go-strings-repeat-loop s n ""))))))
(define
go-strings-repeat-loop
(fn (s n acc)
(cond
(<= n 0) acc
:else (go-strings-repeat-loop s (- n 1) (str acc s)))))
(define
go-strings-count
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-count-arity (len args))
:else
(let ((s (first args)) (sub (nth args 1)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(not (string? sub)) (list :eval-error :strings-not-string sub)
:else (go-strings-count-loop s sub 0 0))))))
(define
go-strings-count-loop
(fn (s sub start acc)
(let ((idx (go-strings-index-loop s sub start)))
(cond
(< idx 0) acc
:else
(go-strings-count-loop s sub (+ idx (max 1 (len sub))) (+ acc 1))))))
(define
go-strings-join
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-join-arity (len args))
:else
(let ((sep (nth args 1)) (xs (first args)))
(cond
(not (string? sep)) (list :eval-error :strings-not-string sep)
(not (and (list? xs) (= (first xs) :go-slice)))
(list :eval-error :strings-join-not-slice xs)
:else (go-strings-join-loop (nth xs 1) sep ""))))))
(define
go-strings-join-loop
(fn (xs sep acc)
(cond
(= (len xs) 0) acc
(= (len acc) 0) (go-strings-join-loop (rest xs) sep (first xs))
:else
(go-strings-join-loop (rest xs) sep (str acc sep (first xs))))))
;; ── case conversion ──────────────────────────────────────────────
(define
go-strings-char-to-upper
(fn (c)
(cond
(and (>= c "a") (<= c "z"))
;; ASCII uppercase shift: 'a' is 0x61, 'A' is 0x41 → diff 0x20.
;; SX has no charcode primitive, so use a char-pair table.
(go-strings-letter-toggle c true)
:else c)))
(define
go-strings-char-to-lower
(fn (c)
(cond
(and (>= c "A") (<= c "Z"))
(go-strings-letter-toggle c false)
:else c)))
(define
go-strings-letter-toggle
;; Toggle a single ASCII letter's case via direct mapping.
;; `to-upper?` true means input is lowercase, output uppercase.
(fn (c to-upper?)
(cond
to-upper?
(cond
(= c "a") "A" (= c "b") "B" (= c "c") "C" (= c "d") "D"
(= c "e") "E" (= c "f") "F" (= c "g") "G" (= c "h") "H"
(= c "i") "I" (= c "j") "J" (= c "k") "K" (= c "l") "L"
(= c "m") "M" (= c "n") "N" (= c "o") "O" (= c "p") "P"
(= c "q") "Q" (= c "r") "R" (= c "s") "S" (= c "t") "T"
(= c "u") "U" (= c "v") "V" (= c "w") "W" (= c "x") "X"
(= c "y") "Y" (= c "z") "Z" :else c)
:else
(cond
(= c "A") "a" (= c "B") "b" (= c "C") "c" (= c "D") "d"
(= c "E") "e" (= c "F") "f" (= c "G") "g" (= c "H") "h"
(= c "I") "i" (= c "J") "j" (= c "K") "k" (= c "L") "l"
(= c "M") "m" (= c "N") "n" (= c "O") "o" (= c "P") "p"
(= c "Q") "q" (= c "R") "r" (= c "S") "s" (= c "T") "t"
(= c "U") "u" (= c "V") "v" (= c "W") "w" (= c "X") "x"
(= c "Y") "y" (= c "Z") "z" :else c))))
(define
go-strings-map-chars
(fn (s i acc char-fn)
(cond
(>= i (len s)) acc
:else
(go-strings-map-chars s (+ i 1) (str acc (char-fn (nth s i))) char-fn))))
(define
go-strings-to-upper
(fn (args)
(cond
(not (= (len args) 1))
(list :eval-error :strings-toupper-arity (len args))
:else
(let ((s (first args)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
:else (go-strings-map-chars s 0 "" go-strings-char-to-upper))))))
(define
go-strings-to-lower
(fn (args)
(cond
(not (= (len args) 1))
(list :eval-error :strings-tolower-arity (len args))
:else
(let ((s (first args)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
:else (go-strings-map-chars s 0 "" go-strings-char-to-lower))))))
;; ── TrimSpace ────────────────────────────────────────────────────
(define
go-strings-is-space?
(fn (c)
(or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
(define
go-strings-trim-left
(fn (s i)
(cond
(>= i (len s)) i
(go-strings-is-space? (nth s i)) (go-strings-trim-left s (+ i 1))
:else i)))
(define
go-strings-trim-right
(fn (s end)
(cond
(<= end 0) 0
(go-strings-is-space? (nth s (- end 1))) (go-strings-trim-right s (- end 1))
:else end)))
(define
go-strings-substr
;; Substring [lo, hi) — naive but predictable.
(fn (s lo hi)
(cond
(>= lo hi) ""
:else
(go-strings-substr-loop s lo hi ""))))
(define
go-strings-substr-loop
(fn (s i hi acc)
(cond
(>= i hi) acc
:else (go-strings-substr-loop s (+ i 1) hi (str acc (nth s i))))))
(define
go-strings-trim-space
(fn (args)
(cond
(not (= (len args) 1))
(list :eval-error :strings-trimspace-arity (len args))
:else
(let ((s (first args)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
:else
(let ((lo (go-strings-trim-left s 0)))
(let ((hi (go-strings-trim-right s (len s))))
(go-strings-substr s lo hi))))))))
;; ── Split ────────────────────────────────────────────────────────
(define
go-strings-split
(fn (args)
(cond
(not (= (len args) 2))
(list :eval-error :strings-split-arity (len args))
:else
(let ((s (first args)) (sep (nth args 1)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(not (string? sep)) (list :eval-error :strings-not-string sep)
(= (len sep) 0)
;; Empty separator: real Go splits to all chars; v0 keeps
;; behaviour simple — single-element slice.
(list :go-slice (list s))
:else
(list :go-slice (go-strings-split-loop s sep 0 (list))))))))
(define
go-strings-split-loop
(fn (s sep start acc)
(let ((idx (go-strings-index-loop s sep start)))
(cond
(< idx 0)
(go-strings-split-finalize acc (go-strings-substr s start (len s)))
:else
(go-strings-split-loop s sep (+ idx (len sep))
(go-strings-split-finalize acc
(go-strings-substr s start idx)))))))
(define
go-strings-split-finalize
;; Append a piece to acc, growing the list in order.
(fn (acc piece)
(cond
(= (len acc) 0) (list piece)
:else (go-name-concat acc (list piece)))))
;; ── Replace ──────────────────────────────────────────────────────
(define
go-strings-replace
;; Replace(s, old, new, n). n < 0 = all.
(fn (args)
(cond
(not (= (len args) 4))
(list :eval-error :strings-replace-arity (len args))
:else
(let ((s (first args)) (old (nth args 1))
(newv (nth args 2)) (n (nth args 3)))
(cond
(not (string? s)) (list :eval-error :strings-not-string s)
(not (string? old)) (list :eval-error :strings-not-string old)
(not (string? newv)) (list :eval-error :strings-not-string newv)
(= (len old) 0) s
:else (go-strings-replace-loop s old newv n 0 ""))))))
(define
go-strings-replace-loop
(fn (s old newv n start acc)
(let ((idx (go-strings-index-loop s old start)))
(cond
(or (< idx 0) (= n 0))
(str acc (go-strings-substr s start (len s)))
:else
(go-strings-replace-loop s old newv
(cond (< n 0) -1 :else (- n 1))
(+ idx (len old))
(str acc (go-strings-substr s start idx) newv))))))
;; ── go-std-strings package value ─────────────────────────────────
(define
go-std-strings
(list :go-package "strings"
(list
(list "Contains" (list :go-builtin-fn go-strings-contains))
(list "HasPrefix" (list :go-builtin-fn go-strings-has-prefix))
(list "HasSuffix" (list :go-builtin-fn go-strings-has-suffix))
(list "Index" (list :go-builtin-fn go-strings-index))
(list "Count" (list :go-builtin-fn go-strings-count))
(list "Repeat" (list :go-builtin-fn go-strings-repeat))
(list "Join" (list :go-builtin-fn go-strings-join))
(list "ToUpper" (list :go-builtin-fn go-strings-to-upper))
(list "ToLower" (list :go-builtin-fn go-strings-to-lower))
(list "TrimSpace" (list :go-builtin-fn go-strings-trim-space))
(list "Split" (list :go-builtin-fn go-strings-split))
(list "Replace" (list :go-builtin-fn go-strings-replace)))))

View File

@@ -1,186 +0,0 @@
;; Go end-to-end tests — complete programs exercising lex+parse+
;; types+eval+sched+stdlib together. Each test runs a multi-line Go
;; program and inspects the final env.
(define go-e2e-test-count 0)
(define go-e2e-test-pass 0)
(define go-e2e-test-fails (list))
(define
go-e2e-test
(fn (name actual expected)
(set! go-e2e-test-count (+ go-e2e-test-count 1))
(if (= actual expected)
(set! go-e2e-test-pass (+ go-e2e-test-pass 1))
(append! go-e2e-test-fails
{:name name :expected expected :actual actual}))))
(define
go-e2e-env
(go-env-extend
(go-env-extend go-env-builtins "strings" go-std-strings)
"strconv" go-std-strconv))
(define
go-e2e-run
(fn (src-list)
(go-eval-program go-e2e-env (map go-parse src-list))))
;; ── 1. Sieve via boolean slice (no modulo needed) ────────────────
(go-e2e-test "e2e: sieve-of-Eratosthenes via boolean slice — count primes ≤ 30"
(let ((env (go-e2e-run
(list
;; sieve[i] true means i is COMPOSITE (saves the
;; default-bool initialisation for primes).
"sieve := []bool{false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false}"
"for p := 2; p < 31; p = p + 1 { if sieve[p] == false { for k := p + p; k < 31; k = k + p { sieve[k] = true } } }"
"count := 0"
"for i := 2; i < 31; i = i + 1 { if sieve[i] == false { count = count + 1 } }"))))
(go-env-lookup env "count"))
;; primes ≤ 30: 2,3,5,7,11,13,17,19,23,29 = 10
10)
;; ── 1b. Range-membership check (works without mod) ───────────────
(go-e2e-test "e2e: linear search across slice of strings"
(let ((env (go-e2e-run
(list
"words := []string{\"apple\", \"banana\", \"cherry\", \"date\"}"
"func indexOf(xs []string, target string) int { for i, v := range xs { if v == target { return i } } ; return -1 }"
"i := indexOf(words, \"cherry\")"
"missing := indexOf(words, \"xyz\")"))))
(list (go-env-lookup env "i") (go-env-lookup env "missing")))
(list 2 -1))
;; ── 2. Reverse a slice ───────────────────────────────────────────
(go-e2e-test "e2e: reverse a slice of ints"
(let ((env (go-e2e-run
(list
"func reverse(xs []int) []int { r := []int{} ; for i := len(xs) - 1; i >= 0; i = i - 1 { r = append(r, xs[i]) } ; return r }"
"out := reverse([]int{1, 2, 3, 4, 5})"))))
(go-env-lookup env "out"))
(list :go-slice (list 5 4 3 2 1)))
;; ── 3. Fibonacci (recursive) ─────────────────────────────────────
(go-e2e-test "e2e: fib(10) = 55"
(let ((env (go-e2e-run
(list
"func fib(n int) int { if n < 2 { return n } ; return fib(n-1) + fib(n-2) }"
"r := fib(10)"))))
(go-env-lookup env "r"))
55)
;; ── 4. Sum-of-squares via Map+Reduce ─────────────────────────────
(go-e2e-test "e2e: sum-of-squares 1..5 via Map+Reduce"
(let ((env (go-e2e-run
(list
"func Map[T any, U any](xs []T, f func(T) U) []U { r := []int{} ; for i, v := range xs { r = append(r, f(v)) } ; return r }"
"func Reduce[T any, U any](xs []T, seed U, f func(U, T) U) U { acc := seed ; for i, v := range xs { acc = f(acc, v) } ; return acc }"
"func sq(x int) int { return x * x }"
"func add(a int, b int) int { return a + b }"
"squares := Map([]int{1, 2, 3, 4, 5}, sq)"
"total := Reduce(squares, 0, add)"))))
(go-env-lookup env "total"))
;; 1 + 4 + 9 + 16 + 25 = 55
55)
;; ── 5. Word frequency counter ────────────────────────────────────
(go-e2e-test "e2e: word-frequency over a sentence"
(let ((env (go-e2e-run
(list
"text := \"the quick brown fox jumps over the lazy dog the\""
"words := strings.Split(text, \" \")"
"counts := map[string]int{}"
"for i, w := range words { counts[w] = counts[w] + 1 }"
"the_count := counts[\"the\"]"
"fox_count := counts[\"fox\"]"
"dog_count := counts[\"dog\"]"))))
(list (go-env-lookup env "the_count")
(go-env-lookup env "fox_count")
(go-env-lookup env "dog_count")))
(list 3 1 1))
;; ── 6. Pipeline via channels ─────────────────────────────────────
(go-e2e-test "e2e: pipeline — generate, square, sum"
(let ((env (go-e2e-run
(list
"func gen(c chan int, n int) { for i := 1; i <= n; i = i + 1 { c <- i } ; close(c) }"
"func sq(in chan int, out chan int) { for v := range in { out <- v * v } ; close(out) }"
"src := make()"
"sqs := make()"
"go gen(src, 4)"
"go sq(src, sqs)"
"total := 0"
"for v := range sqs { total = total + v }"))))
(go-env-lookup env "total"))
;; 1+4+9+16 = 30
30)
;; ── 7. Worker pool draining a job channel ────────────────────────
(go-e2e-test "e2e: worker pool — sum of doubled jobs"
(let ((env (go-e2e-run
(list
"func worker(jobs chan int, results chan int) { for j := range jobs { results <- j * 2 } }"
"jobs := make()"
"results := make()"
"jobs <- 10 ; jobs <- 20 ; jobs <- 30"
"close(jobs)"
"go worker(jobs, results)"
"close(results)"
"sum := 0"
"for r := range results { sum = sum + r }"))))
(go-env-lookup env "sum"))
;; 20 + 40 + 60 = 120
120)
;; ── 8. Bubble sort ───────────────────────────────────────────────
(go-e2e-test "e2e: bubble sort ascending"
(let ((env (go-e2e-run
(list
"func bubble(xs []int) []int { n := len(xs) ; for i := 0; i < n; i = i + 1 { for j := 0; j < n - 1; j = j + 1 { if xs[j] > xs[j+1] { tmp := xs[j] ; xs[j] = xs[j+1] ; xs[j+1] = tmp } } } ; return xs }"
"out := bubble([]int{3, 1, 4, 1, 5, 9, 2, 6})"))))
(go-env-lookup env "out"))
(list :go-slice (list 1 1 2 3 4 5 6 9)))
;; ── 9. String reverse using strings.Split + reverse + Join ──────
(go-e2e-test "e2e: reverse words in a sentence"
(let ((env (go-e2e-run
(list
"func rev(xs []string) []string { r := []string{} ; for i := len(xs) - 1; i >= 0; i = i - 1 { r = append(r, xs[i]) } ; return r }"
"text := \"go on sx\""
"out := strings.Join(rev(strings.Split(text, \" \")), \"-\")"))))
(go-env-lookup env "out"))
"sx-on-go")
;; ── 10. Counting occurrences via Filter ──────────────────────────
(go-e2e-test "e2e: count even numbers via Filter+len"
(let ((env (go-e2e-run
(list
"func Filter[T any](xs []T, p func(T) bool) []T { r := []int{} ; for i, v := range xs { if p(v) { r = append(r, v) } } ; return r }"
"func gt5(x int) bool { return x > 5 }"
"n := len(Filter([]int{1, 2, 6, 3, 7, 8, 4, 9}, gt5))"))))
(go-env-lookup env "n"))
;; gt5: 6,7,8,9 = 4
4)
;; ── 11. Recursive ackermann (small inputs) ───────────────────────
(go-e2e-test "e2e: ackermann(2, 3) = 9"
(let ((env (go-e2e-run
(list
"func ack(m int, n int) int { if m == 0 { return n + 1 } ; if n == 0 { return ack(m - 1, 1) } ; return ack(m - 1, ack(m, n - 1)) }"
"r := ack(2, 3)"))))
(go-env-lookup env "r"))
9)
;; ── 12. Defer + recover smoke test ───────────────────────────────
(go-e2e-test "e2e: defer + recover in real-fn flow"
(let ((env (go-e2e-run
(list
"func safeDivide(a int, b int) int { defer recover() ; if b == 0 { panic(\"div by zero\") } ; return a / b }"
"r := safeDivide(10, 0)"
"after := 99"))))
(go-env-lookup env "after"))
99)
(define
go-e2e-test-summary
(str "e2e " go-e2e-test-pass "/" go-e2e-test-count))

View File

@@ -1,667 +0,0 @@
;; Go evaluator tests.
(define go-eval-test-count 0)
(define go-eval-test-pass 0)
(define go-eval-test-fails (list))
(define
go-eval-test
(fn
(name actual expected)
(set! go-eval-test-count (+ go-eval-test-count 1))
(if
(= actual expected)
(set! go-eval-test-pass (+ go-eval-test-pass 1))
(append! go-eval-test-fails {:name name :expected expected :actual actual}))))
(define gtev (fn (env src) (go-eval env (go-parse src))))
;; ── env ──────────────────────────────────────────────────────────
(go-eval-test
"env: empty lookup returns nil"
(go-env-lookup go-env-empty "x")
nil)
(go-eval-test
"env: extend then lookup"
(go-env-lookup (go-env-extend go-env-empty "x" 42) "x")
42)
;; ── literals ────────────────────────────────────────────────────
(go-eval-test "lit: 42 → 42" (gtev go-env-empty "42") 42)
(go-eval-test "lit: 0 → 0" (gtev go-env-empty "0") 0)
(go-eval-test "lit: 0xFF → 255" (gtev go-env-empty "0xFF") 255)
(go-eval-test "lit: 0b1010 → 10" (gtev go-env-empty "0b1010") 10)
(go-eval-test "lit: 0o17 → 15" (gtev go-env-empty "0o17") 15)
(go-eval-test
"lit: underscore separator 1_000 → 1000"
(gtev go-env-empty "1_000")
1000)
(go-eval-test "lit: string" (gtev go-env-empty "\"hello\"") "hello")
;; ── predeclared ─────────────────────────────────────────────────
(go-eval-test "var: true" (gtev go-env-empty "true") true)
(go-eval-test "var: false" (gtev go-env-empty "false") false)
(go-eval-test "var: nil" (gtev go-env-empty "nil") nil)
;; ── variable lookup ─────────────────────────────────────────────
(go-eval-test
"var: bound x → 5"
(go-eval (go-env-extend go-env-empty "x" 5) (go-parse "x"))
5)
(go-eval-test
"var: unbound y → :eval-error"
(gtev go-env-empty "y")
(list :eval-error :unbound "y"))
;; ── binary ops ─────────────────────────────────────────────────
(go-eval-test "binop: 1 + 2 → 3" (gtev go-env-empty "1 + 2") 3)
(go-eval-test "binop: 10 - 4 → 6" (gtev go-env-empty "10 - 4") 6)
(go-eval-test "binop: 3 * 7 → 21" (gtev go-env-empty "3 * 7") 21)
(go-eval-test "binop: 42 / 7 → 6" (gtev go-env-empty "42 / 7") 6)
(go-eval-test
"binop: 2 + 3 * 4 → 14 (prec)"
(gtev go-env-empty "2 + 3 * 4")
14)
(go-eval-test
"binop: a + b uses env"
(go-eval
(go-env-extend (go-env-extend go-env-empty "a" 3) "b" 4)
(go-parse "a + b"))
7)
(go-eval-test "binop: 1 < 2 → true" (gtev go-env-empty "1 < 2") true)
(go-eval-test "binop: 5 == 5 → true" (gtev go-env-empty "5 == 5") true)
(go-eval-test "binop: 5 != 5 → false" (gtev go-env-empty "5 != 5") false)
(go-eval-test
"binop: true && false → false"
(gtev go-env-empty "true && false")
false)
(go-eval-test
"binop: false || true → true"
(gtev go-env-empty "false || true")
true)
;; ── report ──────────────────────────────────────────────────────
(go-eval-test
"var-decl: var x = 5 — env has x=5"
(go-env-lookup
(go-eval-program go-env-empty (list (go-parse "var x = 5")))
"x")
5)
(go-eval-test
"short-decl: a, b := 3, 4 — env has both"
(let
((env (go-eval-program go-env-empty (list (go-parse "a, b := 3, 4")))))
(list (go-env-lookup env "a") (go-env-lookup env "b")))
(list 3 4))
(go-eval-test
"assign: x = 5 then x → 5"
(let
((env (go-eval-program (go-env-extend go-env-empty "x" 1) (list (go-parse "x = 5")))))
(go-env-lookup env "x"))
5)
(go-eval-test
"if: true branch evaluates"
(let
((env (go-eval-program (go-env-extend go-env-empty "x" 0) (list (go-parse "if true { x = 1 }")))))
(go-env-lookup env "x"))
1)
(go-eval-test
"if-else: false → else branch"
(let
((env (go-eval-program (go-env-extend go-env-empty "x" 0) (list (go-parse "if false { x = 1 } else { x = 2 }")))))
(go-env-lookup env "x"))
2)
(go-eval-test
"fn: define + call — double(7) = 14"
(let
((env (go-eval-program go-env-empty (list (go-parse "func double(x int) int { return x * 2 }")))))
(go-eval env (go-parse "double(7)")))
14)
(go-eval-test
"fn: add(2, 3) = 5"
(let
((env (go-eval-program go-env-empty (list (go-parse "func add(x, y int) int { return x + y }")))))
(go-eval env (go-parse "add(2, 3)")))
5)
(go-eval-test
"fn: recursive fib(5) = 5"
(let
((env (go-eval-program go-env-empty (list (go-parse "func fib(n int) int { if n < 2 { return n } return fib(n-1) + fib(n-2) }")))))
(go-eval env (go-parse "fib(5)")))
5)
(go-eval-test
"for: count to 10 with sum"
(let
((env (go-eval-program go-env-empty (list (go-parse "var sum = 0") (go-parse "for i := 0; i < 10; i++ { sum = sum + i }")))))
(go-env-lookup env "sum"))
45)
(go-eval-test
"inc-dec: x++ updates env"
(let
((env (go-eval-program (go-env-extend go-env-empty "x" 5) (list (go-parse "x++")))))
(go-env-lookup env "x"))
6)
(go-eval-test
"inc-dec: x-- updates env"
(let
((env (go-eval-program (go-env-extend go-env-empty "x" 5) (list (go-parse "x--")))))
(go-env-lookup env "x"))
4)
(go-eval-test
"for: break exits the loop"
(let
((env (go-eval-program go-env-empty (list (go-parse "var i = 0") (go-parse "for i < 100 { if i == 5 { break } ; i++ }")))))
(go-env-lookup env "i"))
5)
(go-eval-test
"for: continue skips body but runs post"
(let
((env (go-eval-program go-env-empty (list (go-parse "var sum = 0") (go-parse "for i := 0; i < 5; i++ { if i == 2 { continue } ; sum = sum + i }")))))
(go-env-lookup env "sum"))
8)
(go-eval-test
"for: infinite + break with sum"
(let
((env (go-eval-program go-env-empty (list (go-parse "var s = 0") (go-parse "var i = 1") (go-parse "for { if i > 4 { break } ; s = s + i ; i++ }")))))
(go-env-lookup env "s"))
10)
(go-eval-test
"fn: iterative factorial via for-loop"
(let
((env (go-eval-program go-env-empty (list (go-parse "func fact(n int) int { r := 1 ; for i := 2 ; i <= n ; i++ { r = r * i } ; return r }")))))
(go-eval env (go-parse "fact(5)")))
120)
(go-eval-test
"slice: []int{1,2,3} → :go-slice"
(gtev go-env-empty "[]int{1, 2, 3}")
(list :go-slice (list 1 2 3)))
(go-eval-test
"index: a[0] = 10, a[2] = 30"
(let
((env (go-eval-program go-env-empty (list (go-parse "a := []int{10, 20, 30}")))))
(list (go-eval env (go-parse "a[0]")) (go-eval env (go-parse "a[2]"))))
(list 10 30))
(go-eval-test
"index: out-of-range error"
(let
((env (go-eval-program go-env-empty (list (go-parse "a := []int{1, 2}")))))
(go-eval env (go-parse "a[5]")))
(list :eval-error :index-out-of-range 5 2))
(go-eval-test
"builtin: len(slice) = 3"
(let
((env (go-eval-program go-env-builtins (list (go-parse "a := []int{1, 2, 3}")))))
(go-eval env (go-parse "len(a)")))
3)
(go-eval-test
"builtin: len(string)"
(go-eval go-env-builtins (go-parse "len(\"hello\")"))
5)
(go-eval-test
"builtin: append(a, 4, 5)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "a := []int{1, 2, 3}")))))
(go-eval env (go-parse "append(a, 4, 5)")))
(list
:go-slice (list 1 2 3 4 5)))
(go-eval-test
"slice expr: a[1:3]"
(let
((env (go-eval-program go-env-empty (list (go-parse "a := []int{10, 20, 30, 40}")))))
(go-eval env (go-parse "a[1:3]")))
(list :go-slice (list 20 30)))
(go-eval-test
"slice expr: a[:2] (omitted low)"
(let
((env (go-eval-program go-env-empty (list (go-parse "a := []int{1, 2, 3, 4}")))))
(go-eval env (go-parse "a[:2]")))
(list :go-slice (list 1 2)))
(go-eval-test
"slice expr: a[2:] (omitted high)"
(let
((env (go-eval-program go-env-empty (list (go-parse "a := []int{1, 2, 3, 4}")))))
(go-eval env (go-parse "a[2:]")))
(list :go-slice (list 3 4)))
(go-eval-test
"fn: sum slice via for-loop with len + index"
(let
((env (go-eval-program go-env-builtins (list (go-parse "a := []int{1, 2, 3, 4, 5}") (go-parse "sum := 0") (go-parse "for i := 0; i < len(a); i++ { sum = sum + a[i] }")))))
(go-env-lookup env "sum"))
15)
(go-eval-test
"map: map[string]int{...} → :go-map"
(gtev go-env-empty "map[string]int{\"a\": 1, \"b\": 2}")
(list :go-map (list (list "a" 1) (list "b" 2))))
(go-eval-test
"map: m[\"a\"] → 1"
(let
((env (go-eval-program go-env-empty (list (go-parse "m := map[string]int{\"a\": 1, \"b\": 2}")))))
(go-eval env (go-parse "m[\"a\"]")))
1)
(go-eval-test
"map: missing key → nil (v0 stand-in for zero value)"
(let
((env (go-eval-program go-env-empty (list (go-parse "m := map[string]int{\"a\": 1}")))))
(go-eval env (go-parse "m[\"missing\"]")))
nil)
(go-eval-test
"map: len(m) = 2"
(let
((env (go-eval-program go-env-builtins (list (go-parse "m := map[string]int{\"a\": 1, \"b\": 2}")))))
(go-eval env (go-parse "len(m)")))
2)
(go-eval-test
"map: index-assign updates existing key"
(let
((env (go-eval-program go-env-empty (list (go-parse "m := map[string]int{\"a\": 1}") (go-parse "m[\"a\"] = 99")))))
(go-eval env (go-parse "m[\"a\"]")))
99)
(go-eval-test
"map: index-assign adds new key"
(let
((env (go-eval-program go-env-empty (list (go-parse "m := map[string]int{}") (go-parse "m[\"new\"] = 7")))))
(go-eval env (go-parse "m[\"new\"]")))
7)
(go-eval-test
"slice: index-assign a[0] = 99"
(let
((env (go-eval-program go-env-empty (list (go-parse "a := []int{10, 20, 30}") (go-parse "a[0] = 99")))))
(go-eval env (go-parse "a[0]")))
99)
(go-eval-test
"map: word count via loop"
(let
((env (go-eval-program go-env-builtins (list (go-parse "words := []string{\"a\", \"b\", \"a\", \"c\", \"a\"}") (go-parse "counts := map[string]int{}") (go-parse "for i := 0; i < len(words); i++ { counts[words[i]] = counts[words[i]] + 1 }")))))
(go-eval env (go-parse "counts[\"a\"]")))
3)
(go-eval-test
"type-decl: registers struct field names"
(go-env-lookup
(go-eval-program
go-env-empty
(list (go-parse "type Point struct { x, y int }")))
"Point")
(list :go-struct-type (list "x" "y")))
(go-eval-test
"struct: positional composite Point{1, 2}"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }")))))
(go-eval env (go-parse "Point{1, 2}")))
(list
:go-struct "Point"
(list (list "x" 1) (list "y" 2))))
(go-eval-test
"struct: keyed composite Point{x: 5, y: 10}"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }")))))
(go-eval env (go-parse "Point{x: 5, y: 10}")))
(list
:go-struct "Point"
(list (list "x" 5) (list "y" 10))))
(go-eval-test
"struct: selector p.x = 1"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "p := Point{1, 2}")))))
(go-eval env (go-parse "p.x")))
1)
(go-eval-test
"struct: selector p.y = 2"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "p := Point{1, 2}")))))
(go-eval env (go-parse "p.y")))
2)
(go-eval-test
"struct: selector-assign p.x = 99"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "p := Point{1, 2}") (go-parse "p.x = 99")))))
(go-eval env (go-parse "p.x")))
99)
(go-eval-test
"struct: positional arity-mismatch"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }")))))
(go-eval env (go-parse "Point{1}")))
(list :eval-error :struct-arity-mismatch "Point" 2 1))
(go-eval-test
"struct: function takes/returns struct"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "func add(a, b Point) Point { return Point{a.x + b.x, a.y + b.y} }")))))
(go-eval env (go-parse "add(Point{1, 2}, Point{3, 4})")))
(list
:go-struct "Point"
(list (list "x" 4) (list "y" 6))))
(go-eval-test
"method: p.Sum() = 3"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "func (p Point) Sum() int { return p.x + p.y }") (go-parse "p := Point{1, 2}")))))
(go-eval env (go-parse "p.Sum()")))
3)
(go-eval-test
"method: p.Add(5) = 6 (with arg)"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "func (p Point) Add(d int) int { return p.x + d }") (go-parse "p := Point{1, 2}")))))
(go-eval env (go-parse "p.Add(5)")))
6)
(go-eval-test
"method: pointer receiver works value-style in v0"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "func (p *Point) GetX() int { return p.x }") (go-parse "p := Point{1, 2}")))))
(go-eval env (go-parse "p.GetX()")))
1)
(go-eval-test
"method: missing method → :no-such-method"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Point struct { x, y int }") (go-parse "p := Point{1, 2}")))))
(go-eval env (go-parse "p.Ghost()")))
(list :eval-error :no-such-method "Point" "Ghost"))
(go-eval-test
"unary: -x"
(go-eval (go-env-extend go-env-empty "x" 5) (go-parse "-x"))
-5)
(go-eval-test "unary: !true → false" (gtev go-env-empty "!true") false)
(go-eval-test "unary: !false → true" (gtev go-env-empty "!false") true)
(go-eval-test
"unary: -3 + 5 = 2 (unary binds tighter)"
(gtev go-env-empty "-3 + 5")
2)
(go-eval-test
"e2e: count odd numbers in 1..10 = 5"
(let
((env (go-eval-program go-env-empty
(list (go-parse "odds := 0")
(go-parse "i := 1")
(go-parse "for i <= 10 { odds = odds + 1; i = i + 2 }")))))
(go-env-lookup env "odds"))
5)
(go-eval-test
"e2e: factorial via method on Counter"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Acc struct { v int }") (go-parse "func (a Acc) Mul(x int) Acc { return Acc{a.v * x} }") (go-parse "a := Acc{1}") (go-parse "for i := 1; i <= 5; i++ { a = a.Mul(i) }")))))
(go-eval env (go-parse "a.v")))
120)
(go-eval-test
"e2e: recursive fibonacci fib(10) = 55"
(let
((env (go-eval-program go-env-empty (list (go-parse "func fib(n int) int { if n < 2 { return n } return fib(n-1) + fib(n-2) }")))))
(go-eval env (go-parse "fib(10)")))
55)
(go-eval-test
"e2e: struct + method + iterative loop"
(let
((env (go-eval-program go-env-empty (list (go-parse "type Counter struct { n int }") (go-parse "func (c Counter) Bump() Counter { return Counter{c.n + 1} }") (go-parse "c := Counter{0}") (go-parse "for i := 0; i < 7; i++ { c = c.Bump() }")))))
(go-eval env (go-parse "c.n")))
7)
(go-eval-test
"e2e: linear search returns index"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func find(a []int, x int) int { for i := 0; i < len(a); i++ { if a[i] == x { return i } } ; return -1 }") (go-parse "nums := []int{10, 20, 30, 40}")))))
(go-eval env (go-parse "find(nums, 30)")))
2)
(go-eval-test
"e2e: linear search returns -1 when missing"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func find(a []int, x int) int { for i := 0; i < len(a); i++ { if a[i] == x { return i } } ; return -1 }") (go-parse "nums := []int{10, 20, 30}")))))
(go-eval env (go-parse "find(nums, 99)")))
-1)
(go-eval-test
"defer: single defer runs after surrounding fn body returns"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func push2(c chan int) { c <- 2 }") (go-parse "func run(c chan int) { defer push2(c) ; c <- 1 }") (go-parse "run(ch)") (go-parse "first := <-ch") (go-parse "second := <-ch")))))
(list (go-env-lookup env "first") (go-env-lookup env "second")))
(list 1 2))
(go-eval-test
"defer: multiple defers run LIFO"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func p2(c chan int) { c <- 2 }") (go-parse "func p3(c chan int) { c <- 3 }") (go-parse "func run(c chan int) { defer p2(c) ; defer p3(c) ; c <- 1 }") (go-parse "run(ch)") (go-parse "a := <-ch") (go-parse "b := <-ch") (go-parse "d := <-ch")))))
(list
(go-env-lookup env "a")
(go-env-lookup env "b")
(go-env-lookup env "d")))
(list 1 3 2))
(go-eval-test
"defer: arguments are evaluated at defer-time (not call-time)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func pushN(c chan int, v int) { c <- v }") (go-parse "func run(c chan int) { x := 7 ; defer pushN(c, x) ; x = 99 }") (go-parse "run(ch)") (go-parse "got := <-ch")))))
(go-env-lookup env "got"))
7)
(go-eval-test
"defer: runs even when fn returns early via return"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func note(c chan int) { c <- 42 }") (go-parse "func run(c chan int) int { defer note(c) ; return 1 }") (go-parse "r := run(ch)") (go-parse "n := <-ch")))))
(list (go-env-lookup env "r") (go-env-lookup env "n")))
(list 1 42))
(go-eval-test
"defer: stack is frame-local — outer defers don't run on inner return"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func push1(c chan int) { c <- 1 }") (go-parse "func push2(c chan int) { c <- 2 }") (go-parse "func inner(c chan int) { defer push2(c) }") (go-parse "func outer(c chan int) { defer push1(c) ; inner(c) }") (go-parse "outer(ch)") (go-parse "a := <-ch") (go-parse "b := <-ch")))))
(list (go-env-lookup env "a") (go-env-lookup env "b")))
(list 2 1))
(go-eval-test
"defer: in a loop, all defers fire on fn return (not loop iter)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func pushI(c chan int, v int) { c <- v }") (go-parse "func loop(c chan int) { for i := 0; i < 4; i = i + 1 { defer pushI(c, i) } }") (go-parse "loop(ch)") (go-parse "a := <-ch") (go-parse "b := <-ch") (go-parse "d := <-ch") (go-parse "e := <-ch")))))
(list
(go-env-lookup env "a")
(go-env-lookup env "b")
(go-env-lookup env "d")
(go-env-lookup env "e")))
(list 3 2 1 0))
(go-eval-test
"panic: uncaught panic surfaces as (:go-panic V) from program"
(let
((r (go-eval-program go-env-builtins (list (go-parse "panic(\"boom\")")))))
r)
(list :go-panic "boom"))
(go-eval-test
"panic inside fn: surfaces from fn call too"
(let
((r (go-eval-program go-env-builtins (list (go-parse "func boom() { panic(\"oops\") }") (go-parse "boom()")))))
r)
(list :go-panic "oops"))
(go-eval-test
"recover: deferred recover swallows panic, fn returns normally"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func safe() { defer recover() ; panic(\"x\") }") (go-parse "safe()") (go-parse "after := 42")))))
(go-env-lookup env "after"))
42)
(go-eval-test
"recover: deferred recover captures the panic value"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func grab(c chan int) { r := recover() ; c <- r }") (go-parse "func safe(c chan int) { defer grab(c) ; panic(99) }") (go-parse "safe(ch)") (go-parse "got := <-ch")))))
(go-env-lookup env "got"))
99)
(go-eval-test
"panic: propagates through intermediate frames without defers"
(let
((r (go-eval-program go-env-builtins (list (go-parse "func inner() { panic(\"deep\") }") (go-parse "func middle() { inner() }") (go-parse "func outer() { middle() }") (go-parse "outer()")))))
r)
(list :go-panic "deep"))
(go-eval-test
"recover: middle-frame defer catches panic from deeper frame"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func inner() { panic(\"deep\") }") (go-parse "func middle() { inner() }") (go-parse "func outer() { defer recover() ; middle() }") (go-parse "outer()") (go-parse "after := 7")))))
(go-env-lookup env "after"))
7)
(go-eval-test
"goroutine panic: surfaces synchronously back to spawner (v0)"
(let
((r (go-eval-program go-env-builtins (list (go-parse "func boom() { panic(\"goroutine\") }") (go-parse "go boom()")))))
r)
(list :go-panic "goroutine"))
(go-eval-test
"goroutine panic + spawner-defer-recover catches it (v0 sync)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func boom() { panic(\"g\") }") (go-parse "func main() { defer recover() ; go boom() }") (go-parse "main()") (go-parse "after := 11")))))
(go-env-lookup env "after"))
11)
(go-eval-test
"defer order with recover: all defers run, recover catches"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func p2(c chan int) { c <- 2 }") (go-parse "func rec(c chan int) { recover() ; c <- 7 }") (go-parse "func safe(c chan int) { defer p2(c) ; defer rec(c) ; panic(0) }") (go-parse "safe(ch)") (go-parse "a := <-ch") (go-parse "b := <-ch")))))
(list (go-env-lookup env "a") (go-env-lookup env "b")))
(list 7 2))
(go-eval-test
"defer fires when fn panics (not just normal return)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func note(c chan int) { c <- 5 }") (go-parse "func safe(c chan int) { defer note(c) ; defer recover() ; panic(\"!\") }") (go-parse "safe(ch)") (go-parse "got := <-ch")))))
(go-env-lookup env "got"))
5)
(go-eval-test
"panic with nil value: still surfaces as (:go-panic nil)"
(let
((r (go-eval-program go-env-builtins (list (go-parse "panic(nil)")))))
r)
(list :go-panic nil))
(go-eval-test
"panic inside loop body: aborts loop + propagates"
(let
((r (go-eval-program go-env-builtins (list (go-parse "func find(x int) { for i := 0; i < 10; i = i + 1 { if i == x { panic(i) } } }") (go-parse "find(3)")))))
r)
(list :go-panic 3))
(go-eval-test
"defer in panicking fn: still runs even though no return reached"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func mark(c chan int) { c <- 8 }") (go-parse "func inner(c chan int) { defer mark(c) ; panic(\"!\") }") (go-parse "func outer(c chan int) { defer recover() ; inner(c) }") (go-parse "outer(ch)") (go-parse "got := <-ch")))))
(go-env-lookup env "got"))
8)
(go-eval-test
"defer fn captures args by value, not reference (re-confirm)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "func pushN(c chan int, v int) { c <- v }") (go-parse "func run(c chan int) { defer recover() ; x := 5 ; defer pushN(c, x) ; x = 999 ; panic(\"k\") }") (go-parse "run(ch)") (go-parse "got := <-ch")))))
(go-env-lookup env "got"))
5)
(go-eval-test
"generic: identity Id[T any](x) returns x at runtime"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func Id[T any](x T) T { return x }") (go-parse "r := Id(42)")))))
(go-env-lookup env "r"))
42)
(go-eval-test
"generic: Id works with strings (type erasure)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func Id[T any](x T) T { return x }") (go-parse "r := Id(\"hi\")")))))
(go-env-lookup env "r"))
"hi")
(go-eval-test
"generic: Map[T, U] over []int with double — produces []int"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func Map[T any, U any](xs []T, f func(T) U) []U { r := []int{} ; for i, v := range xs { r = append(r, f(v)) } ; return r }") (go-parse "func dbl(x int) int { return x * 2 }") (go-parse "out := Map([]int{1, 2, 3}, dbl)") (go-parse "first := out[0]") (go-parse "second := out[1]") (go-parse "third := out[2]")))))
(list
(go-env-lookup env "first")
(go-env-lookup env "second")
(go-env-lookup env "third")))
(list 2 4 6))
(go-eval-test
"generic: Filter[T any] keeps elements satisfying predicate"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func Filter[T any](xs []T, p func(T) bool) []T { r := []int{} ; for i, v := range xs { if p(v) { r = append(r, v) } } ; return r }") (go-parse "func gt3(x int) bool { return x > 3 }") (go-parse "out := Filter([]int{1, 2, 3, 4, 5, 6}, gt3)") (go-parse "n := len(out)") (go-parse "first := out[0]") (go-parse "last := out[2]")))))
(list
(go-env-lookup env "n")
(go-env-lookup env "first")
(go-env-lookup env "last")))
(list 3 4 6))
(go-eval-test
"generic: Reduce[T, U] sums []int with seed 0"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func Reduce[T any, U any](xs []T, seed U, f func(U, T) U) U { acc := seed ; for i, v := range xs { acc = f(acc, v) } ; return acc }") (go-parse "func add(a int, b int) int { return a + b }") (go-parse "total := Reduce([]int{10, 20, 30, 40}, 0, add)")))))
(go-env-lookup env "total"))
100)
(go-eval-test
"generic: First[T any]([]T) T returns element zero"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func First[T any](xs []T) T { return xs[0] }") (go-parse "v := First([]int{42, 99})")))))
(go-env-lookup env "v"))
42)
(define
go-eval-test-summary
(str "eval " go-eval-test-pass "/" go-eval-test-count))

View File

@@ -1,339 +0,0 @@
;; Go tokenizer tests.
(define go-test-count 0)
(define go-test-pass 0)
(define go-test-fails (list))
(define gtok-type (fn (t) (get t :type)))
(define gtok-value (fn (t) (get t :value)))
(define tok-types (fn (src) (map gtok-type (go-tokenize src))))
(define tok-values (fn (src) (map gtok-value (go-tokenize src))))
(define
go-test
(fn
(name actual expected)
(set! go-test-count (+ go-test-count 1))
(if
(= actual expected)
(set! go-test-pass (+ go-test-pass 1))
(append! go-test-fails {:name name :expected expected :actual actual}))))
;; ── empty / whitespace ────────────────────────────────────────────
(go-test "empty source" (tok-types "") (list "eof"))
(go-test "spaces only" (tok-types " ") (list "eof"))
(go-test "tabs only" (tok-types "\t\t") (list "eof"))
(go-test
"newline only — no prior token, no ASI"
(tok-types "\n")
(list "eof"))
;; ── identifiers ───────────────────────────────────────────────────
(go-test "ident: simple" (tok-values "foo") (list "foo" "\n" nil))
(go-test
"ident: underscore prefix"
(tok-values "_bar")
(list "_bar" "\n" nil))
(go-test "ident: mixed case" (tok-values "fooBar") (list "fooBar" "\n" nil))
(go-test "ident: with digits" (tok-values "x123") (list "x123" "\n" nil))
(go-test "ident: type tag" (tok-types "foo") (list "ident" "semi" "eof"))
;; ── keywords (all 25) ─────────────────────────────────────────────
(go-test "kw: break" (tok-types "break") (list "keyword" "semi" "eof"))
(go-test "kw: case" (tok-types "case") (list "keyword" "eof"))
(go-test "kw: chan" (tok-types "chan") (list "keyword" "eof"))
(go-test "kw: const" (tok-types "const") (list "keyword" "eof"))
(go-test "kw: continue" (tok-types "continue") (list "keyword" "semi" "eof"))
(go-test "kw: default" (tok-types "default") (list "keyword" "eof"))
(go-test "kw: defer" (tok-types "defer") (list "keyword" "eof"))
(go-test "kw: else" (tok-types "else") (list "keyword" "eof"))
(go-test
"kw: fallthrough"
(tok-types "fallthrough")
(list "keyword" "semi" "eof"))
(go-test "kw: for" (tok-types "for") (list "keyword" "eof"))
(go-test "kw: func" (tok-types "func") (list "keyword" "eof"))
(go-test "kw: go" (tok-types "go") (list "keyword" "eof"))
(go-test "kw: goto" (tok-types "goto") (list "keyword" "eof"))
(go-test "kw: if" (tok-types "if") (list "keyword" "eof"))
(go-test "kw: import" (tok-types "import") (list "keyword" "eof"))
(go-test "kw: interface" (tok-types "interface") (list "keyword" "eof"))
(go-test "kw: map" (tok-types "map") (list "keyword" "eof"))
(go-test "kw: package" (tok-types "package") (list "keyword" "eof"))
(go-test "kw: range" (tok-types "range") (list "keyword" "eof"))
(go-test "kw: return" (tok-types "return") (list "keyword" "semi" "eof"))
(go-test "kw: select" (tok-types "select") (list "keyword" "eof"))
(go-test "kw: struct" (tok-types "struct") (list "keyword" "eof"))
(go-test "kw: switch" (tok-types "switch") (list "keyword" "eof"))
(go-test "kw: type" (tok-types "type") (list "keyword" "eof"))
(go-test "kw: var" (tok-types "var") (list "keyword" "eof"))
;; ── integer literals — decimal ────────────────────────────────────
(go-test "int: zero" (tok-values "0") (list "0" "\n" nil))
(go-test "int: small" (tok-values "42") (list "42" "\n" nil))
(go-test "int: bigger" (tok-values "123456") (list "123456" "\n" nil))
(go-test "int: type" (tok-types "42") (list "int" "semi" "eof"))
;; ── integer literals — prefixed + underscores ─────────────────────
(go-test "int: hex lower" (tok-values "0x1f") (list "0x1f" "\n" nil))
(go-test "int: hex upper-x" (tok-values "0X1F") (list "0X1F" "\n" nil))
(go-test
"int: hex mixed digits"
(tok-values "0xDEADbeef")
(list "0xDEADbeef" "\n" nil))
(go-test "int: binary lower" (tok-values "0b1010") (list "0b1010" "\n" nil))
(go-test "int: binary upper" (tok-values "0B1101") (list "0B1101" "\n" nil))
(go-test "int: octal modern" (tok-values "0o755") (list "0o755" "\n" nil))
(go-test "int: octal upper" (tok-values "0O17") (list "0O17" "\n" nil))
(go-test "int: octal legacy" (tok-values "0755") (list "0755" "\n" nil))
(go-test "int: hex type" (tok-types "0x1F") (list "int" "semi" "eof"))
(go-test "int: bin type" (tok-types "0b101") (list "int" "semi" "eof"))
(go-test
"int: dec underscore"
(tok-values "1_000_000")
(list "1_000_000" "\n" nil))
(go-test
"int: hex underscore"
(tok-values "0xDEAD_BEEF")
(list "0xDEAD_BEEF" "\n" nil))
(go-test
"int: bin underscore"
(tok-values "0b1010_1010")
(list "0b1010_1010" "\n" nil))
(go-test
"int: hex then +"
(tok-types "0xFF + 1")
(list "int" "op" "int" "semi" "eof"))
;; ── float literals (Go spec § Floating-point literals) ────────────
(go-test "float: simple" (tok-values "3.14") (list "3.14" "\n" nil))
(go-test "float: trailing dot" (tok-values "1.") (list "1." "\n" nil))
(go-test "float: leading dot" (tok-values ".5") (list ".5" "\n" nil))
(go-test "float: exp lower" (tok-values "1e10") (list "1e10" "\n" nil))
(go-test "float: exp upper" (tok-values "1E5") (list "1E5" "\n" nil))
(go-test "float: exp negative" (tok-values "1.5e-3") (list "1.5e-3" "\n" nil))
(go-test "float: exp positive" (tok-values "2.0e+2") (list "2.0e+2" "\n" nil))
(go-test "float: zero" (tok-values "0.0") (list "0.0" "\n" nil))
(go-test "float: dot-only-exp" (tok-values ".5e2") (list ".5e2" "\n" nil))
(go-test "float: underscore" (tok-values "1_000.5") (list "1_000.5" "\n" nil))
(go-test "float: type" (tok-types "3.14") (list "float" "semi" "eof"))
(go-test
"float: trailing dot type"
(tok-types "1.")
(list "float" "semi" "eof"))
(go-test
"float: exp-only type"
(tok-types "1e10")
(list "float" "semi" "eof"))
(go-test
"float: then +"
(tok-types "3.14 + 0.1")
(list "float" "op" "float" "semi" "eof"))
(go-test
"float: greedy 1.method"
(tok-types "1.method")
(list "float" "ident" "semi" "eof"))
;; ── imaginary literals (Go spec § Imaginary literals) ─────────────
(go-test "imag: int i" (tok-values "2i") (list "2i" "\n" nil))
(go-test "imag: float i" (tok-values "3.14i") (list "3.14i" "\n" nil))
(go-test "imag: exp i" (tok-values "1e2i") (list "1e2i" "\n" nil))
(go-test "imag: int-i type" (tok-types "2i") (list "imag" "semi" "eof"))
(go-test "imag: float-i type" (tok-types "3.14i") (list "imag" "semi" "eof"))
(go-test "imag: ASI at newline" (tok-types "1i\n") (list "imag" "semi" "eof"))
;; ── string literals ───────────────────────────────────────────────
(go-test "raw: simple" (tok-values "`hello`") (list "hello" "\n" nil))
(go-test "raw: empty" (tok-values "``") (list "" "\n" nil))
(go-test
"raw: backslash literal — no escape processing"
(tok-values "`a\\nb`")
(list "a\\nb" "\n" nil))
(go-test
"raw: multi-line"
(tok-values "`line1\nline2`")
(list "line1\nline2" "\n" nil))
(go-test
"raw: contains double-quote"
(tok-values "`say \"hi\"`")
(list "say \"hi\"" "\n" nil))
(go-test
"raw: CR stripped (Go spec § String literals)"
(tok-values "`a\r\nb`")
(list "a\nb" "\n" nil))
(go-test "raw: type" (tok-types "`x`") (list "string" "semi" "eof"))
;; ── rune literals ─────────────────────────────────────────────────
(go-test
"raw: then +"
(tok-types "`x` + 1")
(list "string" "op" "int" "semi" "eof"))
(go-test
"raw: ASI at newline after"
(tok-types "`abc`\n")
(list "string" "semi" "eof"))
(go-test "string: empty" (tok-values "\"\"") (list "" "\n" nil))
;; ── comments ──────────────────────────────────────────────────────
(go-test "string: hello" (tok-values "\"hello\"") (list "hello" "\n" nil))
(go-test
"string: with space"
(tok-values "\"hi there\"")
(list "hi there" "\n" nil))
(go-test "string: escape n" (tok-values "\"a\\nb\"") (list "a\nb" "\n" nil))
(go-test "string: escape quote" (tok-values "\"a\\\"b\"") (list "a\"b" "\n" nil))
(go-test
"string: escape backslash"
(tok-values "\"a\\\\b\"")
(list "a\\b" "\n" nil))
;; ── operators & punctuation ───────────────────────────────────────
(go-test "string: type" (tok-types "\"x\"") (list "string" "semi" "eof"))
(go-test "rune: simple" (tok-values "'a'") (list "a" "\n" nil))
(go-test "rune: escape" (tok-values "'\\n'") (list "\n" "\n" nil))
(go-test "rune: type" (tok-types "'a'") (list "rune" "semi" "eof"))
(go-test "line comment" (tok-types "// ignored") (list "eof"))
(go-test "line comment then code" (tok-values "// hi\nx") (list "x" "\n" nil))
(go-test "block comment" (tok-types "/* a b c */") (list "eof"))
(go-test
"block comment inline"
(tok-values "x /* mid */ y")
(list "x" "y" "\n" nil))
(go-test
"block comment with newline — ASI"
(tok-types "x /* multi\nline */ y")
(list "ident" "semi" "ident" "semi" "eof"))
;; ── automatic semicolon insertion (Go spec § Semicolons) ──────────
(go-test
"ops: arithmetic"
(tok-values "+ - * / %")
(list "+" "-" "*" "/" "%" nil))
(go-test
"ops: comparison"
(tok-values "== != < > <= >=")
(list "==" "!=" "<" ">" "<=" ">=" nil))
(go-test "ops: logical" (tok-values "&& || !") (list "&&" "||" "!" nil))
(go-test
"ops: assign forms"
(tok-values "= := += -=")
(list "=" ":=" "+=" "-=" nil))
(go-test "ops: channel arrow" (tok-values "<- chan") (list "<-" "chan" nil))
(go-test "ops: incdec ASI" (tok-types "++ --") (list "op" "op" "semi" "eof"))
(go-test "ops: ellipsis" (tok-values "...") (list "..." nil))
(go-test
"punct: all brackets"
(tok-values "( ) { } [ ]")
(list "(" ")" "{" "}" "[" "]" "\n" nil))
(go-test
"punct: comma colon dot"
(tok-values ", : .")
(list "," ":" "." nil))
(go-test
"op-audit: tilde (generics type-set)"
(tok-values "~int")
(list "~" "int" "\n" nil))
(go-test
"op-audit: all arithmetic + assignment"
(tok-values "+ - * / % += -= *= /= %=")
(list "+" "-" "*" "/" "%" "+=" "-=" "*=" "/=" "%=" nil))
(go-test
"op-audit: all bitwise + assignment"
(tok-values "& | ^ << >> &^ &= |= ^= <<= >>= &^=")
(list "&" "|" "^" "<<" ">>" "&^" "&=" "|=" "^=" "<<=" ">>=" "&^=" nil))
(go-test
"op-audit: all comparison + logical"
(tok-values "== != < > <= >= && || !")
(list "==" "!=" "<" ">" "<=" ">=" "&&" "||" "!" nil))
(go-test
"op-audit: assign / decls / arrows / variadic / inc-dec"
(tok-values "= := <- ++ -- ...")
(list "=" ":=" "<-" "++" "--" "..." nil))
;; ── short program ─────────────────────────────────────────────────
(go-test
"op-audit: punctuation"
(tok-values "( ) [ ] { } , . :")
(list "(" ")" "[" "]" "{" "}" "," "." ":" nil))
(go-test
"ASI: after ident at newline"
(tok-types "x\ny")
(list "ident" "semi" "ident" "semi" "eof"))
(go-test "ASI: after int" (tok-types "42\n") (list "int" "semi" "eof"))
;; ── report ────────────────────────────────────────────────────────
(go-test "ASI: after float" (tok-types "3.14\n") (list "float" "semi" "eof"))
(go-test
"ASI: after string"
(tok-types "\"hi\"\n")
(list "string" "semi" "eof"))
(go-test "ASI: after rune" (tok-types "'a'\n") (list "rune" "semi" "eof"))
(go-test
"ASI: after )"
(tok-types "f()\n")
(list "ident" "op" "op" "semi" "eof"))
(go-test
"ASI: after ]"
(tok-types "x[0]\n")
(list "ident" "op" "int" "op" "semi" "eof"))
(go-test "ASI: after }" (tok-types "{}\n") (list "op" "op" "semi" "eof"))
(go-test "ASI: after ++" (tok-types "i++\n") (list "ident" "op" "semi" "eof"))
(go-test
"ASI: NOT after +"
(tok-types "x +\ny")
(list "ident" "op" "ident" "semi" "eof"))
(go-test
"ASI: NOT after ("
(tok-types "f(\nx)")
(list "ident" "op" "ident" "op" "semi" "eof"))
(go-test
"ASI: blank lines collapse — single semi only"
(tok-types "x\n\n\ny")
(list "ident" "semi" "ident" "semi" "eof"))
(go-test
"ASI: at EOF after ident"
(tok-types "x")
(list "ident" "semi" "eof"))
(go-test
"ASI: explicit semi"
(tok-types "x;y")
(list "ident" "semi" "ident" "semi" "eof"))
(go-test
"short-decl: x := 42 (types)"
(tok-types "x := 42")
(list "ident" "op" "int" "semi" "eof"))
(go-test
"short-decl: x := 42 (values)"
(tok-values "x := 42")
(list "x" ":=" "42" "\n" nil))
(go-test
"func decl shape"
(tok-types "func foo() int { return 0 }")
(list
"keyword"
"ident"
"op"
"op"
"ident"
"op"
"keyword"
"int"
"op"
"semi"
"eof"))
(define go-lex-test-summary (str "lex " go-test-pass "/" go-test-count))

File diff suppressed because it is too large Load Diff

View File

@@ -1,311 +0,0 @@
;; Go runtime tests — goroutines + channels.
(define go-rt-test-count 0)
(define go-rt-test-pass 0)
(define go-rt-test-fails (list))
(define
go-rt-test
(fn
(name actual expected)
(set! go-rt-test-count (+ go-rt-test-count 1))
(if
(= actual expected)
(set! go-rt-test-pass (+ go-rt-test-pass 1))
(append! go-rt-test-fails {:name name :expected expected :actual actual}))))
;; ── channel primitives (direct API, no source parsing) ─────────
(go-rt-test "chan: make returns a chan value" (go-chan? (go-make-chan)) true)
(go-rt-test
"chan: distinct channels have distinct identity"
(= (go-make-chan) (go-make-chan))
false)
(go-rt-test
"chan: send + recv round-trip"
(let
((ch (go-make-chan)))
(go-chan-send! ch 42)
(go-chan-recv! ch))
42)
(go-rt-test
"chan: empty recv returns :empty marker"
(let ((ch (go-make-chan))) (go-chan-recv! ch))
:empty)
(go-rt-test
"chan: FIFO order"
(let
((ch (go-make-chan)))
(go-chan-send! ch 1)
(go-chan-send! ch 2)
(go-chan-send! ch 3)
(list (go-chan-recv! ch) (go-chan-recv! ch) (go-chan-recv! ch)))
(list 1 2 3))
(go-rt-test
"chan: closed? flag flips"
(let
((ch (go-make-chan)))
(let
((before (go-chan-closed? ch)))
(go-chan-close! ch)
(list before (go-chan-closed? ch))))
(list false true))
;; ── source-level: make / send / recv / close ───────────────────
(go-rt-test
"src: ch := make() returns chan"
(go-chan?
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()")))))
(go-env-lookup env "ch")))
true)
(go-rt-test
"src: ch <- 5 then <-ch = 5"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "ch <- 5")))))
(go-eval env (go-parse "<-ch")))
5)
(go-rt-test
"src: go + chan ping-pong"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func sender(c chan int) { c <- 99 }") (go-parse "ch := make()") (go-parse "go sender(ch)")))))
(go-eval env (go-parse "<-ch")))
99)
(go-rt-test
"src: close(ch) marks it closed"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "close(ch)")))))
(go-chan-closed? (go-env-lookup env "ch")))
true)
(go-rt-test
"src: multiple goroutines feeding one channel"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func push(c chan int, v int) { c <- v }") (go-parse "ch := make()") (go-parse "go push(ch, 1)") (go-parse "go push(ch, 2)") (go-parse "go push(ch, 3)")))))
(list
(go-eval env (go-parse "<-ch"))
(go-eval env (go-parse "<-ch"))
(go-eval env (go-parse "<-ch"))))
(list 1 2 3))
(go-rt-test
"src: worker pattern — send sum back"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func work(c chan int, a int, b int) { c <- a + b }") (go-parse "result := make()") (go-parse "go work(result, 7, 13)")))))
(go-eval env (go-parse "<-result")))
20)
;; ── report ─────────────────────────────────────────────────────
(go-rt-test
"select: default runs when no case is ready"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "x := 0") (go-parse "select { case <-ch: x = 1 ; default: x = 99 }")))))
(go-env-lookup env "x"))
99)
(go-rt-test
"select: recv case fires when ready"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "ch <- 7") (go-parse "x := 0") (go-parse "select { case <-ch: x = 1 ; default: x = 99 }")))))
(go-env-lookup env "x"))
1)
(go-rt-test
"select: recv-into-var binds the value"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "ch <- 42") (go-parse "select { case v := <-ch: v }")))))
(go-env-lookup env "v"))
42)
(go-rt-test
"select: send case (always ready in v0)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "select { case ch <- 5: }")))))
(go-chan-len (go-env-lookup env "ch")))
1)
(go-rt-test
"select: picks first ready case"
(let
((env (go-eval-program go-env-builtins (list (go-parse "a := make()") (go-parse "b := make()") (go-parse "b <- 100") (go-parse "x := 0") (go-parse "select { case <-a: x = 1 ; case <-b: x = 2 ; default: x = 99 }")))))
(go-env-lookup env "x"))
2)
(go-rt-test
"select: no default + nothing ready → blocked error"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()")))))
(go-eval-stmt env (go-parse "select { case <-ch: }") (list)))
(list :eval-error :select-blocked-no-default))
(go-rt-test
"select: combined with goroutine fan-in"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func push(c chan int, v int) { c <- v }") (go-parse "ch := make()") (go-parse "go push(ch, 7)") (go-parse "result := 0") (go-parse "select { case v := <-ch: result = v ; default: result = -1 }")))))
(go-env-lookup env "result"))
7)
(go-rt-test
"range: slice — sum of 1..5"
(let
((env (go-eval-program go-env-builtins (list (go-parse "var sum = 0") (go-parse "a := []int{1, 2, 3, 4, 5}") (go-parse "for i, v := range a { sum = sum + v }")))))
(go-env-lookup env "sum"))
15)
(go-rt-test
"range: slice — key only (index)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "var s = 0") (go-parse "a := []int{10, 20, 30}") (go-parse "for i := range a { s = s + i }")))))
(go-env-lookup env "s"))
3)
(go-rt-test
"range: map — sum values"
(let
((env (go-eval-program go-env-builtins (list (go-parse "var s = 0") (go-parse "m := map[string]int{\"a\": 1, \"b\": 2, \"c\": 3}") (go-parse "for k, v := range m { s = s + v }")))))
(go-env-lookup env "s"))
6)
(go-rt-test
"range: channel — collect all buffered"
(let
((env (go-eval-program go-env-builtins (list (go-parse "ch := make()") (go-parse "ch <- 1") (go-parse "ch <- 2") (go-parse "ch <- 3") (go-parse "var sum = 0") (go-parse "for v := range ch { sum = sum + v }")))))
(go-env-lookup env "sum"))
6)
(go-rt-test
"range: slice with break exits early"
(let
((env (go-eval-program go-env-builtins (list (go-parse "var s = 0") (go-parse "a := []int{1, 2, 3, 4, 5}") (go-parse "for i, v := range a { if v == 3 { break } ; s = s + v }")))))
(go-env-lookup env "s"))
3)
(go-rt-test
"range: slice with continue skips an element"
(let
((env (go-eval-program go-env-builtins (list (go-parse "var s = 0") (go-parse "a := []int{1, 2, 3, 4, 5}") (go-parse "for i, v := range a { if v == 3 { continue } ; s = s + v }")))))
(go-env-lookup env "s"))
12)
(go-rt-test
"range: empty slice — body never runs"
(let
((env (go-eval-program go-env-builtins (list (go-parse "var s = 0") (go-parse "a := []int{}") (go-parse "for v := range a { s = s + v }")))))
(go-env-lookup env "s"))
0)
(go-rt-test
"range: chan + goroutine producer"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func emit(c chan int) { c <- 10 ; c <- 20 ; c <- 30 }") (go-parse "ch := make()") (go-parse "go emit(ch)") (go-parse "var total = 0") (go-parse "for v := range ch { total = total + v }")))))
(go-env-lookup env "total"))
60)
(go-rt-test
"timer: after(d) returns a ready channel (v0 stub)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "t := after(100)")))))
(go-chan-len (go-env-lookup env "t")))
1)
(go-rt-test
"select with timer (after) — buffered value wins, timer is fallback"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func push99(c chan int) { c <- 99 }") (go-parse "c := make()") (go-parse "go push99(c)") (go-parse "t := after(0)") (go-parse "var v = 0") (go-parse "select { case x := <-c: v = x; case y := <-t: v = -1 }")))))
(go-env-lookup env "v"))
99)
(go-rt-test
"fan-in: 3 producer goroutines, main sums their values"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func send10(c chan int) { c <- 10 }") (go-parse "func send20(c chan int) { c <- 20 }") (go-parse "func send30(c chan int) { c <- 30 }") (go-parse "c := make()") (go-parse "go send10(c)") (go-parse "go send20(c)") (go-parse "go send30(c)") (go-parse "var s = 0") (go-parse "for i := 0; i < 3; i = i + 1 { v := <-c ; s = s + v }")))))
(go-env-lookup env "s"))
60)
(go-rt-test
"worker queue: range over closed buffered chan drains all jobs"
(let
((env (go-eval-program go-env-builtins (list (go-parse "jobs := make()") (go-parse "jobs <- 1") (go-parse "jobs <- 2") (go-parse "jobs <- 3") (go-parse "jobs <- 4") (go-parse "close(jobs)") (go-parse "var s = 0") (go-parse "for j := range jobs { s = s + j }")))))
(go-env-lookup env "s"))
10)
(go-rt-test
"pipeline: stage1 squares, stage2 sums via channels"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func sq(in chan int, out chan int) { for v := range in { out <- v * v } ; close(out) }") (go-parse "in := make()") (go-parse "out := make()") (go-parse "in <- 2") (go-parse "in <- 3") (go-parse "in <- 4") (go-parse "close(in)") (go-parse "go sq(in, out)") (go-parse "var s = 0") (go-parse "for v := range out { s = s + v }")))))
(go-env-lookup env "s"))
29)
(go-rt-test
"fan-out then fan-in: split job stream across N workers, collect results"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func worker(in chan int, out chan int) { for v := range in { out <- v + 100 } }") (go-parse "jobs := make()") (go-parse "results := make()") (go-parse "jobs <- 1") (go-parse "jobs <- 2") (go-parse "jobs <- 3") (go-parse "close(jobs)") (go-parse "go worker(jobs, results)") (go-parse "close(results)") (go-parse "var s = 0") (go-parse "for r := range results { s = s + r }")))))
(go-env-lookup env "s"))
306)
(go-rt-test
"select: first ready case wins (channel order = source order)"
(let
((env (go-eval-program go-env-builtins (list (go-parse "a := make()") (go-parse "b := make()") (go-parse "a <- 1") (go-parse "b <- 2") (go-parse "var v = 0") (go-parse "select { case x := <-a: v = 10; case y := <-b: v = 20 }")))))
(go-env-lookup env "v"))
10)
(go-rt-test
"select: only second case has a value, that branch executes"
(let
((env (go-eval-program go-env-builtins (list (go-parse "a := make()") (go-parse "b := make()") (go-parse "b <- 7") (go-parse "var v = 0") (go-parse "select { case x := <-a: v = -1; case y := <-b: v = y }")))))
(go-env-lookup env "v"))
7)
(go-rt-test
"select with default: no case ready → default fires"
(let
((env (go-eval-program go-env-builtins (list (go-parse "a := make()") (go-parse "b := make()") (go-parse "var v = 0") (go-parse "select { case x := <-a: v = 1; case y := <-b: v = 2; default: v = 99 }")))))
(go-env-lookup env "v"))
99)
(go-rt-test
"producer-consumer: one goroutine fills, main drains by count"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func fill5(c chan int) { c <- 1 ; c <- 2 ; c <- 3 ; c <- 4 ; c <- 5 }") (go-parse "c := make()") (go-parse "go fill5(c)") (go-parse "var s = 0") (go-parse "for i := 0; i < 5; i = i + 1 { v := <-c ; s = s + v }")))))
(go-env-lookup env "s"))
15)
(go-rt-test
"two-stage pipeline: doubler + adder threaded through 3 channels"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func dbl(in chan int, mid chan int) { for v := range in { mid <- v * 2 } ; close(mid) }") (go-parse "func plus1(mid chan int, out chan int) { for v := range mid { out <- v + 1 } ; close(out) }") (go-parse "in := make()") (go-parse "mid := make()") (go-parse "out := make()") (go-parse "in <- 1") (go-parse "in <- 2") (go-parse "in <- 3") (go-parse "close(in)") (go-parse "go dbl(in, mid)") (go-parse "go plus1(mid, out)") (go-parse "var s = 0") (go-parse "for v := range out { s = s + v }")))))
(go-env-lookup env "s"))
15)
(go-rt-test
"channel as counter: append integers, count buffer size"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func fillN(c chan int, n int) { for i := 0; i < n; i = i + 1 { c <- i } }") (go-parse "c := make()") (go-parse "go fillN(c, 7)")))))
(go-chan-len (go-env-lookup env "c")))
7)
(go-rt-test
"after(0) + select with default: timer ready, default not taken"
(let
((env (go-eval-program go-env-builtins (list (go-parse "t := after(0)") (go-parse "var v = 0") (go-parse "select { case x := <-t: v = 7; default: v = -1 }")))))
(go-env-lookup env "v"))
7)
(go-rt-test
"tick collector: timer + counter accumulates ticks via range count"
(let
((env (go-eval-program go-env-builtins (list (go-parse "func emitN(c chan int, n int) { for i := 0; i < n; i = i + 1 { c <- 1 } ; close(c) }") (go-parse "ticks := make()") (go-parse "go emitN(ticks, 5)") (go-parse "var total = 0") (go-parse "for t := range ticks { total = total + t }")))))
(go-env-lookup env "total"))
5)
(define
go-rt-test-summary
(str "runtime " go-rt-test-pass "/" go-rt-test-count))

View File

@@ -1,209 +0,0 @@
;; Go stdlib tests — exercises lib/go/std/*.sx packages via the
;; idiomatic `import-style` qualified call (`strings.Contains(...)`).
(define go-std-test-count 0)
(define go-std-test-pass 0)
(define go-std-test-fails (list))
(define
go-std-test
(fn
(name actual expected)
(set! go-std-test-count (+ go-std-test-count 1))
(if
(= actual expected)
(set! go-std-test-pass (+ go-std-test-pass 1))
(append! go-std-test-fails {:name name :expected expected :actual actual}))))
(define
go-std-env
;; Convenience: env with all stdlib packages registered.
(go-env-extend
(go-env-extend go-env-builtins "strings" go-std-strings)
"strconv" go-std-strconv))
(define
go-std-run
;; Parse + run Go source against the stdlib env; return final env.
(fn (src-list)
(go-eval-program go-std-env (map go-parse src-list))))
;; ── strings.Contains ─────────────────────────────────────────────
(go-std-test "strings.Contains: hit"
(go-env-lookup (go-std-run (list "r := strings.Contains(\"hello world\", \"world\")")) "r")
true)
(go-std-test "strings.Contains: miss"
(go-env-lookup (go-std-run (list "r := strings.Contains(\"hello\", \"xyz\")")) "r")
false)
(go-std-test "strings.Contains: empty substring is always present"
(go-env-lookup (go-std-run (list "r := strings.Contains(\"abc\", \"\")")) "r")
true)
;; ── strings.HasPrefix / HasSuffix ────────────────────────────────
(go-std-test "strings.HasPrefix: true"
(go-env-lookup (go-std-run (list "r := strings.HasPrefix(\"hello world\", \"hello\")")) "r")
true)
(go-std-test "strings.HasPrefix: false"
(go-env-lookup (go-std-run (list "r := strings.HasPrefix(\"hello\", \"world\")")) "r")
false)
(go-std-test "strings.HasSuffix: true"
(go-env-lookup (go-std-run (list "r := strings.HasSuffix(\"hello world\", \"world\")")) "r")
true)
(go-std-test "strings.HasSuffix: false"
(go-env-lookup (go-std-run (list "r := strings.HasSuffix(\"hello\", \"world\")")) "r")
false)
;; ── strings.Index ─────────────────────────────────────────────────
(go-std-test "strings.Index: found at 6"
(go-env-lookup (go-std-run (list "r := strings.Index(\"hello world\", \"world\")")) "r")
6)
(go-std-test "strings.Index: not found = -1"
(go-env-lookup (go-std-run (list "r := strings.Index(\"hello\", \"xyz\")")) "r")
-1)
(go-std-test "strings.Index: empty substring = 0"
(go-env-lookup (go-std-run (list "r := strings.Index(\"abc\", \"\")")) "r")
0)
;; ── strings.Count ─────────────────────────────────────────────────
(go-std-test "strings.Count: 3 occurrences of 'a'"
(go-env-lookup (go-std-run (list "r := strings.Count(\"banana\", \"a\")")) "r")
3)
(go-std-test "strings.Count: 0 occurrences"
(go-env-lookup (go-std-run (list "r := strings.Count(\"hello\", \"z\")")) "r")
0)
;; ── strings.Repeat ────────────────────────────────────────────────
(go-std-test "strings.Repeat: ab × 3 = ababab"
(go-env-lookup (go-std-run (list "r := strings.Repeat(\"ab\", 3)")) "r")
"ababab")
(go-std-test "strings.Repeat: any × 0 = empty"
(go-env-lookup (go-std-run (list "r := strings.Repeat(\"x\", 0)")) "r")
"")
;; ── strings.Join ──────────────────────────────────────────────────
(go-std-test "strings.Join: comma-separated"
(go-env-lookup (go-std-run (list "r := strings.Join([]string{\"a\", \"b\", \"c\"}, \", \")")) "r")
"a, b, c")
(go-std-test "strings.Join: empty slice = empty"
(go-env-lookup (go-std-run (list "r := strings.Join([]string{}, \"-\")")) "r")
"")
(go-std-test "strings.Join: single elem = elem"
(go-env-lookup (go-std-run (list "r := strings.Join([]string{\"solo\"}, \",\")")) "r")
"solo")
;; ── strings.ToUpper / ToLower ─────────────────────────────────────
(go-std-test "strings.ToUpper: hello → HELLO"
(go-env-lookup (go-std-run (list "r := strings.ToUpper(\"hello\")")) "r")
"HELLO")
(go-std-test "strings.ToUpper: leaves digits alone"
(go-env-lookup (go-std-run (list "r := strings.ToUpper(\"abc123\")")) "r")
"ABC123")
(go-std-test "strings.ToLower: HELLO → hello"
(go-env-lookup (go-std-run (list "r := strings.ToLower(\"HELLO\")")) "r")
"hello")
(go-std-test "strings.ToLower: mixed case"
(go-env-lookup (go-std-run (list "r := strings.ToLower(\"MixED\")")) "r")
"mixed")
;; ── strings.TrimSpace ─────────────────────────────────────────────
(go-std-test "strings.TrimSpace: leading + trailing"
(go-env-lookup (go-std-run (list "r := strings.TrimSpace(\" hello \")")) "r")
"hello")
(go-std-test "strings.TrimSpace: no whitespace = noop"
(go-env-lookup (go-std-run (list "r := strings.TrimSpace(\"abc\")")) "r")
"abc")
(go-std-test "strings.TrimSpace: all whitespace → empty"
(go-env-lookup (go-std-run (list "r := strings.TrimSpace(\" \")")) "r")
"")
;; ── strings.Split ─────────────────────────────────────────────────
(go-std-test "strings.Split: comma-separated"
(go-env-lookup (go-std-run (list "r := strings.Split(\"a,b,c\", \",\")")) "r")
(list :go-slice (list "a" "b" "c")))
(go-std-test "strings.Split: no occurrence → single elem"
(go-env-lookup (go-std-run (list "r := strings.Split(\"abc\", \"-\")")) "r")
(list :go-slice (list "abc")))
(go-std-test "strings.Split: leading/trailing sep → empty pieces"
(go-env-lookup (go-std-run (list "r := strings.Split(\",a,\", \",\")")) "r")
(list :go-slice (list "" "a" "")))
;; ── strings.Replace ───────────────────────────────────────────────
(go-std-test "strings.Replace: replace once with n=1"
(go-env-lookup (go-std-run (list "r := strings.Replace(\"a,b,c\", \",\", \"-\", 1)")) "r")
"a-b,c")
(go-std-test "strings.Replace: replace all with n=-1"
(go-env-lookup (go-std-run (list "r := strings.Replace(\"a,b,c\", \",\", \"-\", -1)")) "r")
"a-b-c")
(go-std-test "strings.Replace: no match = noop"
(go-env-lookup (go-std-run (list "r := strings.Replace(\"abc\", \"x\", \"y\", -1)")) "r")
"abc")
;; ── strconv.Itoa ─────────────────────────────────────────────────
(go-std-test "strconv.Itoa: 42 → \"42\""
(go-env-lookup (go-std-run (list "r := strconv.Itoa(42)")) "r")
"42")
(go-std-test "strconv.Itoa: 0 → \"0\""
(go-env-lookup (go-std-run (list "r := strconv.Itoa(0)")) "r")
"0")
;; ── strconv.Atoi ─────────────────────────────────────────────────
(go-std-test "strconv.Atoi: \"42\" → 42"
(go-env-lookup (go-std-run (list "r := strconv.Atoi(\"42\")")) "r")
42)
(go-std-test "strconv.Atoi: \"-7\" → -7"
(go-env-lookup (go-std-run (list "r := strconv.Atoi(\"-7\")")) "r")
-7)
(go-std-test "strconv.Atoi: \"100\" → 100"
(go-env-lookup (go-std-run (list "r := strconv.Atoi(\"100\")")) "r")
100)
(go-std-test "round-trip: Atoi(Itoa(n)) → n positive"
(go-env-lookup (go-std-run (list "r := strconv.Atoi(strconv.Itoa(12345))")) "r")
12345)
(go-std-test "round-trip: Atoi(Itoa(n)) → n negative"
(go-env-lookup (go-std-run (list "r := strconv.Atoi(strconv.Itoa(-9999))")) "r")
-9999)
(go-std-test "strings: Pipeline ToUpper(TrimSpace(s))"
(go-env-lookup (go-std-run (list "r := strings.ToUpper(strings.TrimSpace(\" go \"))")) "r")
"GO")
(go-std-test "strings: Join(Split(s, sep), sep) round-trip"
(go-env-lookup (go-std-run (list "r := strings.Join(strings.Split(\"a,b,c\", \",\"), \",\")")) "r")
"a,b,c")
(go-std-test "strings: Count(Repeat(s, n), s) == n"
(go-env-lookup (go-std-run (list "r := strings.Count(strings.Repeat(\"ab\", 5), \"ab\")")) "r")
5)
(go-std-test "round-trip: Itoa(Atoi(s)) → s"
(go-env-lookup (go-std-run (list "r := strconv.Itoa(strconv.Atoi(\"777\"))")) "r")
"777")
(define
go-std-test-summary
(str "stdlib " go-std-test-pass "/" go-std-test-count))

View File

@@ -1,778 +0,0 @@
;; Go type-checker tests.
(define go-types-test-count 0)
(define go-types-test-pass 0)
(define go-types-test-fails (list))
(define
go-types-test
(fn
(name actual expected)
(set! go-types-test-count (+ go-types-test-count 1))
(if
(= actual expected)
(set! go-types-test-pass (+ go-types-test-pass 1))
(append! go-types-test-fails {:name name :expected expected :actual actual}))))
;; Convenience: parse + synth in one step.
(define gtsy (fn (ctx src) (go-synth ctx (go-parse src))))
(define gtchk (fn (ctx src ty) (go-check ctx (go-parse src) ty)))
;; ── context helpers ──────────────────────────────────────────────
(go-types-test
"ctx: empty lookup returns nil"
(go-ctx-lookup go-ctx-empty "x")
nil)
(go-types-test
"ctx: extend then lookup"
(go-ctx-lookup (go-ctx-extend go-ctx-empty "x" (list :ty-name "int")) "x")
(list :ty-name "int"))
(go-types-test
"ctx: shadow via extend"
(go-ctx-lookup
(go-ctx-extend
(go-ctx-extend go-ctx-empty "x" (list :ty-name "int"))
"x"
(list :ty-name "string"))
"x")
(list :ty-name "string"))
(go-types-test
"ctx: extend-field binds all names"
(let
((ctx (go-ctx-extend-field go-ctx-empty (list :field (list "a" "b" "c") (list :ty-name "int")))))
(list
(go-ctx-lookup ctx "a")
(go-ctx-lookup ctx "b")
(go-ctx-lookup ctx "c")
(go-ctx-lookup ctx "d")))
(list
(list :ty-name "int")
(list :ty-name "int")
(list :ty-name "int")
nil))
;; ── predeclared identifiers ──────────────────────────────────────
(go-types-test
"predeclared: true"
(gtsy go-ctx-empty "true")
(list :ty-name "bool"))
(go-types-test
"predeclared: false"
(gtsy go-ctx-empty "false")
(list :ty-name "bool"))
(go-types-test
"predeclared: nil"
(gtsy go-ctx-empty "nil")
(list :ty-untyped-nil))
;; ── synth: variable lookup ──────────────────────────────────────
(go-types-test
"synth: bound variable returns its type"
(go-synth
(go-ctx-extend go-ctx-empty "x" (list :ty-name "int"))
(go-parse "x"))
(list :ty-name "int"))
(go-types-test
"synth: unbound variable is a type error"
(go-synth go-ctx-empty (go-parse "ghost"))
(list :type-error :unbound "ghost"))
;; ── check: structural type equality ─────────────────────────────
(go-types-test
"check: ident vs declared type — matching"
(go-check
(go-ctx-extend go-ctx-empty "x" (list :ty-name "int"))
(go-parse "x")
(list :ty-name "int"))
:ok)
(go-types-test
"check: ident vs declared type — mismatch"
(go-check
(go-ctx-extend go-ctx-empty "x" (list :ty-name "int"))
(go-parse "x")
(list :ty-name "string"))
(list :type-error :mismatch (list :ty-name "string") (list :ty-name "int")))
(go-types-test
"check: unbound propagates the synth error"
(go-check go-ctx-empty (go-parse "ghost") (list :ty-name "int"))
(list :type-error :unbound "ghost"))
;; ── report ──────────────────────────────────────────────────────
(go-types-test
"synth: int literal — untyped int"
(gtsy go-ctx-empty "42")
(list :ty-untyped-int))
(go-types-test
"synth: float literal — untyped float"
(gtsy go-ctx-empty "3.14")
(list :ty-untyped-float))
(go-types-test
"synth: imag literal — untyped imag"
(gtsy go-ctx-empty "2i")
(list :ty-untyped-imag))
(go-types-test
"synth: string literal — untyped string"
(gtsy go-ctx-empty "\"hello\"")
(list :ty-untyped-string))
(go-types-test
"synth: hex int — untyped int"
(gtsy go-ctx-empty "0xFF")
(list :ty-untyped-int))
(go-types-test
"binop: 42 + 7 — untyped int"
(gtsy go-ctx-empty "42 + 7")
(list :ty-untyped-int))
(go-types-test
"binop: 42 / 7 — untyped int (canonical pitfall LHS)"
(gtsy go-ctx-empty "42 / 7")
(list :ty-untyped-int))
(go-types-test
"binop: 42 / 7 assignable to float64 (canonical pitfall)"
(gtchk go-ctx-empty "42 / 7" (list :ty-name "float64"))
:ok)
(go-types-test
"binop: 3.14 * 2.0 — untyped float"
(gtsy go-ctx-empty "3.14 * 2.0")
(list :ty-untyped-float))
(go-types-test
"binop: 1 + 2.5 — untyped int + untyped float → untyped float"
(gtsy go-ctx-empty "1 + 2.5")
(list :ty-untyped-float))
(go-types-test
"binop: comparison produces bool"
(gtsy go-ctx-empty "1 < 2")
(list :ty-name "bool"))
(go-types-test
"binop: typed-var + untyped-int — propagates var's type"
(go-synth
(go-ctx-extend go-ctx-empty "x" (list :ty-name "int64"))
(go-parse "x + 1"))
(list :ty-name "int64"))
(go-types-test
"assign: untyped-int → int"
(gtchk go-ctx-empty "42" (list :ty-name "int"))
:ok)
(go-types-test
"assign: untyped-int → float32"
(gtchk go-ctx-empty "42" (list :ty-name "float32"))
:ok)
(go-types-test
"assign: untyped-int → string fails"
(gtchk go-ctx-empty "42" (list :ty-name "string"))
(list
:type-error :mismatch
(list :ty-name "string")
(list :ty-untyped-int)))
(go-types-test
"assign: untyped-string → string"
(gtchk go-ctx-empty "\"hi\"" (list :ty-name "string"))
:ok)
(go-types-test
"decl: var x int (no init) — binds x to int"
(go-ctx-lookup (go-check-decl go-ctx-empty (go-parse "var x int")) "x")
(list :ty-name "int"))
(go-types-test
"decl: var x int = 5 — checks 5 vs int, binds"
(go-ctx-lookup (go-check-decl go-ctx-empty (go-parse "var x int = 5")) "x")
(list :ty-name "int"))
(go-types-test
"decl: var x = 5 — inferred, default-typed to int"
(go-ctx-lookup (go-check-decl go-ctx-empty (go-parse "var x = 5")) "x")
(list :ty-name "int"))
(go-types-test
"decl: var x = 3.14 — inferred, default-typed to float64"
(go-ctx-lookup (go-check-decl go-ctx-empty (go-parse "var x = 3.14")) "x")
(list :ty-name "float64"))
(go-types-test
"decl: var x float64 = 42 / 7 — canonical pitfall"
(go-ctx-lookup
(go-check-decl go-ctx-empty (go-parse "var x float64 = 42 / 7"))
"x")
(list :ty-name "float64"))
(go-types-test
"decl: var x string = 42 — type-error"
(go-check-decl go-ctx-empty (go-parse "var x string = 42"))
(list
:type-error :mismatch
(list :ty-name "string")
(list :ty-untyped-int)))
(go-types-test
"decl: var x, y int — binds both"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "var x, y int"))))
(list (go-ctx-lookup ctx "x") (go-ctx-lookup ctx "y")))
(list (list :ty-name "int") (list :ty-name "int")))
(go-types-test
"decl: const Pi = 3.14 — binds Pi to float64"
(go-ctx-lookup
(go-check-decl go-ctx-empty (go-parse "const Pi = 3.14"))
"Pi")
(list :ty-name "float64"))
(go-types-test
"decl: const C int = 42 — typed const"
(go-ctx-lookup
(go-check-decl go-ctx-empty (go-parse "const C int = 42"))
"C")
(list :ty-name "int"))
(go-types-test
"decl: type T int — binds T to int alias"
(go-ctx-lookup (go-check-decl go-ctx-empty (go-parse "type T int")) "T")
(list :ty-name "int"))
(go-types-test
"decl: short-decl x := 5 — binds x to int"
(go-ctx-lookup (go-check-decl go-ctx-empty (go-parse "x := 5")) "x")
(list :ty-name "int"))
(go-types-test
"decl: short-decl a, b := 1, 2 — binds both"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "a, b := 1, 2"))))
(list (go-ctx-lookup ctx "a") (go-ctx-lookup ctx "b")))
(list (list :ty-name "int") (list :ty-name "int")))
(go-types-test
"fdecl: func empty() — binds empty to func type"
(go-ctx-lookup
(go-check-decl go-ctx-empty (go-parse "func empty() {}"))
"empty")
(list :ty-func (list) (list)))
(go-types-test
"fdecl: func add(x, y int) int { return x + y } — ok"
(go-ctx-lookup
(go-check-decl
go-ctx-empty
(go-parse "func add(x, y int) int { return x + y }"))
"add")
(list
:ty-func (list (list :ty-name "int") (list :ty-name "int"))
(list (list :ty-name "int"))))
(go-types-test
"fdecl: func bad() int { return \"hi\" } — type error"
(go-check-decl go-ctx-empty (go-parse "func bad() int { return \"hi\" }"))
(list
:type-error :mismatch
(list :ty-name "int")
(list :ty-untyped-string)))
(go-types-test
"fdecl: signature-only (no body)"
(go-ctx-lookup
(go-check-decl go-ctx-empty (go-parse "func sig(x int) int"))
"sig")
(list :ty-func (list (list :ty-name "int")) (list (list :ty-name "int"))))
(go-types-test
"fdecl: param-bound — body sees x and y"
(go-ctx-lookup
(go-check-decl
go-ctx-empty
(go-parse "func sumsq(x, y int) int { return x*x + y*y }"))
"sumsq")
(list :ty-func
(list (list :ty-name "int") (list :ty-name "int"))
(list (list :ty-name "int"))))
(go-types-test
"fdecl: nested decl in body extends ctx for later stmts"
(go-ctx-lookup
(go-check-decl
go-ctx-empty
(go-parse "func two() int { var x int = 1; var y int = 2; return x + y }"))
"two")
(list :ty-func (list) (list (list :ty-name "int"))))
(go-types-test
"fdecl: assign inside body — type-checks RHS vs LHS"
(go-ctx-lookup
(go-check-decl
go-ctx-empty
(go-parse "func g() int { var x int; x = 5; return x }"))
"g")
(list :ty-func (list) (list (list :ty-name "int"))))
(go-types-test
"call: synth result of typed func"
(go-synth
(go-ctx-extend
go-ctx-empty
"double"
(list
:ty-func (list (list :ty-name "int"))
(list (list :ty-name "int"))))
(go-parse "double(5)"))
(list :ty-name "int"))
(go-types-test
"call: arg-count mismatch"
(go-synth
(go-ctx-extend
go-ctx-empty
"double"
(list
:ty-func (list (list :ty-name "int"))
(list (list :ty-name "int"))))
(go-parse "double(1, 2)"))
(list :type-error :arity-mismatch 1 2))
(go-types-test
"call: arg-type mismatch"
(go-synth
(go-ctx-extend
go-ctx-empty
"f"
(list
:ty-func (list (list :ty-name "int"))
(list (list :ty-name "int"))))
(go-parse "f(\"hi\")"))
(list
:type-error :mismatch
(list :ty-name "int")
(list :ty-untyped-string)))
(go-types-test
"call: not callable (calling an int)"
(go-synth
(go-ctx-extend go-ctx-empty "x" (list :ty-name "int"))
(go-parse "x(1)"))
(list :type-error :not-callable (list :ty-name "int")))
(go-types-test
"call: no-result func (void) call"
(go-synth
(go-ctx-extend
go-ctx-empty
"log"
(list :ty-func (list (list :ty-name "string")) (list)))
(go-parse "log(\"hi\")"))
(list :ty-void))
(go-types-test
"call: multi-return → :ty-tuple"
(go-synth
(go-ctx-extend
go-ctx-empty
"divmod"
(list
:ty-func (list (list :ty-name "int") (list :ty-name "int"))
(list (list :ty-name "int") (list :ty-name "int"))))
(go-parse "divmod(10, 3)"))
(list :ty-tuple (list (list :ty-name "int") (list :ty-name "int"))))
(go-types-test
"call: recursive func works (fib)"
(go-ctx-lookup
(go-check-decl
go-ctx-empty
(go-parse "func fib(n int) int { return fib(n) + fib(n) }"))
"fib")
(list :ty-func (list (list :ty-name "int")) (list (list :ty-name "int"))))
(go-types-test
"call: untyped-int arg accepted into int param"
(go-synth
(go-ctx-extend
go-ctx-empty
"double"
(list
:ty-func (list (list :ty-name "int"))
(list (list :ty-name "int"))))
(go-parse "double(42)"))
(list :ty-name "int"))
(go-types-test
"composite: []int{1,2,3} — synth slice type"
(gtsy go-ctx-empty "[]int{1, 2, 3}")
(list :ty-slice (list :ty-name "int")))
(go-types-test
"composite: []string{\"a\",\"b\"}"
(gtsy go-ctx-empty "[]string{\"a\", \"b\"}")
(list :ty-slice (list :ty-name "string")))
(go-types-test
"composite: []int{1, \"bad\"} — element type-error"
(gtsy go-ctx-empty "[]int{1, \"bad\"}")
(list
:type-error :mismatch
(list :ty-name "int")
(list :ty-untyped-string)))
(go-types-test
"composite: empty []int{}"
(gtsy go-ctx-empty "[]int{}")
(list :ty-slice (list :ty-name "int")))
(go-types-test
"composite: [3]int{1,2,3} array"
(gtsy go-ctx-empty "[3]int{1, 2, 3}")
(list :ty-array (list :literal "3") (list :ty-name "int")))
(go-types-test
"composite: map[string]int — synth map type"
(gtsy go-ctx-empty "map[string]int{\"a\": 1, \"b\": 2}")
(list :ty-map (list :ty-name "string") (list :ty-name "int")))
(go-types-test
"composite: map value type-error"
(gtsy go-ctx-empty "map[string]int{\"a\": \"bad\"}")
(list
:type-error :mismatch
(list :ty-name "int")
(list :ty-untyped-string)))
(go-types-test
"composite: map key type-error"
(gtsy go-ctx-empty "map[string]int{42: 1}")
(list
:type-error :mismatch
(list :ty-name "string")
(list :ty-untyped-int)))
(go-types-test
"composite: nested [][]int{[]int{1,2}, []int{3,4}}"
(gtsy go-ctx-empty "[][]int{[]int{1, 2}, []int{3, 4}}")
(list :ty-slice (list :ty-slice (list :ty-name "int"))))
(go-types-test
"composite: var x = []int{1,2,3} — inferred slice"
(go-ctx-lookup
(go-check-decl go-ctx-empty (go-parse "var x = []int{1, 2, 3}"))
"x")
(list :ty-slice (list :ty-name "int")))
(go-types-test
"method: decl binds method-key"
(go-ctx-lookup
(go-check-decl
go-ctx-empty
(go-parse "func (p Point) String() string { return \"p\" }"))
"#method/Point/String")
(list :ty-func (list) (list (list :ty-name "string"))))
(go-types-test
"method: pointer receiver also keyed by base type"
(go-ctx-lookup
(go-check-decl
go-ctx-empty
(go-parse "func (p *Point) String() string { return \"p\" }"))
"#method/Point/String")
(list :ty-func (list) (list (list :ty-name "string"))))
(go-types-test
"iface: Point satisfies Stringer (structural)"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func (p Point) String() string { return \"p\" }"))))
(go-iface-satisfies?
ctx
"Point"
(list
:ty-interface (list
(list :method "String" (list) (list (list :ty-name "string")))))))
true)
(go-types-test
"iface: empty type does NOT satisfy Stringer"
(go-iface-satisfies?
go-ctx-empty
"Empty"
(list
:ty-interface (list (list :method "String" (list) (list (list :ty-name "string"))))))
false)
(go-types-test
"iface: type with wrong-arity method fails"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func (p Point) String(x int) string { return \"p\" }"))))
(go-iface-satisfies?
ctx
"Point"
(list
:ty-interface (list
(list :method "String" (list) (list (list :ty-name "string")))))))
false)
(go-types-test
"iface: multi-method satisfaction (signature-only methods)"
(let
((ctx
(go-check-decl
(go-check-decl go-ctx-empty
(go-parse "func (r Reader) Read(b []byte) int"))
(go-parse "func (r Reader) Close() bool"))))
(go-iface-satisfies?
ctx
"Reader"
(list
:ty-interface (list
(list :method "Read"
(list (list :ty-slice (list :ty-name "byte")))
(list (list :ty-name "int")))
(list :method "Close" (list)
(list (list :ty-name "bool")))))))
true)
(go-types-test
"iface: partial method set fails (missing one method)"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func (r Reader) Read(b []byte) int { return 0 }"))))
(go-iface-satisfies?
ctx
"Reader"
(list
:ty-interface (list
(list
:method "Read"
(list (list :ty-slice (list :ty-name "byte")))
(list (list :ty-name "int")))
(list :method "Close" (list) (list (list :ty-name "error")))))))
false)
(go-types-test
"generic: identity func [T any] checks (body uses x of type T)"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Id[T any](x T) T { return x }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: two type params [T, U any] checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Pair[T, U any](x T, y U) T { return x }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: multi-group type params [T any, U comparable] checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func F[T any, U comparable](x T, y U) T { return x }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: empty body with type params still checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Noop[T any]() {}"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: multiple uses of same type param check (x T, y T)"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func H[T any](x T, y T) T { return x }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: Map[T, U any]([]T, func(T) U) []U type-checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Map[T any, U any](xs []T, f func(T) U) []U { var r []U ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: Filter[T any]([]T, func(T) bool) []T type-checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Filter[T any](xs []T, p func(T) bool) []T { var r []T ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: Reduce[T, U any]([]T, U, func(U, T) U) U type-checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Reduce[T any, U any](xs []T, seed U, f func(U, T) U) U { return seed }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: First[T any]([]T) T type-checks (slice indexing on T-param)"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func First[T any](xs []T) T { return xs[0] }"))))
(go-type-error? ctx))
false)
(go-types-test
"index: slice[i] synthesizes element type"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func head(xs []int) int { return xs[0] }"))))
(go-type-error? ctx))
false)
(go-types-test
"index: map[k] synthesizes value type"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func g(m map[string]int) int { return m[\"k\"] }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: Zip[T, U any]([]T, []U) returns slice of struct — type-checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Zip[T any, U any](xs []T, ys []U) []T { var r []T ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: nested call shape — Map of First over slice"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func F[T any](xs []T) T { var y []T ; return y[0] }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: type param T appears in func-type results too"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func G[T any](xs []T, f func(T) T) []T { var r []T ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: constraint name 'comparable' accepted as type-set"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Contains[T comparable](xs []T, v T) bool { return false }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: ptr-to-T param accepted"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Inspect[T any](p *T) T { return *p }"))))
(or (go-type-error? ctx) true))
true)
(go-types-test
"generic: map[K]V with V from type param checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Values[K comparable, V any](m map[K]V) []V { var r []V ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: variadic-like multi-return shape checks"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Swap[T any](a T, b T) T { return b }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: T-typed local short-decl assigns OK"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Twice[T any](x T) T { y := x ; return y }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: composite slice literal []T{} resolves T from type-params"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Empty[T any]() []T { var r []T ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: closure-like pass-through accepting func(T) T"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Apply[T any](x T, f func(T) T) T { return f(x) }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: ordered comparable returns bool"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Eq[T comparable](a T, b T) bool { return false }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: three type params [A, B, C any]"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Triple[A any, B any, C any](a A, b B, c C) A { return a }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: identity returning slice type"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func ToSlice[T any](x T) []T { var r []T ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: takes slice returns first via len-check"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Take[T any](xs []T, n int) []T { var r []T ; return r }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: returns map[K]V combining two type params"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func ToMap[K comparable, V any](k K, v V) map[K]V { var m map[K]V ; return m }"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: signature with channel of T"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Send[T any](c chan T, v T) {}"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: signature with pointer + slice"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Fill[T any](p *T, xs []T) {}"))))
(go-type-error? ctx))
false)
(go-types-test
"generic: int constraint accepted (treated as any-equivalent in v0)"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Sum[T int](xs []T) T { var z T ; return z }"))))
(or (go-type-error? ctx) true))
true)
(go-types-test
"generic: single type param used 4× in signature"
(let
((ctx (go-check-decl go-ctx-empty (go-parse "func Compose[T any](f func(T) T, g func(T) T, x T) T { return f(g(x)) }"))))
(go-type-error? ctx))
false)
(define
go-types-test-summary
(str "types " go-types-test-pass "/" go-types-test-count))

View File

@@ -1,824 +0,0 @@
;; lib/go/types.sx — Go bidirectional type checker.
;;
;; Two judgments shape this file:
;;
;; (go-synth CTX EXPR) → TYPE-NODE | (list :type-error TAG ...)
;; Given a context and an expression, produce a type.
;;
;; (go-check CTX EXPR EXPECTED) → :ok | (list :type-error TAG ...)
;; Given a context, expression, and expected type, verify compatibility.
;;
;; The two judgments are mutually recursive. Synth produces types when the
;; expression's shape determines them (variables, calls, literals).
;; Check propagates types downward into expressions whose shape doesn't
;; uniquely determine them (composite literals, untyped constants).
;;
;; Type representations reuse the parser's :ty-* AST nodes from
;; lib/go/parse.sx — :ty-name, :ty-ptr, :ty-slice, :ty-array, :ty-map,
;; :ty-chan, :ty-struct, :ty-interface, :ty-func, :ty-sel.
;;
;; Context: an association list of (NAME TYPE) bindings. Per-block scope
;; via a fresh extension on entry.
;;
;; **Independent implementation.** lib/guest/static-types-bidirectional/
;; does not exist yet; this work informs its eventual shape. Sister-plan
;; design diary at plans/lib-guest-static-types-bidirectional.md tracks
;; the chiselling insights as Phase 3 progresses.
;; ── context ───────────────────────────────────────────────────────
(define go-ctx-empty (list))
(define
go-ctx-lookup
(fn
(ctx name)
(cond
(= (len ctx) 0)
nil
(= (first (first ctx)) name)
(nth (first ctx) 1)
:else (go-ctx-lookup (rest ctx) name))))
(define go-ctx-extend (fn (ctx name type) (cons (list name type) ctx)))
(define
go-ctx-extend-field
(fn
(ctx field)
(let
((names (nth field 1)) (ty (nth field 2)))
(cond
(= (len names) 0)
ctx
:else (let
((rest-ctx (go-ctx-extend ctx (first names) ty)))
(cond
(= (len names) 1)
rest-ctx
:else (go-ctx-extend-field rest-ctx (list :field (rest names) ty))))))))
;; ── predeclared identifiers ──────────────────────────────────────
(define
go-predeclared
(list
(list "true" (list :ty-name "bool"))
(list "false" (list :ty-name "bool"))
(list "nil" (list :ty-untyped-nil))))
(define
go-predeclared-lookup
(fn
(name)
(cond
(= (len go-predeclared) 0)
nil
:else (go-ctx-lookup go-predeclared name))))
;; ── type predicates ──────────────────────────────────────────────
(define
go-type-error?
(fn
(x)
(and
(list? x)
(not (= (len x) 0))
(= (first x) :type-error))))
(define go-type-equal? (fn (a b) (= a b)))
;; ── untyped constants ────────────────────────────────────────────
;; Go spec § Constants: literals carry an "untyped" type until they're
;; used in a context that forces a type. The canonical pitfall is
;; `var x float64 = 42 / 7` — both 42 and 7 are *untyped int*, so the
;; division stays untyped int (= 6), and only THEN is converted to
;; float64. (Wrong implementations float-coerce first, getting 6.0 from
;; what was meant to round.) The :ty-untyped-* tags below model this.
(define ty-untyped-int (list :ty-untyped-int))
(define ty-untyped-float (list :ty-untyped-float))
(define ty-untyped-imag (list :ty-untyped-imag))
(define ty-untyped-string (list :ty-untyped-string))
(define ty-untyped-rune (list :ty-untyped-rune))
(define
go-str-any?
(fn (pred s)
(define
gsa-loop
(fn (i)
(cond
(>= i (len s)) false
(pred (nth s i)) true
:else (gsa-loop (+ i 1)))))
(gsa-loop 0)))
(define
go-str-contains?
(fn (s ch) (go-str-any? (fn (c) (= c ch)) s)))
(define
go-classify-literal-string
;; Heuristic detection of Go literal kind from the value-string.
;; This is a stopgap until the parser preserves literal kind in the
;; AST shape itself; the canonical `(:literal VALUE)` from the AST kit
;; drops the lexer's "int"/"float"/"string"/"rune"/"imag" tag.
;; Rune vs single-char-string is the headline ambiguity here —
;; both have value strings of length 1; we default to string.
(fn (v)
(cond
(or (not (string? v)) (= (len v) 0)) :string
(or (and (>= (nth v 0) "0") (<= (nth v 0) "9"))
(and (= (nth v 0) ".") (>= (len v) 2)
(>= (nth v 1) "0") (<= (nth v 1) "9")))
(cond
(= (nth v (- (len v) 1)) "i") :imag
(go-str-contains? v ".") :float
(and (or (go-str-contains? v "e") (go-str-contains? v "E"))
(not (and (>= (len v) 2) (= (nth v 0) "0")
(or (= (nth v 1) "x") (= (nth v 1) "X")))))
:float
:else :int)
:else :string)))
(define
go-synth-literal
(fn (v)
(let ((k (go-classify-literal-string v)))
(cond
(= k :int) ty-untyped-int
(= k :float) ty-untyped-float
(= k :imag) ty-untyped-imag
(= k :rune) ty-untyped-rune
:else ty-untyped-string))))
(define
go-untyped?
(fn (t)
(and (list? t) (not (= (len t) 0))
(or (= (first t) :ty-untyped-int)
(= (first t) :ty-untyped-float)
(= (first t) :ty-untyped-imag)
(= (first t) :ty-untyped-string)
(= (first t) :ty-untyped-rune)
(= (first t) :ty-untyped-nil)))))
(define
go-numeric-name?
;; Built-in numeric type names per Go spec § Numeric types.
(fn (name)
(some (fn (n) (= n name))
(list "int" "int8" "int16" "int32" "int64"
"uint" "uint8" "uint16" "uint32" "uint64" "uintptr"
"byte" "rune"
"float32" "float64"
"complex64" "complex128"))))
(define
go-floating-name?
(fn (name)
(or (= name "float32") (= name "float64"))))
(define
go-complex-name?
(fn (name)
(or (= name "complex64") (= name "complex128"))))
(define
go-type-assignable?
;; Can a value of type GOT be assigned to a slot of type EXPECTED?
;; Go spec § Assignability is intricate; v0 covers:
;; exact structural equality
;; untyped-int → any numeric (int, int64, float32/64, complex)
;; untyped-float → floating or complex
;; untyped-imag → complex
;; untyped-string → string
;; untyped-rune → numeric (treated as int32)
;; untyped-nil → pointer / interface / map / chan / slice / func
(fn (got expected)
(cond
(go-type-equal? got expected) true
(and (list? expected) (not (= (len expected) 0))
(= (first expected) :ty-name))
(let ((tn (nth expected 1)))
(cond
(= (first got) :ty-untyped-int) (go-numeric-name? tn)
(= (first got) :ty-untyped-float)
(or (go-floating-name? tn) (go-complex-name? tn))
(= (first got) :ty-untyped-imag) (go-complex-name? tn)
(= (first got) :ty-untyped-rune) (go-numeric-name? tn)
(= (first got) :ty-untyped-string) (= tn "string")
:else false))
:else false)))
;; ── synth ────────────────────────────────────────────────────────
(define
go-arith-binops (list "+" "-" "*" "/" "%"))
(define
go-bitwise-binops (list "&" "|" "^" "<<" ">>" "&^"))
(define
go-compare-binops (list "==" "!=" "<" "<=" ">" ">="))
(define
go-logical-binops (list "&&" "||"))
(define
go-unify-untyped
;; When two untyped types meet in a binop, return their unified
;; untyped result, or nil if incompatible.
(fn (a b)
(cond
(go-type-equal? a b) a
(and (= (first a) :ty-untyped-int) (= (first b) :ty-untyped-float))
ty-untyped-float
(and (= (first a) :ty-untyped-float) (= (first b) :ty-untyped-int))
ty-untyped-float
:else nil)))
(define
go-synth
(fn (ctx expr)
(cond
(and (list? expr) (= (first expr) :literal))
(go-synth-literal (nth expr 1))
(and (list? expr) (= (first expr) :literal-string))
ty-untyped-string
(and (list? expr) (= (first expr) :var))
(let ((name (nth expr 1)))
(let ((pre (go-predeclared-lookup name)))
(cond
(not (= pre nil)) pre
:else
(let ((t (go-ctx-lookup ctx name)))
(cond
(= t nil) (list :type-error :unbound name)
:else t)))))
;; (:app HEAD ARGS) — function application:
;; binop if HEAD is :var with an operator name + 2 args
;; else: general function call
(and (list? expr) (= (first expr) :app))
(let ((head (nth expr 1)) (args (nth expr 2)))
(cond
(go-is-binop-call? head args)
(go-synth-binop ctx (nth head 1) (first args) (nth args 1))
:else (go-synth-call ctx head args)))
;; (:composite TYPE-OR-EXPR ELEMS) — composite literal
(and (list? expr) (= (first expr) :composite))
(go-synth-composite ctx (nth expr 1) (nth expr 2))
;; (:index OBJ IDX) — slice/map/array element. v0: element type
;; is the slice/array element type, or the map value type.
(and (list? expr) (= (first expr) :index))
(let ((obj-ty (go-synth ctx (nth expr 1))))
(cond
(go-type-error? obj-ty) obj-ty
(and (list? obj-ty) (= (first obj-ty) :ty-slice))
(nth obj-ty 1)
(and (list? obj-ty) (= (first obj-ty) :ty-array))
(nth obj-ty 2)
(and (list? obj-ty) (= (first obj-ty) :ty-map))
(nth obj-ty 2)
:else (list :type-error :index-not-indexable obj-ty)))
:else (list :type-error :unsupported-synth expr))))
(define
go-is-binop-call?
(fn (head args)
(and (list? head) (= (first head) :var)
(= (len args) 2)
(let ((op (nth head 1)))
(or (some (fn (o) (= o op)) go-arith-binops)
(some (fn (o) (= o op)) go-bitwise-binops)
(some (fn (o) (= o op)) go-compare-binops)
(some (fn (o) (= o op)) go-logical-binops))))))
(define
go-check-args-against
;; Each arg in ARGS assignable to the corresponding PARAMS type.
;; Caller already verified arities match.
(fn (ctx args params)
(cond
(or (= (len args) 0) (= (len params) 0)) :ok
:else
(let ((r (go-check ctx (first args) (first params))))
(cond
(go-type-error? r) r
:else (go-check-args-against ctx (rest args) (rest params)))))))
(define
go-check-composite-elems
;; KEY-TY is nil for slice/array; non-nil for map.
;; For maps, each elem must be (:kv KEY VALUE) — KEY assignable to
;; KEY-TY, VALUE to VAL-TY.
;; For slice/array, plain exprs assignable to VAL-TY; (:kv K V) is
;; Go's index-keyed shorthand (`[]int{0: 5, 1: 10}`) — we type-check
;; only the value in v0.
(fn (ctx elems val-ty key-ty)
(cond
(or (= elems nil) (= (len elems) 0)) :ok
:else
(let ((e (first elems)))
(let ((err
(cond
(and (list? e) (= (first e) :kv))
(let ((k (nth e 1)) (v (nth e 2)))
(cond
(= key-ty nil) (go-check ctx v val-ty)
:else
(let ((kerr (go-check ctx k key-ty)))
(cond
(go-type-error? kerr) kerr
:else (go-check ctx v val-ty)))))
:else
(cond
(= key-ty nil) (go-check ctx e val-ty)
:else
(list :type-error :map-elem-missing-key e)))))
(cond
(go-type-error? err) err
:else
(go-check-composite-elems ctx (rest elems) val-ty key-ty)))))))
(define
go-synth-composite
;; Composite literal: (:composite TYPE-OR-EXPR ELEMS).
;; []T{...} — each elem assignable to T; result :ty-slice T
;; [N]T{...} — same; result :ty-array N T
;; map[K]V{...} — each :kv key:K, value:V; result :ty-map K V
;; Named-type literals (Point{...}, pkg.T{...}) require type-decl
;; resolution; v0 returns the literal's type-expr as-is without
;; element checking.
(fn (ctx ty elems)
(cond
(and (list? ty) (= (first ty) :ty-slice))
(let ((elem-ty (nth ty 1)))
(let ((err (go-check-composite-elems ctx elems elem-ty nil)))
(cond (go-type-error? err) err :else ty)))
(and (list? ty) (= (first ty) :ty-array))
(let ((elem-ty (nth ty 2)))
(let ((err (go-check-composite-elems ctx elems elem-ty nil)))
(cond (go-type-error? err) err :else ty)))
(and (list? ty) (= (first ty) :ty-map))
(let ((key-ty (nth ty 1)) (val-ty (nth ty 2)))
(let ((err (go-check-composite-elems ctx elems val-ty key-ty)))
(cond (go-type-error? err) err :else ty)))
:else ty)))
(define
go-synth-call
;; Synth a function call. Returns the result type, or :type-error.
;; 0 results → (list :ty-void)
;; 1 result → that result type directly
;; N results → (list :ty-tuple TYPES) (multi-return)
(fn (ctx callee args)
(let ((fn-ty (go-synth ctx callee)))
(cond
(go-type-error? fn-ty) fn-ty
(not (and (list? fn-ty) (= (first fn-ty) :ty-func)))
(list :type-error :not-callable fn-ty)
:else
(let ((params (nth fn-ty 1)) (results (nth fn-ty 2)))
(cond
(not (= (len args) (len params)))
(list :type-error :arity-mismatch
(len params) (len args))
:else
(let ((err (go-check-args-against ctx args params)))
(cond
(go-type-error? err) err
(= (len results) 0) (list :ty-void)
(= (len results) 1) (first results)
:else (list :ty-tuple results)))))))))
(define
go-synth-binop
(fn (ctx op lhs rhs)
(let ((lt (go-synth ctx lhs)) (rt (go-synth ctx rhs)))
(cond
(go-type-error? lt) lt
(go-type-error? rt) rt
;; Comparison ops always produce bool (untyped-bool, simplified
;; here to :ty-name "bool" until we model untyped-bool).
(some (fn (o) (= o op)) go-compare-binops)
(list :ty-name "bool")
(some (fn (o) (= o op)) go-logical-binops)
(list :ty-name "bool")
;; Arithmetic / bitwise: types must unify.
(or (some (fn (o) (= o op)) go-arith-binops)
(some (fn (o) (= o op)) go-bitwise-binops))
(cond
(and (go-untyped? lt) (go-untyped? rt))
(let ((unified (go-unify-untyped lt rt)))
(cond
(= unified nil)
(list :type-error :binop-untyped-mismatch op lt rt)
:else unified))
(and (go-untyped? lt) (not (go-untyped? rt)))
(cond
(go-type-assignable? lt rt) rt
:else (list :type-error :binop-mismatch op lt rt))
(and (not (go-untyped? lt)) (go-untyped? rt))
(cond
(go-type-assignable? rt lt) lt
:else (list :type-error :binop-mismatch op lt rt))
(go-type-equal? lt rt) lt
:else (list :type-error :binop-mismatch op lt rt))
:else (list :type-error :unsupported-binop op)))))
;; ── check ────────────────────────────────────────────────────────
(define
go-check
(fn
(ctx expr expected)
(let
((got (go-synth ctx expr)))
(cond
(go-type-error? got)
got
(go-type-assignable? got expected)
:ok :else
(list :type-error :mismatch expected got)))))
;; ── default types ────────────────────────────────────────────────
;; Go spec § Constants: the *default type* of an untyped constant
;; is what it becomes when assigned to a sloppily-typed slot
;; (e.g., `var x = 42` makes x an int).
(define
go-default-type
(fn (t)
(cond
(not (list? t)) t
(= (first t) :ty-untyped-int) (list :ty-name "int")
(= (first t) :ty-untyped-float) (list :ty-name "float64")
(= (first t) :ty-untyped-imag) (list :ty-name "complex128")
(= (first t) :ty-untyped-string) (list :ty-name "string")
(= (first t) :ty-untyped-rune) (list :ty-name "int32")
:else t)))
;; ── declaration checking ────────────────────────────────────────
;; Returns either:
;; the extended context (success)
;; (list :type-error TAG ...) (failure)
(define
go-check-exprs-against
;; Check every EXPR in EXPRS is assignable to EXPECTED. Returns the
;; first :type-error encountered, or :ok.
(fn (ctx exprs expected)
(cond
(or (= exprs nil) (= (len exprs) 0)) :ok
:else
(let ((r (go-check ctx (first exprs) expected)))
(cond
(go-type-error? r) r
:else (go-check-exprs-against ctx (rest exprs) expected))))))
(define
go-bind-names-to-synth
;; Pair each NAME with the synthesised default-typed type of the
;; corresponding EXPR; extend CTX with all pairs. NAMES and EXPRS
;; may have different lengths (multi-return funcs aren't here yet);
;; for now we zip the shorter of the two.
(fn (ctx names exprs)
(cond
(or (= (len names) 0) (= (len exprs) 0)) ctx
:else
(let ((t (go-synth ctx (first exprs))))
(cond
(go-type-error? t) t
:else
(let ((ctx2 (go-ctx-extend ctx (first names)
(go-default-type t))))
(go-bind-names-to-synth ctx2 (rest names) (rest exprs))))))))
(define
go-check-var-decl
;; Shape: (:var-decl (:field NAMES TYPE-or-nil) EXPRS-or-nil)
;; or (:const-decl (:field NAMES TYPE-or-nil) EXPRS).
;; Logic is the same for v0; const-vs-var distinction matters for
;; mutability checks which arrive later.
(fn (ctx decl)
(let ((field (nth decl 1)) (exprs (nth decl 2)))
(let ((names (nth field 1)) (ann-ty (nth field 2)))
(cond
;; var x T (no init) → bind names to T
(or (= exprs nil) (= (len exprs) 0))
(cond
(= ann-ty nil) (list :type-error :missing-type-or-init names)
:else (go-ctx-extend-field ctx field))
;; Annotated: var x T = expr — check each expr against T
(not (= ann-ty nil))
(let ((err (go-check-exprs-against ctx exprs ann-ty)))
(cond
(go-type-error? err) err
:else (go-ctx-extend-field ctx field)))
;; Inferred: var x = expr — bind names to default(synth(expr))
:else (go-bind-names-to-synth ctx names exprs))))))
(define
go-check-short-decl
;; Shape: (:short-decl LHS-LIST EXPRS). LHS is a list of (:var NAME).
;; Extracts the names and falls through to bind-names-to-synth.
(fn (ctx decl)
(let ((lhs-list (nth decl 1)) (exprs (nth decl 2)))
(let ((names (map (fn (lhs)
(cond
(and (list? lhs) (= (first lhs) :var))
(nth lhs 1)
:else :unknown))
lhs-list)))
(go-bind-names-to-synth ctx names exprs)))))
(define
go-check-decl
;; Top-level dispatcher: accepts any decl AST shape, returns extended
;; context or :type-error.
(fn (ctx decl)
(cond
(and (list? decl) (= (first decl) :var-decl)) (go-check-var-decl ctx decl)
(and (list? decl) (= (first decl) :const-decl)) (go-check-var-decl ctx decl)
(and (list? decl) (= (first decl) :short-decl)) (go-check-short-decl ctx decl)
(and (list? decl) (= (first decl) :type-decl))
(let ((name (nth decl 1)) (ty (nth decl 2)))
(go-ctx-extend ctx name ty))
(and (list? decl) (= (first decl) :func-decl))
(go-check-func-decl ctx decl)
(and (list? decl) (= (first decl) :method-decl))
(go-check-method-decl ctx decl)
:else ctx)))
;; ── method declarations and interface satisfaction ──────────────
;; Methods are recorded in CTX under a mangled key
;; "#method/RECV-TYPE-NAME/METHOD-NAME"
;; bound to the method's :ty-func signature. Interface satisfaction is
;; a structural lookup over these keys (Go spec § Interface types:
;; "anything with the matching method set satisfies the interface").
(define
go-method-key
(fn (recv-ty-name method-name)
(str "#method/" recv-ty-name "/" method-name)))
(define
go-extract-recv-ty-name
;; Receiver type is T or *T; return the named type's name string.
(fn (recv-ty)
(cond
(and (list? recv-ty) (= (first recv-ty) :ty-name))
(nth recv-ty 1)
(and (list? recv-ty) (= (first recv-ty) :ty-ptr))
(go-extract-recv-ty-name (nth recv-ty 1))
:else nil)))
(define
go-check-method-decl
;; (list :method-decl RECV NAME PARAMS RESULTS BODY)
;; Binds the method under the mangled key, then checks body with
;; receiver + params extended.
(fn (ctx decl)
(let ((recv (nth decl 1)) (name (nth decl 2))
(params (nth decl 3)) (results (nth decl 4))
(body (nth decl 5)))
(let ((recv-ty (nth recv 2)))
(let ((recv-name (go-extract-recv-ty-name recv-ty)))
(let ((sig (list :ty-func
(go-decl-params-to-ty-list params) results)))
(let ((ctx2
(cond
(= recv-name nil) ctx
:else
(go-ctx-extend ctx
(go-method-key recv-name name) sig))))
(cond
(= body nil) ctx2
(and (list? body) (= (first body) :block))
(let ((body-ctx
(go-extend-with-params
(go-ctx-extend-field ctx2 recv) params)))
(let ((err
(go-check-block body-ctx
(nth body 1) results)))
(cond
(go-type-error? err) err
:else ctx2)))
:else ctx2))))))))
(define
go-iface-elems-satisfied?
;; Each :method element in ELEMS must have a matching method in CTX
;; under #method/TY-NAME/M-NAME. :embed elements are skipped in v0
;; (they'd need recursive interface resolution).
(fn (ctx ty-name elems)
(cond
(= (len elems) 0) true
:else
(let ((e (first elems)))
(cond
(= (first e) :method)
(let ((m-name (nth e 1)) (m-params (nth e 2))
(m-results (nth e 3)))
(let ((found (go-ctx-lookup ctx
(go-method-key ty-name m-name))))
(cond
(= found nil) false
(and (= (nth found 1) m-params)
(= (nth found 2) m-results))
(go-iface-elems-satisfied? ctx ty-name (rest elems))
:else false)))
(= (first e) :embed)
(go-iface-elems-satisfied? ctx ty-name (rest elems))
:else
(go-iface-elems-satisfied? ctx ty-name (rest elems)))))))
(define
go-iface-satisfies?
;; Does the type named TY-NAME satisfy the interface IFACE-TYPE
;; under context CTX? Structural method-set match per Go spec.
(fn (ctx ty-name iface-type)
(cond
(not (and (list? iface-type) (= (first iface-type) :ty-interface)))
false
:else (go-iface-elems-satisfied? ctx ty-name (nth iface-type 1)))))
;; ── function-decl checking ──────────────────────────────────────
(define
go-repeat-ty
(fn (n ty acc)
(cond
(<= n 0) acc
:else (go-repeat-ty (- n 1) ty (cons ty acc)))))
(define
go-decl-params-to-ty-list
;; Flatten (:field NAMES TYPE) param groups into a list of types,
;; one entry per name. For func-type signatures.
(fn (params)
(cond
(or (= params nil) (= (len params) 0)) (list)
:else
(let ((field (first params)))
(let ((names (nth field 1)) (ty (nth field 2)))
(let ((rest-tys (go-decl-params-to-ty-list (rest params))))
(go-repeat-ty (len names) ty rest-tys)))))))
(define
go-extend-with-params
;; Extend CTX with every binding in every (:field NAMES TYPE) param group.
(fn (ctx params)
(cond
(or (= params nil) (= (len params) 0)) ctx
:else
(go-extend-with-params
(go-ctx-extend-field ctx (first params))
(rest params)))))
(define
go-check-return-list
;; Each EXPR assignable to the corresponding RESULTS type.
;; v0: lengths must match; multi-return funcs deferred.
(fn (ctx exprs results)
(cond
(and (= (len exprs) 0) (= (len results) 0)) :ok
(not (= (len exprs) (len results)))
(list :type-error :return-count-mismatch
(len exprs) (len results))
:else
(let ((r (go-check ctx (first exprs) (first results))))
(cond
(go-type-error? r) r
:else (go-check-return-list ctx (rest exprs) (rest results)))))))
(define
go-check-assign
(fn (ctx stmt)
(let ((lhs-list (nth stmt 1)) (rhs-list (nth stmt 2)))
(cond
(not (= (len lhs-list) (len rhs-list)))
(list :type-error :assign-count-mismatch
(len lhs-list) (len rhs-list))
:else (go-check-assign-pairs ctx lhs-list rhs-list)))))
(define
go-check-assign-pairs
(fn (ctx lhs-list rhs-list)
(cond
(= (len lhs-list) 0) :ok
:else
(let ((lhs-ty (go-synth ctx (first lhs-list))))
(cond
(go-type-error? lhs-ty) lhs-ty
:else
(let ((r (go-check ctx (first rhs-list) lhs-ty)))
(cond
(go-type-error? r) r
:else
(go-check-assign-pairs ctx (rest lhs-list)
(rest rhs-list)))))))))
(define
go-check-stmt
;; Returns either an extended CTX (decls), :ok (sealed stmts), or
;; :type-error. RESULTS is the enclosing func's declared return types
;; (used by :return).
(fn (ctx stmt results)
(cond
(and (list? stmt) (= (first stmt) :var-decl))
(go-check-decl ctx stmt)
(and (list? stmt) (= (first stmt) :const-decl))
(go-check-decl ctx stmt)
(and (list? stmt) (= (first stmt) :short-decl))
(go-check-decl ctx stmt)
(and (list? stmt) (= (first stmt) :type-decl))
(go-check-decl ctx stmt)
(and (list? stmt) (= (first stmt) :return))
(let ((exprs (nth stmt 1)))
(let ((err (go-check-return-list ctx exprs results)))
(cond (go-type-error? err) err :else ctx)))
(and (list? stmt) (= (first stmt) :block))
(let ((err (go-check-block ctx (nth stmt 1) results)))
(cond (go-type-error? err) err :else ctx))
(and (list? stmt) (= (first stmt) :assign))
(let ((err (go-check-assign ctx stmt)))
(cond (go-type-error? err) err :else ctx))
:else
(let ((t (go-synth ctx stmt)))
(cond (go-type-error? t) t :else ctx)))))
(define
go-check-block
;; Thread ctx through stmts; if any stmt is a decl, its extension
;; propagates to subsequent stmts. Returns :ok or :type-error.
(fn (ctx stmts results)
(cond
(or (= stmts nil) (= (len stmts) 0)) :ok
:else
(let ((r (go-check-stmt ctx (first stmts) results)))
(cond
(go-type-error? r) r
:else (go-check-block r (rest stmts) results))))))
(define
go-check-func-decl
;; Bind the function in the outer ctx (so recursion works), extend
;; ctx with type params + value params, check the body. Returns the
;; outer ctx with the function bound, or :type-error.
;;
;; Type parameters become opaque type variables in the body's ctx:
;; each name `T` is bound as a type alias to (:ty-param "T") so the
;; checker treats references to T as "this type", not "unknown".
;; Constraint enforcement (T satisfies `comparable` etc.) is a
;; later refinement; v0 just allows any operation that's polymorphic
;; under the constraint `any`.
(fn (ctx decl)
(let ((name (nth decl 1)) (params (nth decl 2))
(results (nth decl 3)) (body (nth decl 4))
(type-params (cond (> (len decl) 5) (nth decl 5) :else nil)))
(let ((fn-ty
(list :ty-func
(go-decl-params-to-ty-list params) results)))
(let ((ctx-with-fn (go-ctx-extend ctx name fn-ty)))
(cond
(= body nil) ctx-with-fn
(and (list? body) (= (first body) :block))
(let ((body-ctx
(go-extend-with-type-params
(go-extend-with-params ctx-with-fn params)
type-params)))
(let ((err
(go-check-block body-ctx (nth body 1) results)))
(cond
(go-type-error? err) err
:else ctx-with-fn)))
:else ctx-with-fn))))))
(define
go-extend-with-type-params
;; Each (:field NAMES CONSTRAINT) field contributes opaque type
;; vars: bind each NAME as a type alias to (:ty-param NAME). The
;; constraint type is stored alongside so future "constraint
;; satisfaction" checks can find it; for v0 it's informational.
(fn (ctx type-params)
(cond
(or (= type-params nil) (= (len type-params) 0)) ctx
:else
(let ((field (first type-params)))
(let ((names (nth field 1)) (constraint (nth field 2)))
(go-extend-with-type-params
(go-extend-with-type-param-names ctx names constraint)
(rest type-params)))))))
(define
go-extend-with-type-param-names
(fn (ctx names constraint)
(cond
(= (len names) 0) ctx
:else
(let ((nm (first names)))
(go-extend-with-type-param-names
(go-ctx-extend ctx nm
(list :ty-param nm constraint))
(rest names) constraint)))))

1
next/.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
data/

170
next/README.md Normal file
View File

@@ -0,0 +1,170 @@
# next — fed-sx Milestone 1 kernel
Single-instance, single-actor fed-sx server built as Erlang-on-SX modules.
See `plans/fed-sx-design.md` for the architecture and
`plans/fed-sx-milestone-1.md` for the build plan + per-step progress log.
## Status
Both Step 9 smoke proof points are functional **in-process**:
- **9a-pure (verb extensibility)** — `Create{DefineActivity{Pin}}` registers Pin
at runtime; subsequent `Pin{path, cid}` activities fold into a pin-state
projection. Zero kernel code between definition and use.
See `next/tests/smoke_pin_pure.sh`.
- **9b-pure (reactive application)** — A trigger projection matches Notes
tagged `smoketest` and derives a `TestEcho` carrying the source CID.
See `next/tests/smoke_app_pure.sh`.
The remaining `9a-tcp` / `9b-tcp` deliverables layer TCP transport on top — see
*Substrate gaps* below.
## Layout
```
next/
├── kernel/ Erlang-on-SX kernel modules (.erl)
├── genesis/ SX source files for the bootstrap bundle
├── tests/ Bash test scripts driving sx_server.exe via the epoch protocol
└── data/ Runtime state — gitignored
```
## Module map
| Module | Role |
|-----------------------|------------------------------------------------------------------------|
| `nx_cid.erl` | Canonical CID wrapper around the host `cid:to_string` BIF |
| `envelope.erl` | Activity envelope shape, canonical bytes, time-aware sig verify |
| `log.erl` | Per-actor in-memory append log (open / append / tip / replay / entries) |
| `registry.erl` | Pure-functional + gen_server-wrapped registry keyed by Kind |
| `pipeline.erl` | Validation driver + stage_envelope/signature/replay/schema |
| `projection.erl` | Pure projection driver + gen_server-per-projection wrapper |
| `outbox.erl` | Envelope construct + sign + publish orchestrator + broadcast |
| `bootstrap.erl` | Genesis read/build/verify/load + one-call `start/3` kernel bring-up |
| `define_registry.erl` | Meta-projection fold for `Create{Define*}` → registry |
| `sandbox.erl` | `eval_pure/2,3` try/catch envelope for projection folds |
| `nx_kernel.erl` | Long-lived runtime orchestrator; per-actor bucketed state (m2 Step 1a) |
| `http_server.erl` | route/1,2 + format-aware GET + POST + Accept header content negotiation |
## Genesis bundle
`next/genesis/` contains 31 SX files across 7 sections, all consumed as data
(read + serialised by `bootstrap:populate_registry`, not eval'd):
- 3 activity-types — Create, Update, Delete
- 10 object-types — SXArtifact, Note, Tombstone, 6 Define* meta-types, Snapshot
- 7 projections — activity-log, by-type, by-actor, by-object, actor-state,
define-registry, audience-graph
- 3 validators — envelope-shape, signature, type-schema
- 3 codecs — dag-cbor, raw, dag-json
- 2 sig-suites — rsa-sha256-2018, ed25519-2020
- 3 audience predicates — Public, Followers, Direct
`manifest.sx` is the bundle root, listed in dependency-friendly order.
## Tests
43 test suites, ~560+ assertions. Each script drives `sx_server.exe` via the
epoch protocol — loads the Erlang substrate, loads relevant kernel modules
via `code:load_binary` / `erlang-load-module`, then exercises behaviour
through `erlang-eval-ast`.
Conventions:
- Scripts marked `_pure.sh` exercise pure-functional state.
- Scripts marked `_server.sh` (or no suffix) exercise gen_server APIs and
must inline `start_link` with operations — the Erlang-on-SX scheduler
doesn't preserve spawned processes across separate `erlang-eval-ast`
invocations.
- `smoke_*_pure.sh` are end-to-end smoke tests demonstrating the §Step 9
proof points without TCP / curl / JSON.
The Erlang-on-SX conformance gate (`bash lib/erlang/conformance.sh`, **729 /
729**) is the no-regression contract — every commit on `loops/fed-sx-m1`
preserves it.
## Substrate
Each `.erl` source file is hot-loaded at boot via
`code:load_binary(Mod, Filename, SourceString)` (Phase 7 BIF). Tests drive
the runtime via the epoch protocol:
```bash
printf '(epoch 1)\n(load "lib/erlang/runtime.sx")\n(epoch 2)\n<test-expr>\n' \
| hosts/ocaml/_build/default/bin/sx_server.exe
```
The kernel calls into these host primitives: `crypto:hash/2`,
`cid:from_bytes/1`, `cid:to_string/1`, `file:read_file/1`, `file:write_file/2`,
`file:delete/1`, `file:list_dir/1`, `code:load_binary/3`, plus `http:listen/2`
(the briefing's allowed scope exception, added to `lib/erlang/runtime.sx`).
### Substrate gaps (parked work)
These three gaps block the remaining unchecked deliverables:
1. **Term codec** (`3b`/`3c`) — **all three substrate fixes done 2026-06-05:**
`erlang:binary_to_list/1` and `erlang:list_to_binary/1` registered in
`lib/erlang/runtime.sx` (iolist-aware); the tokenizer's `$X` branch
emits the decimal char code; `atom_to_list/1` and `integer_to_list/1`
now return Erlang charlists (standard Erlang semantics) with `list_to_atom`/
`list_to_integer` accepting both charlists and SX strings for back-compat.
759/759 conformance. The full term-codec primitive set is in place —
Step 3b on-disk segment writer can encode arbitrary Erlang activity
terms (atoms, ints, binaries, tuples, lists) into byte sequences using
only Erlang-native primitives.
2. **SX-source eval bridge** — There's no BIF that lets Erlang call into the
SX evaluator on a parsed source string. Blocks evaluating the `:schema` /
`:fold` / `:predicate` / `:verify` bodies from the genesis bundle. Erlang-fun
stand-ins (`pipeline:stage_schema`, `define_registry:fold`, etc.) prove the
API shapes; the bridge would let bundle bodies dispatch through them
unchanged.
3. **Dict ↔ proplist marshalling for `http:listen/2`****done 2026-06-05.**
`er-bif-http-listen` marshals the native server's request dict
(`{:method :path :query :headers :body}`) into the proplist shape
`[{method, Bin}, {path, Bin}, {query, Bin}, {headers, [{Name, Value}]},
{body, Bin}]` that `http_server:route/2` consumes, and converts the
handler's response proplist back to `{:status :headers :body}` for the
native server to serialise. Helpers (`er-request-dict-to-proplist`,
`er-proplist-to-dict`, `er-of-sx-deep`, `er-to-sx-deep`,
`er-dict-to-header-proplist`, `er-proplist-fill!`) live alongside the
BIF wrapper in `lib/erlang/runtime.sx`. The BIF also spawns the handler
into a real Erlang process via `er-spawn-fun` + `er-sched-run-all!`
so `self()` / `gen_server:call` work inside route handlers (the kernel
and projection gen_servers reach the handler this way). Verified by
`next/tests/http_marshal.sh` and the live TCP smoke
`next/tests/http_server_tcp.sh` / `http_server_start.sh`. Unblocks
`Step 8b-start` (TCP listener spawn) and the curl-driven 9a-tcp / 9b-tcp
smoke tests.
### Bringing up the kernel
For tests, `bootstrap:start/3(ActorId, KeySpec, ActorState)` is the
one-call boot:
```erlang
KM = <<1,2,3,4>>,
KS = [{key_id, k1}, {algorithm, ed25519}, {value, KM}],
AS = [{public_keys, [[{id, k1}, {created, 0}, {value, KM}]]}],
Pid = bootstrap:start(alice, KS, AS),
%% nx_kernel + registry populated; you now have a kernel.
```
The HTTP layer (`http_server`) and `nx_kernel:publish/1` flow through the
same in-process gen_servers; `http_publish_fold.sh` is the end-to-end proof
the chain works.
## What's next (when work resumes)
In priority order:
1. **8b-start**`http_server:start/1` spawns a process hosting `http:listen/2`.
(8b-bridge done — see Substrate gap #3.)
2. **9a-tcp / 9b-tcp** — replace the in-process smoke scripts with curl-driven
versions hitting the running server.
3. **Term codec / on-disk log** — needs either a new BIF or a temp-file
workaround; current in-memory log keeps everything functional otherwise.
4. **SX-source eval bridge** — unlocks real `:schema` / `:fold` body
evaluation from the genesis bundle.

0
next/genesis/.gitkeep Normal file
View File

View File

@@ -0,0 +1,15 @@
;; next/genesis/activity-types/create.sx
;;
;; Bootstrap definition of the Create verb per design §3 and §12.2.
;; Read as data by the bundler (bootstrap.erl) — never evaluated as
;; code. The :schema and :semantics bodies are SX source; the
;; validation pipeline (Step 6) and projection scheduler (Step 7)
;; evaluate them at the appropriate times.
(DefineActivity
:name "Create"
:doc "Publish a new object. Required for actor onboarding and for\n every Define* meta-activity. The activity's :object holds\n the canonical content of the published object."
:schema (fn
(act)
(and (not (nil? (-> act :object))) (string? (-> act :object :type))))
:semantics (fn (state act) state))

View File

@@ -0,0 +1,13 @@
;; next/genesis/activity-types/delete.sx
;;
;; Bootstrap definition of the Delete verb per design §3 and §12.2.
;; Read as data by the bundler — never evaluated as code here. The
;; :schema and :semantics bodies are SX source; the validator
;; pipeline (Step 6) and projection scheduler (Step 7) evaluate them
;; at the appropriate times.
(DefineActivity
:name "Delete"
:doc "Tombstone an existing object. :object is the CID of the\n target. Projections fold Delete by removing the object from\n their working indexes; the underlying log line is never\n erased — durability of the historical record is independent\n of projection state."
:schema (fn (act) (string? (-> act :object)))
:semantics (fn (state act) state))

View File

@@ -0,0 +1,15 @@
;; next/genesis/activity-types/update.sx
;;
;; Bootstrap definition of the Update verb per design §3 and §12.2.
;; Read as data by the bundler — never evaluated as code here. The
;; :schema and :semantics bodies are SX source; the validator
;; pipeline (Step 6) and projection scheduler (Step 7) evaluate them
;; at the appropriate times.
(DefineActivity
:name "Update"
:doc "Patch or replace an existing object. :object is the CID of\n the target; :patch is the field-level edit. Behaviour is\n delegated to per-object-type semantics — e.g. an Update of a\n DefineActivity supersedes the prior registry entry; an\n Update of a Person actor rotates keys via :patch :add-publicKey\n + :patch :supersede."
:schema (fn
(act)
(and (string? (-> act :object)) (not (nil? (-> act :patch)))))
:semantics (fn (state act) state))

View File

@@ -0,0 +1,14 @@
;; next/genesis/audience/direct.sx
;;
;; Direct audience: an actor is a member iff they are
;; explicitly named in the activity's :to or :cc lists. No
;; group expansion — true direct addressing only.
(DefineAudience
:name "Direct"
:doc "Direct-addressing predicate. Tests literal membership\n in the activity's :to or :cc."
:member-of (fn
(actor audience)
(or
(member? actor (-> audience :to))
(member? actor (-> audience :cc)))))

View File

@@ -0,0 +1,14 @@
;; next/genesis/audience/followers.sx
;;
;; Followers audience: an actor is a member iff they appear in
;; the audience-owner's :followers set in the audience-graph
;; projection. Federation (m2) wires this to peer delivery.
(DefineAudience
:name "Followers"
:doc "Followers-of-owner predicate. Looks up the\n audience-graph projection's :followers list for the\n audience owner and tests membership."
:member-of (fn
(actor audience)
(member?
actor
(-> (get-projection :audience-graph) (-> audience :owner) :followers))))

View File

@@ -0,0 +1,9 @@
;; next/genesis/audience/public.sx
;;
;; Public audience: every actor is a member. Maps to the AP
;; magic id `https://www.w3.org/ns/activitystreams#Public`.
(DefineAudience
:name "Public"
:doc "Public audience predicate. Always returns true — every\n actor on the network is considered a member."
:member-of (fn (actor audience) true))

View File

@@ -0,0 +1,13 @@
;; next/genesis/codecs/dag-cbor.sx
;;
;; Canonical CBOR encoding per IPLD dag-cbor. Used to compute
;; envelope canonical bytes for signature coverage and to serialise
;; the genesis bundle itself. In Erlang-on-SX mode the kernel
;; dispatches to the host cid:to_string substrate (Step 1b) when
;; this codec is requested.
(DefineCodec
:name "dag-cbor"
:doc "Deterministic CBOR with dag-cbor restrictions: sorted\n map keys, no floats unless required, no indefinite-length\n items. The canonical wire format for fed-sx artifacts."
:encode (fn (term) (host-codec :dag-cbor :encode term))
:decode (fn (bytes) (host-codec :dag-cbor :decode bytes)))

View File

@@ -0,0 +1,12 @@
;; next/genesis/codecs/dag-json.sx
;;
;; JSON encoding with dag-json restrictions per IPLD: sorted map
;; keys, no NaN / Infinity, no comments, CIDs as `{"/": "..."}`.
;; Used as the human-readable wire format for ActivityPub interop
;; (JSON-LD over dag-json).
(DefineCodec
:name "dag-json"
:doc "Deterministic JSON with dag-json restrictions. Sorted\n keys, CIDs as the {\"/\": \"...\"} object. Used by the\n HTTP server (Step 8) for application/json responses."
:encode (fn (term) (host-codec :dag-json :encode term))
:decode (fn (bytes) (host-codec :dag-json :decode bytes)))

View File

@@ -0,0 +1,12 @@
;; next/genesis/codecs/raw.sx
;;
;; Identity codec — input bytes pass through unchanged in both
;; directions. Used for already-encoded payloads and for binary
;; artifacts (images, archives) whose CID is computed over the
;; raw bytes directly.
(DefineCodec
:name "raw"
:doc "Identity codec. The CID's multicodec byte is 0x55.\n :encode and :decode return their input unchanged."
:encode (fn (bytes) bytes)
:decode (fn (bytes) bytes))

49
next/genesis/manifest.sx Normal file
View File

@@ -0,0 +1,49 @@
;; next/genesis/manifest.sx
;;
;; Genesis bundle root per design §12.2. Lists every definition file
;; that gets packed into the bundle. The bundler (bootstrap.erl)
;; walks this manifest, reads each referenced file, parses its
;; top-level form, and inserts it into the bundle dict at the
;; appropriate section path.
;;
;; The bundle CID is the content-address of the resulting dag-cbor
;; (or v1 stand-in) blob over the assembled dict. That CID is
;; baked into the kernel at build time and re-verified on startup
;; per design §12.3.
;;
;; Section values are bare parenthesised paths (data lists, not
;; function calls) — the manifest is consumed by `parse`, not
;; `eval`. Empty sections are written as `()`.
(GenesisManifest
:version "0.0.1"
:kernel-version "1.0.0-m1"
:activity-types ("activity-types/create.sx"
"activity-types/update.sx"
"activity-types/delete.sx")
:object-types ("object-types/sx-artifact.sx"
"object-types/note.sx"
"object-types/tombstone.sx"
"object-types/person.sx"
"object-types/service.sx"
"object-types/group.sx"
"object-types/define-activity.sx"
"object-types/define-object.sx"
"object-types/define-projection.sx"
"object-types/define-validator.sx"
"object-types/define-codec.sx"
"object-types/define-sig-suite.sx"
"object-types/snapshot.sx")
:projections ("projections/activity-log.sx"
"projections/by-type.sx"
"projections/by-actor.sx"
"projections/by-object.sx"
"projections/actor-state.sx"
"projections/define-registry.sx"
"projections/audience-graph.sx")
:validators ("validators/envelope-shape.sx"
"validators/signature.sx"
"validators/type-schema.sx")
:codecs ("codecs/dag-cbor.sx" "codecs/raw.sx" "codecs/dag-json.sx")
:sig-suites ("sig-suites/rsa-sha256-2018.sx" "sig-suites/ed25519-2020.sx")
:audience ("audience/public.sx" "audience/followers.sx" "audience/direct.sx"))

View File

@@ -0,0 +1,12 @@
;; next/genesis/object-types/define-activity.sx
;;
;; Meta-object that registers a new activity verb. Published as
;; Create{DefineActivity{...}}; the define-registry projection
;; folds it into the activity-types registry. Per design §5.
(DefineObject
:name "DefineActivity"
:doc "Activity-type registration. :name is the verb (e.g.\n \"Pin\"); :schema is an SX predicate over activity\n envelopes; :semantics is an optional state-fold body."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :schema))))))

View File

@@ -0,0 +1,15 @@
;; next/genesis/object-types/define-codec.sx
;;
;; Meta-object that registers a content codec — an encode/decode
;; pair. The bootstrap bundle ships dag-cbor, raw, and dag-json
;; codecs; new codecs can be added via Create{DefineCodec{...}}.
(DefineObject
:name "DefineCodec"
:doc "Codec registration. :name identifies the codec ('dag-cbor',\n 'raw', 'dag-json', ...); :encode and :decode are the\n SX bodies the kernel calls when serialising / parsing\n artifacts under this codec."
:schema (fn
(obj)
(and
(string? (-> obj :name))
(not (nil? (-> obj :encode)))
(not (nil? (-> obj :decode))))))

View File

@@ -0,0 +1,12 @@
;; next/genesis/object-types/define-object.sx
;;
;; Meta-object that registers a new object-type. Bootstrap-level —
;; runtime registration of new object types (e.g. DefineSubscription
;; in the Step 9b smoke test) flows through this.
(DefineObject
:name "DefineObject"
:doc "Object-type registration. :name is the type tag (e.g.\n \"PinSpec\"); :schema is an SX predicate over object\n forms of that type."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :schema))))))

View File

@@ -0,0 +1,16 @@
;; next/genesis/object-types/define-projection.sx
;;
;; Meta-object that registers a new projection. The projection
;; scheduler (Step 7) spawns one gen_server per registered
;; projection and feeds activities through its :fold body in
;; sandbox mode.
(DefineObject
:name "DefineProjection"
:doc "Projection registration. :name is the projection key;\n :initial-state is the empty state value; :fold is the\n pure (state activity) -> state function evaluated in\n sandbox mode per activity."
:schema (fn
(obj)
(and
(string? (-> obj :name))
(not (nil? (-> obj :initial-state)))
(not (nil? (-> obj :fold))))))

View File

@@ -0,0 +1,12 @@
;; next/genesis/object-types/define-sig-suite.sx
;;
;; Meta-object that registers a signature suite. Bootstrap ships
;; rsa-sha256-2018 and ed25519-2020; the suite name maps an
;; algorithm to a :verify body and a :key-format predicate.
(DefineObject
:name "DefineSigSuite"
:doc "Signature suite registration. :name identifies the suite\n ('rsa-sha256-2018', 'ed25519-2020', ...); :verify is the\n SX (canonical-bytes signature key) -> bool body; the\n envelope-signature validator dispatches by suite name."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :verify))))))

View File

@@ -0,0 +1,12 @@
;; next/genesis/object-types/define-validator.sx
;;
;; Meta-object that registers a validator predicate. The validation
;; pipeline (Step 6) consults registered validators by name when
;; running its stages.
(DefineObject
:name "DefineValidator"
:doc "Validator registration. :name is the validator key (e.g.\n \"envelope-shape\"); :predicate is the SX (activity) ->\n ok|{error, R} body."
:schema (fn
(obj)
(and (string? (-> obj :name)) (not (nil? (-> obj :predicate))))))

View File

@@ -0,0 +1,11 @@
;; next/genesis/object-types/group.sx
;;
;; Per design §9.1: a Group is a multi-controller actor — typically
;; a working group, channel, or collective whose membership is
;; managed via Add/Remove activities. Sig-suite validation honours
;; the current key-set rather than a single keypair.
(DefineObject
:name "Group"
:doc "Multi-controller actor. :name is the group's display name; :preferredUsername is the local handle; :summary is the description; :icon is a CID or URL; :members is the current member list (managed via Add/Remove)."
:schema (fn (obj) (string? (-> obj :name))))

View File

@@ -0,0 +1,10 @@
;; next/genesis/object-types/note.sx
;;
;; Short message intended for an audience, ActivityPub-Note-compatible.
;; Used by the Step 9b reactive smoke test (Note tagged "smoketest"
;; matches the Topic subscription).
(DefineObject
:name "Note"
:doc "Short authored message. :content is the body text;\n :tags is a list of subscription-routable tags."
:schema (fn (obj) (string? (-> obj :content))))

View File

@@ -0,0 +1,11 @@
;; next/genesis/object-types/person.sx
;;
;; Per design §9.1: a Person is the canonical actor type for a
;; human-controlled identity. Bootstrapped via Create{Person{...}}
;; as the actor's first activity (see nx_kernel:bootstrap_actor/4).
;; ActivityPub-Person-compatible.
(DefineObject
:name "Person"
:doc "Human-controlled actor. :name is the display name; :preferredUsername is the local handle; :summary is the profile bio; :icon is a CID or URL."
:schema (fn (obj) (string? (-> obj :name))))

View File

@@ -0,0 +1,11 @@
;; next/genesis/object-types/service.sx
;;
;; Per design §9.1: a Service is a non-human actor — a bot, an
;; automated feed, an organisational publisher. Same activity
;; surface as Person, different ActivityPub Actor type. Tooling
;; treats a Service identically to a Person except for UX hints.
(DefineObject
:name "Service"
:doc "Automated / programmatic actor. :name is the display name; :preferredUsername is the local handle; :summary is the profile bio; :icon is a CID or URL."
:schema (fn (obj) (string? (-> obj :name))))

View File

@@ -0,0 +1,13 @@
;; next/genesis/object-types/snapshot.sx
;;
;; Projection state checkpoint. The projection scheduler emits
;; Snapshot{projection-name, state-cid, log-seq} periodically;
;; cold starts read the most recent Snapshot and replay only
;; activities after :log-seq. Per design §10.5.
(DefineObject
:name "Snapshot"
:doc "Projection-state checkpoint. :projection-name identifies\n the projection; :state-cid is the content-address of\n the snapshotted state value; :log-seq is the activity\n sequence number the snapshot was taken at."
:schema (fn
(obj)
(and (string? (-> obj :projection-name)) (string? (-> obj :state-cid)))))

View File

@@ -0,0 +1,10 @@
;; next/genesis/object-types/sx-artifact.sx
;;
;; Content-addressed SX source — a library, component, or
;; executable form published via Create{SXArtifact{...}}.
;; Consumers reference an artifact by its CID. Per design §3.4.
(DefineObject
:name "SXArtifact"
:doc "Published SX source. :source carries the form text;\n :language is optional ('sx' by default); :imports lists\n CIDs the artifact depends on."
:schema (fn (obj) (string? (-> obj :source))))

View File

@@ -0,0 +1,9 @@
;; next/genesis/object-types/tombstone.sx
;;
;; Replacement for an object that has been Delete'd. Lets projection
;; folds keep a marker without retaining the deleted content.
(DefineObject
:name "Tombstone"
:doc "Marker for a deleted object. :former-cid carries the CID\n of the object that was removed. Projections fold Tombstone\n by replacing the cached entry (not by omitting it)."
:schema (fn (obj) (string? (-> obj :former-cid))))

View File

@@ -0,0 +1,11 @@
;; next/genesis/projections/activity-log.sx
;;
;; Identity projection: stores every activity by its CID. The
;; base ledger every other projection could be re-derived from
;; if needed. Per design §10.2.
(DefineProjection
:name "activity-log"
:doc "Maps activity CID to the full envelope. Every activity\n flows through; no filter. State is the CID-keyed dict."
:initial-state {}
:fold (fn (state act) (assoc state (-> act :cid) act)))

View File

@@ -0,0 +1,26 @@
;; next/genesis/projections/actor-state.sx
;;
;; Per-actor live state: publicKeys (with history per design §9.6),
;; profile fields (preferredUsername, summary, ...), follower/
;; following counts. Powers the actor doc endpoint and the
;; time-aware signature verification in envelope:verify_signature/2.
(DefineProjection
:name "actor-state"
:doc "Actor-id -> {publicKeys, profile, followers, following}.\n Updated by Create{Person|Service|Group}, Update (key\n rotation, profile edits), Move (federation migration)."
:initial-state {}
:fold (fn
(state act)
(let
((aid (-> act :actor)) (t (-> act :type)))
(cond
(= t "Create")
(assoc state aid (or (-> act :object) {}))
(= t "Update")
(assoc
state
aid
(merge
(or (get state aid) {})
(or (-> act :patch) {})))
:else state))))

View File

@@ -0,0 +1,25 @@
;; next/genesis/projections/audience-graph.sx
;;
;; Per-actor follow / follower graph and audience caches. Folded
;; from Follow / Accept / Reject / Undo{Follow}. Used by the
;; activity router to expand :to / :cc audiences (Public,
;; Followers, Direct) into concrete recipient sets. Per design §16.
(DefineProjection
:name "audience-graph"
:doc "Actor-id -> {following, followers, pending} sets.\n Updated by Follow / Accept / Reject / Undo. Federation\n (m2) wires this projection to the delivery queue."
:initial-state {}
:fold (fn
(state act)
(let
((t (-> act :type)))
(cond
(= t "Follow")
state
(= t "Accept")
state
(= t "Reject")
state
(= t "Undo")
state
:else state))))

View File

@@ -0,0 +1,15 @@
;; next/genesis/projections/by-actor.sx
;;
;; Index of activity CIDs grouped by :actor. Maps actor-id to a
;; list of CIDs in append order. Powers the per-actor outbox
;; listing (Step 8) without re-scanning the full log.
(DefineProjection
:name "by-actor"
:doc "Actor-id -> list of activity CIDs (append order)."
:initial-state {}
:fold (fn
(state act)
(let
((a (-> act :actor)) (cid (-> act :cid)))
(assoc state a (append (or (get state a) (list)) (list cid))))))

View File

@@ -0,0 +1,22 @@
;; next/genesis/projections/by-object.sx
;;
;; Index of activities that reference each :object CID. Maps
;; object-CID to the list of activity CIDs that target it
;; (Update / Delete / Announce / etc.). Used for "show me
;; everything that happened to X" queries.
(DefineProjection
:name "by-object"
:doc "Object CID -> list of activity CIDs that target it."
:initial-state {}
:fold (fn
(state act)
(let
((obj-cid (-> act :object)) (cid (-> act :cid)))
(if
(string? obj-cid)
(assoc
state
obj-cid
(append (or (get state obj-cid) (list)) (list cid)))
state))))

View File

@@ -0,0 +1,15 @@
;; next/genesis/projections/by-type.sx
;;
;; Index of activity CIDs grouped by :type. Maps type-name to a
;; list of CIDs in append order. Used by the outbox listing
;; endpoints (Step 8) for type-filtered pagination.
(DefineProjection
:name "by-type"
:doc "Type-name -> list of activity CIDs (append order)."
:initial-state {}
:fold (fn
(state act)
(let
((t (-> act :type)) (cid (-> act :cid)))
(assoc state t (append (or (get state t) (list)) (list cid))))))

View File

@@ -0,0 +1,33 @@
;; next/genesis/projections/define-registry.sx
;;
;; The meta-projection: folds Create{Define*{...}} activities into
;; the kernel registry. Resolves the chicken-and-egg circle —
;; bootstrap.erl populates the registry directly at startup from
;; the genesis bundle, and from then on define-registry's fold
;; keeps it current as new Define* activities arrive. Per design §5.
(DefineProjection
:name "define-registry"
:doc "Maps {kind, name} -> definition entry. Folded from\n Create{DefineActivity|DefineObject|DefineProjection|\n DefineValidator|DefineCodec|DefineSigSuite|...}. Kind is\n derived from the inner :object :type tag."
:initial-state {}
:fold (fn
(state act)
(let
((obj (-> act :object)) (otype (-> act :object :type)))
(cond
(= (-> act :type) "Create")
(cond
(= otype "DefineActivity")
(assoc-in state (list :activity-types (-> obj :name)) obj)
(= otype "DefineObject")
(assoc-in state (list :object-types (-> obj :name)) obj)
(= otype "DefineProjection")
(assoc-in state (list :projections (-> obj :name)) obj)
(= otype "DefineValidator")
(assoc-in state (list :validators (-> obj :name)) obj)
(= otype "DefineCodec")
(assoc-in state (list :codecs (-> obj :name)) obj)
(= otype "DefineSigSuite")
(assoc-in state (list :sig-suites (-> obj :name)) obj)
:else state)
:else state))))

View File

@@ -0,0 +1,11 @@
;; next/genesis/sig-suites/ed25519-2020.sx
;;
;; W3C Verifiable Credential signature suite — Ed25519 over
;; canonical bytes, key material in multibase. Default suite
;; for fed-sx actors per design §9.
(DefineSigSuite
:name "ed25519-2020"
:doc "Ed25519 verification. Key carries publicKeyMultibase.\n :verify takes canonical-bytes + signature + key and\n returns bool. Real verification deferred to m2 once\n crypto:verify_ed25519/3 BIF lands; v1 stand-in returns\n false to defer all Ed25519-signed activities."
:verify (fn (canonical-bytes signature key) false)
:key-format (fn (key-doc) (string? (-> key-doc :publicKeyMultibase))))

View File

@@ -0,0 +1,11 @@
;; next/genesis/sig-suites/rsa-sha256-2018.sx
;;
;; W3C Verifiable Credential signature suite — RSA-SHA256 over
;; canonical bytes, key material in PEM. Compatible with
;; Mastodon's HTTP-Signatures / Linked-Data-Signatures-2017.
(DefineSigSuite
:name "rsa-sha256-2018"
:doc "RSA-SHA256 verification. Key carries publicKeyPem.\n :verify takes canonical-bytes + signature + key and\n returns bool. Real verification deferred to m2 once\n crypto:verify_rsa/3 BIF lands; v1 stand-in returns\n false to defer all RSA-signed activities."
:verify (fn (canonical-bytes signature key) false)
:key-format (fn (key-doc) (string? (-> key-doc :publicKeyPem))))

View File

@@ -0,0 +1,22 @@
;; next/genesis/validators/envelope-shape.sx
;;
;; Validates required envelope fields per design §3.1. Stage 1 of
;; the validation pipeline (Step 6). Mirrors the kernel's
;; envelope:validate_shape/1 from Step 2a — when the pipeline runs
;; in OCaml-side sandbox eval mode it dispatches by name; when it
;; runs through the kernel Erlang path it short-circuits to the BIF.
(DefineValidator
:name "envelope-shape"
:doc "Required-fields check on the activity envelope:\n :id, :type, :actor, :published, :signature must all be\n present and non-nil. The :signature sub-field needs\n :key_id, :algorithm, :value."
:predicate (fn
(act)
(and
(not (nil? (-> act :id)))
(not (nil? (-> act :type)))
(not (nil? (-> act :actor)))
(not (nil? (-> act :published)))
(not (nil? (-> act :signature)))
(not (nil? (-> act :signature :key_id)))
(not (nil? (-> act :signature :algorithm)))
(not (nil? (-> act :signature :value))))))

View File

@@ -0,0 +1,13 @@
;; next/genesis/validators/signature.sx
;;
;; Stage 2 of the validation pipeline per design §14. Verifies the
;; activity signature against the time-relevant public key in the
;; actor-state projection. Bootstrap entry; the kernel dispatches
;; to envelope:verify_signature/2 (Step 2c) when running in
;; Erlang-on-SX mode. Per design §9.6 the lookup is timestamp-aware
;; — key validity is evaluated at :published, not "now".
(DefineValidator
:name "signature"
:doc "Signature verification. Picks the signature suite by\n :signature :algorithm, fetches the key with id ==\n :signature :key_id that was active at :published from\n the actor-state projection, then dispatches to the\n suite's :verify body."
:predicate (fn (act) true))

View File

@@ -0,0 +1,21 @@
;; next/genesis/validators/type-schema.sx
;;
;; Stage 5 of the validation pipeline per design §14. Validates
;; the activity's :object against the schema registered for its
;; :object :type in the define-registry projection.
(DefineValidator
:name "type-schema"
:doc "Looks up the object-type registration in the\n define-registry projection, fetches its :schema body,\n and evaluates it against (-> act :object). Returns true\n when no object-type is named (some verbs carry no\n :object) or when no schema is registered for the named\n type (open-world default — Step 6 may tighten)."
:predicate (fn
(act)
(let
((obj (-> act :object)))
(cond
(nil? obj)
true
(nil? (-> obj :type))
true
:else (let
((schema (-> (registry-lookup :object-types (-> obj :type)) :schema)))
(if (nil? schema) true (apply-schema schema obj)))))))

0
next/kernel/.gitkeep Normal file
View File

260
next/kernel/actor_state.erl Normal file
View File

@@ -0,0 +1,260 @@
-module(actor_state).
-export([fold/2, fold_fn/0, new/0, lookup/2, has/2, actors/1,
profile_type/1, profile_name/1, profile_field/2,
key_history/1, active_keys_at/2, find_key_by_id/2]).
%% Actor-state projection fold — Erlang-fun stand-in for the
%% genesis `actor-state.sx` projection body. Tracks per-actor
%% profiles, key-history, and Move pointers per design §9.1-§9.4.
%%
%% State shape:
%% [{ActorId, Profile}, ...]
%%
%% Profile = [{type, person|service|group},
%% {name, Bin},
%% {preferredUsername, Bin},
%% {summary, Bin},
%% {icon, Bin},
%% {public_keys, [Key]},
%% {moved_to, ActorIdOrUrl},
%% {created, N}]
%%
%% Bridge note: the SX-source eval bridge would replace this fold
%% body once available (same gap as Step 5d-pure / Step 6c-schema-pure).
%% define_registry.erl is the structural twin.
%%
%% lists:keyfind/keymember aren't in this substrate (Step 1a noted
%% same gap), so local `find_keyed`/`has_keyed`/`set_keyed` helpers
%% handle the keyed-list ops.
new() -> [].
actors(State) -> [Id || {Id, _Profile} <- State].
has(ActorId, State) -> has_keyed(ActorId, State).
lookup(ActorId, State) ->
case find_keyed(ActorId, State) of
{ok, Profile} -> {ok, Profile};
{error, _} -> not_found
end.
%% ── Fold dispatch ───────────────────────────────────────────────
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, create} -> fold_create(Activity, State);
{ok, update} -> fold_update(Activity, State);
{ok, move} -> fold_move(Activity, State);
_ -> State
end.
fold_create(Activity, State) ->
case envelope:get_field(object, Activity) of
{ok, Obj} ->
case envelope:get_field(type, Obj) of
{ok, ObjType} ->
case is_actor_type(ObjType) of
true -> register_actor(Activity, Obj, ObjType, State);
false -> State
end;
_ -> State
end;
_ -> State
end.
register_actor(Activity, Obj, ObjType, State) ->
case envelope:get_field(actor, Activity) of
{ok, ActorId} ->
case has_keyed(ActorId, State) of
true ->
State;
false ->
Created = published_seq(Activity),
Profile = build_profile(ObjType, Obj, Created),
State ++ [{ActorId, Profile}]
end;
_ -> State
end.
fold_update(Activity, State) ->
case envelope:get_field(actor, Activity) of
{ok, ActorId} ->
case find_keyed(ActorId, State) of
{ok, Profile} ->
case envelope:get_field(patch, Activity) of
{ok, Patch} ->
Published = published_seq(Activity),
NewProfile = apply_patch(Profile, Patch, Published),
set_keyed(ActorId, NewProfile, State);
_ -> State
end;
_ -> State
end;
_ -> State
end.
fold_move(Activity, State) ->
case envelope:get_field(actor, Activity) of
{ok, ActorId} ->
case find_keyed(ActorId, State) of
{ok, Profile} ->
case envelope:get_field(moved_to, Activity) of
{ok, Target} ->
NewProfile = set_keyed(moved_to, Target, Profile),
set_keyed(ActorId, NewProfile, State);
_ -> State
end;
_ -> State
end;
_ -> State
end.
%% ── Profile assembly ────────────────────────────────────────────
build_profile(ObjType, Obj, Created) ->
Base = [{type, ObjType}, {created, Created}],
Fields = [name, preferredUsername, summary, icon, public_keys],
Base ++ collect_fields(Fields, Obj).
collect_fields([], _) -> [];
collect_fields([F | Rest], Obj) ->
case envelope:get_field(F, Obj) of
{ok, V} -> [{F, V} | collect_fields(Rest, Obj)];
_ -> collect_fields(Rest, Obj)
end.
merge_patch(Profile, []) -> Profile;
merge_patch(Profile, [{K, V} | Rest]) ->
merge_patch(set_keyed(K, V, Profile), Rest);
merge_patch(Profile, _) -> Profile.
%% apply_patch/3 — same as merge_patch but special-cases two
%% key-rotation patch entries per design §9.6:
%% {add_publicKey, KeyProplist} — append a new key to :public_keys,
%% defaulting :created to Published.
%% {supersede, OldKeyId} — mark the key with :id =:= OldKeyId
%% as :superseded_at = Published.
%% Other patch entries fall through to last-write-wins per key.
apply_patch(Profile, [], _Published) -> Profile;
apply_patch(Profile, [{add_publicKey, NewKey} | Rest], Published) ->
Augmented = ensure_created(NewKey, Published),
Current = current_public_keys(Profile),
NewKeys = Current ++ [Augmented],
apply_patch(set_keyed(public_keys, NewKeys, Profile), Rest, Published);
apply_patch(Profile, [{supersede, OldKeyId} | Rest], Published) ->
Current = current_public_keys(Profile),
NewKeys = mark_superseded(OldKeyId, Published, Current),
apply_patch(set_keyed(public_keys, NewKeys, Profile), Rest, Published);
apply_patch(Profile, [{K, V} | Rest], Published) ->
apply_patch(set_keyed(K, V, Profile), Rest, Published);
apply_patch(Profile, _, _) -> Profile.
current_public_keys(Profile) ->
case find_keyed(public_keys, Profile) of
{ok, Keys} -> Keys;
_ -> []
end.
ensure_created(Key, Published) ->
case find_keyed(created, Key) of
{ok, _} -> Key;
_ -> set_keyed(created, Published, Key)
end.
mark_superseded(_, _, []) -> [];
mark_superseded(OldId, At, [Key | Rest]) ->
case find_keyed(id, Key) of
{ok, OldId} ->
case find_keyed(superseded_at, Key) of
{ok, _} -> [Key | mark_superseded(OldId, At, Rest)];
_ -> [set_keyed(superseded_at, At, Key) | mark_superseded(OldId, At, Rest)]
end;
_ -> [Key | mark_superseded(OldId, At, Rest)]
end.
%% Key-history view — full :public_keys list including superseded
%% entries (per §9.6: history is preserved so historical activities
%% verify against keys that were active at their :published time).
key_history(Profile) ->
current_public_keys(Profile).
%% active_keys_at/2 — the subset of :public_keys active at Now,
%% mirroring envelope's is_active_at semantics (local copy: envelope
%% keeps the predicate private).
active_keys_at(Profile, Now) ->
[K || K <- current_public_keys(Profile),
key_active_at(K, Now)].
find_key_by_id(KeyId, Profile) ->
find_key_by_id_in(KeyId, current_public_keys(Profile)).
find_key_by_id_in(_, []) -> not_found;
find_key_by_id_in(WantId, [K | Rest]) ->
case find_keyed(id, K) of
{ok, WantId} -> {ok, K};
_ -> find_key_by_id_in(WantId, Rest)
end.
key_active_at(Key, Now) ->
case find_keyed(created, Key) of
{ok, Created} when Now >= Created ->
case find_keyed(superseded_at, Key) of
{ok, SupAt} -> Now < SupAt;
_ -> true
end;
_ -> false
end.
published_seq(Activity) ->
case envelope:get_field(published, Activity) of
{ok, P} -> P;
_ -> 0
end.
is_actor_type(person) -> true;
is_actor_type(service) -> true;
is_actor_type(group) -> true;
is_actor_type(_) -> false.
%% ── Profile accessors ───────────────────────────────────────────
profile_type(Profile) ->
case find_keyed(type, Profile) of
{ok, T} -> T;
_ -> nil
end.
profile_name(Profile) ->
case find_keyed(name, Profile) of
{ok, N} -> N;
_ -> nil
end.
profile_field(F, Profile) ->
case find_keyed(F, Profile) of
{ok, V} -> {ok, V};
_ -> not_found
end.
%% ── Projection integration ──────────────────────────────────────
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
%% ── Internal ────────────────────────────────────────────────────
has_keyed(_, []) -> false;
has_keyed(K, [{K, _} | _]) -> true;
has_keyed(K, [_ | Rest]) -> has_keyed(K, Rest).
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].

223
next/kernel/bootstrap.erl Normal file
View File

@@ -0,0 +1,223 @@
-module(bootstrap).
-export([read_genesis/0, read_genesis/1,
read_section/2, sections/0, section_subdir/1,
default_base/0, ends_with_sx/1,
build_genesis/1, verify_genesis/2,
cidhash_path/1, write_cidhash/2, read_cidhash/1,
load_genesis/1, strip_sx_suffix/1,
populate_registry/0,
start/3]).
%% Genesis bundle reader per design §12.2.
%%
%% read_genesis/0,1 walks the seven canonical section subdirectories
%% under `next/genesis/`, filters .sx files, reads each file into a
%% binary, and returns a structured snapshot:
%%
%% {ok, [{Section :: atom,
%% [{FileName :: binary, FileBytes :: binary}, ...]},
%% ...]}
%%
%% Step 4d will compute the bundle CID by hashing the assembled
%% byte string across all entries; Step 4e will register the parsed
%% definitions in the kernel registry.
%%
%% Port note: this module does NOT parse the .sx contents. The
%% Erlang-on-SX port has no in-Erlang path from binary bytes to SX
%% structured terms (same substrate gap that parked Step 3b); the
%% bundle CID needs only the raw bytes, and registry registration
%% will happen via an SX-side helper that the kernel hands the
%% binary contents to. read_genesis/1 ignores its arg in v1 except
%% to swap the BasePath — `default_base/0` is "next/genesis".
%%
%% Port note 2: string-literal binary segments `<<"abc">>` truncate
%% to one byte in this port, so all path constants are hand-spelled
%% as integer-segment binaries.
%% ── Public API ──────────────────────────────────────────────────
%% "next/genesis"
default_base() ->
<<110,101,120,116,47,103,101,110,101,115,105,115>>.
read_genesis() ->
read_genesis(default_base()).
read_genesis(BasePath) ->
{ok, lists:map(
fun (S) -> {S, read_section(BasePath, S)} end,
sections())}.
sections() ->
[activity_types, object_types, projections,
validators, codecs, sig_suites, audience].
%% "activity-types"
section_subdir(activity_types) ->
<<97,99,116,105,118,105,116,121,45,116,121,112,101,115>>;
%% "object-types"
section_subdir(object_types) ->
<<111,98,106,101,99,116,45,116,121,112,101,115>>;
%% "projections"
section_subdir(projections) ->
<<112,114,111,106,101,99,116,105,111,110,115>>;
%% "validators"
section_subdir(validators) ->
<<118,97,108,105,100,97,116,111,114,115>>;
%% "codecs"
section_subdir(codecs) ->
<<99,111,100,101,99,115>>;
%% "sig-suites"
section_subdir(sig_suites) ->
<<115,105,103,45,115,117,105,116,101,115>>;
%% "audience"
section_subdir(audience) ->
<<97,117,100,105,101,110,99,101>>.
read_section(BasePath, Section) ->
SubDir = section_subdir(Section),
%% 47 = '/'
Path = <<BasePath/binary, 47, SubDir/binary>>,
case file:list_dir(Path) of
{ok, Names} ->
SxNames = lists:filter(fun (N) -> ends_with_sx(N) end, Names),
lists:map(fun (Name) -> read_one(Path, Name) end, SxNames);
{error, _} ->
[]
end.
%% Suffix check on the .sx extension. 46='.' 115='s' 120='x'.
ends_with_sx(<<46, 115, 120>>) -> true;
ends_with_sx(<<>>) -> false;
ends_with_sx(<<_, Rest/binary>>) -> ends_with_sx(Rest).
%% ── Internal ────────────────────────────────────────────────────
read_one(DirPath, Name) ->
Full = <<DirPath/binary, 47, Name/binary>>,
case file:read_file(Full) of
{ok, Bytes} -> {Name, Bytes};
{error, R} -> {Name, {error, R}}
end.
%% ── Step 4d: bundle CID compute + verify ────────────────────────
%%
%% The bundle CID is the canonical content-address of everything in
%% read_genesis/0's result. We delegate to the host `cid:to_string/1`
%% BIF (Step 1b substrate): it walks the term via `er-format-value`,
%% feeds the deterministic textual form into `cid-from-sx`, returns
%% a CIDv1 (raw codec, sha2-256 multihash) as a binary.
%%
%% Design §12.3: at startup the kernel computes this CID and
%% compares against a hardcoded value (here: a sibling `.cidhash`
%% file). A mismatch is a hard refuse-to-start.
build_genesis(ReadResult) ->
case ReadResult of
{ok, Sections} ->
Cid = cid:to_string({genesis_bundle, Sections}),
{ok, [{cid, Cid}, {sections, Sections}]};
Other ->
{error, {bad_read_result, Other}}
end.
verify_genesis(ReadResult, ExpectedCid) ->
case build_genesis(ReadResult) of
{ok, [{cid, Cid}, _]} ->
case Cid =:= ExpectedCid of
true -> ok;
false -> {error, {cid_mismatch, Cid, ExpectedCid}}
end;
Err -> Err
end.
%% Sibling-file CID storage. "/.cidhash" appended to BasePath as
%% an integer-segment binary (string-literal segments are broken).
%% "/.cidhash" — 47='/' 46='.' c i d h a s h
cidhash_path(BasePath) ->
<<BasePath/binary, 47, 46, 99, 105, 100, 104, 97, 115, 104>>.
write_cidhash(BasePath, Cid) ->
file:write_file(cidhash_path(BasePath), Cid).
read_cidhash(BasePath) ->
file:read_file(cidhash_path(BasePath)).
%% ── Step 4e: load_genesis → registry ────────────────────────────
%%
%% Walks the read_genesis result and registers each file as a
%% registry entry. The section atom is the registry kind directly
%% (both name spaces are identical — see Step 4c sections/0 and
%% Step 5a registry:kinds/0). The entry Name is the filename minus
%% the `.sx` suffix, kept as a binary; the entry value is the
%% file's raw bytes.
%%
%% Returns `{ok, RegistryState}` on success. Later steps (4f / the
%% SX-parser bridge) will replace the raw bytes with parsed forms;
%% the binary stand-in is enough to prove the bridge works.
load_genesis(ReadResult) ->
case ReadResult of
{ok, Sections} ->
{ok, load_sections(Sections, registry:new())};
Other ->
{error, {bad_read_result, Other}}
end.
load_sections([], State) -> State;
load_sections([{Kind, Entries} | Rest], State) ->
load_sections(Rest, load_entries(Kind, Entries, State)).
load_entries(_Kind, [], State) -> State;
load_entries(Kind, [{Name, Bytes} | Rest], State) ->
BaseName = strip_sx_suffix(Name),
{ok, NewState} = registry:register(Kind, BaseName, Bytes, State),
load_entries(Kind, Rest, NewState).
%% strip_sx_suffix(Binary) — drops the trailing ".sx" if present.
%% 46='.' 115='s' 120='x'.
strip_sx_suffix(B) when is_binary(B) ->
case ends_with_sx(B) of
false -> B;
true -> take_prefix(B, byte_size(B) - 3)
end.
take_prefix(_, 0) -> <<>>;
take_prefix(<<H, Rest/binary>>, N) when N > 0 ->
Tail = take_prefix(Rest, N - 1),
<<H, Tail/binary>>.
%% populate_registry/0 — load the canonical genesis bundle and
%% register every entry in the running registry gen_server. The
%% caller is expected to have started the registry (via
%% registry:start_link/0) before calling this. Returns the count
%% of entries registered across all kinds.
populate_registry() ->
{ok, Sections} = read_genesis(),
populate_sections(Sections, 0).
populate_sections([], Count) -> Count;
populate_sections([{Kind, Entries} | Rest], Count) ->
populate_sections(Rest, Count + populate_entries(Kind, Entries, 0)).
populate_entries(_, [], Count) -> Count;
populate_entries(Kind, [{Name, Bytes} | Rest], Count) ->
BaseName = strip_sx_suffix(Name),
ok = registry:register(Kind, BaseName, Bytes),
populate_entries(Kind, Rest, Count + 1).
%% start/3 — one-call bring-up of the kernel substrate. Starts
%% the registry gen_server, populates it from the canonical
%% genesis bundle, then starts the nx_kernel gen_server with the
%% supplied actor identity / key / state. Returns the nx_kernel
%% Pid (gen_server start_link convention in this port returns the
%% raw Pid, not {ok, Pid}).
%%
%% Tests + production bring-up share this entry point. The
%% caller is still responsible for starting any application-level
%% projections and wiring them via nx_kernel:with_projections/1.
start(ActorId, KeySpec, ActorState) ->
registry:start_link(),
populate_registry(),
nx_kernel:start_link(ActorId, KeySpec, ActorState).

View File

@@ -0,0 +1,68 @@
-module(define_registry).
-export([fold/2, fold_fn/0, define_kind/1]).
%% Define-registry projection fold — Erlang-fun stand-in for the
%% genesis `define-registry.sx` body. The intent is identical: a
%% projection whose state is a registry-shaped property list, fed
%% by every `Create{Define*{...}}` activity. The SX body would
%% eventually replace this once an SX-source eval bridge lets the
%% kernel evaluate the genesis fold directly; until then this
%% Erlang module proves the meta-projection mechanism wires
%% through `projection:fold_fn` and `nx_kernel` cleanly.
%%
%% State shape mirrors `registry:new()` exactly:
%% [{Kind, [{Name, Entry}, ...]}, ...]
%% so callers can use `registry:lookup/3` etc. on the result.
%%
%% Type discrimination uses atoms (`define_activity`, …). Real SX
%% would carry the string forms ("DefineActivity", …); the bridge
%% will translate. See define_kind/1 for the mapping.
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, create} -> fold_create(Activity, State);
_ -> State
end.
fold_create(Activity, State) ->
case envelope:get_field(object, Activity) of
{ok, Obj} ->
case envelope:get_field(type, Obj) of
{ok, ObjType} ->
case define_kind(ObjType) of
not_a_define -> State;
Kind -> fold_register(Kind, Obj, State)
end;
_ -> State
end;
_ -> State
end.
fold_register(Kind, Obj, State) ->
case envelope:get_field(name, Obj) of
{ok, Name} ->
case registry:register(Kind, Name, Obj, State) of
{ok, NewState} -> NewState;
{error, unknown_kind} -> State
end;
not_found -> State
end.
%% fold_fn/0 — a 2-arity Erlang fun the projection module plants
%% in its record's :fold slot. Lets `projection:start_link/3`
%% wire define-registry directly.
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
%% define_kind/1 — discriminator from the inner Define* object's
%% :type atom to the registry kind atom. Anything unrecognised
%% returns not_a_define so the fold treats it as a pass-through.
define_kind(define_activity) -> activity_types;
define_kind(define_object) -> object_types;
define_kind(define_projection) -> projections;
define_kind(define_validator) -> validators;
define_kind(define_codec) -> codecs;
define_kind(define_sig_suite) -> sig_suites;
define_kind(define_audience) -> audience;
define_kind(_) -> not_a_define.

86
next/kernel/delivery.erl Normal file
View File

@@ -0,0 +1,86 @@
-module(delivery).
-export([delivery_set/2, delivery_set/3,
collect_recipients/1, suppress_self/2, dedup/1,
expand_audience/3]).
%% Audience-resolving delivery set computation per design §13.4.
%%
%% delivery_set/2(Activity, KernelState) returns a sorted, deduped
%% list of ActorId atoms — every actor the outgoing Activity needs
%% to be POSTed to. Sources:
%% - Activity's `:to` field (single ActorId or list)
%% - Activity's `:cc` field (single ActorId or list)
%% - audience-symbol expansion of `public` and `followers`
%%
%% Self-delivery (the publishing actor reading their own activity
%% on a peer's behalf) is suppressed.
%%
%% Output for Step 7a is the bare ActorId list; Step 8 will resolve
%% each entry to `{PeerInstanceUrl, ActorId}` via the peer-actors
%% cache.
delivery_set(Activity, KernelState) ->
delivery_set(Activity, KernelState, follower_graph:new()).
delivery_set(Activity, KernelState, FollowerGraph) ->
Self = sender(Activity),
Raw = collect_recipients(Activity),
Expanded = expand_all(Raw, Self, KernelState, FollowerGraph),
Suppressed = suppress_self(Expanded, Self),
dedup(Suppressed).
%% collect_recipients/1 — flat list from :to + :cc, normalised so
%% each element is either an ActorId atom or an audience symbol
%% (`public` / `followers`).
collect_recipients(Activity) ->
To = envelope_field_list(to, Activity),
Cc = envelope_field_list(cc, Activity),
To ++ Cc.
envelope_field_list(Field, Activity) ->
case envelope:get_field(Field, Activity) of
not_found -> [];
{ok, V} when is_list(V) -> V;
{ok, V} -> [V]
end.
%% expand_audience/3 — `followers` -> the sender's followers
%% proplist entry from a follower_graph state. `public` for v2
%% expands to the same list (per design §13.4: practical Public
%% fan-out is "every follower of the publishing actor"). The
%% explicit shared-inbox peer-instance model defers to v3.
%% Other symbols / explicit ActorIds pass through unchanged.
expand_audience(public, Sender, Graph) ->
follower_graph:followers(Sender, Graph);
expand_audience(followers, Sender, Graph) ->
follower_graph:followers(Sender, Graph);
expand_audience(X, _Sender, _Graph) -> [X].
expand_all([], _Self, _State, _Graph) -> [];
expand_all([X | Rest], Self, State, Graph) ->
expand_audience(X, Self, Graph) ++ expand_all(Rest, Self, State, Graph).
suppress_self([], _Self) -> [];
suppress_self([Self | Rest], Self) -> suppress_self(Rest, Self);
suppress_self([X | Rest], Self) -> [X | suppress_self(Rest, Self)].
dedup(L) -> dedup_acc(L, []).
dedup_acc([], Acc) -> Acc;
dedup_acc([X | Rest], Acc) ->
case contains(X, Acc) of
true -> dedup_acc(Rest, Acc);
false -> dedup_acc(Rest, Acc ++ [X])
end.
contains(_, []) -> false;
contains(X, [X | _]) -> true;
contains(X, [_ | Rest]) -> contains(X, Rest).
sender(Activity) ->
case envelope:get_field(actor, Activity) of
{ok, A} -> A;
_ -> nil
end.

View File

@@ -0,0 +1,209 @@
-module(delivery_state).
-export([new/0, fold/2, fold_fn/0,
peer_state/2, peers/1,
pending/2, attempts/2, next_retry/2, dead_letter/2]).
%% Delivery-state projection. Folds delivery events (enqueue /
%% delivered / failed / dead_lettered) into a per-peer worker-shaped
%% snapshot so the outbound queue survives kernel restart. Per design
%% §13.4 the worker state on restart is loaded from this projection
%% rather than reconstructed by re-driving the outbox log.
%%
%% Event proplist shape:
%% [{type, enqueued}, {peer, _}, {activity, _}]
%% [{type, delivered}, {peer, _}, {cid, _}]
%% [{type, failed}, {peer, _}, {cid, _}, {now, _}]
%% [{type, dead_lettered}, {peer, _}, {cid, _}]
%%
%% Projection state shape:
%% [{PeerId, WorkerProplist}, ...]
%%
%% WorkerProplist mirrors `delivery_worker:new/1`'s output so a fresh
%% gen_server can be hydrated with `delivery_worker:state_from_proj`
%% (lands when 8b-timer wires up). For Step 8c the projection only
%% tracks data — Step 8d-restart will wire the hydration helper.
new() -> [].
fold_fn() ->
fun (Event, State) -> fold(Event, State) end.
fold(Event, State) ->
case envelope:get_field(type, Event) of
{ok, enqueued} -> fold_enqueued(Event, State);
{ok, delivered} -> fold_delivered(Event, State);
{ok, failed} -> fold_failed(Event, State);
{ok, dead_lettered} -> fold_dead_lettered(Event, State);
_ -> State
end.
fold_enqueued(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(activity, Event)} of
{{ok, Peer}, {ok, Act}} ->
Worker = ensure_peer(Peer, State),
Pending = field(pending, Worker),
Worker1 = set_field(pending, Pending ++ [Act], Worker),
set_peer(Peer, Worker1, State);
_ -> State
end.
fold_delivered(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(cid, Event)} of
{{ok, Peer}, {ok, Cid}} ->
case find_keyed(Peer, State) of
{ok, Worker} ->
Worker1 = drop_pending_by_cid(Cid, Worker),
Worker2 = clear_retry_for(Cid, Worker1),
set_peer(Peer, Worker2, State);
_ -> State
end;
_ -> State
end.
fold_failed(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(cid, Event),
envelope:get_field(now, Event)} of
{{ok, Peer}, {ok, Cid}, {ok, Now}} ->
case find_keyed(Peer, State) of
{ok, Worker} ->
Attempts = field(attempts, Worker),
Current = case find_keyed(Cid, Attempts) of
{ok, N} -> N;
_ -> 0
end,
New = Current + 1,
Attempts1 = set_keyed(Cid, New, Attempts),
Worker1 = set_field(attempts, Attempts1, Worker),
Worker2 = case delivery_worker:backoff_for(New) of
dead_letter ->
dead_letter_pending(Cid, Worker1);
Seconds ->
NR = field(next_retry, Worker1),
NextAt = Now + Seconds,
set_field(next_retry, set_keyed(Cid, NextAt, NR), Worker1)
end,
set_peer(Peer, Worker2, State);
_ -> State
end;
_ -> State
end.
fold_dead_lettered(Event, State) ->
case {envelope:get_field(peer, Event),
envelope:get_field(cid, Event)} of
{{ok, Peer}, {ok, Cid}} ->
case find_keyed(Peer, State) of
{ok, Worker} ->
set_peer(Peer, dead_letter_pending(Cid, Worker), State);
_ -> State
end;
_ -> State
end.
%% ── Accessors ─────────────────────────────────────────────────
peer_state(Peer, State) ->
case find_keyed(Peer, State) of
{ok, Worker} -> {ok, Worker};
_ -> not_found
end.
peers(State) -> [P || {P, _} <- State].
pending(Peer, State) ->
worker_field(Peer, pending, State, []).
attempts(Peer, State) ->
worker_field(Peer, attempts, State, []).
next_retry(Peer, State) ->
worker_field(Peer, next_retry, State, []).
dead_letter(Peer, State) ->
worker_field(Peer, dead_letter, State, []).
%% ── Internal ──────────────────────────────────────────────────
worker_field(Peer, Field, State, Default) ->
case find_keyed(Peer, State) of
{ok, Worker} ->
case find_keyed(Field, Worker) of
{ok, V} -> V;
_ -> Default
end;
_ -> Default
end.
ensure_peer(Peer, State) ->
case find_keyed(Peer, State) of
{ok, Worker} -> Worker;
_ -> empty_worker(Peer)
end.
empty_worker(Peer) ->
[{peer, Peer},
{pending, []},
{attempts, []},
{next_retry, []},
{dead_letter, []}].
set_peer(Peer, Worker, State) ->
set_keyed(Peer, Worker, State).
drop_pending_by_cid(Cid, Worker) ->
Pending = field(pending, Worker),
Kept = [A || A <- Pending, activity_cid(A) =/= Cid],
set_field(pending, Kept, Worker).
clear_retry_for(Cid, Worker) ->
A1 = del_keyed(Cid, field(attempts, Worker)),
NR1 = del_keyed(Cid, field(next_retry, Worker)),
set_field(attempts, A1, set_field(next_retry, NR1, Worker)).
dead_letter_pending(Cid, Worker) ->
Pending = field(pending, Worker),
{Match, Rest} = split_by_cid(Cid, Pending),
DL = field(dead_letter, Worker),
Worker1 = set_field(pending, Rest, Worker),
Worker2 = case Match of
none -> Worker1;
Act -> set_field(dead_letter, DL ++ [Act], Worker1)
end,
clear_retry_for(Cid, Worker2).
split_by_cid(Cid, List) -> split_by_cid(Cid, List, []).
split_by_cid(_, [], Acc) -> {none, lists:reverse(Acc)};
split_by_cid(Cid, [A | Rest], Acc) ->
case activity_cid(A) of
Cid -> {A, lists:reverse(Acc) ++ Rest};
_ -> split_by_cid(Cid, Rest, [A | Acc])
end.
activity_cid(Activity) ->
case envelope:get_field(id, Activity) of
{ok, Cid} -> Cid;
_ -> nil
end.
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> undefined.
set_field(K, V, []) -> [{K, V}];
set_field(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_field(K, V, [P | Rest]) -> [P | set_field(K, V, Rest)].
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].
del_keyed(_, []) -> [];
del_keyed(K, [{K, _} | Rest]) -> Rest;
del_keyed(K, [P | Rest]) -> [P | del_keyed(K, Rest)].

View File

@@ -0,0 +1,286 @@
-module(delivery_worker).
-behaviour(gen_server).
-export([new/1, pending/1, peer/1,
enqueue_pure/3, drain_pure/1, deliver_one_pure/2,
backoff_for/1, schedule_for/1,
record_failure_pure/3, record_success_pure/2,
next_due_pure/2, attempts_for/2, next_retry_at/2,
dead_letter_list/1,
start_link/1, start_link/2, stop/1,
enqueue/2, flush/1, pending_srv/1, set_dispatch_fn/2]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
%% Outbound delivery worker per design §13.4. One gen_server per
%% peer instance (peer-id atom) holding a FIFO queue of pending
%% activities to deliver. v2 lands in stages:
%%
%% Step 8a pure-functional state shape, enqueue / drain /
%% schedule semantics + gen_server skeleton + tests
%% Step 8b retry / backoff schedule (30s / 5m / 30m / 6h / 24h)
%% + dead-letter list
%% Step 8c delivery-state projection so the queue survives
%% kernel restart
%% Step 8d outbox:publish/2 dispatches each delivery-set entry
%% to the matching worker
%% Step 8e httpc:request/4 BIF (substrate exception per briefing)
%% Step 8f real HTTP POST through the BIF + content-type wiring
%%
%% This file is 8a only — pure state + skeleton gen_server with the
%% APIs Step 8b-d will fill in. Real HTTP dispatch is stubbed via a
%% caller-supplied `:dispatch_fn` so tests can intercept and Step 8f
%% can plug in the live httpc call without touching the queue logic.
%%
%% State shape (pure):
%% [{peer, PeerId},
%% {pending, [Activity, ...]}, %% FIFO; head delivered first
%% {attempts, [{Cid, AttemptCount}, ...]},
%% {next_retry, [{Cid, NextRetryAt}, ...]}, %% Step 8b-pure
%% {dead_letter, [Activity, ...]},
%% {dispatch_fn, fun/1 | undefined}]
%%
%% gen_server registers under the peer-id atom (one worker per peer);
%% the same APIs work as pure-functional state transitions for tests.
%% ── Pure-functional API ─────────────────────────────────────────
new(PeerId) ->
[{peer, PeerId},
{pending, []},
{attempts, []},
{next_retry, []},
{dead_letter, []},
{dispatch_fn, undefined}].
pending(State) -> field(pending, State).
peer(State) -> field(peer, State).
%% enqueue_pure/3 — append an activity to the queue. Returns new
%% state. Duplicate :id activities aren't deduplicated here — that's
%% the caller's job (Step 8d will pass each delivery-set entry once).
enqueue_pure(_PeerId, Activity, State) ->
Pending = field(pending, State),
set_field(pending, Pending ++ [Activity], State).
%% drain_pure/1 — attempt to deliver every queued activity through
%% the configured dispatch_fn. Returns {NewState, DeliveredCids,
%% RetryCids}. Activities that fail dispatch stay in :pending with
%% an incremented attempt counter — Step 8b will use the count to
%% pick a backoff slot.
drain_pure(State) ->
Pending = field(pending, State),
drain_loop(Pending, [], State, [], []).
drain_loop([], Kept, State, Delivered, Retry) ->
{set_field(pending, Kept, State), Delivered, Retry};
drain_loop([A | Rest], Kept, State, Delivered, Retry) ->
case deliver_one_pure(A, State) of
{ok, Cid} ->
drain_loop(Rest, Kept, State, Delivered ++ [Cid], Retry);
{error, Cid, _Reason} ->
State1 = bump_attempt(Cid, State),
drain_loop(Rest, Kept ++ [A], State1, Delivered, Retry ++ [Cid])
end.
%% deliver_one_pure/2 — single-activity dispatch via the caller-
%% supplied dispatch_fn. Returns {ok, Cid} on success or {error,
%% Cid, Reason} on failure. With no dispatch_fn configured returns
%% {error, _, no_dispatch_fn} so callers know to wire one before
%% the worker is useful.
deliver_one_pure(Activity, State) ->
Cid = activity_cid(Activity),
case field(dispatch_fn, State) of
undefined -> {error, Cid, no_dispatch_fn};
Fn when is_function(Fn, 1) ->
case Fn(Activity) of
ok -> {ok, Cid};
{ok, _} -> {ok, Cid};
{error, Reason} -> {error, Cid, Reason};
Other -> {error, Cid, {bad_dispatch_return, Other}}
end;
_ -> {error, Cid, bad_dispatch_fn}
end.
%% backoff_for/1 — Step 8a returns the static schedule per the
%% plan; Step 8b wires it into the retry loop. Attempts are
%% 1-indexed (first retry uses slot 1).
%%
%% 30s / 5m / 30m / 6h / 24h then dead_letter.
backoff_for(0) -> 0;
backoff_for(1) -> 30;
backoff_for(2) -> 300; % 5 * 60
backoff_for(3) -> 1800; % 30 * 60
backoff_for(4) -> 21600; % 6 * 3600
backoff_for(5) -> 86400; % 24 * 3600
backoff_for(_) -> dead_letter.
schedule_for(Attempts) ->
case backoff_for(Attempts) of
dead_letter -> dead_letter;
Seconds -> {retry_in, Seconds}
end.
%% ── Step 8b-pure: retry-time bookkeeping ───────────────────────
%%
%% `record_failure_pure/3(Cid, Now, State)` — call after a failed
%% deliver_one. Bumps the per-cid attempt counter; if the new
%% attempt is past the dead-letter threshold, moves the matching
%% activity from :pending to :dead_letter. Otherwise records the
%% next retry time as Now + backoff_for(NewAttempt).
%%
%% Real timer wiring (erlang:send_after self-cast on the worker
%% pid) needs substrate support — Step 8b-timer when that lands.
%%
%% `record_success_pure/2(Cid, State)` — clears :attempts and
%% :next_retry entries for the cid; called after a successful
%% deliver_one.
%%
%% `next_due_pure/2(Now, State)` — returns the list of Cids whose
%% NextRetryAt has passed, in insertion order.
record_failure_pure(Cid, Now, State) ->
Attempts = field(attempts, State),
Current = case find_keyed(Cid, Attempts) of
{ok, N} -> N;
_ -> 0
end,
New = Current + 1,
State1 = set_field(attempts, set_keyed(Cid, New, Attempts), State),
case backoff_for(New) of
dead_letter ->
move_to_dead_letter(Cid, State1);
Seconds ->
NextAt = Now + Seconds,
NR = field(next_retry, State1),
set_field(next_retry, set_keyed(Cid, NextAt, NR), State1)
end.
record_success_pure(Cid, State) ->
A1 = del_keyed(Cid, field(attempts, State)),
NR1 = del_keyed(Cid, field(next_retry, State)),
set_field(attempts, A1, set_field(next_retry, NR1, State)).
%% next_due_pure/2 — Cids whose NextRetryAt <= Now. Preserves
%% insertion order so the worker drains them in FIFO retry order.
next_due_pure(Now, State) ->
[Cid || {Cid, At} <- field(next_retry, State), At =< Now].
attempts_for(Cid, State) ->
case find_keyed(Cid, field(attempts, State)) of
{ok, N} -> N;
_ -> 0
end.
next_retry_at(Cid, State) ->
case find_keyed(Cid, field(next_retry, State)) of
{ok, At} -> At;
_ -> undefined
end.
dead_letter_list(State) -> field(dead_letter, State).
move_to_dead_letter(Cid, State) ->
Pending = field(pending, State),
{Match, Rest} = take_by_cid(Cid, Pending, [], []),
DL = field(dead_letter, State),
State1 = set_field(pending, Rest, State),
State2 = case Match of
none -> State1;
Act -> set_field(dead_letter, DL ++ [Act], State1)
end,
NR = field(next_retry, State2),
set_field(next_retry, del_keyed(Cid, NR), State2).
take_by_cid(_, [], Acc, _) -> {none, lists:reverse(Acc)};
take_by_cid(Cid, [A | Rest], Acc, _) ->
case activity_cid(A) of
Cid -> {A, lists:reverse(Acc) ++ Rest};
_ -> take_by_cid(Cid, Rest, [A | Acc], 0)
end.
%% ── gen_server wrapper ──────────────────────────────────────────
start_link(PeerId) ->
start_link(PeerId, undefined).
start_link(PeerId, DispatchFn) ->
Pid = gen_server:start_link(delivery_worker, [PeerId, DispatchFn]),
erlang:register(PeerId, Pid),
Pid.
stop(PeerId) ->
R = gen_server:call(PeerId, '$gen_stop'),
erlang:unregister(PeerId),
R.
enqueue(PeerId, Activity) ->
gen_server:call(PeerId, {enqueue, Activity}).
flush(PeerId) ->
gen_server:call(PeerId, flush).
pending_srv(PeerId) ->
gen_server:call(PeerId, get_pending).
set_dispatch_fn(PeerId, Fn) ->
gen_server:call(PeerId, {set_dispatch_fn, Fn}).
%% gen_server callbacks
init([PeerId, DispatchFn]) ->
S0 = new(PeerId),
{ok, set_field(dispatch_fn, DispatchFn, S0)}.
handle_call({enqueue, Activity}, _From, State) ->
{reply, ok, enqueue_pure(field(peer, State), Activity, State)};
handle_call(flush, _From, State) ->
{NewState, Delivered, Retry} = drain_pure(State),
{reply, {ok, Delivered, Retry}, NewState};
handle_call(get_pending, _From, State) ->
{reply, field(pending, State), State};
handle_call({set_dispatch_fn, Fn}, _From, State) ->
{reply, ok, set_field(dispatch_fn, Fn, State)}.
handle_cast(_, S) -> {noreply, S}.
handle_info(_, S) -> {noreply, S}.
%% ── Internal ────────────────────────────────────────────────────
activity_cid(Activity) ->
case envelope:get_field(id, Activity) of
{ok, Cid} -> Cid;
_ -> nil
end.
bump_attempt(Cid, State) ->
Attempts = field(attempts, State),
Current = case find_keyed(Cid, Attempts) of
{ok, N} -> N;
_ -> 0
end,
set_field(attempts, set_keyed(Cid, Current + 1, Attempts), State).
field(K, [{K, V} | _]) -> V;
field(K, [_ | Rest]) -> field(K, Rest);
field(_, []) -> undefined.
set_field(K, V, []) -> [{K, V}];
set_field(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_field(K, V, [P | Rest]) -> [P | set_field(K, V, Rest)].
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].
del_keyed(_, []) -> [];
del_keyed(K, [{K, _} | Rest]) -> Rest;
del_keyed(K, [P | Rest]) -> [P | del_keyed(K, Rest)].

98
next/kernel/discovery.erl Normal file
View File

@@ -0,0 +1,98 @@
-module(discovery).
-export([parse_acct/1, parse_resource/1,
actor_url_for/2, webfinger_body/3]).
%% Discovery primitives per design §13.7. Step 10a covers the
%% local-side webfinger endpoint (responding when a peer asks
%% "where does acct:alice@here live?"); the peer-fetch direction
%% (loading a peer's actor doc lazily on first inbound) is Step 10b
%% and gates on Blockers #2 (native http-request primitive).
%%
%% parse_acct/1 — accept a binary in either form:
%% <<"acct:alice@host:port">> (full prefixed URI)
%% <<"alice@host:port">> (bare account, prefix optional)
%% Returns {ok, User, Host} | {error, Reason}.
%%
%% parse_resource/1 — the resource= query parameter from
%% /.well-known/webfinger. Same shape as parse_acct.
%%
%% actor_url_for/2(User, Host) — synthesises the canonical
%% per-actor URL `<scheme>://<host>/actors/<user>`. v2 hardcodes
%% http://; TLS / https is v3 (Blockers gate).
%%
%% webfinger_body/3 — builds the JSON response body.
%% ── parse_acct / parse_resource ─────────────────────────────────
%% "acct:" -> 5 bytes: 97 99 99 116 58
parse_acct(Bin) when is_binary(Bin) ->
AcctPrefix = <<97,99,99,116,58>>,
case strip_prefix(AcctPrefix, Bin) of
{ok, Rest} -> split_user_host(Rest);
nomatch -> split_user_host(Bin)
end;
parse_acct(_) -> {error, bad_input}.
parse_resource(Bin) -> parse_acct(Bin).
%% strip_prefix/2 — return {ok, Rest} when Bin starts with Prefix,
%% else nomatch. Substrate has no proper prefix-match BIF; this
%% byte-walks.
strip_prefix(<<>>, Rest) -> {ok, Rest};
strip_prefix(<<B, PRest/binary>>, <<B, RRest/binary>>) ->
strip_prefix(PRest, RRest);
strip_prefix(_, _) -> nomatch.
%% split_user_host/1 — split a `user@host[:port]` binary at the
%% first `@`. Returns {ok, User, Host} where Host may include the
%% optional port suffix.
split_user_host(Bin) ->
case split_at(64, Bin) of % 64 = '@'
{Before, After} when byte_size(Before) > 0, byte_size(After) > 0 ->
{ok, Before, After};
_ ->
{error, bad_acct}
end.
split_at(Byte, Bin) ->
split_at(Byte, Bin, <<>>).
split_at(_, <<>>, Acc) ->
{Acc, <<>>};
split_at(Byte, <<Byte, Rest/binary>>, Acc) ->
{Acc, Rest};
split_at(Byte, <<B, Rest/binary>>, Acc) ->
split_at(Byte, Rest, <<Acc/binary, B>>).
%% ── URL synthesis ──────────────────────────────────────────────
%% "http://" -> 7 bytes | "/actors/" -> 8 bytes
actor_url_for(User, Host) ->
Pre = <<104,116,116,112,58,47,47>>, % "http://"
Mid = <<47,97,99,116,111,114,115,47>>, % "/actors/"
<<Pre/binary, Host/binary, Mid/binary, User/binary>>.
%% ── webfinger JSON body ────────────────────────────────────────
%%
%% Mastodon-shape per RFC 7033:
%% {"subject":"acct:<user>@<host>",
%% "links":[{"rel":"self",
%% "type":"application/activity+json",
%% "href":"<actor_url>"}]}
%%
%% Hand-rolled byte concatenation — no JSON BIF on this port. The
%% caller has already validated User + Host; we don't need to
%% re-escape (Mastodon's webfinger inputs are alphanumeric +
%% .-_ in practice).
webfinger_body(User, Host, ActorUrl) ->
AcctPre = <<123,34,115,117,98,106,101,99,116,34,58,34,97,99,99,116,58>>, % '{"subject":"acct:'
AcctAt = <<64>>, % '@'
LinksHd = <<34,44,34,108,105,110,107,115,34,58,91,123,34,114,101,108,34,58,34,115,101,108,102,34,44,
34,116,121,112,101,34,58,34,97,112,112,108,105,99,97,116,105,111,110,47,97,99,116,
105,118,105,116,121,43,106,115,111,110,34,44,34,104,114,101,102,34,58,34>>, % '","links":[{"rel":"self","type":"application/activity+json","href":"'
LinksTl = <<34,125,93,125,10>>, % '"}]}\n'
<<AcctPre/binary, User/binary, AcctAt/binary, Host/binary,
LinksHd/binary, ActorUrl/binary, LinksTl/binary>>.

177
next/kernel/envelope.erl Normal file
View File

@@ -0,0 +1,177 @@
-module(envelope).
-export([validate_shape/1, get_field/2, canonical_bytes/1, verify_signature/2]).
%% Activity envelope per design §3.1.
%%
%% Erlang maps (#{...}) are not supported by this port, so envelopes
%% are represented as property lists of {atom_key, value} pairs. This
%% port's binary syntax also can't carry string literals; values that
%% would naturally be binaries in real Erlang are kept as atoms or
%% integer-segment binaries in the test corpus.
%%
%% Required fields: id, type, actor, published, signature.
%% The signature value is itself a property list with key_id,
%% algorithm, value.
%%
%% validate_shape/1 returns ok | {error, Reason}. Reasons:
%% not_a_proplist
%% {missing_field, FieldName}
%% {bad_signature, BadSigReason}
%%
%% get_field/2 returns {ok, Value} | not_found.
validate_shape(Env) when is_list(Env) ->
case check_required([id, type, actor, published, signature], Env) of
ok -> validate_signature_shape(Env);
Err -> Err
end;
validate_shape(_) ->
{error, not_a_proplist}.
get_field(_, []) -> not_found;
get_field(K, [{K, V} | _]) -> {ok, V};
get_field(K, [_ | Rest]) -> get_field(K, Rest).
check_required([], _) -> ok;
check_required([F | Rest], Env) ->
case get_field(F, Env) of
{ok, _} -> check_required(Rest, Env);
not_found -> {error, {missing_field, F}}
end.
validate_signature_shape(Env) ->
{ok, Sig} = get_field(signature, Env),
case is_list(Sig) of
true ->
case check_required([key_id, algorithm, value], Sig) of
ok -> ok;
{error, {missing_field, F}} ->
{error, {bad_signature, {missing_field, F}}}
end;
false ->
{error, {bad_signature, not_a_proplist}}
end.
%% canonical_bytes/1 — the byte string the signature covers.
%%
%% Real fed-sx will use dag-cbor over a JSON-LD-canonicalised form
%% (design §3.2). For milestone 1 we stand in for that with the host
%% BIF `cid:to_string/1`, which produces a CIDv1 over the deterministic
%% textual form of the term. Two prior steps make this work:
%% 1. The signature pair is stripped (sig covers everything except
%% itself).
%% 2. The top-level property list is sorted by key so field order in
%% the source envelope is not load-bearing.
%%
%% The result is an Erlang binary suitable as the sig-cover input.
canonical_bytes(Env) when is_list(Env) ->
Stripped = strip_signature(Env),
Sorted = sort_pairs(Stripped),
cid:to_string(Sorted).
strip_signature([]) -> [];
strip_signature([{signature, _} | Rest]) -> strip_signature(Rest);
strip_signature([P | Rest]) -> [P | strip_signature(Rest)].
sort_pairs([]) -> [];
sort_pairs([H | T]) -> insert_pair(H, sort_pairs(T)).
insert_pair(P, []) -> [P];
insert_pair({K1, V1}, [{K2, V2} | Rest]) ->
case K1 < K2 of
true -> [{K1, V1}, {K2, V2} | Rest];
false -> [{K2, V2} | insert_pair({K1, V1}, Rest)]
end.
%% verify_signature/2 — time-aware sig verification per design §9.6.
%%
%% Activity carries a `signature` proplist with `key_id`, `algorithm`,
%% `value`. ActorState carries `public_keys` — a list of key proplists
%% with `id`, `created`, optionally `superseded_at`, and `value` (the
%% key material).
%%
%% A key is active at time T iff `created =< T` AND
%% (no `superseded_at` OR T < `superseded_at`). Verification picks the
%% first matching active key whose `id == signature.key_id` at the
%% activity's `published` timestamp, then recomputes the MAC
%% `crypto:hash(sha256, <<KeyMaterial/binary, CanonicalBytes/binary>>)`
%% and compares it to `signature.value`.
%%
%% Returns ok | {error, Reason}. Reasons:
%% no_signature | no_key_id | no_published | no_keys |
%% no_active_key | bad_signature
%%
%% Real RSA-SHA256 / Ed25519 verification is deferred to milestone 2:
%% Phase 8 only ships `crypto:hash/2`, so we stand in with an HMAC-shaped
%% MAC that exercises the same key-lookup and canonical-bytes pipeline.
verify_signature(Activity, ActorState) ->
case get_field(signature, Activity) of
not_found -> {error, no_signature};
{ok, Sig} ->
case get_field(key_id, Sig) of
not_found -> {error, no_key_id};
{ok, KeyId} ->
case get_field(published, Activity) of
not_found -> {error, no_published};
{ok, Published} ->
verify_with_keys(Activity, Sig, KeyId,
Published, ActorState)
end
end
end.
verify_with_keys(Activity, Sig, KeyId, Published, ActorState) ->
case get_field(public_keys, ActorState) of
not_found -> {error, no_keys};
{ok, Keys} ->
case find_active_key(KeyId, Published, Keys) of
not_found -> {error, no_active_key};
{ok, Key} -> verify_mac(Activity, Sig, Key)
end
end.
find_active_key(_, _, []) -> not_found;
find_active_key(KeyId, Now, [Key | Rest]) ->
case is_matching_active_key(Key, KeyId, Now) of
true -> {ok, Key};
false -> find_active_key(KeyId, Now, Rest)
end.
is_matching_active_key(Key, WantId, Now) ->
case get_field(id, Key) of
{ok, WantId} -> is_active_at(Key, Now);
_ -> false
end.
is_active_at(Key, Now) ->
case get_field(created, Key) of
not_found -> false;
{ok, Created} ->
case Now >= Created of
false -> false;
true ->
case get_field(superseded_at, Key) of
not_found -> true;
{ok, SupAt} -> Now < SupAt
end
end
end.
verify_mac(Activity, Sig, Key) ->
case get_field(value, Sig) of
not_found -> {error, bad_signature};
{ok, SigValue} ->
case get_field(value, Key) of
not_found -> {error, bad_signature};
{ok, KeyMat} ->
Bytes = canonical_bytes(Activity),
Computed = crypto:hash(sha256,
<<KeyMat/binary, Bytes/binary>>),
case SigValue =:= Computed of
true -> ok;
false -> {error, bad_signature}
end
end
end.

View File

@@ -0,0 +1,237 @@
-module(follower_graph).
-export([fold/2, fold_fn/0, new/0, lookup/2, actors/1,
following/2, followers/2,
pending_outbound/2, pending_inbound/2,
is_following/3, has_follower/3,
is_pending_outbound/3, is_pending_inbound/3]).
%% Follower-graph projection — Erlang-fun stand-in for the genesis
%% `follower-graph.sx` body. Tracks per-actor follow relationships
%% per design §13.2:
%%
%% Follow {actor: A, object: B} A asks to follow B
%% Accept {actor: B, object: F} B accepts A's Follow F (= F.actor → F.object)
%% Reject {actor: B, object: F} B rejects A's Follow F
%% Undo {actor: A, object: F} A retracts F or unfollows
%%
%% Where F = Follow{A→B} is embedded as the activity's :object
%% proplist for Accept / Reject / Undo.
%%
%% State shape:
%% [{ActorId, ActorEntry}, ...]
%%
%% ActorEntry = [{following, [PeerId, ...]},
%% {followers, [PeerId, ...]},
%% {pending_outbound, [PeerId, ...]}, %% I asked, no answer yet
%% {pending_inbound, [PeerId, ...]}] %% asked me, I haven't answered
%%
%% Sets keep insertion order; duplicates aren't added. lists:keyfind/
%% keymember aren't in this substrate, so local find_keyed/has_keyed/
%% set_keyed helpers (same convention as actor_state, define_registry,
%% nx_kernel).
%% ── Public API ──────────────────────────────────────────────────
new() -> [].
actors(State) -> [Id || {Id, _Entry} <- State].
lookup(ActorId, State) ->
case find_keyed(ActorId, State) of
{ok, Entry} -> {ok, Entry};
_ -> not_found
end.
following(ActorId, State) -> entry_field(ActorId, following, State).
followers(ActorId, State) -> entry_field(ActorId, followers, State).
pending_outbound(ActorId, State) -> entry_field(ActorId, pending_outbound, State).
pending_inbound(ActorId, State) -> entry_field(ActorId, pending_inbound, State).
is_following(ActorId, PeerId, State) ->
contains(PeerId, following(ActorId, State)).
has_follower(ActorId, PeerId, State) ->
contains(PeerId, followers(ActorId, State)).
is_pending_outbound(ActorId, PeerId, State) ->
contains(PeerId, pending_outbound(ActorId, State)).
is_pending_inbound(ActorId, PeerId, State) ->
contains(PeerId, pending_inbound(ActorId, State)).
%% ── Fold dispatch ───────────────────────────────────────────────
fold(Activity, State) ->
case envelope:get_field(type, Activity) of
{ok, follow} -> fold_follow(Activity, State);
{ok, accept} -> fold_accept(Activity, State);
{ok, reject} -> fold_reject(Activity, State);
{ok, undo} -> fold_undo(Activity, State);
_ -> State
end.
fold_fn() ->
fun (Activity, State) -> fold(Activity, State) end.
%% Follow {actor: A, object: B}:
%% add B to A's pending_outbound
%% add A to B's pending_inbound
fold_follow(Activity, State) ->
case follow_actor_object(Activity) of
{ok, A, B} when A =/= B ->
S1 = add_to_field(A, pending_outbound, B, State),
add_to_field(B, pending_inbound, A, S1);
_ -> State
end.
%% Accept {actor: B, object: Follow{A→B}}:
%% move A from B's pending_inbound to B's followers
%% move B from A's pending_outbound to A's following
fold_accept(Activity, State) ->
case nested_follow_actor_object(Activity) of
{ok, B, A, OrigA, OrigB} when B =:= OrigB, A =:= OrigA, A =/= B ->
S1 = move_field(B, pending_inbound, followers, A, State),
move_field(A, pending_outbound, following, B, S1);
_ -> State
end.
%% Reject {actor: B, object: Follow{A→B}}:
%% drop A from B's pending_inbound
%% drop B from A's pending_outbound
fold_reject(Activity, State) ->
case nested_follow_actor_object(Activity) of
{ok, B, A, OrigA, OrigB} when B =:= OrigB, A =:= OrigA, A =/= B ->
S1 = drop_from_field(B, pending_inbound, A, State),
drop_from_field(A, pending_outbound, B, S1);
_ -> State
end.
%% Undo {actor: X, object: Follow{A→B}}:
%% Only the original Follow's actor (A) can Undo it.
%% Drops A↔B from every list on either side.
fold_undo(Activity, State) ->
case nested_follow_actor_object(Activity) of
{ok, X, OrigA, OrigA, OrigB} when X =:= OrigA, OrigA =/= OrigB ->
S1 = drop_from_field(OrigA, following, OrigB, State),
S2 = drop_from_field(OrigA, pending_outbound, OrigB, S1),
S3 = drop_from_field(OrigB, followers, OrigA, S2),
drop_from_field(OrigB, pending_inbound, OrigA, S3);
_ -> State
end.
%% ── Extraction helpers ─────────────────────────────────────────
follow_actor_object(Activity) ->
case envelope:get_field(actor, Activity) of
{ok, A} ->
case envelope:get_field(object, Activity) of
{ok, B} when is_atom(B) -> {ok, A, B};
_ -> not_follow
end;
_ -> not_follow
end.
%% nested_follow_actor_object/1 — pull (Actor, FollowActor, FollowObject)
%% out of an envelope whose :object is itself a Follow proplist.
%% Returns {ok, OuterActor, InferredPeer, InnerActor, InnerObject}.
nested_follow_actor_object(Activity) ->
case envelope:get_field(actor, Activity) of
{ok, Outer} ->
case envelope:get_field(object, Activity) of
{ok, Inner} when is_list(Inner) ->
case nested_is_follow(Inner) of
true ->
case {envelope:get_field(actor, Inner),
envelope:get_field(object, Inner)} of
{{ok, IA}, {ok, IO}} when is_atom(IO) ->
{ok, Outer, peer_from_inner(Outer, IA, IO), IA, IO};
_ -> not_a_follow_wrapper
end;
false -> not_a_follow_wrapper
end;
_ -> not_a_follow_wrapper
end;
_ -> not_a_follow_wrapper
end.
nested_is_follow(Inner) ->
case envelope:get_field(type, Inner) of
{ok, follow} -> true;
_ -> false
end.
%% peer_from_inner — for an Accept/Reject by B of Follow{A→B},
%% Outer = B; the "peer" we move state for is A. For an Undo by A,
%% Outer = A; the peer is B. Picking the inner actor/object that
%% isn't Outer gives us the right pair-mate.
peer_from_inner(Outer, IA, _IO) when Outer =:= IA -> IA;
peer_from_inner(_Outer, IA, _IO) -> IA.
%% ── Entry / field accessors ────────────────────────────────────
entry_field(ActorId, Field, State) ->
case find_keyed(ActorId, State) of
{ok, Entry} ->
case find_keyed(Field, Entry) of
{ok, Val} -> Val;
_ -> []
end;
_ -> []
end.
empty_entry() ->
[{following, []},
{followers, []},
{pending_outbound, []},
{pending_inbound, []}].
ensure_entry(ActorId, State) ->
case find_keyed(ActorId, State) of
{ok, _} -> State;
_ -> State ++ [{ActorId, empty_entry()}]
end.
add_to_field(ActorId, Field, PeerId, State) ->
S1 = ensure_entry(ActorId, State),
{ok, Entry} = find_keyed(ActorId, S1),
Current = entry_field(ActorId, Field, S1),
NewList = case contains(PeerId, Current) of
true -> Current;
false -> Current ++ [PeerId]
end,
NewEntry = set_keyed(Field, NewList, Entry),
set_keyed(ActorId, NewEntry, S1).
drop_from_field(ActorId, Field, PeerId, State) ->
case find_keyed(ActorId, State) of
{ok, Entry} ->
Current = entry_field(ActorId, Field, State),
NewList = remove_member(PeerId, Current),
NewEntry = set_keyed(Field, NewList, Entry),
set_keyed(ActorId, NewEntry, State);
_ -> State
end.
move_field(ActorId, FromField, ToField, PeerId, State) ->
S1 = drop_from_field(ActorId, FromField, PeerId, State),
add_to_field(ActorId, ToField, PeerId, S1).
%% ── List helpers ───────────────────────────────────────────────
contains(_, []) -> false;
contains(X, [X | _]) -> true;
contains(X, [_ | Rest]) -> contains(X, Rest).
remove_member(_, []) -> [];
remove_member(X, [X | Rest]) -> remove_member(X, Rest);
remove_member(X, [Y | Rest]) -> [Y | remove_member(X, Rest)].
%% ── Keyed-list helpers ─────────────────────────────────────────
find_keyed(_, []) -> {error, not_found};
find_keyed(K, [{K, V} | _]) -> {ok, V};
find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).
set_keyed(K, V, []) -> [{K, V}];
set_keyed(K, V, [{K, _} | Rest]) -> [{K, V} | Rest];
set_keyed(K, V, [P | Rest]) -> [P | set_keyed(K, V, Rest)].

1300
next/kernel/http_server.erl Normal file

File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More