Compare commits

..

99 Commits

Author SHA1 Message Date
070986913d fed-sx-m2: Step 9c — auto-Accept backfill drain + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
maybe_auto_accept/3 in http_server.erl now calls maybe_backfill/3
after the Accept publish. Flow:

  inbound Follow{actor: bob, object: alice, backfill: SPEC} lands
    -> pipeline ok -> append_inbox + broadcast (Step 6b)
    -> maybe_auto_accept fires (Step 6c)
       -> publish Accept{actor: alice, object: Follow} (Step 6c)
       -> maybe_backfill (Step 9c)
          -> backfill_enabled cfg gate
          -> :backfill present on Follow
          -> backfill:parse_mode -> Mode
          -> nx_kernel:log_state_for(alice) -> LogState
          -> backfill:slice(Mode, LogState, true) -> [Wrapped]
          -> deliver_backfill(bob, Slice):
               whereis(bob) cfg gate (peer worker registered)
               -> delivery_worker:enqueue(bob, A) for each

Cfg surface:
  {backfill_enabled, true}     gate the drain (default off)
  {auto_accept_follows, true}  Step 6c gate (required)

Each backfilled entry carries {backfilled, true} (per design §13.3,
:id preserved so the receiver's replay defence still catches the
forward-going copy).

6/6 in next/tests/backfill_drain.sh:
  - Follow with {backfill, {last_n, 2}} + 3 pre-published notes
    -> bob's delivery_worker has exactly 2 pending entries
  - Each entry carries {backfilled, true}
  - :backfill_enabled absent -> no drain (back-compat)
  - Follow without :backfill field -> no drain
  - Missing peer worker (no whereis) -> silently skipped + 202

Step 9 fully closed (9a slicing + 9b ?since route + 9c
Accept-drain). The live HTTP dispatch of the queued entries
still gates on Blockers #2 (httpc).
2026-06-07 07:01:55 +00:00
3629b2923f fed-sx-m2: Step 9b — outbox ?since=Cid pagination + 3 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
actor_outbox_response_for/3 in http_server.erl now reads ?since=
from the query string before paging:

  Q       = field(request_query, Cfg),
  Filtered = case parse_since(Q) of
      nil      -> Entries;
      SinceCid -> backfill:since_cid_entries(SinceCid, Entries)
  end,
  Slice = page_slice(Filtered, Page),
  ...

New helpers:
  parse_since/1   — scan query for since=<Cid>, value is the
                    binary up to next & or end-of-binary. nil
                    when absent.
  scan_param/2,3  — generic 'find Name=Value anywhere in &-sep
                    query'. Used for since= today; could be
                    factored over parse_page=.
  skip_to_amp/1   — walk past the next & for the iteration step.

Order-independent: ?since=X&page=2 and ?page=2&since=X both
work. Unknown cid -> backfill:since_cid_entries returns []
-> empty page -> body degrades to tip-only shape (Step 4d
back-compat).

Three new cases in http_multi_actor.sh (44/44 total):
  - ?since=<first cid> filters out the first publish, leaving
    2 of 3 items in the paged response
  - ?since=<unknown cid> -> empty page; body has tip but no
    item: lines (tip-only degrade)
  - ?since=<cid> + ?page=1 combined — pagination still applies
    to the filtered list

Latent issue surfaced + fixed in passing: http_multi_actor.sh
was missing follower_graph + delivery + backfill module loads
(outbox has depended on follower_graph + delivery since Step 7c
and now backfill from 9a). Added all three with epoch 100/101/
102 to match the c6b49200 fix-up pattern. 41 existing tests now
also exercise the live path through outbox:publish without
crashing on missing module deps.
2026-06-07 06:28:47 +00:00
9621599606 fed-sx-m2: Step 9a — pure-functional backfill slicing + 20 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
New next/kernel/backfill.erl owns the §13.3 backfill mode
slicing. Given an outbox log + a mode, returns the activity
list to send to a new follower as backfill.

Public API:
  slice/2(Mode, LogState)               default Wrap=false
  slice/3(Mode, LogState, Wrap)         Wrap=true wraps entries
  wrap_backfill/1                       add {backfilled, true}
  parse_mode/1                          lift Follow :backfill field

Modes:
  none                       new follower: forward-only content
  full                       entire outbox
  {last_n, N}                last N activities (FIFO)
  {last_t, T, NowFn}         entries with :published in
                             (NowFn()-T .. NowFn()]
  {since_cid, Cid}           entries after the one with :id = Cid
                             (consumes the matched entry; returns
                             every entry after it)

wrap_backfill/1 marks each entry {backfilled, true}. Per §13.3
wrapped bodies preserve :id so the receiver's replay defence
still catches duplicates from the live stream.

parse_mode/1 accepts:
  nil / none / full / {last_n, _} / {last_t, _, _} /
  {since_cid, _} — pass through or normalize
  Proplist with :mode + :limit -> {last_n, N}
  Proplist with :mode + :duration -> {last_t, T, fun() -> 0 end}
  Proplist with :mode = full -> full
  Anything else -> none (open-world default)

Substrate gotchas re-confirmed and worked around:
  - lists:nthtail/2 not registered — rolled drop_n/2
  - Pattern-alias 'Pat = Var' not supported by this port's
    parser — parse_mode/1 clauses use explicit deconstruction

20/20 in next/tests/backfill.sh covering all five modes plus
edge cases (N=0, N>length, T=0 -> empty window, since_cid
hit/miss/unknown), wrap_backfill semantics, parse_mode for
atoms / tuple shapes / proplists / unknown / nil.

Step 9b (outbox listing ?since=Cid&limit=N pagination) and
Step 9c (Follow-Accept-backfill wiring) layer on top.
Conformance preserved at 761/761.
2026-06-07 05:39:46 +00:00
b2b61a0112 fed-sx-m2: Step 11b — Announce + Endorse projection folds + 19 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Two new projection modules for the rich verbs landed in Step 11a:

  next/kernel/announce_state.erl
    Per-target-Cid announcer set.
    State: [{TargetCid, [AnnouncerActorId, ...]}, ...]
    Set semantics — duplicate Announce by the same actor on the
    same target is a no-op.

    Public API:
      new/0, fold/2, fold_fn/0
      announcers_for/2, announce_count/2, announced_cids/1
      has_announced/3

  next/kernel/endorsement_state.erl
    Per-target-Cid + per-kind + per-actor endorsement counter.
    State: [{TargetCid, [{Kind, [{ActorId, Count}, ...]}, ...]}, ...]
    Additive semantics — re-endorse by the same actor under the
    same kind bumps the counter. Undo{Endorse} retraction defers
    to a follow-up.

    Public API:
      new/0, fold/2, fold_fn/0
      counters_for/2, total_for/2, kinds_for/2
      endorsers_for/3, has_endorsed/4

Both fold_fn/0 returns a 2-arity Erlang fun for
projection:start_link/3 (same plug shape as actor_state /
follower_graph / delivery_state). Non-matching activity types
pass through unchanged.

Read-side accessors cover both enumeration (announcers_for,
endorsers_for) and predicates (has_announced, has_endorsed) so
the feed/timeline projection layer doesn't have to re-implement
that logic on every consumer.

19/19 in next/tests/rich_verbs.sh:

  announce_state:
    - new/0 -> []
    - Announce -> announcer added
    - Two announces same target -> both in set
    - Duplicate announce by same actor -> no-op
    - announce_count + announced_cids
    - has_announced predicate
    - fold_fn/0 is fun/2
    - Non-Announce activity passes through

  endorsement_state:
    - new/0 -> []
    - Endorse -> counter 1
    - Two likes by different actors -> total 2
    - like + share -> two kinds tracked
    - endorsers_for(Cid, Kind)
    - has_endorsed predicate
    - fold_fn/0 is fun/2
    - Non-Endorse activity passes through
    - Same actor endorsing twice -> total = 2 (additive)

Conformance preserved at 761/761.
2026-06-07 05:06:27 +00:00
80f6fc9279 fed-sx-m2: Step 11a — Announce + Endorse genesis activity-types + 4 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
Two new DefineActivity SX files in next/genesis/activity-types/
per design §13.5 / Step 11:

  announce.sx — Re-broadcast a peer's activity to followers.
    :object is the CID of the activity being announced.
    :schema requires :object to be a string.
    Followers see the Announce in their inbox; their projection
    decides whether to fetch the wrapped activity body.

  endorse.sx — Cross-actor signal on a target activity.
    :object is the target activity's CID; :kind is the
    endorsement variant (e.g. 'like', 'share').
    :schema requires both :object and :kind to be strings.
    Projections aggregate endorsements into counters / heat /
    ranking signals.

M1's Note object-type is unchanged — Create{Note{...}} is still
the publish path for short authored messages. The runtime-publish
demo (verb extensibility via Create{DefineActivity{...}} at
runtime) from M1 §9a continues to work; these files are the
genesis pre-shipped variants for v2 baseline so peers don't have
to negotiate verb definitions on first contact.

Manifest extended:
  :activity-types  3 -> 5 entries
  total genesis    34 -> 36 entries

Hardcoded count assertions bumped in:
  bootstrap_read.sh  (activity_types 3->5, first-section-count 3->5)
  bootstrap_load.sh  (activity_types 3->5)
  bootstrap_populate.sh (total 34->36, activity_types 3->5)
  bootstrap_start.sh (activity_types 3->5, total 34->36)

genesis_parse.sh +4 cases (head form + name for both files).
bootstrap_populate.sh internal sx_server timeout bumped
300s -> 600s to fit the larger genesis bundle.

61/61 in genesis_parse.sh, 15/15 in bootstrap_read.sh,
15/15 in bootstrap_load.sh, 14/14 in bootstrap_populate.sh,
12/12 in bootstrap_build.sh.
2026-06-07 04:38:32 +00:00
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
260 changed files with 18276 additions and 19111 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

