Compare commits

..

86 Commits

Author SHA1 Message Date
2913cdc3a8 plans: correct extraction note — declined after reading both impls
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Reading lib/mod (Prolog) and lib/acl (Datalog) side by side shows the convergence
is in module names only. Federation: opposite trust models (SX registry + decision
sharing vs in-engine Datalog trust facts + fact replication), zero shared code.
Audit: only a ~5-fn core overlaps and it diverges (entry shapes, seq base 0 vs 1,
op sets, mutation idiom) — not worth a shared module under two restricted envs.
Outcome: keep them parallel; revisit only on a third same-model consumer.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 09:10:57 +00:00
538b8a53e0 plans: shared-plumbing extraction note — defer to post-merge integration
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
mod-sx (Prolog) and acl-sx (Datalog) converged on the same module shape but run
on different engines. Only the audit log + fed trust/outbox shapes truly share;
extract at the architecture-merge point refactoring both consumers atomically,
not unilaterally from a loop branch.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 22:20:52 +00:00
739e743918 mod: Ext 19 — end-to-end triage pipeline (capstone), 390/390
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
mod/triage-pipeline domain r reports actor composes domain-policy decision →
explanation → AP activity → wire into one bundle. Integration test runs the whole
federated path across 5 modules (decide → wire → peer → trust-gated apply),
confirming the module-by-module subsystem composes end to end. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:40:36 +00:00
c19f658cf2 mod: Ext 18 — ergonomic defrule / ruleset surface, 375/375
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
mod/defrule collects trailing conditions via &rest; mod/ruleset assembles rules.
No macro needed — conditions are plain data, fn supports &rest here. Produces
structurally identical rules to mk-rule (asserted) and works in the engine
unchanged. Closes the roadmap's original defrule surface. +11 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:37:12 +00:00
2f75ab11fc mod: Ext 17 — per-domain policy registry, 364/364
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
mod/register-policy! domain rules + mod/decide-in domain r reports give each
rose-ash domain its own rule set; unregistered domains fall back to default-rules
(never unmoderated). Same spam report → remove under a strict market policy, hide
under blog default. Engine already took rules as a param, so this is registry +
fallback, no engine change. +14 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:33:24 +00:00
82fbf01bb3 mod: Ext 16 — ActivityPub-shaped decision export, 350/350
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
mod/decision->activity maps a decision to a moderation verb (remove→Delete,
ban→Block, hide/escalate→Flag, keep→no activity) shaped like an AP activity,
preserving the precise action. mod/decisions->activities batch-exports dropping
keeps. With wire (Ext 14) + fed trust (Phase 4) the federated moderation path is
end-to-end: decide → activity/wire → peer → trust-gate → apply. +17 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:28:49 +00:00
329b3c4903 mod: Ext 15 — disjunctive (:any) conditions, 333/333
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
(:any (list c1 c2 ...)) compiles to Prolog disjunction (g1 ; g2 ; ...), completing
the condition boolean algebra (AND via :when list, :not, :any). cond->goal
recurses so combinators nest arbitrarily; the proof tree shows the compiled
disjunction verbatim. Maps onto Prolog's control constructs rather than
reimplementing boolean logic in SX. +10 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:23:15 +00:00
b43901d297 mod: Ext 14 — decision wire format for federation transport, 323/323
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
mod/decision->wire emits a versioned pipe-delimited line (MOD1|r1|hide|spam-hide);
mod/wire->decision parses it back (mod/wire-valid? guards). split-char built over
slice/len (loaded env has no split). Integration test runs the full federated
path: serialize → wire → deserialize → fed-receive-decision trust-gating
(untrusted→advisory, trusted→applied). +16 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:17:19 +00:00
68c8e39508 mod: Ext 13 — SLA sweep over pending lifecycle cases, 307/307
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 6m28s
Composes lifecycle (Phase 3) with time (Ext 12): a timed-case pairs a case with
its state-entry tick; mod/overdue? flags pending cases (open/triaged/appealed)
past a deadline; mod/sla-sweep returns the breached report ids. Terminal states
never breach. Pure overlay — lifecycle stays timeless, caller stamps entry. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:08:37 +00:00
92addf5146 mod: Ext 12 — temporal burst detection, 292/292
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Reports gain an :at tick (deterministic, supplied). mod/decide-temporal counts
reports about a subject within [now-window, now], asserts burst_count/2, and a
(:burst-at-least K) rule fires only on a real burst. 3 reports at 10/11/12 → hide;
3 at 1/2/12 (window 5) → keep, while the plain count rule escalates both. Fifth
report field threaded through rebuild helpers, non-breaking. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:00:51 +00:00
8292607e38 mod: Ext 11 — batch triage + corpus analytics, 277/277
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
mod/decide-batch triages a queue; mod/action-histogram summarizes outcomes by
action; mod/rule-coverage + mod/never-fired measure which rules fire across a
corpus — the empirical complement to lint's static unreachable check (lint finds
rules that can't fire; never-fired finds rules that didn't). +17 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:56:19 +00:00
bf65de7b24 mod: Ext 10 — policy what-if / impact analysis, 260/260
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
mod/decision-diff compares one report's action under two rule sets;
mod/policy-impact batches a set and returns only the reports whose decision flips;
mod/impact-count / mod/impact-report summarize. Lets a mod team measure a policy
change's blast radius before shipping (e.g. removing spam-hide flips r1 hide→keep).
Pure SX over decide-report. +13 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:51:47 +00:00
3764b62206 mod: Ext 9 — policy dry-run trace diagnostics, 247/247
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
mod/trace-rules evaluates a report against every rule, returning each rule's
proved/unproved status + goal-by-goal derivation (an unproved rule shows which
goal failed). mod/first-proved = winner (matches engine precedence, cross-checked),
mod/proved-rules the firing set, mod/trace-report a [fires]/[ - ] rendering.
Answers 'why didn't my rule fire?' without instrumenting the engine. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:48:44 +00:00
062a76e64f mod: Ext 8 — quorum over distinct reporters (anti-brigade), 232/232
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
(:reporters-at-least N) compiles to setof(Br, report(_, Br, Sr), Bsr),
length(Bsr, Nr), Nr >= N — counts distinct reporters, not raw reports.
mod/decide-quorum asserts every report's report/3 fact (base engine scopes to the
decided report) so Prolog can aggregate reporters. One user filing 3 reports stays
:keep under quorum while the count rule escalates. Own suite. +9 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:45:28 +00:00
50eb7079e5 briefings: mod-loop — cut/backtracking allowance + sx_write_file-first + loaded-env/not(Goal) gotchas
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m15s
Make explicit that the loop may lean on Prolog backtracking (pl-query-all) and cut,
preferring clause-order precedence via pl-query-one. Default to sx_write_file over
path/pattern edits; flag that sx_insert_near drops all but the first form. Document
the loaded-env primitive restriction (includes?/chars/etc. undefined after prolog
preloads; use the tokenizer's surviving set) and that negation is the not(Goal)
functor, not the prefix \+ operator.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:30:44 +00:00
c3668e4461 mod: Ext 7 — repeat-offender escalation (audit log as evidence), 223/223
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m13s
mod/subject-sanctions counts prior hide/remove/ban decisions about a subject from
the append-only audit log; mod/decide-escalating upgrades a sanction to :ban when
the subject has >= k priors. Non-sanction outcomes (keep/escalate) pass through.
Closes the loop between audit and policy — the trail feeds future decisions. Own
suite. +19 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:29:36 +00:00
01be84b5d8 mod: Ext 6 — strictest-wins decision strategy + action severity, 204/204
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m3s
mod/decide-strictest collects every proven rule (pl-query-all) and applies the
harshest action by mod/action-severity (keep<escalate<hide<remove<ban), an
alternative to the engine's first-match precedence. Diverges from first-match
exactly when rule order and severity disagree. Same decision shape + :strategy;
engine untouched. Own suite. +14 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:20:15 +00:00
e53a292f1a mod: Ext 5 — policy rule-set lint (unreachable/catch-all/dups), 190/190
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m12s
Static analysis of a policy without running the engine: mod/unreachable-rules
flags rules after an unconditional rule (dead under first-match precedence),
mod/has-catchall? checks total coverage, mod/duplicate-rule-names + mod/rules-ok?
give a well-formedness verdict policy authors can assert. Own suite. +14 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:15:41 +00:00
3d2c1d94f2 mod: Ext 4 — report linking + dedup (Prolog-backed retrieval), 176/176
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
mod/related-ids and mod/reporters-of find reports about a subject via a Prolog
relational query (report(Id, _, 'subject')) — the policy substrate reused for
retrieval. mod/dedup-reports collapses identical reports by a normalized
reporter|subject|reason key; mod/distinct-reporters-of counts unique reporters.
Own suite (tests/link.sx). +12 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:09:37 +00:00
102c806451 mod: Ext 3 — human-readable proof explanation (mod/explain), 164/164
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 47s
mod/explain renders a decision's proof tree into legible text: action + rule,
evidence line, and each derivation goal with [proved]/[unproved] and the
unification bindings that satisfied it (e.g. {B=ann, N=3, S=dave}). Pure SX over
the Phase-2 proof data — the audit trail's 'why' made readable. +10 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:06:29 +00:00
779a592614 mod: Ext 2 — weighted/aggregate scoring (:score-at-least), 154/154
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
Report :signals ({:kind :weight}) project to signal(Id, 'kind', weight) facts;
condition (:score-at-least N) compiles to aggregate_all(sum(W), signal(Id,_,W),T),
T >= N. Low-confidence signals accumulate past a threshold via genuine Prolog
arithmetic aggregation. Default policy untouched — proven via custom rule sets.
+8 extension tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:02:52 +00:00
2ea87796a1 mod: Ext 1 — negation-as-failure conditions (:not / :attr), 146/146
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
Report attributes (:attrs) project to attr(Id, name) facts; policy gains (:attr x)
and (:not <cond>) conditions. The Prolog substrate exposes negation as a functor
not(Goal) (the prefix \+ operator doesn't parse here). Closed-world example:
hide spam unless author verified. Default policy untouched — feature proven via
custom rule sets, so all 132 base tests stay green. +14 extension tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:59:01 +00:00
ee9851c063 mod: Phase 4 — federation (trust, sharing, revocation), 132/132 — roadmap done
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
Cross-instance reports ingest into the local registry with origin tags; the
engine decides them unchanged. Decision sharing pushes to a mock fed-sx outbox
(mod/fed-send! is the transport seam). Trust is advisory by default: a peer's
decision binds locally only under (mod/trusted? peer :mod), else it lands in the
advisory log unapplied. Revocation composes with the Phase-2 proof model —
fed-revoke-if-invalidated re-runs the engine and undoes moderation only when the
action no longer holds (exoneration flips hide→keep → revoked + origin notified).
+26 fed tests. Full mod-on-sx roadmap complete.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:54:37 +00:00
f4f34c1d33 mod: Phase 3 — lifecycle state machine + escalation + appeal, 106/106
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Pure SX state machine (lib/mod/lifecycle.sx) over the engine:
open→triaged→decided→appealed→final, transition table guards illegal moves.
Auto-tier resolves terminal actions; escalate parks at human-tier (resolve
blocked until review supplies evidence). Appeal re-runs the engine — new
exonerated-keep rule at top precedence lets exoneration override a prior hide.
Api façade (mod/triage/resolve/review/appeal/finalize) over a case registry,
logging committed decisions to the audit trail. +46 escalation tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:50:05 +00:00
6e825e1283 mod: Phase 2 — evidence accumulation + proof trees + audit log, 60/60
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m7s
Reports carry an :evidence list, asserted as evidence/3 facts; reviewer-remove
rule (highest precedence) lets human review override classification. Proof tree
built constructively by re-querying each rule body goal against the same DB with
the report id bound, so derivations carry real unification bindings. Append-only
audit log records decision + proof + evidence snapshot per decide, monotonic seq,
never mutates prior entries. +29 audit tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:37:02 +00:00
8dfc987095 mod: Phase 1 — report schema + policy engine on Prolog, 31/31
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s
Reports → Prolog facts (report/3, classification/2, report_count/2); ordered
policy rules compile to policy_action/3 clauses, first match wins via
pl-query-one. Decisions carry their proof (matching rule + conditions +
evidence). Spam/abuse keyword classification, repeated-report escalation via
Prolog join+arithmetic, no-rule→keep default. Registry api + conformance harness.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:30:50 +00:00
72174941aa briefings: add mod-on-sx loop briefing
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:18:02 +00:00
c3a0727645 plans: five rose-ash subsystem plans + three loop briefings
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
Plans for acl-on-sx (Datalog), flow-on-sx (Scheme), feed-on-sx (APL),
mod-on-sx (Prolog), search-on-sx (Haskell). Each is a 4-phase queue
sitting on its respective guest language, targeting rose-ash needs:
access control, durable workflows, activity feeds, moderation, search.
Federation extension in Phase 4 of each (plugs into fed-sx).

Briefings for the three loops we're kicking off now: acl-loop,
flow-loop, feed-loop. mod-sx and search-sx briefings will follow
once the first three have surfaced any shared infrastructure
worth extracting to lib/guest/.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-06 15:55:39 +00:00
1b94082a71 Merge loops/erlang into architecture: Erlang substrate fixes (FFI + tokenizer + charlists + integer literals)
Four small, contained substrate fixes that came out of the fed-sx-m1 milestone work — all scoped to
lib/erlang/, no other-language regressions:

  c6f397c3  register binary_to_list/1 + list_to_binary/1 BIFs (+9 ffi tests, 738/738)
  9fe5c904  $X char literals decode to char code in tokenizer (+12 eval tests, 750/750)
  5098a8f0  atom_to_list/integer_to_list return Erlang charlists; list_to_* accept both (+9 eval, 759/759)
  bcabed6b  integer literals truncate to strict int (was float; broke integer->char)

Together these complete the byte-level term-codec primitive set:
  binary_to_list / list_to_binary (iolist-aware; round-trips for free)
  $X char literals decoding to int char codes
  atom_to_list / integer_to_list returning standard Erlang charlists
  integer literals coercing to strict int (not float)

Any Erlang-on-SX consumer that needs to construct/deconstruct byte sequences or work with charlists now
does so with standard Erlang semantics. Scoreboard: 759/759 (full Erlang suite).

Loop branch loops/erlang stays alive for future Erlang substrate work; this just lands the closed deliverables.
2026-06-06 15:45:46 +00:00
57184daaee briefings: add kernel-on-sx loop briefing
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Sibling to apl-loop / common-lisp-loop / scheme-loop. Captures the
queue-driven kernel loop pattern (Phase B stratification entry-point,
env-as-value successor, motivates lib/guest/reflective/).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-06 15:28:09 +00:00
d9e2627b89 Merge loops/go into architecture: Go-on-SX, 609/609 across 11 phases, loop closed
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
2026-06-06 15:17:17 +00:00
bcabed6bce erlang: integer literals truncate to strict int (was float; broke integer->char)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-06-06 08:05:57 +00:00
5098a8f015 erlang: atom_to_list/integer_to_list return Erlang charlists; list_to_* accept both (+9 net eval, 759/759) 2026-06-06 08:04:45 +00:00
9fe5c9044d erlang: $X char literals decode to char code in tokenizer (+12 eval tests, 750/750) 2026-06-06 08:03:46 +00:00
c6f397c3d9 erlang: register binary_to_list/1 + list_to_binary/1 BIFs (+9 ffi tests, 738/738) 2026-06-06 08:02:36 +00:00
f553d5b0aa go: tick Phases 4 + 5b + 11 — every phase box , loop formally closed [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
Phase 4 (tree-walk evaluator): acceptance bar (80+ tests) was
crossed long ago; remaining sub-items (pointer semantics, lexical
closures, multi-return) flagged "don't gate Phase 5" — ticking the
phase box now.

Phase 5b (buffered channels + select fairness): deferred-by-design.
Re-open when real preemption lands in lib/guest/scheduler.

Phase 11 (VM bytecode opcodes): deferred-by-design. Re-open when
an e2e program takes > 10s, sister kits need bytecode-shape input,
or scheduler kit needs reified frame state.

Stop condition #3 (every Phase 1-11 box checked) satisfied. Final
state: 12 phase boxes ticked, 7 test suites, 609/609 passing,
sister-plan Phase-1 boxes ticked + diaries populated with the
chisel summary. Go-on-SX loop exits.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-28 03:48:07 +00:00
14486dd78f go: Phase 10 closed — sister plans cross-referenced [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
plans/lib-guest-scheduler.md and plans/lib-guest-static-types-
bidirectional.md both have Phase 1 ticked complete from Go's side
with status blocks enumerating what landed.

Each sister diary received a consolidated chisel-summary entry:
the kit primitives the Go consumer chiselled out, the three
pluggable predicates / orthogonal first-class-tag axes, and the
v0 limitations the eventual kit must lift.

No new Go code — Phase 10 is doc-only per plan. Go-on-SX loop
fully landed: 11 phases, 7 test suites, 609/609 passing.
Two-consumer rule per sister plan now waits on TypeScript (Phase 2
of the bidirectional sister plan, owned outside this loop).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-28 03:14:12 +00:00
9036ce3400 go: Phase 9 closed — 12 end-to-end programs, total 609/609 [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
12 canonical Go programs running through the full pipeline (lex +
parse + types + eval + sched + stdlib): sieve-of-Eratosthenes via
boolean slice (modulo-free), linear search, slice reverse, fib(10),
sum-of-squares via generic Map+Reduce, word-freq counter, channel
pipeline (gen→sq→sum), worker pool, bubble sort, sentence-reverse,
Filter+len, Ackermann, defer+recover on div-by-zero.

Each test threads ONE self-contained Go program through go-eval-
program. The v0 limitations chiselled in earlier phases (float
division, sync spawn, type erasure, nil-as-unbound) are now
durable as commit-trail artifacts; e2e variants written to avoid
them where possible. HTTP-ish ping-pong + WaitGroup deferred
(real preemption + sync package needed).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-28 02:45:36 +00:00
8c91b34264 go: Phase 8 first slice — stdlib strings/strconv, 41 tests, +40 cleared [shapes-static-types-bidirectional]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
New :go-package NAME ENTRIES value type with field lookup via
extended go-eval-select. New :go-builtin-fn callable for closure-
based stdlib functions. lib/go/std/strings.sx ships 12 functions
(Contains, HasPrefix, HasSuffix, Index, Count, Repeat, Join,
ToUpper, ToLower, TrimSpace, Split, Replace) + lib/go/std/strconv.sx
ships Itoa/Atoi.

Pre-existing bug fixed: parser was emitting (:literal V) for both
`42` and `"42"`, relying on first-char heuristic in eval/types.
Now emits :literal-string for string/rune literals so Atoi("42")
correctly receives the string. 3 parse tests + 2 in-composite-key
tests updated to new shape.

Total 597/597. Stdlib 41/41 — +40 acceptance bar cleared. Sister
diary documents the 11 value-type kinds (struct/slice/map/chan/
fn/method/builtin/builtin-fn/package/panic/defer) all sharing the
"(:KIND PAYLOAD...)" shape, alongside AST nodes and sentinel signals
as the kit's three orthogonal first-class-tag axes.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-28 02:14:55 +00:00
a7902df365 go: Phase 7 generics closed — types 102/102, +30 cleared, total 556/556 [shapes-static-types-bidirectional]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
Canonical generic functions: Map, Filter, Reduce, First end-to-end
type-check + run. Plus 20+ typer-only shape tests covering Apply,
Compose, ToMap, Swap, Box, Triple, ToSlice, Take, Send, Fill, Eq,
Values, Pair, Inspect, etc. Index synth (slice/array/map →
element type) added to typer.

v0 limitations stamped in tests: SX `/` is float (no int mod
emulation), `var r []T` indistinguishable from unbound, single-name
constraints opaque (no type-set arithmetic).

Shape locked in: "the parser recognizes shapes, the validator
recognizes roles." Same AST + different role-validators = different
guest semantics. Diary documents this as the lemma the kit should
extract — three deliverables (binding-groups, control-flow sentinels,
index synthesis) now all instantiate it.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-28 01:25:23 +00:00
459427512d go: Phase 7 foundation — generics syntax through parser/typer/eval [shapes-static-types-bidirectional]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
gp-parse-type-params consumes the optional [NAMES CONSTRAINT, ...]
clause after a func name. AST stays backward-compatible: 5-slot
func-decl when no [...] is present, 6-slot when it is.

Typer binds each type-param name as (:ty-param NAME CONSTRAINT) so
body's (:ty-name "T") references resolve. Eval is type-erasing —
ignores type info, dispatches by name + arity.

10 new tests: parse (3), types (5), eval (2). Total 527/527.

Shape: the field binding-group from the canonical kit now feeds
6 consumers (struct fields, var-decls, const-decls, params,
receivers, type-params). Confirms it as a TRUE cross-deliverable
shape — sister-plan diary documents the 5 roles binding-groups
take and why the kit should expose ONE parser + pluggable validators.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-28 00:31:28 +00:00
c50f5d5155 go: goroutine-panic propagation + 8 corner tests → eval 100/100, Phase 6 acceptance cleared [shapes-scheduler]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Wired panic through :go stmt (v0 sync surfaces back to spawner —
matches real Go's "crash whole program" end-effect) and through
go-eval-for (was swallowing panic at the loop boundary).

8 tests added: goroutine-panic-surfaces, goroutine-recover-via-
spawner-defer, multi-defer-LIFO-with-recover, defer-fires-on-panic-
path, panic(nil), panic-in-loop, defer-still-runs-in-panicking-fn,
args-eager-on-panic-path. 20 Phase-6 tests total; +20 acceptance
bar cleared (eval/ 80 → 100).

Shape: 4 control-flow sites now repeat the same sentinel dispatch
arm (return-value, break, continue, eval-error, go-panic). The
scheduler kit should bake in a single propagates? helper rather
than have each guest evaluator list every sentinel inline — diary
documents the cross-cutting abstraction.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 23:54:56 +00:00
f52ad1fac6 go: panic + recover → eval 92/92, total 509/509, Phase 6 closed [shapes-scheduler]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Panic/recover builtins + per-frame __go-panic-cell of shape
(STATE V). Body panic flips cell :none→:raised BEFORE defers drain
so recover() can find it. recover() walks env chain past shadowing
cells to the outermost :raised one — flips it :recovered, returns V.
Frame exit checks cell: :recovered → return clean; :raised →
propagate (:go-panic V).

6 tests: uncaught-from-program, panic-from-fn, defer-recover-swallow,
recover-captures-via-channel, propagation-through-no-defer-chain,
middle-frame-catches-deeper-panic.

Shape: panic cell is a frame-attached out-of-band channel that
survives function boundaries via env-chain walk. Same primitive
slots into the scheduler kit's termination-record + cleanup-with-
error-context hook. Maps cleanly to Erlang try/catch/after.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 23:20:46 +00:00
219e2fcfe7 go: defer + LIFO drain → eval 86/86, total 503/503 [shapes-scheduler]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
Phase 6 first slice. New :defer stmt dispatch, go-eval-defer-stmt
captures (callee, eagerly-evaluated args) onto a frame-local
__go-defer-stack mutable list. go-eval-call installs the stack and
drains LIFO before returning; go-eval-program does the same for
the implicit main frame. New :quoted-value AST node lets defer
re-invoke calls with the frozen arg values.

6 eval tests: single defer, multi-LIFO, args-eager-at-defer-time,
fires-on-early-return, frame-local (no bleed to outer), defer-in-loop.

Shape: defer is a per-frame cleanup queue (LIFO on frame exit) that
the scheduler kit will reuse for panic-unwind + clean-exit + select-
case-rollback paths. Distinct from the scheduler's ready-queue —
diary updated to keep that distinction explicit.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 23:00:37 +00:00
1d3021d206 go: after(d) timer stub + 13 pattern tests → runtime 40/40, Phase 5 closed [shapes-scheduler]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Acceptance bar hit (40 runtime, 497 total). Tests: timer ready,
select-with-timeout, fan-in (3 producers), worker queue, pipeline,
fan-out-then-fan-in, select source-order, fallback case, default,
producer-consumer, two-stage pipeline, channel-counter, after+default,
tick-collector.

Shape chiselled: timer collapses "after duration" into
"channel ready immediately" — select needs only ready? from each
case. Real time is when the flip happens, not what the protocol is.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 22:24:13 +00:00
fa99652970 go: eval.sx — range-over-{slice,map,chan} + 7 tests; break-env fix [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
Phase 5 cont. New go-eval-range-for handles the parser's :range-for
AST shape. Dispatches on the collection's runtime type:

  :go-slice  → bind index + element, iterate by position
  :go-map    → bind key + value, walk entries assoc list
  :go-chan   → bind value, drain until buffer empty (v0 limitation)

Each loop carries:
  - go-range-extend: handles 0/1/2-name binding patterns uniformly
  - go-range-body:   evaluates body whether it's a :block or other shape
  - per-collection loop helper: threads env, catches :break/:continue/
    :return-value/:eval-error sentinels

**Subtle break fix:** loops were previously returning the *pre-loop*
env when break fired, clobbering all assignments made in prior
iterations. Now returns the current iteration's input env (which
carries forward successful iterations' state). Patched for the three
range variants and for the regular for-loop where the same pattern
applied. The shape:

  (= r :break) env    ;; was: (= r :break) original-env

Tests:
  range: slice — sum of 1..5 = 15
  range: slice — key only (index)
  range: map — sum values
  range: channel — collect all buffered
  range: slice with break exits early
  range: slice with continue skips an element
  range: empty slice — body never runs
  range: chan + goroutine producer

runtime 26/26, total 483/483.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 22:09:46 +00:00
4807bc9c58 go: eval.sx + sched.sx — select stmt evaluation + 6 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Phase 5 cont. Adds `select` statement evaluation:

  go-select-try-case env COMM →
    :not-ready / extended-env / :eval-error
  go-select-pick env CASES DEFAULT-OR-NIL →
    body-result / blocked-error
  go-eval-select-stmt env STMT  — public entry

Walks cases in declared order:
  * :send case — always ready in v0 (unbounded buffer). Sends value
    via go-chan-send! and returns env unchanged.
  * :short-decl / :assign case — RHS expected to be unary <- on a
    channel. Ready iff go-chan-len > 0; on success, recv-into-var
    binds the new value in env.
  * Bare recv (:app (:var "<-") [CHAN]) — ready iff len > 0; consumes
    the value (discarded).
  * :default — deferred until end of walk. Runs if no other case
    ready. Absence + no ready case → (:eval-error :select-blocked-
    no-default).

New `go-chan-len` accessor on the channel closure-bundle so the
select can peek without consuming.

Subtle bug fix: the :select stmt branch in go-eval-stmt was returning
the old env instead of the env returned by the case body. Assignments
inside select cases (`select { case <-ch: x = 1 ; default: x = 99 }`)
now stick.

Tests (6):
  default fires when no case ready
  recv case fires when ready
  recv-into-var binds the value
  send case always ready
  picks first ready case (deterministic order in v0)
  no default + nothing ready → blocked error
  combined with goroutine fan-in

runtime 18/18, total 475/475.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 22:03:17 +00:00
b693854dc4 go: sched.sx — channels + goroutines (v0 synchronous) + 12 tests; Phase 5 starts [shapes-scheduler]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
Phase 5 (goroutines + channels) opens.

lib/go/sched.sx is the **independent implementation** referenced by
plans/lib-guest-scheduler.md — the first-consumer cut whose realised
shape will inform the eventual sister kit.

Channel representation:
  (list :go-chan SEND-FN RECV-FN CLOSED?-FN CLOSE!-FN)
Each closure shares a mutable `buf` (a list mutated via append! and
set!) and a `closed` flag. Channel identity is closure-instance —
two `make()` calls produce distinct values per Go spec § Channel types.

Primitive API in sched.sx:
  go-make-chan / go-chan? / go-chan-send! / go-chan-recv! /
  go-chan-closed? / go-chan-close!

Eval integration in eval.sx:
  * `make` and `close` added as builtins. v0 `make()` takes no args
    and returns an unbounded-buffer channel.
  * `:send` stmt → go-chan-send! on the channel.
  * Unary `<-` recv on channel values → go-chan-recv!. `:empty`
    sentinel converted to nil (stand-in for blocking semantics).
  * `:go expr` → synchronous eval (v0 limitation, see sched.sx
    header).

**v0 concurrency model — synchronous goroutines.** SX doesn't expose
first-class continuations to guest code, so v0 runs `go f()`
immediately and depends on the spawned goroutine running to
completion before the main goroutine receives. This is the right
semantics for the simple producer/consumer patterns covered here.
True preemption with blocking send/recv is Phase 5b — requires either
a CEK-style trampolining eval rewrite or kit-level continuation
support. Logged in sched.sx header and in the sister-plan diary.

Runtime suite (12 tests):
  * 6 direct API tests: identity, FIFO order, closed-flag
  * 6 source-level: make + send + recv, go ping-pong, close,
    multi-goroutine fan-in, worker-with-result

Sister-plan scheduler diary updated with the channel-as-closure-
bundle insight and the v0 synchronous-spawn caveat.

runtime 12/12, total 469/469.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:55:41 +00:00
674d8115b8 go: eval.sx — method dispatch + unary + e2e programs + 14 tests; Phase 4 bar crossed [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Phase 4 cont. The crossings:

  * Method dispatch — Methods record under #method/TYPE/NAME (same
    mangled-key scheme the type checker uses, intentionally so eval
    and type checker can converge on a shared method-table protocol
    later). go-eval-method-call: lookup the receiver type's method,
    bind receiver param to the struct value, evaluate body. Value and
    pointer receivers treated the same in v0 (pointer semantics not
    modelled yet).
  * Method-call dispatch — In go-eval's :app branch, head=:select
    routes to go-eval-method-call. If the receiver is not a struct,
    falls back to the field-as-callable path.
  * Unary prefix ops — go-eval's :app branch checks for 1-arg :var
    head with op name "-" / "+" / "!". (Other unary ops like
    *p / &v / <-ch / ^x deferred until pointer / channel / bitwise
    semantics arrive.)

End-to-end programs verified:
  * recursive fib(10) = 55
  * struct + method + iterative loop (counter bump 7 times)
  * linear search (returns index or -1)
  * factorial via method on Counter (= 120)
  * count odd numbers in 1..10 = 5

**Phase 4 acceptance bar (80+) crossed: eval 80/80, total 457/457.**

Remaining Phase 4 work (closures, multi-return, full slice triple,
pointer semantics) refines but doesn't gate Phase 5 (goroutines).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:47:07 +00:00
99f8f37ff8 go: eval.sx — structs + selector + selector-assign + 8 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
Phase 4 cont. Adds runtime support for Go's struct type.

Struct representation: (list :go-struct TYPE-NAME FIELDS) where
FIELDS is an association list of (field-name value) pairs.

`type T struct { ... }` is now significant at eval-time. The new
go-eval-type-decl registers field-name lists in env under
(:go-struct-type FIELD-NAMES) so positional composite literals can
map argument positions to field names. Non-struct type aliases are
silent no-ops in v0.

go-eval-composite extended:
  * If type is (:var TYPE-NAME), look up in env. Must be a
    :go-struct-type entry — error otherwise.
  * go-eval-struct-lit branches on whether the first elem is :kv
    (keyed) or not (positional). Keyed mode reads key-name from each
    :kv's key (which is a :var node). Positional mode arity-checks
    against the field-names list and zips positionally.

go-eval-select handles (:select OBJ FIELD-NAME) — field lookup with
go-map-get on the FIELDS assoc list.

go-eval-assign-pairs gets a new (:select OBJ FIELD) LHS branch:
  - var-rooted only for v0
  - rebuilds the struct via go-map-set, rebinds the var

**Functions taking and returning structs round-trip end-to-end:**

  type Point struct { x, y int }
  func add(a, b Point) Point { return Point{a.x + b.x, a.y + b.y} }
  add(Point{1, 2}, Point{3, 4})  // Point{4, 6}

Method-dispatch (calling p.M() where M is a method on Point's type)
is the next step; needs threading the type checker's #method/T/N
scheme into eval-time so functions can be looked up by receiver type.

eval 66/66, total 443/443.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:39:06 +00:00
9ed58bd0fc go: eval.sx — maps + index-assign + 8 tests; word-count e2e [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
Phase 4 cont. Adds map values and index-assignment for both
slices and maps.

Map representation: (list :go-map ENTRIES) where ENTRIES is an
association list of (key value) pairs.

  go-map-get / go-map-set    — primitive lookup + functional-update.
  go-slice-set               — same idea for slices.

go-extract-map-entries reads each :kv element in a composite literal,
evaluating key and value. go-eval-composite dispatches on :ty-map to
build the :go-map value.

go-eval-index extended: when OBJ is a :go-map, look up the key via
go-map-get. Missing keys return nil in v0 (Go's real semantics is
the zero value of the value type — needs runtime type info that this
slice doesn't yet thread through).

go-eval-builtin's len handles :go-map alongside :go-slice and strings.

go-eval-assign-pairs gets a new branch for (:index OBJ IDX) LHS:
  - var-rooted indexing only (a[i] = v / m["k"] = v)
  - slice → go-slice-set then rebind the var
  - map   → go-map-set then rebind the var

**Word-counter via map[string]int works end-to-end:**

  words := []string{"a", "b", "a", "c", "a"}
  counts := map[string]int{}
  for i := 0; i < len(words); i++ {
    counts[words[i]] = counts[words[i]] + 1
  }
  // counts["a"] == 3

Builds on:
  - map composite literal eval
  - map index lookup
  - map index-assign
  - slice indexing
  - len() builtin
  - nil + 1 = 1 (numeric-coercion of missing-key default)

eval 58/58, total 435/435.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:33:17 +00:00
ab04ec1cf7 go: eval.sx — slices + index + slice expr + len/append builtins + 10 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
Phase 4 cont. Adds runtime support for Go's slice type.

Slice representation: (list :go-slice ELEMS) — a simple wrapper around
a list of element values. v0 deferring the full
(length, capacity, backing-vector) triple from the Go spec until
programs need it.

  go-eval-composite      → for (:composite TYPE-OR-EXPR ELEMS) where
                            TYPE is :ty-slice / :ty-array, eval each
                            element (handling :kv index-keyed
                            shorthand by taking only the value) and
                            wrap in :go-slice.
  go-eval-index          → (:index OBJ IDX). Bounds-checked; out-of-
                            range returns (:eval-error :index-out-of-range).
  go-eval-slice          → (:slice OBJ LOW HIGH MAX). Two-index slice
                            with omitted low → 0, omitted high → len.
                            Returns a new :go-slice.
  go-list-slice          → primitive list-slicing helper.

Builtins live in a new starter env go-env-builtins:
  len(slice|string)      → count
  append(slice, ...x)    → new slice with x appended
  print(...)             → no-op in v0

Builtins are bound as (:go-builtin NAME); go-eval-call recognises the
shape and routes to go-eval-builtin instead of go-eval-fn.

**Summing a slice via the canonical Go for-loop works end-to-end:**

  a := []int{1, 2, 3, 4, 5}
  sum := 0
  for i := 0; i < len(a); i++ {
    sum = sum + a[i]
  }
  // sum == 15

eval 50/50, total 427/427.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:28:12 +00:00
a019aa1edc go: eval.sx — for / break / continue / inc-dec + 7 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
Phase 4 cont. go-eval-for handles all three for-header shapes:

  for { ... }                          — infinite (cond defaults to true)
  for cond { ... }                     — while-like (init=nil, post=nil)
  for init ; cond ; post { ... }       — C-style

Implementation:
  * Run INIT (if any), extending env.
  * Loop: eval COND. If false, exit with current env.
    Eval body (a :block). Catch sentinels:
      :return-value → propagate up
      :break        → exit loop with pre-break env
      :continue     → still runs POST, then re-loops
    Otherwise: run POST, re-loop.

:break and :continue propagate as keyword sentinels through
go-eval-block alongside the existing :return-value sentinel. The
block returns whichever sentinel hit first; control-flow constructs
(for, switch, select) catch them.

inc-dec (x++ / x--) updates env via the same shadowing model used by
assign — `(go-env-extend env name (+ current 1))`.

**Iterative fact(5) = 120 and the classic sum-to-9 = 45 both
evaluate.** Demonstrates the for-loop machinery is solid enough for
real programs.

eval 40/40, total 417/417.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:22:34 +00:00
1340c2626b go: eval.sx — stmts + function application; recursive fib evaluates + 8 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Phase 4 cont. go-eval-stmt dispatches on:
  :return       → wraps value in (:return-value V) sentinel
  :var-decl     → bind each NAME via go-eval-var-decl
  :short-decl   → bind each (:var NAME) lhs to corresponding expr value
  :assign       → immutable-env shadowing (true mutation deferred)
  :block        → run stmts via go-eval-block, propagating :return-value
  :if / :else   → cond-driven dispatch
  :func-decl    → bind name to (list :go-fn PARAMS BODY)
  else          → expression statement, evaluate for side effects

go-eval-call extends the CALLER's env with param-names → arg-values
(dynamic-scope-ish — closures don't capture lexical env yet), runs the
body block, catches :return-value and unwraps.

**Recursive fib(5) = 5 evaluates correctly.** Recursion works because
top-level func bindings are in the calling env before the recursive
call happens.

True lexical closures (let bind sees outer var; assignments visible to
nested funcs) need an env-cell model with mutation; deferred to a
later slice.

eval 33/33, total 410/410.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:17:26 +00:00
ff9abe3ae6 go: eval.sx scaffold — literals + vars + binops + 25 tests; Phase 3 closed [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Phase 3 — bidirectional type checker — is fully ticked (short-decl
was already implemented). Phase 4 starts here.

lib/go/eval.sx single judgment:

  (go-eval ENV EXPR)  →  VALUE | (list :eval-error TAG ...)

ENV is an association list of (NAME VALUE) bindings — same shape as
the type checker's ctx, but the entries are runtime values. Values
are represented directly in SX: integers/floats as SX numbers,
strings as SX strings, booleans as true/false, nil as nil. Composite
values (slices/maps/structs/pointers/channels) arrive in later slices.

First-slice coverage:

  * go-env-empty / -lookup / -extend
  * Literal decoding:
      decimal (with underscores)
      hex (0x.. / 0X..)
      oct (0o.. / 0O..)
      bin (0b.. / 0B..)
    via go-hex-digit-value (explicit char equality — SX's nth on
    strings returns single-char strings, not numeric codes; the
    arithmetic-on-char-codes pattern from the OCaml kernel ports
    doesn't work here).
  * Identifier lookup with predeclared true / false / nil.
  * Binops: + - * / and the six comparison ops and && / ||.
  * Errors as (:eval-error TAG ...) sentinels.

Statements (block / return / short-decl / assign), control flow
(if / for), and function application / closures arrive in subsequent
slices.

eval 25/25, total 402/402.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:11:20 +00:00
21bb17e4a6 go: types.sx — interface satisfaction (structural method-set check) + 7 tests [shapes-static-types-bidirectional]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
Phase 3 cont. The headline Go-distinguishing typing feature: interfaces
are satisfied *structurally and silently* — no `implements` declaration,
no nominal subtyping. Any type whose method set contains all the
interface's methods (with matching signatures) satisfies it.

Method declarations now type-check via go-check-method-decl:

  * Receiver type extracted (T or *T → "T") via go-extract-recv-ty-name.
  * Method signature (:ty-func PARAMS RESULTS) bound under a mangled
    key "#method/RECV-NAME/METHOD-NAME" in ctx.
  * Body checked with receiver + params extended into the body ctx.

go-iface-satisfies? CTX TY-NAME IFACE-TYPE walks the interface's
:method elements; for each, looks up #method/TY-NAME/METHOD-NAME and
compares (PARAMS, RESULTS) tuples. Embedded interfaces (:embed
elements) skipped in v0 — recursive interface resolution later.

Tests:
  * method-decl binds under #method/Point/String
  * pointer-receiver method also keys the base type
  * Point with String() satisfies interface { String() string }
  * empty type does NOT satisfy Stringer
  * arity-mismatch method fails satisfaction
  * multi-method satisfaction works
  * partial method-set fails

types 72/72, total 377/377. Phase 3 sub-deliverable list is now
substantially complete; only AST-path error context remains as a UX
sharpener.

Sister-plan static-types-bidirectional diary updated with the
**constraint-satisfies? pluggable predicate** kit-API proposal —
third pluggable point after synth/check + assignable?. Go interfaces,
Haskell typeclasses, Rust traits, and TS structural subtyping all
answer "does this value-type fit this constraint-type?" with
different machinery; the kit's check uses constraint-satisfies? when
EXPECTED is itself a constraint type.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:05:08 +00:00
4bd9262060 go: types.sx — composite-literal element checking; Phase 3 bar crossed + 10 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
Phase 3 cont. Adds composite-literal type-checking via go-synth-composite:

  []T{...}     — go-check-composite-elems with VAL-TY=T, KEY-TY=nil.
                 Each plain elem assignable to T; :kv element accepted
                 (Go's index-keyed shorthand: `[]int{0: 5, 1: 10}`)
                 with only the value checked.
  [N]T{...}    — same as slice; result :ty-array N T.
  map[K]V{...} — KEY-TY=K, VAL-TY=V. Each :kv pair: key assignable
                 to K, value to V. Non-:kv elements in maps are
                 (:type-error :map-elem-missing-key).

The literal's *synthesised* type is the type expression itself, so
nested composites fall out by recursion:

  [][]int{[]int{1,2}, []int{3,4}}
    → outer: go-check-composite-elems with VAL-TY=[]int
    → each inner []int{1,2} goes through go-synth-composite recursively,
      yielding :ty-slice :ty-name "int" — assignable-equal to VAL-TY.

Coverage: positive cases (homogeneous slices/arrays/maps, empty
slice, nested), and three negative cases (slice element mismatch,
map key mismatch, map value mismatch). Also a decl test:
  var x = []int{1, 2, 3}  →  binds x to :ty-slice :ty-name "int"

Named-type literals (`Point{1,2}`, `pkg.T{...}`) need type-decl-driven
field resolution; deferred. Interface satisfaction and AST-path error
context also remain — neither gates Phase 4.

**Phase 3 acceptance bar (60+) crossed: types 65/65, total 370/370.**

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:59:38 +00:00
5b4a8be689 go: types.sx — call type-checking + 8 tests; recursive funcs now type [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Phase 3 cont. The expression-synth :app dispatch is now bifurcated:

  * go-is-binop-call? — head is :var with an operator name AND 2 args
    AND the operator is in one of the binop tables. Short-circuits to
    go-synth-binop as before.
  * Everything else routes to go-synth-call.

go-synth-call:
  1. Synth the callee. Must produce a (list :ty-func PARAMS RESULTS).
     Otherwise → (:type-error :not-callable TYPE).
  2. Arity-check args vs params. Mismatch → (:type-error :arity-mismatch).
  3. go-check-args-against: each arg assignable to corresponding param
     (untyped-constant flow works — `f(42)` accepts the untyped int
     into an int param).
  4. Result by count:
       0 results → (list :ty-void)
       1 result  → that result directly
       N results → (list :ty-tuple TYPES)   for multi-return

The recursive case lights up: go-check-func-decl binds the function
in its own body's ctx before checking. So:

  func fib(n int) int { return fib(n) + fib(n) }

now type-checks because `fib` resolves inside the body, synth-call
sees its `:ty-func` and verifies the recursive call. Multi-return
functions destructure into `:ty-tuple` which short-decl will need to
consume next iteration.

types 55/55, total 360/360.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:56:10 +00:00
9f4c6787e4 go: types.sx — func-decl + stmt-level dispatch + 7 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
Phase 3 cont. Adds:

  * go-check-func-decl — binds the function in the outer ctx (recursive
    self-reference will work once call-checking lands), extends the
    body's ctx with each :field param group via go-ctx-extend-field
    (the binding-group shape's *third* consumer in the type checker;
    five total across parser+typer when counted with struct fields,
    var-decls, const-decls, func params, method receivers).
  * go-check-stmt — dispatches on :return / :assign / :var-decl /
    :const-decl / :short-decl / :type-decl / :block; falls back to
    go-synth for expression statements.
  * go-check-block — threads ctx through stmts so that decls inside
    the block extend the ctx for subsequent stmts.
  * go-check-return-list — each return expr assignable to the
    corresponding declared result type; mismatch counts are typed.
  * go-check-assign / go-check-assign-pairs — RHS assignable to LHS
    synthesised type, count mismatch typed.
  * Helpers: go-decl-params-to-ty-list (flattens :field NAMES TYPE to
    a flat list of N types), go-extend-with-params (folds extend-field
    over a param-group list), go-repeat-ty.

Coverage tests:
  func empty() {}                                          → ok
  func add(x, y int) int { return x + y }                  → ok
  func bad() int { return "hi" }                           → typed error
  func sig(x int) int                                      → signature-only binds
  func sumsq(x, y int) int { return x*x + y*y }            → params visible
  func two() int { var x int = 1; var y int = 2;           → nested decl
                   return x + y }
  func g() int { var x int; x = 5; return x }              → assign verified

types 47/47, total 352/352.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:52:59 +00:00
5e27a7f0c9 go: types.sx — declaration checking (var/const/type + :=) + 12 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Phase 3 cont. Adds go-check-decl which dispatches on AST shape and
returns either the extended context or a :type-error:

  :var-decl     (:field NAMES TYPE-or-nil) EXPRS-or-nil
  :const-decl   (same shape; same logic in v0 — mutability later)
  :short-decl   LHS-LIST EXPRS         (lhs is a list of :var nodes)
  :type-decl    NAME TYPE              (type alias)

New helpers:

  go-default-type      — untyped-int → int, untyped-float → float64,
                         etc. Used when inferring var x = EXPR.
  go-check-exprs-against — every expr assignable to the declared type.
  go-bind-names-to-synth  — pair names with default-typed synth of
                            corresponding exprs; extends ctx.

The canonical Go pitfall flows through end-to-end now:

  (go-check-decl ctx (go-parse "var x float64 = 42 / 7"))
  →  ctx + (x → float64)

Because: 42/7 synthesises to ty-untyped-int (binop result of two
untyped operands), then go-check-exprs-against uses go-type-assignable?
to check ty-untyped-int → ty-name "float64" — :ok via the
untyped-int-to-any-numeric assignability rule. The 6 (integer) result
gets float-converted on assignment, never floated mid-computation.

types 40/40, total 345/345.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:49:27 +00:00
86ddaf255c go: types.sx — literal synth + binop + assignability; canonical pitfall handled + 16 tests [shapes-static-types-bidirectional]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
Phase 3 cont. Adds:

  * go-classify-literal-string — heuristic detection of literal kind
    from the value-string (parser strips lexer's kind tag; flagged for
    follow-up to extend AST shape).
  * go-synth-literal — :ty-untyped-int / -float / -imag / -string.
  * go-synth-binop — arithmetic, bitwise, comparison, logical ops with
    untyped-constant unification:
      untyped-int + untyped-float → untyped-float
      untyped + typed              → typed
      comparison ops               → bool
      logical ops                  → bool
  * go-untyped? + go-type-assignable? — pluggable assignability that
    swaps in where structural equality used to gate go-check. Untyped
    int assignable to any numeric type; untyped float assignable to
    float/complex; untyped string to string.

**Canonical Go pitfall handled correctly**: `var x float64 = 42 / 7`
parses to a binop, synth produces :ty-untyped-int (since BOTH operands
are untyped, the int division stays in the int domain), and check
against float64 returns :ok via assignability. Wrong implementations
that float-coerce eagerly would give 6.0; the right behaviour is
"compute 6 as int, then convert to float64 = 6.0".

Verified by test "binop: 42 / 7 assignable to float64 (canonical
pitfall)" and the type-only test "binop: 42 / 7 — untyped int".

Sister-plan static-types-bidirectional diary updated with the
**pluggable-assignable-predicate** kit-API proposal:

  (check-with assignable? CTX EXPR EXPECTED)

Each consumer plugs in its own variance discipline (Go untyped-flow,
TS structural subtyping, Rust lifetime-aware identity) without
rewriting synth or the judgment skeleton.

types 28/28, total 333/333.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:46:03 +00:00
6c3b7d1cf9 go: types.sx scaffold — synth/check skeleton + 12 tests; Phase 3 starts [shapes-static-types-bidirectional]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
First slice of Phase 3 (bidirectional type checker).

lib/go/types.sx defines:
  * go-ctx-empty / go-ctx-extend / go-ctx-lookup — context as a value.
  * go-ctx-extend-field — consumes the (:field NAMES TYPE) shape from
    the parser, binding every name to the shared type. This is the
    cross-deliverable validation of the :field binding-group
    observation made during Phase 2 func decls: parser produces it,
    type checker consumes it, same shape end-to-end.
  * go-predeclared — true / false / nil baked in. Full list expanded
    on demand.
  * go-synth — currently handles variable lookup; literals / calls /
    binops follow in subsequent iterations.
  * go-check — v0 defers to synth + structural type equality. Untyped-
    constant flow and assignment-compatibility relations land later.
  * Type errors carry first-class tags (:unbound, :mismatch,
    :unsupported-synth) so consumers and tooling can dispatch.

Conformance.sh wired with new types suite. Scoreboard cleanup: drop
the "pending" types row since the suite is now real.

types 12/12, total 317/317. Phase 3 underway.

Sister-plan static-types-bidirectional diary updated with the
synth/check shape: judgment skeleton, error tag structure, and the
proposal that `check` should accept a `subtype?` predicate parameter
so each consumer (Go untyped-constants, TS variance, Rust lifetimes)
plugs in its own variance discipline without rewriting the judgment.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:41:02 +00:00
2404a593bd go: parse.sx — multi-form file parsing + 7 e2e tests; PHASE 2 COMPLETE [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Final Phase 2 sub-deliverable. go-parse now handles whole Go files:

  - Empty source → nil
  - Single top-level form → that form (backward-compatible with ~169
    existing single-stmt / single-decl tests)
  - Multiple forms → (list :file FORMS), the canonical Go file shape

Implementation: gp-parse-all loops gp-parse-top until eof, tolerating
ASI semis between forms, then returns based on form count.

End-to-end test set (asserts the top-level decl-tag sequence via a
new decl-tags helper, not the full AST tree — that'd be unwieldy):

  - hello-world             :package :import :func-decl
  - recursive fibonacci     :package :func-decl
  - FizzBuzz                :package :import :func-decl
  - goroutine ping-pong     :package :func-decl :func-decl
  - struct + method         :package :type-decl :method-decl :func-decl
  - interface + method      :package :type-decl :type-decl :method-decl
  - defer + select + range  :package :func-decl

Type-switch (`switch v := x.(type) { ... }`) is the one syntactic
shape still deferred from Phase 2; doesn't gate Phase 3.

**Phase 2 (parser) is complete.** parse 176/176, total 305/305. Next:
Phase 3 — bidirectional type checker. The sister-plan diary for
static-types-bidirectional already has the :field binding-group
insight; Phase 3 will add the synth/check shape that emerges.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:34:16 +00:00
44fb231391 go: parse.sx — switch + select + 8 tests; stmts done [shapes-scheduler]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
Adds Go's switch and select statements:

  switch TAG { case V1, V2: a; case V3: b; default: c }
  switch { case cond: ... }                            — tagless
  select { case x := <-ch: a; case ch <- v: b; default: c }

AST shapes:
  (list :switch TAG CASES)             — TAG nil for tagless
  (list :case VALUES BODY)             — VALUES is expr-list
  (list :select CASES)
  (list :select-case COMM-STMT BODY)   — COMM-STMT is send/recv-assign/bare-recv
  (list :default BODY)

gp-parse-case-body reads stmts until the next case/default/}/eof
without consuming the terminator — used by both switch and select.

select-case parsing reuses gp-parse-stmt for the comm-stmt, so all
four shapes (send, x := <-ch, x = <-ch, bare <-ch) fall out from the
existing stmt parser. Composite-lit suppression is engaged for the
switch tag expression.

Type-switch (`switch v := x.(type) { case int: ... }`) is the one
deferred shape; needs the `.(type)` pseudo-syntax recognised in the
expression layer. Phase 2 statement coverage is otherwise complete.

This is also a chiselling iteration for scheduler sister kit. Diary
updated with select-case design insights:

  * All four select-case shapes share (list :select-case STMT BODY)
    — kit primitive sched-select accepts a uniform list of cases.
  * Default vs no-default determines blocking semantics. Erlang's
    `receive ... after Timeout -> ...` is the analogue — both fit
    "non-blocking fallback case" in the kit API.

parse 169/169, total 298/298.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:29:37 +00:00
171a08a2f8 go: parse.sx — go/defer/send/for-range + 9 tests [shapes-scheduler]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Adds Go's concurrency + iteration primitives to the statement parser:

  go EXPR                     →  (list :go EXPR)
  defer EXPR                  →  (list :defer EXPR)
  ch <- v                     →  (list :send CHAN VALUE)
  for range COLL { ... }      →  (list :range-for nil nil nil COLL BODY)
  for k := range C { ... }    →  (list :range-for :short-decl KEY nil COLL BODY)
  for k, v := range C { }     →  (list :range-for :short-decl KEY VAL COLL BODY)
  for k, v = range C { ... }  →  (list :range-for :assign KEY VAL COLL BODY)

gp-for-find-range pre-scans the for-header (to '{' or eof) looking
for the 'range' keyword; if present, dispatches to gp-parse-for-range
which handles the four range shapes. C-style and while-like and
infinite are now in gp-parse-for-c-style — gp-parse-for is just a
dispatcher.

Send statement detection lives in the LHS-list branch of gp-parse-stmt:
after parsing a single LHS expression, '<-' triggers (:send LHS RHS).
Channel-recv (`<-ch`) was already parsed as unary `<-` in the expression
layer, so both directions cover.

This is the **chiselling-relevant iteration** for the scheduler sister
kit: the AST shapes Go-on-SX will eventually feed into the kit's
scheduler primitives (sched-spawn, sched-defer, chan-op) have landed.
Sister-plan diary updated with three design insights:

  * :go / :defer both wrap a single expr — kit's sched-spawn should
    accept a thunk uniformly across Erlang's spawn(M,F,A) and Go's
    go fn().
  * :send carries CHAN+VALUE symmetrically with the unary <- recv —
    both reduce to (chan-op direction chan value) in the kit.
  * `for v := range ch` uses the same :range-for shape as range-over-
    slice; the scheduler kit's range dispatch is where chan-recv ⇄
    iteration polymorphism lives.

parse 161/161, total 290/290.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:24:23 +00:00
ba41f8a580 go: parse.sx — if/else, for, break/continue, inc-dec + 11 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
Adds the most-used control-flow forms:
  if COND { ... } [else { ... } | else if ...]
  for { ... }                          — infinite
  for COND { ... }                     — while-like
  for INIT; COND; POST { ... }         — C-style
  break / continue                     — keyword stmts (no labels yet)
  x++ / x--                            — Go statement inc-dec

AST shapes:
  (list :if COND THEN ELSE)              — ELSE nil / :if / :block
  (list :for INIT COND POST BODY)        — any of INIT/COND/POST may be nil
  (list :break LABEL)  (list :continue LABEL)
  (list :inc-dec OP EXPR)                — OP is "++" / "--"

**Closes the parser-mode caveat** logged when composite literals
landed. `gp-no-comp-lit` is a re-entrant counter on the parser state;
control-flow constructs increment it before parsing their condition
and decrement after, suppressing the postfix `{` → composite-lit
interpretation so that `if Foo { ... }` correctly reads `{ ... }` as
the body, not as `Foo{}` composite literal. Verified by the test:

  (go-parse "if Foo {}")  →  (:if (:var "Foo") (:block ()) nil)

gp-parse-control-cond is the single helper that bracket-wraps the
flag bump so future control-flow forms (switch, select, range) can't
forget to engage suppression.

switch / select / defer / go / for-range / channel-send still deferred.

parse 152/152, total 281/281.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:17:40 +00:00
5f6d62f45b go: parse.sx — statements (return / short-decl / assign / block) + 9 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
First slice of Phase 2 statements. Replaces the func-decl ':body'
sentinel with real (:block STMTS) parsing.

gp-parse-stmt dispatches on the leading token:
  return [exprs]                — (list :return EXPRS)
  { ... }                       — nested block (recurses into block-body)
  lhs := exprs                  — (list :short-decl LHS-LIST EXPRS)
  lhs = exprs                   — (list :assign LHS-LIST EXPRS)
  lhs OP= expr                  — (list :assign-op OP LHS-LIST [EXPR])
  expr                          — bare expression statement
  var/const/type/func keywords  — fall through to gp-parse-decl

LHS may be a comma-separated list. Compound-assign covers all 11 Go
forms (+= -= *= /= %= &= |= ^= <<= >>= &^=).

gp-parse-block-body iterates: skips semis, terminates on '}', and for
non-trivial tokens calls gp-parse-stmt. **Two progress guards** added
to avoid infinite loops on unsupported syntax:

  * gp-block-body-loop force-advances one token if gp-parse-stmt
    returns nil without consuming.
  * gp-parse-composite-elems does the same when its expr parser
    returns nil — fixes a hang on '`if true {`x := 1`}`' where the
    parser was misreading `if true{...}` as a composite literal then
    spinning on `:=` inside the brace body.

Existing func/method decl tests updated from the ':body' sentinel to
the new (:block STMTS) shape. Old `gp-skip-block!` left as dead code
(removed once control-flow stmts make the misinterpretation issue
moot).

Control-flow stmts (if/for/switch/select/defer/go/break/continue) and
channel send (`ch <- v`) deferred to subsequent iterations.

parse 141/141, total 270/270.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 20:11:01 +00:00
ad21776002 go: parse.sx — func + method declarations + 8 tests [shapes-static-types-bidirectional]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Adds Go func and method declarations:
  func main() {}
  func add(x, y int) int { return x + y }
  func mix(x int, y string) {}
  func divmod(a, b int) (int, int) {}
  func sig(x int) int                            (no body)
  func (p *Point) String() string { ... }        (method, pointer recv)
  func (s Stack) Len() int { ... }               (method, value recv)
  func nested() { if true { x := 1; { y := 2 } } }   (nested braces)

New gp-parse-decl-param-group implements named-greedy disambiguation:
collects consecutive 'ident [, ident]*' then parses a type. Anonymous
mixed lists like 'func(int, string)' are a known limitation (parser
treats first ident as a name); flagged in plan.

gp-skip-block! brace-balances over the body; the AST stores ':body'
as a sentinel until statement parsing lands. Methods use the receiver
parameter shape directly.

AST:
  (list :func-decl   NAME PARAMS RESULTS BODY)
  (list :method-decl RECV NAME PARAMS RESULTS BODY)

**All five `:field` binding-group consumers now exist** across the
parser: struct fields, var, const, func params, method receivers.
That's strong cross-deliverable validation of the ast-binding-group
proposal from Blockers — five different declaration contexts, one
shared shape.

This is the chisel-relevant insight for sister plan static-types-
bidirectional: an entry has been appended to its design diary
describing how `:field` will be the load-bearing input shape for
the bidirectional checker's `check Γ e T` judgment across these
contexts.

parse 132/132, total 261/261.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 19:52:07 +00:00
4922b6e987 go: parse.sx — package/import/var/const/type declarations + 10 tests [consumes-ast]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
First slice of Phase 2 declarations:
  package main                      →  (list :package "main")
  import "fmt"                      →  (ast-import "fmt")    [from kit]
  var x int                         →  var-decl + :field binding
  var x = 5                         →  init only (type inferred)
  var x int = 5                     →  both type and init
  var x, y int = 1, 2               →  multi-name shared type
  const Pi = 3.14                   →  const-decl
  const C int = 42                  →  typed const
  type T int                        →  named alias
  type Point struct { x, y int }    →  named struct

New gp-parse-top dispatches on the leading keyword: routes
package/import/var/const/type to gp-parse-decl; everything else
still goes through gp-parse-expr. Existing expression tests are
unaffected (cur won't be a decl keyword at expression start).

var/const decls use the (:field NAMES TYPE) shape from the
ast-binding-group proposal — first concrete cross-deliverable use:
struct fields, var decls, const decls all envelope through the
same node. That's the smell test for whether the kit shape is
right; so far it's clean.

import uses the canonical ast-import from lib/guest/ast.sx — first
direct use of a kit constructor for a declaration shape.

Grouped/parenthesized decls (var (...), import (...), const (...),
type (...)) and func decls (with method receivers + named params)
deferred to subsequent iterations.

parse 124/124, total 253/253.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 19:44:24 +00:00
632e06d3cf go: parse.sx — composite literals + 8 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
Adds Go composite literals:
  T{}                                  empty
  T{1, 2}                              positional
  T{X: 1, Y: 2}                        keyed
  []int{1, 2, 3}                       slice
  [3]int{1, 2, 3}                      array
  map[string]int{"a": 1}               map
  pkg.Point{1, 2}                      qualified
  []Point{Point{1,2}, Point{3,4}}      nested

AST: (list :composite TYPE-OR-EXPR ELEMS). Each element is an
expression or (list :kv KEY VALUE).

Two parser entry points feed the same AST:
  * gp-parse-primary picks up type-prefixed composites by seeing
    a literal-type starter ([, map, struct) and parsing a type
    first, then optionally a '{' body.
  * The postfix loop picks up ident-prefixed composites — after
    any base expression, '{' wraps it as a composite literal.

Known limitation flagged in plan: when statement parsing arrives,
the postfix '{' branch will misread `if cond { ... }` as a composite
literal. Standard fix: parser-mode flag suppressing composite-lit
disambiguation in control-flow expression positions. Added to plan.

Elided types in nested composites (`[][]int{{1,2},{3,4}}` with the
inner `{1,2}` typed implicitly) deferred.

parse 114/114, total 243/243.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 08:21:47 +00:00
48379e04bc go: parse.sx — interface type expressions + 8 tests; type expressions DONE [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
Adds Go interface type expressions:
  interface {}                              →  empty
  interface { Close() }                     →  no-param method
  interface { String() string }             →  with single return
  interface { Read([]byte) (int, error) }   →  multi-return method
  interface { Stringer }                    →  embedded named iface
  interface { io.Reader }                   →  qualified embedded
  interface { io.Reader; Close() error }    →  mixed

gp-parse-interface-elems walks elements tolerating ASI semis. Each
element is either:
  (list :method NAME PARAMS RESULTS)
  (list :embed TYPE)

Method params/results reuse gp-parse-func-type-params/results — the
shape is identical to a free-standing func type. Go 1.18+ type sets
(interface { ~int | ~float64 }) are deferred until the generics
sub-deliverable.

With this, the full Phase 2 **type expressions** sub-deliverable is
complete (pending only field tags, struct/iface embeds details,
variadic, named func params, generics — all flagged later).

parse 106/106, total 235/235.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 08:16:24 +00:00
a94ffa0feb go: parse.sx — struct type expressions + 8 tests [proposes-ast]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
Adds Go struct types to gp-parse-type:
  struct {}                       →  (list :ty-struct ())
  struct { x int }                →  (list :ty-struct [(:field [x] (:ty-name int))])
  struct { x int; y string }      →  multiple field rows
  struct { x, y int }             →  shared-type row (NAMES is a list)
  struct { inner struct { x int } }  →  nested struct types

gp-parse-struct-fields walks field rows tolerating ASI-inserted semis
(from newlines between fields). Each row collects 1+ names separated
by commas, then a single type that all the names share. Embedded
fields, field tags, and methods are deferred.

The :field shape (NAMES + TYPE) is a recurring multi-language pattern —
struct fields, func params, method receivers, var decls all map to it.
Logged in Blockers as a canonical-AST candidate
(ast-binding-group / ast-named-of-type); worth promoting once a second
consumer (parser of another statically-typed guest, or Go func decls)
exercises the same shape.

parse 98/98, total 227/227.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 08:12:07 +00:00
9acdbcb8d8 go: parse.sx — func type expressions (anonymous params) + 9 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Adds Go func-type parsing to gp-parse-type:
  func()                  →  (list :ty-func () ())
  func() int              →  (list :ty-func () [int])
  func(int, string)       →  (list :ty-func [int string] ())
  func(int) string        →  (list :ty-func [int] [string])
  func() (int, error)     →  (list :ty-func () [int error])

gp-parse-func-type-params handles the param list inside (...);
gp-parse-func-type-results dispatches between bare single-return,
multi-return parenthesised list, or no return.

Anonymous-only — named params (`func(a int, b string)`) require a
different shape and are mainly needed for func DECLARATIONS, not for
pure func-type expressions in type position. Variadic ('...T')
deferred.

Covers nested cases: func returning func, chan of func, func with
pointer/slice operands.

parse 90/90, total 219/219.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 08:06:53 +00:00
8ba66e0dc9 go: parse.sx — slice/array/map/chan type expressions + 11 tests; parse acceptance crossed [proposes-ast]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 18s
Adds the bulk of Go's type-expression grammar:
  []T         →  (list :ty-slice T)
  [N]T        →  (list :ty-array N T)         — N is an expr
  map[K]V     →  (list :ty-map K V)
  chan T      →  (list :ty-chan :both T)
  chan<- T    →  (list :ty-chan :send T)
  <-chan T    →  (list :ty-chan :recv T)

gp-parse-type now dispatches on the head token: *, [, map, chan, <-,
or ident; each branch recurses for nested types. Channel direction
is encoded as :both / :send / :recv (Go-specific tag).

Coverage: nested types end-to-end — []*T, [][]int, map[string][]int,
chan map[K]V, *[]int — all via the v.(T) assertion carrier.

Logged a concrete kit-gap proposal in plans/go-on-sx.md Blockers for
canonical type-node shapes. The first six (:ty-name, :ty-sel, :ty-ptr,
:ty-slice, :ty-array, :ty-map) are universal across statically-typed
guests and worth promoting on the next consumer; channel/func shapes
stay guest-specific until a second user.

Phase 2 parse acceptance bar (80+ tests) crossed: parse 81/81, total
210/210. Func / struct / interface types and full decls + stmts still
keep Phase 2 open.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 08:02:08 +00:00
503bdf12d6 go: parse.sx — type assertion v.(T) + minimal type parser + 9 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 18s
Postfix '.' branch now peeks at the next token to disambiguate:
  .ident   →  selector / member access  (list :select OBJ "field")
  .(TYPE)  →  type assertion            (list :assert OBJ TYPE)

New gp-parse-type covers the minimum types needed for assertions:
  name        →  (list :ty-name "int")
  pkg.Name    →  (list :ty-sel "pkg" "Name")
  *T  / **T   →  (list :ty-ptr (list :ty-ptr ...))

Full type grammar — slice []T, array [N]T, map[K]V, chan, func,
struct, interface — is a separate Phase 2 sub-deliverable.

Type AST shapes are Go-specific tagged lists; the canonical AST kit
has no type-system primitives at all yet. Worth a richer kit
discussion once Phase 3 (bidirectional type checker) lands and the
sister plan static-types-bidirectional has a real surface to react to.

parse 70/70, total 199/199.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:57:29 +00:00
e64d72f554 go: parse.sx — index x[i] + slice x[a:b]/x[a:b:c] + 12 tests [proposes-ast]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Adds the bracket postfix branch:
  a[0] / a[i] / a[i+1] / m["key"]             → (list :index OBJ IDX)
  a[:] / a[1:] / a[:2] / a[1:2] / a[1:2:3]    → (list :slice OBJ LOW HIGH MAX)

LOW/HIGH/MAX are AST nodes or nil for omitted indices. The 4th MAX
slot is only populated by the three-index full-slice form.

Two new lib/guest/ast.sx kit gaps surfaced (logged in plans/go-on-sx.md
Blockers):

  * No :index node — universal across guests with arrays/maps.
  * No :slice node — Python/Rust/Swift/JS/Ruby all need at minimum the
    two-index form. Go's three-index variant is more specialised but
    fits in the same shape with an optional fourth slot.

Parser is permissive on a[1::3] (strict Go rejects, but the type phase
can enforce the grammar; lexer/parser stays loose).

Chained (a[0][1]) and mixed-with-selector (a[0].field) cases work via
the existing left-associative postfix loop.

parse 61/61, total 190/190.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:53:10 +00:00
e1c5fdae53 go: parse.sx — function calls + member access + 12 tests [consumes-ast proposes-ast]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
Adds postfix expression forms per Go spec:
  f()  f(x)  f(x, y, z)       — function calls
  x.y  x.y.z  obj.method(x)   — selector / member access

gp-parse-postfix sits between gp-parse-unary and gp-parse-primary,
so calls and selectors bind tighter than any unary prefix — `-f(x)`
parses as `-(f(x))`, not `(-f)(x)`. Postfix is left-associative
(`x.y.z` = `(x.y).z`), so the loop iterates rather than recurses
on the LHS.

AST shapes:
  Call:     (ast-app FN ARGS)              — canonical
  Selector: (list :select OBJ "field")     — Go-specific tag

The selector shape is a kit gap — lib/guest/ast.sx ships ast-app but
no ast-select, despite `obj.field` being universal across Go, Rust,
Swift, TS, JS, Python, Ruby, Java, C#. Logged in Blockers; tagging
[proposes-ast]. Worth promoting on the next nominally-typed guest.

parse 49/49, total 178/178.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:48:21 +00:00
728a91e49f go: parse.sx — unary prefix operators + 11 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Adds Go unary prefix operators per Go spec § Operators:
  +x  -x  !x  ^x  *p  &v  <-ch

gp-parse-unary is recursive (so !!x and -^x chain correctly) and
sits between gp-parse-expr and gp-parse-primary — unary therefore
always binds tighter than any binary op without needing a unary
entry in the precedence table.

Symbols +, -, *, &, ^ are shared between unary and binary forms;
the positional split (expression-start sees unary, mid-expression
sees binary) disambiguates them cleanly with no lookback.

Unary nodes are single-arg ast-app:
  (ast-app (ast-var OP) (list OPERAND))

parse 37/37, total 166/166.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:43:34 +00:00
750035d543 go: parse.sx — binary operators via Pratt precedence climbing + 9 tests [consumes-pratt]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 39s
gp-parse-expr / gp-pratt-loop implement classic Pratt climbing
against go-precedence-table (entry shape from lib/guest/pratt.sx).
The kit gives us pratt-op-lookup + accessors; the climbing loop
itself stays per-language (per kit header — Lua and Prolog have
opposite conventions).

Left-associative ops raise the right-recursion min by 1; right-
associative would keep prec. All Go binary operators are left-assoc.

AST shape: a binary node is emitted as
  (ast-app (ast-var OP) [LHS RHS])
— canonical ast-app rather than a Go-specific binary node, since a
future evaluator can recognise operator-named apps without losing
information.

Coverage: equal-prec left-to-right, * tighter than +, && tighter
than ||, comparison tighter than &&, long left-assoc chains, mixed
literal+ident operands.

parse 26/26, total 155/155.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:39:03 +00:00
976c6dd0ef go: parse.sx scaffold — primary expressions + Go precedence table + 17 tests [consumes-pratt consumes-ast]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
Starts Phase 2. lib/go/parse.sx defines:
  * go-precedence-table — Go's five operator-precedence levels in the
    (NAME PREC ASSOC) entry shape from lib/guest/pratt.sx, ready for the
    binary-operator iteration to consume via pratt-op-lookup.
  * go-parse(src) — tokenises and parses ONE primary expression: int,
    float, imag, string, rune literals become (ast-literal VALUE);
    identifiers become (ast-var NAME). Built directly on lib/guest/ast.sx
    constructors — no intermediate AST shape.

Conformance.sh extended to load lib/guest/{ast,pratt}.sx and run the
new parse suite. Scoreboard cleanup: drop the "pending" parse row since
the suite is now real.

parse 17/17 (lex still 129/129). Total 146/146.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:33:31 +00:00
c1baca2e4e go: lex.sx — operator-set audit + tilde; PHASE 1 COMPLETE + 6 tests [proposes-lex]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
Adds the missing tilde operator '~' (Go 1.18+ generics type-set
constraint, e.g. 'interface { ~int | ~float64 }') to the longest-match
operator table. Adds an exhaustive 'op-audit:' test block covering
every Go operator/punctuation token by category — arithmetic +
assignment, bitwise + assignment, comparison + logical, decls /
arrows / variadic / inc-dec, punctuation, and tilde.

Phase 1 (tokenizer) is now complete. Two kit gaps surfaced and logged
in plans/go-on-sx.md Blockers for the substrate maintainer / next
statically-typed guest loop:

  * lib/guest/lex.sx lacks lex-oct-digit? / lex-bin-digit?
    (we rolled local gl-* equivalents for 0o.. and 0b.. literals).
  * lib/guest/lex.sx lacks a table-driven longest-prefix operator
    matcher; our gl-match-op is a 25-clause cond ladder. Rust/Swift/TS
    will each hit the same shape with 50+ ops apiece.

lex 129/129. Phase 2 (parser) next.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:28:50 +00:00
65467c232b go: lex.sx — raw string literals (backtick) + 9 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
Adds Go raw string literals per Go spec § String literals:
backtick-delimited, no escape processing, may span multiple
lines, '\r' chars discarded from the value.

gl-read-raw-string! mirrors gl-read-string! but skips escape
handling and the \r filter. scan! routes the leading backtick
to it; emits "string" type (same as interpreted strings — no
need to distinguish at parse/type time).

lex 123/123.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:22:01 +00:00
e60c74f8c3 go: lex.sx — decimal float + imaginary literals + 22 tests [consumes-lex]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Adds Go float and imaginary literal forms per Go spec § Floating-point
literals and § Imaginary literals:
  3.14   .5   1.   1e10   1.5e-3   2.0e+2   1E5    (floats)
  2i     3.14i   1e2i                              (imag)

gl-read-number! returns one of "int" / "float" / "imag"; gl-finish-number!
factors out the post-mantissa exponent + 'i' suffix logic so the int /
float / leading-dot-float paths all share it. scan! adds a .<digit>
branch ahead of the operator matcher so '.5' tokenises as float.

ASI trigger list extended to include float + imag (Go spec § Semicolons:
all literal types trigger).

Greedy-grammar pin (a single test '1.method' lexes as float ident),
since the Go spec says the '.' after a digit always belongs to the
number, never to a following identifier.

Hex floats (0x1.fp0) deferred — not commonly used.

lex 114/114.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 07:16:56 +00:00
fe614fc531 go: lex.sx — hex/octal/binary integer literals + underscores, +14 tests [consumes-lex]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
Adds prefixed integer forms per Go spec § Integer literals:
0x.. / 0X.. (hex), 0b.. / 0B.. (binary), 0o.. / 0O.. (octal),
legacy 0123 octal also accepted. Underscores allowed between digits
in any run; lexer is permissive (parser/types phase can enforce
strict placement).

Dispatch lives in gl-read-number! against the first 1-2 chars;
hex digit run consumes lex-hex-digit? from lib/guest/lex.sx. Octal
and binary use local gl-oct-digit?/gl-bin-digit? — narrow enough
that promoting them to the kit is premature.

lex 92/92.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 06:57:47 +00:00
4fc73a97f4 go: lex.sx — keywords, ident/int/string/rune lits, comments, ops, ASI + 78 tests [consumes-lex]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
First Go-on-SX iteration. Tokenizer consumes lib/guest/lex.sx character-class
predicates. Automatic semicolon insertion per Go spec § Semicolons fires on
newline, EOF, and block comments containing a newline, after
ident/int/string/rune/{break,continue,fallthrough,return}/{++,--,),],}}.

Scoreboard + conformance.sh wired; lex 78/78. Plan Phase 1 sub-items
checked; floats/raw-strings/hex-ints still .

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-26 21:13:06 +00:00
0f7444e0d5 plans: Go-on-SX + sister lib/guest extraction plans (scheduler, bidirectional types)
- go-on-sx.md: rewrite of 2026-04-26 draft to integrate lib/guest framework.
  Adds Phase 3 (independent bidirectional type checker — first static-typed
  guest), Phase 10 (extraction enabler), chisel discipline, conformance
  scoreboard model. Phases 1-2 now consume lib/guest/core lex+pratt+ast.

- lib-guest-scheduler.md: NEW. Extraction plan for the fork/yield/block/
  resume scheduler shared by Erlang (addressed processes + mailboxes) and
  Go (anonymous channels + goroutines). Two-language rule blocks extraction
  until both consumers independently work; rejected-extraction is a valid
  outcome.

- lib-guest-static-types-bidirectional.md: NEW. Sister to lib/guest/hm.sx.
  Bidirectional checker kit (synth/check judgments, pluggable subtype +
  unify) for the languages HM doesn't fit — Go, Rust, TS, Swift, Kotlin,
  Scala 3, Hack. First consumer: Go-on-SX. Second TBD; recommendation
  TypeScript.

The three plans cross-reference each other. Go-on-SX implements scheduler +
checker independently of the kits; extraction is its own workstream once
two consumers exist.
2026-05-26 20:54:22 +00:00
184 changed files with 17480 additions and 9958 deletions

View File

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

View File

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

View File

@@ -956,118 +956,8 @@
(= 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
@@ -1578,26 +1468,9 @@
;; 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-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
()
(define er-register-builtin-bifs!
(fn ()
;; erlang module — type predicates (all pure)
(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)
@@ -1606,61 +1479,27 @@
(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)
(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" "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)
(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-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)
@@ -1676,16 +1515,12 @@
(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)
(er-register-bif!
"erlang"
"throw"
1
;; erlang module — exception raising (modelled as side-effecting)
(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)
@@ -1699,13 +1534,11 @@
(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)
(er-register-pure-bif! "lists" "duplicate" 2 er-bif-lists-duplicate)
;; io module — side-effecting (writes to io buffer)
(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)
@@ -1713,88 +1546,82 @@
(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)
(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
(nth fail 0)
nil
(er-nil? v)
nil
(er-cons? v)
(do
(er-iolist-walk! (get v :head) acc fail)
;; ── 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")
(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)
(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")))
(er-register-bif! "http" "listen" 2 er-bif-http-listen)
;; Register everything at load time.
(er-register-builtin-bifs!)

141
lib/go/conformance.sh Executable file
View File

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

1539
lib/go/eval.sx Normal file

File diff suppressed because it is too large Load Diff

476
lib/go/lex.sx Normal file
View File

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

1262
lib/go/parse.sx Normal file

File diff suppressed because it is too large Load Diff

66
lib/go/sched.sx Normal file
View File

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

13
lib/go/scoreboard.json Normal file
View File

@@ -0,0 +1,13 @@
{
"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"}]
}

16
lib/go/scoreboard.md Normal file
View File

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

71
lib/go/std/strconv.sx Normal file
View File

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

386
lib/go/std/strings.sx Normal file
View File

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

186
lib/go/tests/e2e.sx Normal file
View File

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

667
lib/go/tests/eval.sx Normal file
View File

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

339
lib/go/tests/lex.sx Normal file
View File

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

1231
lib/go/tests/parse.sx Normal file

File diff suppressed because it is too large Load Diff

311
lib/go/tests/runtime.sx Normal file
View File

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

209
lib/go/tests/stdlib.sx Normal file
View File

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

778
lib/go/tests/types.sx Normal file
View File

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

824
lib/go/types.sx Normal file
View File

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

40
lib/mod/activity.sx Normal file
View File

@@ -0,0 +1,40 @@
;; lib/mod/activity.sx — export decisions as ActivityPub-shaped events.
;;
;; The rose-ash platform propagates cross-domain effects as ActivityPub-shaped
;; activities. A moderation decision maps to a moderation verb so the rest of the
;; platform (and federated peers) can act on it: remove→Delete, ban→Block,
;; hide/escalate→Flag, keep→no activity. The precise mod action is preserved in
;; :action so a consumer can disambiguate (e.g. hide vs escalate, both Flag).
(define
mod/action->verb
(fn
(action)
(cond
((= action "remove") "Delete")
((= action "ban") "Block")
((= action "hide") "Flag")
((= action "escalate") "Flag")
(true nil))))
(define
mod/decision->activity
(fn
(d actor)
(let
((verb (mod/action->verb (get d :action))))
(if (nil? verb) nil {:type verb :action (get d :action) :actor actor :summary (str "moderation/" (get d :action) " via " (get d :rule)) :object (get d :report-id) :rule (get d :rule)}))))
;; map a batch of decisions to activities, dropping the no-op keeps
(define
mod/decisions->activities
(fn
(decisions actor)
(reduce
(fn
(acc d)
(let
((a (mod/decision->activity d actor)))
(if (nil? a) acc (append acc (list a)))))
(list)
decisions)))

163
lib/mod/api.sx Normal file
View File

@@ -0,0 +1,163 @@
;; lib/mod/api.sx — report registry + lifecycle façade + public entry points.
;;
;; mod/report files a report (assigning a sequential id) and opens a lifecycle
;; case for it; mod/add-evidence accumulates evidence; mod/decide runs the engine
;; and commits to the audit log. The lifecycle façade (mod/triage, mod/resolve,
;; mod/review, mod/appeal, mod/finalize) drives the per-report case through its
;; states, logging each committed decision to the audit trail.
(define mod/*reports* (list))
(define mod/*cases* (list))
(define mod/*counter* 0)
(define mod/*rules* mod/default-rules)
(define
mod/reset!
(fn
()
(begin
(set! mod/*reports* (list))
(set! mod/*cases* (list))
(set! mod/*counter* 0)
(mod/audit-reset!))))
(define
mod/report
(fn
(by about reason)
(begin
(set! mod/*counter* (+ mod/*counter* 1))
(let
((id (str "r" mod/*counter*)))
(let
((r (mod/mk-report id by about reason)))
(begin
(append! mod/*reports* r)
(append! mod/*cases* {:id id :case (mod/mk-case r)})
r))))))
(define
mod/get-report
(fn
(id)
(reduce
(fn (acc r) (if (= (mod/report-id r) id) r acc))
nil
mod/*reports*)))
(define
mod/add-evidence
(fn
(id kind val)
(let
((r (mod/get-report id)))
(if
(nil? r)
nil
(let
((updated (mod/attach-evidence r (mod/mk-evidence kind val))))
(begin
(set!
mod/*reports*
(map
(fn (x) (if (= (mod/report-id x) id) updated x))
mod/*reports*))
updated))))))
(define
mod/decide
(fn
(id)
(let
((r (mod/get-report id)))
(if
(nil? r)
nil
(let
((d (mod/decide-report r mod/*reports* mod/*rules*)))
(begin (mod/log-decision! d (mod/report-evidence r)) d))))))
;; ── lifecycle façade over the case registry ──
(define
mod/case-of
(fn
(id)
(reduce
(fn (acc rec) (if (= (get rec :id) id) (get rec :case) acc))
nil
mod/*cases*)))
(define
mod/case-store!
(fn
(id c)
(set!
mod/*cases*
(map
(fn (rec) (if (= (get rec :id) id) {:id id :case c} rec))
mod/*cases*))))
;; apply a lifecycle op to the stored case, persist it, and (when a decision was
;; committed cleanly) append it to the audit log; returns the updated case
(define
mod/case-apply!
(fn
(id op log?)
(let
((c (mod/case-of id)))
(if
(nil? c)
nil
(let
((c2 (op c)))
(begin
(mod/case-store! id c2)
(when
log?
(when
(nil? (mod/case-error c2))
(let
((d (mod/case-decision c2)))
(if
(nil? d)
nil
(mod/log-decision!
d
(mod/report-evidence (mod/case-report c2)))))))
c2))))))
(define
mod/triage
(fn
(id)
(mod/case-apply!
id
(fn (c) (mod/case-triage c mod/*reports* mod/*rules*))
false)))
(define
mod/resolve
(fn (id) (mod/case-apply! id (fn (c) (mod/case-resolve c)) true)))
(define
mod/review
(fn
(id kind val)
(mod/case-apply!
id
(fn (c) (mod/case-review c kind val mod/*reports* mod/*rules*))
true)))
(define
mod/appeal
(fn
(id kind val)
(mod/case-apply!
id
(fn (c) (mod/case-appeal c kind val mod/*reports* mod/*rules*))
true)))
(define
mod/finalize
(fn (id) (mod/case-apply! id (fn (c) (mod/case-finalize c)) false)))

54
lib/mod/audit.sx Normal file
View File

@@ -0,0 +1,54 @@
;; lib/mod/audit.sx — append-only decision log.
;;
;; Every decision the api commits is recorded as an immutable audit entry holding
;; the decision (action + matching rule), the proof tree (the derivation that
;; justified it), and a snapshot of the evidence in force at decision time. The
;; log is append-only: entries are never mutated or removed, only appended, each
;; with a monotonic sequence number. Retrieval is by report id (full history) or
;; by sequence.
(define mod/*audit-log* (list))
(define mod/*audit-seq* 0)
(define
mod/audit-reset!
(fn
()
(begin (set! mod/*audit-log* (list)) (set! mod/*audit-seq* 0))))
(define mod/mk-audit-entry (fn (seq decision evidence-snapshot) {:action (get decision :action) :evidence evidence-snapshot :proof (get decision :proof) :rule (get decision :rule) :report-id (get decision :report-id) :seq seq}))
(define
mod/log-decision!
(fn
(decision evidence-snapshot)
(begin
(set! mod/*audit-seq* (+ mod/*audit-seq* 1))
(let
((entry (mod/mk-audit-entry mod/*audit-seq* decision evidence-snapshot)))
(begin (append! mod/*audit-log* entry) entry)))))
;; entries for one report, in chronological (sequence) order
(define
mod/audit
(fn
(id)
(reduce
(fn
(acc e)
(if (= (get e :report-id) id) (append acc (list e)) acc))
(list)
mod/*audit-log*)))
(define mod/audit-all (fn () mod/*audit-log*))
(define mod/audit-count (fn () (len mod/*audit-log*)))
;; most recent decision logged for a report (nil if none)
(define
mod/audit-latest
(fn
(id)
(reduce
(fn (acc e) (if (= (get e :report-id) id) e acc))
nil
mod/*audit-log*)))

55
lib/mod/batch.sx Normal file
View File

@@ -0,0 +1,55 @@
;; lib/mod/batch.sx — batch triage + corpus analytics.
;;
;; Operational layer: decide a whole queue of reports at once, summarize the
;; outcomes by action, and measure which rules actually fire across a corpus.
;; mod/never-fired is the empirical complement to lint's static unreachable check
;; (Ext 5): lint finds rules that CAN'T fire by structure; never-fired finds rules
;; that DIDN'T fire on real data.
(define
mod/decide-batch
(fn
(reports rules)
(map (fn (r) (mod/decide-report r reports rules)) reports)))
(define
mod/count-action
(fn
(decisions action)
(reduce
(fn (acc d) (if (= (get d :action) action) (+ acc 1) acc))
0
decisions)))
(define mod/action-histogram (fn (decisions) {:keep (mod/count-action decisions "keep") :remove (mod/count-action decisions "remove") :escalate (mod/count-action decisions "escalate") :hide (mod/count-action decisions "hide") :ban (mod/count-action decisions "ban")}))
(define
mod/rule-fire-count
(fn
(decisions rule-name)
(reduce
(fn (acc d) (if (= (get d :rule) rule-name) (+ acc 1) acc))
0
decisions)))
(define
mod/rule-coverage
(fn
(reports rules)
(let
((decisions (mod/decide-batch reports rules)))
(map (fn (rule) {:rule (mod/rule-name rule) :fired (mod/rule-fire-count decisions (mod/rule-name rule))}) rules))))
(define
mod/never-fired
(fn
(reports rules)
(reduce
(fn
(acc c)
(if
(= (get c :fired) 0)
(append acc (list (get c :rule)))
acc))
(list)
(mod/rule-coverage reports rules))))

60
lib/mod/conformance.conf Normal file
View File

@@ -0,0 +1,60 @@
# Mod conformance config — sourced by lib/guest/conformance.sh.
LANG_NAME=mod
MODE=dict
PRELOADS=(
lib/guest/pratt.sx
lib/prolog/tokenizer.sx
lib/prolog/parser.sx
lib/prolog/runtime.sx
lib/prolog/query.sx
lib/prolog/compiler.sx
lib/mod/schema.sx
lib/mod/policy.sx
lib/mod/defrule.sx
lib/mod/engine.sx
lib/mod/explain.sx
lib/mod/severity.sx
lib/mod/offenders.sx
lib/mod/quorum.sx
lib/mod/trace.sx
lib/mod/whatif.sx
lib/mod/batch.sx
lib/mod/temporal.sx
lib/mod/sla.sx
lib/mod/wire.sx
lib/mod/activity.sx
lib/mod/policies.sx
lib/mod/pipeline.sx
lib/mod/lifecycle.sx
lib/mod/audit.sx
lib/mod/api.sx
lib/mod/fed.sx
lib/mod/link.sx
lib/mod/lint.sx
)
SUITES=(
"decide:lib/mod/tests/decide.sx:(mod-decide-tests-run!)"
"audit:lib/mod/tests/audit.sx:(mod-audit-tests-run!)"
"escalation:lib/mod/tests/escalation.sx:(mod-escalation-tests-run!)"
"fed:lib/mod/tests/fed.sx:(mod-fed-tests-run!)"
"extensions:lib/mod/tests/extensions.sx:(mod-extensions-tests-run!)"
"link:lib/mod/tests/link.sx:(mod-link-tests-run!)"
"lint:lib/mod/tests/lint.sx:(mod-lint-tests-run!)"
"severity:lib/mod/tests/severity.sx:(mod-severity-tests-run!)"
"offenders:lib/mod/tests/offenders.sx:(mod-offenders-tests-run!)"
"quorum:lib/mod/tests/quorum.sx:(mod-quorum-tests-run!)"
"trace:lib/mod/tests/trace.sx:(mod-trace-tests-run!)"
"whatif:lib/mod/tests/whatif.sx:(mod-whatif-tests-run!)"
"batch:lib/mod/tests/batch.sx:(mod-batch-tests-run!)"
"temporal:lib/mod/tests/temporal.sx:(mod-temporal-tests-run!)"
"sla:lib/mod/tests/sla.sx:(mod-sla-tests-run!)"
"wire:lib/mod/tests/wire.sx:(mod-wire-tests-run!)"
"disjunction:lib/mod/tests/disjunction.sx:(mod-disjunction-tests-run!)"
"activity:lib/mod/tests/activity.sx:(mod-activity-tests-run!)"
"policies:lib/mod/tests/policies.sx:(mod-policies-tests-run!)"
"defrule:lib/mod/tests/defrule.sx:(mod-defrule-tests-run!)"
"pipeline:lib/mod/tests/pipeline.sx:(mod-pipeline-tests-run!)"
)

3
lib/mod/conformance.sh Executable file
View File

@@ -0,0 +1,3 @@
#!/usr/bin/env bash
# Thin wrapper — see lib/guest/conformance.sh and lib/mod/conformance.conf.
exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

16
lib/mod/defrule.sx Normal file
View File

@@ -0,0 +1,16 @@
;; lib/mod/defrule.sx — ergonomic rule / ruleset construction.
;;
;; The roadmap sketched a (defrule action :when conditions) surface. Conditions
;; already evaluate to plain data, so this needs no macro — variadic functions
;; suffice: mod/defrule collects its trailing condition forms via &rest (dropping
;; the explicit outer (list ...)), and mod/ruleset assembles rules the same way.
;;
;; (mod/ruleset
;; (mod/defrule "spam-hide" :hide (list :classification "spam"))
;; (mod/defrule "default-keep" :keep))
(define
mod/defrule
(fn (name action &rest conds) (mod/mk-rule name action conds)))
(define mod/ruleset (fn (&rest rules) rules))

64
lib/mod/engine.sx Normal file
View File

@@ -0,0 +1,64 @@
;; lib/mod/engine.sx — decide a report by querying the policy program.
;;
;; build-program assembles the report's facts plus the compiled policy clauses;
;; decide-report runs the Prolog query and returns a decision. A decision is a
;; proof, not a bare keyword: it carries the matching rule, the conditions it
;; required, the evidence that satisfied them, and a derivation — the proof tree.
;;
;; The proof tree is built constructively: for the matching rule, each body goal
;; is re-queried against the same DB with the report id bound, recording the goal
;; text, whether it was solved, and the bindings that satisfied it. That is a
;; genuine derivation drawn from the Prolog database, ready for the audit trail.
(define
mod/find-rule
(fn
(rules name)
(reduce
(fn
(acc r)
(if (nil? acc) (if (= (mod/rule-name r) name) r acc) acc))
nil
rules)))
(define
mod/build-program
(fn
(r count rules)
(str (mod/report-facts r count) "\n" (mod/rules->program rules))))
(define
mod/proof-goals
(fn
(db id conds)
(if
(empty? conds)
(list {:solved true :goal "true" :bindings {}})
(map
(fn
(c)
(let
((g (mod/cond->goal c id)))
(let ((sols (pl-query-all db g))) {:solved (if (empty? sols) false true) :goal g :bindings (if (empty? sols) {} (first sols))})))
conds))))
(define
mod/decide-report
(fn
(r reports rules)
(let
((count (mod/report-count (mod/report-about r) reports))
(kinds (mod/classify-keywords r))
(id (mod/report-id r)))
(let
((program (mod/build-program r count rules)))
(let
((db (pl-load program)))
(let
((sol (pl-query-one db (str "policy_action(" id ", Action, Rule)"))))
(if
(nil? sol)
{:action "keep" :proof {:goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none"}
(let
((rname (dict-get sol "Rule")))
(let ((rule (mod/find-rule rules rname))) {:action (mod/rule-action rule) :proof {:goals (mod/proof-goals db id (mod/rule-when rule)) :evidence kinds :conditions (mod/rule-when rule) :rule rname :count count} :report-id id :rule rname})))))))))

55
lib/mod/explain.sx Normal file
View File

@@ -0,0 +1,55 @@
;; lib/mod/explain.sx — human-readable proof explanation.
;;
;; Turns a decision (from mod/decide-report, or any audit entry) into a readable
;; multi-line "why": the action, the rule that fired, the evidence in play, and
;; the derivation goal-by-goal with [proved]/[unproved] marks and the unification
;; bindings that satisfied each goal. Pure SX over the Phase-2 proof tree.
(define
mod/explain-binds
(fn
(binds)
(mod/join-with
", "
(map (fn (k) (str k "=" (dict-get binds k))) (keys binds)))))
(define
mod/explain-goal
(fn
(g)
(let
((mark (if (get g :solved) " [proved] " " [unproved] "))
(binds (get g :bindings)))
(if
(empty? (keys binds))
(str mark (get g :goal))
(str mark (get g :goal) " {" (mod/explain-binds binds) "}")))))
(define
mod/explain-evidence
(fn
(evidence)
(if
(empty? evidence)
"Evidence: (none)"
(str "Evidence: " (mod/join-with ", " evidence)))))
(define
mod/explain
(fn
(decision)
(let
((id (get decision :report-id))
(action (get decision :action))
(rule (get decision :rule))
(proof (get decision :proof)))
(let
((goals (get proof :goals)) (evidence (get proof :evidence)))
(mod/join-with
"\n"
(append
(list
(str "Report " id ": " action " (rule: " rule ")")
(mod/explain-evidence evidence)
"Because:")
(map mod/explain-goal goals)))))))

145
lib/mod/fed.sx Normal file
View File

@@ -0,0 +1,145 @@
;; lib/mod/fed.sx — federation: cross-instance reports, decision sharing, trust,
;; revocation. fed-sx itself is mocked here (an in-memory outbox); the real wire
;; transport would replace mod/fed-send!.
;;
;; Trust is advisory by default (the hard rule): a peer's decision only binds
;; locally when (mod/trusted? peer :mod) holds. An untrusted peer's decision is
;; recorded as a suggestion in the advisory log and is NOT applied. Local
;; decisions propagate outward via the outbox. Revocation undoes a locally
;; applied action when its proof is invalidated, notifying the origin peer.
(define mod/*fed-trust* (list)) ;; {:peer :scope}
(define mod/*fed-outbox* (list)) ;; {:to :type :payload}
(define mod/*fed-advisory* (list)) ;; {:peer :decision} — received, not applied
(define mod/*fed-applied* (list)) ;; {:report-id :action :origin :revoked}
(define mod/*fed-origins* (list)) ;; {:id :origin}
(define
mod/fed-reset!
(fn
()
(begin
(set! mod/*fed-trust* (list))
(set! mod/*fed-outbox* (list))
(set! mod/*fed-advisory* (list))
(set! mod/*fed-applied* (list))
(set! mod/*fed-origins* (list)))))
;; ── trust model ──
(define
mod/trust-match?
(fn
(t peer scope)
(if (= (get t :peer) peer) (= (get t :scope) scope) false)))
(define
mod/grant-trust
(fn (peer scope) (begin (append! mod/*fed-trust* {:scope scope :peer peer}) true)))
(define
mod/revoke-trust
(fn
(peer scope)
(set!
mod/*fed-trust*
(reduce
(fn
(acc t)
(if (mod/trust-match? t peer scope) acc (append acc (list t))))
(list)
mod/*fed-trust*))))
(define
mod/trusted?
(fn
(peer scope)
(mod/any? (fn (t) (mod/trust-match? t peer scope)) mod/*fed-trust*)))
;; ── cross-instance reports ──
(define
mod/fed-receive-report
(fn
(peer by about reason)
(let
((r (mod/report by about reason)))
(begin (append! mod/*fed-origins* {:id (mod/report-id r) :origin peer}) r))))
(define
mod/report-origin
(fn
(id)
(reduce
(fn (acc o) (if (= (get o :id) id) (get o :origin) acc))
"local"
mod/*fed-origins*)))
;; ── decision sharing (mock fed-sx send) ──
(define
mod/fed-send!
(fn (to type payload) (begin (append! mod/*fed-outbox* {:type type :to to :payload payload}) true)))
(define mod/fed-outbox (fn () mod/*fed-outbox*))
(define
mod/fed-share-decision
(fn
(decision peers)
(reduce
(fn
(acc p)
(begin (mod/fed-send! p "decision" decision) (append acc (list p))))
(list)
peers)))
;; ── receiving a peer's decision (advisory unless trusted) ──
(define
mod/fed-applied-action
(fn
(report-id)
(reduce
(fn (acc a) (if (= (get a :report-id) report-id) a acc))
nil
mod/*fed-applied*)))
(define
mod/fed-receive-decision
(fn
(peer decision)
(if
(mod/trusted? peer :mod)
(begin (append! mod/*fed-applied* {:revoked false :action (get decision :action) :report-id (get decision :report-id) :origin peer}) {:advisory false :peer peer :applied true :decision decision})
(begin (append! mod/*fed-advisory* {:peer peer :decision decision}) {:advisory true :peer peer :applied false :decision decision}))))
;; ── revocation ──
(define
mod/fed-revoke!
(fn
(report-id reason)
(begin
(set!
mod/*fed-applied*
(map
(fn (a) (if (= (get a :report-id) report-id) {:revoked true :action (get a :action) :report-id (get a :report-id) :origin (get a :origin)} a))
mod/*fed-applied*))
(mod/fed-send! (mod/report-origin report-id) "revocation" {:report-id report-id :reason reason})
report-id)))
;; re-run the engine; if the action no longer holds, the prior decision's proof
;; is invalidated — revoke the applied moderation.
(define
mod/fed-revoke-if-invalidated
(fn
(report decision reports rules)
(let
((d2 (mod/decide-report report reports rules)))
(if
(= (get d2 :action) (get decision :action))
{:revoked false :decision d2}
(begin
(mod/fed-revoke! (get decision :report-id) "proof invalidated")
{:revoked true :decision d2})))))

160
lib/mod/lifecycle.sx Normal file
View File

@@ -0,0 +1,160 @@
;; lib/mod/lifecycle.sx — report lifecycle state machine (pure SX over the engine).
;;
;; Lifecycle state is deliberately separate from policy: the Prolog rules answer
;; "what action?", this module answers "where in the process is this report?".
;;
;; :open ──triage──▶ :triaged ──resolve/review──▶ :decided ──appeal──▶ :appealed
;; │ │
;; └────finalize───▶ :final ◀┘
;;
;; A case is an immutable value {:report :state :decision :tier :error :history}.
;; Every transition returns a NEW case; illegal transitions return the case
;; unchanged with :error set. Tiers: triage runs the engine (auto-tier); a
;; terminal action (hide/remove/keep) resolves immediately, an :escalate action
;; flags the case for human review (human-tier) before it can be resolved.
(define mod/case* (fn (report state decision tier err history) {:history history :state state :report report :error err :tier tier :decision decision}))
(define
mod/mk-case
(fn (report) (mod/case* report "open" nil nil nil (list))))
(define mod/case-report (fn (c) (get c :report)))
(define mod/case-state (fn (c) (get c :state)))
(define mod/case-decision (fn (c) (get c :decision)))
(define mod/case-tier (fn (c) (get c :tier)))
(define mod/case-error (fn (c) (get c :error)))
(define mod/case-history (fn (c) (get c :history)))
;; ── transition table ──
(define mod/lc-transitions {:final (list) :appealed (list "final") :decided (list "appealed" "final") :open (list "triaged") :triaged (list "decided")})
(define mod/member? (fn (x lst) (mod/any? (fn (y) (= y x)) lst)))
(define
mod/lc-can-transition?
(fn
(from to)
(let
((outs (get mod/lc-transitions from)))
(if (nil? outs) false (mod/member? to outs)))))
;; ── core transition: validate, record history, or flag :error ──
(define
mod/case-goto
(fn
(c to note report decision tier)
(let
((from (mod/case-state c)))
(if
(mod/lc-can-transition? from to)
(mod/case*
report
to
decision
tier
nil
(append (mod/case-history c) (list {:note note :to to :from from})))
(mod/case*
(mod/case-report c)
from
(mod/case-decision c)
(mod/case-tier c)
(str "illegal transition: " from " -> " to)
(mod/case-history c))))))
(define
mod/case-error-set
(fn
(c msg)
(mod/case*
(mod/case-report c)
(mod/case-state c)
(mod/case-decision c)
(mod/case-tier c)
msg
(mod/case-history c))))
;; ── lifecycle operations ──
;; :open → :triaged — run the auto-tier first pass.
(define
mod/case-triage
(fn
(c reports rules)
(let
((d (mod/decide-report (mod/case-report c) reports rules)))
(let
((tier (if (= (get d :action) "escalate") "human" "auto")))
(mod/case-goto
c
"triaged"
"auto-tier first pass"
(mod/case-report c)
d
tier)))))
;; :triaged → :decided — auto-tier resolves; human-tier is blocked until review.
(define
mod/case-resolve
(fn
(c)
(if
(= (mod/case-tier c) "human")
(mod/case-error-set c "awaiting human review (escalated)")
(mod/case-goto
c
"decided"
"auto-tier resolved"
(mod/case-report c)
(mod/case-decision c)
(mod/case-tier c)))))
;; :triaged → :decided — human review: attach evidence, re-decide, resolve.
(define
mod/case-review
(fn
(c kind val reports rules)
(let
((nr (mod/attach-evidence (mod/case-report c) (mod/mk-evidence kind val))))
(let
((d (mod/decide-report nr reports rules)))
(mod/case-goto c "decided" (str "human review: " kind) nr d "human")))))
;; :decided → :appealed — appeal: attach evidence, re-decide (may override).
(define
mod/case-appeal
(fn
(c kind val reports rules)
(let
((nr (mod/attach-evidence (mod/case-report c) (mod/mk-evidence kind val))))
(let
((d (mod/decide-report nr reports rules)))
(mod/case-goto
c
"appealed"
(str "appeal: " kind)
nr
d
(mod/case-tier c))))))
;; :decided | :appealed → :final
(define
mod/case-finalize
(fn
(c)
(mod/case-goto
c
"final"
"finalized"
(mod/case-report c)
(mod/case-decision c)
(mod/case-tier c))))
(define
mod/case-action
(fn
(c)
(let ((d (mod/case-decision c))) (if (nil? d) nil (get d :action)))))

92
lib/mod/link.sx Normal file
View File

@@ -0,0 +1,92 @@
;; lib/mod/link.sx — report linking + deduplication.
;;
;; Reports about the same subject form a cluster; identical reports (same
;; reporter + subject + reason) are duplicates. Linking is Prolog-backed: all
;; report facts are loaded and related ids are found by unification — the same
;; relational substrate the policy engine uses, here for retrieval rather than
;; decision. Dedup is pure SX over a normalized link key.
(define
mod/link-key
(fn
(r)
(str
(mod/report-by r)
"|"
(mod/report-about r)
"|"
(downcase (mod/report-reason r)))))
(define
mod/dedup-reports
(fn
(reports)
(reduce
(fn
(acc r)
(if
(mod/any? (fn (x) (= (mod/link-key x) (mod/link-key r))) acc)
acc
(append acc (list r))))
(list)
reports)))
(define
mod/duplicate-count
(fn (reports) (- (len reports) (len (mod/dedup-reports reports)))))
;; ── Prolog-backed relational retrieval ──
(define
mod/report-rel-facts
(fn
(reports)
(mod/join-with
"\n"
(map
(fn
(r)
(str
"report("
(mod/report-id r)
", "
(mod/pl-quote (mod/report-by r))
", "
(mod/pl-quote (mod/report-about r))
")."))
reports))))
(define
mod/related-ids
(fn
(subject reports)
(let
((db (pl-load (mod/report-rel-facts reports))))
(map
(fn (sol) (dict-get sol "Id"))
(pl-query-all db (str "report(Id, _, " (mod/pl-quote subject) ")"))))))
(define
mod/reporters-of
(fn
(subject reports)
(let
((db (pl-load (mod/report-rel-facts reports))))
(map
(fn (sol) (dict-get sol "By"))
(pl-query-all db (str "report(_, By, " (mod/pl-quote subject) ")"))))))
(define
mod/distinct
(fn
(items)
(reduce
(fn
(acc x)
(if (mod/any? (fn (y) (= y x)) acc) acc (append acc (list x))))
(list)
items)))
(define
mod/distinct-reporters-of
(fn (subject reports) (mod/distinct (mod/reporters-of subject reports))))

69
lib/mod/lint.sx Normal file
View File

@@ -0,0 +1,69 @@
;; lib/mod/lint.sx — static analysis of a policy rule set.
;;
;; Because precedence is "first matching clause wins" (pl-query-one), the rule
;; order has correctness consequences a moderator can get wrong: a rule placed
;; after an unconditional (empty :when) rule can never fire, and a rule set with
;; no unconditional rule may leave some reports undecided. lint-rules surfaces
;; these without running the engine.
(define mod/rule-unconditional? (fn (r) (empty? (mod/rule-when r))))
;; names of rules that follow the first unconditional rule — structurally dead,
;; since the unconditional rule always matches first
(define
mod/unreachable-rules
(fn
(rules)
(get
(reduce
(fn
(acc r)
(if
(get acc :hit)
{:dead (append (get acc :dead) (list (mod/rule-name r))) :hit true}
(if (mod/rule-unconditional? r) {:dead (get acc :dead) :hit true} acc)))
{:dead (list) :hit false}
rules)
:dead)))
(define
mod/has-catchall?
(fn (rules) (mod/any? mod/rule-unconditional? rules)))
(define
mod/count-eq
(fn
(x lst)
(reduce (fn (a y) (if (= y x) (+ a 1) a)) 0 lst)))
(define
mod/duplicate-rule-names
(fn
(rules)
(let
((names (map mod/rule-name rules)))
(mod/distinct
(reduce
(fn
(acc n)
(if
(< 1 (mod/count-eq n names))
(append acc (list n))
acc))
(list)
names)))))
(define mod/lint-rules (fn (rules) {:duplicate-names (mod/duplicate-rule-names rules) :has-catchall (mod/has-catchall? rules) :unreachable (mod/unreachable-rules rules)}))
;; a rule set is well-formed when nothing is dead, it has a catch-all, and rule
;; names are unique
(define
mod/rules-ok?
(fn
(rules)
(let
((l (mod/lint-rules rules)))
(if
(empty? (get l :unreachable))
(if (get l :has-catchall) (empty? (get l :duplicate-names)) false)
false))))

59
lib/mod/offenders.sx Normal file
View File

@@ -0,0 +1,59 @@
;; lib/mod/offenders.sx — repeat-offender escalation (audit log as evidence).
;;
;; The append-only audit trail is itself a source of evidence: a subject already
;; sanctioned several times is a repeat offender. mod/decide-escalating decides a
;; report normally, then — if the action is a sanction and the subject has at
;; least k PRIOR sanctions in the audit log — upgrades it to :ban. This is the one
;; place a decision depends on history beyond the single report, and it reads that
;; history from the audit log rather than re-deriving it.
(define
mod/sanction?
(fn
(action)
(mod/any? (fn (a) (= a action)) (list "hide" "remove" "ban"))))
;; count of prior sanctioning decisions in the audit log about a subject
(define
mod/subject-sanctions
(fn
(subject)
(reduce
(fn
(acc e)
(let
((r (mod/get-report (get e :report-id))))
(if
(nil? r)
acc
(if
(if
(= (mod/report-about r) subject)
(mod/sanction? (get e :action))
false)
(+ acc 1)
acc))))
0
(mod/audit-all))))
(define
mod/repeat-offender?
(fn (subject k) (<= k (mod/subject-sanctions subject))))
(define
mod/decide-escalating
(fn
(id k)
(let
((r (mod/get-report id)))
(if
(nil? r)
nil
(let
((priors (mod/subject-sanctions (mod/report-about r))))
(let
((d (mod/decide id)))
(if
(if (mod/sanction? (get d :action)) (<= k priors) false)
{:action "ban" :proof {:goals (get (get d :proof) :goals) :prior-sanctions priors :evidence (get (get d :proof) :evidence) :conditions (list) :rule "repeat-offender-ban" :count (get (get d :proof) :count)} :report-id id :rule "repeat-offender-ban" :strategy "escalating"}
d)))))))

18
lib/mod/pipeline.sx Normal file
View File

@@ -0,0 +1,18 @@
;; lib/mod/pipeline.sx — end-to-end triage orchestration.
;;
;; A single entry point that runs a report through the subsystem and returns the
;; full artifact bundle: the decision (under the report's domain policy), a
;; human-readable explanation, an ActivityPub-shaped event for the bus, and the
;; wire line for federated peers. Composes policies (Ext 17), explain (Ext 3),
;; activity (Ext 16) and wire (Ext 14) — the modules are independent, this is just
;; the convenience that wires them together for the common "process a report" path.
(define
mod/triage-pipeline
(fn
(domain r reports actor)
(let ((d (mod/decide-in domain r reports))) {:activity (mod/decision->activity d actor) :action (get d :action) :wire (mod/decision->wire d) :rule (get d :rule) :decision d :explanation (mod/explain d)})))
(define mod/pipeline-action (fn (p) (get p :action)))
(define mod/pipeline-activity (fn (p) (get p :activity)))
(define mod/pipeline-wire (fn (p) (get p :wire)))

40
lib/mod/policies.sx Normal file
View File

@@ -0,0 +1,40 @@
;; lib/mod/policies.sx — per-domain policy registry.
;;
;; rose-ash spans domains (blog, market, events, federation, …) that want
;; different moderation — a marketplace listing and a blog comment are not held to
;; the same bar. This registry maps a domain to a rule set; mod/decide-in resolves
;; the right policy and decides. Unregistered domains fall back to the default
;; rules, so adding a domain never leaves it unmoderated.
(define mod/*policies* (list))
(define mod/policies-reset! (fn () (set! mod/*policies* (list))))
(define
mod/register-policy!
(fn (domain rules) (begin (append! mod/*policies* {:domain domain :rules rules}) true)))
(define
mod/policy-registered?
(fn
(domain)
(mod/any? (fn (p) (= (get p :domain) domain)) mod/*policies*)))
(define
mod/policy-for
(fn
(domain)
(reduce
(fn (acc p) (if (= (get p :domain) domain) (get p :rules) acc))
mod/default-rules
mod/*policies*)))
(define
mod/decide-in
(fn
(domain r reports)
(mod/decide-report r reports (mod/policy-for domain))))
(define
mod/registered-domains
(fn () (map (fn (p) (get p :domain)) mod/*policies*)))

137
lib/mod/policy.sx Normal file
View File

@@ -0,0 +1,137 @@
;; lib/mod/policy.sx — moderation rules → Prolog clauses.
;;
;; A rule is {:name :action :when}. :when is a list of condition forms; each
;; compiles to a Prolog goal. The conditions in a :when list are ANDed (joined by
;; ", "); :not negates and :any (a list of sub-conditions) disjoins — so the
;; condition language is a small boolean algebra over the leaf predicates.
;; Rule order is precedence: the engine queries with pl-query-one, so the first
;; clause that proves wins. The final default rule has an empty body (true) so
;; every report yields at least :keep — "no rule matched" is a real result, not a
;; query failure.
;;
;; cond->goal takes an id-term so the same condition can be compiled with the
;; head variable "Id" (for clause bodies) or a concrete report id (for proof-tree
;; goal-by-goal re-querying in the engine).
;;
;; Precedence (top wins): exoneration evidence (appeal override) > confirmed-abuse
;; evidence (human review) > spam/abuse classification > repeated-report count >
;; default keep.
(define mod/mk-rule (fn (name action conds) {:when conds :name name :action action}))
(define mod/rule-name (fn (r) (get r :name)))
(define mod/rule-action (fn (r) (get r :action)))
(define mod/rule-when (fn (r) (get r :when)))
(define
mod/default-rules
(list
(mod/mk-rule
"exonerated-keep"
:keep (list (list :evidence "exonerated")))
(mod/mk-rule
"reviewer-remove"
:remove (list (list :evidence "confirmed-abuse")))
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))
(mod/mk-rule
"repeated-escalate"
:escalate (list (list :count-at-least 3)))
(mod/mk-rule "default-keep" :keep (list))))
;; ── condition → Prolog goal ──
;;
;; (:classification "spam") → classification(Id, spam)
;; (:evidence "kind") → evidence(Id, 'kind', _)
;; (:attr "verified") → attr(Id, verified)
;; (:not <cond>) → not(<cond>) (negation)
;; (:any (list c1 c2 ...)) → (g1 ; g2 ; ...) (disjunction)
;; (:count-at-least 3) → report(Id, B, S), report_count(S, N), N >= 3
;; (:score-at-least 5) → aggregate_all(sum(W), signal(Id, _, W), T), T >= 5
;; (:reporters-at-least 2) → report(Id, _, Sr), setof(Br, report(_, Br, Sr), Bsr),
;; length(Bsr, Nr), Nr >= 2 (quorum engine)
;; (:burst-at-least 3) → report(Id, _, Sb), burst_count(Sb, Nb), Nb >= 3
;; (temporal engine)
(define
mod/cond->goal
(fn
(c idterm)
(let
((tag (first c)))
(cond
((= tag :classification)
(str "classification(" idterm ", " (nth c 1) ")"))
((= tag :evidence)
(str
"evidence("
idterm
", "
(mod/pl-quote (nth c 1))
", _)"))
((= tag :attr) (str "attr(" idterm ", " (nth c 1) ")"))
((= tag :not)
(str "not(" (mod/cond->goal (nth c 1) idterm) ")"))
((= tag :any)
(str
"("
(mod/join-with
" ; "
(map
(fn (sub) (mod/cond->goal sub idterm))
(nth c 1)))
")"))
((= tag :count-at-least)
(str
"report("
idterm
", B, S), report_count(S, N), N >= "
(nth c 1)))
((= tag :score-at-least)
(str
"aggregate_all(sum(W), signal("
idterm
", _, W), T), T >= "
(nth c 1)))
((= tag :reporters-at-least)
(str
"report("
idterm
", _, Sr), setof(Br, report(_, Br, Sr), Bsr), "
"length(Bsr, Nr), Nr >= "
(nth c 1)))
((= tag :burst-at-least)
(str
"report("
idterm
", _, Sb), burst_count(Sb, Nb), Nb >= "
(nth c 1)))
(true "true")))))
(define
mod/conds->body
(fn
(conds idterm)
(if
(empty? conds)
"true"
(mod/join-with ", " (map (fn (c) (mod/cond->goal c idterm)) conds)))))
(define
mod/rule->clause
(fn
(r)
(str
"policy_action(Id, "
(mod/rule-action r)
", '"
(mod/rule-name r)
"') :- "
(mod/conds->body (mod/rule-when r) "Id")
".")))
(define
mod/rules->program
(fn (rules) (mod/join-with "\n" (map mod/rule->clause rules))))

40
lib/mod/quorum.sx Normal file
View File

@@ -0,0 +1,40 @@
;; lib/mod/quorum.sx — quorum decisions over distinct reporters (anti-brigade).
;;
;; The base engine asserts only the decided report's report/3 fact, so it can't
;; reason about WHO reported a subject. The quorum engine additionally asserts
;; every report's report/3 fact (via link's rel-facts), letting a rule require N
;; *distinct* reporters with `setof`/`length` — so one user filing many reports
;; does not manufacture consensus. Same decision shape as the base engine, plus
;; :strategy "quorum".
(define
mod/build-quorum-program
(fn
(r count reports rules)
(str
(mod/report-rel-facts reports)
"\n"
(mod/report-facts r count)
"\n"
(mod/rules->program rules))))
(define
mod/decide-quorum
(fn
(r reports rules)
(let
((count (mod/report-count (mod/report-about r) reports))
(kinds (mod/classify-keywords r))
(id (mod/report-id r)))
(let
((program (mod/build-quorum-program r count reports rules)))
(let
((db (pl-load program)))
(let
((sol (pl-query-one db (str "policy_action(" id ", Action, Rule)"))))
(if
(nil? sol)
{:action "keep" :proof {:goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none" :strategy "quorum"}
(let
((rule (mod/find-rule rules (dict-get sol "Rule"))))
{:action (mod/rule-action rule) :proof {:goals (mod/proof-goals db id (mod/rule-when rule)) :evidence kinds :conditions (mod/rule-when rule) :rule (mod/rule-name rule) :count count} :report-id id :rule (mod/rule-name rule) :strategy "quorum"}))))))))

259
lib/mod/schema.sx Normal file
View File

@@ -0,0 +1,259 @@
;; lib/mod/schema.sx — report representation + Prolog fact generation.
;;
;; A report is a dict {:id :by :about :reason :evidence :attrs :signals :at}.
;; :evidence — accumulated {:kind :val} entries (human review, scanners)
;; :attrs — attribute names ("verified") for negation-as-failure conditions
;; :signals — weighted {:kind :weight} entries for aggregate scoring rules
;; :at — integer timestamp/tick (deterministic; supplied, not clock-read)
;; The engine derives keyword classifications from the reason text and projects
;; the report, its classifications, evidence, attributes, and signals into Prolog
;; facts that policy clauses match against.
(define mod/mk-report (fn (id by about reason) {:attrs (list) :id id :signals (list) :by by :evidence (list) :about about :at 0 :reason reason}))
(define mod/report-id (fn (r) (get r :id)))
(define mod/report-by (fn (r) (get r :by)))
(define mod/report-about (fn (r) (get r :about)))
(define mod/report-reason (fn (r) (get r :reason)))
(define
mod/report-evidence
(fn (r) (let ((e (get r :evidence))) (if (nil? e) (list) e))))
(define
mod/report-attrs
(fn (r) (let ((a (get r :attrs))) (if (nil? a) (list) a))))
(define
mod/report-signals
(fn (r) (let ((s (get r :signals))) (if (nil? s) (list) s))))
(define
mod/report-at
(fn (r) (let ((t (get r :at))) (if (nil? t) 0 t))))
(define mod/mk-evidence (fn (kind val) {:val val :kind kind}))
(define mod/evidence-kind (fn (e) (get e :kind)))
(define mod/evidence-val (fn (e) (get e :val)))
(define mod/mk-signal (fn (kind weight) {:kind kind :weight weight}))
(define mod/signal-kind (fn (s) (get s :kind)))
(define mod/signal-weight (fn (s) (get s :weight)))
(define mod/report* (fn (r evs attrs sigs at) {:attrs attrs :id (mod/report-id r) :signals sigs :by (mod/report-by r) :evidence evs :about (mod/report-about r) :at at :reason (mod/report-reason r)}))
(define
mod/with-evidence
(fn
(r evs)
(mod/report*
r
evs
(mod/report-attrs r)
(mod/report-signals r)
(mod/report-at r))))
(define
mod/with-attrs
(fn
(r attrs)
(mod/report*
r
(mod/report-evidence r)
attrs
(mod/report-signals r)
(mod/report-at r))))
(define
mod/with-signals
(fn
(r sigs)
(mod/report*
r
(mod/report-evidence r)
(mod/report-attrs r)
sigs
(mod/report-at r))))
(define
mod/with-at
(fn
(r at)
(mod/report*
r
(mod/report-evidence r)
(mod/report-attrs r)
(mod/report-signals r)
at)))
(define
mod/attach-evidence
(fn
(r e)
(mod/with-evidence r (append (mod/report-evidence r) (list e)))))
(define
mod/attach-attr
(fn (r a) (mod/with-attrs r (append (mod/report-attrs r) (list a)))))
(define
mod/attach-signal
(fn (r s) (mod/with-signals r (append (mod/report-signals r) (list s)))))
;; ── substring search (the prolog-loaded env lacks includes?; slice/len do work) ──
(define
mod/contains-at?
(fn
(hay needle hl nl pos)
(if
(< hl (+ pos nl))
false
(if
(= (slice hay pos (+ pos nl)) needle)
true
(mod/contains-at? hay needle hl nl (+ pos 1))))))
(define
mod/str-contains?
(fn
(hay needle)
(let
((hl (len hay)) (nl (len needle)))
(if
(= nl 0)
true
(mod/contains-at? hay needle hl nl 0)))))
;; ── evidence derivation (keyword classification) ──
(define
mod/spam-keywords
(list "spam" "buy now" "click here" "free money" "viagra" "limited offer"))
(define
mod/abuse-keywords
(list "abuse" "harassment" "threat" "slur" "hate speech"))
(define
mod/any?
(fn (pred coll) (reduce (fn (acc x) (if acc acc (pred x))) false coll)))
(define
mod/reason-matches?
(fn
(reason kws)
(let
((low (downcase reason)))
(mod/any? (fn (k) (mod/str-contains? low k)) kws))))
(define
mod/classify-keywords
(fn
(r)
(let
((reason (mod/report-reason r)) (kinds (list)))
(begin
(when
(mod/reason-matches? reason mod/spam-keywords)
(append! kinds "spam"))
(when
(mod/reason-matches? reason mod/abuse-keywords)
(append! kinds "abuse"))
kinds))))
(define
mod/report-count
(fn
(about reports)
(reduce
(fn
(acc r)
(if (= (mod/report-about r) about) (+ acc 1) acc))
0
reports)))
;; ── Prolog fact projection ──
(define
mod/join-with
(fn
(sep items)
(reduce (fn (acc x) (if (= acc "") x (str acc sep x))) "" items)))
(define mod/pl-quote (fn (s) (str "'" s "'")))
(define
mod/classification-facts
(fn
(id kinds)
(mod/join-with
"\n"
(map (fn (k) (str "classification(" id ", " k ").")) kinds))))
(define
mod/evidence-facts
(fn
(id evs)
(mod/join-with
"\n"
(map
(fn
(e)
(str
"evidence("
id
", "
(mod/pl-quote (mod/evidence-kind e))
", "
(mod/pl-quote (str (mod/evidence-val e)))
")."))
evs))))
(define
mod/attr-facts
(fn
(id attrs)
(mod/join-with "\n" (map (fn (a) (str "attr(" id ", " a ").")) attrs))))
(define
mod/signal-facts
(fn
(id sigs)
(mod/join-with
"\n"
(map
(fn
(s)
(str
"signal("
id
", "
(mod/pl-quote (mod/signal-kind s))
", "
(mod/signal-weight s)
")."))
sigs))))
(define
mod/report-facts
(fn
(r count)
(let
((id (mod/report-id r))
(by (mod/pl-quote (mod/report-by r)))
(about (mod/pl-quote (mod/report-about r))))
(let
((cls (mod/classification-facts id (mod/classify-keywords r)))
(evs (mod/evidence-facts id (mod/report-evidence r)))
(ats (mod/attr-facts id (mod/report-attrs r)))
(sgs (mod/signal-facts id (mod/report-signals r))))
(mod/join-with
"\n"
(list
(str "report(" id ", " by ", " about ").")
(str "report_count(" about ", " count ").")
cls
evs
ats
sgs))))))

30
lib/mod/scoreboard.json Normal file
View File

@@ -0,0 +1,30 @@
{
"lang": "mod",
"total_passed": 390,
"total_failed": 0,
"total": 390,
"suites": [
{"name":"decide","passed":31,"failed":0,"total":31},
{"name":"audit","passed":29,"failed":0,"total":29},
{"name":"escalation","passed":46,"failed":0,"total":46},
{"name":"fed","passed":26,"failed":0,"total":26},
{"name":"extensions","passed":32,"failed":0,"total":32},
{"name":"link","passed":12,"failed":0,"total":12},
{"name":"lint","passed":14,"failed":0,"total":14},
{"name":"severity","passed":14,"failed":0,"total":14},
{"name":"offenders","passed":19,"failed":0,"total":19},
{"name":"quorum","passed":9,"failed":0,"total":9},
{"name":"trace","passed":15,"failed":0,"total":15},
{"name":"whatif","passed":13,"failed":0,"total":13},
{"name":"batch","passed":17,"failed":0,"total":17},
{"name":"temporal","passed":15,"failed":0,"total":15},
{"name":"sla","passed":15,"failed":0,"total":15},
{"name":"wire","passed":16,"failed":0,"total":16},
{"name":"disjunction","passed":10,"failed":0,"total":10},
{"name":"activity","passed":17,"failed":0,"total":17},
{"name":"policies","passed":14,"failed":0,"total":14},
{"name":"defrule","passed":11,"failed":0,"total":11},
{"name":"pipeline","passed":15,"failed":0,"total":15}
],
"generated": "2026-06-06T19:40:03+00:00"
}

27
lib/mod/scoreboard.md Normal file
View File

@@ -0,0 +1,27 @@
# mod scoreboard
**390 / 390 passing** (0 failure(s)).
| Suite | Passed | Total | Status |
|-------|--------|-------|--------|
| decide | 31 | 31 | ok |
| audit | 29 | 29 | ok |
| escalation | 46 | 46 | ok |
| fed | 26 | 26 | ok |
| extensions | 32 | 32 | ok |
| link | 12 | 12 | ok |
| lint | 14 | 14 | ok |
| severity | 14 | 14 | ok |
| offenders | 19 | 19 | ok |
| quorum | 9 | 9 | ok |
| trace | 15 | 15 | ok |
| whatif | 13 | 13 | ok |
| batch | 17 | 17 | ok |
| temporal | 15 | 15 | ok |
| sla | 15 | 15 | ok |
| wire | 16 | 16 | ok |
| disjunction | 10 | 10 | ok |
| activity | 17 | 17 | ok |
| policies | 14 | 14 | ok |
| defrule | 11 | 11 | ok |
| pipeline | 15 | 15 | ok |

60
lib/mod/severity.sx Normal file
View File

@@ -0,0 +1,60 @@
;; lib/mod/severity.sx — "strictest-wins" decision strategy.
;;
;; The default engine resolves precedence by rule ORDER (first proven clause wins,
;; via pl-query-one). Some policies instead want the HARSHEST applicable sanction
;; regardless of order. mod/decide-strictest collects every rule that proves
;; (pl-query-all) and picks the highest-severity action. Same decision shape as
;; the engine, plus :strategy. Built over the engine's helpers; engine untouched.
(define
mod/action-severity
(fn
(action)
(cond
((= action "ban") 4)
((= action "remove") 3)
((= action "hide") 2)
((= action "escalate") 1)
(true 0))))
(define
mod/strictest-sol
(fn
(sols)
(reduce
(fn
(acc s)
(if
(nil? acc)
s
(if
(<
(mod/action-severity (dict-get acc "Action"))
(mod/action-severity (dict-get s "Action")))
s
acc)))
nil
sols)))
(define
mod/decide-strictest
(fn
(r reports rules)
(let
((count (mod/report-count (mod/report-about r) reports))
(kinds (mod/classify-keywords r))
(id (mod/report-id r)))
(let
((program (mod/build-program r count rules)))
(let
((db (pl-load program)))
(let
((sols (pl-query-all db (str "policy_action(" id ", Action, Rule)"))))
(let
((best (mod/strictest-sol sols)))
(if
(nil? best)
{:action "keep" :proof {:goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none" :strategy "strictest"}
(let
((rule (mod/find-rule rules (dict-get best "Rule"))))
{:action (mod/rule-action rule) :proof {:goals (mod/proof-goals db id (mod/rule-when rule)) :evidence kinds :conditions (mod/rule-when rule) :rule (mod/rule-name rule) :count count} :report-id id :rule (mod/rule-name rule) :strategy "strictest"})))))))))

47
lib/mod/sla.sx Normal file
View File

@@ -0,0 +1,47 @@
;; lib/mod/sla.sx — service-level sweep over pending lifecycle cases.
;;
;; Composes the Phase-3 lifecycle with the Ext-12 time dimension: a case left in a
;; pending state (open / triaged / appealed) past a deadline has breached SLA and
;; should resurface. A timed-case pairs a case with the tick it entered its
;; current state (the caller stamps this — the lifecycle stays timeless and pure).
;; Terminal states (decided / final) never breach.
(define mod/pending-states (list "open" "triaged" "appealed"))
(define mod/pending-state? (fn (s) (mod/member? s mod/pending-states)))
(define mod/mk-timed-case (fn (c entered-at) {:entered-at entered-at :case c}))
(define mod/tc-case (fn (tc) (get tc :case)))
(define mod/tc-entered-at (fn (tc) (get tc :entered-at)))
(define
mod/overdue?
(fn
(tc now deadline)
(if
(mod/pending-state? (mod/case-state (mod/tc-case tc)))
(< deadline (- now (mod/tc-entered-at tc)))
false)))
(define
mod/sla-sweep
(fn
(timed-cases now deadline)
(reduce
(fn
(acc tc)
(if
(mod/overdue? tc now deadline)
(append
acc
(list (mod/report-id (mod/case-report (mod/tc-case tc)))))
acc))
(list)
timed-cases)))
(define
mod/overdue-count
(fn
(timed-cases now deadline)
(len (mod/sla-sweep timed-cases now deadline))))
(define mod/age (fn (tc now) (- now (mod/tc-entered-at tc))))

62
lib/mod/temporal.sx Normal file
View File

@@ -0,0 +1,62 @@
;; lib/mod/temporal.sx — burst detection over a time window.
;;
;; A plain report count can't tell a burst (N reports in minutes) from slow
;; accumulation (N reports over months). mod/decide-temporal takes a `now` tick
;; and a `window`, counts reports about the subject with :at within [now-window,
;; now], asserts it as burst_count/2, and lets a `(:burst-at-least K)` rule fire
;; only on a genuine burst. Time is supplied (deterministic), never clock-read.
(define
mod/window-count
(fn
(subject reports now window)
(reduce
(fn
(acc r)
(if
(if
(= (mod/report-about r) subject)
(<= (- now window) (mod/report-at r))
false)
(+ acc 1)
acc))
0
reports)))
(define
mod/build-temporal-program
(fn
(r count bcount rules)
(str
(mod/report-facts r count)
"\n"
"burst_count("
(mod/pl-quote (mod/report-about r))
", "
bcount
").\n"
(mod/rules->program rules))))
(define
mod/decide-temporal
(fn
(r reports rules now window)
(let
((about (mod/report-about r))
(id (mod/report-id r))
(kinds (mod/classify-keywords r)))
(let
((count (mod/report-count about reports))
(bcount (mod/window-count about reports now window)))
(let
((program (mod/build-temporal-program r count bcount rules)))
(let
((db (pl-load program)))
(let
((sol (pl-query-one db (str "policy_action(" id ", Action, Rule)"))))
(if
(nil? sol)
{:action "keep" :proof {:burst bcount :goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none" :strategy "temporal"}
(let
((rule (mod/find-rule rules (dict-get sol "Rule"))))
{:action (mod/rule-action rule) :proof {:burst bcount :goals (mod/proof-goals db id (mod/rule-when rule)) :evidence kinds :conditions (mod/rule-when rule) :rule (mod/rule-name rule) :count count} :report-id id :rule (mod/rule-name rule) :strategy "temporal"})))))))))

95
lib/mod/tests/activity.sx Normal file
View File

@@ -0,0 +1,95 @@
;; lib/mod/tests/activity.sx — Ext 16: ActivityPub-shaped decision export.
(define mod-ap-count 0)
(define mod-ap-pass 0)
(define mod-ap-fail 0)
(define mod-ap-failures (list))
(define
mod-ap-test!
(fn
(name got expected)
(begin
(set! mod-ap-count (+ mod-ap-count 1))
(if
(= got expected)
(set! mod-ap-pass (+ mod-ap-pass 1))
(begin
(set! mod-ap-fail (+ mod-ap-fail 1))
(append!
mod-ap-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── action → AP verb ──
(mod-ap-test! "remove → Delete" (mod/action->verb "remove") "Delete")
(mod-ap-test! "ban → Block" (mod/action->verb "ban") "Block")
(mod-ap-test! "hide → Flag" (mod/action->verb "hide") "Flag")
(mod-ap-test! "escalate → Flag" (mod/action->verb "escalate") "Flag")
(mod-ap-test! "keep → nil (no activity)" (mod/action->verb "keep") nil)
;; ── single decision → activity ──
(define mod-ap-spam (mod/mk-report "r1" "a" "bob" "this is spam"))
(define
mod-ap-dec
(mod/decide-report mod-ap-spam (list mod-ap-spam) mod/default-rules))
(define mod-ap-act (mod/decision->activity mod-ap-dec "instance.example"))
(mod-ap-test! "activity type is Flag (hide)" (get mod-ap-act :type) "Flag")
(mod-ap-test! "activity object is report id" (get mod-ap-act :object) "r1")
(mod-ap-test!
"activity actor preserved"
(get mod-ap-act :actor)
"instance.example")
(mod-ap-test!
"activity preserves precise action"
(get mod-ap-act :action)
"hide")
(mod-ap-test! "activity carries rule" (get mod-ap-act :rule) "spam-hide")
(mod-ap-test!
"activity summary"
(get mod-ap-act :summary)
"moderation/hide via spam-hide")
;; ── keep produces no activity ──
(define mod-ap-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(define
mod-ap-keep
(mod/decide-report mod-ap-clean (list mod-ap-clean) mod/default-rules))
(mod-ap-test!
"keep decision → nil activity"
(mod/decision->activity mod-ap-keep "x")
nil)
;; ── abuse → Delete ──
(define mod-ap-abuse (mod/mk-report "r3" "a" "b" "harassment here"))
(define
mod-ap-abuse-dec
(mod/decide-report mod-ap-abuse (list mod-ap-abuse) mod/default-rules))
(mod-ap-test!
"abuse decision → Delete activity"
(get (mod/decision->activity mod-ap-abuse-dec "x") :type)
"Delete")
;; ── batch export drops keeps ──
(define mod-ap-decisions (list mod-ap-dec mod-ap-keep mod-ap-abuse-dec))
(define mod-ap-acts (mod/decisions->activities mod-ap-decisions "inst"))
(mod-ap-test! "batch export drops the keep" (len mod-ap-acts) 2)
(mod-ap-test!
"batch export first is the Flag"
(get (first mod-ap-acts) :type)
"Flag")
(mod-ap-test!
"batch export second is the Delete"
(get (nth mod-ap-acts 1) :type)
"Delete")
(mod-ap-test!
"empty decisions → no activities"
(mod/decisions->activities (list) "inst")
(list))
(define mod-activity-tests-run! (fn () {:failures mod-ap-failures :total mod-ap-count :passed mod-ap-pass :failed mod-ap-fail}))

187
lib/mod/tests/audit.sx Normal file
View File

@@ -0,0 +1,187 @@
;; lib/mod/tests/audit.sx — Phase 2: evidence accumulation + proof tree + audit.
(define mod-aud-count 0)
(define mod-aud-pass 0)
(define mod-aud-fail 0)
(define mod-aud-failures (list))
(define
mod-aud-test!
(fn
(name got expected)
(begin
(set! mod-aud-count (+ mod-aud-count 1))
(if
(= got expected)
(set! mod-aud-pass (+ mod-aud-pass 1))
(begin
(set! mod-aud-fail (+ mod-aud-fail 1))
(append!
mod-aud-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-aud-decide1
(fn (r) (mod/decide-report r (list r) mod/default-rules)))
;; ── proof tree: keyword classification ──
(define
mod-aud-spam
(mod-aud-decide1 (mod/mk-report "r1" "alice" "bob" "this is spam")))
(define mod-aud-spam-goals (get (get mod-aud-spam :proof) :goals))
(mod-aud-test! "spam proof has one goal" (len mod-aud-spam-goals) 1)
(mod-aud-test!
"spam proof goal text"
(get (first mod-aud-spam-goals) :goal)
"classification(r1, spam)")
(mod-aud-test!
"spam proof goal solved"
(get (first mod-aud-spam-goals) :solved)
true)
;; ── proof tree: count rule with real bindings ──
(define mod-aud-rep-r (mod/mk-report "r3" "ann" "dave" "x"))
(define
mod-aud-rep
(mod/decide-report
mod-aud-rep-r
(list mod-aud-rep-r mod-aud-rep-r mod-aud-rep-r)
mod/default-rules))
(define mod-aud-rep-goals (get (get mod-aud-rep :proof) :goals))
(define mod-aud-rep-binds (get (first mod-aud-rep-goals) :bindings))
(mod-aud-test!
"count proof goal solved"
(get (first mod-aud-rep-goals) :solved)
true)
(mod-aud-test! "count proof binding N" (dict-get mod-aud-rep-binds "N") "3")
(mod-aud-test!
"count proof binding S (subject)"
(dict-get mod-aud-rep-binds "S")
"dave")
;; ── proof tree: default keep has a 'true' goal ──
(define
mod-aud-keep
(mod-aud-decide1 (mod/mk-report "rk" "a" "b" "a fine post")))
(define mod-aud-keep-goals (get (get mod-aud-keep :proof) :goals))
(mod-aud-test!
"keep proof goal text true"
(get (first mod-aud-keep-goals) :goal)
"true")
(mod-aud-test!
"keep proof goal solved"
(get (first mod-aud-keep-goals) :solved)
true)
;; ── evidence accumulation drives a rule ──
(define
mod-aud-rev-r
(mod/attach-evidence
(mod/mk-report "re" "a" "carol" "neutral")
(mod/mk-evidence "confirmed-abuse" "human")))
(define mod-aud-rev (mod-aud-decide1 mod-aud-rev-r))
(mod-aud-test!
"evidence has length 1"
(len (mod/report-evidence mod-aud-rev-r))
1)
(mod-aud-test!
"evidence reviewer-remove → remove"
(get mod-aud-rev :action)
"remove")
(mod-aud-test!
"evidence reviewer-remove rule"
(get mod-aud-rev :rule)
"reviewer-remove")
(mod-aud-test!
"evidence proof goal solved"
(get (first (get (get mod-aud-rev :proof) :goals)) :solved)
true)
(mod-aud-test!
"no evidence → not reviewer-remove"
(get (mod-aud-decide1 (mod/mk-report "rn" "a" "b" "neutral")) :rule)
"default-keep")
;; ── append-only audit log via the api ──
(mod/reset!)
(mod/report "alice" "bob" "this is spam")
(mod/report "carol" "eve" "fine post")
(define mod-aud-d1 (mod/decide "r1"))
(define mod-aud-d2 (mod/decide "r2"))
(mod-aud-test! "two decisions logged" (mod/audit-count) 2)
(mod-aud-test!
"first entry seq 1"
(get (first (mod/audit-all)) :seq)
1)
(mod-aud-test!
"audit r1 returns one entry"
(len (mod/audit "r1"))
1)
(mod-aud-test!
"audit r1 action matches decision"
(get (first (mod/audit "r1")) :action)
(get mod-aud-d1 :action))
(mod-aud-test!
"audit r1 rule matches decision"
(get (first (mod/audit "r1")) :rule)
"spam-hide")
(mod-aud-test!
"audit r1 entry carries proof goals"
(len (get (get (first (mod/audit "r1")) :proof) :goals))
1)
(mod-aud-test!
"audit r2 keep"
(get (first (mod/audit "r2")) :action)
"keep")
(mod-aud-test! "audit unknown report → empty" (mod/audit "r99") (list))
;; ── append-only: re-deciding appends, never mutates ──
(define mod-aud-d1b (mod/decide "r1"))
(mod-aud-test! "re-decide appends (count 3)" (mod/audit-count) 3)
(mod-aud-test!
"audit r1 now has 2 entries"
(len (mod/audit "r1"))
2)
(mod-aud-test!
"audit r1 seqs monotonic"
(get (nth (mod/audit "r1") 1) :seq)
3)
(mod-aud-test!
"audit-latest r1 is seq 3"
(get (mod/audit-latest "r1") :seq)
3)
(mod-aud-test!
"first r1 entry unchanged (still seq 1)"
(get (first (mod/audit "r1")) :seq)
1)
;; ── evidence snapshot captured at decision time ──
(mod/add-evidence "r2" "confirmed-abuse" "human")
(define mod-aud-d2b (mod/decide "r2"))
(mod-aud-test!
"post-evidence decision flips to remove"
(get mod-aud-d2b :action)
"remove")
(mod-aud-test!
"audit snapshot records evidence kind"
(mod/evidence-kind (first (get (mod/audit-latest "r2") :evidence)))
"confirmed-abuse")
(mod-aud-test!
"earlier r2 entry had empty evidence snapshot"
(len (get (first (mod/audit "r2")) :evidence))
0)
(define mod-audit-tests-run! (fn () {:failures mod-aud-failures :total mod-aud-count :passed mod-aud-pass :failed mod-aud-fail}))

101
lib/mod/tests/batch.sx Normal file
View File

@@ -0,0 +1,101 @@
;; lib/mod/tests/batch.sx — Ext 11: batch triage + corpus analytics.
(define mod-b-count 0)
(define mod-b-pass 0)
(define mod-b-fail 0)
(define mod-b-failures (list))
(define
mod-b-test!
(fn
(name got expected)
(begin
(set! mod-b-count (+ mod-b-count 1))
(if
(= got expected)
(set! mod-b-pass (+ mod-b-pass 1))
(begin
(set! mod-b-fail (+ mod-b-fail 1))
(append!
mod-b-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; corpus: 2 spam, 1 abuse, 2 clean — distinct subjects so the count rule stays quiet
(define
mod-b-corpus
(list
(mod/mk-report "r1" "u" "s1" "this is spam")
(mod/mk-report "r2" "u" "s2" "buy now offer")
(mod/mk-report "r3" "u" "s3" "harassment here")
(mod/mk-report "r4" "u" "s4" "a fine post")
(mod/mk-report "r5" "u" "s5" "thanks for sharing")))
(define mod-b-decisions (mod/decide-batch mod-b-corpus mod/default-rules))
;; ── decide-batch ──
(mod-b-test! "one decision per report" (len mod-b-decisions) 5)
(mod-b-test!
"first decision is hide"
(get (first mod-b-decisions) :action)
"hide")
;; ── action histogram ──
(define mod-b-hist (mod/action-histogram mod-b-decisions))
(mod-b-test! "histogram hide count" (get mod-b-hist :hide) 2)
(mod-b-test! "histogram remove count" (get mod-b-hist :remove) 1)
(mod-b-test! "histogram keep count" (get mod-b-hist :keep) 2)
(mod-b-test! "histogram escalate count" (get mod-b-hist :escalate) 0)
(mod-b-test! "histogram ban count" (get mod-b-hist :ban) 0)
(mod-b-test!
"histogram totals match corpus"
(+
(+ (get mod-b-hist :hide) (get mod-b-hist :remove))
(+
(get mod-b-hist :keep)
(+ (get mod-b-hist :escalate) (get mod-b-hist :ban))))
5)
;; ── rule coverage (empirical) ──
(define mod-b-cov (mod/rule-coverage mod-b-corpus mod/default-rules))
(mod-b-test! "coverage has one row per rule" (len mod-b-cov) 6)
(mod-b-test!
"spam-hide fired twice"
(mod/rule-fire-count mod-b-decisions "spam-hide")
2)
(mod-b-test!
"abuse-remove fired once"
(mod/rule-fire-count mod-b-decisions "abuse-remove")
1)
(mod-b-test!
"default-keep fired twice"
(mod/rule-fire-count mod-b-decisions "default-keep")
2)
;; ── never-fired: rules not exercised by this corpus ──
(define mod-b-never (mod/never-fired mod-b-corpus mod/default-rules))
(mod-b-test!
"exonerated-keep never fired"
(mod/member? "exonerated-keep" mod-b-never)
true)
(mod-b-test!
"reviewer-remove never fired"
(mod/member? "reviewer-remove" mod-b-never)
true)
(mod-b-test!
"repeated-escalate never fired"
(mod/member? "repeated-escalate" mod-b-never)
true)
(mod-b-test!
"spam-hide DID fire (not in never-fired)"
(mod/member? "spam-hide" mod-b-never)
false)
(mod-b-test!
"three rules never fired on this corpus"
(len mod-b-never)
3)
(define mod-batch-tests-run! (fn () {:failures mod-b-failures :total mod-b-count :passed mod-b-pass :failed mod-b-fail}))

215
lib/mod/tests/decide.sx Normal file
View File

@@ -0,0 +1,215 @@
;; lib/mod/tests/decide.sx — Phase 1: report representation + simple policy.
(define mod-dec-count 0)
(define mod-dec-pass 0)
(define mod-dec-fail 0)
(define mod-dec-failures (list))
(define
mod-dec-test!
(fn
(name got expected)
(begin
(set! mod-dec-count (+ mod-dec-count 1))
(if
(= got expected)
(set! mod-dec-pass (+ mod-dec-pass 1))
(begin
(set! mod-dec-fail (+ mod-dec-fail 1))
(append!
mod-dec-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; decide a single report (count over a 1-element registry)
(define
mod-dec-one
(fn
(reason)
(let
((r (mod/mk-report "r1" "alice" "bob" reason)))
(mod/decide-report r (list r) mod/default-rules))))
(define mod-dec-action (fn (reason) (get (mod-dec-one reason) :action)))
;; ── spam keyword → :hide ──
(mod-dec-test!
"spam keyword 'spam' → hide"
(mod-dec-action "this is spam")
"hide")
(mod-dec-test!
"spam keyword 'buy now' → hide"
(mod-dec-action "buy now while stocks last")
"hide")
(mod-dec-test!
"spam keyword case-insensitive 'CLICK HERE' → hide"
(mod-dec-action "CLICK HERE now")
"hide")
(mod-dec-test!
"spam keyword 'free money' → hide"
(mod-dec-action "win free money fast")
"hide")
;; ── abuse keyword → :remove ──
(mod-dec-test!
"abuse keyword 'harassment' → remove"
(mod-dec-action "ongoing harassment of users")
"remove")
(mod-dec-test!
"abuse keyword 'threat' → remove"
(mod-dec-action "this is a threat")
"remove")
(mod-dec-test!
"abuse keyword 'slur' → remove"
(mod-dec-action "contains a slur")
"remove")
;; ── no rule → :keep ──
(mod-dec-test!
"neutral reason → keep"
(mod-dec-action "I disagree with this post")
"keep")
(mod-dec-test! "empty reason → keep" (mod-dec-action "") "keep")
;; ── decision carries the matching rule (proof, not bare keyword) ──
(mod-dec-test!
"spam decision rule name"
(get (mod-dec-one "this is spam") :rule)
"spam-hide")
(mod-dec-test!
"keep decision rule name"
(get (mod-dec-one "fine post") :rule)
"default-keep")
(mod-dec-test!
"abuse decision rule name"
(get (mod-dec-one "harassment here") :rule)
"abuse-remove")
(mod-dec-test!
"spam proof :rule"
(get (get (mod-dec-one "spam!") :proof) :rule)
"spam-hide")
(mod-dec-test!
"spam proof :evidence"
(get (get (mod-dec-one "spam!") :proof) :evidence)
(list "spam"))
(mod-dec-test!
"spam proof :count"
(get (get (mod-dec-one "spam!") :proof) :count)
1)
;; ── classification (evidence derivation) ──
(mod-dec-test!
"classify spam"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "spam!"))
(list "spam"))
(mod-dec-test!
"classify abuse"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "abuse"))
(list "abuse"))
(mod-dec-test!
"classify neutral → empty"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "hello"))
(list))
(mod-dec-test!
"classify both spam+abuse"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "spam and abuse"))
(list "spam" "abuse"))
;; ── report-count + repeated → :escalate ──
(define
mod-dec-three
(list
(mod/mk-report "r1" "a" "bob" "x")
(mod/mk-report "r2" "c" "bob" "y")
(mod/mk-report "r3" "d" "bob" "z")))
(mod-dec-test!
"report-count counts subject"
(mod/report-count "bob" mod-dec-three)
3)
(mod-dec-test!
"3 reports about subject → escalate"
(get
(mod/decide-report (first mod-dec-three) mod-dec-three mod/default-rules)
:action)
"escalate")
(mod-dec-test!
"escalate rule name"
(get
(mod/decide-report (first mod-dec-three) mod-dec-three mod/default-rules)
:rule)
"repeated-escalate")
(define
mod-dec-two
(list
(mod/mk-report "r1" "a" "carol" "x")
(mod/mk-report "r2" "c" "carol" "y")))
(mod-dec-test!
"2 reports about subject → keep (below threshold)"
(get
(mod/decide-report (first mod-dec-two) mod-dec-two mod/default-rules)
:action)
"keep")
;; ── precedence: spam beats repeated ──
(define
mod-dec-spam-among-many
(list
(mod/mk-report "r1" "a" "dave" "buy now spam")
(mod/mk-report "r2" "c" "dave" "y")
(mod/mk-report "r3" "d" "dave" "z")))
(mod-dec-test!
"spam wins over repeated (precedence)"
(get
(mod/decide-report
(first mod-dec-spam-among-many)
mod-dec-spam-among-many
mod/default-rules)
:action)
"hide")
;; ── accessors ──
(mod-dec-test!
"report-about accessor"
(mod/report-about (mod/mk-report "r1" "a" "bob" "x"))
"bob")
(mod-dec-test!
"report-by accessor"
(mod/report-by (mod/mk-report "r1" "alice" "bob" "x"))
"alice")
;; ── api registry ──
(mod/reset!)
(define mod-dec-r1 (mod/report "alice" "bob" "this is spam"))
(define mod-dec-r2 (mod/report "carol" "eve" "fine post"))
(mod-dec-test!
"mod/report assigns sequential id r1"
(mod/report-id mod-dec-r1)
"r1")
(mod-dec-test!
"mod/report assigns sequential id r2"
(mod/report-id mod-dec-r2)
"r2")
(mod-dec-test!
"mod/decide via registry → hide"
(get (mod/decide "r1") :action)
"hide")
(mod-dec-test!
"mod/decide via registry → keep"
(get (mod/decide "r2") :action)
"keep")
(mod-dec-test! "mod/decide unknown id → nil" (mod/decide "r99") nil)
(define mod-decide-tests-run! (fn () {:failures mod-dec-failures :total mod-dec-count :passed mod-dec-pass :failed mod-dec-fail}))

95
lib/mod/tests/defrule.sx Normal file
View File

@@ -0,0 +1,95 @@
;; lib/mod/tests/defrule.sx — Ext 18: ergonomic defrule / ruleset.
(define mod-dr-count 0)
(define mod-dr-pass 0)
(define mod-dr-fail 0)
(define mod-dr-failures (list))
(define
mod-dr-test!
(fn
(name got expected)
(begin
(set! mod-dr-count (+ mod-dr-count 1))
(if
(= got expected)
(set! mod-dr-pass (+ mod-dr-pass 1))
(begin
(set! mod-dr-fail (+ mod-dr-fail 1))
(append!
mod-dr-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── defrule produces the same structure as mk-rule ──
(define
mod-dr-r
(mod/defrule "spam-hide" :hide (list :classification "spam")))
(mod-dr-test! "defrule name" (mod/rule-name mod-dr-r) "spam-hide")
(mod-dr-test! "defrule action" (mod/rule-action mod-dr-r) "hide")
(mod-dr-test!
"defrule when wraps the conditions"
(mod/rule-when mod-dr-r)
(list (list :classification "spam")))
(mod-dr-test!
"defrule equals mk-rule equivalent"
(mod/rule-when mod-dr-r)
(mod/rule-when
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))))
;; ── multi-condition + no-condition ──
(define
mod-dr-multi
(mod/defrule
"strict"
:hide (list :classification "spam")
(list :not (list :attr "verified"))))
(mod-dr-test!
"defrule collects multiple conditions"
(len (mod/rule-when mod-dr-multi))
2)
(define mod-dr-catch (mod/defrule "default-keep" :keep))
(mod-dr-test!
"defrule with no conditions is unconditional"
(mod/rule-when mod-dr-catch)
(list))
;; ── ruleset assembles a list ──
(define
mod-dr-rules
(mod/ruleset
(mod/defrule "spam-hide" :hide (list :classification "spam"))
(mod/defrule "default-keep" :keep)))
(mod-dr-test! "ruleset length" (len mod-dr-rules) 2)
(mod-dr-test!
"ruleset first rule name"
(mod/rule-name (first mod-dr-rules))
"spam-hide")
;; ── engine works with defrule/ruleset-built policy ──
(define mod-dr-spam (mod/mk-report "r1" "a" "b" "this is spam"))
(define mod-dr-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(mod-dr-test!
"defrule policy: spam → hide"
(get
(mod/decide-report mod-dr-spam (list mod-dr-spam) mod-dr-rules)
:action)
"hide")
(mod-dr-test!
"defrule policy: clean → keep"
(get
(mod/decide-report mod-dr-clean (list mod-dr-clean) mod-dr-rules)
:action)
"keep")
(mod-dr-test!
"defrule policy: spam names the rule"
(get (mod/decide-report mod-dr-spam (list mod-dr-spam) mod-dr-rules) :rule)
"spam-hide")
(define mod-defrule-tests-run! (fn () {:failures mod-dr-failures :total mod-dr-count :passed mod-dr-pass :failed mod-dr-fail}))

View File

@@ -0,0 +1,145 @@
;; lib/mod/tests/disjunction.sx — Ext 15: disjunctive (:any) conditions.
(define mod-or-count 0)
(define mod-or-pass 0)
(define mod-or-fail 0)
(define mod-or-failures (list))
(define
mod-or-test!
(fn
(name got expected)
(begin
(set! mod-or-count (+ mod-or-count 1))
(if
(= got expected)
(set! mod-or-pass (+ mod-or-pass 1))
(begin
(set! mod-or-fail (+ mod-or-fail 1))
(append!
mod-or-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; one rule, OR of two classifications → one action covers both
(define
mod-or-rules
(list
(mod/mk-rule
"spam-or-abuse-hide"
:hide (list
(list
:any (list (list :classification "spam") (list :classification "abuse")))))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-or-spam (mod/mk-report "r1" "a" "b" "this is spam"))
(define mod-or-abuse (mod/mk-report "r2" "a" "b" "harassment here"))
(define mod-or-clean (mod/mk-report "r3" "a" "b" "a fine post"))
(mod-or-test!
"OR: spam branch → hide"
(get
(mod/decide-report mod-or-spam (list mod-or-spam) mod-or-rules)
:action)
"hide")
(mod-or-test!
"OR: abuse branch → hide"
(get
(mod/decide-report mod-or-abuse (list mod-or-abuse) mod-or-rules)
:action)
"hide")
(mod-or-test!
"OR: neither branch → keep"
(get
(mod/decide-report mod-or-clean (list mod-or-clean) mod-or-rules)
:action)
"keep")
;; ── goal text + proof ──
(mod-or-test!
"cond->goal :any joins with ;"
(mod/cond->goal
(list
:any (list (list :classification "spam") (list :classification "abuse")))
"Id")
"(classification(Id, spam) ; classification(Id, abuse))")
(define
mod-or-dec
(mod/decide-report mod-or-spam (list mod-or-spam) mod-or-rules))
(mod-or-test!
"OR proof goal solved"
(get (first (get (get mod-or-dec :proof) :goals)) :solved)
true)
(mod-or-test!
"OR proof goal text"
(get (first (get (get mod-or-dec :proof) :goals)) :goal)
"(classification(r1, spam) ; classification(r1, abuse))")
;; ── :any composes with :not (NOR-ish) and :attr ──
(define
mod-or-mixed-rules
(list
(mod/mk-rule
"spam-or-flagged-hide"
:hide (list
(list
:any (list (list :classification "spam") (list :attr "flagged")))))
(mod/mk-rule "default-keep" :keep (list))))
(define
mod-or-flagged
(mod/attach-attr (mod/mk-report "r4" "a" "b" "a fine post") "flagged"))
(mod-or-test!
"OR over classification|attr: flagged clean post → hide"
(get
(mod/decide-report
mod-or-flagged
(list mod-or-flagged)
mod-or-mixed-rules)
:action)
"hide")
(mod-or-test!
"cond->goal :any with :not branch"
(mod/cond->goal
(list
:any (list
(list :classification "spam")
(list :not (list :attr "verified"))))
"Id")
"(classification(Id, spam) ; not(attr(Id, verified)))")
;; AND still works alongside OR in the same :when list
(define
mod-or-and-rules
(list
(mod/mk-rule
"spam-and-not-verified"
:hide (list
(list
:any (list (list :classification "spam") (list :classification "abuse")))
(list :not (list :attr "verified"))))
(mod/mk-rule "default-keep" :keep (list))))
(define
mod-or-spam-verified
(mod/attach-attr (mod/mk-report "r5" "a" "b" "this is spam") "verified"))
(mod-or-test!
"AND of OR + NOT: verified spam → keep"
(get
(mod/decide-report
mod-or-spam-verified
(list mod-or-spam-verified)
mod-or-and-rules)
:action)
"keep")
(mod-or-test!
"AND of OR + NOT: unverified abuse → hide"
(get
(mod/decide-report mod-or-abuse (list mod-or-abuse) mod-or-and-rules)
:action)
"hide")
(define mod-disjunction-tests-run! (fn () {:failures mod-or-failures :total mod-or-count :passed mod-or-pass :failed mod-or-fail}))

279
lib/mod/tests/escalation.sx Normal file
View File

@@ -0,0 +1,279 @@
;; lib/mod/tests/escalation.sx — Phase 3: lifecycle state machine + escalation.
(define mod-esc-count 0)
(define mod-esc-pass 0)
(define mod-esc-fail 0)
(define mod-esc-failures (list))
(define
mod-esc-test!
(fn
(name got expected)
(begin
(set! mod-esc-count (+ mod-esc-count 1))
(if
(= got expected)
(set! mod-esc-pass (+ mod-esc-pass 1))
(begin
(set! mod-esc-fail (+ mod-esc-fail 1))
(append!
mod-esc-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── transition table guard ──
(mod-esc-test!
"open → triaged allowed"
(mod/lc-can-transition? "open" "triaged")
true)
(mod-esc-test!
"triaged → decided allowed"
(mod/lc-can-transition? "triaged" "decided")
true)
(mod-esc-test!
"decided → appealed allowed"
(mod/lc-can-transition? "decided" "appealed")
true)
(mod-esc-test!
"appealed → final allowed"
(mod/lc-can-transition? "appealed" "final")
true)
(mod-esc-test!
"open → decided rejected"
(mod/lc-can-transition? "open" "decided")
false)
(mod-esc-test!
"triaged → final rejected"
(mod/lc-can-transition? "triaged" "final")
false)
(mod-esc-test!
"final is terminal"
(mod/lc-can-transition? "final" "open")
false)
;; ── initial state ──
(define
mod-esc-c0
(mod/mk-case (mod/mk-report "r1" "alice" "bob" "this is spam")))
(mod-esc-test! "new case is open" (mod/case-state mod-esc-c0) "open")
(mod-esc-test! "new case has no decision" (mod/case-decision mod-esc-c0) nil)
;; ── auto-tier: spam triages + resolves to decided/hide ──
(define
mod-esc-spam-rep
(list (mod/mk-report "r1" "alice" "bob" "this is spam")))
(define
mod-esc-t1
(mod/case-triage mod-esc-c0 mod-esc-spam-rep mod/default-rules))
(mod-esc-test! "spam triaged" (mod/case-state mod-esc-t1) "triaged")
(mod-esc-test! "spam triage tier auto" (mod/case-tier mod-esc-t1) "auto")
(mod-esc-test! "spam triage action hide" (mod/case-action mod-esc-t1) "hide")
(define mod-esc-r1 (mod/case-resolve mod-esc-t1))
(mod-esc-test!
"auto resolve → decided"
(mod/case-state mod-esc-r1)
"decided")
(mod-esc-test!
"decision preserved through resolve"
(mod/case-action mod-esc-r1)
"hide")
;; ── illegal transition flags :error, leaves state ──
(define mod-esc-bad (mod/case-finalize mod-esc-c0))
(mod-esc-test!
"finalize from open is illegal"
(mod/case-state mod-esc-bad)
"open")
(mod-esc-test!
"illegal transition sets error"
(nil? (mod/case-error mod-esc-bad))
false)
;; ── human-tier: repeated report escalates, resolve blocked, review decides ──
(define mod-esc-rep-r (mod/mk-report "r3" "ann" "dave" "off-topic"))
(define mod-esc-rep-reports (list mod-esc-rep-r mod-esc-rep-r mod-esc-rep-r))
(define mod-esc-rep-c0 (mod/mk-case mod-esc-rep-r))
(define
mod-esc-rep-t
(mod/case-triage mod-esc-rep-c0 mod-esc-rep-reports mod/default-rules))
(mod-esc-test!
"repeated triage action escalate"
(mod/case-action mod-esc-rep-t)
"escalate")
(mod-esc-test!
"repeated triage tier human"
(mod/case-tier mod-esc-rep-t)
"human")
(mod-esc-test!
"repeated still triaged after triage"
(mod/case-state mod-esc-rep-t)
"triaged")
(define mod-esc-rep-block (mod/case-resolve mod-esc-rep-t))
(mod-esc-test!
"auto-resolve blocked on human tier (state unchanged)"
(mod/case-state mod-esc-rep-block)
"triaged")
(mod-esc-test!
"blocked resolve sets error"
(nil? (mod/case-error mod-esc-rep-block))
false)
(define
mod-esc-rep-rev
(mod/case-review
mod-esc-rep-t
"confirmed-abuse"
"human"
mod-esc-rep-reports
mod/default-rules))
(mod-esc-test!
"human review → decided"
(mod/case-state mod-esc-rep-rev)
"decided")
(mod-esc-test!
"human review action remove"
(mod/case-action mod-esc-rep-rev)
"remove")
(mod-esc-test!
"review attached evidence to report"
(len (mod/report-evidence (mod/case-report mod-esc-rep-rev)))
1)
(define mod-esc-rep-final (mod/case-finalize mod-esc-rep-rev))
(mod-esc-test!
"review case finalizes"
(mod/case-state mod-esc-rep-final)
"final")
;; ── appeal overrides a prior decision ──
(define
mod-esc-ap-c0
(mod/mk-case (mod/mk-report "r5" "u" "v" "buy now spam")))
(define mod-esc-ap-rep (list (mod/mk-report "r5" "u" "v" "buy now spam")))
(define
mod-esc-ap-t
(mod/case-triage mod-esc-ap-c0 mod-esc-ap-rep mod/default-rules))
(define mod-esc-ap-d (mod/case-resolve mod-esc-ap-t))
(mod-esc-test!
"appeal precondition decided/hide"
(mod/case-action mod-esc-ap-d)
"hide")
(define
mod-esc-ap-appealed
(mod/case-appeal
mod-esc-ap-d
"exonerated"
"moderator"
mod-esc-ap-rep
mod/default-rules))
(mod-esc-test!
"appeal → appealed state"
(mod/case-state mod-esc-ap-appealed)
"appealed")
(mod-esc-test!
"appeal overrides hide → keep"
(mod/case-action mod-esc-ap-appealed)
"keep")
(mod-esc-test!
"appeal recorded via exonerated-keep rule"
(get (mod/case-decision mod-esc-ap-appealed) :rule)
"exonerated-keep")
(define mod-esc-ap-final (mod/case-finalize mod-esc-ap-appealed))
(mod-esc-test! "appealed → final" (mod/case-state mod-esc-ap-final) "final")
;; ── history records the full traversal ──
(mod-esc-test!
"full lifecycle history length 4 (triage,resolve,appeal,finalize)"
(len (mod/case-history mod-esc-ap-final))
4)
(mod-esc-test!
"first history step open→triaged"
(get (first (mod/case-history mod-esc-ap-final)) :to)
"triaged")
(mod-esc-test!
"last history step → final"
(get (nth (mod/case-history mod-esc-ap-final) 3) :to)
"final")
;; ── api-level lifecycle façade ──
(mod/reset!)
(mod/report "alice" "bob" "this is spam")
(mod/report "carol" "dave" "off-topic")
(mod/report "carol" "dave" "off-topic")
(mod/report "carol" "dave" "off-topic")
(mod-esc-test!
"api: case opens at open"
(mod/case-state (mod/case-of "r1"))
"open")
(define mod-esc-api-t1 (mod/triage "r1"))
(mod-esc-test!
"api: triage spam → triaged"
(mod/case-state mod-esc-api-t1)
"triaged")
(mod-esc-test!
"api: triage spam action hide"
(mod/case-action mod-esc-api-t1)
"hide")
(define mod-esc-api-r1 (mod/resolve "r1"))
(mod-esc-test!
"api: resolve → decided"
(mod/case-state mod-esc-api-r1)
"decided")
(mod-esc-test!
"api: resolve logged decision"
(len (mod/audit "r1"))
1)
(define mod-esc-api-app (mod/appeal "r1" "exonerated" "mod"))
(mod-esc-test!
"api: appeal → appealed"
(mod/case-state mod-esc-api-app)
"appealed")
(mod-esc-test!
"api: appeal overrides → keep"
(mod/case-action mod-esc-api-app)
"keep")
(mod-esc-test!
"api: appeal logged second decision"
(len (mod/audit "r1"))
2)
(mod-esc-test!
"api: finalize → final"
(mod/case-state (mod/finalize "r1"))
"final")
;; r4 is the 3rd report about dave → escalates via the human tier
(define mod-esc-api-t4 (mod/triage "r4"))
(mod-esc-test!
"api: repeated triage escalates (human tier)"
(mod/case-tier mod-esc-api-t4)
"human")
(define mod-esc-api-blk (mod/resolve "r4"))
(mod-esc-test!
"api: escalated resolve blocked"
(mod/case-state mod-esc-api-blk)
"triaged")
(define mod-esc-api-rev (mod/review "r4" "confirmed-abuse" "human"))
(mod-esc-test!
"api: review → decided/remove"
(mod/case-action mod-esc-api-rev)
"remove")
(mod-esc-test! "api: unknown id → nil" (mod/triage "r99") nil)
(define mod-escalation-tests-run! (fn () {:failures mod-esc-failures :total mod-esc-count :passed mod-esc-pass :failed mod-esc-fail}))

313
lib/mod/tests/extensions.sx Normal file
View File

@@ -0,0 +1,313 @@
;; lib/mod/tests/extensions.sx — beyond-roadmap extensions.
;;
;; Ext 1: negation-as-failure conditions (:not / :attr) + report attributes.
;; "hide spam UNLESS the author is verified" (closed-world reasoning).
;; Ext 2: weighted/aggregate evidence scoring (:score-at-least) + report signals.
;; Many low-confidence signals accumulate past a threshold via Prolog
;; aggregate_all(sum(W), ...).
;; Ext 3: human-readable proof explanation (mod/explain) over the proof tree.
;; Demonstrated with custom rule sets so the default policy (and its conformance
;; tests) stays untouched.
(define mod-ext-count 0)
(define mod-ext-pass 0)
(define mod-ext-fail 0)
(define mod-ext-failures (list))
(define
mod-ext-test!
(fn
(name got expected)
(begin
(set! mod-ext-count (+ mod-ext-count 1))
(if
(= got expected)
(set! mod-ext-pass (+ mod-ext-pass 1))
(begin
(set! mod-ext-fail (+ mod-ext-fail 1))
(append!
mod-ext-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── Ext 1: report attributes ──
(define mod-ext-r0 (mod/mk-report "r1" "a" "b" "this is spam"))
(mod-ext-test!
"fresh report has no attrs"
(len (mod/report-attrs mod-ext-r0))
0)
(define mod-ext-rv (mod/attach-attr mod-ext-r0 "verified"))
(mod-ext-test!
"attach-attr adds one attr"
(len (mod/report-attrs mod-ext-rv))
1)
(mod-ext-test!
"attach-attr preserves evidence field"
(len
(mod/report-evidence
(mod/attach-evidence mod-ext-rv (mod/mk-evidence "x" "y"))))
1)
(mod-ext-test!
"attach-evidence preserves attrs"
(len
(mod/report-attrs
(mod/attach-evidence mod-ext-rv (mod/mk-evidence "x" "y"))))
1)
;; ── Ext 1: negation-as-failure: spam hidden unless author verified ──
(define
mod-ext-rules
(list
(mod/mk-rule
"spam-unverified-hide"
:hide (list
(list :classification "spam")
(list :not (list :attr "verified"))))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-ext-spam-plain (mod/mk-report "p1" "a" "b" "this is spam"))
(define
mod-ext-spam-verified
(mod/attach-attr (mod/mk-report "p2" "a" "b" "this is spam") "verified"))
(define mod-ext-clean (mod/mk-report "p3" "a" "b" "a fine post"))
(mod-ext-test!
"unverified spam → hide"
(get
(mod/decide-report
mod-ext-spam-plain
(list mod-ext-spam-plain)
mod-ext-rules)
:action)
"hide")
(mod-ext-test!
"verified author spam → keep (negation blocks)"
(get
(mod/decide-report
mod-ext-spam-verified
(list mod-ext-spam-verified)
mod-ext-rules)
:action)
"keep")
(mod-ext-test!
"clean post → keep"
(get
(mod/decide-report mod-ext-clean (list mod-ext-clean) mod-ext-rules)
:action)
"keep")
;; ── Ext 1: negation appears in the goal text + proof ──
(define
mod-ext-dec
(mod/decide-report
mod-ext-spam-plain
(list mod-ext-spam-plain)
mod-ext-rules))
(define mod-ext-goals (get (get mod-ext-dec :proof) :goals))
(mod-ext-test!
"rule that matched is spam-unverified-hide"
(get mod-ext-dec :rule)
"spam-unverified-hide")
(mod-ext-test! "proof has two goals" (len mod-ext-goals) 2)
(mod-ext-test!
"negation goal text"
(get (nth mod-ext-goals 1) :goal)
"not(attr(p1, verified))")
(mod-ext-test!
"negation goal solved for unverified"
(get (nth mod-ext-goals 1) :solved)
true)
;; ── Ext 1: cond->goal compiles :attr and :not directly ──
(mod-ext-test!
"cond->goal :attr"
(mod/cond->goal (list :attr "verified") "Id")
"attr(Id, verified)")
(mod-ext-test!
"cond->goal :not wraps inner"
(mod/cond->goal (list :not (list :classification "spam")) "Id")
"not(classification(Id, spam))")
;; ── Ext 1: positive :attr condition (allowlist-style) ──
(define
mod-ext-allow-rules
(list
(mod/mk-rule "trusted-keep" :keep (list (list :attr "trusted")))
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule "default-keep" :keep (list))))
(define
mod-ext-trusted-spam
(mod/attach-attr (mod/mk-report "t1" "a" "b" "this is spam") "trusted"))
(mod-ext-test!
"trusted attr exempts spam → keep"
(get
(mod/decide-report
mod-ext-trusted-spam
(list mod-ext-trusted-spam)
mod-ext-allow-rules)
:action)
"keep")
;; ── Ext 2: weighted signals + aggregate scoring ──
(define mod-ext-s0 (mod/mk-report "s1" "a" "b" "neutral"))
(mod-ext-test!
"fresh report has no signals"
(len (mod/report-signals mod-ext-s0))
0)
(define
mod-ext-s1
(mod/attach-signal mod-ext-s0 (mod/mk-signal "link" 2)))
(mod-ext-test!
"attach-signal adds one"
(len (mod/report-signals mod-ext-s1))
1)
(mod-ext-test!
"attach-signal preserves attrs"
(len
(mod/report-attrs
(mod/attach-signal mod-ext-rv (mod/mk-signal "x" 1))))
1)
(define
mod-ext-score-rules
(list
(mod/mk-rule
"high-score-hide"
:hide (list (list :score-at-least 5)))
(mod/mk-rule "default-keep" :keep (list))))
;; one weak signal (2) — below threshold
(define
mod-ext-weak
(mod/attach-signal
(mod/mk-report "w1" "a" "b" "neutral")
(mod/mk-signal "link" 2)))
(mod-ext-test!
"single weak signal → keep (below threshold)"
(get
(mod/decide-report mod-ext-weak (list mod-ext-weak) mod-ext-score-rules)
:action)
"keep")
;; three signals summing to 6 — over threshold
(define
mod-ext-strong0
(mod/attach-signal
(mod/mk-report "w2" "a" "b" "neutral")
(mod/mk-signal "link" 2)))
(define
mod-ext-strong1
(mod/attach-signal mod-ext-strong0 (mod/mk-signal "newaccount" 2)))
(define
mod-ext-strong
(mod/attach-signal mod-ext-strong1 (mod/mk-signal "burst" 2)))
(mod-ext-test!
"accumulated signals (2+2+2=6) → hide"
(get
(mod/decide-report
mod-ext-strong
(list mod-ext-strong)
mod-ext-score-rules)
:action)
"hide")
(mod-ext-test!
"scoring rule named in decision"
(get
(mod/decide-report
mod-ext-strong
(list mod-ext-strong)
mod-ext-score-rules)
:rule)
"high-score-hide")
;; exactly at threshold (5) fires
(define
mod-ext-exact0
(mod/attach-signal
(mod/mk-report "w3" "a" "b" "neutral")
(mod/mk-signal "link" 3)))
(define
mod-ext-exact
(mod/attach-signal mod-ext-exact0 (mod/mk-signal "burst" 2)))
(mod-ext-test!
"exactly at threshold (5) → hide"
(get
(mod/decide-report mod-ext-exact (list mod-ext-exact) mod-ext-score-rules)
:action)
"hide")
(mod-ext-test!
"cond->goal :score-at-least"
(mod/cond->goal (list :score-at-least 5) "Id")
"aggregate_all(sum(W), signal(Id, _, W), T), T >= 5")
;; ── Ext 3: human-readable proof explanation ──
(define mod-ext-spam-explain (mod/explain mod-ext-dec))
(mod-ext-test!
"explain mentions the report id"
(mod/str-contains? mod-ext-spam-explain "Report p1")
true)
(mod-ext-test!
"explain mentions the action"
(mod/str-contains? mod-ext-spam-explain "hide")
true)
(mod-ext-test!
"explain mentions the rule"
(mod/str-contains? mod-ext-spam-explain "spam-unverified-hide")
true)
(mod-ext-test!
"explain marks proved goals"
(mod/str-contains? mod-ext-spam-explain "[proved]")
true)
(mod-ext-test!
"explain renders the evidence line"
(mod/str-contains? mod-ext-spam-explain "Evidence: spam")
true)
;; count-rule explanation shows the unification bindings
(define mod-ext-rep-r (mod/mk-report "rc" "ann" "dave" "off-topic"))
(define
mod-ext-rep-d
(mod/decide-report
mod-ext-rep-r
(list mod-ext-rep-r mod-ext-rep-r mod-ext-rep-r)
mod/default-rules))
(define mod-ext-rep-explain (mod/explain mod-ext-rep-d))
(mod-ext-test!
"explain shows binding N=3"
(mod/str-contains? mod-ext-rep-explain "N=3")
true)
(mod-ext-test!
"explain shows subject binding"
(mod/str-contains? mod-ext-rep-explain "dave")
true)
;; explain-goal direct: unproved goal gets [unproved]
(mod-ext-test!
"explain-goal marks unproved"
(mod/str-contains? (mod/explain-goal {:solved false :goal "attr(x, foo)" :bindings {}}) "[unproved]")
true)
;; explain-binds renders key=value pairs
(mod-ext-test!
"explain-binds renders pair"
(mod/explain-binds {:N "3"})
"N=3")
;; no-evidence decision says (none)
(define
mod-ext-keep-d
(mod/decide-report mod-ext-clean (list mod-ext-clean) mod-ext-rules))
(mod-ext-test!
"explain (none) for empty evidence"
(mod/str-contains? (mod/explain mod-ext-keep-d) "Evidence: (none)")
true)
(define mod-extensions-tests-run! (fn () {:failures mod-ext-failures :total mod-ext-count :passed mod-ext-pass :failed mod-ext-fail}))

154
lib/mod/tests/fed.sx Normal file
View File

@@ -0,0 +1,154 @@
;; lib/mod/tests/fed.sx — Phase 4: federation (mock fed-sx).
(define mod-fed-count 0)
(define mod-fed-pass 0)
(define mod-fed-fail 0)
(define mod-fed-failures (list))
(define
mod-fed-test!
(fn
(name got expected)
(begin
(set! mod-fed-count (+ mod-fed-count 1))
(if
(= got expected)
(set! mod-fed-pass (+ mod-fed-pass 1))
(begin
(set! mod-fed-fail (+ mod-fed-fail 1))
(append!
mod-fed-failures
(str name "\n expected: " expected "\n got: " got)))))))
(mod/reset!)
(mod/fed-reset!)
;; ── trust model (advisory by default) ──
(mod-fed-test! "trust initially false" (mod/trusted? "peerA" :mod) false)
(mod/grant-trust "peerA" :mod)
(mod-fed-test! "trust after grant" (mod/trusted? "peerA" :mod) true)
(mod-fed-test! "trust wrong scope" (mod/trusted? "peerA" :other) false)
(mod-fed-test! "trust other peer" (mod/trusted? "peerB" :mod) false)
(mod/revoke-trust "peerA" :mod)
(mod-fed-test! "trust after revoke" (mod/trusted? "peerA" :mod) false)
;; ── cross-instance reports ──
(define
mod-fed-fr
(mod/fed-receive-report "peerB" "alice" "bob" "this is spam"))
(mod-fed-test! "fed report assigned id r1" (mod/report-id mod-fed-fr) "r1")
(mod-fed-test! "fed report origin is peer" (mod/report-origin "r1") "peerB")
(define mod-fed-local (mod/report "carol" "dave" "fine post"))
(mod-fed-test!
"local report origin is local"
(mod/report-origin (mod/report-id mod-fed-local))
"local")
(mod-fed-test!
"engine decides fed report (spam → hide)"
(get
(mod/decide-report mod-fed-fr (list mod-fed-fr) mod/default-rules)
:action)
"hide")
;; ── decision sharing (outbox) ──
(define mod-fed-dec {:action "hide" :rule "spam-hide" :report-id "r1"})
(define
mod-fed-shared
(mod/fed-share-decision mod-fed-dec (list "peerB" "peerC")))
(mod-fed-test! "share returns notified peers" (len mod-fed-shared) 2)
(mod-fed-test! "outbox has two messages" (len (mod/fed-outbox)) 2)
(mod-fed-test!
"outbox message type decision"
(get (first (mod/fed-outbox)) :type)
"decision")
(mod-fed-test!
"outbox message addressed to peer"
(get (first (mod/fed-outbox)) :to)
"peerB")
;; ── receiving a peer decision: advisory unless trusted ──
(define mod-fed-untrusted (mod/fed-receive-decision "peerZ" {:action "remove" :rule "reviewer-remove" :report-id "rx"}))
(mod-fed-test!
"untrusted decision not applied"
(get mod-fed-untrusted :applied)
false)
(mod-fed-test!
"untrusted decision advisory"
(get mod-fed-untrusted :advisory)
true)
(mod-fed-test!
"untrusted decision absent from applied log"
(mod/fed-applied-action "rx")
nil)
(mod-fed-test!
"advisory log records suggestion"
(len mod/*fed-advisory*)
1)
(mod/grant-trust "peerT" :mod)
(define mod-fed-trusted (mod/fed-receive-decision "peerT" {:action "hide" :rule "spam-hide" :report-id "ry"}))
(mod-fed-test! "trusted decision applied" (get mod-fed-trusted :applied) true)
(mod-fed-test!
"trusted decision binds locally"
(get (mod/fed-applied-action "ry") :action)
"hide")
;; ── revocation ──
(mod-fed-test!
"applied action not yet revoked"
(get (mod/fed-applied-action "ry") :revoked)
false)
(mod/fed-revoke! "ry" "manual")
(mod-fed-test!
"revoke marks applied action revoked"
(get (mod/fed-applied-action "ry") :revoked)
true)
(mod-fed-test!
"revoke emits a revocation message"
(mod/any? (fn (m) (= (get m :type) "revocation")) (mod/fed-outbox))
true)
;; revoke-if-invalidated: proof still holds → no revocation
(define mod-fed-spam-r (mod/mk-report "rs" "a" "b" "this is spam"))
(define
mod-fed-spam-d
(mod/decide-report mod-fed-spam-r (list mod-fed-spam-r) mod/default-rules))
(mod-fed-test! "spam decision is hide" (get mod-fed-spam-d :action) "hide")
(define
mod-fed-rev-same
(mod/fed-revoke-if-invalidated
mod-fed-spam-r
mod-fed-spam-d
(list mod-fed-spam-r)
mod/default-rules))
(mod-fed-test!
"valid proof → not revoked"
(get mod-fed-rev-same :revoked)
false)
;; exoneration invalidates the proof → revocation
(define
mod-fed-exon-r
(mod/attach-evidence mod-fed-spam-r (mod/mk-evidence "exonerated" "mod")))
(define
mod-fed-rev-inv
(mod/fed-revoke-if-invalidated
mod-fed-exon-r
mod-fed-spam-d
(list mod-fed-exon-r)
mod/default-rules))
(mod-fed-test!
"invalidated proof → revoked"
(get mod-fed-rev-inv :revoked)
true)
(mod-fed-test!
"re-decision after exoneration is keep"
(get (get mod-fed-rev-inv :decision) :action)
"keep")
(define mod-fed-tests-run! (fn () {:failures mod-fed-failures :total mod-fed-count :passed mod-fed-pass :failed mod-fed-fail}))

86
lib/mod/tests/link.sx Normal file
View File

@@ -0,0 +1,86 @@
;; lib/mod/tests/link.sx — Ext 4: report linking + dedup.
(define mod-lnk-count 0)
(define mod-lnk-pass 0)
(define mod-lnk-fail 0)
(define mod-lnk-failures (list))
(define
mod-lnk-test!
(fn
(name got expected)
(begin
(set! mod-lnk-count (+ mod-lnk-count 1))
(if
(= got expected)
(set! mod-lnk-pass (+ mod-lnk-pass 1))
(begin
(set! mod-lnk-fail (+ mod-lnk-fail 1))
(append!
mod-lnk-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── link-key + dedup ──
(define mod-lnk-a (mod/mk-report "r1" "alice" "bob" "this is spam"))
(define mod-lnk-a2 (mod/mk-report "r2" "alice" "bob" "THIS IS SPAM"))
(define mod-lnk-b (mod/mk-report "r3" "carol" "bob" "abuse"))
(define mod-lnk-c (mod/mk-report "r4" "alice" "eve" "this is spam"))
(mod-lnk-test!
"identical reports share a link key (case-insensitive reason)"
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-a2))
true)
(mod-lnk-test!
"different reporter → different key"
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-b))
false)
(mod-lnk-test!
"different subject → different key"
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-c))
false)
(define mod-lnk-set (list mod-lnk-a mod-lnk-a2 mod-lnk-b mod-lnk-c))
(mod-lnk-test!
"dedup collapses identical reports"
(len (mod/dedup-reports mod-lnk-set))
3)
(mod-lnk-test!
"duplicate-count counts collapsed"
(mod/duplicate-count mod-lnk-set)
1)
(mod-lnk-test!
"dedup of all-distinct keeps all"
(len (mod/dedup-reports (list mod-lnk-a mod-lnk-b mod-lnk-c)))
3)
;; ── Prolog-backed relational linking ──
(mod-lnk-test!
"related-ids finds all reports about subject"
(len (mod/related-ids "bob" mod-lnk-set))
3)
(mod-lnk-test!
"related-ids returns the ids"
(mod/related-ids "eve" mod-lnk-set)
(list "r4"))
(mod-lnk-test!
"related-ids empty for unknown subject"
(mod/related-ids "nobody" mod-lnk-set)
(list))
;; reporters: bob reported by alice (x2) + carol → 3 raw, 2 distinct
(mod-lnk-test!
"reporters-of counts all reports"
(len (mod/reporters-of "bob" mod-lnk-set))
3)
(mod-lnk-test!
"distinct reporters-of dedups reporters"
(len (mod/distinct-reporters-of "bob" mod-lnk-set))
2)
(mod-lnk-test!
"distinct utility removes dups"
(mod/distinct (list "a" "b" "a" "c" "b"))
(list "a" "b" "c"))
(define mod-link-tests-run! (fn () {:failures mod-lnk-failures :total mod-lnk-count :passed mod-lnk-pass :failed mod-lnk-fail}))

122
lib/mod/tests/lint.sx Normal file
View File

@@ -0,0 +1,122 @@
;; lib/mod/tests/lint.sx — Ext 5: policy rule-set static analysis.
(define mod-lint-count 0)
(define mod-lint-pass 0)
(define mod-lint-fail 0)
(define mod-lint-failures (list))
(define
mod-lint-test!
(fn
(name got expected)
(begin
(set! mod-lint-count (+ mod-lint-count 1))
(if
(= got expected)
(set! mod-lint-pass (+ mod-lint-pass 1))
(begin
(set! mod-lint-fail (+ mod-lint-fail 1))
(append!
mod-lint-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── the default rule set is well-formed ──
(mod-lint-test!
"default rules: no unreachable"
(mod/unreachable-rules mod/default-rules)
(list))
(mod-lint-test!
"default rules: has catch-all"
(mod/has-catchall? mod/default-rules)
true)
(mod-lint-test!
"default rules: no duplicate names"
(mod/duplicate-rule-names mod/default-rules)
(list))
(mod-lint-test!
"default rules: well-formed"
(mod/rules-ok? mod/default-rules)
true)
;; ── unreachable detection ──
(define
mod-lint-shadowed
(list
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule "catch-all" :keep (list))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))
(mod/mk-rule
"repeated"
:escalate (list (list :count-at-least 3)))))
(mod-lint-test!
"rules after catch-all are unreachable"
(mod/unreachable-rules mod-lint-shadowed)
(list "abuse-remove" "repeated"))
(mod-lint-test!
"shadowed rule set is not ok"
(mod/rules-ok? mod-lint-shadowed)
false)
;; ── missing catch-all ──
(define
mod-lint-nocatch
(list
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))))
(mod-lint-test!
"no catch-all detected"
(mod/has-catchall? mod-lint-nocatch)
false)
(mod-lint-test!
"no unreachable when no catch-all"
(mod/unreachable-rules mod-lint-nocatch)
(list))
(mod-lint-test!
"no-catch-all rule set is not ok"
(mod/rules-ok? mod-lint-nocatch)
false)
;; ── duplicate names ──
(define
mod-lint-dups
(list
(mod/mk-rule "x" :hide (list (list :classification "spam")))
(mod/mk-rule "x" :remove (list (list :classification "abuse")))
(mod/mk-rule "default" :keep (list))))
(mod-lint-test!
"duplicate names detected"
(mod/duplicate-rule-names mod-lint-dups)
(list "x"))
(mod-lint-test!
"duplicate-name rule set is not ok"
(mod/rules-ok? mod-lint-dups)
false)
;; ── helpers ──
(mod-lint-test!
"rule-unconditional? true for empty when"
(mod/rule-unconditional? (mod/mk-rule "d" :keep (list)))
true)
(mod-lint-test!
"rule-unconditional? false with conditions"
(mod/rule-unconditional?
(mod/mk-rule "s" :hide (list (list :classification "spam"))))
false)
(mod-lint-test!
"count-eq counts occurrences"
(mod/count-eq "a" (list "a" "b" "a"))
2)
(define mod-lint-tests-run! (fn () {:failures mod-lint-failures :total mod-lint-count :passed mod-lint-pass :failed mod-lint-fail}))

115
lib/mod/tests/offenders.sx Normal file
View File

@@ -0,0 +1,115 @@
;; lib/mod/tests/offenders.sx — Ext 7: repeat-offender escalation.
(define mod-off-count 0)
(define mod-off-pass 0)
(define mod-off-fail 0)
(define mod-off-failures (list))
(define
mod-off-test!
(fn
(name got expected)
(begin
(set! mod-off-count (+ mod-off-count 1))
(if
(= got expected)
(set! mod-off-pass (+ mod-off-pass 1))
(begin
(set! mod-off-fail (+ mod-off-fail 1))
(append!
mod-off-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── sanction? predicate ──
(mod-off-test! "hide is a sanction" (mod/sanction? "hide") true)
(mod-off-test! "remove is a sanction" (mod/sanction? "remove") true)
(mod-off-test! "ban is a sanction" (mod/sanction? "ban") true)
(mod-off-test! "keep is not a sanction" (mod/sanction? "keep") false)
(mod-off-test! "escalate is not a sanction" (mod/sanction? "escalate") false)
;; ── repeat-offender escalation over the audit log ──
(mod/reset!)
(mod/report "u1" "spammer" "this is spam")
(mod/report "u2" "spammer" "buy now offer")
(mod/report "u3" "spammer" "click here free money")
(mod/report "u4" "innocent" "fine post")
(mod-off-test!
"no sanctions before any decision"
(mod/subject-sanctions "spammer")
0)
(define mod-off-d1 (mod/decide-escalating "r1" 2))
(mod-off-test!
"first spam → hide (0 priors)"
(get mod-off-d1 :action)
"hide")
(mod-off-test!
"one sanction recorded"
(mod/subject-sanctions "spammer")
1)
(define mod-off-d2 (mod/decide-escalating "r2" 2))
(mod-off-test!
"second spam → hide (1 prior, below k=2)"
(get mod-off-d2 :action)
"hide")
(mod-off-test!
"two sanctions recorded"
(mod/subject-sanctions "spammer")
2)
(define mod-off-d3 (mod/decide-escalating "r3" 2))
(mod-off-test!
"third spam → ban (2 priors ≥ k)"
(get mod-off-d3 :action)
"ban")
(mod-off-test!
"ban decision names repeat-offender rule"
(get mod-off-d3 :rule)
"repeat-offender-ban")
(mod-off-test!
"ban proof records prior sanction count"
(get (get mod-off-d3 :proof) :prior-sanctions)
2)
;; ── different subjects accumulate independently ──
(define mod-off-d4 (mod/decide-escalating "r4" 2))
(mod-off-test!
"innocent keep → not escalated"
(get mod-off-d4 :action)
"keep")
(mod-off-test!
"innocent has no sanctions"
(mod/subject-sanctions "innocent")
0)
(mod-off-test!
"repeat-offender? true for spammer at k=2"
(mod/repeat-offender? "spammer" 2)
true)
(mod-off-test!
"repeat-offender? false for innocent at k=1"
(mod/repeat-offender? "innocent" 1)
false)
;; ── non-sanction decisions are never upgraded to ban ──
;; r5 is a clean post, but it is the 4th report about "spammer", so the
;; repeated-report rule escalates it. escalate is not a sanction, so it passes
;; through decide-escalating unchanged (never becomes :ban).
(mod/report "u5" "spammer" "a perfectly fine post")
(define mod-off-d5 (mod/decide-escalating "r5" 1))
(mod-off-test!
"non-sanction (escalate) decision is not upgraded to ban"
(get mod-off-d5 :action)
"escalate")
(mod-off-test!
"decide-escalating unknown id → nil"
(mod/decide-escalating "r99" 2)
nil)
(define mod-offenders-tests-run! (fn () {:failures mod-off-failures :total mod-off-count :passed mod-off-pass :failed mod-off-fail}))

112
lib/mod/tests/pipeline.sx Normal file
View File

@@ -0,0 +1,112 @@
;; lib/mod/tests/pipeline.sx — Ext 19: end-to-end triage orchestration.
(define mod-pp-count 0)
(define mod-pp-pass 0)
(define mod-pp-fail 0)
(define mod-pp-failures (list))
(define
mod-pp-test!
(fn
(name got expected)
(begin
(set! mod-pp-count (+ mod-pp-count 1))
(if
(= got expected)
(set! mod-pp-pass (+ mod-pp-pass 1))
(begin
(set! mod-pp-fail (+ mod-pp-fail 1))
(append!
mod-pp-failures
(str name "\n expected: " expected "\n got: " got)))))))
(mod/policies-reset!)
(mod/register-policy!
"market"
(mod/ruleset
(mod/defrule "market-spam-remove" :remove (list :classification "spam"))
(mod/defrule "default-keep" :keep)))
;; ── spam in the market domain: full bundle ──
(define mod-pp-spam (mod/mk-report "r1" "u" "bob" "this is spam"))
(define
mod-pp
(mod/triage-pipeline "market" mod-pp-spam (list mod-pp-spam) "inst.example"))
(mod-pp-test!
"pipeline action (market policy → remove)"
(mod/pipeline-action mod-pp)
"remove")
(mod-pp-test! "pipeline rule" (get mod-pp :rule) "market-spam-remove")
(mod-pp-test!
"pipeline explanation mentions the action"
(mod/str-contains? (get mod-pp :explanation) "remove")
true)
(mod-pp-test!
"pipeline activity is Delete (remove)"
(get (mod/pipeline-activity mod-pp) :type)
"Delete")
(mod-pp-test!
"pipeline activity object is the report"
(get (mod/pipeline-activity mod-pp) :object)
"r1")
(mod-pp-test!
"pipeline wire round-trips to the same action"
(get (mod/wire->decision (mod/pipeline-wire mod-pp)) :action)
"remove")
;; ── same report, blog domain (default) → hide, Flag ──
(define
mod-pp-blog
(mod/triage-pipeline "blog" mod-pp-spam (list mod-pp-spam) "inst.example"))
(mod-pp-test!
"blog default policy → hide"
(mod/pipeline-action mod-pp-blog)
"hide")
(mod-pp-test!
"blog activity is Flag"
(get (mod/pipeline-activity mod-pp-blog) :type)
"Flag")
;; ── clean report: keep, no activity, explanation says (none) ──
(define mod-pp-clean (mod/mk-report "r2" "u" "eve" "a fine post"))
(define
mod-pp-k
(mod/triage-pipeline
"market"
mod-pp-clean
(list mod-pp-clean)
"inst.example"))
(mod-pp-test! "clean → keep" (mod/pipeline-action mod-pp-k) "keep")
(mod-pp-test! "keep → no activity" (mod/pipeline-activity mod-pp-k) nil)
(mod-pp-test!
"keep explanation says no evidence"
(mod/str-contains? (get mod-pp-k :explanation) "Evidence: (none)")
true)
(mod-pp-test!
"keep wire still round-trips"
(get (mod/wire->decision (mod/pipeline-wire mod-pp-k)) :rule)
"default-keep")
;; ── federated handoff: market decision crosses to a peer, trust-gated ──
(mod/fed-reset!)
(define mod-pp-peer-dec (mod/wire->decision (mod/pipeline-wire mod-pp)))
(mod-pp-test!
"untrusted peer: market decision is advisory"
(get (mod/fed-receive-decision "peerX" mod-pp-peer-dec) :applied)
false)
(mod/grant-trust "peerY" :mod)
(mod-pp-test!
"trusted peer: market decision applies"
(get (mod/fed-receive-decision "peerY" mod-pp-peer-dec) :applied)
true)
(mod-pp-test!
"applied action is remove"
(get (mod/fed-applied-action "r1") :action)
"remove")
(define mod-pipeline-tests-run! (fn () {:failures mod-pp-failures :total mod-pp-count :passed mod-pp-pass :failed mod-pp-fail}))

112
lib/mod/tests/policies.sx Normal file
View File

@@ -0,0 +1,112 @@
;; lib/mod/tests/policies.sx — Ext 17: per-domain policy registry.
(define mod-pol-count 0)
(define mod-pol-pass 0)
(define mod-pol-fail 0)
(define mod-pol-failures (list))
(define
mod-pol-test!
(fn
(name got expected)
(begin
(set! mod-pol-count (+ mod-pol-count 1))
(if
(= got expected)
(set! mod-pol-pass (+ mod-pol-pass 1))
(begin
(set! mod-pol-fail (+ mod-pol-fail 1))
(append!
mod-pol-failures
(str name "\n expected: " expected "\n got: " got)))))))
(mod/policies-reset!)
;; market is strict: spam is removed outright, not just hidden
(define
mod-pol-market-rules
(list
(mod/mk-rule
"market-spam-remove"
:remove (list (list :classification "spam")))
(mod/mk-rule "default-keep" :keep (list))))
(mod-pol-test!
"unregistered domain falls back to default"
(mod/policy-registered? "market")
false)
(mod/register-policy! "market" mod-pol-market-rules)
(mod-pol-test!
"domain registered after register!"
(mod/policy-registered? "market")
true)
(define mod-pol-spam (mod/mk-report "r1" "a" "b" "this is spam"))
;; ── same report, different domain → different action ──
(mod-pol-test!
"market policy removes spam"
(get (mod/decide-in "market" mod-pol-spam (list mod-pol-spam)) :action)
"remove")
(mod-pol-test!
"market decision uses market rule"
(get (mod/decide-in "market" mod-pol-spam (list mod-pol-spam)) :rule)
"market-spam-remove")
(mod-pol-test!
"blog (unregistered) uses default → hide"
(get (mod/decide-in "blog" mod-pol-spam (list mod-pol-spam)) :action)
"hide")
(mod-pol-test!
"blog decision uses default rule"
(get (mod/decide-in "blog" mod-pol-spam (list mod-pol-spam)) :rule)
"spam-hide")
;; ── policy-for resolution ──
(mod-pol-test!
"policy-for market returns market rules"
(mod/policy-for "market")
mod-pol-market-rules)
(mod-pol-test!
"policy-for unknown returns default"
(mod/policy-for "events")
mod/default-rules)
(mod-pol-test!
"registered-domains lists market"
(mod/registered-domains)
(list "market"))
;; ── a second domain ──
(define
mod-pol-events-rules
(list (mod/mk-rule "events-keep-all" :keep (list))))
(mod/register-policy! "events" mod-pol-events-rules)
(mod-pol-test!
"events policy keeps everything (even spam)"
(get (mod/decide-in "events" mod-pol-spam (list mod-pol-spam)) :action)
"keep")
(mod-pol-test!
"two domains registered"
(len (mod/registered-domains))
2)
(mod-pol-test!
"market still removes after second registration"
(get (mod/decide-in "market" mod-pol-spam (list mod-pol-spam)) :action)
"remove")
;; ── clean report is keep everywhere ──
(define mod-pol-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(mod-pol-test!
"clean report keep in market"
(get (mod/decide-in "market" mod-pol-clean (list mod-pol-clean)) :action)
"keep")
(mod-pol-test!
"clean report keep in blog"
(get (mod/decide-in "blog" mod-pol-clean (list mod-pol-clean)) :action)
"keep")
(define mod-policies-tests-run! (fn () {:failures mod-pol-failures :total mod-pol-count :passed mod-pol-pass :failed mod-pol-fail}))

119
lib/mod/tests/quorum.sx Normal file
View File

@@ -0,0 +1,119 @@
;; lib/mod/tests/quorum.sx — Ext 8: quorum over distinct reporters.
(define mod-q-count 0)
(define mod-q-pass 0)
(define mod-q-fail 0)
(define mod-q-failures (list))
(define
mod-q-test!
(fn
(name got expected)
(begin
(set! mod-q-count (+ mod-q-count 1))
(if
(= got expected)
(set! mod-q-pass (+ mod-q-pass 1))
(begin
(set! mod-q-fail (+ mod-q-fail 1))
(append!
mod-q-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-q-rules
(list
(mod/mk-rule
"quorum-hide"
:hide (list (list :reporters-at-least 2)))
(mod/mk-rule "default-keep" :keep (list))))
;; ── two distinct reporters meet quorum ──
(define
mod-q-two
(list
(mod/mk-report "r1" "alice" "bob" "off-topic")
(mod/mk-report "r2" "carol" "bob" "off-topic")))
(mod-q-test!
"two distinct reporters → hide"
(get (mod/decide-quorum (first mod-q-two) mod-q-two mod-q-rules) :action)
"hide")
(mod-q-test!
"quorum decision names the rule"
(get (mod/decide-quorum (first mod-q-two) mod-q-two mod-q-rules) :rule)
"quorum-hide")
(mod-q-test!
"quorum decision tagged strategy"
(get (mod/decide-quorum (first mod-q-two) mod-q-two mod-q-rules) :strategy)
"quorum")
;; ── single reporter does not meet quorum ──
(define mod-q-one (list (mod/mk-report "r1" "alice" "bob" "off-topic")))
(mod-q-test!
"one reporter → keep (below quorum)"
(get (mod/decide-quorum (first mod-q-one) mod-q-one mod-q-rules) :action)
"keep")
;; ── anti-brigade: one user filing many reports does NOT meet quorum ──
(define
mod-q-brigade
(list
(mod/mk-report "r1" "alice" "bob" "off-topic")
(mod/mk-report "r2" "alice" "bob" "off-topic")
(mod/mk-report "r3" "alice" "bob" "off-topic")))
(mod-q-test!
"three reports, one reporter → keep (quorum counts distinct)"
(get
(mod/decide-quorum (first mod-q-brigade) mod-q-brigade mod-q-rules)
:action)
"keep")
;; contrast: the count rule WOULD fire on the same brigade (3 reports ≥ 3) —
;; quorum is strictly stronger against single-actor brigading
(mod-q-test!
"count rule fires on the brigade (distinct from quorum)"
(get
(mod/decide-report (first mod-q-brigade) mod-q-brigade mod/default-rules)
:action)
"escalate")
;; ── three distinct reporters ──
(define
mod-q-three
(list
(mod/mk-report "r1" "alice" "bob" "off-topic")
(mod/mk-report "r2" "carol" "bob" "off-topic")
(mod/mk-report "r3" "dave" "bob" "off-topic")))
(mod-q-test!
"three distinct reporters → hide"
(get
(mod/decide-quorum (first mod-q-three) mod-q-three mod-q-rules)
:action)
"hide")
(mod-q-test!
"quorum proof goal solved"
(get
(first
(get
(get
(mod/decide-quorum (first mod-q-three) mod-q-three mod-q-rules)
:proof)
:goals))
:solved)
true)
;; ── cond->goal compiles :reporters-at-least ──
(mod-q-test!
"cond->goal :reporters-at-least"
(mod/cond->goal (list :reporters-at-least 2) "Id")
"report(Id, _, Sr), setof(Br, report(_, Br, Sr), Bsr), length(Bsr, Nr), Nr >= 2")
(define mod-quorum-tests-run! (fn () {:failures mod-q-failures :total mod-q-count :passed mod-q-pass :failed mod-q-fail}))

120
lib/mod/tests/severity.sx Normal file
View File

@@ -0,0 +1,120 @@
;; lib/mod/tests/severity.sx — Ext 6: strictest-wins decision strategy.
(define mod-sev-count 0)
(define mod-sev-pass 0)
(define mod-sev-fail 0)
(define mod-sev-failures (list))
(define
mod-sev-test!
(fn
(name got expected)
(begin
(set! mod-sev-count (+ mod-sev-count 1))
(if
(= got expected)
(set! mod-sev-pass (+ mod-sev-pass 1))
(begin
(set! mod-sev-fail (+ mod-sev-fail 1))
(append!
mod-sev-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── severity ranking ──
(mod-sev-test! "ban most severe" (mod/action-severity "ban") 4)
(mod-sev-test!
"remove > hide"
(< (mod/action-severity "hide") (mod/action-severity "remove"))
true)
(mod-sev-test! "keep least severe" (mod/action-severity "keep") 0)
(mod-sev-test!
"escalate above keep"
(< (mod/action-severity "keep") (mod/action-severity "escalate"))
true)
;; ── strictest agrees with default-rules on simple cases ──
(define mod-sev-spam (mod/mk-report "r1" "a" "b" "this is spam"))
(mod-sev-test!
"strictest spam → hide"
(get
(mod/decide-strictest mod-sev-spam (list mod-sev-spam) mod/default-rules)
:action)
"hide")
(define mod-sev-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(mod-sev-test!
"strictest clean → keep"
(get
(mod/decide-strictest
mod-sev-clean
(list mod-sev-clean)
mod/default-rules)
:action)
"keep")
(mod-sev-test!
"decision tagged strategy strictest"
(get
(mod/decide-strictest mod-sev-spam (list mod-sev-spam) mod/default-rules)
:strategy)
"strictest")
;; ── strictest diverges from first-match when order ≠ severity ──
(define
mod-sev-rules
(list
(mod/mk-rule
"early-escalate"
:escalate (list (list :count-at-least 1)))
(mod/mk-rule "spam-remove" :remove (list (list :classification "spam")))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-sev-r (mod/mk-report "r3" "a" "b" "this is spam"))
(mod-sev-test!
"first-match picks earliest rule (escalate)"
(get (mod/decide-report mod-sev-r (list mod-sev-r) mod-sev-rules) :action)
"escalate")
(mod-sev-test!
"strictest picks harshest action (remove)"
(get
(mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules)
:action)
"remove")
(mod-sev-test!
"strictest names the harshest rule"
(get (mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules) :rule)
"spam-remove")
(mod-sev-test!
"strictest carries proof goals"
(len
(get
(get
(mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules)
:proof)
:goals))
1)
;; ── strictest among three matches (spam + repeated) ──
(define mod-sev-rep (mod/mk-report "r4" "a" "b" "buy now spam"))
(define mod-sev-reps (list mod-sev-rep mod-sev-rep mod-sev-rep))
(mod-sev-test!
"strictest among hide+escalate+keep → hide (default rules)"
(get
(mod/decide-strictest mod-sev-rep mod-sev-reps mod/default-rules)
:action)
"hide")
;; ── strictest-sol helper ──
(mod-sev-test!
"strictest-sol picks max severity"
(dict-get
(mod/strictest-sol (list {:Action "keep" :Rule "k"} {:Action "remove" :Rule "r"} {:Action "hide" :Rule "h"}))
"Action")
"remove")
(mod-sev-test! "strictest-sol nil for empty" (mod/strictest-sol (list)) nil)
(define mod-severity-tests-run! (fn () {:failures mod-sev-failures :total mod-sev-count :passed mod-sev-pass :failed mod-sev-fail}))

108
lib/mod/tests/sla.sx Normal file
View File

@@ -0,0 +1,108 @@
;; lib/mod/tests/sla.sx — Ext 13: SLA sweep over pending lifecycle cases.
(define mod-sla-count 0)
(define mod-sla-pass 0)
(define mod-sla-fail 0)
(define mod-sla-failures (list))
(define
mod-sla-test!
(fn
(name got expected)
(begin
(set! mod-sla-count (+ mod-sla-count 1))
(if
(= got expected)
(set! mod-sla-pass (+ mod-sla-pass 1))
(begin
(set! mod-sla-fail (+ mod-sla-fail 1))
(append!
mod-sla-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── pending-state? ──
(mod-sla-test! "open is pending" (mod/pending-state? "open") true)
(mod-sla-test! "triaged is pending" (mod/pending-state? "triaged") true)
(mod-sla-test! "appealed is pending" (mod/pending-state? "appealed") true)
(mod-sla-test! "decided is not pending" (mod/pending-state? "decided") false)
(mod-sla-test! "final is not pending" (mod/pending-state? "final") false)
;; build cases in known states
(define mod-sla-spam (mod/mk-report "r1" "u" "bob" "this is spam"))
(define mod-sla-spam-reports (list mod-sla-spam))
(define
mod-sla-triaged
(mod/case-triage
(mod/mk-case mod-sla-spam)
mod-sla-spam-reports
mod/default-rules))
(define mod-sla-decided (mod/case-resolve mod-sla-triaged))
(define mod-sla-open (mod/mk-case (mod/mk-report "r2" "u" "eve" "hello")))
;; ── overdue? ──
(define mod-sla-tc-old (mod/mk-timed-case mod-sla-triaged 0))
(define mod-sla-tc-fresh (mod/mk-timed-case mod-sla-triaged 90))
(define mod-sla-tc-done (mod/mk-timed-case mod-sla-decided 0))
(mod-sla-test!
"old triaged case is overdue"
(mod/overdue? mod-sla-tc-old 100 50)
true)
(mod-sla-test!
"fresh triaged case not overdue"
(mod/overdue? mod-sla-tc-fresh 100 50)
false)
(mod-sla-test!
"decided case never overdue"
(mod/overdue? mod-sla-tc-done 100 50)
false)
(mod-sla-test!
"age computes elapsed ticks"
(mod/age mod-sla-tc-old 100)
100)
(mod-sla-test!
"boundary: exactly at deadline not overdue"
(mod/overdue?
(mod/mk-timed-case mod-sla-triaged 50)
100
50)
false)
(mod-sla-test!
"boundary: one past deadline overdue"
(mod/overdue?
(mod/mk-timed-case mod-sla-triaged 49)
100
50)
true)
;; ── sweep over a mixed queue ──
(define
mod-sla-queue
(list
(mod/mk-timed-case mod-sla-triaged 0)
(mod/mk-timed-case mod-sla-decided 0)
(mod/mk-timed-case mod-sla-open 90))) ;; r2, pending, age 10 → not
(mod-sla-test!
"sweep finds only the overdue pending case"
(mod/sla-sweep mod-sla-queue 100 50)
(list "r1"))
(mod-sla-test!
"overdue-count agrees"
(mod/overdue-count mod-sla-queue 100 50)
1)
;; tighten deadline so the young open case also breaches
(mod-sla-test!
"tighter deadline catches the open case too"
(mod/overdue-count mod-sla-queue 100 5)
2)
(mod-sla-test!
"empty queue → no breaches"
(mod/sla-sweep (list) 100 50)
(list))
(define mod-sla-tests-run! (fn () {:failures mod-sla-failures :total mod-sla-count :passed mod-sla-pass :failed mod-sla-fail}))

156
lib/mod/tests/temporal.sx Normal file
View File

@@ -0,0 +1,156 @@
;; lib/mod/tests/temporal.sx — Ext 12: burst detection over a time window.
(define mod-tm-count 0)
(define mod-tm-pass 0)
(define mod-tm-fail 0)
(define mod-tm-failures (list))
(define
mod-tm-test!
(fn
(name got expected)
(begin
(set! mod-tm-count (+ mod-tm-count 1))
(if
(= got expected)
(set! mod-tm-pass (+ mod-tm-pass 1))
(begin
(set! mod-tm-fail (+ mod-tm-fail 1))
(append!
mod-tm-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-tm-at
(fn (id about t) (mod/with-at (mod/mk-report id "u" about "off-topic") t)))
(define
mod-tm-rules
(list
(mod/mk-rule "burst-hide" :hide (list (list :burst-at-least 3)))
(mod/mk-rule "default-keep" :keep (list))))
;; ── window-count helper ──
(define
mod-tm-burst
(list
(mod-tm-at "r1" "bob" 10)
(mod-tm-at "r2" "bob" 11)
(mod-tm-at "r3" "bob" 12)))
(define
mod-tm-slow
(list
(mod-tm-at "r1" "bob" 1)
(mod-tm-at "r2" "bob" 2)
(mod-tm-at "r3" "bob" 12)))
(mod-tm-test!
"window-count: all 3 within window"
(mod/window-count "bob" mod-tm-burst 12 5)
3)
(mod-tm-test!
"window-count: only 1 within window"
(mod/window-count "bob" mod-tm-slow 12 5)
1)
(mod-tm-test!
"window-count: subject filter"
(mod/window-count "eve" mod-tm-burst 12 5)
0)
;; ── burst fires; slow accumulation does not ──
(mod-tm-test!
"burst (3 in window) → hide"
(get
(mod/decide-temporal
(first mod-tm-burst)
mod-tm-burst
mod-tm-rules
12
5)
:action)
"hide")
(mod-tm-test!
"slow accumulation (1 in window) → keep"
(get
(mod/decide-temporal
(first mod-tm-slow)
mod-tm-slow
mod-tm-rules
12
5)
:action)
"keep")
;; ── contrast: the plain count rule fires on BOTH (3 total reports) ──
(mod-tm-test!
"count rule fires on slow case (distinct from burst)"
(get
(mod/decide-report (first mod-tm-slow) mod-tm-slow mod/default-rules)
:action)
"escalate")
;; ── decision shape ──
(define
mod-tm-d
(mod/decide-temporal
(first mod-tm-burst)
mod-tm-burst
mod-tm-rules
12
5))
(mod-tm-test! "burst decision rule" (get mod-tm-d :rule) "burst-hide")
(mod-tm-test!
"burst decision tagged strategy"
(get mod-tm-d :strategy)
"temporal")
(mod-tm-test!
"burst recorded in proof"
(get (get mod-tm-d :proof) :burst)
3)
(mod-tm-test!
"burst proof goal solved"
(get (first (get (get mod-tm-d :proof) :goals)) :solved)
true)
;; ── window boundary is inclusive ──
(define
mod-tm-edge
(list
(mod-tm-at "r1" "bob" 7)
(mod-tm-at "r2" "bob" 8)
(mod-tm-at "r3" "bob" 9)))
(mod-tm-test!
"window boundary inclusive (now-window = at)"
(mod/window-count "bob" mod-tm-edge 12 5)
3)
;; ── schema :at round-trips and survives evidence attach ──
(mod-tm-test!
"report-at reads timestamp"
(mod/report-at (mod-tm-at "r1" "bob" 42))
42)
(mod-tm-test!
"default report-at is 0"
(mod/report-at (mod/mk-report "r1" "a" "b" "x"))
0)
(mod-tm-test!
"attach-evidence preserves :at"
(mod/report-at
(mod/attach-evidence
(mod-tm-at "r1" "bob" 42)
(mod/mk-evidence "k" "v")))
42)
;; ── cond->goal :burst-at-least ──
(mod-tm-test!
"cond->goal :burst-at-least"
(mod/cond->goal (list :burst-at-least 3) "Id")
"report(Id, _, Sb), burst_count(Sb, Nb), Nb >= 3")
(define mod-temporal-tests-run! (fn () {:failures mod-tm-failures :total mod-tm-count :passed mod-tm-pass :failed mod-tm-fail}))

116
lib/mod/tests/trace.sx Normal file
View File

@@ -0,0 +1,116 @@
;; lib/mod/tests/trace.sx — Ext 9: policy dry-run diagnostics.
(define mod-tr-count 0)
(define mod-tr-pass 0)
(define mod-tr-fail 0)
(define mod-tr-failures (list))
(define
mod-tr-test!
(fn
(name got expected)
(begin
(set! mod-tr-count (+ mod-tr-count 1))
(if
(= got expected)
(set! mod-tr-pass (+ mod-tr-pass 1))
(begin
(set! mod-tr-fail (+ mod-tr-fail 1))
(append!
mod-tr-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-tr-find
(fn
(trace nm)
(reduce (fn (acc t) (if (= (get t :rule) nm) t acc)) nil trace)))
;; ── trace a spam report against the default rules ──
(define mod-tr-spam (mod/mk-report "r1" "alice" "bob" "this is spam"))
(define
mod-tr-t
(mod/trace-rules mod-tr-spam (list mod-tr-spam) mod/default-rules))
(mod-tr-test! "trace covers every rule" (len mod-tr-t) 6)
(mod-tr-test!
"spam-hide fires"
(get (mod-tr-find mod-tr-t "spam-hide") :proved)
true)
(mod-tr-test!
"default-keep always fires"
(get (mod-tr-find mod-tr-t "default-keep") :proved)
true)
(mod-tr-test!
"reviewer-remove does not fire (no evidence)"
(get (mod-tr-find mod-tr-t "reviewer-remove") :proved)
false)
(mod-tr-test!
"exonerated-keep does not fire"
(get (mod-tr-find mod-tr-t "exonerated-keep") :proved)
false)
(mod-tr-test!
"abuse-remove does not fire"
(get (mod-tr-find mod-tr-t "abuse-remove") :proved)
false)
;; ── winner matches the engine ──
(mod-tr-test!
"first-proved is spam-hide"
(get (mod/first-proved mod-tr-t) :rule)
"spam-hide")
(mod-tr-test!
"winner action matches decide-report"
(get (mod/first-proved mod-tr-t) :action)
(get
(mod/decide-report mod-tr-spam (list mod-tr-spam) mod/default-rules)
:action))
;; ── an unproved rule shows which goal failed ──
(define
mod-tr-rev-goals
(get (mod-tr-find mod-tr-t "reviewer-remove") :goals))
(mod-tr-test!
"reviewer-remove goal is unsolved"
(get (first mod-tr-rev-goals) :solved)
false)
(define mod-tr-spam-goals (get (mod-tr-find mod-tr-t "spam-hide") :goals))
(mod-tr-test!
"spam-hide goal is solved"
(get (first mod-tr-spam-goals) :solved)
true)
;; ── proved-rules list + rendering ──
(mod-tr-test!
"proved-rules lists fired rules in order"
(mod/proved-rules mod-tr-t)
(list "spam-hide" "default-keep"))
(mod-tr-test!
"trace-report marks a firing rule"
(mod/str-contains? (mod/trace-report mod-tr-t) "[fires] spam-hide")
true)
(mod-tr-test!
"trace-report marks a non-firing rule"
(mod/str-contains? (mod/trace-report mod-tr-t) "[ - ] reviewer-remove")
true)
;; ── clean report: only default-keep fires ──
(define mod-tr-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(define
mod-tr-tc
(mod/trace-rules mod-tr-clean (list mod-tr-clean) mod/default-rules))
(mod-tr-test!
"clean report: only default-keep proves"
(mod/proved-rules mod-tr-tc)
(list "default-keep"))
(mod-tr-test!
"clean report winner is default-keep"
(get (mod/first-proved mod-tr-tc) :rule)
"default-keep")
(define mod-trace-tests-run! (fn () {:failures mod-tr-failures :total mod-tr-count :passed mod-tr-pass :failed mod-tr-fail}))

117
lib/mod/tests/whatif.sx Normal file
View File

@@ -0,0 +1,117 @@
;; lib/mod/tests/whatif.sx — Ext 10: policy what-if / impact analysis.
(define mod-wi-count 0)
(define mod-wi-pass 0)
(define mod-wi-fail 0)
(define mod-wi-failures (list))
(define
mod-wi-test!
(fn
(name got expected)
(begin
(set! mod-wi-count (+ mod-wi-count 1))
(if
(= got expected)
(set! mod-wi-pass (+ mod-wi-pass 1))
(begin
(set! mod-wi-fail (+ mod-wi-fail 1))
(append!
mod-wi-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; rules-b is the default policy with spam-hide removed: spam now falls through
;; to default-keep. A spam report flips hide → keep; everything else is unchanged.
(define mod-wi-rules-a mod/default-rules)
(define
mod-wi-rules-b
(list
(mod/mk-rule
"reviewer-remove"
:remove (list (list :evidence "confirmed-abuse")))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))
(mod/mk-rule
"repeated-escalate"
:escalate (list (list :count-at-least 3)))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-wi-spam (mod/mk-report "r1" "a" "bob" "this is spam"))
(define mod-wi-abuse (mod/mk-report "r2" "a" "carol" "harassment here"))
(define mod-wi-clean (mod/mk-report "r3" "a" "dave" "a fine post"))
;; ── single-report diff ──
(define
mod-wi-d
(mod/decision-diff
mod-wi-spam
(list mod-wi-spam)
mod-wi-rules-a
mod-wi-rules-b))
(mod-wi-test! "spam before = hide" (get mod-wi-d :before) "hide")
(mod-wi-test! "spam after = keep" (get mod-wi-d :after) "keep")
(mod-wi-test! "spam decision flips" (get mod-wi-d :changed) true)
(mod-wi-test! "diff carries report id" (get mod-wi-d :report-id) "r1")
(define
mod-wi-da
(mod/decision-diff
mod-wi-abuse
(list mod-wi-abuse)
mod-wi-rules-a
mod-wi-rules-b))
(mod-wi-test! "abuse unchanged (remove both)" (get mod-wi-da :changed) false)
(mod-wi-test! "abuse stays remove" (get mod-wi-da :after) "remove")
(define
mod-wi-dc
(mod/decision-diff
mod-wi-clean
(list mod-wi-clean)
mod-wi-rules-a
mod-wi-rules-b))
(mod-wi-test! "clean unchanged (keep both)" (get mod-wi-dc :changed) false)
;; ── batch impact ──
(define mod-wi-batch (list mod-wi-spam mod-wi-abuse mod-wi-clean))
(define
mod-wi-impact
(mod/policy-impact mod-wi-batch mod-wi-rules-a mod-wi-rules-b))
(mod-wi-test!
"impact lists only changed reports"
(len mod-wi-impact)
1)
(mod-wi-test!
"impacted report is the spam one"
(get (first mod-wi-impact) :report-id)
"r1")
(mod-wi-test!
"impact-count agrees"
(mod/impact-count mod-wi-batch mod-wi-rules-a mod-wi-rules-b)
1)
;; ── identical rule sets → no impact ──
(mod-wi-test!
"same rules → zero impact"
(mod/impact-count mod-wi-batch mod-wi-rules-a mod-wi-rules-a)
0)
(mod-wi-test!
"same rules → empty report"
(mod/impact-report mod-wi-batch mod-wi-rules-a mod-wi-rules-a)
"No decisions change.")
;; ── rendering ──
(mod-wi-test!
"impact-report renders the flip"
(mod/str-contains?
(mod/impact-report mod-wi-batch mod-wi-rules-a mod-wi-rules-b)
"r1: hide → keep")
true)
(define mod-whatif-tests-run! (fn () {:failures mod-wi-failures :total mod-wi-count :passed mod-wi-pass :failed mod-wi-fail}))

96
lib/mod/tests/wire.sx Normal file
View File

@@ -0,0 +1,96 @@
;; lib/mod/tests/wire.sx — Ext 14: decision wire format + federated transport.
(define mod-w-count 0)
(define mod-w-pass 0)
(define mod-w-fail 0)
(define mod-w-failures (list))
(define
mod-w-test!
(fn
(name got expected)
(begin
(set! mod-w-count (+ mod-w-count 1))
(if
(= got expected)
(set! mod-w-pass (+ mod-w-pass 1))
(begin
(set! mod-w-fail (+ mod-w-fail 1))
(append!
mod-w-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── split-char ──
(mod-w-test! "split on pipe" (mod/split-char "a|b|c" "|") (list "a" "b" "c"))
(mod-w-test! "split single field" (mod/split-char "abc" "|") (list "abc"))
(mod-w-test!
"split four fields"
(len (mod/split-char "MOD1|r1|hide|spam-hide" "|"))
4)
;; ── serialize ──
(define
mod-w-dec
(mod/decide-report
(mod/mk-report "r1" "a" "bob" "this is spam")
(list (mod/mk-report "r1" "a" "bob" "this is spam"))
mod/default-rules))
(define mod-w-line (mod/decision->wire mod-w-dec))
(mod-w-test!
"wire is versioned + delimited"
mod-w-line
"MOD1|r1|hide|spam-hide")
(mod-w-test!
"wire-valid? accepts well-formed"
(mod/wire-valid? mod-w-line)
true)
(mod-w-test!
"wire-valid? rejects junk"
(mod/wire-valid? "not a wire line")
false)
(mod-w-test!
"wire-valid? rejects wrong version"
(mod/wire-valid? "MOD9|r1|hide|x")
false)
;; ── round-trip ──
(define mod-w-back (mod/wire->decision mod-w-line))
(mod-w-test! "round-trip report-id" (get mod-w-back :report-id) "r1")
(mod-w-test! "round-trip action" (get mod-w-back :action) "hide")
(mod-w-test! "round-trip rule" (get mod-w-back :rule) "spam-hide")
(mod-w-test! "round-trip tags :wire" (get mod-w-back :wire) true)
(mod-w-test! "malformed → nil" (mod/wire->decision "garbage") nil)
;; ── full federated transport: serialize → wire → deserialize → trust-gate ──
(mod/fed-reset!)
(define mod-w-peer-dec (mod/wire->decision mod-w-line))
;; untrusted peer: decision is advisory, not applied
(define mod-w-recv1 (mod/fed-receive-decision "peerX" mod-w-peer-dec))
(mod-w-test!
"wired decision from untrusted peer → advisory"
(get mod-w-recv1 :applied)
false)
(mod-w-test!
"untrusted wired decision not applied locally"
(mod/fed-applied-action "r1")
nil)
;; trusted peer: decision binds locally
(mod/grant-trust "peerY" :mod)
(define mod-w-recv2 (mod/fed-receive-decision "peerY" mod-w-peer-dec))
(mod-w-test!
"wired decision from trusted peer → applied"
(get mod-w-recv2 :applied)
true)
(mod-w-test!
"trusted wired decision binds locally"
(get (mod/fed-applied-action "r1") :action)
"hide")
(define mod-wire-tests-run! (fn () {:failures mod-w-failures :total mod-w-count :passed mod-w-pass :failed mod-w-fail}))

56
lib/mod/trace.sx Normal file
View File

@@ -0,0 +1,56 @@
;; lib/mod/trace.sx — policy dry-run diagnostics.
;;
;; decide-report returns the winning rule; a policy author debugging "why didn't
;; my rule fire?" needs the whole picture. mod/trace-rules evaluates a report
;; against every rule and reports each rule's proved/unproved status plus its
;; goal-by-goal derivation — so an unproved rule shows exactly which goal failed.
;; The winner is the first proved rule (same precedence as the engine).
(define
mod/trace-rules
(fn
(r reports rules)
(let
((count (mod/report-count (mod/report-about r) reports))
(id (mod/report-id r)))
(let
((db (pl-load (mod/build-program r count rules))))
(let
((proved-names (map (fn (s) (dict-get s "Rule")) (pl-query-all db (str "policy_action(" id ", _, Rule)")))))
(map
(fn (rule) (let ((nm (mod/rule-name rule))) {:proved (mod/member? nm proved-names) :goals (mod/proof-goals db id (mod/rule-when rule)) :action (mod/rule-action rule) :rule nm}))
rules))))))
(define
mod/first-proved
(fn
(trace)
(reduce
(fn (acc t) (if (nil? acc) (if (get t :proved) t acc) acc))
nil
trace)))
(define
mod/proved-rules
(fn
(trace)
(reduce
(fn
(acc t)
(if (get t :proved) (append acc (list (get t :rule))) acc))
(list)
trace)))
(define
mod/trace-row
(fn
(t)
(str
(if (get t :proved) "[fires] " "[ - ] ")
(get t :rule)
" → "
(get t :action))))
(define
mod/trace-report
(fn (trace) (mod/join-with "\n" (map mod/trace-row trace))))

56
lib/mod/whatif.sx Normal file
View File

@@ -0,0 +1,56 @@
;; lib/mod/whatif.sx — policy what-if / impact analysis.
;;
;; Before shipping a policy change, a moderation team needs to know which past or
;; pending reports would decide differently. mod/decision-diff compares one
;; report's action under two rule sets; mod/policy-impact runs a whole batch and
;; returns only the reports whose decision flips. Pure SX over decide-report.
(define
mod/decision-diff
(fn
(r reports rules-a rules-b)
(let
((a (get (mod/decide-report r reports rules-a) :action))
(b (get (mod/decide-report r reports rules-b) :action)))
{:after b :changed (if (= a b) false true) :report-id (mod/report-id r) :before a})))
(define
mod/policy-impact
(fn
(reports rules-a rules-b)
(reduce
(fn
(acc r)
(let
((d (mod/decision-diff r reports rules-a rules-b)))
(if (get d :changed) (append acc (list d)) acc)))
(list)
reports)))
(define
mod/impact-count
(fn
(reports rules-a rules-b)
(len (mod/policy-impact reports rules-a rules-b))))
(define
mod/impact-report
(fn
(reports rules-a rules-b)
(let
((changed (mod/policy-impact reports rules-a rules-b)))
(if
(empty? changed)
"No decisions change."
(mod/join-with
"\n"
(map
(fn
(d)
(str
(get d :report-id)
": "
(get d :before)
" → "
(get d :after)))
changed))))))

55
lib/mod/wire.sx Normal file
View File

@@ -0,0 +1,55 @@
;; lib/mod/wire.sx — portable decision wire format for federation transport.
;;
;; fed.sx shares decisions as in-memory dicts and leaves mod/fed-send! as the
;; transport seam. This is the bytes that cross it: a versioned, pipe-delimited
;; line encoding the verdict a peer needs (report id, action, rule) — enough to
;; trust-gate and apply/advise, without shipping the whole proof tree. The
;; loaded env has no string split, so split is built over slice/len.
(define
mod/split-loop
(fn
(s ch n start pos acc)
(if
(= pos n)
(append acc (list (slice s start n)))
(if
(= (slice s pos (+ pos 1)) ch)
(mod/split-loop
s
ch
n
(+ pos 1)
(+ pos 1)
(append acc (list (slice s start pos))))
(mod/split-loop s ch n start (+ pos 1) acc)))))
(define
mod/split-char
(fn (s ch) (mod/split-loop s ch (len s) 0 0 (list))))
(define
mod/decision->wire
(fn
(d)
(str "MOD1|" (get d :report-id) "|" (get d :action) "|" (get d :rule))))
(define
mod/wire-valid?
(fn
(w)
(let
((parts (mod/split-char w "|")))
(if
(= (len parts) 4)
(= (nth parts 0) "MOD1")
false))))
(define
mod/wire->decision
(fn
(w)
(if
(mod/wire-valid? w)
(let ((parts (mod/split-char w "|"))) {:action (nth parts 2) :wire true :rule (nth parts 3) :report-id (nth parts 1)})
nil)))

1
next/.gitignore vendored
View File

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

View File

@@ -1,170 +0,0 @@
# 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 (state + gen_server) |
| `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.

View File

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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