@@ -571,12 +571,9 @@ and cek_run_with_io state =
Hashtbl.replace d "descent" (Number desc);
Dict d
| _ ->
let argsv = Sx_runtime.get_val request (String "args") in
(match Sx_persist_store.handle_op op argsv with
| Some resp -> resp
| None ->
let args = (match argsv with List l -> l | _ -> [argsv]) in
io_request op args)
let args = let a = Sx_runtime.get_val request (String "args") in
(match a with List l -> l | _ -> [a]) in
io_request op args
in
s := Sx_ref.cek_resume !s response;
loop ()
@@ -1543,12 +1540,7 @@ let rec dispatch env cmd =
| Some path -> load_library_file path | None -> ());
Nil
end
end else
(* durable-storage ops: service against on-disk store *)
let args = Sx_runtime.get_val request (String "args") in
(match Sx_persist_store.handle_op op args with
| Some resp -> resp
| None -> Nil (* non-import IO: resume with nil *)) in
end else Nil (* non-import IO: resume with nil *) in
s := Sx_ref.cek_resume !s response
done;
Sx_ref.cek_value !s
@@ -3901,10 +3893,7 @@ let http_mode port =
Dict d
| "io-sleep" | "sleep" -> Nil
| "import" -> Nil
| _ ->
(match Sx_persist_store.handle_op op args with
| Some resp -> resp
| None -> Nil));
| _ -> Nil);
(* Response cache — path → full HTTP response string.
Populated during pre-warm, serves cached responses in <0.1ms.
Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for

View File

@@ -1,293 +0,0 @@
(* sx_persist_store — host durable-storage adapter for lib/persist.
Production twin of `persist/serve` (lib/persist/durable.sx): it answers the
same `persist/...` IO ops, but backs them with real on-disk storage so writes
survive a process restart. Stateless-on-disk: every op reads/writes the
filesystem directly, so a fresh process recovers state with no warm-up — the
log on disk IS the state.
On-disk layout under the root dir (default ./persist-data, or $SX_PERSIST_DIR):
streams/<hex(stream)>.log append-only, one SX-serialized event per line
streams/<hex(stream)>.seq per-stream monotonic high-water counter (int)
kv/<hex(key)> one SX-serialized value per key
Invariants honoured (see plans/persist-on-sx.md Blocker spec):
1. last-seq is a per-stream monotonic counter stored in .seq, SEPARATE from
the rows — it keeps climbing across truncate, so a compacted stream never
reassigns a seq.
2. append never renumbers — the event already carries its :seq (log.sx does
last-seq+1); the host only bumps the high-water mark to max(hw, seq).
3. read returns surviving events in append order with :seq intact.
4. streams is the set of streams that ever had an append — keyed off the .seq
file, which truncate never deletes, so it survives full compaction.
5. values round-trip structurally via the SX serializer/parser. *)
open Sx_types
(* ---- root dir ---------------------------------------------------------- *)
let _root : string option ref = ref None
let set_root dir = _root := Some dir
let root_dir () =
match !_root with
| Some d -> d
| None -> (try Sys.getenv "SX_PERSIST_DIR" with Not_found -> "persist-data")
(* ---- filesystem helpers ------------------------------------------------ *)
let rec ensure_dir dir =
if dir = "" || dir = "." || dir = "/" || Sys.file_exists dir then ()
else begin
ensure_dir (Filename.dirname dir);
(try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ())
end
let streams_dir () = Filename.concat (root_dir ()) "streams"
let kv_dir () = Filename.concat (root_dir ()) "kv"
let blobs_dir () = Filename.concat (root_dir ()) "blobs"
let read_file path =
let ic = open_in_bin path in
let n = in_channel_length ic in
let s = really_input_string ic n in
close_in ic;
s
(* Atomic write: temp file in the same dir then rename over the target. *)
let write_file_atomic path contents =
ensure_dir (Filename.dirname path);
let tmp = path ^ ".tmp" in
let oc = open_out_bin tmp in
output_string oc contents;
flush oc;
close_out oc;
Sys.rename tmp path
let append_line path line =
ensure_dir (Filename.dirname path);
let oc = open_out_gen [Open_append; Open_creat; Open_wronly] 0o644 path in
output_string oc line;
output_char oc '\n';
close_out oc
(* ---- name <-> filename (hex, reversible, fs-safe) ---------------------- *)
let hex_encode s =
let b = Buffer.create (String.length s * 2) in
String.iter (fun c -> Buffer.add_string b (Printf.sprintf "%02x" (Char.code c))) s;
Buffer.contents b
let hex_decode s =
let n = String.length s / 2 in
String.init n (fun i -> Char.chr (int_of_string ("0x" ^ String.sub s (i * 2) 2)))
let stream_log stream = Filename.concat (streams_dir ()) (hex_encode stream ^ ".log")
let stream_seq stream = Filename.concat (streams_dir ()) (hex_encode stream ^ ".seq")
let kv_path key = Filename.concat (kv_dir ()) (hex_encode key)
(* ---- value <-> SX text (round-trips through Sx_parser) ----------------- *)
let escape_str s =
let len = String.length s in
let buf = Buffer.create (len + 16) in
for i = 0 to len - 1 do
match s.[i] with
| '"' -> Buffer.add_string buf "\\\""
| '\\' -> Buffer.add_string buf "\\\\"
| '\n' -> Buffer.add_string buf "\\n"
| '\r' -> Buffer.add_string buf "\\r"
| '\t' -> Buffer.add_string buf "\\t"
| c -> Buffer.add_char buf c
done;
Buffer.contents buf
let rec serialize = function
| Nil -> "nil"
| Bool true -> "true"
| Bool false -> "false"
| Integer n -> string_of_int n
| Number n -> format_number n
| String s -> "\"" ^ escape_str s ^ "\""
| Symbol s -> "(quote " ^ s ^ ")"
| Keyword k -> ":" ^ k
| List items | ListRef { contents = items } ->
"(list" ^ (List.fold_left (fun acc v -> acc ^ " " ^ serialize v) "" items) ^ ")"
| Dict d ->
let pairs = Hashtbl.fold (fun k v acc ->
(Printf.sprintf ":%s %s" k (serialize v)) :: acc) d [] in
"{" ^ String.concat " " (List.sort String.compare pairs) ^ "}"
| _ -> "nil"
(* Parse one serialized value back. Empty / blank -> Nil. *)
let rec deserialize line =
let line = String.trim line in
if line = "" then Nil
else match Sx_parser.parse_all line with
| v :: _ -> eval_quote_lists v
| [] -> Nil
(* serialize emits lists as `(list ...)` and symbols as `(quote s)` so the
parser yields data, not a call — but the parser leaves those as AST. Walk
the parsed AST and collapse `(list ...)`/`(quote s)` back to values. *)
and eval_quote_lists v =
match v with
| List (Symbol "quote" :: x :: []) -> x
| List (Symbol "list" :: rest) -> List (List.map eval_quote_lists rest)
| List items -> List (List.map eval_quote_lists items)
| ListRef { contents = items } -> List (List.map eval_quote_lists items)
| Dict d ->
let d' = Hashtbl.create (Hashtbl.length d) in
Hashtbl.iter (fun k v -> Hashtbl.replace d' k (eval_quote_lists v)) d;
Dict d'
| other -> other
(* ---- seq counter ------------------------------------------------------- *)
let read_seq stream =
let p = stream_seq stream in
if Sys.file_exists p then (try int_of_string (String.trim (read_file p)) with _ -> 0)
else 0
let write_seq stream n = write_file_atomic (stream_seq stream) (string_of_int n)
let value_to_int = function
| Integer n -> n
| Number n -> int_of_float n
| _ -> 0
let event_seq ev =
match ev with
| Dict d -> (match Hashtbl.find_opt d "seq" with Some v -> value_to_int v | None -> 0)
| _ -> 0
(* ---- ops --------------------------------------------------------------- *)
let do_append stream ev =
ensure_dir (streams_dir ());
(* bump the monotonic high-water mark; create .seq on first append so the
stream shows up in `streams` and survives later truncation. *)
let hw = read_seq stream in
let s = event_seq ev in
write_seq stream (max hw s);
append_line (stream_log stream) (serialize ev)
let do_read stream =
let p = stream_log stream in
if not (Sys.file_exists p) then List []
else begin
let content = read_file p in
let lines = String.split_on_char '\n' content in
let evs = List.filter_map (fun l ->
if String.trim l = "" then None else Some (deserialize l)) lines in
List evs
end
let do_last_seq stream = Number (float_of_int (read_seq stream))
let list_dir_suffix dir suffix =
if not (Sys.file_exists dir) then []
else
Array.to_list (Sys.readdir dir)
|> List.filter (fun f -> Filename.check_suffix f suffix)
|> List.map (fun f -> hex_decode (Filename.chop_suffix f suffix))
|> List.sort String.compare
let do_streams () = List (List.map (fun s -> String s) (list_dir_suffix (streams_dir ()) ".seq"))
(* drop events with seq <= n; the .seq high-water counter is untouched. *)
let do_truncate stream n =
let p = stream_log stream in
if Sys.file_exists p then begin
let evs = match do_read stream with List l -> l | _ -> [] in
let kept = List.filter (fun ev -> event_seq ev > n) evs in
let body = String.concat "" (List.map (fun ev -> serialize ev ^ "\n") kept) in
write_file_atomic p body
end
let do_kv_get key =
let p = kv_path key in
if Sys.file_exists p then deserialize (read_file p) else Nil
let do_kv_put key v =
ensure_dir (kv_dir ());
write_file_atomic (kv_path key) (serialize v)
let do_kv_delete key =
let p = kv_path key in
if Sys.file_exists p then (try Sys.remove p with _ -> ())
let do_kv_has key = Bool (Sys.file_exists (kv_path key))
let do_kv_keys () =
if not (Sys.file_exists (kv_dir ())) then List []
else
List (
Array.to_list (Sys.readdir (kv_dir ()))
|> List.map hex_decode
|> List.sort String.compare
|> List.map (fun s -> String s))
(* ---- blob store (content-addressed) ------------------------------------ *)
(* Same pattern as the persist ops, but a SEPARATE adapter: large objects live
in a content-addressed directory keyed by a CIDv1 (raw codec, sha2-256).
persist only ever stores the returned ref ({:cid :size :mime}), never bytes.
blob/put is idempotent — identical bytes hash to the same cid + same file. *)
let codec_raw = 0x55
let blob_cid bytes =
let digest = Sx_cid.unhex (Sx_sha2.sha256_hex bytes) in
Sx_cid.cidv1 codec_raw (Sx_cid.multihash Sx_cid.mh_sha2_256 digest)
let blob_path cid = Filename.concat (blobs_dir ()) cid
let do_blob_put bytes =
let cid = blob_cid bytes in
let p = blob_path cid in
if not (Sys.file_exists p) then write_file_atomic p bytes;
String cid
let do_blob_get cid =
let p = blob_path cid in
if Sys.file_exists p then String (read_file p) else Nil
let do_blob_has cid = Bool (Sys.file_exists (blob_path cid))
(* ---- dispatch ---------------------------------------------------------- *)
let arglist = function
| List l | ListRef { contents = l } -> l
| Nil -> []
| v -> [v]
(* Returns Some response if op is a persist op this store owns, None otherwise. *)
let handle_op op args =
let a = arglist args in
let str = function String s -> s | v -> value_to_string v in
match op with
| "persist/append" ->
(match a with stream :: ev :: _ -> do_append (str stream) ev | _ -> ()); Some Nil
| "persist/read" ->
(match a with stream :: _ -> Some (do_read (str stream)) | _ -> Some (List []))
| "persist/last-seq" ->
(match a with stream :: _ -> Some (do_last_seq (str stream)) | _ -> Some (Number 0.0))
| "persist/streams" -> Some (do_streams ())
| "persist/truncate" ->
(match a with stream :: n :: _ -> do_truncate (str stream) (value_to_int n) | _ -> ()); Some Nil
| "persist/kv-get" ->
(match a with key :: _ -> Some (do_kv_get (str key)) | _ -> Some Nil)
| "persist/kv-put" ->
(match a with key :: v :: _ -> do_kv_put (str key) v | _ -> ()); Some Nil
| "persist/kv-delete" ->
(match a with key :: _ -> do_kv_delete (str key) | _ -> ()); Some Nil
| "persist/kv-has?" ->
(match a with key :: _ -> Some (do_kv_has (str key)) | _ -> Some (Bool false))
| "persist/kv-keys" -> Some (do_kv_keys ())
| "blob/put" ->
(match a with bytes :: _ -> Some (do_blob_put (str bytes)) | _ -> Some Nil)
| "blob/get" ->
(match a with cid :: _ -> Some (do_blob_get (str cid)) | _ -> Some Nil)
| "blob/has?" ->
(match a with cid :: _ -> Some (do_blob_has (str cid)) | _ -> Some (Bool false))
| _ -> None

View File

@@ -1,144 +0,0 @@
#!/usr/bin/env bash
# hosts/ocaml/test/persist_durable_test.sh
# Acceptance test for the host durable-storage adapter (Sx_persist_store).
#
# Exercises `persist/durable-backend` (REAL `perform`, not the mock) under the
# WORKTREE-built sx_server.exe, and asserts:
# 1. durable: writes land on disk and read back (the silent-data-loss repro
# from plans/persist-on-sx.md now returns correct values).
# 2. last-seq is monotonic across truncate (compaction never reassigns a seq).
# 3. kv ops round-trip and delete.
# 4. recovery: a REAL process restart (write, exit, fresh process, replay)
# recovers state from disk.
#
# Run from repo root or anywhere; locates the worktree binary relative to itself.
set -uo pipefail
HERE="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)"
ROOT="$(cd "$HERE/../../.." && pwd)" # repo/worktree root
cd "$ROOT"
SX="hosts/ocaml/_build/default/bin/sx_server.exe"
if [ ! -x "$SX" ]; then
echo "ERROR: worktree binary not found at $SX — build it first:" >&2
echo " (cd hosts/ocaml && dune build bin/sx_server.exe)" >&2
exit 1
fi
DATADIR="$(mktemp -d)"
trap 'rm -rf "$DATADIR"' EXIT
PASS=0
FAIL=0
check() { # check <label> <got> <expected>
if [ "$2" = "$3" ]; then
PASS=$((PASS + 1)); printf ' ok %-40s => %s\n' "$1" "$2"
else
FAIL=$((FAIL + 1)); printf ' FAIL %-40s got [%s] want [%s]\n' "$1" "$2" "$3"
fi
}
PRELUDE='(epoch 1)
(load "spec/stdlib.sx")
(load "lib/r7rs.sx")
(load "lib/persist/event.sx")
(load "lib/persist/backend.sx")
(load "lib/persist/log.sx")
(load "lib/persist/kv.sx")
(load "lib/persist/durable.sx")
(load "lib/persist/blob.sx")
(epoch 2)'
# run_eval <sx-expr-string>: prints the final (ok-len 2 ...) payload line.
run_eval() {
local expr="$1"
printf '%s\n(eval %s)\n' "$PRELUDE" "$expr" \
| SX_PERSIST_DIR="$DATADIR" timeout 60 "$SX" 2>/dev/null \
| awk '/^\(ok-len 2 / {getline; print; exit}'
}
# escape an SX program into a single-line double-quoted SX string literal for
# (eval "..."). The REPL reads one command per physical line, so newlines in the
# program are collapsed to spaces.
q() { printf '"%s"' "$(printf '%s' "$1" | tr '\n' ' ' | sed 's/\\/\\\\/g; s/"/\\"/g')"; }
echo "== durable: append/read/last-seq round-trip on disk =="
GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
(begin
(persist/append b "s" "x" 0 {:v 1})
(persist/append b "s" "x" 0 {:v 2})
(list (persist/event-seq (persist/append b "s" "x" 0 {:v 3}))
(persist/count b "s")
(len (persist/read b "s")))))')")
check "append/count/read" "$GOT" "(3 3 3)"
echo "== last-seq monotonic across truncate =="
GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
(begin
(persist/append b "t" "x" 0 {})
(persist/append b "t" "x" 0 {})
(persist/append b "t" "x" 0 {})
(persist/truncate b "t" 2)
(list (persist/last-seq b "t") (persist/count b "t"))))')")
check "last-seq survives truncate" "$GOT" "(3 1)"
echo "== streams set survives compaction =="
GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
(sort ((get b "streams"))))')")
check "streams" "$GOT" '("s" "t")'
echo "== kv round-trip + delete =="
GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
(begin
(persist/kv-put b "k" {:a 1 :b "two"})
(persist/kv-put b "gone" 9)
(persist/kv-delete b "gone")
(list (get (persist/kv-get b "k") :b)
(persist/kv-has? b "k")
(persist/kv-has? b "gone"))))')")
check "kv get/has/delete" "$GOT" '("two" true false)'
echo "== recovery: state survives a REAL process restart =="
# write in process A then let it exit; the next run is a brand-new process.
run_eval "$(q '(let ((b (persist/durable-backend)))
(begin
(persist/append b "r" "ev" 0 {:n 1})
(persist/append b "r" "ev" 0 {:n 2})
(persist/kv-put b "survive" "yes")
(persist/count b "r")))')" >/dev/null
# fresh process, same SX_PERSIST_DIR — must replay from disk.
GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
(list (persist/count b "r")
(persist/last-seq b "r")
(get (get (nth (persist/read b "r") 1) :data) :n)
(persist/kv-get b "survive")))')")
check "recovered after restart" "$GOT" '(2 2 2 "yes")'
echo "== blob: content-addressed put/get/has? round-trip =="
GOT=$(run_eval "$(q '(let ((bs (persist/blob-store-backend)))
(let ((r (persist/blob-store bs "hello world" "text/plain")))
(list (persist/blob-size r)
(persist/blob-mime r)
(persist/blob-fetch bs r)
(persist/blob-exists? bs r))))')")
check "blob size/mime/fetch/exists" "$GOT" '(11 "text/plain" "hello world" true)'
echo "== blob: put is content-addressed (idempotent cid) =="
GOT=$(run_eval "$(q '(let ((bs (persist/blob-store-backend)))
(equal? (persist/blob-cid (persist/blob-store bs "same bytes" "x"))
(persist/blob-cid (persist/blob-store bs "same bytes" "x"))))')")
check "same bytes -> same cid" "$GOT" "true"
echo "== blob: bytes + ref-in-kv survive a REAL restart =="
# process A: store a blob, keep only its ref in the durable kv.
run_eval "$(q '(let ((b (persist/durable-backend)) (bs (persist/blob-store-backend)))
(begin (persist/kv-put b "logo" (persist/blob-store bs "PNGDATA" "image/png")) nil))')" >/dev/null
# fresh process: read the ref from kv, fetch the bytes from the blob store.
GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)) (bs (persist/blob-store-backend)))
(let ((r (persist/kv-get b "logo")))
(list (persist/blob-fetch bs r) (persist/blob-exists? bs r) (persist/blob-mime r))))')")
check "blob recovered via ref after restart" "$GOT" '("PNGDATA" true "image/png")'
echo
echo "durable adapter: $PASS passed, $FAIL failed"
[ "$FAIL" -eq 0 ]

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

View File

@@ -1,10 +0,0 @@
; persist/api — the public entry point. persist/open returns a backend (the
; in-memory one by default; pass a custom backend to inject file/pg/ipfs-ref).
; All facet functions take this backend as their first argument.
; Requires: lib/persist/backend.sx, lib/persist/log.sx, lib/persist/kv.sx.
(define
persist/open
(fn
(&rest args)
(if (= (len args) 0) (persist/mem-backend) (first args))))

View File

@@ -1,34 +0,0 @@
; persist/backend — the injected storage protocol. Every facet (log, kv,
; snapshot) goes through a backend dict, never touching storage directly, so
; file/pg/ipfs-ref backends swap in unchanged. A backend is a dict of fns:
; {:append :read :last-seq :truncate-through :streams
; :kv-get :kv-put :kv-delete :kv-has? :kv-keys}
; The in-memory backend is the test default. State is three dicts held in a
; closure and mutated with set!: logs (stream -> event list), seqs (stream ->
; last assigned seq — a monotonic high-water mark that survives compaction so
; truncating the log prefix never lets a future append reuse a seq), kv. The
; stream catalog comes from seqs, so a fully-compacted stream still lists.
(define
persist/mem-backend
(fn
()
(let ((logs {}) (seqs {}) (kv {})) {:truncate-through (fn (stream n) (let ((cur (get logs stream))) (set! logs (assoc logs stream (filter (fn (e) (> (persist/event-seq e) n)) (if cur cur (list))))))) :kv-keys (fn () (keys kv)) :read (fn (stream) (let ((cur (get logs stream))) (if cur cur (list)))) :kv-has? (fn (key) (has-key? kv key)) :last-seq (fn (stream) (let ((s (get seqs stream))) (if s s 0))) :streams (fn () (keys seqs)) :append (fn (stream event) (begin (let ((cur (get logs stream))) (set! logs (assoc logs stream (append (if cur cur (list)) event)))) (set! seqs (assoc seqs stream (persist/event-seq event))))) :kv-delete (fn (key) (set! kv (dissoc kv key))) :kv-put (fn (key val) (set! kv (assoc kv key val))) :kv-get (fn (key) (get kv key))})))
; protocol accessors — call a backend op by keyword
(define
persist/backend-append
(fn (b stream event) ((get b :append) stream event)))
(define persist/backend-read (fn (b stream) ((get b :read) stream)))
(define
persist/backend-last-seq
(fn (b stream) ((get b :last-seq) stream)))
(define persist/backend-streams (fn (b) ((get b :streams))))
(define
persist/backend-truncate
(fn (b stream n) ((get b :truncate-through) stream n)))
(define persist/backend-kv-get (fn (b key) ((get b :kv-get) key)))
(define persist/backend-kv-put (fn (b key val) ((get b :kv-put) key val)))
(define persist/backend-kv-delete (fn (b key) ((get b :kv-delete) key)))
(define persist/backend-kv-has? (fn (b key) ((get b :kv-has?) key)))
(define persist/backend-kv-keys (fn (b) ((get b :kv-keys))))

View File

@@ -1,40 +0,0 @@
; persist/batch — commit several events to a stream as one contiguous block.
; Each spec is (type at data). Plain append-batch always appends; the -expect
; form is the transactional commit: it checks the stream is still at `expected`
; before writing ANY event, so a batch is all-or-nothing under a concurrent
; writer (conflict is a value, not a partial write). For an order + its line
; items, an audit entry + its reason, etc. Requires: lib/persist/log.sx.
; append a list of (type at data) specs as one block; returns the stored events
; (a real cons-list, in order, with contiguous seqs)
(define
persist/append-batch
(fn
(b stream specs)
(reverse
(reduce
(fn
(acc spec)
(cons
(persist/append
b
stream
(first spec)
(nth spec 1)
(nth spec 2))
acc))
(list)
specs))))
; transactional batch: commit all specs only if the stream is still at expected,
; else return a conflict and write nothing
(define
persist/append-batch-expect
(fn
(b stream expected specs)
(let
((actual (persist/last-seq b stream)))
(if
(= actual expected)
(persist/append-batch b stream specs)
{:actual actual :expected expected :conflict true}))))

View File

@@ -1,66 +0,0 @@
; persist/blob — large objects (images, media) are NOT persist's to hold. They
; live in a content-addressed store (artdag/IPFS); persist stores only a
; reference: {:cid :size :mime}. The blob store is a SEPARATE injected
; dependency with its own transport (perform in production, a mock content store
; in tests), distinct from the event/kv backend. The invariant: a blob ref that
; lands in the log or kv carries the CID + metadata and never the bytes.
; Requires: lib/persist/backend.sx.
(define persist/blob-ref (fn (cid size mime) {:mime mime :size size :cid cid}))
(define persist/blob-ref? (fn (r) (has-key? r :cid)))
(define persist/blob-cid (fn (r) (get r :cid)))
(define persist/blob-size (fn (r) (get r :size)))
(define persist/blob-mime (fn (r) (get r :mime)))
; blob store protocol over an injectable transport
(define persist/blob-io (fn (transport) {:put (fn (bytes mime) (transport {:op "blob/put" :args (list bytes mime)})) :get (fn (cid) (transport {:op "blob/get" :args (list cid)})) :has? (fn (cid) (transport {:op "blob/has?" :args (list cid)}))}))
; production blob store — transport is the kernel's perform
(define
persist/blob-store-backend
(fn () (persist/blob-io (fn (req) (perform req)))))
; store bytes via the blob backend; return ONLY the ref (cid + metadata) — this
; is what the caller persists in the log/kv. The bytes never enter persist.
(define
persist/blob-store
(fn
(blob bytes mime)
(let
((cid ((get blob :put) bytes mime)))
(persist/blob-ref cid (len bytes) mime))))
(define
persist/blob-fetch
(fn (blob ref) ((get blob :get) (persist/blob-cid ref))))
(define
persist/blob-exists?
(fn (blob ref) ((get blob :has?) (persist/blob-cid ref))))
; mock content-addressed store (stands in for artdag/IPFS). CID is a
; deterministic content address: identical bytes dedupe to one CID. A real
; store computes a SHA3/IPFS CID host-side; the prefix keeps the mock readable.
(define persist/blob-cid-of (fn (bytes) (str "cid:" bytes)))
(define
persist/blob-serve
(fn
(store req)
(let
((op (get req :op)) (args (get req :args)))
(cond
((equal? op "blob/put")
(let
((cid (persist/blob-cid-of (first args))))
(begin (persist/backend-kv-put store cid (first args)) cid)))
((equal? op "blob/get") (persist/backend-kv-get store (first args)))
((equal? op "blob/has?")
(persist/backend-kv-has? store (first args)))
(else (error (str "persist/blob-serve: unknown op " op)))))))
(define
persist/blob-mock-transport
(fn (store) (fn (req) (persist/blob-serve store req))))
(define
persist/mock-blob
(fn (store) (persist/blob-io (persist/blob-mock-transport store))))

View File

@@ -1,35 +0,0 @@
; persist/catalog — enumerate the streams a backend holds. The catalog is the
; set of streams ever appended to (from the seq high-water marks), so a stream
; whose log has been fully compacted still appears. $-prefixed streams are
; reserved for internal indexes (e.g. the $global commit index) and are hidden
; from the public catalog; use streams-all to see them. For admin, global ops,
; and cross-stream tooling. Requires: lib/persist/backend.sx, lib/persist/log.sx.
(define persist/reserved-stream? (fn (s) (starts-with? s "$")))
; every stream including reserved internal indexes
(define persist/streams-all (fn (b) (persist/backend-streams b)))
; public streams (reserved internal indexes hidden)
(define
persist/streams
(fn
(b)
(filter
(fn (s) (not (persist/reserved-stream? s)))
(persist/streams-all b))))
(define persist/stream-count (fn (b) (len (persist/streams b))))
(define
persist/stream-exists?
(fn (b stream) (contains? (persist/streams b) stream)))
; total logical events across all public streams (sum of high-water marks)
(define
persist/total-events
(fn
(b)
(reduce
(fn (acc s) (+ acc (persist/last-seq b s)))
0
(persist/streams b))))

View File

@@ -1,43 +0,0 @@
; persist/compaction — once a snapshot subsumes a log prefix, those events are
; dead weight: replay starts from the snapshot, so events with seq <= the
; snapshot's seq are never folded again. Compaction checkpoints then truncates
; that prefix. The seq counter is monotonic (backend high-water mark) so future
; appends keep climbing — the surviving tail keeps its original seqs and replay
; from the snapshot still equals a full replay of the pre-compaction log.
; Policy is explicit: compact when the uncompacted tail reaches `every` events.
; Requires: lib/persist/snapshot.sx, lib/persist/log.sx.
; events accumulated since the last snapshot for name
(define
persist/uncompacted
(fn
(b stream name seed)
(-
(persist/last-seq b stream)
(persist/project-seq (persist/snapshot-load b name seed)))))
; policy: should we compact yet? tail since snapshot >= every
(define
persist/should-compact?
(fn
(b stream name every seed)
(>= (persist/uncompacted b stream name seed) every)))
; checkpoint then drop the snapshotted prefix; returns the new snapshot state
(define
persist/compact
(fn
(b stream name step seed)
(let
((state (persist/checkpoint b stream name step seed)))
(begin (persist/truncate b stream (persist/project-seq state)) state))))
; compact only if the policy fires; always returns the current snapshot state
(define
persist/maybe-compact
(fn
(b stream name step seed every)
(if
(persist/should-compact? b stream name every seed)
(persist/compact b stream name step seed)
(persist/snapshot-load b name seed))))

View File

@@ -1,24 +0,0 @@
; persist/concurrency — optimistic concurrency for the log facet. The caller
; passes the seq it believes is current (the last-seq it last observed). If the
; stream has advanced since, the append is refused and a conflict VALUE is
; returned — never a crash, never a silent overwrite. The caller re-reads the
; tail and retries. This is the substrate-level answer to "two writers, one
; stream": the loser gets a result it can act on.
; Requires: lib/persist/log.sx.
(define
persist/append-expect
(fn
(b stream expected type at data)
(let
((actual (persist/last-seq b stream)))
(if
(= actual expected)
(persist/append b stream type at data)
{:actual actual :expected expected :conflict true}))))
(define
persist/conflict?
(fn (r) (if (has-key? r :conflict) (get r :conflict) false)))
(define persist/conflict-expected (fn (r) (get r :expected)))
(define persist/conflict-actual (fn (r) (get r :actual)))

View File

@@ -1,128 +0,0 @@
#!/usr/bin/env bash
# lib/persist/conformance.sh — run persist 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=(event log kv project subscribe concurrency snapshot compaction durable blob view cas catalog query batch upcast idempotency global example-acl recovery)
OUT_JSON="lib/persist/scoreboard.json"
OUT_MD="lib/persist/scoreboard.md"
run_suite() {
local suite=$1
local file="lib/persist/tests/${suite}.sx"
local TMP
TMP=$(mktemp)
cat > "$TMP" << EPOCHS
(epoch 1)
(load "spec/stdlib.sx")
(load "lib/r7rs.sx")
(load "lib/persist/event.sx")
(load "lib/persist/backend.sx")
(load "lib/persist/log.sx")
(load "lib/persist/kv.sx")
(load "lib/persist/project.sx")
(load "lib/persist/concurrency.sx")
(load "lib/persist/snapshot.sx")
(load "lib/persist/compaction.sx")
(load "lib/persist/durable.sx")
(load "lib/persist/blob.sx")
(load "lib/persist/view.sx")
(load "lib/persist/catalog.sx")
(load "lib/persist/query.sx")
(load "lib/persist/batch.sx")
(load "lib/persist/upcast.sx")
(load "lib/persist/idempotency.sx")
(load "lib/persist/global.sx")
(load "lib/persist/examples/acl.sx")
(load "lib/persist/subscribe.sx")
(load "lib/persist/api.sx")
(epoch 2)
(eval "(define persist-test-pass 0)")
(eval "(define persist-test-fail 0)")
(eval "(define persist-test (fn (name got expected) (if (equal? got expected) (set! persist-test-pass (+ persist-test-pass 1)) (set! persist-test-fail (+ persist-test-fail 1)))))")
(epoch 3)
(load "${file}")
(epoch 4)
(eval "(list persist-test-pass persist-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 persist 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 '# persist Conformance Scoreboard\n\n'
printf '_Generated by `lib/persist/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,71 +0,0 @@
; persist/durable — a backend whose every op crosses the kernel's IO-suspension
; boundary. Each op performs an IO request {:op "persist/..." :args (...)};
; under the real kernel `perform` suspends the CEK machine and the host (file,
; pg, ipfs-ref) services the request and resumes with the result — so the facet
; code above (log/kv/project/snapshot/compaction) never changes. The TRANSPORT
; is injectable: production passes the kernel's perform; tests pass a mock
; servicer over an in-memory disk. Same request shapes either way, so the whole
; existing facet stack runs unchanged on the mock-durable backend.
; Requires: lib/persist/backend.sx.
; request encoders — the exact payloads the durable backend performs
(define persist/req-append (fn (stream event) {:op "persist/append" :args (list stream event)}))
(define persist/req-read (fn (stream) {:op "persist/read" :args (list stream)}))
(define persist/req-last-seq (fn (stream) {:op "persist/last-seq" :args (list stream)}))
(define persist/req-streams (fn () {:op "persist/streams" :args (list)}))
(define persist/req-truncate (fn (stream n) {:op "persist/truncate" :args (list stream n)}))
(define persist/req-kv-get (fn (key) {:op "persist/kv-get" :args (list key)}))
(define persist/req-kv-put (fn (key val) {:op "persist/kv-put" :args (list key val)}))
(define persist/req-kv-delete (fn (key) {:op "persist/kv-delete" :args (list key)}))
(define persist/req-kv-has? (fn (key) {:op "persist/kv-has?" :args (list key)}))
(define persist/req-kv-keys (fn () {:op "persist/kv-keys" :args (list)}))
; a backend parameterized over a transport (req -> response)
(define persist/io-backend (fn (transport) {:truncate-through (fn (stream n) (transport (persist/req-truncate stream n))) :kv-keys (fn () (transport (persist/req-kv-keys))) :read (fn (stream) (transport (persist/req-read stream))) :kv-has? (fn (key) (transport (persist/req-kv-has? key))) :last-seq (fn (stream) (transport (persist/req-last-seq stream))) :streams (fn () (transport (persist/req-streams))) :append (fn (stream event) (transport (persist/req-append stream event))) :kv-delete (fn (key) (transport (persist/req-kv-delete key))) :kv-put (fn (key val) (transport (persist/req-kv-put key val))) :kv-get (fn (key) (transport (persist/req-kv-get key)))}))
; production backend — transport is the kernel's perform (suspends; host resumes)
(define
persist/durable-backend
(fn () (persist/io-backend (fn (req) (perform req)))))
; reference host: service one request against a disk (any backend protocol impl).
; This is what a real host plugs into the kernel's IO resolver, and the mock-IO
; harness for tests: it never touches a real disk, just an in-memory backend.
(define
persist/serve
(fn
(disk req)
(let
((op (get req :op)) (args (get req :args)))
(cond
((equal? op "persist/append")
(persist/backend-append disk (first args) (nth args 1)))
((equal? op "persist/read")
(persist/backend-read disk (first args)))
((equal? op "persist/last-seq")
(persist/backend-last-seq disk (first args)))
((equal? op "persist/streams") (persist/backend-streams disk))
((equal? op "persist/truncate")
(persist/backend-truncate disk (first args) (nth args 1)))
((equal? op "persist/kv-get")
(persist/backend-kv-get disk (first args)))
((equal? op "persist/kv-put")
(persist/backend-kv-put disk (first args) (nth args 1)))
((equal? op "persist/kv-delete")
(persist/backend-kv-delete disk (first args)))
((equal? op "persist/kv-has?")
(persist/backend-kv-has? disk (first args)))
((equal? op "persist/kv-keys") (persist/backend-kv-keys disk))
(else (error (str "persist/serve: unknown op " op)))))))
; mock transport: a perform-replacement that services against a disk in-process
(define
persist/mock-transport
(fn (disk) (fn (req) (persist/serve disk req))))
; a durable backend wired to a mock disk — exercises the full io-backend path
; (request-encode -> serve -> disk) with no suspension, so the existing facet
; suite runs against it unchanged.
(define
persist/mock-durable
(fn (disk) (persist/io-backend (persist/mock-transport disk))))

View File

@@ -1,13 +0,0 @@
; persist/event — an event is the unit of the log facet:
; {:stream :seq :type :at :data}
; stream = which append-only stream, seq = 1-based position within it,
; type = event kind, at = caller-supplied timestamp (never a clock here:
; replay must stay pure), data = payload dict.
(define persist/event (fn (stream seq type at data) {:data data :type type :at at :stream stream :seq seq}))
(define persist/event-stream (fn (e) (get e :stream)))
(define persist/event-seq (fn (e) (get e :seq)))
(define persist/event-type (fn (e) (get e :type)))
(define persist/event-at (fn (e) (get e :at)))
(define persist/event-data (fn (e) (get e :data)))

View File

@@ -1,79 +0,0 @@
; persist/examples/acl — a WORKED MIGRATION REFERENCE. A subsystem (acl grants:
; who may access what) currently hand-rolls an in-memory mutable map that loses
; every grant on restart and keeps no audit trail. This shows the same subsystem
; rebuilt on persist. It is the template other subsystem loops copy; it does NOT
; touch the real lib/acl (out of this loop's scope).
;
; BEFORE — hand-rolled, ephemeral, no history, no concurrency safety:
; (define acl-grants {}) ; resource -> principal list (mutable)
; (define acl-grant! (fn (r p) (set! acl-grants (assoc acl-grants r (cons p (get acl-grants r))))))
; (define acl-revoke! (fn (r p) (set! acl-grants (assoc acl-grants r (remove p ...)))))
; (define acl-can? (fn (r p) (contains? (get acl-grants r) p)))
; ;; vanishes on restart; "when/why was X granted?" is unanswerable.
;
; AFTER — on persist. Grants/revokes are EVENTS (history matters), the current
; grant set is a PROJECTION, checks read a materialized VIEW, and the audit trail
; is a time-windowed query. Every fn takes a backend `b`, so the same code runs
; on the in-memory backend today and the durable backend unchanged.
; Requires: lib/persist/log.sx, lib/persist/project.sx, lib/persist/view.sx,
; lib/persist/query.sx.
(define acl/stream (fn (resource) (str "acl/" resource)))
; write side — grant/revoke append events (the history is the source of truth)
(define
acl/grant
(fn
(b resource principal at)
(persist/append b (acl/stream resource) "granted" at {:principal principal})))
(define
acl/revoke
(fn
(b resource principal at)
(persist/append b (acl/stream resource) "revoked" at {:principal principal})))
; fold step: grant adds a principal (once), revoke removes it
(define
acl/step
(fn
(set e)
(let
((p (get (persist/event-data e) :principal)))
(if
(equal? (persist/event-type e) "granted")
(if (contains? set p) set (append set p))
(filter (fn (x) (not (equal? x p))) set)))))
; read side — current grant set + membership check (replays the log)
(define
acl/grants
(fn
(b resource)
(persist/project-fold b (acl/stream resource) acl/step (list))))
(define
acl/can?
(fn (b resource principal) (contains? (acl/grants b resource) principal)))
; materialized view — attach to a hub for O(1) checks that stay current on write
(define
acl/view
(fn
(resource)
(persist/view
(str "acl-current/" resource)
(acl/stream resource)
acl/step
(list))))
(define
acl/can-fast?
(fn
(b resource principal)
(contains? (persist/view-peek b (acl/view resource)) principal)))
; audit — grants/revokes for a resource in a time window (the new capability the
; hand-rolled version could never answer)
(define
acl/audit-window
(fn
(b resource from to)
(persist/read-window b (acl/stream resource) from to)))

View File

@@ -1,55 +0,0 @@
; persist/global — a global commit ordering across streams. Per-stream seqs only
; order within a stream; a unified timeline (e.g. feed's home feed, a global
; audit trail) needs a single order across streams. `persist/gappend` appends to
; the target stream and then records a pointer in a reserved $global index whose
; own seq IS the global commit position. Reading the index in order and
; resolving each pointer yields every event in commit order. This is opt-in:
; streams that don't need global ordering use plain persist/append and never
; touch $global. Determinism: the order is the $global append order, replayed
; identically. Requires: lib/persist/log.sx, lib/persist/catalog.sx.
(define persist/global-stream "$global")
; append with a global commit position. Returns the stored stream event; the
; event's global position is the seq of its pointer in $global.
(define
persist/gappend
(fn
(b stream type at data)
(let
((ev (persist/append b stream type at data)))
(begin (persist/append b persist/global-stream "ref" at {:stream stream :seq (persist/event-seq ev)}) ev))))
; the global index: pointer events in commit order (each pointer's seq = gpos)
(define persist/global-log (fn (b) (persist/read b persist/global-stream)))
; the current global commit position (count of globally-ordered appends)
(define
persist/global-pos
(fn (b) (persist/last-seq b persist/global-stream)))
; resolve a pointer event to the actual stream event it references
(define
persist/resolve-ref
(fn
(b ptr)
(let
((d (persist/event-data ptr)))
(first (persist/read-from b (get d :stream) (get d :seq))))))
; every globally-ordered event, in commit order
(define
persist/read-global
(fn
(b)
(map (fn (ptr) (persist/resolve-ref b ptr)) (persist/global-log b))))
; pointer events at or after a global position (incremental global consumers)
(define
persist/global-from
(fn (b gpos) (persist/read-from b persist/global-stream gpos)))
; fold over all events in global commit order
(define
persist/project-global
(fn (b step seed) (reduce step seed (persist/read-global b))))

View File

@@ -1,28 +0,0 @@
; persist/idempotency — exactly-once append under retries. A command retried
; after a network blip must not append its event twice. The caller supplies an
; idempotency key; the first append for that (stream, key) stores the event and
; remembers the key in the kv facet; a repeat returns the SAME event without
; appending. Because the marker lives in kv, idempotency holds across a restart
; too. Keyed per stream. Requires: lib/persist/log.sx, lib/persist/kv.sx.
(define persist/idem-key (fn (stream key) (str "idem/" stream "/" key)))
; true if an append-once has already been recorded for (stream, key)
(define
persist/seen?
(fn (b stream key) (persist/kv-has? b (persist/idem-key stream key))))
; append at most once per (stream, key). Returns the stored event either way —
; freshly appended on first use, the remembered one on a repeat.
(define
persist/append-once
(fn
(b stream key type at data)
(let
((k (persist/idem-key stream key)))
(if
(persist/kv-has? b k)
(persist/kv-get b k)
(let
((ev (persist/append b stream type at data)))
(begin (persist/kv-put b k ev) ev))))))

View File

@@ -1,44 +0,0 @@
; persist/kv — the kv facet: current-state values, no history. For things
; whose history does NOT matter (stock counts, config, profiles, session
; blobs) and where projections materialize their read models.
; Requires: lib/persist/backend.sx.
(define persist/kv-get (fn (b key) (persist/backend-kv-get b key)))
(define
persist/kv-put
(fn (b key val) (begin (persist/backend-kv-put b key val) val)))
(define persist/kv-delete (fn (b key) (persist/backend-kv-delete b key)))
(define persist/kv-has? (fn (b key) (persist/backend-kv-has? b key)))
(define persist/kv-keys (fn (b) (persist/backend-kv-keys b)))
; get with a default when the key is absent
(define
persist/kv-get-or
(fn
(b key dflt)
(if (persist/kv-has? b key) (persist/kv-get b key) dflt)))
; read-modify-write: apply f to the current value (or dflt if absent), store result
(define
persist/kv-update
(fn
(b key dflt f)
(persist/kv-put b key (f (persist/kv-get-or b key dflt)))))
; compare-and-swap: set key to new ONLY if its current value equals expected.
; Returns new on success, or a conflict value {:conflict true :expected :actual}
; the caller can re-read and retry on. The kv analogue of log append-expect.
(define
persist/kv-cas
(fn
(b key expected new)
(let
((actual (persist/kv-get b key)))
(if (equal? actual expected) (persist/kv-put b key new) {:actual actual :expected expected :conflict true}))))
; create-only: put a value only if the key is absent; conflict if it exists
(define
persist/kv-put-new
(fn
(b key val)
(if (persist/kv-has? b key) {:actual (persist/kv-get b key) :conflict true :reason "exists"} (persist/kv-put b key val))))

View File

@@ -1,43 +0,0 @@
; persist/log — the log facet: append-only event streams. seq is assigned from
; a monotonic per-stream high-water mark (1-based) held by the backend, so it
; keeps climbing even after the log prefix is compacted away. Reads return the
; events currently stored, oldest-first.
; Requires: lib/persist/event.sx, lib/persist/backend.sx.
; logical last seq assigned in a stream (0 if none) — survives compaction
(define
persist/last-seq
(fn (b stream) (persist/backend-last-seq b stream)))
; number of events physically stored in a stream (shrinks on compaction)
(define
persist/count
(fn (b stream) (len (persist/backend-read b stream))))
; append an event, auto-assigning the next seq. Returns the stored event.
(define
persist/append
(fn
(b stream type at data)
(let
((seq (+ 1 (persist/last-seq b stream))))
(let
((ev (persist/event stream seq type at data)))
(begin (persist/backend-append b stream ev) ev)))))
; read all events currently stored in a stream, oldest-first
(define persist/read (fn (b stream) (persist/backend-read b stream)))
; read events with seq >= from
(define
persist/read-from
(fn
(b stream from)
(filter
(fn (e) (>= (persist/event-seq e) from))
(persist/read b stream))))
; drop events with seq <= n (compaction); the seq counter is untouched
(define
persist/truncate
(fn (b stream n) (persist/backend-truncate b stream n)))

View File

@@ -1,30 +0,0 @@
; persist/project — a projection folds a stream's events into a read model.
; A projection state is {:value v :seq s} where s is the last seq folded in,
; so a projection can resume incrementally from where it left off (replay only
; the tail). step : (value event) -> value. Determinism: step must be pure —
; time lives on the event (event-at), never a clock here.
; Requires: lib/persist/event.sx, lib/persist/log.sx.
; fold the tail (events with seq > prior's seq) onto a prior projection state
(define
persist/project-resume
(fn
(b stream step prior)
(let
((tail (persist/read-from b stream (+ 1 (get prior :seq)))))
(reduce (fn (acc e) {:value (step (get acc :value) e) :seq (persist/event-seq e)}) prior tail))))
; project the whole stream from seed
(define
persist/project
(fn (b stream step seed) (persist/project-resume b stream step {:value seed :seq 0})))
(define persist/project-value (fn (p) (get p :value)))
(define persist/project-seq (fn (p) (get p :seq)))
; convenience: project and return just the value
(define
persist/project-fold
(fn
(b stream step seed)
(persist/project-value (persist/project b stream step seed))))

View File

@@ -1,54 +0,0 @@
; persist/query — read-side helpers over a stream: slice by seq range, filter by
; timestamp / type / predicate. Pure reads composed from persist/read, no
; backend changes. The log is bad at ad-hoc relational queries (project into a
; kv read model for those) but these cover the common log scans: an audit window
; by time, a type filter, a since-cursor for incremental consumers.
; Requires: lib/persist/log.sx.
; events with seq in [from, to] inclusive
(define
persist/read-between
(fn
(b stream from to)
(filter
(fn
(e)
(and (>= (persist/event-seq e) from) (<= (persist/event-seq e) to)))
(persist/read b stream))))
; events at or after a timestamp (events carry :at; never a clock here)
(define
persist/read-since
(fn
(b stream at)
(filter (fn (e) (>= (persist/event-at e) at)) (persist/read b stream))))
; events whose :at is in [from, to] inclusive — an audit window
(define
persist/read-window
(fn
(b stream from to)
(filter
(fn
(e)
(and (>= (persist/event-at e) from) (<= (persist/event-at e) to)))
(persist/read b stream))))
; events matching a predicate (e -> truthy)
(define
persist/read-where
(fn (b stream pred) (filter pred (persist/read b stream))))
; events of a given type
(define
persist/read-by-type
(fn
(b stream type)
(filter
(fn (e) (equal? (persist/event-type e) type))
(persist/read b stream))))
; count events matching a predicate
(define
persist/count-where
(fn (b stream pred) (len (persist/read-where b stream pred))))

View File

@@ -1,27 +0,0 @@
{
"suites": {
"event": {"pass": 6, "fail": 0},
"log": {"pass": 9, "fail": 0},
"kv": {"pass": 13, "fail": 0},
"project": {"pass": 9, "fail": 0},
"subscribe": {"pass": 9, "fail": 0},
"concurrency": {"pass": 8, "fail": 0},
"snapshot": {"pass": 11, "fail": 0},
"compaction": {"pass": 11, "fail": 0},
"durable": {"pass": 15, "fail": 0},
"blob": {"pass": 14, "fail": 0},
"view": {"pass": 11, "fail": 0},
"cas": {"pass": 11, "fail": 0},
"catalog": {"pass": 10, "fail": 0},
"query": {"pass": 9, "fail": 0},
"batch": {"pass": 10, "fail": 0},
"upcast": {"pass": 9, "fail": 0},
"idempotency": {"pass": 9, "fail": 0},
"global": {"pass": 11, "fail": 0},
"example-acl": {"pass": 10, "fail": 0},
"recovery": {"pass": 6, "fail": 0}
},
"total_pass": 201,
"total_fail": 0,
"total": 201
}

View File

@@ -1,27 +0,0 @@
# persist Conformance Scoreboard
_Generated by `lib/persist/conformance.sh`_
| Suite | Pass | Fail | Total |
|-------|-----:|-----:|------:|
| event | 6 | 0 | 6 |
| log | 9 | 0 | 9 |
| kv | 13 | 0 | 13 |
| project | 9 | 0 | 9 |
| subscribe | 9 | 0 | 9 |
| concurrency | 8 | 0 | 8 |
| snapshot | 11 | 0 | 11 |
| compaction | 11 | 0 | 11 |
| durable | 15 | 0 | 15 |
| blob | 14 | 0 | 14 |
| view | 11 | 0 | 11 |
| cas | 11 | 0 | 11 |
| catalog | 10 | 0 | 10 |
| query | 9 | 0 | 9 |
| batch | 10 | 0 | 10 |
| upcast | 9 | 0 | 9 |
| idempotency | 9 | 0 | 9 |
| global | 11 | 0 | 11 |
| example-acl | 10 | 0 | 10 |
| recovery | 6 | 0 | 6 |
| **Total** | **201** | **0** | **201** |

View File

@@ -1,40 +0,0 @@
; persist/snapshot — checkpoint a projection so a read model rebuilds as
; snapshot + tail instead of a full replay. A snapshot is just a projection
; state {:value :seq} stored in the kv facet under a namespaced key. The
; headline property (tested both ways): snapshot + tail == full replay. Replay
; is pure — it depends only on the stored snapshot and the log tail, never a
; clock. Requires: lib/persist/project.sx, lib/persist/kv.sx.
(define persist/snapshot-key (fn (name) (str "snapshot/" name)))
; load the stored snapshot for name, or a fresh {:value seed :seq 0} if none
(define
persist/snapshot-load
(fn
(b name seed)
(persist/kv-get-or b (persist/snapshot-key name) {:value seed :seq 0})))
; store a projection state as the snapshot for name; returns the state
(define
persist/snapshot-save
(fn (b name state) (persist/kv-put b (persist/snapshot-key name) state)))
(define
persist/snapshot-exists?
(fn (b name) (persist/kv-has? b (persist/snapshot-key name))))
; replay = snapshot + tail: load the snapshot then fold events after it
(define
persist/replay
(fn
(b stream name step seed)
(persist/project-resume b stream step (persist/snapshot-load b name seed))))
; replay then persist the new snapshot; returns the updated state
(define
persist/checkpoint
(fn
(b stream name step seed)
(let
((state (persist/replay b stream name step seed)))
(begin (persist/snapshot-save b name state) state))))

View File

@@ -1,21 +0,0 @@
; persist/subscribe — a subscription hub wraps a backend with per-stream
; callbacks fired after each append. The canonical use: a callback re-runs a
; projection (or bumps a kv counter) so read models update incrementally on
; write instead of being recomputed on read.
; callback signature: (backend stream event) -> ignored
; Publish goes through the hub; direct persist/append on the backend bypasses
; subscribers by design (bulk loads, replay).
; Requires: lib/persist/log.sx.
(define persist/hub (fn (b) (let ((subs {})) {:subscriber-count (fn (stream) (let ((cs (get subs stream))) (if cs (len cs) 0))) :publish (fn (stream type at data) (let ((ev (persist/append b stream type at data))) (begin (for-each (fn (cb) (cb b stream ev)) (let ((cs (get subs stream))) (if cs cs (list)))) ev))) :subscribe (fn (stream cb) (let ((cur (get subs stream))) (set! subs (assoc subs stream (append (if cur cur (list)) cb))))) :backend b})))
(define persist/hub-backend (fn (h) (get h :backend)))
(define
persist/subscribe
(fn (h stream cb) ((get h :subscribe) stream cb)))
(define
persist/publish
(fn (h stream type at data) ((get h :publish) stream type at data)))
(define
persist/subscriber-count
(fn (h stream) ((get h :subscriber-count) stream)))

View File

@@ -1,122 +0,0 @@
; Extension — atomic batch append: contiguous seqs, transactional all-or-nothing.
(persist-test
"batch assigns contiguous seqs"
(let
((b (persist/open)))
(let
((evs (persist/append-batch b "s" (list (list "a" 0 {}) (list "b" 0 {}) (list "c" 0 {})))))
(list
(persist/event-seq (first evs))
(persist/event-seq (nth evs 2)))))
(list 1 3))
(persist-test
"batch returns events in order"
(let
((b (persist/open)))
(let
((evs (persist/append-batch b "s" (list (list "a" 0 {}) (list "b" 0 {})))))
(list
(persist/event-type (first evs))
(persist/event-type (nth evs 1)))))
(list "a" "b"))
(persist-test
"batch grows the stream by its size"
(let
((b (persist/open)))
(begin
(persist/append-batch
b
"s"
(list
(list "a" 0 {})
(list "b" 0 {})
(list "c" 0 {})))
(persist/count b "s")))
3)
(persist-test
"batch continues an existing stream"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(let
((evs (persist/append-batch b "s" (list (list "a" 0 {}) (list "b" 0 {})))))
(persist/event-seq (first evs)))))
2)
(persist-test
"empty batch is a no-op"
(let
((b (persist/open)))
(begin (persist/append-batch b "s" (list)) (persist/count b "s")))
0)
(persist-test
"batch-expect with correct seq commits all"
(let
((b (persist/open)))
(begin
(persist/append-batch-expect
b
"s"
0
(list
(list "a" 0 {})
(list "b" 0 {})))
(persist/count b "s")))
2)
(persist-test
"batch-expect with stale seq writes nothing"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append-batch-expect
b
"s"
0
(list
(list "a" 0 {})
(list "b" 0 {})))
(persist/count b "s")))
1)
(persist-test
"batch-expect stale returns a conflict"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/conflict?
(persist/append-batch-expect
b
"s"
0
(list (list "a" 0 {}))))))
true)
(persist-test
"batch data is preserved"
(let
((b (persist/open)))
(begin
(persist/append-batch
b
"order"
(list
(list "placed" 0 {:id 1})
(list "line" 0 {:sku "x"})))
(get
(persist/event-data (nth (persist/read b "order") 1))
:sku)))
"x")
(persist-test
"batch works on the durable backend"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append-batch
db
"s"
(list
(list "a" 0 {})
(list "b" 0 {})))
(persist/last-seq db "s")))
2)

View File

@@ -1,112 +0,0 @@
; Phase 4 — blob backend: store the ref, never the bytes. Bytes live in a
; separate content-addressed store (mock here).
(persist-test
"blob-ref carries cid"
(persist/blob-cid (persist/blob-ref "c1" 10 "image/png"))
"c1")
(persist-test
"blob-ref carries size"
(persist/blob-size (persist/blob-ref "c1" 10 "image/png"))
10)
(persist-test
"blob-ref carries mime"
(persist/blob-mime (persist/blob-ref "c1" 10 "image/png"))
"image/png")
(persist-test
"blob-ref? true for a ref"
(persist/blob-ref? (persist/blob-ref "c1" 1 "x"))
true)
(persist-test
"blob-ref? false for a plain dict"
(persist/blob-ref? {:n 1})
false)
(persist-test
"store returns a ref, not the bytes"
(let
((blob (persist/mock-blob (persist/mem-backend))))
(persist/blob-ref? (persist/blob-store blob "PNGDATA" "image/png")))
true)
(persist-test
"store records the byte length as size"
(let
((blob (persist/mock-blob (persist/mem-backend))))
(persist/blob-size (persist/blob-store blob "12345" "text/plain")))
5)
(persist-test
"fetch round-trips the bytes via the ref"
(let
((blob (persist/mock-blob (persist/mem-backend))))
(let
((ref (persist/blob-store blob "PAYLOAD" "text/plain")))
(persist/blob-fetch blob ref)))
"PAYLOAD")
(persist-test
"exists? true after store"
(let
((blob (persist/mock-blob (persist/mem-backend))))
(let
((ref (persist/blob-store blob "X" "text/plain")))
(persist/blob-exists? blob ref)))
true)
(persist-test
"content addressing: same bytes dedupe to same cid"
(let
((blob (persist/mock-blob (persist/mem-backend))))
(equal?
(persist/blob-cid (persist/blob-store blob "SAME" "text/plain"))
(persist/blob-cid (persist/blob-store blob "SAME" "text/plain"))))
true)
(persist-test
"different bytes get different cids"
(let
((blob (persist/mock-blob (persist/mem-backend))))
(equal?
(persist/blob-cid (persist/blob-store blob "A" "text/plain"))
(persist/blob-cid (persist/blob-store blob "B" "text/plain"))))
false)
; ---------- the invariant: persist holds the ref, never the bytes ----------
(persist-test
"a blob ref stored in kv is a ref"
(let
((db (persist/mock-durable (persist/mem-backend)))
(blob (persist/mock-blob (persist/mem-backend))))
(begin
(persist/kv-put
db
"avatar"
(persist/blob-store blob "BIGIMAGE" "image/png"))
(persist/blob-ref? (persist/kv-get db "avatar"))))
true)
(persist-test
"the kv value does not contain the bytes"
(let
((db (persist/mock-durable (persist/mem-backend)))
(blob (persist/mock-blob (persist/mem-backend))))
(begin
(persist/kv-put
db
"avatar"
(persist/blob-store blob "BIGIMAGE" "image/png"))
(has-key? (persist/kv-get db "avatar") :bytes)))
false)
(persist-test
"a blob ref stored in the log is a ref, bytes fetched separately"
(let
((db (persist/mock-durable (persist/mem-backend)))
(store (persist/mem-backend)))
(let
((blob (persist/mock-blob store)))
(begin
(persist/append
db
"uploads"
"added"
0
(persist/blob-store blob "FILEBYTES" "application/pdf"))
(let
((ref (persist/event-data (first (persist/read db "uploads")))))
(list (persist/blob-ref? ref) (persist/blob-fetch blob ref))))))
(list true "FILEBYTES"))

View File

@@ -1,96 +0,0 @@
; Extension — kv compare-and-swap: atomic current-state updates. Uses
; persist/conflict? from concurrency.sx.
(persist-test
"cas on absent key with nil expected succeeds"
(let ((b (persist/open))) (persist/kv-cas b "k" nil 1))
1)
(persist-test
"cas with matching expected succeeds"
(let
((b (persist/open)))
(begin
(persist/kv-put b "k" 5)
(persist/kv-cas b "k" 5 6)
(persist/kv-get b "k")))
6)
(persist-test
"cas with stale expected returns a conflict"
(let
((b (persist/open)))
(begin
(persist/kv-put b "k" 5)
(persist/conflict? (persist/kv-cas b "k" 4 6))))
true)
(persist-test
"a conflicting cas does not write"
(let
((b (persist/open)))
(begin
(persist/kv-put b "k" 5)
(persist/kv-cas b "k" 4 6)
(persist/kv-get b "k")))
5)
(persist-test
"cas conflict carries expected and actual"
(let
((b (persist/open)))
(begin
(persist/kv-put b "k" 5)
(let
((r (persist/kv-cas b "k" 4 6)))
(list (persist/conflict-expected r) (persist/conflict-actual r)))))
(list 4 5))
(persist-test
"two cas racers: first wins, second conflicts"
(let
((b (persist/open)))
(begin
(persist/kv-put b "stock" 10)
(persist/kv-cas b "stock" 10 9)
(persist/conflict? (persist/kv-cas b "stock" 10 9))))
true)
(persist-test
"retry after cas conflict succeeds"
(let
((b (persist/open)))
(begin
(persist/kv-put b "stock" 10)
(persist/kv-cas b "stock" 10 9)
(let
((r (persist/kv-cas b "stock" 10 9)))
(if
(persist/conflict? r)
(persist/kv-cas b "stock" (persist/conflict-actual r) 8)
r))))
8)
(persist-test
"put-new on absent key succeeds"
(let ((b (persist/open))) (persist/kv-put-new b "k" 1))
1)
(persist-test
"put-new on existing key conflicts"
(let
((b (persist/open)))
(begin
(persist/kv-put b "k" 1)
(persist/conflict? (persist/kv-put-new b "k" 2))))
true)
(persist-test
"put-new does not overwrite"
(let
((b (persist/open)))
(begin
(persist/kv-put b "k" 1)
(persist/kv-put-new b "k" 2)
(persist/kv-get b "k")))
1)
(persist-test
"cas works on the durable backend"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/kv-put db "k" 1)
(persist/kv-cas db "k" 1 2)
(persist/kv-get db "k")))
2)

View File

@@ -1,86 +0,0 @@
; Extension — stream catalog: enumerate streams, count, existence, totals.
(persist-test
"empty backend has no streams"
(persist/stream-count (persist/open))
0)
(persist-test
"stream-exists? false when absent"
(persist/stream-exists? (persist/open) "orders")
false)
(persist-test
"append registers a stream"
(let
((b (persist/open)))
(begin
(persist/append b "orders" "x" 0 {})
(persist/stream-exists? b "orders")))
true)
(persist-test
"stream-count counts distinct streams"
(let
((b (persist/open)))
(begin
(persist/append b "a" "x" 0 {})
(persist/append b "b" "x" 0 {})
(persist/append b "a" "x" 0 {})
(persist/stream-count b)))
2)
(persist-test
"compacted-away stream still lists"
(let
((b (persist/open)))
(begin
(persist/append b "a" "x" 0 {})
(persist/checkpoint b "a" "snap" (fn (acc e) acc) 0)
(persist/truncate b "a" 1)
(list (persist/count b "a") (persist/stream-exists? b "a"))))
(list 0 true))
(persist-test
"kv-only backend lists no streams"
(let
((b (persist/open)))
(begin (persist/kv-put b "k" 1) (persist/stream-count b)))
0)
(persist-test
"total-events sums high-water marks"
(let
((b (persist/open)))
(begin
(persist/append b "a" "x" 0 {})
(persist/append b "a" "x" 0 {})
(persist/append b "b" "x" 0 {})
(persist/total-events b)))
3)
(persist-test
"total-events counts compacted events too"
(let
((b (persist/open)))
(begin
(persist/append b "a" "x" 0 {})
(persist/append b "a" "x" 0 {})
(persist/checkpoint b "a" "snap" (fn (acc e) acc) 0)
(persist/truncate b "a" 2)
(persist/total-events b)))
2)
(persist-test
"catalog works on the durable backend"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append db "a" "x" 0 {})
(persist/append db "b" "x" 0 {})
(persist/stream-count db)))
2)
(persist-test
"catalog survives restart"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "a" "x" 0 {})
(persist/append db "b" "x" 0 {})))
(persist/stream-count (persist/mock-durable disk))))
2)

View File

@@ -1,124 +0,0 @@
; Phase 3 — compaction: drop the snapshotted prefix; replay determinism holds.
(define comp-count (fn (acc e) (+ acc 1)))
(persist-test
"uncompacted counts events since snapshot"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/uncompacted b "s" "snap" 0)))
2)
(persist-test
"should-compact? false below threshold"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/should-compact? b "s" "snap" 3 0)))
false)
(persist-test
"should-compact? true at threshold"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/should-compact? b "s" "snap" 3 0)))
true)
(persist-test
"compact truncates the snapshotted prefix"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/compact b "s" "snap" comp-count 0)
(persist/count b "s")))
0)
(persist-test
"compact preserves logical last-seq"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/compact b "s" "snap" comp-count 0)
(persist/last-seq b "s")))
2)
(persist-test
"append after compaction continues the seq"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/compact b "s" "snap" comp-count 0)
(persist/event-seq (persist/append b "s" "x" 0 {}))))
3)
(persist-test
"replay after compaction == full count before compaction"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/compact b "s" "snap" comp-count 0)
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/project-value
(persist/replay b "s" "snap" comp-count 0))))
5)
(persist-test
"determinism: post-compaction replay value equals uncompacted full replay"
(let
((b (persist/open)) (c (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append c "s" "x" 0 {})
(persist/append c "s" "x" 0 {})
(persist/append c "s" "x" 0 {})
(persist/compact b "s" "snap" comp-count 0)
(persist/append b "s" "x" 0 {})
(persist/append c "s" "x" 0 {})
(equal?
(persist/project-value
(persist/replay b "s" "snap" comp-count 0))
(persist/project-fold c "s" comp-count 0))))
true)
(persist-test
"maybe-compact below threshold does not truncate"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/maybe-compact b "s" "snap" comp-count 0 5)
(persist/count b "s")))
1)
(persist-test
"maybe-compact at threshold truncates"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/maybe-compact b "s" "snap" comp-count 0 2)
(persist/count b "s")))
0)
(persist-test
"compact is idempotent on an empty tail"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/compact b "s" "snap" comp-count 0)
(persist/project-value
(persist/compact b "s" "snap" comp-count 0))))
1)

View File

@@ -1,96 +0,0 @@
; Phase 2 — optimistic concurrency: conflict is a real result, not a crash.
(persist-test
"append-expect 0 on empty stream succeeds"
(persist/event-seq
(persist/append-expect
(persist/open)
"s"
0
"x"
0
{}))
1)
(persist-test
"append-expect with correct seq succeeds"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/event-seq
(persist/append-expect b "s" 1 "x" 0 {}))))
2)
(persist-test
"append-expect with stale seq returns a conflict"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/conflict?
(persist/append-expect b "s" 1 "x" 0 {}))))
true)
(persist-test
"a successful append is not a conflict"
(persist/conflict?
(persist/append-expect
(persist/open)
"s"
0
"x"
0
{}))
false)
(persist-test
"conflict carries expected and actual"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(let
((r (persist/append-expect b "s" 0 "x" 0 {})))
(list (persist/conflict-expected r) (persist/conflict-actual r)))))
(list 0 2))
(persist-test
"a conflicting append does not write"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append-expect b "s" 0 "x" 0 {})
(persist/count b "s")))
1)
(persist-test
"two writers: first wins, second conflicts"
(let
((b (persist/open)))
(let
((seen (persist/last-seq b "s")))
(begin
(persist/append-expect b "s" seen "x" 0 {:who "A"})
(persist/conflict?
(persist/append-expect b "s" seen "x" 0 {:who "B"})))))
true)
(persist-test
"retry after conflict succeeds"
(let
((b (persist/open)))
(let
((seen (persist/last-seq b "s")))
(begin
(persist/append-expect b "s" seen "x" 0 {:who "A"})
(let
((r (persist/append-expect b "s" seen "x" 0 {:who "B"})))
(if
(persist/conflict? r)
(persist/event-seq
(persist/append-expect
b
"s"
(persist/conflict-actual r)
"x"
0
{:who "B"}))
(persist/event-seq r))))))
2)

View File

@@ -1,163 +0,0 @@
; Phase 4 — durable backend over the IO-suspension boundary, tested with a mock
; transport (the mock-IO harness for the durable protocol). The whole facet
; stack must run unchanged on mock-durable, and a "crash/restart" (drop the
; backend, keep the disk) must recover state by replay.
(define dur-count (fn (acc e) (+ acc 1)))
; ---------- request encoders ----------
(persist-test
"req-append encodes op + args"
(persist/req-append "s" {:k 1})
{:op "persist/append" :args (list "s" {:k 1})})
(persist-test
"req-kv-put encodes op + args"
(persist/req-kv-put "k" 7)
{:op "persist/kv-put" :args (list "k" 7)})
; ---------- serve round-trips against a disk ----------
(persist-test
"serve append then serve read"
(let
((disk (persist/mem-backend)))
(begin
(persist/serve
disk
(persist/req-append
"s"
(persist/event "s" 1 "x" 0 {:n 1})))
(get
(persist/event-data
(first (persist/serve disk (persist/req-read "s"))))
:n)))
1)
(persist-test
"serve kv-put then kv-get"
(let
((disk (persist/mem-backend)))
(begin
(persist/serve disk (persist/req-kv-put "k" 42))
(persist/serve disk (persist/req-kv-get "k"))))
42)
(persist-test
"serve unknown op is a clear error"
(let
((disk (persist/mem-backend)))
(guard (e (true "errored")) (persist/serve disk {:op "persist/bogus" :args (list)})))
"errored")
; ---------- full facet stack on mock-durable ----------
(persist-test
"log facet works on mock-durable"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})
(persist/count db "s")))
2)
(persist-test
"seq assignment works on mock-durable"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append db "s" "x" 0 {})
(persist/event-seq (persist/append db "s" "x" 0 {}))))
2)
(persist-test
"kv facet works on mock-durable"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin (persist/kv-put db "k" 5) (persist/kv-get db "k")))
5)
(persist-test
"projection works on mock-durable"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})
(persist/project-fold db "s" dur-count 0)))
3)
(persist-test
"snapshot + replay work on mock-durable"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})
(persist/checkpoint db "s" "snap" dur-count 0)
(persist/append db "s" "x" 0 {})
(persist/project-value
(persist/replay db "s" "snap" dur-count 0))))
3)
(persist-test
"compaction works on mock-durable"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})
(persist/compact db "s" "snap" dur-count 0)
(list (persist/count db "s") (persist/last-seq db "s"))))
(list 0 2))
; ---------- crash / restart replay ----------
(persist-test
"restart recovers log state from the disk"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})))
(let
((db2 (persist/mock-durable disk)))
(persist/project-fold db2 "s" dur-count 0))))
2)
(persist-test
"restart continues the seq counter"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})))
(let
((db2 (persist/mock-durable disk)))
(persist/event-seq (persist/append db2 "s" "x" 0 {})))))
3)
(persist-test
"restart recovers a kv value"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(persist/kv-put db "cfg" "on"))
(let ((db2 (persist/mock-durable disk))) (persist/kv-get db2 "cfg"))))
"on")
(persist-test
"restart from snapshot equals full replay"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "s" "x" 0 {})
(persist/append db "s" "x" 0 {})
(persist/checkpoint db "s" "snap" dur-count 0)
(persist/append db "s" "x" 0 {})))
(let
((db2 (persist/mock-durable disk)))
(equal?
(persist/project-value
(persist/replay db2 "s" "snap" dur-count 0))
(persist/project-fold db2 "s" dur-count 0)))))
true)

View File

@@ -1,30 +0,0 @@
; Phase 1 — event record accessors. Uses the persist-test harness
; (persist-test name got expected) provided by conformance.sh.
(persist-test
"event-stream"
(persist/event-stream
(persist/event "s" 1 "t" 0 {}))
"s")
(persist-test
"event-seq"
(persist/event-seq (persist/event "s" 3 "t" 0 {}))
3)
(persist-test
"event-type"
(persist/event-type
(persist/event "s" 1 "create" 0 {}))
"create")
(persist-test
"event-at"
(persist/event-at (persist/event "s" 1 "t" 42 {}))
42)
(persist-test
"event-data"
(persist/event-data
(persist/event "s" 1 "t" 0 {:x 9}))
{:x 9})
(persist-test
"event is a dict with all fields"
(len (keys (persist/event "s" 1 "t" 0 {})))
5)

View File

@@ -1,104 +0,0 @@
; Reference migration — acl grants on persist. Proves the AFTER behaviour,
; including the capabilities the hand-rolled BEFORE version could not provide
; (durability across restart + an audit trail).
(persist-test
"grant then can?"
(let
((b (persist/open)))
(begin
(acl/grant b "doc-1" "alice" 0)
(acl/can? b "doc-1" "alice")))
true)
(persist-test
"no grant means no access"
(acl/can? (persist/open) "doc-1" "alice")
false)
(persist-test
"revoke removes access"
(let
((b (persist/open)))
(begin
(acl/grant b "doc-1" "alice" 0)
(acl/revoke b "doc-1" "alice" 1)
(acl/can? b "doc-1" "alice")))
false)
(persist-test
"multiple principals tracked independently"
(let
((b (persist/open)))
(begin
(acl/grant b "doc-1" "alice" 0)
(acl/grant b "doc-1" "bob" 1)
(acl/revoke b "doc-1" "alice" 2)
(list (acl/can? b "doc-1" "alice") (acl/can? b "doc-1" "bob"))))
(list false true))
(persist-test
"granting twice is idempotent in the set"
(let
((b (persist/open)))
(begin
(acl/grant b "doc-1" "alice" 0)
(acl/grant b "doc-1" "alice" 1)
(len (acl/grants b "doc-1"))))
1)
(persist-test
"grants on different resources are isolated"
(let
((b (persist/open)))
(begin
(acl/grant b "doc-1" "alice" 0)
(acl/grant b "doc-2" "bob" 0)
(list (acl/can? b "doc-1" "bob") (acl/can? b "doc-2" "bob"))))
(list false true))
(persist-test
"audit window answers when-was-it-granted (new capability)"
(let
((b (persist/open)))
(begin
(acl/grant b "doc-1" "alice" 100)
(acl/revoke b "doc-1" "alice" 200)
(acl/grant b "doc-1" "bob" 300)
(len (acl/audit-window b "doc-1" 150 300))))
2)
(persist-test
"materialized view stays current on publish"
(let
((b (persist/open)))
(let
((h (persist/view-attach (persist/hub b) (acl/view "doc-1"))))
(begin
(persist/publish
h
(acl/stream "doc-1")
"granted"
0
{:principal "alice"})
(acl/can-fast? b "doc-1" "alice"))))
true)
(persist-test
"grants survive restart on the durable backend (the headline win)"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(acl/grant db "doc-1" "alice" 0)
(acl/grant db "doc-1" "bob" 1)))
(let
((db2 (persist/mock-durable disk)))
(list (acl/can? db2 "doc-1" "alice") (acl/can? db2 "doc-1" "bob")))))
(list true true))
(persist-test
"revoke before restart is still revoked after"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(acl/grant db "doc-1" "alice" 0)
(acl/revoke db "doc-1" "alice" 1)))
(acl/can? (persist/mock-durable disk) "doc-1" "alice")))
false)

View File

@@ -1,123 +0,0 @@
; Extension — global commit ordering across streams.
(persist-test
"gappend returns the stream event with its local seq"
(let
((b (persist/open)))
(persist/event-seq
(persist/gappend b "orders" "placed" 0 {})))
1)
(persist-test
"global-pos advances per gappend regardless of stream"
(let
((b (persist/open)))
(begin
(persist/gappend b "orders" "placed" 0 {})
(persist/gappend b "users" "joined" 0 {})
(persist/gappend b "orders" "placed" 0 {})
(persist/global-pos b)))
3)
(persist-test
"read-global returns events in commit order across streams"
(let
((b (persist/open)))
(begin
(persist/gappend b "orders" "placed" 0 {:n 1})
(persist/gappend b "users" "joined" 0 {:n 2})
(persist/gappend b "orders" "placed" 0 {:n 3})
(let
((g (persist/read-global b)))
(list
(get (persist/event-data (nth g 0)) :n)
(get (persist/event-data (nth g 1)) :n)
(get (persist/event-data (nth g 2)) :n)))))
(list 1 2 3))
(persist-test
"read-global resolves to the right streams"
(let
((b (persist/open)))
(begin
(persist/gappend b "orders" "placed" 0 {})
(persist/gappend b "users" "joined" 0 {})
(let
((g (persist/read-global b)))
(list
(persist/event-stream (nth g 0))
(persist/event-stream (nth g 1))))))
(list "orders" "users"))
(persist-test
"project-global folds across all streams in order"
(let
((b (persist/open)))
(begin
(persist/gappend b "a" "x" 0 {:v 10})
(persist/gappend b "b" "x" 0 {:v 20})
(persist/gappend b "a" "x" 0 {:v 30})
(persist/project-global
b
(fn (acc e) (+ acc (get (persist/event-data e) :v)))
0)))
60)
(persist-test
"global index is hidden from the public catalog"
(let
((b (persist/open)))
(begin
(persist/gappend b "orders" "placed" 0 {})
(persist/gappend b "users" "joined" 0 {})
(list (persist/stream-count b) (persist/stream-exists? b "$global"))))
(list 2 false))
(persist-test
"streams-all reveals the reserved index"
(let
((b (persist/open)))
(begin
(persist/gappend b "orders" "placed" 0 {})
(contains? (persist/streams-all b) "$global")))
true)
(persist-test
"global-from gives pointers at or after a position"
(let
((b (persist/open)))
(begin
(persist/gappend b "a" "x" 0 {})
(persist/gappend b "a" "x" 0 {})
(persist/gappend b "a" "x" 0 {})
(len (persist/global-from b 2))))
2)
(persist-test
"plain append does not touch the global index"
(let
((b (persist/open)))
(begin
(persist/append b "orders" "placed" 0 {})
(persist/gappend b "orders" "placed" 0 {})
(persist/global-pos b)))
1)
(persist-test
"global ordering works on the durable backend"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/gappend db "a" "x" 0 {:v 1})
(persist/gappend db "b" "x" 0 {:v 2})
(persist/project-global
db
(fn (acc e) (+ acc (get (persist/event-data e) :v)))
0)))
3)
(persist-test
"global order survives restart (determinism)"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/gappend db "a" "x" 0 {:v 1})
(persist/gappend db "b" "x" 0 {:v 2})))
(persist/project-global
(persist/mock-durable disk)
(fn (acc e) (+ acc (get (persist/event-data e) :v)))
0)))
3)

View File

@@ -1,92 +0,0 @@
; Extension — exactly-once append under retries.
(persist-test
"seen? false before first append"
(persist/seen? (persist/open) "orders" "cmd-1")
false)
(persist-test
"append-once appends on first use"
(let
((b (persist/open)))
(begin
(persist/append-once b "orders" "cmd-1" "placed" 0 {})
(persist/count b "orders")))
1)
(persist-test
"seen? true after first append"
(let
((b (persist/open)))
(begin
(persist/append-once b "orders" "cmd-1" "placed" 0 {})
(persist/seen? b "orders" "cmd-1")))
true)
(persist-test
"repeat with same key does not append again"
(let
((b (persist/open)))
(begin
(persist/append-once b "orders" "cmd-1" "placed" 0 {})
(persist/append-once b "orders" "cmd-1" "placed" 0 {})
(persist/append-once b "orders" "cmd-1" "placed" 0 {})
(persist/count b "orders")))
1)
(persist-test
"repeat returns the same event (same seq)"
(let
((b (persist/open)))
(let
((e1 (persist/append-once b "orders" "cmd-1" "placed" 0 {})))
(persist/event-seq
(persist/append-once b "orders" "cmd-1" "placed" 0 {}))))
1)
(persist-test
"different keys append separately"
(let
((b (persist/open)))
(begin
(persist/append-once b "orders" "cmd-1" "placed" 0 {})
(persist/append-once b "orders" "cmd-2" "placed" 0 {})
(persist/count b "orders")))
2)
(persist-test
"idempotency is per-stream"
(let
((b (persist/open)))
(begin
(persist/append-once b "a" "cmd-1" "x" 0 {})
(persist/append-once b "b" "cmd-1" "x" 0 {})
(list (persist/count b "a") (persist/count b "b"))))
(list 1 1))
(persist-test
"stored data is preserved on first append"
(let
((b (persist/open)))
(get
(persist/event-data
(persist/append-once b "s" "k" "x" 0 {:n 9}))
:n))
9)
(persist-test
"idempotency survives restart on the durable backend"
(let
((disk (persist/mem-backend)))
(begin
(persist/append-once
(persist/mock-durable disk)
"orders"
"cmd-1"
"placed"
0
{})
(let
((db2 (persist/mock-durable disk)))
(begin
(persist/append-once
db2
"orders"
"cmd-1"
"placed"
0
{})
(persist/count db2 "orders")))))
1)

View File

@@ -1,86 +0,0 @@
; Phase 1 — kv facet: get/put/delete/has?/keys, get-or, update.
(persist-test "absent key reads nil" (persist/kv-get (persist/open) "x") nil)
(persist-test
"has? false when absent"
(persist/kv-has? (persist/open) "x")
false)
(persist-test
"put then get"
(let
((b (persist/open)))
(begin (persist/kv-put b "x" 7) (persist/kv-get b "x")))
7)
(persist-test
"put returns value"
(let ((b (persist/open))) (persist/kv-put b "x" 9))
9)
(persist-test
"has? true after put"
(let
((b (persist/open)))
(begin (persist/kv-put b "x" 1) (persist/kv-has? b "x")))
true)
(persist-test
"put overwrites"
(let
((b (persist/open)))
(begin
(persist/kv-put b "x" 1)
(persist/kv-put b "x" 2)
(persist/kv-get b "x")))
2)
(persist-test
"delete removes key"
(let
((b (persist/open)))
(begin
(persist/kv-put b "x" 1)
(persist/kv-delete b "x")
(persist/kv-has? b "x")))
false)
(persist-test
"delete then get is nil"
(let
((b (persist/open)))
(begin
(persist/kv-put b "x" 1)
(persist/kv-delete b "x")
(persist/kv-get b "x")))
nil)
(persist-test
"keys lists stored keys"
(let
((b (persist/open)))
(begin
(persist/kv-put b "a" 1)
(persist/kv-put b "b" 2)
(len (persist/kv-keys b))))
2)
(persist-test
"get-or returns default when absent"
(persist/kv-get-or (persist/open) "x" 99)
99)
(persist-test
"get-or returns value when present"
(let
((b (persist/open)))
(begin
(persist/kv-put b "x" 5)
(persist/kv-get-or b "x" 99)))
5)
(persist-test
"kv-update applies fn over default"
(let
((b (persist/open)))
(begin
(persist/kv-update b "n" 0 (fn (v) (+ v 1)))
(persist/kv-update b "n" 0 (fn (v) (+ v 1)))
(persist/kv-get b "n")))
2)
(persist-test
"kv facet does not touch log"
(let
((b (persist/open)))
(begin (persist/kv-put b "x" 1) (persist/count b "x")))
0)

View File

@@ -1,81 +0,0 @@
; Phase 1 — log facet: append/read/read-from, sequential seq, stream isolation.
; Note: map returns an array-backed list not equal? to a (list ...) literal,
; so assertions build their compared list with list/nth, not map.
(persist-test
"empty stream reads empty"
(len (persist/read (persist/open) "orders"))
0)
(persist-test
"last-seq empty is 0"
(persist/last-seq (persist/open) "orders")
0)
(persist-test
"append returns event with seq 1"
(persist/event-seq
(persist/append (persist/open) "orders" "placed" 0 {:id 1}))
1)
(persist-test
"append assigns sequential seqs"
(let
((b (persist/open)))
(begin
(persist/append b "orders" "placed" 0 {})
(persist/append b "orders" "placed" 1 {})
(persist/event-seq
(persist/append b "orders" "placed" 2 {}))))
3)
(persist-test
"read returns events oldest-first"
(let
((b (persist/open)))
(begin
(persist/append b "s" "a" 0 {:n 1})
(persist/append b "s" "b" 0 {:n 2})
(let
((es (persist/read b "s")))
(list
(get (persist/event-data (nth es 0)) :n)
(get (persist/event-data (nth es 1)) :n)))))
(list 1 2))
(persist-test
"count tracks appends"
(let
((b (persist/open)))
(begin
(persist/append b "s" "a" 0 {})
(persist/append b "s" "a" 0 {})
(persist/count b "s")))
2)
(persist-test
"streams are isolated"
(let
((b (persist/open)))
(begin
(persist/append b "s1" "a" 0 {})
(persist/append b "s2" "a" 0 {})
(persist/append b "s2" "a" 0 {})
(list (persist/count b "s1") (persist/count b "s2"))))
(list 1 2))
(persist-test
"read-from filters by seq"
(let
((b (persist/open)))
(begin
(persist/append b "s" "a" 0 {})
(persist/append b "s" "a" 0 {})
(persist/append b "s" "a" 0 {})
(let
((es (persist/read-from b "s" 2)))
(list
(persist/event-seq (nth es 0))
(persist/event-seq (nth es 1))))))
(list 2 3))
(persist-test
"read-from past end is empty"
(let
((b (persist/open)))
(begin
(persist/append b "s" "a" 0 {})
(len (persist/read-from b "s" 5))))
0)

View File

@@ -1,115 +0,0 @@
; Phase 2 — projections: fold a stream into a read model, resume incrementally.
(persist-test
"project empty stream returns seed value"
(persist/project-fold
(persist/open)
"s"
(fn (acc e) (+ acc 1))
0)
0)
(persist-test
"project empty stream seq is 0"
(persist/project-seq
(persist/project (persist/open) "s" (fn (a e) a) 0))
0)
(persist-test
"project counts events"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/project-fold
b
"s"
(fn (acc e) (+ acc 1))
0)))
3)
(persist-test
"project sums event data"
(let
((b (persist/open)))
(begin
(persist/append b "ledger" "credit" 0 {:amt 10})
(persist/append b "ledger" "credit" 1 {:amt 5})
(persist/append b "ledger" "debit" 2 {:amt 3})
(persist/project-fold
b
"ledger"
(fn
(bal e)
(if
(equal? (persist/event-type e) "credit")
(+ bal (get (persist/event-data e) :amt))
(- bal (get (persist/event-data e) :amt))))
0)))
12)
(persist-test
"project tracks last seq"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/project-seq (persist/project b "s" (fn (a e) a) 0))))
2)
(persist-test
"resume folds only the tail"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(let
((p1 (persist/project b "s" (fn (acc e) (+ acc 1)) 0)))
(begin
(persist/append b "s" "x" 0 {})
(persist/project-value
(persist/project-resume
b
"s"
(fn (acc e) (+ acc 1))
p1))))))
3)
(persist-test
"resume with no new events is a no-op"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(let
((p1 (persist/project b "s" (fn (acc e) (+ acc 1)) 0)))
(persist/project-value
(persist/project-resume b "s" (fn (acc e) (+ acc 1)) p1)))))
1)
(persist-test
"resume advances seq"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(let
((p1 (persist/project b "s" (fn (a e) a) 0)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/project-seq
(persist/project-resume b "s" (fn (a e) a) p1))))))
3)
(persist-test
"full project equals seed-resume from zero"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(equal?
(persist/project b "s" (fn (acc e) (+ acc 1)) 0)
(persist/project-resume
b
"s"
(fn (acc e) (+ acc 1))
{:value 0 :seq 0}))))
true)

View File

@@ -1,101 +0,0 @@
; Extension — read-side query helpers. Assertions count / index, not map vs list.
(define q-seqs (fn (es) (map persist/event-seq es)))
(persist-test
"read-between slices a seq range"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(let
((es (persist/read-between b "s" 2 3)))
(list
(len es)
(persist/event-seq (first es))
(persist/event-seq (nth es 1))))))
(list 2 2 3))
(persist-test
"read-between is inclusive of endpoints"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(len (persist/read-between b "s" 1 3))))
3)
(persist-test
"read-since filters by timestamp"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 100 {})
(persist/append b "s" "x" 200 {})
(persist/append b "s" "x" 300 {})
(len (persist/read-since b "s" 200))))
2)
(persist-test
"read-window is an inclusive time range"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 100 {})
(persist/append b "s" "x" 200 {})
(persist/append b "s" "x" 300 {})
(persist/append b "s" "x" 400 {})
(len (persist/read-window b "s" 200 300))))
2)
(persist-test
"read-by-type filters by event type"
(let
((b (persist/open)))
(begin
(persist/append b "s" "created" 0 {})
(persist/append b "s" "updated" 0 {})
(persist/append b "s" "created" 0 {})
(len (persist/read-by-type b "s" "created"))))
2)
(persist-test
"read-where filters by predicate over data"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {:amt 5})
(persist/append b "s" "x" 0 {:amt 15})
(persist/append b "s" "x" 0 {:amt 25})
(len
(persist/read-where
b
"s"
(fn (e) (> (get (persist/event-data e) :amt) 10))))))
2)
(persist-test
"count-where counts matches"
(let
((b (persist/open)))
(begin
(persist/append b "s" "a" 0 {})
(persist/append b "s" "b" 0 {})
(persist/append b "s" "a" 0 {})
(persist/count-where
b
"s"
(fn (e) (equal? (persist/event-type e) "a")))))
2)
(persist-test
"queries return empty on empty stream"
(len (persist/read-since (persist/open) "s" 0))
0)
(persist-test
"queries work on the durable backend"
(let
((db (persist/mock-durable (persist/mem-backend))))
(begin
(persist/append db "s" "x" 100 {})
(persist/append db "s" "x" 200 {})
(len (persist/read-since db "s" 150))))
1)

View File

@@ -1,126 +0,0 @@
; Phase 4 — crash/restart integration. A whole subsystem (an order ledger:
; event log + a kv read model kept by a subscription + a periodic snapshot + an
; invoice blob ref) on the durable backend must survive a restart. "Crash" =
; drop every in-process object (backend, hub, projections); "restart" = rebuild
; them over the SAME disk + blob store. Nothing but the disk and content store
; carries across, exactly as a real process restart.
(define rec-count (fn (acc e) (+ acc 1)))
(persist-test
"log survives restart and seq continues"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "orders" "placed" 0 {:id "a"})
(persist/append db "orders" "placed" 1 {:id "b"})))
(let
((db2 (persist/mock-durable disk)))
(list
(persist/project-fold db2 "orders" rec-count 0)
(persist/event-seq
(persist/append db2 "orders" "placed" 2 {:id "c"}))))))
(list 2 3))
(persist-test
"subscription-driven kv read model survives restart"
(let
((disk (persist/mem-backend)))
(begin
(let
((h (persist/hub (persist/mock-durable disk))))
(begin
(persist/subscribe
h
"orders"
(fn
(bk s e)
(persist/kv-update
bk
"order-count"
0
(fn (n) (+ n 1)))))
(persist/publish h "orders" "placed" 0 {})
(persist/publish h "orders" "placed" 1 {})))
(let
((db2 (persist/mock-durable disk)))
(persist/kv-get db2 "order-count"))))
2)
(persist-test
"snapshot taken before crash drives replay after restart"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "orders" "placed" 0 {})
(persist/append db "orders" "placed" 1 {})
(persist/checkpoint db "orders" "count" rec-count 0)
(persist/append db "orders" "placed" 2 {})))
(let
((db2 (persist/mock-durable disk)))
(equal?
(persist/project-value
(persist/replay db2 "orders" "count" rec-count 0))
(persist/project-fold db2 "orders" rec-count 0)))))
true)
(persist-test
"compacted log still replays correctly after restart"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "orders" "placed" 0 {})
(persist/append db "orders" "placed" 1 {})
(persist/append db "orders" "placed" 2 {})
(persist/compact db "orders" "count" rec-count 0)
(persist/append db "orders" "placed" 3 {})))
(let
((db2 (persist/mock-durable disk)))
(persist/project-value
(persist/replay db2 "orders" "count" rec-count 0)))))
4)
(persist-test
"invoice blob ref survives restart, bytes fetched from content store"
(let
((disk (persist/mem-backend)) (store (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)) (blob (persist/mock-blob store)))
(persist/kv-put
db
"invoice"
(persist/blob-store blob "INVOICEPDF" "application/pdf")))
(let
((db2 (persist/mock-durable disk))
(blob2 (persist/mock-blob store)))
(persist/blob-fetch blob2 (persist/kv-get db2 "invoice")))))
"INVOICEPDF")
(persist-test
"two independent restarts converge to the same state (determinism)"
(let
((disk (persist/mem-backend)))
(begin
(let
((db (persist/mock-durable disk)))
(begin
(persist/append db "orders" "placed" 0 {})
(persist/append db "orders" "placed" 1 {})
(persist/append db "orders" "placed" 2 {})))
(equal?
(persist/project-fold
(persist/mock-durable disk)
"orders"
rec-count
0)
(persist/project-fold
(persist/mock-durable disk)
"orders"
rec-count
0))))
true)

View File

@@ -1,114 +0,0 @@
; Phase 3 — snapshots + replay. Headline: snapshot + tail == full replay.
(define snap-count (fn (acc e) (+ acc 1)))
(persist-test
"no snapshot loads fresh seed state"
(persist/snapshot-load (persist/open) "feed" 0)
{:value 0 :seq 0})
(persist-test
"snapshot-exists? false initially"
(persist/snapshot-exists? (persist/open) "feed")
false)
(persist-test
"checkpoint stores a snapshot"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "snap" snap-count 0)
(persist/snapshot-exists? b "snap")))
true)
(persist-test
"checkpoint value equals full projection"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/project-value
(persist/checkpoint b "s" "snap" snap-count 0))))
3)
(persist-test
"checkpoint records the last seq"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/project-seq
(persist/checkpoint b "s" "snap" snap-count 0))))
2)
(persist-test
"replay after checkpoint only folds the tail"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "snap" snap-count 0)
(persist/append b "s" "x" 0 {})
(persist/project-value
(persist/replay b "s" "snap" snap-count 0))))
3)
(persist-test
"snapshot + tail == full replay (value)"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "snap" snap-count 0)
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(equal?
(persist/project-value
(persist/replay b "s" "snap" snap-count 0))
(persist/project-fold b "s" snap-count 0))))
true)
(persist-test
"snapshot + tail == full replay (whole state)"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "snap" snap-count 0)
(persist/append b "s" "x" 0 {})
(persist/append b "s" "x" 0 {})
(equal?
(persist/replay b "s" "snap" snap-count 0)
(persist/project b "s" snap-count 0))))
true)
(persist-test
"replay determinism: two replays from same snapshot agree"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "snap" snap-count 0)
(persist/append b "s" "x" 0 {})
(equal?
(persist/replay b "s" "snap" snap-count 0)
(persist/replay b "s" "snap" snap-count 0))))
true)
(persist-test
"re-checkpoint advances the snapshot"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "snap" snap-count 0)
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "snap" snap-count 0)
(persist/project-seq (persist/snapshot-load b "snap" 0))))
2)
(persist-test
"snapshots are keyed independently"
(let
((b (persist/open)))
(begin
(persist/append b "s" "x" 0 {})
(persist/checkpoint b "s" "a" snap-count 0)
(persist/snapshot-exists? b "b")))
false)

View File

@@ -1,130 +0,0 @@
; Phase 2 — subscription hub: callbacks fire on publish, drive read models.
(persist-test
"no subscribers initially"
(persist/subscriber-count (persist/hub (persist/open)) "s")
0)
(persist-test
"subscribe registers a callback"
(let
((h (persist/hub (persist/open))))
(begin
(persist/subscribe h "s" (fn (b s e) nil))
(persist/subscriber-count h "s")))
1)
(persist-test
"publish appends to the log"
(let
((b (persist/open)))
(let
((h (persist/hub b)))
(begin
(persist/publish h "s" "x" 0 {})
(persist/publish h "s" "x" 0 {})
(persist/count b "s"))))
2)
(persist-test
"publish returns the stored event"
(let
((h (persist/hub (persist/open))))
(persist/event-seq (persist/publish h "s" "x" 0 {:id 1})))
1)
(persist-test
"callback fires on publish — drives a kv read model"
(let
((b (persist/open)))
(let
((h (persist/hub b)))
(begin
(persist/subscribe
h
"s"
(fn
(bk s e)
(persist/kv-update
bk
"count"
0
(fn (n) (+ n 1)))))
(persist/publish h "s" "x" 0 {})
(persist/publish h "s" "x" 0 {})
(persist/publish h "s" "x" 0 {})
(persist/kv-get b "count"))))
3)
(persist-test
"callback receives the event"
(let
((b (persist/open)))
(let
((h (persist/hub b)))
(begin
(persist/subscribe
h
"s"
(fn (bk s e) (persist/kv-put bk "last" (persist/event-type e))))
(persist/publish h "s" "created" 0 {})
(persist/kv-get b "last"))))
"created")
(persist-test
"subscriptions are per-stream"
(let
((b (persist/open)))
(let
((h (persist/hub b)))
(begin
(persist/subscribe
h
"s1"
(fn
(bk s e)
(persist/kv-update bk "n" 0 (fn (n) (+ n 1)))))
(persist/publish h "s2" "x" 0 {})
(persist/kv-get-or b "n" 0))))
0)
(persist-test
"multiple subscribers all fire"
(let
((b (persist/open)))
(let
((h (persist/hub b)))
(begin
(persist/subscribe
h
"s"
(fn
(bk s e)
(persist/kv-update bk "a" 0 (fn (n) (+ n 1)))))
(persist/subscribe
h
"s"
(fn
(bk s e)
(persist/kv-update bk "b" 0 (fn (n) (+ n 10)))))
(persist/publish h "s" "x" 0 {})
(list (persist/kv-get b "a") (persist/kv-get b "b")))))
(list 1 10))
(persist-test
"incremental read model via resume in callback"
(let
((b (persist/open)))
(let
((h (persist/hub b)))
(begin
(persist/kv-put b "proj" {:value 0 :seq 0})
(persist/subscribe
h
"s"
(fn
(bk s e)
(persist/kv-put
bk
"proj"
(persist/project-resume
bk
s
(fn (acc ev) (+ acc 1))
(persist/kv-get bk "proj")))))
(persist/publish h "s" "x" 0 {})
(persist/publish h "s" "x" 0 {})
(persist/project-value (persist/kv-get b "proj")))))
2)

View File

@@ -1,115 +0,0 @@
; Extension — event schema evolution via upcasters.
; v1 "placed" events had {:total N}; v2 wants {:amount N :currency "GBP"}.
(define up-placed (fn (e) (persist/upcast-data e {:amount (get (persist/event-data e) :total) :currency "GBP"})))
(persist-test
"unregistered type passes through unchanged"
(let
((reg (persist/upcasters)))
(persist/event-data
(persist/upcast
reg
(persist/event "s" 1 "other" 0 {:x 1}))))
{:x 1})
(persist-test
"registered upcaster lifts an old event"
(let
((reg (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
(get
(persist/event-data
(persist/upcast
reg
(persist/event "s" 1 "placed" 0 {:total 50})))
:amount))
50)
(persist-test
"upcaster adds the new field"
(let
((reg (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
(get
(persist/event-data
(persist/upcast
reg
(persist/event "s" 1 "placed" 0 {:total 50})))
:currency))
"GBP")
(persist-test
"upcast preserves stream/seq/type/at"
(let
((reg (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
(let
((e (persist/upcast reg (persist/event "orders" 7 "placed" 99 {:total 1}))))
(list
(persist/event-seq e)
(persist/event-at e)
(persist/event-type e))))
(list 7 99 "placed"))
(persist-test
"registry is immutable — register returns a new dict"
(let
((r0 (persist/upcasters)))
(begin
(persist/register-upcaster r0 "placed" up-placed)
(has-key? r0 "placed")))
false)
(persist-test
"read-upcast lifts every event in a stream"
(let
((b (persist/open))
(reg
(persist/register-upcaster (persist/upcasters) "placed" up-placed)))
(begin
(persist/append b "orders" "placed" 0 {:total 10})
(persist/append b "orders" "placed" 0 {:total 20})
(let
((es (persist/read-upcast b "orders" reg)))
(list
(get (persist/event-data (nth es 0)) :amount)
(get (persist/event-data (nth es 1)) :amount)))))
(list 10 20))
(persist-test
"project-upcast folds over the current shape"
(let
((b (persist/open))
(reg
(persist/register-upcaster (persist/upcasters) "placed" up-placed)))
(begin
(persist/append b "orders" "placed" 0 {:total 10})
(persist/append b "orders" "placed" 0 {:total 20})
(persist/project-upcast
b
"orders"
reg
(fn (acc e) (+ acc (get (persist/event-data e) :amount)))
0)))
30)
(persist-test
"mixed old and new events fold uniformly"
(let
((b (persist/open))
(reg
(persist/register-upcaster (persist/upcasters) "placed" up-placed)))
(begin
(persist/append b "orders" "placed" 0 {:total 5})
(persist/append b "orders" "placed" 0 {:total 7 :amount 7})
(persist/project-upcast
b
"orders"
reg
(fn (acc e) (+ acc (get (persist/event-data e) :amount)))
0)))
12)
(persist-test
"upcast works on the durable backend"
(let
((db (persist/mock-durable (persist/mem-backend)))
(reg
(persist/register-upcaster (persist/upcasters) "placed" up-placed)))
(begin
(persist/append db "orders" "placed" 0 {:total 42})
(get
(persist/event-data
(nth (persist/read-upcast db "orders" reg) 0))
:amount)))
42)

View File

@@ -1,105 +0,0 @@
; Extension — materialized views: stay current on write, read O(1) via peek.
(define vw-count (fn (acc e) (+ acc 1)))
(define vw (persist/view "order-count" "orders" vw-count 0))
(persist-test "view-name" (persist/view-name vw) "order-count")
(persist-test "view-stream" (persist/view-stream vw) "orders")
(persist-test
"view-value folds the stream"
(let
((b (persist/open)))
(begin
(persist/append b "orders" "x" 0 {})
(persist/append b "orders" "x" 0 {})
(persist/view-value b vw)))
2)
(persist-test
"view-refresh persists a snapshot that peek then reads"
(let
((b (persist/open)))
(begin
(persist/append b "orders" "x" 0 {})
(persist/view-refresh b vw)
(persist/view-peek b vw)))
1)
(persist-test
"peek lags an un-refreshed tail"
(let
((b (persist/open)))
(begin
(persist/append b "orders" "x" 0 {})
(persist/view-refresh b vw)
(persist/append b "orders" "x" 0 {})
(persist/view-peek b vw)))
1)
(persist-test
"view-value sees the whole stream even after a stale snapshot"
(let
((b (persist/open)))
(begin
(persist/append b "orders" "x" 0 {})
(persist/view-refresh b vw)
(persist/append b "orders" "x" 0 {})
(persist/view-value b vw)))
2)
(persist-test
"attached view stays current on publish — peek needs no manual refresh"
(let
((b (persist/open)))
(let
((h (persist/view-attach (persist/hub b) vw)))
(begin
(persist/publish h "orders" "x" 0 {})
(persist/publish h "orders" "x" 0 {})
(persist/publish h "orders" "x" 0 {})
(persist/view-peek b vw))))
3)
(persist-test
"attached view advances the snapshot seq incrementally"
(let
((b (persist/open)))
(let
((h (persist/view-attach (persist/hub b) vw)))
(begin
(persist/publish h "orders" "x" 0 {})
(persist/publish h "orders" "x" 0 {})
(persist/project-seq
(persist/snapshot-load b "order-count" 0)))))
2)
(persist-test
"attach only reacts to its own stream"
(let
((b (persist/open)))
(let
((h (persist/view-attach (persist/hub b) vw)))
(begin
(persist/publish h "other" "x" 0 {})
(persist/view-peek b vw))))
0)
(persist-test
"materialized view works on the durable backend"
(let
((db (persist/mock-durable (persist/mem-backend))))
(let
((h (persist/view-attach (persist/hub db) vw)))
(begin
(persist/publish h "orders" "x" 0 {})
(persist/publish h "orders" "x" 0 {})
(persist/view-peek db vw))))
2)
(persist-test
"view sum over event data"
(let
((b (persist/open))
(sumv
(persist/view
"rev"
"sales"
(fn (acc e) (+ acc (get (persist/event-data e) :amt)))
0)))
(begin
(persist/append b "sales" "sale" 0 {:amt 10})
(persist/append b "sales" "sale" 1 {:amt 25})
(persist/view-value b sumv)))
35)

View File

@@ -1,44 +0,0 @@
; persist/upcast — event schema evolution. An append-only log keeps events
; forever, so old events have old shapes. Rather than migrate stored data (you
; can't rewrite history) or branch every projection on version, register an
; upcaster per event type: a pure (event -> event) that lifts an old event to
; the current shape. Reads pass through the registry so projections see ONE
; shape. The registry is an immutable dict the consumer threads (no global
; mutable state). Requires: lib/persist/event.sx, lib/persist/log.sx.
(define persist/upcasters (fn () {}))
(define persist/register-upcaster (fn (reg type fn) (assoc reg type fn)))
; apply the registered upcaster for an event's type, or pass it through unchanged
(define
persist/upcast
(fn
(reg e)
(let ((f (get reg (persist/event-type e)))) (if f (f e) e))))
; read a stream with every event lifted to current shape
(define
persist/read-upcast
(fn
(b stream reg)
(map (fn (e) (persist/upcast reg e)) (persist/read b stream))))
; project over upcasted events — projections never see a legacy shape
(define
persist/project-upcast
(fn
(b stream reg step seed)
(reduce step seed (persist/read-upcast b stream reg))))
; helper: upcast an event's :data by merging in/overriding fields, keeping the
; record's stream/seq/type/at. Common upcaster body.
(define
persist/upcast-data
(fn
(e new-data)
(persist/event
(persist/event-stream e)
(persist/event-seq e)
(persist/event-type e)
(persist/event-at e)
(merge (persist/event-data e) new-data))))

View File

@@ -1,49 +0,0 @@
; persist/view — a materialized view: the consumer-facing read model. It bundles
; a stream, a fold (step + seed) and a snapshot name. Attached to a hub it
; refreshes incrementally on every publish, so the materialized value stays
; current on write and reads are O(1) snapshot loads (persist/view-peek) instead
; of a full fold. This is what feed indices, mod audit rollups, search counters,
; etc. sit on. Requires: lib/persist/snapshot.sx, lib/persist/subscribe.sx.
(define persist/view (fn (name stream step seed) {:name name :step step :stream stream :seed seed}))
(define persist/view-name (fn (v) (get v :name)))
(define persist/view-stream (fn (v) (get v :stream)))
; bring the view's snapshot up to date with the log tail; returns the state
(define
persist/view-refresh
(fn
(b v)
(persist/checkpoint
b
(get v :stream)
(get v :name)
(get v :step)
(get v :seed))))
; current materialized value — refreshes first, so never stale
(define
persist/view-value
(fn (b v) (persist/project-value (persist/view-refresh b v))))
; O(1) read of the last persisted snapshot value WITHOUT folding the tail. Equal
; to view-value when the view is attached (kept current on every publish);
; otherwise may lag the log by the un-refreshed tail.
(define
persist/view-peek
(fn
(b v)
(persist/project-value
(persist/snapshot-load b (get v :name) (get v :seed)))))
; attach to a hub: refresh the view on every publish to its stream
(define
persist/view-attach
(fn
(h v)
(begin
(persist/subscribe
h
(persist/view-stream v)
(fn (bk s e) (persist/view-refresh bk v)))
h)))

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

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