ocaml: phase 1+2 records {x=1;y=2} + with-update (+6 tests, 289 total)

Parser: { f = e; f = e; ... } -> (:record (F E)...). { base with f = e; ... } -> (:record-update BASE (F E)...). Eval builds a dict from field bindings; record-update merges the new fields over the base dict — the same dict representation already used for modules. { also added to at-app-start? so records are valid arg atoms. Field access via the existing :field postfix unifies record/module access. Record patterns deferred to a later iteration.
ocaml: phase 5.1 conformance.sh + scoreboard (283 tests across 14 suites)
2026-05-08 09:26:24 +00:00 · 2026-05-08 09:23:06 +00:00 · 2026-05-08 09:21:06 +00:00 · 2026-05-08 09:10:06 +00:00 · 2026-05-08 09:02:25 +00:00 · 2026-05-08 08:53:53 +00:00
39 changed files with 4390 additions and 6194 deletions
--- a/lib/datalog/aggregates.sx
+++ b/lib/datalog/aggregates.sx
@@ -1,141 +0,0 @@
 ;; lib/datalog/aggregates.sx — count / sum / min / max / findall.
 ;;
 ;; Surface form (always 3-arg after the relation name):
 ;;
 ;;   (count   Result  Var  GoalLit)
 ;;   (sum     Result  Var  GoalLit)
 ;;   (min     Result  Var  GoalLit)
 ;;   (max     Result  Var  GoalLit)
 ;;   (findall List    Var  GoalLit)
 ;;
 ;; Parsed naturally because arg-position compounds are already allowed
 ;; (Phase 4 needs them for arithmetic). At evaluation time the aggregator
 ;; runs `dl-find-bindings` on `GoalLit` under the current subst, collects
 ;; the distinct values of `Var`, and binds `Result`.
 ;;
 ;; Aggregation is non-monotonic — `count(C, X, p(X))` shrinks as p loses
 ;; tuples. The stratifier (lib/datalog/strata.sx) treats every aggregate's
 ;; goal relation as a negation-like edge so the inner relation is fully
 ;; derived before the aggregate fires.
 ;;
 ;; Empty input: count → 0, sum → 0, min/max → no binding (rule fails).
 (define dl-aggregate-rels (list "count" "sum" "min" "max" "findall"))
 (define
  dl-aggregate?
  (fn
    (lit)
    (and
      (list? lit)
      (>= (len lit) 4)
      (let ((rel (dl-rel-name lit)))
        (cond
          ((nil? rel) false)
          (else (dl-member-string? rel dl-aggregate-rels)))))))
 ;; Apply aggregation operator to a list of (already-distinct) numeric or
 ;; symbolic values. Returns the aggregated value, or :empty if min/max
 ;; has no input.
 (define
  dl-do-aggregate
  (fn
    (op vals)
    (cond
      ((= op "count") (len vals))
      ((= op "sum") (dl-sum-vals vals 0))
      ((= op "findall") vals)
      ((= op "min")
        (cond
          ((= (len vals) 0) :empty)
          (else (dl-min-vals vals 1 (first vals)))))
      ((= op "max")
        (cond
          ((= (len vals) 0) :empty)
          (else (dl-max-vals vals 1 (first vals)))))
      (else (error (str "datalog: unknown aggregate " op))))))
 (define
  dl-sum-vals
  (fn
    (vals acc)
    (cond
      ((= (len vals) 0) acc)
      (else (dl-sum-vals (rest vals) (+ acc (first vals)))))))
 (define
  dl-min-vals
  (fn
    (vals i cur)
    (cond
      ((>= i (len vals)) cur)
      (else
        (let ((v (nth vals i)))
          (dl-min-vals vals (+ i 1) (if (< v cur) v cur)))))))
 (define
  dl-max-vals
  (fn
    (vals i cur)
    (cond
      ((>= i (len vals)) cur)
      (else
        (let ((v (nth vals i)))
          (dl-max-vals vals (+ i 1) (if (> v cur) v cur)))))))
 ;; Membership check by deep equality (so 30 == 30.0 etc).
 (define
  dl-val-member?
  (fn
    (v xs)
    (cond
      ((= (len xs) 0) false)
      ((dl-tuple-equal? v (first xs)) true)
      (else (dl-val-member? v (rest xs))))))
 ;; Evaluate an aggregate body lit under `subst`. Returns the list of
 ;; extended substitutions (0 or 1 element).
 (define
  dl-eval-aggregate
  (fn
    (lit db subst)
    (let
      ((op (dl-rel-name lit))
        (result-var (nth lit 1))
        (agg-var (nth lit 2))
        (goal (nth lit 3)))
      (let
        ((substs (dl-find-bindings (list goal) db subst))
          (vals (list)))
        (do
          (for-each
            (fn
              (s)
              (let ((v (dl-apply-subst agg-var s)))
                (when
                  (not (dl-val-member? v vals))
                  (append! vals v))))
            substs)
          (let ((agg-val (dl-do-aggregate op vals)))
            (cond
              ((= agg-val :empty) (list))
              (else
                (let ((s2 (dl-unify result-var agg-val subst)))
                  (if (nil? s2) (list) (list s2)))))))))))
 ;; Stratification edges from aggregates: like negation, the goal's
 ;; relation must be in a strictly lower stratum so that the aggregate
 ;; fires only after the underlying tuples are settled.
 (define
  dl-aggregate-dep-edge
  (fn
    (lit)
    (cond
      ((dl-aggregate? lit)
        (let ((goal (nth lit 3)))
          (cond
            ((and (list? goal) (> (len goal) 0))
              (let ((rel (dl-rel-name goal)))
                (if (nil? rel) nil {:rel rel :neg true})))
            (else nil))))
      (else nil))))
--- a/lib/datalog/api.sx
+++ b/lib/datalog/api.sx
@@ -1,186 +0,0 @@
 ;; lib/datalog/api.sx — SX-data embedding API.
 ;;
 ;; Where Phase 1's `dl-program` takes a Datalog source string,
 ;; this module exposes a parser-free API that consumes SX data
 ;; directly. Two rule shapes are accepted:
 ;;
 ;;   - dict:   {:head <literal> :body (<literal> ...)}
 ;;   - list:   (<head-elements...> <- <body-literal> ...)
 ;;             — `<-` is an SX symbol used as the rule arrow.
 ;;
 ;; Examples:
 ;;
 ;;   (dl-program-data
 ;;     '((parent tom bob) (parent tom liz) (parent bob ann))
 ;;     '((ancestor X Y <- (parent X Y))
 ;;       (ancestor X Z <- (parent X Y) (ancestor Y Z))))
 ;;
 ;;   (dl-query db '(ancestor tom X))   ; same query API as before
 ;;
 ;; Variables follow the parser convention: SX symbols whose first
 ;; character is uppercase or `_` are variables.
 (define
  dl-rule
  (fn (head body) {:head head :body body}))
 (define
  dl-rule-arrow?
  (fn
    (x)
    (and (symbol? x) (= (symbol->string x) "<-"))))
 (define
  dl-find-arrow
  (fn
    (rl i n)
    (cond
      ((>= i n) nil)
      ((dl-rule-arrow? (nth rl i)) i)
      (else (dl-find-arrow rl (+ i 1) n)))))
 ;; Given a list of the form (head-elt ... <- body-lit ...) returns
 ;; {:head (head-elt ...) :body (body-lit ...)}. If no arrow is
 ;; present, the whole list is treated as the head and the body is
 ;; empty (i.e. a fact written rule-style).
 (define
  dl-rule-from-list
  (fn
    (rl)
    (let ((n (len rl)))
      (let ((idx (dl-find-arrow rl 0 n)))
        (cond
          ((nil? idx) {:head rl :body (list)})
          (else
            (let
              ((head (slice rl 0 idx))
                (body (slice rl (+ idx 1) n)))
              {:head head :body body})))))))
 ;; Coerce a rule given as either a dict or a list-with-arrow to a dict.
 (define
  dl-coerce-rule
  (fn
    (r)
    (cond
      ((dict? r) r)
      ((list? r) (dl-rule-from-list r))
      (else (error (str "dl-coerce-rule: expected dict or list, got " r))))))
 ;; Build a db from SX data lists.
 (define
  dl-program-data
  (fn
    (facts rules)
    (let ((db (dl-make-db)))
      (do
        (for-each (fn (lit) (dl-add-fact! db lit)) facts)
        (for-each
          (fn (r) (dl-add-rule! db (dl-coerce-rule r)))
          rules)
        db))))
 ;; Add a single fact at runtime, then re-saturate the db so derived
 ;; tuples reflect the change. Returns the db.
 (define
  dl-assert!
  (fn
    (db lit)
    (do
      (dl-add-fact! db lit)
      (dl-saturate! db)
      db)))
 ;; Remove a fact: drop matching tuples from EDB AND wipe all derived
 ;; tuples (any IDB tuple may have transitively depended on the removed
 ;; fact). Then re-saturate to repopulate IDB. EDB facts that were
 ;; asserted via dl-add-fact! are preserved unless they match `lit`.
 ;;
 ;; To distinguish EDB from IDB, we treat any fact for a relation that
 ;; has rules as IDB; otherwise EDB. (Phase 9 simplification — Phase 10
 ;; may track provenance.)
 (define
  dl-retract!
  (fn
    (db lit)
    (let
      ((rel-key (dl-rel-name lit)))
      (do
        ;; Drop the matching tuple from its relation list (if EDB-only).
        (when
          (has-key? (get db :facts) rel-key)
          (let
            ((existing (get (get db :facts) rel-key))
              (kept (list))
              (kept-keys {})
              (kept-index {}))
            (do
              (for-each
                (fn
                  (t)
                  (when
                    (not (dl-tuple-equal? t lit))
                    (do
                      (append! kept t)
                      (dict-set! kept-keys (dl-tuple-key t) true)
                      (when
                        (>= (len t) 2)
                        (let ((k (dl-arg-key (nth t 1))))
                          (do
                            (when
                              (not (has-key? kept-index k))
                              (dict-set! kept-index k (list)))
                            (append! (get kept-index k) t)))))))
                existing)
              (dict-set! (get db :facts) rel-key kept)
              (dict-set! (get db :facts-keys) rel-key kept-keys)
              (dict-set! (get db :facts-index) rel-key kept-index))))
        ;; Wipe all relations that have a rule (these are IDB) so the
        ;; saturator regenerates them from the surviving EDB.
        (let ((rule-heads (dl-rule-head-rels db)))
          (for-each
            (fn
              (k)
              (do
                (dict-set! (get db :facts) k (list))
                (dict-set! (get db :facts-keys) k {})
                (dict-set! (get db :facts-index) k {})))
            rule-heads))
        (dl-saturate! db)
        db))))
 ;; ── Convenience: single-call source + query ───────────────────
 ;; (dl-eval source query-source) parses both, builds a db, saturates,
 ;; runs the query, returns the substitution list. The query source
 ;; should be `?- goal[, goal ...].` — the parser produces a clause
 ;; with :query containing a list of literals which is fed straight
 ;; to dl-query.
 (define
  dl-eval
  (fn
    (source query-source)
    (let
      ((db (dl-program source))
        (queries (dl-parse query-source)))
      (cond
        ((= (len queries) 0) (error "dl-eval: query string is empty"))
        ((not (has-key? (first queries) :query))
          (error "dl-eval: second arg must be a `?- ...` query clause"))
        (else
          (dl-query db (get (first queries) :query)))))))
 (define
  dl-rule-head-rels
  (fn
    (db)
    (let ((seen (list)))
      (do
        (for-each
          (fn
            (rule)
            (let ((h (dl-rel-name (get rule :head))))
              (when
                (and (not (nil? h)) (not (dl-member-string? h seen)))
                (append! seen h))))
          (dl-rules db))
        seen))))
--- a/lib/datalog/builtins.sx
+++ b/lib/datalog/builtins.sx
@@ -1,314 +0,0 @@
 ;; lib/datalog/builtins.sx — comparison + arithmetic body literals.
 ;;
 ;; Built-in predicates filter / extend candidate substitutions during
 ;; rule evaluation. They are not stored facts and do not participate in
 ;; the Herbrand base.
 ;;
 ;;   (< a b)  (<= a b)  (> a b)  (>= a b)   ; numeric (or string) compare
 ;;   (= a b)                                  ; unify (binds vars)
 ;;   (!= a b)                                ; ground-only inequality
 ;;   (is X expr)                              ; bind X to expr's value
 ;;
 ;; Arithmetic expressions are SX-list compounds:
 ;;   (+ a b)  (- a b)  (* a b)  (/ a b)
 ;; or numbers / variables (must be bound at evaluation time).
 (define
  dl-comparison?
  (fn
    (lit)
    (and
      (list? lit)
      (> (len lit) 0)
      (let
        ((rel (dl-rel-name lit)))
        (cond
          ((nil? rel) false)
          (else (dl-member-string? rel (list "<" "<=" ">" ">=" "!="))))))))
 (define
  dl-eq?
  (fn
    (lit)
    (and
      (list? lit)
      (> (len lit) 0)
      (let ((rel (dl-rel-name lit))) (and (not (nil? rel)) (= rel "=")))))) 
 (define
  dl-is?
  (fn
    (lit)
    (and
      (list? lit)
      (> (len lit) 0)
      (let
        ((rel (dl-rel-name lit)))
        (and (not (nil? rel)) (= rel "is")))))) 
 ;; Evaluate an arithmetic expression under subst. Returns the numeric
 ;; result, or raises if any operand is unbound or non-numeric.
 (define
  dl-eval-arith
  (fn
    (expr subst)
    (let
      ((w (dl-walk expr subst)))
      (cond
        ((number? w) w)
        ((dl-var? w)
          (error (str "datalog arith: unbound variable " (symbol->string w))))
        ((list? w)
          (let
            ((rel (dl-rel-name w)) (args (rest w)))
            (cond
              ((not (= (len args) 2))
                (error (str "datalog arith: need 2 args, got " w)))
              (else
                (let
                  ((a (dl-eval-arith (first args) subst))
                    (b (dl-eval-arith (nth args 1) subst)))
                  (cond
                    ((= rel "+") (+ a b))
                    ((= rel "-") (- a b))
                    ((= rel "*") (* a b))
                    ((= rel "/") (/ a b))
                    (else (error (str "datalog arith: unknown op " rel)))))))))
        (else (error (str "datalog arith: not a number — " w)))))))
 (define
  dl-eval-compare
  (fn
    (lit subst)
    (let
      ((rel (dl-rel-name lit))
        (a (dl-walk (nth lit 1) subst))
        (b (dl-walk (nth lit 2) subst)))
      (cond
        ((or (dl-var? a) (dl-var? b))
          (error
            (str
              "datalog: comparison "
              rel
              " has unbound argument; "
              "ensure prior body literal binds the variable")))
        (else
          (let
            ((ok (cond ((= rel "<") (< a b)) ((= rel "<=") (<= a b)) ((= rel ">") (> a b)) ((= rel ">=") (>= a b)) ((= rel "!=") (not (dl-tuple-equal? a b))) (else (error (str "datalog: unknown compare " rel))))))
            (if ok subst nil)))))))
 (define
  dl-eval-eq
  (fn
    (lit subst)
    (dl-unify (nth lit 1) (nth lit 2) subst)))
 (define
  dl-eval-is
  (fn
    (lit subst)
    (let
      ((target (nth lit 1)) (expr (nth lit 2)))
      (let
        ((value (dl-eval-arith expr subst)))
        (dl-unify target value subst)))))
 (define
  dl-eval-builtin
  (fn
    (lit subst)
    (cond
      ((dl-comparison? lit) (dl-eval-compare lit subst))
      ((dl-eq? lit) (dl-eval-eq lit subst))
      ((dl-is? lit) (dl-eval-is lit subst))
      (else (error (str "dl-eval-builtin: not a built-in: " lit))))))
 ;; ── Safety analysis ──────────────────────────────────────────────
 ;;
 ;; Walks body literals left-to-right tracking a "bound" set. The check
 ;; understands these literal kinds:
 ;;
 ;;   positive non-built-in    → adds its vars to bound
 ;;   (is X expr)              → vars(expr) ⊆ bound, then add X (if var)
 ;;   <,<=,>,>=,!=             → all vars ⊆ bound (no binding)
 ;;   (= a b) where:
 ;;       both non-vars        → constraint check, no binding
 ;;       a var, b not         → bind a
 ;;       b var, a not         → bind b
 ;;       both vars            → at least one in bound; bind the other
 ;;   {:neg lit}               → all vars ⊆ bound (Phase 7 enforces fully)
 ;;
 ;; At end, head vars (minus `_`) must be ⊆ bound.
 (define
  dl-vars-not-in
  (fn
    (vs bound)
    (let
      ((out (list)))
      (do
        (for-each
          (fn
            (v)
            (when (not (dl-member-string? v bound)) (append! out v)))
          vs)
        out))))
 (define
  dl-rule-check-safety
  (fn
    (rule)
    (let
      ((head (get rule :head))
        (body (get rule :body))
        (bound (list))
        (err nil))
      (do
        (define
          dl-add-bound!
          (fn
            (vs)
            (for-each
              (fn
                (v)
                (when (not (dl-member-string? v bound)) (append! bound v)))
              vs)))
        (define
          dl-process-eq!
          (fn
            (lit)
            (let
              ((a (nth lit 1)) (b (nth lit 2)))
              (let
                ((va (dl-var? a)) (vb (dl-var? b)))
                (cond
                  ((and (not va) (not vb)) nil)
                  ((and va (not vb))
                    (dl-add-bound! (list (symbol->string a))))
                  ((and (not va) vb)
                    (dl-add-bound! (list (symbol->string b))))
                  (else
                    (let
                      ((sa (symbol->string a)) (sb (symbol->string b)))
                      (cond
                        ((dl-member-string? sa bound)
                          (dl-add-bound! (list sb)))
                        ((dl-member-string? sb bound)
                          (dl-add-bound! (list sa)))
                        (else
                          (set!
                            err
                            (str
                              "= between two unbound variables "
                              (list sa sb)
                              " — at least one must be bound by an "
                              "earlier positive body literal")))))))))))
        (define
          dl-process-cmp!
          (fn
            (lit)
            (let
              ((needed (dl-vars-of (list (nth lit 1) (nth lit 2)))))
              (let
                ((missing (dl-vars-not-in needed bound)))
                (when
                  (> (len missing) 0)
                  (set!
                    err
                    (str
                      "comparison "
                      (dl-rel-name lit)
                      " requires bound variable(s) "
                      missing
                      " (must be bound by an earlier positive "
                      "body literal)")))))))
        (define
          dl-process-is!
          (fn
            (lit)
            (let
              ((tgt (nth lit 1)) (expr (nth lit 2)))
              (let
                ((needed (dl-vars-of expr)))
                (let
                  ((missing (dl-vars-not-in needed bound)))
                  (cond
                    ((> (len missing) 0)
                      (set!
                        err
                        (str
                          "is RHS uses unbound variable(s) "
                          missing
                          " — bind them via a prior positive body "
                          "literal")))
                    (else
                      (when
                        (dl-var? tgt)
                        (dl-add-bound! (list (symbol->string tgt)))))))))))
        (define
          dl-process-neg!
          (fn
            (lit)
            (let
              ((needed (dl-vars-of (get lit :neg))))
              (let
                ((missing (dl-vars-not-in needed bound)))
                (when
                  (> (len missing) 0)
                  (set!
                    err
                    (str
                      "negation refers to unbound variable(s) "
                      missing
                      " — they must be bound by an earlier "
                      "positive body literal")))))))
        (define
          dl-process-agg!
          (fn
            (lit)
            (let
              ((result-var (nth lit 1)))
              ;; Aggregate goal vars are existentially quantified within
              ;; the aggregate; nothing required from outer context. The
              ;; result var becomes bound after the aggregate fires.
              (when
                (dl-var? result-var)
                (dl-add-bound! (list (symbol->string result-var)))))))
        (define
          dl-process-lit!
          (fn
            (lit)
            (when
              (nil? err)
              (cond
                ((and (dict? lit) (has-key? lit :neg))
                  (dl-process-neg! lit))
                ((dl-aggregate? lit) (dl-process-agg! lit))
                ((dl-eq? lit) (dl-process-eq! lit))
                ((dl-is? lit) (dl-process-is! lit))
                ((dl-comparison? lit) (dl-process-cmp! lit))
                ((and (list? lit) (> (len lit) 0))
                  (dl-add-bound! (dl-vars-of lit)))))))
        (for-each dl-process-lit! body)
        (when
          (nil? err)
          (let
            ((head-vars (dl-vars-of head)) (missing (list)))
            (do
              (for-each
                (fn
                  (v)
                  (when
                    (and (not (dl-member-string? v bound)) (not (= v "_")))
                    (append! missing v)))
                head-vars)
              (when
                (> (len missing) 0)
                (set!
                  err
                  (str
                    "head variable(s) "
                    missing
                    " do not appear in any positive body literal"))))))
        err))))
--- a/lib/datalog/conformance.conf
+++ b/lib/datalog/conformance.conf
@@ -1,32 +0,0 @@
 # Datalog conformance config — sourced by lib/guest/conformance.sh.
 LANG_NAME=datalog
 MODE=dict
 PRELOADS=(
  lib/datalog/tokenizer.sx
  lib/datalog/parser.sx
  lib/datalog/unify.sx
  lib/datalog/db.sx
  lib/datalog/builtins.sx
  lib/datalog/aggregates.sx
  lib/datalog/strata.sx
  lib/datalog/eval.sx
  lib/datalog/api.sx
  lib/datalog/magic.sx
  lib/datalog/demo.sx
 )
 SUITES=(
  "tokenize:lib/datalog/tests/tokenize.sx:(dl-tokenize-tests-run!)"
  "parse:lib/datalog/tests/parse.sx:(dl-parse-tests-run!)"
  "unify:lib/datalog/tests/unify.sx:(dl-unify-tests-run!)"
  "eval:lib/datalog/tests/eval.sx:(dl-eval-tests-run!)"
  "builtins:lib/datalog/tests/builtins.sx:(dl-builtins-tests-run!)"
  "semi_naive:lib/datalog/tests/semi_naive.sx:(dl-semi-naive-tests-run!)"
  "negation:lib/datalog/tests/negation.sx:(dl-negation-tests-run!)"
  "aggregates:lib/datalog/tests/aggregates.sx:(dl-aggregates-tests-run!)"
  "api:lib/datalog/tests/api.sx:(dl-api-tests-run!)"
  "magic:lib/datalog/tests/magic.sx:(dl-magic-tests-run!)"
  "demo:lib/datalog/tests/demo.sx:(dl-demo-tests-run!)"
 )
--- a/lib/datalog/conformance.sh
+++ b/lib/datalog/conformance.sh
@@ -1,3 +0,0 @@
 #!/usr/bin/env bash
 # Thin wrapper — see lib/guest/conformance.sh and lib/datalog/conformance.conf.
 exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"
--- a/lib/datalog/datalog.sx
+++ b/lib/datalog/datalog.sx
@@ -1,79 +0,0 @@
 ;; lib/datalog/datalog.sx — public API documentation index.
 ;;
 ;; This file is reference-only — `load` is an epoch-protocol command,
 ;; not an SX function, so it cannot reload a list of files from inside
 ;; another `.sx` file. To set up a fresh sx_server session with all
 ;; modules in scope, issue these loads in order:
 ;;
 ;;   (load "lib/datalog/tokenizer.sx")
 ;;   (load "lib/datalog/parser.sx")
 ;;   (load "lib/datalog/unify.sx")
 ;;   (load "lib/datalog/db.sx")
 ;;   (load "lib/datalog/builtins.sx")
 ;;   (load "lib/datalog/aggregates.sx")
 ;;   (load "lib/datalog/strata.sx")
 ;;   (load "lib/datalog/eval.sx")
 ;;   (load "lib/datalog/api.sx")
 ;;   (load "lib/datalog/demo.sx")
 ;;
 ;; (lib/datalog/conformance.sh runs this load list automatically.)
 ;;
 ;; ── Public API surface ─────────────────────────────────────────────
 ;;
 ;;   Source / data:
 ;;     (dl-tokenize "src")              → token list
 ;;     (dl-parse "src")                 → parsed clauses
 ;;     (dl-program "src")               → db built from a source string
 ;;     (dl-program-data facts rules)    → db from SX data lists; rules
 ;;                                        accept either dict form or
 ;;                                        list form with `<-` arrow
 ;;
 ;;   Construction (mutates db):
 ;;     (dl-make-db)                     empty db
 ;;     (dl-add-fact! db lit)            rejects non-ground
 ;;     (dl-add-rule! db rule)           rejects unsafe rules
 ;;     (dl-rule head body)              dict-rule constructor
 ;;     (dl-add-clause! db clause)       parser output → fact or rule
 ;;     (dl-load-program! db src)        string source
 ;;
 ;;   Mutation:
 ;;     (dl-assert! db lit)              add + re-saturate
 ;;     (dl-retract! db lit)             drop EDB, wipe IDB, re-saturate
 ;;
 ;;   Query / inspection:
 ;;     (dl-saturate! db)                stratified semi-naive default
 ;;     (dl-saturate-naive! db)          reference (slow on chains)
 ;;     (dl-saturate-rules! db rules)    per-rule-set semi-naive worker
 ;;     (dl-query db goal)               list of substitution dicts
 ;;     (dl-relation db rel-name)        tuple list for a relation
 ;;     (dl-rules db)                    rule list
 ;;     (dl-fact-count db)               total ground tuples
 ;;
 ;; ── Body literal kinds ─────────────────────────────────────────────
 ;;
 ;;   Positive             (rel arg ... arg)
 ;;   Negation             {:neg (rel arg ...)}
 ;;   Comparison           (< X Y), (<= X Y), (> X Y), (>= X Y),
 ;;                        (= X Y), (!= X Y)
 ;;   Arithmetic           (is Z (+ X Y)) and (- * /)
 ;;   Aggregation          (count R V Goal),  (sum R V Goal),
 ;;                        (min R V Goal),    (max R V Goal),
 ;;                        (findall L V Goal)
 ;;
 ;; ── Variable conventions ───────────────────────────────────────────
 ;;
 ;;   Variables: SX symbols whose first char is uppercase A–Z or '_'.
 ;;   Anonymous '_' is renamed to a fresh _anon<N> per occurrence at
 ;;   rule/query load time so multiple '_' don't unify.
 ;;
 ;; ── Demo programs ──────────────────────────────────────────────────
 ;;
 ;;   See lib/datalog/demo.sx — federation, content, permissions, and
 ;;   the canonical "cooking posts by people I follow (transitively)"
 ;;   example.
 ;;
 ;; ── Status ─────────────────────────────────────────────────────────
 ;;
 ;;   See plans/datalog-on-sx.md — phase-by-phase progress log and
 ;;   roadmap. Run `bash lib/datalog/conformance.sh` to refresh
 ;;   `lib/datalog/scoreboard.{json,md}`.
--- a/lib/datalog/db.sx
+++ b/lib/datalog/db.sx
@@ -1,386 +0,0 @@
 ;; lib/datalog/db.sx — Datalog database (EDB + IDB + rules) + safety hook.
 ;;
 ;; A db is a mutable dict:
 ;;   {:facts {<rel-name-string> -> (literal ...)}
 ;;    :rules ({:head literal :body (literal ...)} ...)}
 ;;
 ;; Facts are stored as full literals `(rel arg ... arg)` so they unify
 ;; directly against rule body literals. Each relation's tuple list is
 ;; deduplicated on insert.
 ;;
 ;; Phase 3 introduced safety analysis for head variables; Phase 4 (in
 ;; lib/datalog/builtins.sx) swaps in the real `dl-rule-check-safety`,
 ;; which is order-aware and understands built-in predicates.
 (define
  dl-make-db
  (fn () {:facts {} :facts-keys {} :facts-index {} :rules (list) :strategy :semi-naive}))
 ;; Evaluation strategy. Default :semi-naive (the only strategy
 ;; currently implemented). :magic is reserved for goal-directed
 ;; magic-sets evaluation — calling it now logs a one-time "deferred"
 ;; note and falls back to semi-naive.
 (define
  dl-set-strategy!
  (fn
    (db strategy)
    (do
      (dict-set! db :strategy strategy)
      db)))
 (define
  dl-get-strategy
  (fn
    (db)
    (if (has-key? db :strategy) (get db :strategy) :semi-naive)))
 (define
  dl-rel-name
  (fn
    (lit)
    (cond
      ((and (dict? lit) (has-key? lit :neg)) (dl-rel-name (get lit :neg)))
      ((and (list? lit) (> (len lit) 0) (symbol? (first lit)))
        (symbol->string (first lit)))
      (else nil))))
 (define dl-builtin-rels (list "<" "<=" ">" ">=" "=" "!=" "is"))
 (define
  dl-member-string?
  (fn
    (s xs)
    (cond
      ((= (len xs) 0) false)
      ((= (first xs) s) true)
      (else (dl-member-string? s (rest xs))))))
 (define
  dl-builtin?
  (fn
    (lit)
    (and
      (list? lit)
      (> (len lit) 0)
      (let
        ((rel (dl-rel-name lit)))
        (cond
          ((nil? rel) false)
          (else (dl-member-string? rel dl-builtin-rels)))))))
 (define
  dl-positive-lit?
  (fn
    (lit)
    (cond
      ((and (dict? lit) (has-key? lit :neg)) false)
      ((dl-builtin? lit) false)
      ((and (list? lit) (> (len lit) 0)) true)
      (else false))))
 (define
  dl-tuple-equal?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-tuple-equal-list? a b 0)))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-tuple-equal-list?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-tuple-equal? (nth a i) (nth b i))) false)
      (else (dl-tuple-equal-list? a b (+ i 1))))))
 (define
  dl-tuple-member?
  (fn
    (lit lits)
    (dl-tuple-member-aux? lit lits 0 (len lits))))
 (define
  dl-tuple-member-aux?
  (fn
    (lit lits i n)
    (cond
      ((>= i n) false)
      ((dl-tuple-equal? lit (nth lits i)) true)
      (else (dl-tuple-member-aux? lit lits (+ i 1) n)))))
 (define
  dl-ensure-rel!
  (fn
    (db rel-key)
    (let
      ((facts (get db :facts))
        (fk (get db :facts-keys))
        (fi (get db :facts-index)))
      (do
        (when
          (not (has-key? facts rel-key))
          (dict-set! facts rel-key (list)))
        (when
          (not (has-key? fk rel-key))
          (dict-set! fk rel-key {}))
        (when
          (not (has-key? fi rel-key))
          (dict-set! fi rel-key {}))
        (get facts rel-key)))))
 ;; First-arg index helpers. Tuples are keyed by their first-after-rel
 ;; arg's `(str ...)`; when that arg is a constant, dl-match-positive
 ;; uses the index instead of scanning the full relation.
 (define
  dl-arg-key
  (fn
    (v)
    (str v)))
 (define
  dl-index-add!
  (fn
    (db rel-key lit)
    (let
      ((idx (get db :facts-index))
        (n (len lit)))
      (when
        (and (>= n 2) (has-key? idx rel-key))
        (let
          ((rel-idx (get idx rel-key))
            (k (dl-arg-key (nth lit 1))))
          (do
            (when
              (not (has-key? rel-idx k))
              (dict-set! rel-idx k (list)))
            (append! (get rel-idx k) lit)))))))
 (define
  dl-index-lookup
  (fn
    (db rel-key arg-val)
    (let
      ((idx (get db :facts-index)))
      (cond
        ((not (has-key? idx rel-key)) (list))
        (else
          (let ((rel-idx (get idx rel-key))
                (k (dl-arg-key arg-val)))
            (if (has-key? rel-idx k) (get rel-idx k) (list))))))))
 (define dl-tuple-key (fn (lit) (str lit)))
 (define
  dl-rel-tuples
  (fn
    (db rel-key)
    (let
      ((facts (get db :facts)))
      (if (has-key? facts rel-key) (get facts rel-key) (list)))))
 (define
  dl-add-fact!
  (fn
    (db lit)
    (cond
      ((not (and (list? lit) (> (len lit) 0)))
        (error (str "dl-add-fact!: expected literal list, got " lit)))
      ((not (dl-ground? lit (dl-empty-subst)))
        (error (str "dl-add-fact!: expected ground literal, got " lit)))
      (else
        (let
          ((rel-key (dl-rel-name lit)))
          (let
            ((tuples (dl-ensure-rel! db rel-key))
              (key-dict (get (get db :facts-keys) rel-key))
              (tk (dl-tuple-key lit)))
            (cond
              ((has-key? key-dict tk) false)
              (else
                (do
                  (dict-set! key-dict tk true)
                  (append! tuples lit)
                  (dl-index-add! db rel-key lit)
                  true)))))))))
 ;; The full safety check lives in builtins.sx (it has to know which
 ;; predicates are built-ins). dl-add-rule! calls it via forward
 ;; reference; load builtins.sx alongside db.sx in any setup that
 ;; adds rules. The fallback below is used if builtins.sx isn't loaded.
 (define
  dl-rule-check-safety
  (fn
    (rule)
    (let
      ((head-vars (dl-vars-of (get rule :head))) (body-vars (list)))
      (do
        (for-each
          (fn
            (lit)
            (when
              (and
                (list? lit)
                (> (len lit) 0)
                (not (and (dict? lit) (has-key? lit :neg))))
              (for-each
                (fn
                  (v)
                  (when
                    (not (dl-member-string? v body-vars))
                    (append! body-vars v)))
                (dl-vars-of lit))))
          (get rule :body))
        (let
          ((missing (list)))
          (do
            (for-each
              (fn
                (v)
                (when
                  (and
                    (not (dl-member-string? v body-vars))
                    (not (= v "_")))
                  (append! missing v)))
              head-vars)
            (cond
              ((> (len missing) 0)
                (str
                  "head variable(s) "
                  missing
                  " do not appear in any body literal"))
              (else nil))))))))
 (define
  dl-rename-anon-term
  (fn
    (term next-name)
    (cond
      ((and (symbol? term) (= (symbol->string term) "_"))
        (next-name))
      ((list? term)
        (map (fn (x) (dl-rename-anon-term x next-name)) term))
      (else term))))
 (define
  dl-rename-anon-lit
  (fn
    (lit next-name)
    (cond
      ((and (dict? lit) (has-key? lit :neg))
        {:neg (dl-rename-anon-term (get lit :neg) next-name)})
      ((list? lit) (dl-rename-anon-term lit next-name))
      (else lit))))
 (define
  dl-make-anon-renamer
  (fn
    ()
    (let ((counter 0))
      (fn () (do (set! counter (+ counter 1))
                 (string->symbol (str "_anon" counter)))))))
 (define
  dl-rename-anon-rule
  (fn
    (rule)
    (let ((next-name (dl-make-anon-renamer)))
      {:head (dl-rename-anon-term (get rule :head) next-name)
       :body (map (fn (lit) (dl-rename-anon-lit lit next-name))
                  (get rule :body))})))
 (define
  dl-add-rule!
  (fn
    (db rule)
    (cond
      ((not (dict? rule))
        (error (str "dl-add-rule!: expected rule dict, got " rule)))
      ((not (has-key? rule :head))
        (error (str "dl-add-rule!: rule missing :head, got " rule)))
      (else
        (let ((rule (dl-rename-anon-rule rule)))
          (let
            ((err (dl-rule-check-safety rule)))
            (cond
              ((not (nil? err)) (error (str "dl-add-rule!: " err)))
              (else
                (let
                  ((rules (get db :rules)))
                  (do (append! rules rule) true))))))))))
 (define
  dl-add-clause!
  (fn
    (db clause)
    (cond
      ((has-key? clause :query) false)
      ((and (has-key? clause :body) (= (len (get clause :body)) 0))
        (dl-add-fact! db (get clause :head)))
      (else (dl-add-rule! db clause)))))
 (define
  dl-load-program!
  (fn
    (db source)
    (let
      ((clauses (dl-parse source)))
      (do (for-each (fn (c) (dl-add-clause! db c)) clauses) db))))
 (define
  dl-program
  (fn (source) (let ((db (dl-make-db))) (dl-load-program! db source))))
 (define dl-rules (fn (db) (get db :rules)))
 (define
  dl-fact-count
  (fn
    (db)
    (let
      ((facts (get db :facts)) (total 0))
      (do
        (for-each
          (fn (k) (set! total (+ total (len (get facts k)))))
          (keys facts))
        total))))
 ;; Returns {<rel-name>: tuple-count} for debugging. Includes
 ;; relations with any tuples plus all rule-head relations (so empty
 ;; IDB shows as 0). Skips empty EDB-only entries that are placeholders
 ;; from internal `dl-ensure-rel!` calls.
 (define
  dl-summary
  (fn
    (db)
    (let
      ((facts (get db :facts))
        (out {})
        (rule-heads (list)))
      (do
        (for-each
          (fn
            (rule)
            (let ((h (dl-rel-name (get rule :head))))
              (when
                (and (not (nil? h)) (not (dl-member-string? h rule-heads)))
                (append! rule-heads h))))
          (dl-rules db))
        (for-each
          (fn
            (k)
            (let ((c (len (get facts k))))
              (when
                (or (> c 0) (dl-member-string? k rule-heads))
                (dict-set! out k c))))
          (keys facts))
        ;; Add rule heads that have no facts (yet).
        (for-each
          (fn
            (k)
            (when (not (has-key? out k)) (dict-set! out k 0)))
          rule-heads)
        out))))
--- a/lib/datalog/demo.sx
+++ b/lib/datalog/demo.sx
@@ -1,143 +0,0 @@
 ;; lib/datalog/demo.sx — example programs over rose-ash-shaped data.
 ;;
 ;; Phase 10 prototypes Datalog as a rose-ash query language. Wiring
 ;; the EDB to actual PostgreSQL is out of scope for this loop (it
 ;; would touch service code outside lib/datalog/), but the programs
 ;; below show the shape of queries we want, and the test suite runs
 ;; them against synthetic in-memory tuples loaded via dl-program-data.
 ;;
 ;; Six thematic demos:
 ;;
 ;;   1. Federation — follow graph, transitive reach, mutuals, FOAF.
 ;;   2. Content    — posts, tags, likes, popularity, "for you" feed.
 ;;   3. Permissions — group membership and resource access.
 ;;   4. Cooking-posts — canonical "posts about cooking by people I
 ;;                      follow (transitively)" multi-domain query.
 ;;   5. Tag co-occurrence — distinct (T1, T2) pairs with counts.
 ;;   6. Shortest path  — weighted-DAG path enumeration + min agg.
 ;; ── Demo 1: federation follow graph ─────────────────────────────
 ;; EDB: (follows ACTOR-A ACTOR-B) — A follows B.
 ;; IDB:
 ;;   (mutual A B)            — A follows B and B follows A
 ;;   (reachable A B)         — transitive follow closure
 ;;   (foaf A C)              — friend of a friend (mutual filter)
 (define
  dl-demo-federation-rules
  (quote
    ((mutual A B <- (follows A B) (follows B A))
     (reachable A B <- (follows A B))
     (reachable A C <- (follows A B) (reachable B C))
     (foaf A C <- (follows A B) (follows B C) (!= A C)))))
 ;; ── Demo 2: content recommendation ──────────────────────────────
 ;; EDB:
 ;;   (authored ACTOR POST)
 ;;   (tagged POST TAG)
 ;;   (liked ACTOR POST)
 ;; IDB:
 ;;   (post-likes POST N)            — count of likes per post
 ;;   (popular POST)                 — posts with >= 3 likes
 ;;   (tagged-by-mutual ACTOR POST)  — post tagged TOPIC by someone
 ;;                                    A's mutuals follow.
 (define
  dl-demo-content-rules
  (quote
    ((post-likes P N <- (authored Author P) (count N L (liked L P)))
     (popular P <- (authored Author P) (post-likes P N) (>= N 3))
     (interesting Me P
       <-
       (follows Me Buddy)
       (authored Buddy P)
       (popular P)))))
 ;; ── Demo 3: role-based permissions ──────────────────────────────
 ;; EDB:
 ;;   (member ACTOR GROUP)
 ;;   (subgroup CHILD PARENT)
 ;;   (allowed GROUP RESOURCE)
 ;; IDB:
 ;;   (in-group ACTOR GROUP)         — direct or via subgroup chain
 ;;   (can-access ACTOR RESOURCE)    — actor inherits group permission
 (define
  dl-demo-perm-rules
  (quote
    ((in-group A G <- (member A G))
     (in-group A G <- (member A H) (subgroup-trans H G))
     (subgroup-trans X Y <- (subgroup X Y))
     (subgroup-trans X Z <- (subgroup X Y) (subgroup-trans Y Z))
     (can-access A R <- (in-group A G) (allowed G R)))))
 ;; ── Demo 4: cooking-posts (the canonical Phase 10 query) ────────
 ;; "Posts about cooking by people I follow (transitively)."
 ;; Combines federation (follows + transitive reach), authoring,
 ;; tagging — the rose-ash multi-domain join.
 ;;
 ;; EDB:
 ;;   (follows ACTOR-A ACTOR-B)
 ;;   (authored ACTOR POST)
 ;;   (tagged POST TAG)
 (define
  dl-demo-cooking-rules
  (quote
    ((reach Me Them <- (follows Me Them))
     (reach Me Them <- (follows Me X) (reach X Them))
     (cooking-post-by-network Me P
       <-
       (reach Me Author)
       (authored Author P)
       (tagged P cooking)))))
 ;; ── Demo 5: tag co-occurrence ───────────────────────────────────
 ;; "Posts tagged with both T1 AND T2." Useful for narrowed-down
 ;; recommendations like "vegetarian cooking" posts.
 ;;
 ;; EDB:
 ;;   (tagged POST TAG)
 ;; IDB:
 ;;   (cotagged POST T1 T2)        — post has both T1 and T2 (T1 != T2)
 ;;   (popular-pair T1 T2 N)       — count of posts cotagged (T1, T2)
 (define
  dl-demo-tag-cooccur-rules
  (quote
    ((cotagged P T1 T2 <- (tagged P T1) (tagged P T2) (!= T1 T2))
     ;; Distinct (T1, T2) pairs that occur somewhere.
     (tag-pair T1 T2 <- (cotagged P T1 T2))
     (tag-pair-count T1 T2 N
       <-
       (tag-pair T1 T2)
       (count N P (cotagged P T1 T2))))))
 ;; ── Demo 6: weighted-DAG shortest path ─────────────────────────
 ;; "What's the cheapest way from X to Y?" Edge weights with `is`
 ;; arithmetic to sum costs, then `min` aggregation to pick the
 ;; shortest. Termination requires the graph to be a DAG (cycles
 ;; would produce infinite distances without a bound; programs
 ;; built on this should add a depth filter `(<, D, MAX)` if cycles
 ;; are possible).
 ;;
 ;; EDB:
 ;;   (edge FROM TO COST)
 ;; IDB:
 ;;   (path FROM TO COST)            — any path
 ;;   (shortest FROM TO COST)        — minimum cost path
 (define
  dl-demo-shortest-path-rules
  (quote
    ((path X Y W <- (edge X Y W))
     (path X Z W
       <-
       (edge X Y W1)
       (path Y Z W2)
       (is W (+ W1 W2)))
     (shortest X Y W <- (path X Y _) (min W C (path X Y C))))))
 ;; ── Loader stub ──────────────────────────────────────────────────
 ;; Wiring to PostgreSQL would replace these helpers with calls into
 ;; rose-ash's internal HTTP RPC (fetch_data → /internal/data/...).
 ;; The shape returned by dl-load-from-edb! is the same in either case.
 (define
  dl-demo-make
  (fn
    (facts rules)
    (dl-program-data facts rules)))
--- a/lib/datalog/eval.sx
+++ b/lib/datalog/eval.sx
@@ -1,480 +0,0 @@
 ;; lib/datalog/eval.sx — fixpoint evaluator (naive + semi-naive).
 ;;
 ;; Two saturators are exposed:
 ;;   `dl-saturate-naive!` — re-joins each rule against the full DB every
 ;;     iteration. Reference implementation; useful for differential tests.
 ;;   `dl-saturate!`       — semi-naive default. Tracks per-relation delta
 ;;     sets and substitutes one positive body literal per rule with the
 ;;     delta of its relation, joining the rest against the previous-
 ;;     iteration DB. Same fixpoint, dramatically less work on recursive
 ;;     rules.
 ;;
 ;; Body literal kinds:
 ;;   positive (rel arg ... arg)  → match against EDB+IDB tuples
 ;;   built-in (< X Y), (is X e)  → constraint via dl-eval-builtin
 ;;   negation {:neg lit}         → Phase 7
 (define
  dl-match-positive
  (fn
    (lit db subst)
    (let
      ((rel (dl-rel-name lit)) (results (list)))
      (cond
        ((nil? rel) (error (str "dl-match-positive: bad literal " lit)))
        (else
          (let
            ;; If the first argument walks to a non-variable (constant
            ;; or already-bound var), use the first-arg index for
            ;; this relation. Otherwise scan the full tuple list.
            ((tuples
               (cond
                 ((>= (len lit) 2)
                   (let ((walked (dl-walk (nth lit 1) subst)))
                     (cond
                       ((dl-var? walked) (dl-rel-tuples db rel))
                       (else (dl-index-lookup db rel walked)))))
                 (else (dl-rel-tuples db rel)))))
            (do
              (for-each
                (fn
                  (tuple)
                  (let
                    ((s (dl-unify lit tuple subst)))
                    (when (not (nil? s)) (append! results s))))
                tuples)
              results)))))))
 ;; Match a positive literal against the delta set for its relation only.
 (define
  dl-match-positive-delta
  (fn
    (lit delta subst)
    (let
      ((rel (dl-rel-name lit)) (results (list)))
      (let
        ((tuples (if (has-key? delta rel) (get delta rel) (list))))
        (do
          (for-each
            (fn
              (tuple)
              (let
                ((s (dl-unify lit tuple subst)))
                (when (not (nil? s)) (append! results s))))
            tuples)
          results)))))
 ;; Naive matcher (for dl-saturate-naive! and dl-query post-saturation).
 (define
  dl-match-negation
  (fn
    (inner db subst)
    (let
      ((walked (dl-apply-subst inner subst))
        (matches (dl-match-positive inner db subst)))
      (cond
        ((= (len matches) 0) (list subst))
        (else (list))))))
 (define
  dl-match-lit
  (fn
    (lit db subst)
    (cond
      ((and (dict? lit) (has-key? lit :neg))
        (dl-match-negation (get lit :neg) db subst))
      ((dl-aggregate? lit) (dl-eval-aggregate lit db subst))
      ((dl-builtin? lit)
        (let
          ((s (dl-eval-builtin lit subst)))
          (if (nil? s) (list) (list s))))
      ((and (list? lit) (> (len lit) 0))
        (dl-match-positive lit db subst))
      (else (error (str "datalog: unknown body-literal shape: " lit))))))
 (define
  dl-find-bindings
  (fn (lits db subst) (dl-fb-aux lits db subst 0 (len lits))))
 (define
  dl-fb-aux
  (fn
    (lits db subst i n)
    (cond
      ((nil? subst) (list))
      ((>= i n) (list subst))
      (else
        (let
          ((options (dl-match-lit (nth lits i) db subst))
            (results (list)))
          (do
            (for-each
              (fn
                (s)
                (for-each
                  (fn (s2) (append! results s2))
                  (dl-fb-aux lits db s (+ i 1) n)))
              options)
            results))))))
 ;; Naive: apply each rule against full DB until no new tuples.
 (define
  dl-apply-rule!
  (fn
    (db rule)
    (let
      ((head (get rule :head)) (body (get rule :body)) (new? false))
      (do
        (for-each
          (fn
            (s)
            (let
              ((derived (dl-apply-subst head s)))
              (when (dl-add-fact! db derived) (set! new? true))))
          (dl-find-bindings body db (dl-empty-subst)))
        new?))))
 (define
  dl-saturate-naive!
  (fn
    (db)
    (let
      ((changed true))
      (do
        (define
          dl-snloop
          (fn
            ()
            (when
              changed
              (do
                (set! changed false)
                (for-each
                  (fn (r) (when (dl-apply-rule! db r) (set! changed true)))
                  (dl-rules db))
                (dl-snloop)))))
        (dl-snloop)
        db))))
 ;; ── Semi-naive ───────────────────────────────────────────────────
 ;; Take a snapshot dict {rel -> tuples} of every relation currently in
 ;; the DB. Used as initial delta for the first iteration.
 (define
  dl-snapshot-facts
  (fn
    (db)
    (let
      ((facts (get db :facts)) (out {}))
      (do
        (for-each
          (fn (k) (dict-set! out k (dl-copy-list (get facts k))))
          (keys facts))
        out))))
 (define
  dl-copy-list
  (fn
    (xs)
    (let
      ((out (list)))
      (do (for-each (fn (x) (append! out x)) xs) out))))
 ;; Does any relation in `delta` have ≥1 tuple?
 (define
  dl-delta-empty?
  (fn
    (delta)
    (let
      ((ks (keys delta)) (any-non-empty false))
      (do
        (for-each
          (fn
            (k)
            (when
              (> (len (get delta k)) 0)
              (set! any-non-empty true)))
          ks)
        (not any-non-empty)))))
 ;; Find substitutions such that `lits` are all satisfied AND `delta-idx`
 ;; is matched against the per-relation delta only. The other positive
 ;; literals match against the snapshot DB (db.facts read at iteration
 ;; start). Built-ins and negations behave as in `dl-match-lit`.
 (define
  dl-find-bindings-semi
  (fn
    (lits db delta delta-idx subst)
    (dl-fbs-aux lits db delta delta-idx 0 subst)))
 (define
  dl-fbs-aux
  (fn
    (lits db delta delta-idx i subst)
    (cond
      ((nil? subst) (list))
      ((>= i (len lits)) (list subst))
      (else
        (let
          ((lit (nth lits i))
            (options
              (cond
                ((and (dict? lit) (has-key? lit :neg))
                  (dl-match-negation (get lit :neg) db subst))
                ((dl-aggregate? lit) (dl-eval-aggregate lit db subst))
                ((dl-builtin? lit)
                  (let
                    ((s (dl-eval-builtin lit subst)))
                    (if (nil? s) (list) (list s))))
                ((and (list? lit) (> (len lit) 0))
                  (if
                    (= i delta-idx)
                    (dl-match-positive-delta lit delta subst)
                    (dl-match-positive lit db subst)))
                (else (error (str "datalog: unknown body-lit: " lit)))))
            (results (list)))
          (do
            (for-each
              (fn
                (s)
                (for-each
                  (fn (s2) (append! results s2))
                  (dl-fbs-aux lits db delta delta-idx (+ i 1) s)))
              options)
            results))))))
 ;; Collect candidate head tuples from a rule using delta. Walks every
 ;; positive body position and unions the resulting heads. For rules
 ;; with no positive body literal, falls back to a naive single-pass
 ;; (so static facts like `(p X) :- (= X 5).` derive on iteration 1).
 (define
  dl-collect-rule-candidates
  (fn
    (rule db delta)
    (let
      ((head (get rule :head))
        (body (get rule :body))
        (out (list))
        (saw-pos false))
      (do
        (define
          dl-cri
          (fn
            (i)
            (when
              (< i (len body))
              (do
                (let
                  ((lit (nth body i)))
                  (when
                    (dl-positive-lit? lit)
                    (do
                      (set! saw-pos true)
                      (for-each
                        (fn (s) (append! out (dl-apply-subst head s)))
                        (dl-find-bindings-semi
                          body
                          db
                          delta
                          i
                          (dl-empty-subst))))))
                (dl-cri (+ i 1))))))
        (dl-cri 0)
        (when
          (not saw-pos)
          (for-each
            (fn (s) (append! out (dl-apply-subst head s)))
            (dl-find-bindings body db (dl-empty-subst))))
        out))))
 ;; Add a list of candidate tuples to db; collect newly-added ones into
 ;; the new-delta dict (keyed by relation name).
 (define
  dl-commit-candidates!
  (fn
    (db candidates new-delta)
    (for-each
      (fn
        (lit)
        (when
          (dl-add-fact! db lit)
          (let
            ((rel (dl-rel-name lit)))
            (do
              (when
                (not (has-key? new-delta rel))
                (dict-set! new-delta rel (list)))
              (append! (get new-delta rel) lit)))))
      candidates)))
 (define
  dl-saturate-rules!
  (fn
    (db rules)
    (let
      ((delta (dl-snapshot-facts db)))
      (do
        (define
          dl-sr-step
          (fn
            ()
            (let
              ((pending (list)) (new-delta {}))
              (do
                (for-each
                  (fn
                    (rule)
                    (for-each
                      (fn (cand) (append! pending cand))
                      (dl-collect-rule-candidates rule db delta)))
                  rules)
                (dl-commit-candidates! db pending new-delta)
                (cond
                  ((dl-delta-empty? new-delta) nil)
                  (else (do (set! delta new-delta) (dl-sr-step))))))))
        (dl-sr-step)
        db))))
 ;; Stratified driver: rejects non-stratifiable programs at saturation
 ;; time, then iterates strata in increasing order, running semi-naive on
 ;; the rules whose head sits in that stratum.
 (define
  dl-saturate!
  (fn
    (db)
    (let
      ((err (dl-check-stratifiable db)))
      (cond
        ((not (nil? err)) (error (str "dl-saturate!: " err)))
        (else
          (let
            ((strata (dl-compute-strata db)))
            (let
              ((grouped (dl-group-rules-by-stratum db strata)))
              (let
                ((groups (get grouped :groups))
                  (max-s (get grouped :max)))
                (do
                  (define
                    dl-strat-loop
                    (fn
                      (s)
                      (when
                        (<= s max-s)
                        (let
                          ((sk (str s)))
                          (do
                            (when
                              (has-key? groups sk)
                              (dl-saturate-rules! db (get groups sk)))
                            (dl-strat-loop (+ s 1)))))))
                  (dl-strat-loop 0)
                  db)))))))))
 ;; ── Querying ─────────────────────────────────────────────────────
 ;; Coerce a query argument to a list of body literals. A single literal
 ;; like `(p X)` (positive — head is a symbol) or `{:neg ...}` becomes
 ;; `((p X))`. A list of literals like `((p X) (q X))` is returned as-is.
 (define
  dl-query-coerce
  (fn
    (goal)
    (cond
      ((and (dict? goal) (has-key? goal :neg)) (list goal))
      ((and (list? goal) (> (len goal) 0) (symbol? (first goal)))
        (list goal))
      ((list? goal) goal)
      (else (error (str "dl-query: unrecognised goal shape: " goal))))))
 (define
  dl-query
  (fn
    (db goal)
    (do
      (dl-saturate! db)
      ;; Rename anonymous '_' vars in each goal literal so multiple
      ;; occurrences do not unify together. Keep the user-facing var
      ;; list (taken before renaming) so projected results retain user
      ;; names.
      (let
        ((goals (dl-query-coerce goal))
          (renamer (dl-make-anon-renamer)))
        (let
          ((user-vars (dl-query-user-vars goals))
            (renamed (map (fn (g) (dl-rename-anon-lit g renamer)) goals)))
          (let
            ((substs (dl-find-bindings renamed db (dl-empty-subst)))
              (results (list)))
            (do
              (for-each
                (fn
                  (s)
                  (let
                    ((proj (dl-project-subst s user-vars)))
                    (when
                      (not (dl-tuple-member? proj results))
                      (append! results proj))))
                substs)
              results)))))))
 (define
  dl-query-user-vars
  (fn
    (goals)
    (let ((seen (list)))
      (do
        (for-each
          (fn
            (g)
            (cond
              ((and (dict? g) (has-key? g :neg))
                (for-each
                  (fn
                    (v)
                    (when
                      (and (not (= v "_")) (not (dl-member-string? v seen)))
                      (append! seen v)))
                  (dl-vars-of (get g :neg))))
              ((dl-aggregate? g)
                ;; Only the result var (first arg of the aggregate
                ;; literal) is user-facing. The aggregated var and
                ;; any vars in the inner goal are internal.
                (let ((r (nth g 1)))
                  (when
                    (dl-var? r)
                    (let ((rn (symbol->string r)))
                      (when
                        (and (not (= rn "_"))
                             (not (dl-member-string? rn seen)))
                        (append! seen rn))))))
              (else
                (for-each
                  (fn
                    (v)
                    (when
                      (and (not (= v "_")) (not (dl-member-string? v seen)))
                      (append! seen v)))
                  (dl-vars-of g)))))
          goals)
        seen))))
 (define
  dl-project-subst
  (fn
    (subst names)
    (let
      ((out {}))
      (do
        (for-each
          (fn
            (n)
            (let
              ((sym (string->symbol n)))
              (let
                ((v (dl-walk sym subst)))
                (dict-set! out n (dl-apply-subst v subst)))))
          names)
        out))))
 (define dl-relation (fn (db name) (dl-rel-tuples db name)))
--- a/lib/datalog/magic.sx
+++ b/lib/datalog/magic.sx
@@ -1,403 +0,0 @@
 ;; lib/datalog/magic.sx — adornment analysis + sideways info passing.
 ;;
 ;; First step of the magic-sets transformation (Phase 6). Right now
 ;; the saturator does not consume these — they are introspection
 ;; helpers that future magic-set rewriting will build on top of.
 ;;
 ;; Definitions:
 ;;   - An *adornment* of an n-ary literal is an n-character string
 ;;     of "b" (bound — value already known at the call site) and
 ;;     "f" (free — to be derived).
 ;;   - SIPS (Sideways Information Passing Strategy) walks the body
 ;;     of an adorned rule left-to-right tracking which variables
 ;;     have been bound so far, computing each body literal's
 ;;     adornment in turn.
 ;;
 ;; Usage:
 ;;
 ;;   (dl-adorn-goal '(ancestor tom X))
 ;;     => "bf"
 ;;
 ;;   (dl-rule-sips
 ;;     {:head (ancestor X Z)
 ;;      :body ((parent X Y) (ancestor Y Z))}
 ;;     "bf")
 ;;   => ({:lit (parent X Y) :adornment "bf"}
 ;;       {:lit (ancestor Y Z) :adornment "bf"})
 ;; Per-arg adornment under the current bound-var name set.
 (define
  dl-adorn-arg
  (fn
    (arg bound)
    (cond
      ((dl-var? arg)
        (if (dl-member-string? (symbol->string arg) bound) "b" "f"))
      (else "b"))))
 ;; Adornment for the args of a literal (after the relation name).
 (define
  dl-adorn-args
  (fn
    (args bound)
    (cond
      ((= (len args) 0) "")
      (else
        (str
          (dl-adorn-arg (first args) bound)
          (dl-adorn-args (rest args) bound))))))
 ;; Adornment of a top-level goal under the empty bound-var set.
 (define
  dl-adorn-goal
  (fn (goal) (dl-adorn-args (rest goal) (list))))
 ;; Adornment of a literal under an explicit bound set.
 (define
  dl-adorn-lit
  (fn (lit bound) (dl-adorn-args (rest lit) bound)))
 ;; The set of variable names made bound by walking a positive
 ;; literal whose adornment is known. Free positions add their
 ;; vars to the bound set.
 (define
  dl-vars-bound-by-lit
  (fn
    (lit bound)
    (let ((args (rest lit)) (out (list)))
      (do
        (for-each
          (fn (a)
            (when
              (and (dl-var? a)
                   (not (dl-member-string? (symbol->string a) bound))
                   (not (dl-member-string? (symbol->string a) out)))
              (append! out (symbol->string a))))
          args)
        out))))
 ;; Walk the rule body left-to-right tracking bound vars seeded by the
 ;; head adornment. Returns a list of {:lit :adornment} entries.
 ;;
 ;; Negation, comparison, and built-ins are passed through with their
 ;; adornment computed from the current bound set; they don't add new
 ;; bindings (except `is`, which binds its left arg if a var). Aggregates
 ;; are treated like is — the result var becomes bound.
 (define
  dl-init-head-bound
  (fn
    (head adornment)
    (let ((args (rest head)) (out (list)))
      (do
        (define
          dl-ihb-loop
          (fn
            (i)
            (when
              (< i (len args))
              (do
                (let
                  ((c (slice adornment i (+ i 1)))
                    (a (nth args i)))
                  (when
                    (and (= c "b") (dl-var? a))
                    (let ((n (symbol->string a)))
                      (when
                        (not (dl-member-string? n out))
                        (append! out n)))))
                (dl-ihb-loop (+ i 1))))))
        (dl-ihb-loop 0)
        out))))
 (define
  dl-rule-sips
  (fn
    (rule head-adornment)
    (let
      ((bound (dl-init-head-bound (get rule :head) head-adornment))
        (out (list)))
      (do
        (for-each
          (fn
            (lit)
            (cond
              ((and (dict? lit) (has-key? lit :neg))
                (let ((target (get lit :neg)))
                  (append!
                    out
                    {:lit lit :adornment (dl-adorn-lit target bound)})))
              ((dl-builtin? lit)
                (let ((adn (dl-adorn-lit lit bound)))
                  (do
                    (append! out {:lit lit :adornment adn})
                    ;; `is` binds its left arg (if var) once RHS is ground.
                    (when
                      (and (= (dl-rel-name lit) "is") (dl-var? (nth lit 1)))
                      (let ((n (symbol->string (nth lit 1))))
                        (when
                          (not (dl-member-string? n bound))
                          (append! bound n)))))))
              ((and (list? lit) (dl-aggregate? lit))
                (let ((adn (dl-adorn-lit lit bound)))
                  (do
                    (append! out {:lit lit :adornment adn})
                    ;; Result var (first arg) becomes bound.
                    (when (dl-var? (nth lit 1))
                      (let ((n (symbol->string (nth lit 1))))
                        (when
                          (not (dl-member-string? n bound))
                          (append! bound n)))))))
              ((and (list? lit) (> (len lit) 0))
                (let ((adn (dl-adorn-lit lit bound)))
                  (do
                    (append! out {:lit lit :adornment adn})
                    (for-each
                      (fn (n)
                        (when (not (dl-member-string? n bound))
                          (append! bound n)))
                      (dl-vars-bound-by-lit lit bound)))))))
          (get rule :body))
        out))))
 ;; ── Magic predicate naming + bound-args extraction ─────────────
 ;; These are building blocks for the magic-sets *transformation*
 ;; itself. The transformation (which generates rewritten rules
 ;; with magic_<rel>^<adornment> filters) is future work — for now
 ;; these helpers can be used to inspect what such a transformation
 ;; would produce.
 ;; "magic_p^bf" given relation "p" and adornment "bf".
 (define
  dl-magic-rel-name
  (fn (rel adornment) (str "magic_" rel "^" adornment)))
 ;; A magic predicate literal:
 ;;   (magic_<rel>^<adornment> arg1 arg2 ...)
 (define
  dl-magic-lit
  (fn
    (rel adornment bound-args)
    (cons (string->symbol (dl-magic-rel-name rel adornment)) bound-args)))
 ;; Extract bound args (those at "b" positions in `adornment`) from a
 ;; literal `(rel arg1 arg2 ... argN)`. Returns the list of arg values.
 (define
  dl-bound-args
  (fn
    (lit adornment)
    (let ((args (rest lit)) (out (list)))
      (do
        (define
          dl-ba-loop
          (fn
            (i)
            (when
              (< i (len args))
              (do
                (when
                  (= (slice adornment i (+ i 1)) "b")
                  (append! out (nth args i)))
                (dl-ba-loop (+ i 1))))))
        (dl-ba-loop 0)
        out))))
 ;; ── Magic-sets rewriter ─────────────────────────────────────────
 ;;
 ;; Given the original rule list and a query (rel, adornment) pair,
 ;; generates the magic-rewritten program: a list of rules that
 ;; (a) gate each original rule with a `magic_<rel>^<adn>` filter and
 ;; (b) propagate the magic relation through SIPS so that only
 ;; query-relevant tuples are derived. Seed facts are returned
 ;; separately and must be added to the db at evaluation time.
 ;;
 ;; Output: {:rules <rewritten-rules> :seed <magic-seed-literal>}
 ;;
 ;; The rewriter only rewrites IDB rules; EDB facts pass through.
 ;; Built-in predicates and negation in body literals are kept in
 ;; place but do not generate propagation rules of their own.
 (define
  dl-magic-pair-key
  (fn (rel adornment) (str rel "^" adornment)))
 (define
  dl-magic-rewrite
  (fn
    (rules query-rel query-adornment query-args)
    (let
      ((seen (list))
        (queue (list))
        (out (list)))
      (do
        (define
          dl-mq-mark!
          (fn
            (rel adornment)
            (let ((k (dl-magic-pair-key rel adornment)))
              (when
                (not (dl-member-string? k seen))
                (do
                  (append! seen k)
                  (append! queue {:rel rel :adn adornment}))))))
        (define
          dl-mq-rewrite-rule!
          (fn
            (rule adn)
            (let
              ((head (get rule :head))
                (body (get rule :body))
                (sips (dl-rule-sips rule adn)))
              (let
                ((magic-filter
                   (dl-magic-lit
                     (dl-rel-name head)
                     adn
                     (dl-bound-args head adn))))
                (do
                  ;; Adorned rule: head :- magic-filter, body...
                  (let ((new-body (list)))
                    (do
                      (append! new-body magic-filter)
                      (for-each
                        (fn (lit) (append! new-body lit))
                        body)
                      (append! out {:head head :body new-body})))
                  ;; Propagation rules for each positive non-builtin
                  ;; body literal at position i.
                  (define
                    dl-mq-prop-loop
                    (fn
                      (i)
                      (when
                        (< i (len body))
                        (do
                          (let
                            ((lit (nth body i))
                              (sip-entry (nth sips i)))
                            (when
                              (and (list? lit)
                                   (> (len lit) 0)
                                   (not (and (dict? lit) (has-key? lit :neg)))
                                   (not (dl-builtin? lit))
                                   (not (dl-aggregate? lit)))
                              (let
                                ((lit-adn (get sip-entry :adornment))
                                  (lit-rel (dl-rel-name lit)))
                                (let
                                  ((prop-head
                                     (dl-magic-lit
                                       lit-rel
                                       lit-adn
                                       (dl-bound-args lit lit-adn))))
                                  (let ((prop-body (list)))
                                    (do
                                      (append! prop-body magic-filter)
                                      (define
                                        dl-mq-prefix-loop
                                        (fn
                                          (j)
                                          (when
                                            (< j i)
                                            (do
                                              (append!
                                                prop-body
                                                (nth body j))
                                              (dl-mq-prefix-loop (+ j 1))))))
                                      (dl-mq-prefix-loop 0)
                                      (append!
                                        out
                                        {:head prop-head :body prop-body})
                                      (dl-mq-mark! lit-rel lit-adn)))))))
                          (dl-mq-prop-loop (+ i 1))))))
                  (dl-mq-prop-loop 0))))))
        (dl-mq-mark! query-rel query-adornment)
        (define
          dl-mq-process
          (fn
            ()
            (when
              (> (len queue) 0)
              (let ((item (first queue)))
                (do
                  (set! queue (rest queue))
                  (let
                    ((rel (get item :rel)) (adn (get item :adn)))
                    (for-each
                      (fn
                        (rule)
                        (when
                          (= (dl-rel-name (get rule :head)) rel)
                          (dl-mq-rewrite-rule! rule adn)))
                      rules))
                  (dl-mq-process))))))
        (dl-mq-process)
        {:rules out
         :seed
         (dl-magic-lit
           query-rel
           query-adornment
           query-args)}))))
 ;; ── Top-level magic-sets driver ─────────────────────────────────
 ;;
 ;; (dl-magic-query db query-goal) — run `query-goal` under magic-sets
 ;; evaluation. Builds a fresh internal db with:
 ;;   - the caller's EDB facts (relations not headed by any rule),
 ;;   - the magic seed fact, and
 ;;   - the rewritten rules.
 ;; Saturates and queries, returning the substitution list. The
 ;; caller's db is untouched.
 ;;
 ;; Useful primarily as a perf alternative for queries that only
 ;; need a small slice of a recursive relation. Equivalent to
 ;; dl-query for any single fully-stratifiable program.
 (define
  dl-magic-rule-heads
  (fn
    (rules)
    (let ((seen (list)))
      (do
        (for-each
          (fn
            (r)
            (let ((h (dl-rel-name (get r :head))))
              (when
                (and (not (nil? h)) (not (dl-member-string? h seen)))
                (append! seen h))))
          rules)
        seen))))
 (define
  dl-magic-query
  (fn
    (db query-goal)
    (let
      ((query-rel (dl-rel-name query-goal))
        (query-adn (dl-adorn-goal query-goal)))
      (let
        ((query-args (dl-bound-args query-goal query-adn))
          (rules (dl-rules db)))
        (let
          ((rewritten (dl-magic-rewrite rules query-rel query-adn query-args))
            (mdb (dl-make-db))
            (rule-heads (dl-magic-rule-heads rules)))
          (do
            ;; Copy EDB facts (relations not headed by any caller rule).
            (for-each
              (fn
                (rel)
                (when
                  (not (dl-member-string? rel rule-heads))
                  (for-each
                    (fn (t) (dl-add-fact! mdb t))
                    (dl-rel-tuples db rel))))
              (keys (get db :facts)))
            ;; Seed + rewritten rules.
            (dl-add-fact! mdb (get rewritten :seed))
            (for-each (fn (r) (dl-add-rule! mdb r)) (get rewritten :rules))
            (dl-query mdb query-goal)))))))
--- a/lib/datalog/parser.sx
+++ b/lib/datalog/parser.sx
@@ -1,242 +0,0 @@
 ;; lib/datalog/parser.sx — Datalog tokens → AST
 ;;
 ;; Output shapes:
 ;;   Literal (positive)  := (relname arg ... arg)        — SX list
 ;;   Literal (negative)  := {:neg (relname arg ... arg)} — dict
 ;;   Argument            := var-symbol | atom-symbol | number | string
 ;;                        | (op-name arg ... arg)        — arithmetic compound
 ;;   Fact                := {:head literal :body ()}
 ;;   Rule                := {:head literal :body (lit ... lit)}
 ;;   Query               := {:query (lit ... lit)}
 ;;   Program             := list of facts / rules / queries
 ;;
 ;; Variables and constants are both SX symbols; the evaluator dispatches
 ;; on first-char case ('A'..'Z' or '_' = variable, otherwise constant).
 ;;
 ;; The parser permits nested compounds in arg position to support
 ;; arithmetic (e.g. (is Z (+ X Y))). Safety analysis at rule-load time
 ;; rejects compounds whose head is not an arithmetic operator.
 (define
  dl-pp-peek
  (fn
    (st)
    (let
      ((i (get st :idx)) (tokens (get st :tokens)))
      (if (< i (len tokens)) (nth tokens i) {:type "eof" :value nil :pos 0}))))
 (define
  dl-pp-peek2
  (fn
    (st)
    (let
      ((i (+ (get st :idx) 1)) (tokens (get st :tokens)))
      (if (< i (len tokens)) (nth tokens i) {:type "eof" :value nil :pos 0}))))
 (define
  dl-pp-advance!
  (fn (st) (dict-set! st :idx (+ (get st :idx) 1))))
 (define
  dl-pp-at?
  (fn
    (st type value)
    (let
      ((t (dl-pp-peek st)))
      (and
        (= (get t :type) type)
        (or (= value nil) (= (get t :value) value))))))
 (define
  dl-pp-error
  (fn
    (st msg)
    (let
      ((t (dl-pp-peek st)))
      (error
        (str
          "Parse error at pos "
          (get t :pos)
          ": "
          msg
          " (got "
          (get t :type)
          " '"
          (if (= (get t :value) nil) "" (get t :value))
          "')")))))
 (define
  dl-pp-expect!
  (fn
    (st type value)
    (let
      ((t (dl-pp-peek st)))
      (if
        (dl-pp-at? st type value)
        (do (dl-pp-advance! st) t)
        (dl-pp-error
          st
          (str "expected " type (if (= value nil) "" (str " '" value "'"))))))))
 ;; Argument: variable, atom, number, string, or compound (relname/op + parens).
 (define
  dl-pp-parse-arg
  (fn
    (st)
    (let
      ((t (dl-pp-peek st)))
      (let
        ((ty (get t :type)) (vv (get t :value)))
        (cond
          ((= ty "number") (do (dl-pp-advance! st) vv))
          ((= ty "string") (do (dl-pp-advance! st) vv))
          ((= ty "var") (do (dl-pp-advance! st) (string->symbol vv)))
          ((or (= ty "atom") (= ty "op"))
            (do
              (dl-pp-advance! st)
              (if
                (dl-pp-at? st "punct" "(")
                (do
                  (dl-pp-advance! st)
                  (let
                    ((args (dl-pp-parse-arg-list st)))
                    (do
                      (dl-pp-expect! st "punct" ")")
                      (cons (string->symbol vv) args))))
                (string->symbol vv))))
          (else (dl-pp-error st "expected term")))))))
 ;; Comma-separated args inside parens.
 (define
  dl-pp-parse-arg-list
  (fn
    (st)
    (let
      ((args (list)))
      (do
        (append! args (dl-pp-parse-arg st))
        (define
          dl-pp-arg-loop
          (fn
            ()
            (when
              (dl-pp-at? st "punct" ",")
              (do
                (dl-pp-advance! st)
                (append! args (dl-pp-parse-arg st))
                (dl-pp-arg-loop)))))
        (dl-pp-arg-loop)
        args))))
 ;; A positive literal: relname (atom or op) followed by optional (args).
 (define
  dl-pp-parse-positive
  (fn
    (st)
    (let
      ((t (dl-pp-peek st)))
      (let
        ((ty (get t :type)) (vv (get t :value)))
        (if
          (or (= ty "atom") (= ty "op"))
          (do
            (dl-pp-advance! st)
            (if
              (dl-pp-at? st "punct" "(")
              (do
                (dl-pp-advance! st)
                (let
                  ((args (dl-pp-parse-arg-list st)))
                  (do
                    (dl-pp-expect! st "punct" ")")
                    (cons (string->symbol vv) args))))
              (list (string->symbol vv))))
          (dl-pp-error st "expected literal head"))))))
 ;; A body literal: positive, or not(positive).
 (define
  dl-pp-parse-body-lit
  (fn
    (st)
    (let
      ((t1 (dl-pp-peek st)) (t2 (dl-pp-peek2 st)))
      (if
        (and
          (= (get t1 :type) "atom")
          (= (get t1 :value) "not")
          (= (get t2 :type) "punct")
          (= (get t2 :value) "("))
        (do
          (dl-pp-advance! st)
          (dl-pp-advance! st)
          (let
            ((inner (dl-pp-parse-positive st)))
            (do (dl-pp-expect! st "punct" ")") {:neg inner})))
        (dl-pp-parse-positive st)))))
 ;; Comma-separated body literals.
 (define
  dl-pp-parse-body
  (fn
    (st)
    (let
      ((lits (list)))
      (do
        (append! lits (dl-pp-parse-body-lit st))
        (define
          dl-pp-body-loop
          (fn
            ()
            (when
              (dl-pp-at? st "punct" ",")
              (do
                (dl-pp-advance! st)
                (append! lits (dl-pp-parse-body-lit st))
                (dl-pp-body-loop)))))
        (dl-pp-body-loop)
        lits))))
 ;; Single clause: fact, rule, or query. Consumes trailing dot.
 (define
  dl-pp-parse-clause
  (fn
    (st)
    (cond
      ((dl-pp-at? st "op" "?-")
        (do
          (dl-pp-advance! st)
          (let
            ((body (dl-pp-parse-body st)))
            (do (dl-pp-expect! st "punct" ".") {:query body}))))
      (else
        (let
          ((head (dl-pp-parse-positive st)))
          (cond
            ((dl-pp-at? st "op" ":-")
              (do
                (dl-pp-advance! st)
                (let
                  ((body (dl-pp-parse-body st)))
                  (do (dl-pp-expect! st "punct" ".") {:body body :head head}))))
            (else (do (dl-pp-expect! st "punct" ".") {:body (list) :head head}))))))))
 (define
  dl-parse-program
  (fn
    (tokens)
    (let
      ((st {:tokens tokens :idx 0}) (clauses (list)))
      (do
        (define
          dl-pp-prog-loop
          (fn
            ()
            (when
              (not (dl-pp-at? st "eof" nil))
              (do
                (append! clauses (dl-pp-parse-clause st))
                (dl-pp-prog-loop)))))
        (dl-pp-prog-loop)
        clauses))))
 (define dl-parse (fn (src) (dl-parse-program (dl-tokenize src))))
--- a/lib/datalog/scoreboard.json
+++ b/lib/datalog/scoreboard.json
@@ -1,20 +0,0 @@
 {
  "lang": "datalog",
  "total_passed": 205,
  "total_failed": 0,
  "total": 205,
  "suites": [
    {"name":"tokenize","passed":26,"failed":0,"total":26},
    {"name":"parse","passed":18,"failed":0,"total":18},
    {"name":"unify","passed":28,"failed":0,"total":28},
    {"name":"eval","passed":25,"failed":0,"total":25},
    {"name":"builtins","passed":19,"failed":0,"total":19},
    {"name":"semi_naive","passed":8,"failed":0,"total":8},
    {"name":"negation","passed":10,"failed":0,"total":10},
    {"name":"aggregates","passed":18,"failed":0,"total":18},
    {"name":"api","passed":14,"failed":0,"total":14},
    {"name":"magic","passed":21,"failed":0,"total":21},
    {"name":"demo","passed":18,"failed":0,"total":18}
  ],
  "generated": "2026-05-08T10:02:51+00:00"
 }
--- a/lib/datalog/scoreboard.md
+++ b/lib/datalog/scoreboard.md
@@ -1,17 +0,0 @@
 # datalog scoreboard
 **205 / 205 passing** (0 failure(s)).
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
 | tokenize | 26 | 26 | ok |
 | parse | 18 | 18 | ok |
 | unify | 28 | 28 | ok |
 | eval | 25 | 25 | ok |
 | builtins | 19 | 19 | ok |
 | semi_naive | 8 | 8 | ok |
 | negation | 10 | 10 | ok |
 | aggregates | 18 | 18 | ok |
 | api | 14 | 14 | ok |
 | magic | 21 | 21 | ok |
 | demo | 18 | 18 | ok |
--- a/lib/datalog/strata.sx
+++ b/lib/datalog/strata.sx
@@ -1,323 +0,0 @@
 ;; lib/datalog/strata.sx — dependency graph, SCC analysis, stratum assignment.
 ;;
 ;; A program is stratifiable iff no cycle in its dependency graph passes
 ;; through a negative edge. The stratum of relation R is the depth at which
 ;; R can first be evaluated:
 ;;
 ;;   stratum(R) = max over edges (R → S) of:
 ;;       stratum(S)         if the edge is positive
 ;;       stratum(S) + 1     if the edge is negative
 ;;
 ;; All relations in the same SCC share a stratum (and the SCC must have only
 ;; positive internal edges, else the program is non-stratifiable).
 ;; Build dep graph: dict {head-rel-name -> ({:rel str :neg bool} ...)}.
 (define
  dl-build-dep-graph
  (fn
    (db)
    (let ((g {}))
      (do
        (for-each
          (fn
            (rule)
            (let
              ((head-rel (dl-rel-name (get rule :head))))
              (when
                (not (nil? head-rel))
                (do
                  (when
                    (not (has-key? g head-rel))
                    (dict-set! g head-rel (list)))
                  (let ((existing (get g head-rel)))
                    (for-each
                      (fn
                        (lit)
                        (cond
                          ((dl-aggregate? lit)
                            (let
                              ((edge (dl-aggregate-dep-edge lit)))
                              (when
                                (not (nil? edge))
                                (append! existing edge))))
                          (else
                            (let
                              ((target
                                 (cond
                                   ((and (dict? lit) (has-key? lit :neg))
                                     (dl-rel-name (get lit :neg)))
                                   ((dl-builtin? lit) nil)
                                   ((and (list? lit) (> (len lit) 0))
                                     (dl-rel-name lit))
                                   (else nil)))
                                (neg?
                                  (and (dict? lit) (has-key? lit :neg))))
                              (when
                                (not (nil? target))
                                (append!
                                  existing
                                  {:rel target :neg neg?}))))))
                      (get rule :body)))))))
          (dl-rules db))
        g))))
 ;; All relations referenced — heads of rules + EDB names + body relations.
 (define
  dl-all-relations
  (fn
    (db)
    (let ((seen (list)))
      (do
        (for-each
          (fn
            (k)
            (when (not (dl-member-string? k seen)) (append! seen k)))
          (keys (get db :facts)))
        (for-each
          (fn
            (rule)
            (do
              (let ((h (dl-rel-name (get rule :head))))
                (when
                  (and (not (nil? h)) (not (dl-member-string? h seen)))
                  (append! seen h)))
              (for-each
                (fn
                  (lit)
                  (let
                    ((t
                       (cond
                         ((dl-aggregate? lit)
                           (let ((edge (dl-aggregate-dep-edge lit)))
                             (if (nil? edge) nil (get edge :rel))))
                         ((and (dict? lit) (has-key? lit :neg))
                           (dl-rel-name (get lit :neg)))
                         ((dl-builtin? lit) nil)
                         ((and (list? lit) (> (len lit) 0))
                           (dl-rel-name lit))
                         (else nil))))
                    (when
                      (and (not (nil? t)) (not (dl-member-string? t seen)))
                      (append! seen t))))
                (get rule :body))))
          (dl-rules db))
        seen))))
 ;; reach: dict {from: dict {to: edge-info}} where edge-info is
 ;;   {:any bool :neg bool}
 ;; meaning "any path from `from` to `to`" and "exists a negative-passing
 ;; path from `from` to `to`".
 ;;
 ;; Floyd-Warshall over the dep graph. The 'neg' flag propagates through
 ;; concatenation: if any edge along the path is negative, the path's
 ;; flag is true.
 (define
  dl-build-reach
  (fn
    (graph nodes)
    (let ((reach {}))
      (do
        (for-each
          (fn (n) (dict-set! reach n {}))
          nodes)
        (for-each
          (fn
            (head)
            (when
              (has-key? graph head)
              (for-each
                (fn
                  (edge)
                  (let
                    ((target (get edge :rel)) (n (get edge :neg)))
                    (let ((row (get reach head)))
                      (cond
                        ((has-key? row target)
                          (let ((cur (get row target)))
                            (dict-set!
                              row
                              target
                              {:any true :neg (or n (get cur :neg))})))
                        (else
                          (dict-set! row target {:any true :neg n}))))))
                (get graph head))))
          nodes)
        (for-each
          (fn
            (k)
            (for-each
              (fn
                (i)
                (let ((row-i (get reach i)))
                  (when
                    (has-key? row-i k)
                    (let ((ik (get row-i k)) (row-k (get reach k)))
                      (for-each
                        (fn
                          (j)
                          (when
                            (has-key? row-k j)
                            (let ((kj (get row-k j)))
                              (let
                                ((combined-neg (or (get ik :neg) (get kj :neg))))
                                (cond
                                  ((has-key? row-i j)
                                    (let ((cur (get row-i j)))
                                      (dict-set!
                                        row-i
                                        j
                                        {:any true
                                         :neg (or combined-neg (get cur :neg))})))
                                  (else
                                    (dict-set!
                                      row-i
                                      j
                                      {:any true :neg combined-neg})))))))
                        nodes)))))
              nodes))
          nodes)
        reach))))
 ;; Returns nil on success, or error message string on failure.
 (define
  dl-check-stratifiable
  (fn
    (db)
    (let
      ((graph (dl-build-dep-graph db))
        (nodes (dl-all-relations db)))
      (let ((reach (dl-build-reach graph nodes)) (err nil))
        (do
          (for-each
            (fn
              (rule)
              (when
                (nil? err)
                (let ((head-rel (dl-rel-name (get rule :head))))
                  (for-each
                    (fn
                      (lit)
                      (cond
                        ((and (dict? lit) (has-key? lit :neg))
                          (let ((tgt (dl-rel-name (get lit :neg))))
                            (when
                              (and (not (nil? tgt))
                                   (dl-reach-cycle? reach head-rel tgt))
                              (set!
                                err
                                (str "non-stratifiable: relation " head-rel
                                     " transitively depends through negation on "
                                     tgt
                                     " which depends back on " head-rel)))))
                        ((dl-aggregate? lit)
                          (let ((edge (dl-aggregate-dep-edge lit)))
                            (when
                              (not (nil? edge))
                              (let ((tgt (get edge :rel)))
                                (when
                                  (and (not (nil? tgt))
                                       (dl-reach-cycle? reach head-rel tgt))
                                  (set!
                                    err
                                    (str "non-stratifiable: relation "
                                         head-rel
                                         " aggregates over " tgt
                                         " which depends back on "
                                         head-rel))))))))) 
                    (get rule :body)))))
            (dl-rules db))
          err)))))
 (define
  dl-reach-cycle?
  (fn
    (reach a b)
    (and
      (dl-reach-row-has? reach b a)
      (dl-reach-row-has? reach a b))))
 (define
  dl-reach-row-has?
  (fn
    (reach from to)
    (let ((row (get reach from)))
      (and (not (nil? row)) (has-key? row to)))))
 ;; Compute stratum per relation. Iteratively propagate from EDB roots.
 ;; Uses the per-relation max-stratum-of-deps formula. Stops when stable.
 (define
  dl-compute-strata
  (fn
    (db)
    (let
      ((graph (dl-build-dep-graph db))
        (nodes (dl-all-relations db))
        (strata {}))
      (do
        (for-each (fn (n) (dict-set! strata n 0)) nodes)
        (let ((changed true))
          (do
            (define
              dl-cs-loop
              (fn
                ()
                (when
                  changed
                  (do
                    (set! changed false)
                    (for-each
                      (fn
                        (head)
                        (when
                          (has-key? graph head)
                          (for-each
                            (fn
                              (edge)
                              (let
                                ((tgt (get edge :rel))
                                  (n (get edge :neg)))
                                (let
                                  ((tgt-strat
                                     (if (has-key? strata tgt)
                                       (get strata tgt) 0))
                                    (cur (get strata head)))
                                  (let
                                    ((needed
                                       (if n (+ tgt-strat 1) tgt-strat)))
                                    (when
                                      (> needed cur)
                                      (do
                                        (dict-set! strata head needed)
                                        (set! changed true)))))))
                            (get graph head))))
                      nodes)
                    (dl-cs-loop)))))
            (dl-cs-loop)))
        strata))))
 ;; Group rules by their head's stratum. Returns dict {stratum-int -> rules}.
 (define
  dl-group-rules-by-stratum
  (fn
    (db strata)
    (let ((groups {}) (max-s 0))
      (do
        (for-each
          (fn
            (rule)
            (let
              ((head-rel (dl-rel-name (get rule :head))))
              (let
                ((s (if (has-key? strata head-rel)
                       (get strata head-rel) 0)))
                (do
                  (when (> s max-s) (set! max-s s))
                  (let
                    ((sk (str s)))
                    (do
                      (when
                        (not (has-key? groups sk))
                        (dict-set! groups sk (list)))
                      (append! (get groups sk) rule)))))))
          (dl-rules db))
        {:groups groups :max max-s}))))
--- a/lib/datalog/tests/aggregates.sx
+++ b/lib/datalog/tests/aggregates.sx
@@ -1,298 +0,0 @@
 ;; lib/datalog/tests/aggregates.sx — count / sum / min / max.
 (define dl-at-pass 0)
 (define dl-at-fail 0)
 (define dl-at-failures (list))
 (define
  dl-at-deep=?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-at-deq-l? a b 0)))
      ((and (dict? a) (dict? b))
        (let ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-at-deq-d? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-at-deq-l?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-at-deep=? (nth a i) (nth b i))) false)
      (else (dl-at-deq-l? a b (+ i 1))))))
 (define
  dl-at-deq-d?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i)))
         (not (dl-at-deep=? (get a k) (get b k))))
        false)
      (else (dl-at-deq-d? a b ka (+ i 1))))))
 (define
  dl-at-set=?
  (fn
    (a b)
    (and
      (= (len a) (len b))
      (dl-at-subset? a b)
      (dl-at-subset? b a))))
 (define
  dl-at-subset?
  (fn
    (xs ys)
    (cond
      ((= (len xs) 0) true)
      ((not (dl-at-contains? ys (first xs))) false)
      (else (dl-at-subset? (rest xs) ys)))))
 (define
  dl-at-contains?
  (fn
    (xs target)
    (cond
      ((= (len xs) 0) false)
      ((dl-at-deep=? (first xs) target) true)
      (else (dl-at-contains? (rest xs) target)))))
 (define
  dl-at-test!
  (fn
    (name got expected)
    (if
      (dl-at-deep=? got expected)
      (set! dl-at-pass (+ dl-at-pass 1))
      (do
        (set! dl-at-fail (+ dl-at-fail 1))
        (append!
          dl-at-failures
          (str
            name
            "\n    expected: " expected
            "\n    got:      " got))))))
 (define
  dl-at-test-set!
  (fn
    (name got expected)
    (if
      (dl-at-set=? got expected)
      (set! dl-at-pass (+ dl-at-pass 1))
      (do
        (set! dl-at-fail (+ dl-at-fail 1))
        (append!
          dl-at-failures
          (str
            name
            "\n    expected (set): " expected
            "\n    got:            " got))))))
 (define
  dl-at-throws?
  (fn
    (thunk)
    (let
      ((threw false))
      (do
        (guard
          (e (#t (set! threw true)))
          (thunk))
        threw))))
 (define
  dl-at-run-all!
  (fn
    ()
    (do
      ;; count
      (dl-at-test-set! "count siblings"
        (dl-query
          (dl-program
            "parent(p, bob). parent(p, alice). parent(p, charlie).
             sibling(X, Y) :- parent(P, X), parent(P, Y), !=(X, Y).
             sib_count(N) :- count(N, S, sibling(bob, S)).")
          (list (quote sib_count) (quote N)))
        (list {:N 2}))
      ;; sum
      (dl-at-test-set! "sum prices"
        (dl-query
          (dl-program
            "price(apple, 5). price(pear, 7). price(plum, 3).
             total(T) :- sum(T, X, price(F, X)).")
          (list (quote total) (quote T)))
        (list {:T 15}))
      ;; min
      (dl-at-test-set! "min score"
        (dl-query
          (dl-program
            "score(alice, 80). score(bob, 65). score(carol, 92).
             lo(M) :- min(M, S, score(P, S)).")
          (list (quote lo) (quote M)))
        (list {:M 65}))
      ;; max
      (dl-at-test-set! "max score"
        (dl-query
          (dl-program
            "score(alice, 80). score(bob, 65). score(carol, 92).
             hi(M) :- max(M, S, score(P, S)).")
          (list (quote hi) (quote M)))
        (list {:M 92}))
      ;; count over derived relation (stratification needed).
      (dl-at-test-set! "count over derived"
        (dl-query
          (dl-program
            "parent(a, b). parent(a, c). parent(b, d). parent(c, e).
             ancestor(X, Y) :- parent(X, Y).
             ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).
             num_ancestors(N) :- count(N, X, ancestor(a, X)).")
          (list (quote num_ancestors) (quote N)))
        (list {:N 4}))
      ;; count with no matches → 0.
      (dl-at-test-set! "count empty"
        (dl-query
          (dl-program
            "p(1). p(2).
             zero(N) :- count(N, X, q(X)).")
          (list (quote zero) (quote N)))
        (list {:N 0}))
      ;; sum with no matches → 0.
      (dl-at-test-set! "sum empty"
        (dl-query
          (dl-program
            "p(1). p(2).
             total(T) :- sum(T, X, q(X)).")
          (list (quote total) (quote T)))
        (list {:T 0}))
      ;; min with no matches → rule does not fire.
      (dl-at-test-set! "min empty"
        (dl-query
          (dl-program
            "p(1). p(2).
             lo(M) :- min(M, X, q(X)).")
          (list (quote lo) (quote M)))
        (list))
      ;; Aggregate with comparison filter on result.
      (dl-at-test-set! "popularity threshold"
        (dl-query
          (dl-program
            "post(p1). post(p2).
             liked(u1, p1). liked(u2, p1). liked(u3, p1).
             liked(u1, p2). liked(u2, p2).
             popular(P) :- post(P), count(N, U, liked(U, P)), >=(N, 3).")
          (list (quote popular) (quote P)))
        (list {:P (quote p1)}))
      ;; findall: collect distinct values into a list.
      (dl-at-test-set! "findall over EDB"
        (dl-query
          (dl-program
            "p(a). p(b). p(c).
             all_p(L) :- findall(L, X, p(X)).")
          (list (quote all_p) (quote L)))
        (list {:L (list (quote a) (quote b) (quote c))}))
      (dl-at-test-set! "findall over derived"
        (dl-query
          (dl-program
            "parent(a, b). parent(b, c). parent(c, d).
             ancestor(X, Y) :- parent(X, Y).
             ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).
             desc(L) :- findall(L, X, ancestor(a, X)).")
          (list (quote desc) (quote L)))
        (list {:L (list (quote b) (quote c) (quote d))}))
      (dl-at-test-set! "findall empty"
        (dl-query
          (dl-program
            "p(1).
             all_q(L) :- findall(L, X, q(X)).")
          (list (quote all_q) (quote L)))
        (list {:L (list)}))
      ;; Aggregate vs single distinct.
      ;; Stratification: recursion through aggregation is rejected.
      (dl-at-test! "agg recursion rejected"
        (dl-at-throws?
          (fn ()
            (let ((db (dl-make-db)))
              (do
                (dl-add-rule! db
                  {:head (list (quote q) (quote N))
                   :body (list (list (quote count) (quote N) (quote X)
                                     (list (quote q) (quote X))))})
                (dl-saturate! db)))))
        true)
      ;; Negation + aggregation in the same body — different strata.
      (dl-at-test-set! "neg + agg coexist"
        (dl-query
          (dl-program
            "u(a). u(b). u(c). banned(b).
             active(X) :- u(X), not(banned(X)).
             cnt(N) :- count(N, X, active(X)).")
          (list (quote cnt) (quote N)))
        (list {:N 2}))
      ;; Min over a derived empty relation: no result.
      (dl-at-test-set! "min over empty derived"
        (dl-query
          (dl-program
            "s(50). s(60).
             score(N) :- s(N), >(N, 100).
             low(M) :- min(M, X, score(X)).")
          (list (quote low) (quote M)))
        (list))
      ;; Aggregates as the top-level query goal (regression for
      ;; dl-match-lit aggregate dispatch and projection cleanup).
      (dl-at-test-set! "count as query goal"
        (dl-query
          (dl-program "p(1). p(2). p(3). p(4).")
          (list (quote count) (quote N) (quote X) (list (quote p) (quote X))))
        (list {:N 4}))
      (dl-at-test-set! "findall as query goal"
        (dl-query
          (dl-program "p(1). p(2). p(3).")
          (list (quote findall) (quote L) (quote X)
                (list (quote p) (quote X))))
        (list {:L (list 1 2 3)}))
      (dl-at-test-set! "distinct counted once"
        (dl-query
          (dl-program
            "rated(alice, x). rated(alice, y). rated(bob, x).
             rater_count(N) :- count(N, U, rated(U, F)).")
          (list (quote rater_count) (quote N)))
        (list {:N 2})))))
 (define
  dl-aggregates-tests-run!
  (fn
    ()
    (do
      (set! dl-at-pass 0)
      (set! dl-at-fail 0)
      (set! dl-at-failures (list))
      (dl-at-run-all!)
      {:passed dl-at-pass
       :failed dl-at-fail
       :total (+ dl-at-pass dl-at-fail)
       :failures dl-at-failures})))
--- a/lib/datalog/tests/api.sx
+++ b/lib/datalog/tests/api.sx
@@ -1,259 +0,0 @@
 ;; lib/datalog/tests/api.sx — SX-data embedding API.
 (define dl-api-pass 0)
 (define dl-api-fail 0)
 (define dl-api-failures (list))
 (define
  dl-api-deep=?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-api-deq-l? a b 0)))
      ((and (dict? a) (dict? b))
        (let ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-api-deq-d? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-api-deq-l?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-api-deep=? (nth a i) (nth b i))) false)
      (else (dl-api-deq-l? a b (+ i 1))))))
 (define
  dl-api-deq-d?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i)))
         (not (dl-api-deep=? (get a k) (get b k))))
        false)
      (else (dl-api-deq-d? a b ka (+ i 1))))))
 (define
  dl-api-set=?
  (fn
    (a b)
    (and
      (= (len a) (len b))
      (dl-api-subset? a b)
      (dl-api-subset? b a))))
 (define
  dl-api-subset?
  (fn
    (xs ys)
    (cond
      ((= (len xs) 0) true)
      ((not (dl-api-contains? ys (first xs))) false)
      (else (dl-api-subset? (rest xs) ys)))))
 (define
  dl-api-contains?
  (fn
    (xs target)
    (cond
      ((= (len xs) 0) false)
      ((dl-api-deep=? (first xs) target) true)
      (else (dl-api-contains? (rest xs) target)))))
 (define
  dl-api-test!
  (fn
    (name got expected)
    (if
      (dl-api-deep=? got expected)
      (set! dl-api-pass (+ dl-api-pass 1))
      (do
        (set! dl-api-fail (+ dl-api-fail 1))
        (append!
          dl-api-failures
          (str
            name
            "\n    expected: " expected
            "\n    got:      " got))))))
 (define
  dl-api-test-set!
  (fn
    (name got expected)
    (if
      (dl-api-set=? got expected)
      (set! dl-api-pass (+ dl-api-pass 1))
      (do
        (set! dl-api-fail (+ dl-api-fail 1))
        (append!
          dl-api-failures
          (str
            name
            "\n    expected (set): " expected
            "\n    got:            " got))))))
 (define
  dl-api-run-all!
  (fn
    ()
    (do
      ;; dl-program-data with arrow form.
      (dl-api-test-set! "data API ancestor closure"
        (dl-query
          (dl-program-data
            (quote ((parent tom bob) (parent bob ann) (parent ann pat)))
            (quote
              ((ancestor X Y <- (parent X Y))
               (ancestor X Z <- (parent X Y) (ancestor Y Z)))))
          (quote (ancestor tom X)))
        (list {:X (quote bob)} {:X (quote ann)} {:X (quote pat)}))
      ;; dl-program-data with dict rules.
      (dl-api-test-set! "data API with dict rules"
        (dl-query
          (dl-program-data
            (quote ((p a) (p b) (p c)))
            (list
              {:head (quote (q X)) :body (quote ((p X)))}))
          (quote (q X)))
        (list {:X (quote a)} {:X (quote b)} {:X (quote c)}))
      ;; dl-rule helper.
      (dl-api-test-set! "dl-rule constructor"
        (dl-query
          (dl-program-data
            (quote ((p 1) (p 2)))
            (list (dl-rule (quote (q X)) (quote ((p X))))))
          (quote (q X)))
        (list {:X 1} {:X 2}))
      ;; dl-assert! adds and re-derives.
      (dl-api-test-set! "dl-assert! incremental"
        (let
          ((db (dl-program-data
                 (quote ((parent tom bob) (parent bob ann)))
                 (quote
                   ((ancestor X Y <- (parent X Y))
                    (ancestor X Z <- (parent X Y) (ancestor Y Z)))))))
          (do
            (dl-saturate! db)
            (dl-assert! db (quote (parent ann pat)))
            (dl-query db (quote (ancestor tom X)))))
        (list {:X (quote bob)} {:X (quote ann)} {:X (quote pat)}))
      ;; dl-retract! removes a fact and recomputes IDB.
      (dl-api-test-set! "dl-retract! removes derived"
        (let
          ((db (dl-program-data
                 (quote ((parent tom bob) (parent bob ann) (parent ann pat)))
                 (quote
                   ((ancestor X Y <- (parent X Y))
                    (ancestor X Z <- (parent X Y) (ancestor Y Z)))))))
          (do
            (dl-saturate! db)
            (dl-retract! db (quote (parent bob ann)))
            (dl-query db (quote (ancestor tom X)))))
        (list {:X (quote bob)}))
      ;; dl-program-data + dl-query with constants in head.
      (dl-api-test-set! "constant-in-head data"
        (dl-query
          (dl-program-data
            (quote ((edge a b) (edge b c) (edge c a)))
            (quote
              ((reach X Y <- (edge X Y))
               (reach X Z <- (edge X Y) (reach Y Z)))))
          (quote (reach a X)))
        (list {:X (quote a)} {:X (quote b)} {:X (quote c)}))
      ;; Assert into empty db.
      (dl-api-test-set! "assert into empty"
        (let
          ((db (dl-program-data (list) (list))))
          (do
            (dl-assert! db (quote (p 1)))
            (dl-assert! db (quote (p 2)))
            (dl-query db (quote (p X)))))
        (list {:X 1} {:X 2}))
      ;; Multi-goal query: pass list of literals.
      (dl-api-test-set! "multi-goal query"
        (dl-query
          (dl-program-data
            (quote ((p 1) (p 2) (p 3) (q 2) (q 3)))
            (list))
          (list (quote (p X)) (quote (q X))))
        (list {:X 2} {:X 3}))
      ;; Multi-goal with comparison.
      (dl-api-test-set! "multi-goal with comparison"
        (dl-query
          (dl-program-data
            (quote ((n 1) (n 2) (n 3) (n 4) (n 5)))
            (list))
          (list (quote (n X)) (list (string->symbol ">") (quote X) 2)))
        (list {:X 3} {:X 4} {:X 5}))
      ;; dl-eval: single-call source + query.
      (dl-api-test-set! "dl-eval ancestor"
        (dl-eval
          "parent(a, b). parent(b, c).
           ancestor(X, Y) :- parent(X, Y).
           ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z)."
          "?- ancestor(a, X).")
        (list {:X (quote b)} {:X (quote c)}))
      (dl-api-test-set! "dl-eval multi-goal"
        (dl-eval
          "p(1). p(2). p(3). q(2). q(3)."
          "?- p(X), q(X).")
        (list {:X 2} {:X 3}))
      ;; Comprehensive integration: recursion + stratified negation
      ;; + aggregation + comparison composed in a single program.
      ;; (Uses _Anything as a regular var instead of `_` so the
      ;;  outer rule binds via the reach lit.)
      (dl-api-test-set! "integration"
        (dl-eval
          (str
            "edge(a, b). edge(b, c). edge(c, d). edge(a, d). "
            "banned(c). "
            "reach(X, Y) :- edge(X, Y). "
            "reach(X, Z) :- edge(X, Y), reach(Y, Z). "
            "safe(X, Y) :- reach(X, Y), not(banned(Y)). "
            "reach_count(X, N) :- reach(X, Z), count(N, Y, safe(X, Y)). "
            "popular(X) :- reach_count(X, N), >=(N, 2).")
          "?- popular(X).")
        (list {:X (quote a)}))
      ;; dl-rule-from-list with no arrow → fact-style.
      (dl-api-test-set! "no arrow → fact-like rule"
        (let
          ((rule (dl-rule-from-list (quote (foo X Y)))))
          (list rule))
        (list {:head (quote (foo X Y)) :body (list)}))
      ;; dl-coerce-rule on dict passes through.
      (dl-api-test-set! "coerce dict rule"
        (let
          ((d {:head (quote (h X)) :body (quote ((b X)))}))
          (list (dl-coerce-rule d)))
        (list {:head (quote (h X)) :body (quote ((b X)))})))))
 (define
  dl-api-tests-run!
  (fn
    ()
    (do
      (set! dl-api-pass 0)
      (set! dl-api-fail 0)
      (set! dl-api-failures (list))
      (dl-api-run-all!)
      {:passed dl-api-pass
       :failed dl-api-fail
       :total (+ dl-api-pass dl-api-fail)
       :failures dl-api-failures})))
--- a/lib/datalog/tests/builtins.sx
+++ b/lib/datalog/tests/builtins.sx
@@ -1,228 +0,0 @@
 ;; lib/datalog/tests/builtins.sx — comparison + arithmetic body literals.
 (define dl-bt-pass 0)
 (define dl-bt-fail 0)
 (define dl-bt-failures (list))
 (define
  dl-bt-deep=?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-bt-deq-l? a b 0)))
      ((and (dict? a) (dict? b))
        (let
          ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-bt-deq-d? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-bt-deq-l?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-bt-deep=? (nth a i) (nth b i))) false)
      (else (dl-bt-deq-l? a b (+ i 1))))))
 (define
  dl-bt-deq-d?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i))) (not (dl-bt-deep=? (get a k) (get b k))))
        false)
      (else (dl-bt-deq-d? a b ka (+ i 1))))))
 (define
  dl-bt-set=?
  (fn
    (a b)
    (and (= (len a) (len b)) (dl-bt-subset? a b) (dl-bt-subset? b a))))
 (define
  dl-bt-subset?
  (fn
    (xs ys)
    (cond
      ((= (len xs) 0) true)
      ((not (dl-bt-contains? ys (first xs))) false)
      (else (dl-bt-subset? (rest xs) ys)))))
 (define
  dl-bt-contains?
  (fn
    (xs target)
    (cond
      ((= (len xs) 0) false)
      ((dl-bt-deep=? (first xs) target) true)
      (else (dl-bt-contains? (rest xs) target)))))
 (define
  dl-bt-test-set!
  (fn
    (name got expected)
    (if
      (dl-bt-set=? got expected)
      (set! dl-bt-pass (+ dl-bt-pass 1))
      (do
        (set! dl-bt-fail (+ dl-bt-fail 1))
        (append!
          dl-bt-failures
          (str
            name
            "\n    expected (set): "
            expected
            "\n    got:            "
            got))))))
 (define
  dl-bt-test!
  (fn
    (name got expected)
    (if
      (dl-bt-deep=? got expected)
      (set! dl-bt-pass (+ dl-bt-pass 1))
      (do
        (set! dl-bt-fail (+ dl-bt-fail 1))
        (append!
          dl-bt-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))
 (define
  dl-bt-throws?
  (fn
    (thunk)
    (let
      ((threw false))
      (do (guard (e (#t (set! threw true))) (thunk)) threw))))
 (define
  dl-bt-run-all!
  (fn
    ()
    (do
      (dl-bt-test-set!
        "less than filter"
        (dl-query
          (dl-program
            "age(alice, 30). age(bob, 17). age(carol, 22).\n             adult(X) :- age(X, A), >=(A, 18).")
          (list (quote adult) (quote X)))
        (list {:X (quote alice)} {:X (quote carol)}))
      (dl-bt-test-set!
        "less-equal filter"
        (dl-query
          (dl-program
            "n(1). n(2). n(3). n(4). n(5).\n             small(X) :- n(X), <=(X, 3).")
          (list (quote small) (quote X)))
        (list {:X 1} {:X 2} {:X 3}))
      (dl-bt-test-set!
        "not-equal filter"
        (dl-query
          (dl-program
            "p(1, 2). p(2, 2). p(3, 4).\n             diff(X, Y) :- p(X, Y), !=(X, Y).")
          (list (quote diff) (quote X) (quote Y)))
        (list {:X 1 :Y 2} {:X 3 :Y 4}))
      (dl-bt-test-set!
        "is plus"
        (dl-query
          (dl-program
            "n(1). n(2). n(3).\n             succ(X, Y) :- n(X), is(Y, +(X, 1)).")
          (list (quote succ) (quote X) (quote Y)))
        (list {:X 1 :Y 2} {:X 2 :Y 3} {:X 3 :Y 4}))
      (dl-bt-test-set!
        "is multiply"
        (dl-query
          (dl-program
            "n(2). n(3). n(4).\n             square(X, Y) :- n(X), is(Y, *(X, X)).")
          (list (quote square) (quote X) (quote Y)))
        (list {:X 2 :Y 4} {:X 3 :Y 9} {:X 4 :Y 16}))
      (dl-bt-test-set!
        "is nested expr"
        (dl-query
          (dl-program
            "n(1). n(2). n(3).\n             f(X, Y) :- n(X), is(Y, *(+(X, 1), 2)).")
          (list (quote f) (quote X) (quote Y)))
        (list {:X 1 :Y 4} {:X 2 :Y 6} {:X 3 :Y 8}))
      (dl-bt-test-set!
        "is bound LHS — equality"
        (dl-query
          (dl-program
            "n(1, 2). n(2, 5). n(3, 4).\n             succ(X, Y) :- n(X, Y), is(Y, +(X, 1)).")
          (list (quote succ) (quote X) (quote Y)))
        (list {:X 1 :Y 2} {:X 3 :Y 4}))
      (dl-bt-test-set!
        "triple via is"
        (dl-query
          (dl-program
            "n(1). n(2). n(3).\n             triple(X, Y) :- n(X), is(Y, *(X, 3)).")
          (list (quote triple) (quote X) (quote Y)))
        (list {:X 1 :Y 3} {:X 2 :Y 6} {:X 3 :Y 9}))
      (dl-bt-test-set!
        "= unifies var with constant"
        (dl-query
          (dl-program "p(a). p(b).\n             qual(X) :- p(X), =(X, a).")
          (list (quote qual) (quote X)))
        (list {:X (quote a)}))
      (dl-bt-test-set!
        "= unifies two vars (one bound)"
        (dl-query
          (dl-program "p(a). p(b).\n             twin(X, Y) :- p(X), =(Y, X).")
          (list (quote twin) (quote X) (quote Y)))
        (list {:X (quote a) :Y (quote a)} {:X (quote b) :Y (quote b)}))
      (dl-bt-test!
        "big count"
        (let
          ((db (dl-program "n(0). n(1). n(2). n(3). n(4). n(5). n(6). n(7). n(8). n(9).\n                  big(X) :- n(X), >=(X, 5).")))
          (do (dl-saturate! db) (len (dl-relation db "big"))))
        5)
      (dl-bt-test!
        "unsafe — comparison without binder"
        (dl-bt-throws? (fn () (dl-program "p(X) :- <(X, 5).")))
        true)
      (dl-bt-test!
        "unsafe — comparison both unbound"
        (dl-bt-throws? (fn () (dl-program "p(X, Y) :- <(X, Y), q(X).")))
        true)
      (dl-bt-test!
        "unsafe — is uses unbound RHS var"
        (dl-bt-throws?
          (fn () (dl-program "p(X, Y) :- q(X), is(Y, +(X, Z)).")))
        true)
      (dl-bt-test!
        "unsafe — is on its own"
        (dl-bt-throws? (fn () (dl-program "p(Y) :- is(Y, +(X, 1)).")))
        true)
      (dl-bt-test!
        "unsafe — = between two unbound"
        (dl-bt-throws? (fn () (dl-program "p(X, Y) :- =(X, Y).")))
        true)
      (dl-bt-test!
        "safe — is binds head var"
        (dl-bt-throws?
          (fn () (dl-program "n(1). p(Y) :- n(X), is(Y, +(X, 1)).")))
        false)
      (dl-bt-test!
        "safe — comparison after binder"
        (dl-bt-throws?
          (fn () (dl-program "n(1). big(X) :- n(X), >=(X, 0).")))
        false)
      (dl-bt-test!
        "safe — = binds head var"
        (dl-bt-throws?
          (fn () (dl-program "p(a). p(b). x(Y) :- p(X), =(Y, X).")))
        false))))
 (define
  dl-builtins-tests-run!
  (fn
    ()
    (do
      (set! dl-bt-pass 0)
      (set! dl-bt-fail 0)
      (set! dl-bt-failures (list))
      (dl-bt-run-all!)
      {:failures dl-bt-failures :total (+ dl-bt-pass dl-bt-fail) :passed dl-bt-pass :failed dl-bt-fail})))
--- a/lib/datalog/tests/demo.sx
+++ b/lib/datalog/tests/demo.sx
@@ -1,285 +0,0 @@
 ;; lib/datalog/tests/demo.sx — Phase 10 demo programs.
 (define dl-demo-pass 0)
 (define dl-demo-fail 0)
 (define dl-demo-failures (list))
 (define
  dl-demo-deep=?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-demo-deq-l? a b 0)))
      ((and (dict? a) (dict? b))
        (let ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-demo-deq-d? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-demo-deq-l?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-demo-deep=? (nth a i) (nth b i))) false)
      (else (dl-demo-deq-l? a b (+ i 1))))))
 (define
  dl-demo-deq-d?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i)))
         (not (dl-demo-deep=? (get a k) (get b k))))
        false)
      (else (dl-demo-deq-d? a b ka (+ i 1))))))
 (define
  dl-demo-set=?
  (fn
    (a b)
    (and
      (= (len a) (len b))
      (dl-demo-subset? a b)
      (dl-demo-subset? b a))))
 (define
  dl-demo-subset?
  (fn
    (xs ys)
    (cond
      ((= (len xs) 0) true)
      ((not (dl-demo-contains? ys (first xs))) false)
      (else (dl-demo-subset? (rest xs) ys)))))
 (define
  dl-demo-contains?
  (fn
    (xs target)
    (cond
      ((= (len xs) 0) false)
      ((dl-demo-deep=? (first xs) target) true)
      (else (dl-demo-contains? (rest xs) target)))))
 (define
  dl-demo-test-set!
  (fn
    (name got expected)
    (if
      (dl-demo-set=? got expected)
      (set! dl-demo-pass (+ dl-demo-pass 1))
      (do
        (set! dl-demo-fail (+ dl-demo-fail 1))
        (append!
          dl-demo-failures
          (str
            name
            "\n    expected (set): " expected
            "\n    got:            " got))))))
 (define
  dl-demo-run-all!
  (fn
    ()
    (do
      ;; ── Federation ──────────────────────────────────────────
      (dl-demo-test-set! "mutuals"
        (dl-query
          (dl-demo-make
            (quote ((follows alice bob) (follows bob alice)
                    (follows bob carol) (follows carol dave)))
            dl-demo-federation-rules)
          (quote (mutual alice X)))
        (list {:X (quote bob)}))
      (dl-demo-test-set! "reachable transitive"
        (dl-query
          (dl-demo-make
            (quote ((follows alice bob) (follows bob carol) (follows carol dave)))
            dl-demo-federation-rules)
          (quote (reachable alice X)))
        (list {:X (quote bob)} {:X (quote carol)} {:X (quote dave)}))
      (dl-demo-test-set! "foaf"
        (dl-query
          (dl-demo-make
            (quote ((follows alice bob) (follows bob carol) (follows alice dave)))
            dl-demo-federation-rules)
          (quote (foaf alice X)))
        (list {:X (quote carol)}))
      ;; ── Content ─────────────────────────────────────────────
      (dl-demo-test-set! "popular posts"
        (dl-query
          (dl-demo-make
            (quote
              ((authored alice p1) (authored bob p2) (authored carol p3)
               (liked u1 p1) (liked u2 p1) (liked u3 p1)
               (liked u1 p2)))
            dl-demo-content-rules)
          (quote (popular P)))
        (list {:P (quote p1)}))
      (dl-demo-test-set! "interesting feed"
        (dl-query
          (dl-demo-make
            (quote
              ((follows me alice) (follows me bob)
               (authored alice p1) (authored bob p2)
               (liked u1 p1) (liked u2 p1) (liked u3 p1)
               (liked u4 p2)))
            dl-demo-content-rules)
          (quote (interesting me P)))
        (list {:P (quote p1)}))
      (dl-demo-test-set! "post likes count"
        (dl-query
          (dl-demo-make
            (quote
              ((authored alice p1)
               (liked u1 p1) (liked u2 p1) (liked u3 p1)))
            dl-demo-content-rules)
          (quote (post-likes p1 N)))
        (list {:N 3}))
      ;; ── Permissions ─────────────────────────────────────────
      (dl-demo-test-set! "direct group access"
        (dl-query
          (dl-demo-make
            (quote
              ((member alice editors)
               (allowed editors blog)))
            dl-demo-perm-rules)
          (quote (can-access X blog)))
        (list {:X (quote alice)}))
      (dl-demo-test-set! "subgroup access"
        (dl-query
          (dl-demo-make
            (quote
              ((member bob writers)
               (subgroup writers editors)
               (allowed editors blog)))
            dl-demo-perm-rules)
          (quote (can-access X blog)))
        (list {:X (quote bob)}))
      (dl-demo-test-set! "transitive subgroup"
        (dl-query
          (dl-demo-make
            (quote
              ((member carol drafters)
               (subgroup drafters writers)
               (subgroup writers editors)
               (allowed editors blog)))
            dl-demo-perm-rules)
          (quote (can-access X blog)))
        (list {:X (quote carol)}))
      ;; ── Cooking posts (canonical Phase 10 example) ─────────
      (dl-demo-test-set! "cooking posts by network"
        (dl-query
          (dl-demo-make
            (quote
              ((follows me alice) (follows alice bob) (follows alice carol)
               (authored alice p1) (authored bob p2)
               (authored carol p3) (authored carol p4)
               (tagged p1 travel) (tagged p2 cooking)
               (tagged p3 cooking) (tagged p4 books)))
            dl-demo-cooking-rules)
          (quote (cooking-post-by-network me P)))
        (list {:P (quote p2)} {:P (quote p3)}))
      (dl-demo-test-set! "cooking — direct follow only"
        (dl-query
          (dl-demo-make
            (quote
              ((follows me bob)
               (authored bob p1) (authored bob p2)
               (tagged p1 cooking) (tagged p2 books)))
            dl-demo-cooking-rules)
          (quote (cooking-post-by-network me P)))
        (list {:P (quote p1)}))
      (dl-demo-test-set! "cooking — none in network"
        (dl-query
          (dl-demo-make
            (quote
              ((follows me bob)
               (authored bob p1) (tagged p1 books)))
            dl-demo-cooking-rules)
          (quote (cooking-post-by-network me P)))
        (list))
      ;; ── Tag co-occurrence ──────────────────────────────────
      (dl-demo-test-set! "cotagged posts"
        (dl-query
          (dl-demo-make
            (quote
              ((tagged p1 cooking) (tagged p1 vegetarian)
               (tagged p2 cooking) (tagged p2 quick)
               (tagged p3 vegetarian)))
            dl-demo-tag-cooccur-rules)
          (quote (cotagged P cooking vegetarian)))
        (list {:P (quote p1)}))
      (dl-demo-test-set! "tag pair count"
        (dl-query
          (dl-demo-make
            (quote
              ((tagged p1 cooking) (tagged p1 vegetarian)
               (tagged p2 cooking) (tagged p2 quick)
               (tagged p3 cooking) (tagged p3 vegetarian)))
            dl-demo-tag-cooccur-rules)
          (quote (tag-pair-count cooking vegetarian N)))
        (list {:N 2}))
      ;; ── Shortest path on a weighted DAG ──────────────────
      (dl-demo-test-set! "shortest a→d via DAG"
        (dl-query
          (dl-demo-make
            (quote ((edge a b 5) (edge b c 3) (edge a c 10) (edge c d 2)))
            dl-demo-shortest-path-rules)
          (quote (shortest a d W)))
        (list {:W 10}))
      (dl-demo-test-set! "shortest a→c picks 2-hop"
        (dl-query
          (dl-demo-make
            (quote ((edge a b 5) (edge b c 3) (edge a c 10)))
            dl-demo-shortest-path-rules)
          (quote (shortest a c W)))
        (list {:W 8}))
      (dl-demo-test-set! "shortest unreachable empty"
        (dl-query
          (dl-demo-make
            (quote ((edge a b 5) (edge b c 3)))
            dl-demo-shortest-path-rules)
          (quote (shortest a d W)))
        (list))
      (dl-demo-test-set! "no access without grant"
        (dl-query
          (dl-demo-make
            (quote ((member dave outsiders) (allowed editors blog)))
            dl-demo-perm-rules)
          (quote (can-access X blog)))
        (list)))))
 (define
  dl-demo-tests-run!
  (fn
    ()
    (do
      (set! dl-demo-pass 0)
      (set! dl-demo-fail 0)
      (set! dl-demo-failures (list))
      (dl-demo-run-all!)
      {:passed dl-demo-pass
       :failed dl-demo-fail
       :total (+ dl-demo-pass dl-demo-fail)
       :failures dl-demo-failures})))
--- a/lib/datalog/tests/eval.sx
+++ b/lib/datalog/tests/eval.sx
@@ -1,281 +0,0 @@
 ;; lib/datalog/tests/eval.sx — naive evaluation + safety analysis tests.
 (define dl-et-pass 0)
 (define dl-et-fail 0)
 (define dl-et-failures (list))
 ;; Same deep-equal helper used in other suites.
 (define
  dl-et-deep=?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-et-deq-l? a b 0)))
      ((and (dict? a) (dict? b))
        (let
          ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-et-deq-d? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-et-deq-l?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-et-deep=? (nth a i) (nth b i))) false)
      (else (dl-et-deq-l? a b (+ i 1))))))
 (define
  dl-et-deq-d?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i))) (not (dl-et-deep=? (get a k) (get b k))))
        false)
      (else (dl-et-deq-d? a b ka (+ i 1))))))
 ;; Set-equality on lists (order-independent, uses dl-et-deep=?).
 (define
  dl-et-set=?
  (fn
    (a b)
    (and (= (len a) (len b)) (dl-et-subset? a b) (dl-et-subset? b a))))
 (define
  dl-et-subset?
  (fn
    (xs ys)
    (cond
      ((= (len xs) 0) true)
      ((not (dl-et-contains? ys (first xs))) false)
      (else (dl-et-subset? (rest xs) ys)))))
 (define
  dl-et-contains?
  (fn
    (xs target)
    (cond
      ((= (len xs) 0) false)
      ((dl-et-deep=? (first xs) target) true)
      (else (dl-et-contains? (rest xs) target)))))
 (define
  dl-et-test!
  (fn
    (name got expected)
    (if
      (dl-et-deep=? got expected)
      (set! dl-et-pass (+ dl-et-pass 1))
      (do
        (set! dl-et-fail (+ dl-et-fail 1))
        (append!
          dl-et-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))
 (define
  dl-et-test-set!
  (fn
    (name got expected)
    (if
      (dl-et-set=? got expected)
      (set! dl-et-pass (+ dl-et-pass 1))
      (do
        (set! dl-et-fail (+ dl-et-fail 1))
        (append!
          dl-et-failures
          (str
            name
            "\n    expected (set): "
            expected
            "\n    got:            "
            got))))))
 (define
  dl-et-throws?
  (fn
    (thunk)
    (let
      ((threw false))
      (do (guard (e (#t (set! threw true))) (thunk)) threw))))
 (define
  dl-et-run-all!
  (fn
    ()
    (do
      (dl-et-test-set!
        "fact lookup any"
        (dl-query
          (dl-program "parent(tom, bob). parent(bob, ann).")
          (list (quote parent) (quote X) (quote Y)))
        (list {:X (quote tom) :Y (quote bob)} {:X (quote bob) :Y (quote ann)}))
      (dl-et-test-set!
        "fact lookup constant arg"
        (dl-query
          (dl-program "parent(tom, bob). parent(tom, liz). parent(bob, ann).")
          (list (quote parent) (quote tom) (quote Y)))
        (list {:Y (quote bob)} {:Y (quote liz)}))
      (dl-et-test-set!
        "no match"
        (dl-query
          (dl-program "parent(tom, bob).")
          (list (quote parent) (quote nobody) (quote X)))
        (list))
      (dl-et-test-set!
        "ancestor closure"
        (dl-query
          (dl-program
            "parent(tom, bob). parent(bob, ann). parent(ann, pat).\n             ancestor(X, Y) :- parent(X, Y).\n             ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")
          (list (quote ancestor) (quote tom) (quote X)))
        (list {:X (quote bob)} {:X (quote ann)} {:X (quote pat)}))
      (dl-et-test-set!
        "sibling"
        (dl-query
          (dl-program
            "parent(tom, bob). parent(tom, liz). parent(jane, bob). parent(jane, liz).\n             sibling(X, Y) :- parent(P, X), parent(P, Y).")
          (list (quote sibling) (quote bob) (quote Y)))
        (list {:Y (quote bob)} {:Y (quote liz)}))
      (dl-et-test-set!
        "same-generation"
        (dl-query
          (dl-program
            "parent(tom, bob). parent(tom, liz). parent(bob, ann). parent(liz, joe).\n             person(tom). person(bob). person(liz). person(ann). person(joe).\n             sg(X, X) :- person(X).\n             sg(X, Y) :- parent(P1, X), sg(P1, P2), parent(P2, Y).")
          (list (quote sg) (quote ann) (quote X)))
        (list {:X (quote ann)} {:X (quote joe)}))
      (dl-et-test!
        "ancestor count"
        (let
          ((db (dl-program "parent(a, b). parent(b, c). parent(c, d).\n                  ancestor(X, Y) :- parent(X, Y).\n                  ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))
          (do (dl-saturate! db) (len (dl-relation db "ancestor"))))
        6)
      (dl-et-test-set!
        "grandparent"
        (dl-query
          (dl-program
            "parent(a, b). parent(b, c). parent(c, d).\n             grandparent(X, Z) :- parent(X, Y), parent(Y, Z).")
          (list (quote grandparent) (quote X) (quote Y)))
        (list {:X (quote a) :Y (quote c)} {:X (quote b) :Y (quote d)}))
      (dl-et-test!
        "no recursion infinite loop"
        (let
          ((db (dl-program "edge(1, 2). edge(2, 3). edge(3, 1).\n                  reach(X, Y) :- edge(X, Y).\n                  reach(X, Z) :- edge(X, Y), reach(Y, Z).")))
          (do (dl-saturate! db) (len (dl-relation db "reach"))))
        9)
      (dl-et-test!
        "unsafe head var"
        (dl-et-throws? (fn () (dl-program "p(X, Y) :- q(X).")))
        true)
      (dl-et-test!
        "unsafe — empty body"
        (dl-et-throws? (fn () (dl-program "p(X) :- .")))
        true)
      ;; Underscore in head is unsafe — it's a fresh existential per
      ;; occurrence after Phase 5d's anonymous-var renaming, and there's
      ;; nothing in the body to bind it. (Old behavior accepted this by
      ;; treating '_' as a literal name to skip; the renaming made it an
      ;; ordinary unbound variable.)
      (dl-et-test!
        "underscore in head — unsafe"
        (dl-et-throws? (fn () (dl-program "p(X, _) :- q(X).")))
        true)
      (dl-et-test!
        "underscore in body only — safe"
        (dl-et-throws? (fn () (dl-program "p(X) :- q(X, _).")))
        false)
      (dl-et-test!
        "var only in head — unsafe"
        (dl-et-throws? (fn () (dl-program "p(X, Y) :- q(Z).")))
        true)
      (dl-et-test!
        "head var bound by body"
        (dl-et-throws? (fn () (dl-program "p(X) :- q(X).")))
        false)
      (dl-et-test!
        "head subset of body"
        (dl-et-throws?
          (fn
            ()
            (dl-program
              "edge(a,b). edge(b,c). reach(X, Z) :- edge(X, Y), edge(Y, Z).")))
        false)
      ;; Anonymous variables: each occurrence must be independent.
      (dl-et-test-set! "anon vars in rule are independent"
        (dl-query
          (dl-program
            "p(a, b). p(c, d). q(X) :- p(X, _), p(_, Y).")
          (list (quote q) (quote X)))
        (list {:X (quote a)} {:X (quote c)}))
      (dl-et-test-set! "anon vars in goal are independent"
        (dl-query
          (dl-program "p(1, 2, 3). p(4, 5, 6).")
          (list (quote p) (quote _) (quote X) (quote _)))
        (list {:X 2} {:X 5}))
      ;; dl-summary: relation -> tuple-count for inspection.
      (dl-et-test! "dl-summary basic"
        (dl-summary
          (let
            ((db (dl-program "p(1). p(2). q(3).")))
            (do (dl-saturate! db) db)))
        {:p 2 :q 1})
      (dl-et-test! "dl-summary empty IDB shown"
        (dl-summary
          (let
            ((db (dl-program "r(X) :- s(X).")))
            (do (dl-saturate! db) db)))
        {:r 0})
      (dl-et-test! "dl-summary mixed EDB and IDB"
        (dl-summary
          (let
            ((db (dl-program
                   "parent(a, b).
                    ancestor(X, Y) :- parent(X, Y).
                    ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))
            (do (dl-saturate! db) db)))
        {:parent 1 :ancestor 1})
      (dl-et-test! "dl-summary empty db"
        (dl-summary (dl-make-db))
        {})
      ;; Strategy hook: default semi-naive; :magic accepted but
      ;; falls back to semi-naive (the transformation itself is
      ;; deferred — Phase 6 in plan).
      (dl-et-test! "default strategy"
        (dl-get-strategy (dl-make-db))
        :semi-naive)
      (dl-et-test! "set strategy"
        (let ((db (dl-make-db)))
          (do (dl-set-strategy! db :magic) (dl-get-strategy db)))
        :magic)
      (dl-et-test-set! "magic-set still derives correctly"
        (let
          ((db (dl-program
                 "parent(a, b). parent(b, c).
                  ancestor(X, Y) :- parent(X, Y).
                  ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))
          (do
            (dl-set-strategy! db :magic)
            (dl-query db (list (quote ancestor) (quote a) (quote X)))))
        (list {:X (quote b)} {:X (quote c)})))))
 (define
  dl-eval-tests-run!
  (fn
    ()
    (do
      (set! dl-et-pass 0)
      (set! dl-et-fail 0)
      (set! dl-et-failures (list))
      (dl-et-run-all!)
      {:failures dl-et-failures :total (+ dl-et-pass dl-et-fail) :passed dl-et-pass :failed dl-et-fail})))
--- a/lib/datalog/tests/magic.sx
+++ b/lib/datalog/tests/magic.sx
@@ -1,286 +0,0 @@
 ;; lib/datalog/tests/magic.sx — adornment + SIPS analysis tests.
 (define dl-mt-pass 0)
 (define dl-mt-fail 0)
 (define dl-mt-failures (list))
 (define
  dl-mt-deep=?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-mt-deq-l? a b 0)))
      ((and (dict? a) (dict? b))
        (let ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-mt-deq-d? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-mt-deq-l?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-mt-deep=? (nth a i) (nth b i))) false)
      (else (dl-mt-deq-l? a b (+ i 1))))))
 (define
  dl-mt-deq-d?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i)))
         (not (dl-mt-deep=? (get a k) (get b k))))
        false)
      (else (dl-mt-deq-d? a b ka (+ i 1))))))
 (define
  dl-mt-test!
  (fn
    (name got expected)
    (if
      (dl-mt-deep=? got expected)
      (set! dl-mt-pass (+ dl-mt-pass 1))
      (do
        (set! dl-mt-fail (+ dl-mt-fail 1))
        (append!
          dl-mt-failures
          (str
            name
            "\n    expected: " expected
            "\n    got:      " got))))))
 (define
  dl-mt-run-all!
  (fn
    ()
    (do
      ;; Goal adornment.
      (dl-mt-test! "adorn 0-ary"
        (dl-adorn-goal (list (quote ready)))
        "")
      (dl-mt-test! "adorn all bound"
        (dl-adorn-goal (list (quote p) 1 2 3))
        "bbb")
      (dl-mt-test! "adorn all free"
        (dl-adorn-goal (list (quote p) (quote X) (quote Y)))
        "ff")
      (dl-mt-test! "adorn mixed"
        (dl-adorn-goal (list (quote ancestor) (quote tom) (quote X)))
        "bf")
      (dl-mt-test! "adorn const var const"
        (dl-adorn-goal (list (quote p) (quote a) (quote X) (quote b)))
        "bfb")
      ;; dl-adorn-lit with explicit bound set.
      (dl-mt-test! "adorn lit with bound"
        (dl-adorn-lit (list (quote p) (quote X) (quote Y)) (list "X"))
        "bf")
      ;; Rule SIPS — chain ancestor.
      (dl-mt-test! "sips chain ancestor bf"
        (dl-rule-sips
          {:head (list (quote ancestor) (quote X) (quote Z))
           :body (list (list (quote parent) (quote X) (quote Y))
                       (list (quote ancestor) (quote Y) (quote Z)))}
          "bf")
        (list
          {:lit (list (quote parent) (quote X) (quote Y)) :adornment "bf"}
          {:lit (list (quote ancestor) (quote Y) (quote Z)) :adornment "bf"}))
      ;; SIPS — head fully bound.
      (dl-mt-test! "sips head bb"
        (dl-rule-sips
          {:head (list (quote q) (quote X) (quote Y))
           :body (list (list (quote p) (quote X) (quote Z))
                       (list (quote r) (quote Z) (quote Y)))}
          "bb")
        (list
          {:lit (list (quote p) (quote X) (quote Z)) :adornment "bf"}
          {:lit (list (quote r) (quote Z) (quote Y)) :adornment "bb"}))
      ;; SIPS — comparison; vars must be bound by prior body lit.
      (dl-mt-test! "sips with comparison"
        (dl-rule-sips
          {:head (list (quote q) (quote X))
           :body (list (list (quote p) (quote X))
                       (list (string->symbol "<") (quote X) 5))}
          "f")
        (list
          {:lit (list (quote p) (quote X)) :adornment "f"}
          {:lit (list (string->symbol "<") (quote X) 5) :adornment "bb"}))
      ;; SIPS — `is` binds its left arg.
      (dl-mt-test! "sips with is"
        (dl-rule-sips
          {:head (list (quote q) (quote X) (quote Y))
           :body (list (list (quote p) (quote X))
                       (list (quote is) (quote Y) (list (string->symbol "+") (quote X) 1)))}
          "ff")
        (list
          {:lit (list (quote p) (quote X)) :adornment "f"}
          {:lit (list (quote is) (quote Y)
                      (list (string->symbol "+") (quote X) 1))
           :adornment "fb"}))
      ;; Magic predicate naming.
      (dl-mt-test! "magic-rel-name"
        (dl-magic-rel-name "ancestor" "bf")
        "magic_ancestor^bf")
      ;; Bound-args extraction.
      (dl-mt-test! "bound-args bf"
        (dl-bound-args (list (quote ancestor) (quote tom) (quote X)) "bf")
        (list (quote tom)))
      (dl-mt-test! "bound-args mixed"
        (dl-bound-args (list (quote p) 1 (quote Y) 3) "bfb")
        (list 1 3))
      (dl-mt-test! "bound-args all-free"
        (dl-bound-args (list (quote p) (quote X) (quote Y)) "ff")
        (list))
      ;; Magic literal construction.
      (dl-mt-test! "magic-lit"
        (dl-magic-lit "ancestor" "bf" (list (quote tom)))
        (list (string->symbol "magic_ancestor^bf") (quote tom)))
      ;; Magic-sets rewriter: structural sanity.
      (dl-mt-test! "rewrite ancestor produces seed"
        (let
          ((rules
             (list
               {:head (list (quote ancestor) (quote X) (quote Y))
                :body (list (list (quote parent) (quote X) (quote Y)))}
               {:head (list (quote ancestor) (quote X) (quote Z))
                :body
                (list (list (quote parent) (quote X) (quote Y))
                      (list (quote ancestor) (quote Y) (quote Z)))})))
          (get
            (dl-magic-rewrite rules "ancestor" "bf" (list (quote a)))
            :seed))
        (list (string->symbol "magic_ancestor^bf") (quote a)))
      ;; Equivalence: rewritten program derives same ancestor tuples.
      ;; In a chain a→b→c→d, magic-rewritten run still derives all
      ;; ancestor pairs reachable from any node a/b/c/d propagated via
      ;; magic_ancestor^bf — i.e. the full closure (6 tuples). Magic
      ;; saves work only when the EDB has irrelevant nodes outside
      ;; the seed's transitive cone.
      (dl-mt-test! "magic-rewritten ancestor count"
        (let
          ((rules
             (list
               {:head (list (quote ancestor) (quote X) (quote Y))
                :body (list (list (quote parent) (quote X) (quote Y)))}
               {:head (list (quote ancestor) (quote X) (quote Z))
                :body
                (list (list (quote parent) (quote X) (quote Y))
                      (list (quote ancestor) (quote Y) (quote Z)))}))
            (edb (list
                   (list (quote parent) (quote a) (quote b))
                   (list (quote parent) (quote b) (quote c))
                   (list (quote parent) (quote c) (quote d)))))
          (let
            ((rewritten (dl-magic-rewrite rules "ancestor" "bf" (list (quote a))))
              (db (dl-make-db)))
            (do
              (for-each (fn (f) (dl-add-fact! db f)) edb)
              (dl-add-fact! db (get rewritten :seed))
              (for-each (fn (r) (dl-add-rule! db r)) (get rewritten :rules))
              (dl-saturate! db)
              (len (dl-relation db "ancestor")))))
        6)
      ;; dl-magic-query: end-to-end driver, doesn't mutate caller's db.
      (dl-mt-test! "magic-query equivalent to dl-query"
        (let
          ((db (dl-program
                 "parent(a, b). parent(b, c). parent(c, d).
                  ancestor(X, Y) :- parent(X, Y).
                  ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))
          (let
            ((semi (dl-query db (list (quote ancestor) (quote a) (quote X))))
              (magic (dl-magic-query
                       db (list (quote ancestor) (quote a) (quote X)))))
            (= (len semi) (len magic))))
        true)
      ;; magic-query doesn't mutate caller db.
      (dl-mt-test! "magic-query preserves caller db"
        (let
          ((db (dl-program
                 "parent(a, b). parent(b, c).
                  ancestor(X, Y) :- parent(X, Y).
                  ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))
          (let
            ((rules-before (len (dl-rules db))))
            (do
              (dl-magic-query db (list (quote ancestor) (quote a) (quote X)))
              (= rules-before (len (dl-rules db))))))
        true)
      ;; Magic-sets benefit: query touches only one cluster of a
      ;; multi-component graph. Semi-naive derives the full closure
      ;; over both clusters; magic only the seeded one.
      (dl-mt-test! "magic skips irrelevant clusters"
        (let
          ;; Two disjoint chains. Query is rooted in cluster 1.
          ((db (dl-program
                 "parent(a, b). parent(b, c).
                  parent(x, y). parent(y, z).
                  ancestor(X, Y) :- parent(X, Y).
                  ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))
          (do
            (dl-saturate! db)
            (let
              ((semi-count (len (dl-relation db "ancestor")))
                (magic-results
                  (dl-magic-query
                    db (list (quote ancestor) (quote a) (quote X)))))
              ;; Semi-naive derives 6 (3 in each cluster). Magic
              ;; gives 3 query results (a's reachable: b, c).
              (and (= semi-count 6) (= (len magic-results) 2)))))
        true)
      (dl-mt-test! "magic-rewritten finds same answers"
        (let
          ((rules
             (list
               {:head (list (quote ancestor) (quote X) (quote Y))
                :body (list (list (quote parent) (quote X) (quote Y)))}
               {:head (list (quote ancestor) (quote X) (quote Z))
                :body
                (list (list (quote parent) (quote X) (quote Y))
                      (list (quote ancestor) (quote Y) (quote Z)))}))
            (edb (list
                   (list (quote parent) (quote a) (quote b))
                   (list (quote parent) (quote b) (quote c)))))
          (let
            ((rewritten (dl-magic-rewrite rules "ancestor" "bf" (list (quote a))))
              (db (dl-make-db)))
            (do
              (for-each (fn (f) (dl-add-fact! db f)) edb)
              (dl-add-fact! db (get rewritten :seed))
              (for-each (fn (r) (dl-add-rule! db r)) (get rewritten :rules))
              (dl-saturate! db)
              (len (dl-query db (list (quote ancestor) (quote a) (quote X)))))))
        2))))
 (define
  dl-magic-tests-run!
  (fn
    ()
    (do
      (set! dl-mt-pass 0)
      (set! dl-mt-fail 0)
      (set! dl-mt-failures (list))
      (dl-mt-run-all!)
      {:passed dl-mt-pass
       :failed dl-mt-fail
       :total (+ dl-mt-pass dl-mt-fail)
       :failures dl-mt-failures})))
--- a/lib/datalog/tests/negation.sx
+++ b/lib/datalog/tests/negation.sx
@@ -1,231 +0,0 @@
 ;; lib/datalog/tests/negation.sx — stratified negation tests.
 (define dl-nt-pass 0)
 (define dl-nt-fail 0)
 (define dl-nt-failures (list))
 (define
  dl-nt-deep=?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-nt-deq-l? a b 0)))
      ((and (dict? a) (dict? b))
        (let ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-nt-deq-d? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-nt-deq-l?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-nt-deep=? (nth a i) (nth b i))) false)
      (else (dl-nt-deq-l? a b (+ i 1))))))
 (define
  dl-nt-deq-d?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i)))
         (not (dl-nt-deep=? (get a k) (get b k))))
        false)
      (else (dl-nt-deq-d? a b ka (+ i 1))))))
 (define
  dl-nt-set=?
  (fn
    (a b)
    (and
      (= (len a) (len b))
      (dl-nt-subset? a b)
      (dl-nt-subset? b a))))
 (define
  dl-nt-subset?
  (fn
    (xs ys)
    (cond
      ((= (len xs) 0) true)
      ((not (dl-nt-contains? ys (first xs))) false)
      (else (dl-nt-subset? (rest xs) ys)))))
 (define
  dl-nt-contains?
  (fn
    (xs target)
    (cond
      ((= (len xs) 0) false)
      ((dl-nt-deep=? (first xs) target) true)
      (else (dl-nt-contains? (rest xs) target)))))
 (define
  dl-nt-test!
  (fn
    (name got expected)
    (if
      (dl-nt-deep=? got expected)
      (set! dl-nt-pass (+ dl-nt-pass 1))
      (do
        (set! dl-nt-fail (+ dl-nt-fail 1))
        (append!
          dl-nt-failures
          (str
            name
            "\n    expected: " expected
            "\n    got:      " got))))))
 (define
  dl-nt-test-set!
  (fn
    (name got expected)
    (if
      (dl-nt-set=? got expected)
      (set! dl-nt-pass (+ dl-nt-pass 1))
      (do
        (set! dl-nt-fail (+ dl-nt-fail 1))
        (append!
          dl-nt-failures
          (str
            name
            "\n    expected (set): " expected
            "\n    got:            " got))))))
 (define
  dl-nt-throws?
  (fn
    (thunk)
    (let
      ((threw false))
      (do
        (guard
          (e (#t (set! threw true)))
          (thunk))
        threw))))
 (define
  dl-nt-run-all!
  (fn
    ()
    (do
      ;; Negation against EDB-only relation.
      (dl-nt-test-set! "not against EDB"
        (dl-query
          (dl-program
            "p(1). p(2). p(3). r(2).
             q(X) :- p(X), not(r(X)).")
          (list (quote q) (quote X)))
        (list {:X 1} {:X 3}))
      ;; Negation against derived relation — needs stratification.
      (dl-nt-test-set! "not against derived rel"
        (dl-query
          (dl-program
            "p(1). p(2). p(3). s(2).
             r(X) :- s(X).
             q(X) :- p(X), not(r(X)).")
          (list (quote q) (quote X)))
        (list {:X 1} {:X 3}))
      ;; Two-step strata: r derives via s; q derives via not r.
      (dl-nt-test-set! "two-step strata"
        (dl-query
          (dl-program
            "node(a). node(b). node(c). node(d).
             edge(a, b). edge(b, c). edge(c, a).
             reach(X, Y) :- edge(X, Y).
             reach(X, Z) :- edge(X, Y), reach(Y, Z).
             unreachable(X) :- node(X), not(reach(a, X)).")
          (list (quote unreachable) (quote X)))
        (list {:X (quote d)}))
      ;; Combine negation with arithmetic and comparison.
      (dl-nt-test-set! "negation with arithmetic"
        (dl-query
          (dl-program
            "n(1). n(2). n(3). n(4). n(5). odd(1). odd(3). odd(5).
             even(X) :- n(X), not(odd(X)).")
          (list (quote even) (quote X)))
        (list {:X 2} {:X 4}))
      ;; Empty negation result.
      (dl-nt-test-set! "negation always succeeds"
        (dl-query
          (dl-program
            "p(1). p(2). q(X) :- p(X), not(r(X)).")
          (list (quote q) (quote X)))
        (list {:X 1} {:X 2}))
      ;; Negation always fails.
      (dl-nt-test-set! "negation always fails"
        (dl-query
          (dl-program
            "p(1). p(2). r(1). r(2). q(X) :- p(X), not(r(X)).")
          (list (quote q) (quote X)))
        (list))
      ;; Stratifiability checks.
      (dl-nt-test! "non-stratifiable rejected"
        (dl-nt-throws?
          (fn ()
            (let ((db (dl-make-db)))
              (do
                (dl-add-rule!
                  db
                  {:head (list (quote p) (quote X))
                   :body (list (list (quote q) (quote X))
                               {:neg (list (quote r) (quote X))})})
                (dl-add-rule!
                  db
                  {:head (list (quote r) (quote X))
                   :body (list (list (quote p) (quote X)))})
                (dl-add-fact! db (list (quote q) 1))
                (dl-saturate! db)))))
        true)
      (dl-nt-test! "stratifiable accepted"
        (dl-nt-throws?
          (fn ()
            (dl-program
              "p(1). p(2). r(2).
               q(X) :- p(X), not(r(X)).")))
        false)
      ;; Multi-stratum chain.
      (dl-nt-test-set! "three-level strata"
        (dl-query
          (dl-program
            "a(1). a(2). a(3). a(4).
             b(X) :- a(X), not(c(X)).
             c(X) :- d(X).
             d(2).
             d(4).")
          (list (quote b) (quote X)))
        (list {:X 1} {:X 3}))
      ;; Safety violation: negation refers to unbound var.
      (dl-nt-test! "negation safety violation"
        (dl-nt-throws?
          (fn ()
            (dl-program
              "p(1). q(X) :- p(X), not(r(Y)).")))
        true))))
 (define
  dl-negation-tests-run!
  (fn
    ()
    (do
      (set! dl-nt-pass 0)
      (set! dl-nt-fail 0)
      (set! dl-nt-failures (list))
      (dl-nt-run-all!)
      {:passed dl-nt-pass
       :failed dl-nt-fail
       :total (+ dl-nt-pass dl-nt-fail)
       :failures dl-nt-failures})))
--- a/lib/datalog/tests/parse.sx
+++ b/lib/datalog/tests/parse.sx
@@ -1,147 +0,0 @@
 ;; lib/datalog/tests/parse.sx — parser unit tests
 ;;
 ;; Run via: bash lib/datalog/conformance.sh
 ;; Or:      (load "lib/datalog/tokenizer.sx") (load "lib/datalog/parser.sx")
 ;;          (load "lib/datalog/tests/parse.sx") (dl-parse-tests-run!)
 (define dl-pt-pass 0)
 (define dl-pt-fail 0)
 (define dl-pt-failures (list))
 ;; Order-independent structural equality. Lists compared positionally,
 ;; dicts as sets of (key, value) pairs. Numbers via = (so 30.0 = 30).
 (define
  dl-deep-equal?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-deep-equal-list? a b 0)))
      ((and (dict? a) (dict? b))
        (let
          ((ka (keys a)) (kb (keys b)))
          (and
            (= (len ka) (len kb))
            (dl-deep-equal-dict? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-deep-equal-list?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-deep-equal? (nth a i) (nth b i))) false)
      (else (dl-deep-equal-list? a b (+ i 1))))))
 (define
  dl-deep-equal-dict?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i))) (not (dl-deep-equal? (get a k) (get b k))))
        false)
      (else (dl-deep-equal-dict? a b ka (+ i 1))))))
 (define
  dl-pt-test!
  (fn
    (name got expected)
    (if
      (dl-deep-equal? got expected)
      (set! dl-pt-pass (+ dl-pt-pass 1))
      (do
        (set! dl-pt-fail (+ dl-pt-fail 1))
        (append!
          dl-pt-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))
 (define
  dl-pt-throws?
  (fn
    (thunk)
    (let
      ((threw false))
      (do (guard (e (#t (set! threw true))) (thunk)) threw))))
 (define
  dl-pt-run-all!
  (fn
    ()
    (do
      (dl-pt-test! "empty program" (dl-parse "") (list))
      (dl-pt-test! "fact" (dl-parse "parent(tom, bob).") (list {:body (list) :head (list (quote parent) (quote tom) (quote bob))}))
      (dl-pt-test!
        "two facts"
        (dl-parse "parent(tom, bob). parent(bob, ann).")
        (list {:body (list) :head (list (quote parent) (quote tom) (quote bob))} {:body (list) :head (list (quote parent) (quote bob) (quote ann))}))
      (dl-pt-test! "zero-ary fact" (dl-parse "ready.") (list {:body (list) :head (list (quote ready))}))
      (dl-pt-test!
        "rule one body lit"
        (dl-parse "ancestor(X, Y) :- parent(X, Y).")
        (list {:body (list (list (quote parent) (quote X) (quote Y))) :head (list (quote ancestor) (quote X) (quote Y))}))
      (dl-pt-test!
        "recursive rule"
        (dl-parse "ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")
        (list {:body (list (list (quote parent) (quote X) (quote Y)) (list (quote ancestor) (quote Y) (quote Z))) :head (list (quote ancestor) (quote X) (quote Z))}))
      (dl-pt-test!
        "query single"
        (dl-parse "?- ancestor(tom, X).")
        (list {:query (list (list (quote ancestor) (quote tom) (quote X)))}))
      (dl-pt-test!
        "query multi"
        (dl-parse "?- p(X), q(X).")
        (list {:query (list (list (quote p) (quote X)) (list (quote q) (quote X)))}))
      (dl-pt-test!
        "negation"
        (dl-parse "safe(X) :- person(X), not(parent(X, _)).")
        (list {:body (list (list (quote person) (quote X)) {:neg (list (quote parent) (quote X) (quote _))}) :head (list (quote safe) (quote X))}))
      (dl-pt-test!
        "number arg"
        (dl-parse "age(alice, 30).")
        (list {:body (list) :head (list (quote age) (quote alice) 30)}))
      (dl-pt-test!
        "string arg"
        (dl-parse "label(x, \"hi\").")
        (list {:body (list) :head (list (quote label) (quote x) "hi")}))
      (dl-pt-test!
        "comparison literal"
        (dl-parse "p(X) :- <(X, 5).")
        (list {:body (list (list (string->symbol "<") (quote X) 5)) :head (list (quote p) (quote X))}))
      (dl-pt-test!
        "is with arith"
        (dl-parse "succ(X, Y) :- nat(X), is(Y, +(X, 1)).")
        (list {:body (list (list (quote nat) (quote X)) (list (quote is) (quote Y) (list (string->symbol "+") (quote X) 1))) :head (list (quote succ) (quote X) (quote Y))}))
      (dl-pt-test!
        "mixed program"
        (dl-parse "p(a). p(b). q(X) :- p(X). ?- q(Y).")
        (list {:body (list) :head (list (quote p) (quote a))} {:body (list) :head (list (quote p) (quote b))} {:body (list (list (quote p) (quote X))) :head (list (quote q) (quote X))} {:query (list (list (quote q) (quote Y)))}))
      (dl-pt-test!
        "comments skipped"
        (dl-parse "% comment\nfoo(a).\n/* block */ bar(b).")
        (list {:body (list) :head (list (quote foo) (quote a))} {:body (list) :head (list (quote bar) (quote b))}))
      (dl-pt-test!
        "underscore var"
        (dl-parse "p(X) :- q(X, _).")
        (list {:body (list (list (quote q) (quote X) (quote _))) :head (list (quote p) (quote X))}))
      (dl-pt-test!
        "missing dot raises"
        (dl-pt-throws? (fn () (dl-parse "p(a)")))
        true)
      (dl-pt-test!
        "trailing comma raises"
        (dl-pt-throws? (fn () (dl-parse "p(a,).")))
        true))))
 (define
  dl-parse-tests-run!
  (fn
    ()
    (do
      (set! dl-pt-pass 0)
      (set! dl-pt-fail 0)
      (set! dl-pt-failures (list))
      (dl-pt-run-all!)
      {:failures dl-pt-failures :total (+ dl-pt-pass dl-pt-fail) :passed dl-pt-pass :failed dl-pt-fail})))
--- a/lib/datalog/tests/semi_naive.sx
+++ b/lib/datalog/tests/semi_naive.sx
@@ -1,153 +0,0 @@
 ;; lib/datalog/tests/semi_naive.sx — semi-naive correctness vs naive.
 ;;
 ;; Strategy: differential — run both saturators on each program and
 ;; compare the resulting per-relation tuple counts. Counting (not
 ;; element-wise set equality) keeps the suite fast under the bundled
 ;; conformance session; correctness on the inhabitants is covered by
 ;; eval.sx and builtins.sx (which use dl-saturate! by default — the
 ;; semi-naive saturator).
 (define dl-sn-pass 0)
 (define dl-sn-fail 0)
 (define dl-sn-failures (list))
 (define
  dl-sn-test!
  (fn
    (name got expected)
    (if
      (equal? got expected)
      (set! dl-sn-pass (+ dl-sn-pass 1))
      (do
        (set! dl-sn-fail (+ dl-sn-fail 1))
        (append!
          dl-sn-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))
 ;; Load `source` into both a semi-naive and a naive db and return a
 ;; list of (rel-name semi-count naive-count) triples. Both sets must
 ;; have the same union of relation names.
 (define
  dl-sn-counts
  (fn
    (source)
    (let
      ((db-s (dl-program source)) (db-n (dl-program source)))
      (do
        (dl-saturate! db-s)
        (dl-saturate-naive! db-n)
        (let
          ((out (list)))
          (do
            (for-each
              (fn
                (k)
                (append!
                  out
                  (list
                    k
                    (len (dl-relation db-s k))
                    (len (dl-relation db-n k)))))
              (keys (get db-s :facts)))
            out))))))
 (define
  dl-sn-counts-agree?
  (fn
    (counts)
    (cond
      ((= (len counts) 0) true)
      (else
        (let
          ((row (first counts)))
          (and
            (= (nth row 1) (nth row 2))
            (dl-sn-counts-agree? (rest counts))))))))
 (define
  dl-sn-chain-source
  (fn
    (n)
    (let
      ((parts (list "")))
      (do
        (define
          dl-sn-loop
          (fn
            (i)
            (when
              (< i n)
              (do
                (append! parts (str "parent(" i ", " (+ i 1) "). "))
                (dl-sn-loop (+ i 1))))))
        (dl-sn-loop 0)
        (str
          (join "" parts)
          "ancestor(X, Y) :- parent(X, Y). "
          "ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))))
 (define
  dl-sn-run-all!
  (fn
    ()
    (do
      (dl-sn-test!
        "ancestor closure counts match"
        (dl-sn-counts-agree?
          (dl-sn-counts
            "parent(a, b). parent(b, c). parent(c, d).\n             ancestor(X, Y) :- parent(X, Y).\n             ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z)."))
        true)
      (dl-sn-test!
        "cyclic reach counts match"
        (dl-sn-counts-agree?
          (dl-sn-counts
            "edge(1, 2). edge(2, 3). edge(3, 1). edge(3, 4).\n             reach(X, Y) :- edge(X, Y).\n             reach(X, Z) :- edge(X, Y), reach(Y, Z)."))
        true)
      (dl-sn-test!
        "same-gen counts match"
        (dl-sn-counts-agree?
          (dl-sn-counts
            "parent(a, b). parent(a, c). parent(b, d). parent(c, e).\n             person(a). person(b). person(c). person(d). person(e).\n             sg(X, X) :- person(X).\n             sg(X, Y) :- parent(P1, X), sg(P1, P2), parent(P2, Y)."))
        true)
      (dl-sn-test!
        "rules with builtins counts match"
        (dl-sn-counts-agree?
          (dl-sn-counts
            "n(1). n(2). n(3). n(4). n(5).\n             small(X) :- n(X), <(X, 5).\n             succ(X, Y) :- n(X), <(X, 5), is(Y, +(X, 1))."))
        true)
      (dl-sn-test!
        "static rule fires under semi-naive"
        (dl-sn-counts-agree?
          (dl-sn-counts "p(a). p(b). q(X) :- p(X), =(X, a)."))
        true)
      ;; Chain length 12 — multiple semi-naive iterations against
      ;; the recursive ancestor rule (differential vs naive).
      (dl-sn-test!
        "chain-12 ancestor counts match"
        (dl-sn-counts-agree? (dl-sn-counts (dl-sn-chain-source 12)))
        true)
      ;; Chain length 25 — semi-naive only — first-arg index makes
      ;; this tractable in conformance budget.
      (dl-sn-test!
        "chain-25 ancestor count value (semi only)"
        (let
          ((db (dl-program (dl-sn-chain-source 25))))
          (do (dl-saturate! db) (len (dl-relation db "ancestor"))))
        325)
      (dl-sn-test!
        "query through semi saturate"
        (let
          ((db (dl-program "parent(a, b). parent(b, c).\n                  ancestor(X, Y) :- parent(X, Y).\n                  ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z).")))
          (len (dl-query db (list (quote ancestor) (quote a) (quote X)))))
        2))))
 (define
  dl-semi-naive-tests-run!
  (fn
    ()
    (do
      (set! dl-sn-pass 0)
      (set! dl-sn-fail 0)
      (set! dl-sn-failures (list))
      (dl-sn-run-all!)
      {:failures dl-sn-failures :total (+ dl-sn-pass dl-sn-fail) :passed dl-sn-pass :failed dl-sn-fail})))
--- a/lib/datalog/tests/tokenize.sx
+++ b/lib/datalog/tests/tokenize.sx
@@ -1,139 +0,0 @@
 ;; lib/datalog/tests/tokenize.sx — tokenizer unit tests
 ;;
 ;; Run via: bash lib/datalog/conformance.sh
 ;; Or:      (load "lib/datalog/tokenizer.sx") (load "lib/datalog/tests/tokenize.sx")
 ;;          (dl-tokenize-tests-run!)
 (define dl-tk-pass 0)
 (define dl-tk-fail 0)
 (define dl-tk-failures (list))
 (define
  dl-tk-test!
  (fn
    (name got expected)
    (if
      (= got expected)
      (set! dl-tk-pass (+ dl-tk-pass 1))
      (do
        (set! dl-tk-fail (+ dl-tk-fail 1))
        (append!
          dl-tk-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))
 (define dl-tk-types (fn (toks) (map (fn (t) (get t :type)) toks)))
 (define dl-tk-values (fn (toks) (map (fn (t) (get t :value)) toks)))
 (define
  dl-tk-run-all!
  (fn
    ()
    (do
      (dl-tk-test! "empty" (dl-tk-types (dl-tokenize "")) (list "eof"))
      (dl-tk-test!
        "atom dot"
        (dl-tk-types (dl-tokenize "foo."))
        (list "atom" "punct" "eof"))
      (dl-tk-test!
        "atom dot value"
        (dl-tk-values (dl-tokenize "foo."))
        (list "foo" "." nil))
      (dl-tk-test!
        "var"
        (dl-tk-types (dl-tokenize "X."))
        (list "var" "punct" "eof"))
      (dl-tk-test!
        "underscore var"
        (dl-tk-types (dl-tokenize "_x."))
        (list "var" "punct" "eof"))
      (dl-tk-test!
        "integer"
        (dl-tk-values (dl-tokenize "42"))
        (list 42 nil))
      (dl-tk-test!
        "decimal"
        (dl-tk-values (dl-tokenize "3.14"))
        (list 3.14 nil))
      (dl-tk-test!
        "string"
        (dl-tk-values (dl-tokenize "\"hello\""))
        (list "hello" nil))
      (dl-tk-test!
        "quoted atom"
        (dl-tk-types (dl-tokenize "'two words'"))
        (list "atom" "eof"))
      (dl-tk-test!
        "quoted atom value"
        (dl-tk-values (dl-tokenize "'two words'"))
        (list "two words" nil))
      (dl-tk-test! ":-" (dl-tk-values (dl-tokenize ":-")) (list ":-" nil))
      (dl-tk-test! "?-" (dl-tk-values (dl-tokenize "?-")) (list "?-" nil))
      (dl-tk-test! "<=" (dl-tk-values (dl-tokenize "<=")) (list "<=" nil))
      (dl-tk-test! ">=" (dl-tk-values (dl-tokenize ">=")) (list ">=" nil))
      (dl-tk-test! "!=" (dl-tk-values (dl-tokenize "!=")) (list "!=" nil))
      (dl-tk-test!
        "single op values"
        (dl-tk-values (dl-tokenize "< > = + - * /"))
        (list "<" ">" "=" "+" "-" "*" "/" nil))
      (dl-tk-test!
        "single op types"
        (dl-tk-types (dl-tokenize "< > = + - * /"))
        (list "op" "op" "op" "op" "op" "op" "op" "eof"))
      (dl-tk-test!
        "punct"
        (dl-tk-values (dl-tokenize "( ) , ."))
        (list "(" ")" "," "." nil))
      (dl-tk-test!
        "fact tokens"
        (dl-tk-types (dl-tokenize "parent(tom, bob)."))
        (list "atom" "punct" "atom" "punct" "atom" "punct" "punct" "eof"))
      (dl-tk-test!
        "rule shape"
        (dl-tk-types (dl-tokenize "p(X) :- q(X)."))
        (list
          "atom"
          "punct"
          "var"
          "punct"
          "op"
          "atom"
          "punct"
          "var"
          "punct"
          "punct"
          "eof"))
      (dl-tk-test!
        "comparison literal"
        (dl-tk-values (dl-tokenize "<(X, 5)"))
        (list "<" "(" "X" "," 5 ")" nil))
      (dl-tk-test!
        "is form"
        (dl-tk-values (dl-tokenize "is(Y, +(X, 1))"))
        (list "is" "(" "Y" "," "+" "(" "X" "," 1 ")" ")" nil))
      (dl-tk-test!
        "line comment"
        (dl-tk-types (dl-tokenize "% comment line\nfoo."))
        (list "atom" "punct" "eof"))
      (dl-tk-test!
        "block comment"
        (dl-tk-types (dl-tokenize "/* a\nb */ x."))
        (list "atom" "punct" "eof"))
      (dl-tk-test!
        "whitespace"
        (dl-tk-types (dl-tokenize "  foo  ,\t bar  ."))
        (list "atom" "punct" "atom" "punct" "eof"))
      (dl-tk-test!
        "positions"
        (map (fn (t) (get t :pos)) (dl-tokenize "foo bar"))
        (list 0 4 7)))))
 (define
  dl-tokenize-tests-run!
  (fn
    ()
    (do
      (set! dl-tk-pass 0)
      (set! dl-tk-fail 0)
      (set! dl-tk-failures (list))
      (dl-tk-run-all!)
      {:failures dl-tk-failures :total (+ dl-tk-pass dl-tk-fail) :passed dl-tk-pass :failed dl-tk-fail})))
--- a/lib/datalog/tests/unify.sx
+++ b/lib/datalog/tests/unify.sx
@@ -1,185 +0,0 @@
 ;; lib/datalog/tests/unify.sx — unification + substitution tests.
 (define dl-ut-pass 0)
 (define dl-ut-fail 0)
 (define dl-ut-failures (list))
 (define
  dl-ut-deep-equal?
  (fn
    (a b)
    (cond
      ((and (list? a) (list? b))
        (and (= (len a) (len b)) (dl-ut-deq-list? a b 0)))
      ((and (dict? a) (dict? b))
        (let
          ((ka (keys a)) (kb (keys b)))
          (and (= (len ka) (len kb)) (dl-ut-deq-dict? a b ka 0))))
      ((and (number? a) (number? b)) (= a b))
      (else (equal? a b)))))
 (define
  dl-ut-deq-list?
  (fn
    (a b i)
    (cond
      ((>= i (len a)) true)
      ((not (dl-ut-deep-equal? (nth a i) (nth b i))) false)
      (else (dl-ut-deq-list? a b (+ i 1))))))
 (define
  dl-ut-deq-dict?
  (fn
    (a b ka i)
    (cond
      ((>= i (len ka)) true)
      ((let ((k (nth ka i))) (not (dl-ut-deep-equal? (get a k) (get b k))))
        false)
      (else (dl-ut-deq-dict? a b ka (+ i 1))))))
 (define
  dl-ut-test!
  (fn
    (name got expected)
    (if
      (dl-ut-deep-equal? got expected)
      (set! dl-ut-pass (+ dl-ut-pass 1))
      (do
        (set! dl-ut-fail (+ dl-ut-fail 1))
        (append!
          dl-ut-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))
 (define
  dl-ut-run-all!
  (fn
    ()
    (do
      (dl-ut-test! "var? uppercase" (dl-var? (quote X)) true)
      (dl-ut-test! "var? underscore" (dl-var? (quote _foo)) true)
      (dl-ut-test! "var? lowercase" (dl-var? (quote tom)) false)
      (dl-ut-test! "var? number" (dl-var? 5) false)
      (dl-ut-test! "var? string" (dl-var? "hi") false)
      (dl-ut-test! "var? list" (dl-var? (list 1)) false)
      (dl-ut-test!
        "atom-atom match"
        (dl-unify (quote tom) (quote tom) (dl-empty-subst))
        {})
      (dl-ut-test!
        "atom-atom fail"
        (dl-unify (quote tom) (quote bob) (dl-empty-subst))
        nil)
      (dl-ut-test!
        "num-num match"
        (dl-unify 5 5 (dl-empty-subst))
        {})
      (dl-ut-test!
        "num-num fail"
        (dl-unify 5 6 (dl-empty-subst))
        nil)
      (dl-ut-test!
        "string match"
        (dl-unify "hi" "hi" (dl-empty-subst))
        {})
      (dl-ut-test! "string fail" (dl-unify "hi" "bye" (dl-empty-subst)) nil)
      (dl-ut-test!
        "var-atom binds"
        (dl-unify (quote X) (quote tom) (dl-empty-subst))
        {:X (quote tom)})
      (dl-ut-test!
        "atom-var binds"
        (dl-unify (quote tom) (quote X) (dl-empty-subst))
        {:X (quote tom)})
      (dl-ut-test!
        "var-var same"
        (dl-unify (quote X) (quote X) (dl-empty-subst))
        {})
      (dl-ut-test!
        "var-var bind"
        (let
          ((s (dl-unify (quote X) (quote Y) (dl-empty-subst))))
          (dl-walk (quote X) s))
        (quote Y))
      (dl-ut-test!
        "tuple match"
        (dl-unify
          (list (quote parent) (quote X) (quote bob))
          (list (quote parent) (quote tom) (quote Y))
          (dl-empty-subst))
        {:X (quote tom) :Y (quote bob)})
      (dl-ut-test!
        "tuple arity mismatch"
        (dl-unify
          (list (quote p) (quote X))
          (list (quote p) (quote a) (quote b))
          (dl-empty-subst))
        nil)
      (dl-ut-test!
        "tuple head mismatch"
        (dl-unify
          (list (quote p) (quote X))
          (list (quote q) (quote X))
          (dl-empty-subst))
        nil)
      (dl-ut-test!
        "walk chain"
        (let
          ((s1 (dl-unify (quote X) (quote Y) (dl-empty-subst))))
          (let
            ((s2 (dl-unify (quote Y) (quote tom) s1)))
            (dl-walk (quote X) s2)))
        (quote tom))
      (dl-ut-test!
        "apply subst on tuple"
        (let
          ((s (dl-bind (quote X) (quote tom) (dl-empty-subst))))
          (dl-apply-subst (list (quote parent) (quote X) (quote Y)) s))
        (list (quote parent) (quote tom) (quote Y)))
      (dl-ut-test!
        "ground? all const"
        (dl-ground?
          (list (quote p) (quote tom) 5)
          (dl-empty-subst))
        true)
      (dl-ut-test!
        "ground? unbound var"
        (dl-ground? (list (quote p) (quote X)) (dl-empty-subst))
        false)
      (dl-ut-test!
        "ground? bound var"
        (let
          ((s (dl-bind (quote X) (quote tom) (dl-empty-subst))))
          (dl-ground? (list (quote p) (quote X)) s))
        true)
      (dl-ut-test!
        "ground? bare var"
        (dl-ground? (quote X) (dl-empty-subst))
        false)
      (dl-ut-test!
        "vars-of basic"
        (dl-vars-of
          (list (quote p) (quote X) (quote tom) (quote Y) (quote X)))
        (list "X" "Y"))
      (dl-ut-test!
        "vars-of ground"
        (dl-vars-of (list (quote p) (quote tom) (quote bob)))
        (list))
      (dl-ut-test!
        "vars-of nested compound"
        (dl-vars-of
          (list
            (quote is)
            (quote Z)
            (list (string->symbol "+") (quote X) 1)))
        (list "Z" "X")))))
 (define
  dl-unify-tests-run!
  (fn
    ()
    (do
      (set! dl-ut-pass 0)
      (set! dl-ut-fail 0)
      (set! dl-ut-failures (list))
      (dl-ut-run-all!)
      {:failures dl-ut-failures :total (+ dl-ut-pass dl-ut-fail) :passed dl-ut-pass :failed dl-ut-fail})))
--- a/lib/datalog/tokenizer.sx
+++ b/lib/datalog/tokenizer.sx
@@ -1,254 +0,0 @@
 ;; lib/datalog/tokenizer.sx — Datalog source → token stream
 ;;
 ;; Tokens: {:type T :value V :pos P}
 ;; Types:
 ;;   "atom"    — lowercase-start ident or quoted 'atom'
 ;;   "var"     — uppercase-start or _-start ident (value is the name)
 ;;   "number"  — numeric literal (decoded to number)
 ;;   "string"  — "..." string literal
 ;;   "punct"   — ( ) , .
 ;;   "op"      — :- ?- <= >= != < > = + - * /
 ;;   "eof"
 ;;
 ;; Datalog has no function symbols in arg position; the parser still
 ;; accepts nested compounds for arithmetic ((is X (+ A B))) but safety
 ;; analysis rejects non-arithmetic nesting at rule-load time.
 (define dl-make-token (fn (type value pos) {:type type :value value :pos pos}))
 (define dl-digit? (fn (c) (and (>= c "0") (<= c "9"))))
 (define dl-lower? (fn (c) (and (>= c "a") (<= c "z"))))
 (define dl-upper? (fn (c) (and (>= c "A") (<= c "Z"))))
 (define
  dl-ident-char?
  (fn (c) (or (dl-lower? c) (dl-upper? c) (dl-digit? c) (= c "_"))))
 (define dl-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
 (define
  dl-tokenize
  (fn
    (src)
    (let
      ((tokens (list)) (pos 0) (src-len (len src)))
      (define
        dl-peek
        (fn
          (offset)
          (if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
      (define cur (fn () (dl-peek 0)))
      (define advance! (fn (n) (set! pos (+ pos n))))
      (define
        at?
        (fn
          (s)
          (let
            ((sl (len s)))
            (and (<= (+ pos sl) src-len) (= (slice src pos (+ pos sl)) s)))))
      (define
        dl-emit!
        (fn
          (type value start)
          (append! tokens (dl-make-token type value start))))
      (define
        skip-line-comment!
        (fn
          ()
          (when
            (and (< pos src-len) (not (= (cur) "\n")))
            (do (advance! 1) (skip-line-comment!)))))
      (define
        skip-block-comment!
        (fn
          ()
          (cond
            ((>= pos src-len) nil)
            ((and (= (cur) "*") (< (+ pos 1) src-len) (= (dl-peek 1) "/"))
              (advance! 2))
            (else (do (advance! 1) (skip-block-comment!))))))
      (define
        skip-ws!
        (fn
          ()
          (cond
            ((>= pos src-len) nil)
            ((dl-ws? (cur)) (do (advance! 1) (skip-ws!)))
            ((= (cur) "%")
              (do (advance! 1) (skip-line-comment!) (skip-ws!)))
            ((and (= (cur) "/") (< (+ pos 1) src-len) (= (dl-peek 1) "*"))
              (do (advance! 2) (skip-block-comment!) (skip-ws!)))
            (else nil))))
      (define
        read-ident
        (fn
          (start)
          (do
            (when
              (and (< pos src-len) (dl-ident-char? (cur)))
              (do (advance! 1) (read-ident start)))
            (slice src start pos))))
      (define
        read-decimal-digits!
        (fn
          ()
          (when
            (and (< pos src-len) (dl-digit? (cur)))
            (do (advance! 1) (read-decimal-digits!)))))
      (define
        read-number
        (fn
          (start)
          (do
            (read-decimal-digits!)
            (when
              (and
                (< pos src-len)
                (= (cur) ".")
                (< (+ pos 1) src-len)
                (dl-digit? (dl-peek 1)))
              (do (advance! 1) (read-decimal-digits!)))
            (parse-number (slice src start pos)))))
      (define
        read-quoted
        (fn
          (quote-char)
          (let
            ((chars (list)))
            (advance! 1)
            (define
              loop
              (fn
                ()
                (cond
                  ((>= pos src-len) nil)
                  ((= (cur) "\\")
                    (do
                      (advance! 1)
                      (when
                        (< pos src-len)
                        (let
                          ((ch (cur)))
                          (do
                            (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)))
                            (advance! 1))))
                      (loop)))
                  ((= (cur) quote-char) (advance! 1))
                  (else
                    (do (append! chars (cur)) (advance! 1) (loop))))))
            (loop)
            (join "" chars))))
      (define
        scan!
        (fn
          ()
          (do
            (skip-ws!)
            (when
              (< pos src-len)
              (let
                ((ch (cur)) (start pos))
                (cond
                  ((at? ":-")
                    (do
                      (dl-emit! "op" ":-" start)
                      (advance! 2)
                      (scan!)))
                  ((at? "?-")
                    (do
                      (dl-emit! "op" "?-" start)
                      (advance! 2)
                      (scan!)))
                  ((at? "<=")
                    (do
                      (dl-emit! "op" "<=" start)
                      (advance! 2)
                      (scan!)))
                  ((at? ">=")
                    (do
                      (dl-emit! "op" ">=" start)
                      (advance! 2)
                      (scan!)))
                  ((at? "!=")
                    (do
                      (dl-emit! "op" "!=" start)
                      (advance! 2)
                      (scan!)))
                  ((dl-digit? ch)
                    (do
                      (dl-emit! "number" (read-number start) start)
                      (scan!)))
                  ((= ch "'")
                    (do (dl-emit! "atom" (read-quoted "'") start) (scan!)))
                  ((= ch "\"")
                    (do (dl-emit! "string" (read-quoted "\"") start) (scan!)))
                  ((dl-lower? ch)
                    (do (dl-emit! "atom" (read-ident start) start) (scan!)))
                  ((or (dl-upper? ch) (= ch "_"))
                    (do (dl-emit! "var" (read-ident start) start) (scan!)))
                  ((= ch "(")
                    (do
                      (dl-emit! "punct" "(" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch ")")
                    (do
                      (dl-emit! "punct" ")" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch ",")
                    (do
                      (dl-emit! "punct" "," start)
                      (advance! 1)
                      (scan!)))
                  ((= ch ".")
                    (do
                      (dl-emit! "punct" "." start)
                      (advance! 1)
                      (scan!)))
                  ((= ch "<")
                    (do
                      (dl-emit! "op" "<" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch ">")
                    (do
                      (dl-emit! "op" ">" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch "=")
                    (do
                      (dl-emit! "op" "=" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch "+")
                    (do
                      (dl-emit! "op" "+" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch "-")
                    (do
                      (dl-emit! "op" "-" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch "*")
                    (do
                      (dl-emit! "op" "*" start)
                      (advance! 1)
                      (scan!)))
                  ((= ch "/")
                    (do
                      (dl-emit! "op" "/" start)
                      (advance! 1)
                      (scan!)))
                  (else (do (advance! 1) (scan!)))))))))
      (scan!)
      (dl-emit! "eof" nil pos)
      tokens)))
--- a/lib/datalog/unify.sx
+++ b/lib/datalog/unify.sx
@@ -1,159 +0,0 @@
 ;; lib/datalog/unify.sx — unification + substitution for Datalog terms.
 ;;
 ;; Term taxonomy (after parsing):
 ;;   variable  — SX symbol whose first char is uppercase A–Z or '_'.
 ;;   constant  — SX symbol whose first char is lowercase a–z (atom name).
 ;;   number    — numeric literal.
 ;;   string    — string literal.
 ;;   compound  — SX list (functor arg ... arg). In core Datalog these
 ;;               only appear as arithmetic expressions (see Phase 4
 ;;               safety analysis); compound-against-compound unification
 ;;               is supported anyway for completeness.
 ;;
 ;; Substitutions are immutable dicts keyed by variable name (string).
 ;; A failed unification returns nil; success returns the extended subst.
 (define dl-empty-subst (fn () {}))
 (define
  dl-var?
  (fn
    (term)
    (and
      (symbol? term)
      (let
        ((name (symbol->string term)))
        (and
          (> (len name) 0)
          (let
            ((c (slice name 0 1)))
            (or (and (>= c "A") (<= c "Z")) (= c "_"))))))))
 ;; Walk: chase variable bindings until we hit a non-variable or an unbound
 ;; variable. The result is either a non-variable term or an unbound var.
 (define
  dl-walk
  (fn
    (term subst)
    (if
      (dl-var? term)
      (let
        ((name (symbol->string term)))
        (if
          (and (dict? subst) (has-key? subst name))
          (dl-walk (get subst name) subst)
          term))
      term)))
 ;; Bind a variable symbol to a value in subst, returning a new subst.
 (define
  dl-bind
  (fn (var-sym value subst) (assoc subst (symbol->string var-sym) value)))
 (define
  dl-unify
  (fn
    (t1 t2 subst)
    (if
      (nil? subst)
      nil
      (let
        ((u1 (dl-walk t1 subst)) (u2 (dl-walk t2 subst)))
        (cond
          ((dl-var? u1)
            (cond
              ((and (dl-var? u2) (= (symbol->string u1) (symbol->string u2)))
                subst)
              (else (dl-bind u1 u2 subst))))
          ((dl-var? u2) (dl-bind u2 u1 subst))
          ((and (list? u1) (list? u2))
            (if
              (= (len u1) (len u2))
              (dl-unify-list u1 u2 subst 0)
              nil))
          ((and (number? u1) (number? u2)) (if (= u1 u2) subst nil))
          ((and (string? u1) (string? u2)) (if (= u1 u2) subst nil))
          ((and (symbol? u1) (symbol? u2))
            (if (= (symbol->string u1) (symbol->string u2)) subst nil))
          (else nil))))))
 (define
  dl-unify-list
  (fn
    (a b subst i)
    (cond
      ((nil? subst) nil)
      ((>= i (len a)) subst)
      (else
        (dl-unify-list
          a
          b
          (dl-unify (nth a i) (nth b i) subst)
          (+ i 1))))))
 ;; Apply substitution: walk the term and recurse into lists.
 (define
  dl-apply-subst
  (fn
    (term subst)
    (let
      ((w (dl-walk term subst)))
      (if (list? w) (map (fn (x) (dl-apply-subst x subst)) w) w))))
 ;; Ground? — true iff no free variables remain after walking.
 (define
  dl-ground?
  (fn
    (term subst)
    (let
      ((w (dl-walk term subst)))
      (cond
        ((dl-var? w) false)
        ((list? w) (dl-ground-list? w subst 0))
        (else true)))))
 (define
  dl-ground-list?
  (fn
    (xs subst i)
    (cond
      ((>= i (len xs)) true)
      ((not (dl-ground? (nth xs i) subst)) false)
      (else (dl-ground-list? xs subst (+ i 1))))))
 ;; Return the list of variable names appearing in a term (deduped, in
 ;; left-to-right order). Useful for safety analysis later.
 (define
  dl-vars-of
  (fn (term) (let ((seen (list))) (do (dl-vars-of-aux term seen) seen))))
 (define
  dl-vars-of-aux
  (fn
    (term acc)
    (cond
      ((dl-var? term)
        (let
          ((name (symbol->string term)))
          (when (not (dl-member? name acc)) (append! acc name))))
      ((list? term) (dl-vars-of-list term acc 0))
      (else nil))))
 (define
  dl-vars-of-list
  (fn
    (xs acc i)
    (when
      (< i (len xs))
      (do
        (dl-vars-of-aux (nth xs i) acc)
        (dl-vars-of-list xs acc (+ i 1))))))
 (define
  dl-member?
  (fn
    (x xs)
    (cond
      ((= (len xs) 0) false)
      ((= (first xs) x) true)
      (else (dl-member? x (rest xs))))))
--- a/lib/ocaml/conformance.sh
+++ b/lib/ocaml/conformance.sh
@@ -0,0 +1,116 @@
 #!/usr/bin/env bash
 # lib/ocaml/conformance.sh — run the OCaml-on-SX test suite and emit
 # scoreboard.json + scoreboard.md broken into suites by epoch range.
 #
 # Suites are defined by epoch ranges in test.sh:
 #   100-199  tokenize
 #   200-329  parse-expr
 #   270-329  parse-program (overlaps; assigned to parse-expr)
 #   400-499  eval-core (atoms / arith / control / let / fn)
 #   500-665  phase3-adt-match (incl ref + try/with)
 #   700-754  phase4-modules
 #   800-974  phase6-stdlib
 #   850-852  let-and (small group)
 #   900-913  phase5-hm
 #   1000+    misc
 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
 OUT_JSON="lib/ocaml/scoreboard.json"
 OUT_MD="lib/ocaml/scoreboard.md"
 # Run test.sh in verbose mode, capturing per-test pass/fail lines plus
 # the trailing summary.
 TMPLOG=$(mktemp)
 trap "rm -f $TMPLOG" EXIT
 bash lib/ocaml/test.sh -v > "$TMPLOG" 2>&1 || true
 # Classification by epoch is non-trivial to recover from the human
 # output, so we classify by the test-name prefix that test.sh emits.
 declare -A SUITE_PASS
 declare -A SUITE_FAIL
 classify() {
  local desc="$1"
  case "$desc" in
    *"tok"*|*"comment"*|*"keyword"*|*"primed"*|*"tyvar"*|*"underscored"*|*"hex"*|*"exponent"*|*"escape"*) echo "tokenize" ;;
    *"parse"*|*"program"*|*"match"*|*"begin/end"*|*"::"*|*"|>"*|*"|"*) echo "parser" ;;
    *"eval"*|*"truthy"*|*"closure"*|*"recur"*|*"fact"*|*"fib"*|*"sum"*|*"curried lambda"*) echo "eval-core" ;;
    *"ref"*|*"deref"*|*"increment"*|*":="*) echo "phase2-refs" ;;
    *"for"*|*"while"*|*"product"*) echo "phase2-loops" ;;
    *"function "*|*"rec function"*) echo "phase2-function" ;;
    *"try"*|*"raise"*|*"failwith"*|*"caught"*) echo "phase2-exn" ;;
    *"None"*|*"Some"*|*"Pair"*|*"Ok"*|*"Error"*|*"ctor"*) echo "phase3-adt" ;;
    *"module"*|*"functor"*|*"include"*|*"open"*|*"M.x"*|*"submodule"*|*"alias"*|*"Sphere"*|*"Identity"*|*"Outer.Inner"*) echo "phase4-modules" ;;
    *"List."*|*"Option."*|*"Result."*|*"Char."*|*"Int."*|*"String."*) echo "phase6-stdlib" ;;
    *"type "*|*"Int -> Int"*|*"poly"*|*"twice"*|*"Bool"*|*" -> "*) echo "phase5-hm" ;;
    *"and y"*|*"mutual"*|*"odd"*|*"even"*) echo "let-and" ;;
    *"unit "*|*"wildcard"*|*"top-level let f"*) echo "phase1-params" ;;
    *) echo "misc" ;;
  esac
 }
 while IFS= read -r line; do
  if [[ "$line" =~ ^[[:space:]]*ok\ (.+)$ ]]; then
    desc="${BASH_REMATCH[1]}"
    suite=$(classify "$desc")
    SUITE_PASS[$suite]=$(( ${SUITE_PASS[$suite]:-0} + 1 ))
  elif [[ "$line" =~ ^[[:space:]]*FAIL\ (.+)\ \(epoch ]]; then
    desc="${BASH_REMATCH[1]}"
    suite=$(classify "$desc")
    SUITE_FAIL[$suite]=$(( ${SUITE_FAIL[$suite]:-0} + 1 ))
  fi
 done < "$TMPLOG"
 # Pull the final pass/total
 TOTAL_PASS=0
 TOTAL_FAIL=0
 for s in "${!SUITE_PASS[@]}"; do
  TOTAL_PASS=$(( TOTAL_PASS + ${SUITE_PASS[$s]:-0} ))
 done
 for s in "${!SUITE_FAIL[@]}"; do
  TOTAL_FAIL=$(( TOTAL_FAIL + ${SUITE_FAIL[$s]:-0} ))
 done
 TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
 # Emit scoreboard.json (suites sorted)
 {
  printf '{\n  "suites": {\n'
  first=1
  for s in $(printf '%s\n' "${!SUITE_PASS[@]}" "${!SUITE_FAIL[@]}" | sort -u); do
    p=${SUITE_PASS[$s]:-0}
    f=${SUITE_FAIL[$s]:-0}
    if [ $first -eq 1 ]; then first=0; else printf ',\n'; fi
    printf '    "%s": {"pass": %d, "fail": %d}' "$s" "$p" "$f"
  done
  printf '\n  },\n'
  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
  printf '  "total": %d\n' "$TOTAL"
  printf '}\n'
 } > "$OUT_JSON"
 # Emit scoreboard.md
 {
  printf '# OCaml-on-SX scoreboard\n\n'
  printf '%d / %d tests passing.\n\n' "$TOTAL_PASS" "$TOTAL"
  printf '| Suite | Pass | Fail |\n'
  printf '|---|---:|---:|\n'
  for s in $(printf '%s\n' "${!SUITE_PASS[@]}" "${!SUITE_FAIL[@]}" | sort -u); do
    p=${SUITE_PASS[$s]:-0}
    f=${SUITE_FAIL[$s]:-0}
    printf '| %s | %d | %d |\n' "$s" "$p" "$f"
  done
 } > "$OUT_MD"
 cat "$OUT_MD"
--- a/lib/ocaml/eval.sx
+++ b/lib/ocaml/eval.sx
@@ -0,0 +1,801 @@
 ;; lib/ocaml/eval.sx — OCaml AST evaluator (Phase 2 slice).
 ;;
 ;; Walks the AST produced by ocaml-parse / ocaml-parse-program and yields
 ;; SX values.
 ;;
 ;; Coverage in this slice:
 ;;   atoms     int/float/string/char/bool/unit
 ;;   :var      env lookup
 ;;   :app      curried application
 ;;   :op       arithmetic, comparison, boolean, ^ string concat, mod, ::
 ;;   :neg      unary minus
 ;;   :not      boolean negation
 ;;   :if       conditional
 ;;   :seq      sequence — discard all but last
 ;;   :tuple    SX (:tuple v1 v2 …)
 ;;   :list     SX list
 ;;   :fun      closure (auto-curried via host SX lambda)
 ;;   :let      non-recursive binding
 ;;   :let-rec  recursive binding for function values (mutable ref cell)
 ;;
 ;; Out of scope: pattern matching, refs (`ref`/`!`/`:=`), modules, ADTs,
 ;; mutable records, for/while, try/with.
 ;;
 ;; Environment representation: an assoc list of (name value) pairs. Most
 ;; recent binding shadows older ones.
 ;; Initial environment provides OCaml stdlib functions that are values,
 ;; not language keywords (e.g. `not`, `succ`, `pred`). Phase 6 adds the
 ;; full stdlib slice; this just unblocks Phase 2 tests.
 (define ocaml-empty-env
  (fn ()
    (list
      (list "not"  (fn (x) (not x)))
      (list "succ" (fn (x) (+ x 1)))
      (list "pred" (fn (x) (- x 1)))
      (list "abs"  (fn (x) (if (< x 0) (- 0 x) x)))
      (list "max"  (fn (a) (fn (b) (if (> a b) a b))))
      (list "min"  (fn (a) (fn (b) (if (< a b) a b))))
      (list "fst"  (fn (p) (nth p 1)))
      (list "snd"  (fn (p) (nth p 2)))
      (list "ignore" (fn (x) nil))
      ;; References. A ref cell is a one-element list; ! reads it and
      ;; := mutates it via set-nth!.
      (list "ref" (fn (x) (list x)))
      ;; Exceptions: `raise e` invokes the host-SX raise; values are
      ;; tagged like other ctors so `try ... with | Exn x -> handler`
      ;; can pattern-match them.
      (list "raise" (fn (e) (raise e)))
      (list "failwith" (fn (msg) (raise (list "Failure" msg))))
      (list "invalid_arg" (fn (msg) (raise (list "Invalid_argument" msg)))
      )
      ;; Host primitives exposed for the OCaml stdlib (lib/ocaml/runtime.sx).
      ;; Underscore-prefixed to avoid clashing with user names.
      (list "_string_length" (fn (s) (len s)))
      (list "_string_get"    (fn (s) (fn (i) (nth s i))))
      (list "_string_sub"    (fn (s) (fn (i) (fn (n) (slice s i (+ i n))))))
      (list "_string_concat" (fn (sep) (fn (xs) (join sep xs))))
      (list "_string_upper"  (fn (s) (upper s)))
      (list "_string_lower"  (fn (s) (lower s)))
      (list "_string_starts_with" (fn (p) (fn (s) (starts-with? s p))))
      (list "_int_of_string" (fn (s) (parse-number s)))
      (list "_string_of_int" (fn (i) (str i)))
      (list "_string_of_float" (fn (f) (str f)))
      (list "_char_code" (fn (c) (char-code c)))
      (list "_char_chr"  (fn (n) (char-from-code n)))
      ;; Print: prints to host stdout via println.
      (list "print_string"  (fn (s) (begin (print s) nil)))
      (list "print_endline" (fn (s) (begin (println s) nil)))
      (list "print_int"     (fn (i) (begin (print (str i)) nil))))))
 (define ocaml-env-lookup
  (fn (env name)
    (cond
      ((= env (list)) nil)
      ((= (first (first env)) name) (nth (first env) 1))
      (else (ocaml-env-lookup (rest env) name)))))
 (define ocaml-env-has?
  (fn (env name)
    (cond
      ((= env (list)) false)
      ((= (first (first env)) name) true)
      (else (ocaml-env-has? (rest env) name)))))
 (define ocaml-env-extend
  (fn (env name val)
    (cons (list name val) env)))
 ;; Resolve a module path / functor-application expression to a module dict.
 ;; Mirrors the field-access escape hatch where `(:con NAME)` is treated as
 ;; an env lookup rather than a nullary ctor; also handles `(:app FN ARG)`
 ;; for functor applications, `(:field …)` for sub-modules, and `(:var …)`
 ;; for lower-case bindings.
 (define ocaml-resolve-module-path
  (fn (path-expr env)
    (let ((tag (ocaml-tag-of path-expr)))
      (cond
        ((= tag "con")
          (cond
            ((ocaml-env-has? env (nth path-expr 1))
              (ocaml-env-lookup env (nth path-expr 1)))
            (else (error (str "ocaml-eval: unknown module " (nth path-expr 1))))))
        ((= tag "var")
          (cond
            ((ocaml-env-has? env (nth path-expr 1))
              (ocaml-env-lookup env (nth path-expr 1)))
            (else (error (str "ocaml-eval: unknown module-var " (nth path-expr 1))))))
        ((= tag "field")
          (let ((parent (ocaml-resolve-module-path (nth path-expr 1) env)))
            (cond
              ((dict? parent) (get parent (nth path-expr 2)))
              (else (error
                (str "ocaml-eval: not a module on path: " parent))))))
        ((= tag "app")
          (let ((fn-val (ocaml-resolve-module-path (nth path-expr 1) env))
                (arg-val (ocaml-resolve-module-path (nth path-expr 2) env)))
            (fn-val arg-val)))
        ((= tag "unit") {})
        (else (ocaml-eval path-expr env))))))
 ;; Merge a dict's bindings into an env (used by `open`/`include`).
 ;; Iterates keys; each (k, get d k) becomes a fresh env binding.
 (define ocaml-env-merge-dict
  (fn (env d)
    (let ((result env) (ks (keys d)))
      (begin
        (define loop
          (fn (xs)
            (when (not (= xs (list)))
              (let ((k (first xs)))
                (begin
                  (set! result (cons (list k (get d k)) result))
                  (loop (rest xs)))))))
        (loop ks)
        result))))
 (define ocaml-tag-of (fn (ast) (nth ast 0)))
 (define ocaml-eval (fn (ast env) nil))
 ;; Pattern matcher — returns the extended env on success, or :fail on
 ;; mismatch (using the keyword :fail so nil values don't ambiguate).
 ;;
 ;; Pattern shapes (from parser):
 ;;   (:pwild)                  match anything, no binding
 ;;   (:pvar NAME)              match anything, bind NAME → val
 ;;   (:plit LITAST)            literal compare
 ;;   (:pcon NAME PATS...)      ctor: val must be (NAME ARGS...) and arity match
 ;;   (:pcons HEAD TAIL)        non-empty list: match head + tail
 ;;   (:plist PATS...)          list of exact length, item-wise match
 ;;   (:ptuple PATS...)         val must be ("tuple" ITEMS...) of same arity
 (define ocaml-match-fail :fail)
 (define ocaml-eval-lit
  (fn (lit-ast)
    (let ((tag (nth lit-ast 0)))
      (cond
        ((= tag "int")    (nth lit-ast 1))
        ((= tag "float")  (nth lit-ast 1))
        ((= tag "string") (nth lit-ast 1))
        ((= tag "char")   (nth lit-ast 1))
        ((= tag "bool")   (nth lit-ast 1))
        ((= tag "unit")   nil)
        (else (error (str "ocaml-eval-lit: bad literal " tag)))))))
 (define ocaml-match-pat (fn (pat val env) ocaml-match-fail))
 (define ocaml-match-list
  (fn (pats vals env)
    (cond
      ((and (= (len pats) 0) (= (len vals) 0)) env)
      ((or (= (len pats) 0) (= (len vals) 0)) ocaml-match-fail)
      (else
        (let ((env2 (ocaml-match-pat (first pats) (first vals) env)))
          (cond
            ((= env2 ocaml-match-fail) ocaml-match-fail)
            (else (ocaml-match-list (rest pats) (rest vals) env2))))))))
 (set! ocaml-match-pat
  (fn (pat val env)
    (let ((tag (nth pat 0)))
      (cond
        ((= tag "pwild") env)
        ((= tag "pvar")
          (ocaml-env-extend env (nth pat 1) val))
        ((= tag "plit")
          (if (= (ocaml-eval-lit (nth pat 1)) val) env ocaml-match-fail))
        ((= tag "pcon")
          ;; (:pcon NAME PATS...) — val must be (NAME VALS...) with same arity.
          (let ((name (nth pat 1)) (arg-pats (rest (rest pat))))
            (cond
              ((and (list? val) (not (empty? val)) (= (first val) name)
                    (= (len (rest val)) (len arg-pats)))
                (ocaml-match-list arg-pats (rest val) env))
              (else ocaml-match-fail))))
        ((= tag "pcons")
          ;; (:pcons HEAD TAIL) — val must be a non-empty list.
          (cond
            ((and (list? val) (not (empty? val))
                  (not (and (not (empty? val)) (string? (first val)))))
              ;; OCaml lists are SX lists (not tagged like ctors). Match
              ;; head pattern against (first val), tail against (rest val).
              (let ((env2 (ocaml-match-pat (nth pat 1) (first val) env)))
                (cond
                  ((= env2 ocaml-match-fail) ocaml-match-fail)
                  (else (ocaml-match-pat (nth pat 2) (rest val) env2)))))
            ;; Allow lists whose first element happens to be a string —
            ;; ambiguous with ctors; treat them as plain lists.
            ((and (list? val) (not (empty? val)))
              (let ((env2 (ocaml-match-pat (nth pat 1) (first val) env)))
                (cond
                  ((= env2 ocaml-match-fail) ocaml-match-fail)
                  (else (ocaml-match-pat (nth pat 2) (rest val) env2)))))
            (else ocaml-match-fail)))
        ((= tag "plist")
          ;; (:plist PATS...) — val must be a list of exact length.
          (let ((item-pats (rest pat)))
            (cond
              ((and (list? val) (= (len val) (len item-pats)))
                (ocaml-match-list item-pats val env))
              (else ocaml-match-fail))))
        ((= tag "ptuple")
          (let ((item-pats (rest pat)))
            (cond
              ((and (list? val) (not (empty? val))
                    (= (first val) "tuple")
                    (= (len (rest val)) (len item-pats)))
                (ocaml-match-list item-pats (rest val) env))
              (else ocaml-match-fail))))
        (else (error (str "ocaml-match-pat: unknown pattern tag " tag)))))))
 (define ocaml-match-clauses
  (fn (val clauses env)
    (begin
      (define try-clauses
        (fn (cs)
          (cond
            ((empty? cs)
              (error (str "ocaml-eval: match failure on " val)))
            (else
              (let ((clause (first cs)))
                (let ((pat (nth clause 1)) (body (nth clause 2)))
                  (let ((env2 (ocaml-match-pat pat val env)))
                    (cond
                      ((= env2 ocaml-match-fail) (try-clauses (rest cs)))
                      (else (ocaml-eval body env2))))))))))
      (try-clauses clauses))))
 (define ocaml-match-eval
  (fn (scrut-ast clauses env)
    (ocaml-match-clauses (ocaml-eval scrut-ast env) clauses env)))
 ;; Auto-curry: (:fun ("x" "y" "z") body) → (fn (x) (fn (y) (fn (z) body))).
 ;; A zero-param lambda evaluates the body immediately on first call —
 ;; OCaml does not have nullary functions; `()`-taking functions still
 ;; receive the unit argument via a one-param lambda.
 (define ocaml-make-curried
  (fn (params body env)
    (cond
      ((= (len params) 0)
        (ocaml-eval body env))
      ((= (len params) 1)
        (fn (arg)
          (ocaml-eval body
            (ocaml-env-extend env (nth params 0) arg))))
      (else
        (fn (arg)
          (ocaml-make-curried
            (rest params)
            body
            (ocaml-env-extend env (nth params 0) arg)))))))
 (define ocaml-eval-op
  (fn (op lhs rhs)
    (cond
      ((= op "+")    (+ lhs rhs))
      ((= op "-")    (- lhs rhs))
      ((= op "*")    (* lhs rhs))
      ((= op "/")    (/ lhs rhs))
      ((= op "mod")  (mod lhs rhs))
      ((= op "%")    (mod lhs rhs))
      ((= op "**")   (pow lhs rhs))
      ((= op "^")    (str lhs rhs))
      ((= op "@")    (concat lhs rhs))
      ((= op "::")   (cons lhs rhs))
      ((= op "=")    (= lhs rhs))
      ((= op "<>")   (not (= lhs rhs)))
      ((= op "==")   (= lhs rhs))
      ((= op "!=")   (not (= lhs rhs)))
      ((= op "<")    (< lhs rhs))
      ((= op ">")    (> lhs rhs))
      ((= op "<=")   (<= lhs rhs))
      ((= op ">=")   (>= lhs rhs))
      ((= op "&&")   (and lhs rhs))
      ((= op "||")   (or lhs rhs))
      ((= op "or")   (or lhs rhs))
      ((= op "|>")   (rhs lhs))
      (else (error (str "ocaml-eval: unknown operator " op))))))
 (set! ocaml-eval
  (fn (ast env)
    (let ((tag (ocaml-tag-of ast)))
      (cond
        ((= tag "int")    (nth ast 1))
        ((= tag "float")  (nth ast 1))
        ((= tag "string") (nth ast 1))
        ((= tag "char")   (nth ast 1))
        ((= tag "bool")   (nth ast 1))
        ((= tag "unit")   nil)
        ((= tag "var")
          (let ((name (nth ast 1)))
            (cond
              ((ocaml-env-has? env name) (ocaml-env-lookup env name))
              (else (error (str "ocaml-eval: unbound variable " name))))))
        ((= tag "neg") (- 0 (ocaml-eval (nth ast 1) env)))
        ((= tag "not") (not (ocaml-eval (nth ast 1) env)))
        ((= tag "deref")
          (let ((cell (ocaml-eval (nth ast 1) env)))
            (nth cell 0)))
        ((= tag "op")
          (let ((op (nth ast 1)))
            (cond
              ;; := mutates the lhs cell — short-circuit before generic
              ;; eval-op so we still evaluate lhs (to obtain the cell).
              ((= op ":=")
                (let ((cell (ocaml-eval (nth ast 2) env))
                      (new-val (ocaml-eval (nth ast 3) env)))
                  (begin (set-nth! cell 0 new-val) nil)))
              (else
                (ocaml-eval-op op
                  (ocaml-eval (nth ast 2) env)
                  (ocaml-eval (nth ast 3) env))))))
        ((= tag "if")
          (if (ocaml-eval (nth ast 1) env)
              (ocaml-eval (nth ast 2) env)
              (ocaml-eval (nth ast 3) env)))
        ((= tag "seq")
          (let ((items (rest ast)) (last nil))
            (begin
              (define loop
                (fn (xs)
                  (when (not (= xs (list)))
                    (begin
                      (set! last (ocaml-eval (first xs) env))
                      (loop (rest xs))))))
              (loop items)
              last)))
        ((= tag "tuple")
          (cons :tuple
            (map (fn (e) (ocaml-eval e env)) (rest ast))))
        ((= tag "list")
          (map (fn (e) (ocaml-eval e env)) (rest ast)))
        ((= tag "fun")
          (ocaml-make-curried (nth ast 1) (nth ast 2) env))
        ((= tag "con")
          ;; Standalone ctor — produces a nullary tagged value.
          (list (nth ast 1)))
        ((= tag "app")
          (let ((fn-ast (nth ast 1)))
            (cond
              ;; Constructor application: build a tagged value, flattening
              ;; a tuple arg into multiple ctor args (so `Pair (a, b)`
              ;; becomes ("Pair" va vb) — matches the parser's pattern
              ;; flattening).
              ((= (ocaml-tag-of fn-ast) "con")
                (let ((name (nth fn-ast 1))
                      (arg-val (ocaml-eval (nth ast 2) env)))
                  (cond
                    ((and (list? arg-val) (not (empty? arg-val))
                          (= (first arg-val) "tuple"))
                      (cons name (rest arg-val)))
                    (else (list name arg-val)))))
              (else
                (let ((fn-val (ocaml-eval fn-ast env))
                      (arg-val (ocaml-eval (nth ast 2) env)))
                  (fn-val arg-val))))))
        ((= tag "match")
          (ocaml-match-eval (nth ast 1) (nth ast 2) env))
        ((= tag "function")
          ;; `function | pat -> body | …` — produces a unary closure that
          ;; matches its argument against the clauses.
          (let ((clauses (nth ast 1)) (captured env))
            (fn (arg) (ocaml-match-clauses arg clauses captured))))
        ((= tag "record")
          (let ((fields (rest ast)) (result {}))
            (begin
              (define loop
                (fn (xs)
                  (when (not (= xs (list)))
                    (let ((kv (first xs)))
                      (let ((k (first kv)) (v (ocaml-eval (nth kv 1) env)))
                        (begin
                          (set! result (merge result (dict k v)))
                          (loop (rest xs))))))))
              (loop fields)
              result)))
        ((= tag "record-update")
          (let ((base-ast (nth ast 1)) (fields (rest (rest ast))))
            (let ((base (ocaml-eval base-ast env)))
              (cond
                ((dict? base)
                  (let ((result base))
                    (begin
                      (define loop
                        (fn (xs)
                          (when (not (= xs (list)))
                            (let ((kv (first xs)))
                              (let ((k (first kv)) (v (ocaml-eval (nth kv 1) env)))
                                (begin
                                  (set! result (merge result (dict k v)))
                                  (loop (rest xs))))))))
                      (loop fields)
                      result)))
                (else (error (str "ocaml-eval: with-update on non-record: " base)))))))
        ((= tag "field")
          ;; `e.name` — evaluate e, expect a dict (record/module), get name.
          ;; Special case: `(:field (:con "M") "x")` looks up M as a module
          ;; binding rather than evaluating it as a nullary ctor.
          (let ((target-ast (nth ast 1)) (fname (nth ast 2)))
            (let ((target
                    (cond
                      ((= (ocaml-tag-of target-ast) "con")
                        (cond
                          ((ocaml-env-has? env (nth target-ast 1))
                            (ocaml-env-lookup env (nth target-ast 1)))
                          (else (list (nth target-ast 1)))))
                      (else (ocaml-eval target-ast env)))))
              (cond
                ((dict? target) (get target fname))
                (else (error
                  (str "ocaml-eval: not a record/module on .field: " target)))))))
        ((= tag "for")
          ;; (:for NAME LO HI DIR BODY) — DIR is "ascend" or "descend".
          (let ((name (nth ast 1))
                (lo (ocaml-eval (nth ast 2) env))
                (hi (ocaml-eval (nth ast 3) env))
                (dir (nth ast 4))
                (body (nth ast 5)))
            (begin
              (cond
                ((= dir "ascend")
                  (let ((i lo))
                    (begin
                      (define loop
                        (fn ()
                          (when (<= i hi)
                            (begin
                              (ocaml-eval body
                                (ocaml-env-extend env name i))
                              (set! i (+ i 1))
                              (loop)))))
                      (loop))))
                ((= dir "descend")
                  (let ((i lo))
                    (begin
                      (define loop
                        (fn ()
                          (when (>= i hi)
                            (begin
                              (ocaml-eval body
                                (ocaml-env-extend env name i))
                              (set! i (- i 1))
                              (loop)))))
                      (loop)))))
              nil)))
        ((= tag "try")
          ;; (:try EXPR CLAUSES) — evaluate EXPR; if it raises, match the
          ;; raised value against CLAUSES. Re-raise on no-match.
          (let ((expr (nth ast 1)) (clauses (nth ast 2)) (env-cap env))
            (guard (e
                    (else
                      (begin
                        (define try-clauses
                          (fn (cs)
                            (cond
                              ((empty? cs) (raise e))
                              (else
                                (let ((clause (first cs)))
                                  (let ((pat (nth clause 1))
                                        (body (nth clause 2)))
                                    (let ((env2 (ocaml-match-pat pat e env-cap)))
                                      (cond
                                        ((= env2 ocaml-match-fail)
                                          (try-clauses (rest cs)))
                                        (else (ocaml-eval body env2))))))))))
                        (try-clauses clauses))))
              (ocaml-eval expr env-cap))))
        ((= tag "while")
          (let ((cond-ast (nth ast 1)) (body (nth ast 2)))
            (begin
              (define loop
                (fn ()
                  (when (ocaml-eval cond-ast env)
                    (begin
                      (ocaml-eval body env)
                      (loop)))))
              (loop)
              nil)))
        ((= tag "let")
          (let ((name (nth ast 1)) (params (nth ast 2))
                (rhs (nth ast 3)) (body (nth ast 4)))
            (let ((rhs-val
                    (if (= (len params) 0)
                        (ocaml-eval rhs env)
                        (ocaml-make-curried params rhs env))))
              (ocaml-eval body (ocaml-env-extend env name rhs-val)))))
        ((= tag "let-rec")
          ;; Tie the knot via a mutable cell when rhs is function-typed.
          ;; The placeholder closure dereferences the cell on each call.
          (let ((name (nth ast 1)) (params (nth ast 2))
                (rhs (nth ast 3)) (body (nth ast 4)))
            (let ((rhs-fn?
                    (or (> (len params) 0)
                        (= (ocaml-tag-of rhs) "fun")
                        (= (ocaml-tag-of rhs) "function"))))
              (cond
                (rhs-fn?
                  (let ((cell (list nil)))
                    (let ((env2 (ocaml-env-extend env name
                                  (fn (arg) ((nth cell 0) arg)))))
                      (let ((rhs-val
                              (if (= (len params) 0)
                                  (ocaml-eval rhs env2)
                                  (ocaml-make-curried params rhs env2))))
                        (begin
                          (set-nth! cell 0 rhs-val)
                          (ocaml-eval body env2))))))
                (else
                  (let ((rhs-val (ocaml-eval rhs env)))
                    (ocaml-eval body
                      (ocaml-env-extend env name rhs-val))))))))
        (else (error
          (str "ocaml-eval: unknown AST tag " tag)))))))
 ;; ocaml-make-functor — build a curried host-SX closure that accepts
 ;; argument modules (one per param) and returns the resulting module dict
 ;; produced by evaluating the functor's body.
 (define ocaml-make-functor
  (fn (params decls captured-env)
    (cond
      ((= (len params) 1)
        (fn (arg-mod)
          (ocaml-eval-module decls
            (ocaml-env-extend captured-env (first params) arg-mod))))
      (else
        (fn (arg-mod)
          (ocaml-make-functor (rest params) decls
            (ocaml-env-extend captured-env (first params) arg-mod)))))))
 ;; ocaml-eval-module — evaluate a list of decls in a fresh sub-env layered
 ;; on top of the parent. Returns a dict mapping each declared name to its
 ;; value. Used by `module M = struct DECLS end`.
 (define ocaml-eval-module
  (fn (decls parent-env)
    (let ((env parent-env) (result {}))
      (begin
        (define run-decl
          (fn (decl)
            (let ((tag (ocaml-tag-of decl)))
              (cond
                ((= tag "def")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((v (if (= (len params) 0)
                                 (ocaml-eval rhs env)
                                 (ocaml-make-curried params rhs env))))
                      (begin
                        (set! env (ocaml-env-extend env name v))
                        (set! result (merge result (dict name v)))))))
                ((= tag "def-rec")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((rhs-fn?
                            (or (> (len params) 0)
                                (= (ocaml-tag-of rhs) "fun")
                                (= (ocaml-tag-of rhs) "function"))))
                      (cond
                        (rhs-fn?
                          (let ((cell (list nil)))
                            (let ((env2 (ocaml-env-extend env name
                                          (fn (arg) ((nth cell 0) arg)))))
                              (let ((v (if (= (len params) 0)
                                           (ocaml-eval rhs env2)
                                           (ocaml-make-curried params rhs env2))))
                                (begin
                                  (set-nth! cell 0 v)
                                  (set! env env2)
                                  (set! result (merge result (dict name v))))))))
                        (else
                          (let ((v (ocaml-eval rhs env)))
                            (begin
                              (set! env (ocaml-env-extend env name v))
                              (set! result (merge result (dict name v))))))))))
                ((= tag "expr")
                  (ocaml-eval (nth decl 1) env))
                ((= tag "module-def")
                  (let ((mname (nth decl 1)) (mdecls (nth decl 2)))
                    (let ((mod-val (ocaml-eval-module mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname mod-val))
                        (set! result (merge result (dict mname mod-val)))))))
                ((= tag "functor-def")
                  (let ((mname (nth decl 1))
                        (mparams (nth decl 2))
                        (mdecls (nth decl 3)))
                    (let ((fn-val (ocaml-make-functor mparams mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname fn-val))
                        (set! result (merge result (dict mname fn-val)))))))
                ((= tag "module-alias")
                  (let ((mname (nth decl 1)) (body-src (nth decl 2)))
                    (let ((body-expr (ocaml-parse body-src)))
                      (let ((mod-val (ocaml-resolve-module-path body-expr env)))
                        (begin
                          (set! env (ocaml-env-extend env mname mod-val))
                          (set! result (merge result (dict mname mod-val))))))))
                ((= tag "open")
                  (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
                    (cond
                      ((dict? mod-val)
                        (set! env (ocaml-env-merge-dict env mod-val)))
                      (else (error
                        (str "ocaml-eval: open on non-module: " mod-val))))))
                ((= tag "include")
                  ;; `include M` brings M's bindings into scope AND into
                  ;; the surrounding module's exports.
                  (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
                    (cond
                      ((dict? mod-val)
                        (begin
                          (set! env (ocaml-env-merge-dict env mod-val))
                          (set! result (merge result mod-val))))
                      (else (error
                        (str "ocaml-eval: include on non-module: " mod-val))))))
                (else (error (str "ocaml-eval-module: bad decl " tag)))))))
        (define loop
          (fn (xs)
            (when (not (= xs (list)))
              (begin (run-decl (first xs)) (loop (rest xs))))))
        (loop decls)
        result))))
 ;; ocaml-run — convenience wrapper: parse + eval. Layers the stdlib env
 ;; (List, Option, Result) underneath the empty env so user code can use
 ;; `List.map` etc. without explicit setup.
 ;; Variable guarded so eval.sx is loadable without runtime.sx. runtime.sx
 ;; sets ocaml-stdlib-env once loaded; before that, fall back to the empty
 ;; env so the existing tests continue to work without stdlib.
 (define ocaml-stdlib-env nil)
 (define ocaml-base-env
  (fn ()
    (cond
      ((not (= ocaml-stdlib-env nil)) ocaml-stdlib-env)
      (else (ocaml-empty-env)))))
 (define ocaml-run
  (fn (src)
    (ocaml-eval (ocaml-parse src) (ocaml-base-env))))
 ;; ocaml-run-program — evaluate a program (sequence of decls + bare exprs).
 ;; Threads an env through decls; returns the value of the last form.
 (define ocaml-run-program
  (fn (src)
    (let ((prog (ocaml-parse-program src)) (env (ocaml-base-env)) (last nil))
      (begin
        (define run-decl
          (fn (decl)
            (let ((tag (ocaml-tag-of decl)))
              (cond
                ((= tag "def")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((v (if (= (len params) 0)
                                 (ocaml-eval rhs env)
                                 (ocaml-make-curried params rhs env))))
                      (begin
                        (set! env (ocaml-env-extend env name v))
                        (set! last v)))))
                ((= tag "def-rec")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((rhs-fn?
                            (or (> (len params) 0)
                                (= (ocaml-tag-of rhs) "fun")
                                (= (ocaml-tag-of rhs) "function"))))
                      (cond
                        (rhs-fn?
                          (let ((cell (list nil)))
                            (let ((env2 (ocaml-env-extend env name
                                          (fn (arg) ((nth cell 0) arg)))))
                              (let ((v
                                      (if (= (len params) 0)
                                          (ocaml-eval rhs env2)
                                          (ocaml-make-curried params rhs env2))))
                                (begin
                                  (set-nth! cell 0 v)
                                  (set! env env2)
                                  (set! last v))))))
                        (else
                          (let ((v (ocaml-eval rhs env)))
                            (begin
                              (set! env (ocaml-env-extend env name v))
                              (set! last v))))))))
                ((= tag "def-mut")
                  ;; let x = ... and y = ... — non-recursive; each rhs is
                  ;; evaluated in the parent env, then all names bind in
                  ;; sequence.
                  (let ((bs (nth decl 1)))
                    (begin
                      (define run-one
                        (fn (b)
                          (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                            (let ((v (if (= (len ps) 0)
                                         (ocaml-eval rh env)
                                         (ocaml-make-curried ps rh env))))
                              (begin
                                (set! env (ocaml-env-extend env nm v))
                                (set! last v))))))
                      (define loop
                        (fn (xs)
                          (when (not (= xs (list)))
                            (begin (run-one (first xs)) (loop (rest xs))))))
                      (loop bs))))
                ((= tag "def-rec-mut")
                  ;; let rec f = ... and g = ... — mutually recursive;
                  ;; bind all names with placeholder cells first, then
                  ;; evaluate each rhs in the joint env, finally fill cells.
                  (let ((bs (nth decl 1)) (cells (list)) (env2 env))
                    (begin
                      (define alloc
                        (fn (xs)
                          (when (not (= xs (list)))
                            (let ((b (first xs)))
                              (let ((c (list nil)) (nm (nth b 0)))
                                (begin
                                  (append! cells c)
                                  (set! env2 (ocaml-env-extend env2 nm
                                               (fn (a) ((nth c 0) a))))
                                  (alloc (rest xs))))))))
                      (alloc bs)
                      (let ((idx 0))
                        (begin
                          (define fill
                            (fn (xs)
                              (when (not (= xs (list)))
                                (let ((b (first xs)))
                                  (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                                    (let ((v (if (= (len ps) 0)
                                                 (ocaml-eval rh env2)
                                                 (ocaml-make-curried ps rh env2))))
                                      (begin
                                        (set-nth! (nth cells idx) 0 v)
                                        (set! idx (+ idx 1))
                                        (set! last v)
                                        (fill (rest xs)))))))))
                          (fill bs)
                          (set! env env2))))))
                ((= tag "expr")
                  (set! last (ocaml-eval (nth decl 1) env)))
                ((= tag "module-def")
                  ;; module M = struct DECLS end — evaluate the inner
                  ;; decls in a fresh sub-env layered on the current
                  ;; one, then collect the new bindings into a dict that
                  ;; we bind under M.
                  (let ((mname (nth decl 1)) (mdecls (nth decl 2)))
                    (let ((mod-val (ocaml-eval-module mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname mod-val))
                        (set! last mod-val)))))
                ((= tag "functor-def")
                  ;; module F (M1) (M2) ... = struct DECLS end — bind F
                  ;; to a curried function from module dicts to a module
                  ;; dict.
                  (let ((mname (nth decl 1))
                        (mparams (nth decl 2))
                        (mdecls (nth decl 3)))
                    (let ((functor-val
                            (ocaml-make-functor mparams mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname functor-val))
                        (set! last functor-val)))))
                ((= tag "module-alias")
                  ;; module N = M  /  module N = F(A)  /  module N = M.Sub
                  (let ((mname (nth decl 1)) (body-src (nth decl 2)))
                    (let ((body-expr (ocaml-parse body-src)))
                      (let ((mod-val (ocaml-resolve-module-path body-expr env)))
                        (begin
                          (set! env (ocaml-env-extend env mname mod-val))
                          (set! last mod-val))))))
                ((or (= tag "open") (= tag "include"))
                  ;; open M / include M — bring M's bindings into scope.
                  (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
                    (cond
                      ((dict? mod-val)
                        (begin
                          (set! env (ocaml-env-merge-dict env mod-val))
                          (set! last mod-val)))
                      (else (error (str "ocaml-eval: open/include on non-module: " mod-val))))))
                (else (error (str "ocaml-run-program: bad decl " tag)))))))
        (define loop
          (fn (xs)
            (when (not (= xs (list)))
              (begin (run-decl (first xs)) (loop (rest xs))))))
        (loop (rest prog))
        last))))
--- a/lib/ocaml/infer.sx
+++ b/lib/ocaml/infer.sx
@@ -0,0 +1,209 @@
 ;; lib/ocaml/infer.sx — Algorithm W type inference for OCaml-on-SX.
 ;;
 ;; Consumes lib/guest/hm.sx (algebra) and lib/guest/match.sx (unify) per
 ;; the Phase 5 sequencing. The kit ships fresh-tv, generalize,
 ;; instantiate, and substitution composition; this file assembles the
 ;; lambda / app / let / if rules of Algorithm W against the OCaml AST.
 ;;
 ;; Coverage in this slice (atoms + core forms):
 ;;   :int :float :string :char :bool :unit :var :fun :app :let :if
 ;;   :op (with builtin signatures for +, -, *, /, mod, comparisons, &&, ||)
 ;;
 ;; Out of scope: pattern matching, tuples, lists (need product/list types
 ;; first), records, modules, ADTs, let-rec.
 ;;
 ;; Inference state:
 ;;   env     — dict: name → scheme
 ;;   counter — one-element list (mutable cell) used by hm-fresh-tv
 ;;
 ;; Returned value: {:subst S :type T}.
 (define ocaml-hm-counter (fn () (list 0)))
 (define ocaml-hm-empty-subst (fn () {}))
 (define ocaml-hm-builtin-env
  (fn ()
    (let ((int-int-int (hm-arrow (hm-int) (hm-arrow (hm-int) (hm-int))))
          (int-int-bool (hm-arrow (hm-int) (hm-arrow (hm-int) (hm-bool))))
          (bool-bool-bool (hm-arrow (hm-bool) (hm-arrow (hm-bool) (hm-bool))))
          (str-str-str (hm-arrow (hm-string) (hm-arrow (hm-string) (hm-string))))
          (any-any-bool
            (let ((a (hm-tv "a")))
              (hm-scheme (list "a")
                (hm-arrow a (hm-arrow a (hm-bool))))))
          (a->a
            (let ((a (hm-tv "a")))
              (hm-scheme (list "a") (hm-arrow a a)))))
      {"+"  (hm-monotype int-int-int)
       "-"  (hm-monotype int-int-int)
       "*"  (hm-monotype int-int-int)
       "/"  (hm-monotype int-int-int)
       "mod" (hm-monotype int-int-int)
       "%"  (hm-monotype int-int-int)
       "**" (hm-monotype int-int-int)
       "<"  (hm-monotype int-int-bool)
       ">"  (hm-monotype int-int-bool)
       "<=" (hm-monotype int-int-bool)
       ">=" (hm-monotype int-int-bool)
       "=" any-any-bool
       "<>" any-any-bool
       "&&" (hm-monotype bool-bool-bool)
       "||" (hm-monotype bool-bool-bool)
       "^"  (hm-monotype str-str-str)
       "not" (hm-monotype (hm-arrow (hm-bool) (hm-bool)))
       "succ" (hm-monotype (hm-arrow (hm-int) (hm-int)))
       "pred" (hm-monotype (hm-arrow (hm-int) (hm-int)))
       "abs"  (hm-monotype (hm-arrow (hm-int) (hm-int)))})))
 (define ocaml-infer (fn (expr env counter) nil))
 ;; Unify two types; raise on failure. The match.sx unify returns nil on
 ;; failure so we wrap it for clearer errors.
 (define ocaml-hm-unify
  (fn (t1 t2 subst)
    (let ((s2 (unify t1 t2 subst)))
      (cond
        ((= s2 nil)
          (error (str "ocaml-infer: cannot unify " t1 " with " t2)))
        (else s2)))))
 ;; Look up name; instantiate scheme to a fresh monotype.
 (define ocaml-infer-var
  (fn (name env counter)
    (cond
      ((has-key? env name)
        (let ((scheme (get env name)))
          (let ((t (hm-instantiate scheme counter)))
            {:subst {} :type t})))
      (else (error (str "ocaml-infer: unbound variable " name))))))
 (define ocaml-infer-app
  (fn (fn-expr arg-expr env counter)
    (let ((r1 (ocaml-infer fn-expr env counter)))
      (let ((s1 (get r1 :subst)) (t1 (get r1 :type)))
        (let ((env2 (hm-apply-env s1 env)))
          (let ((r2 (ocaml-infer arg-expr env2 counter)))
            (let ((s2 (get r2 :subst)) (t2 (get r2 :type)))
              (let ((tv (hm-fresh-tv counter)))
                (let ((s3 (ocaml-hm-unify
                            (hm-apply s2 t1)
                            (hm-arrow t2 tv)
                            (hm-compose s2 s1))))
                  {:subst s3 :type (hm-apply s3 tv)})))))))))
 (define ocaml-infer-fun
  (fn (params body env counter)
    (cond
      ((= (len params) 0)
        (error "ocaml-infer: fun without params"))
      ((= (len params) 1)
        (let ((tv (hm-fresh-tv counter)))
          (let ((env2 (assoc env (first params) (hm-monotype tv))))
            (let ((r (ocaml-infer body env2 counter)))
              (let ((s (get r :subst)) (t-body (get r :type)))
                {:subst s
                 :type (hm-arrow (hm-apply s tv) t-body)})))))
      (else
        ;; Curry: fun x y -> e ≡ fun x -> fun y -> e
        (let ((tv (hm-fresh-tv counter)))
          (let ((env2 (assoc env (first params) (hm-monotype tv))))
            (let ((r (ocaml-infer-fun (rest params) body env2 counter)))
              (let ((s (get r :subst)) (t-rest (get r :type)))
                {:subst s
                 :type (hm-arrow (hm-apply s tv) t-rest)}))))))))
 (define ocaml-infer-let
  (fn (name params rhs body env counter)
    (let ((rhs-expr (cond
                      ((= (len params) 0) rhs)
                      (else (list :fun params rhs)))))
      (let ((r1 (ocaml-infer rhs-expr env counter)))
        (let ((s1 (get r1 :subst)) (t1 (get r1 :type)))
          (let ((env2 (hm-apply-env s1 env)))
            (let ((scheme (hm-generalize t1 env2)))
              (let ((env3 (assoc env2 name scheme)))
                (let ((r2 (ocaml-infer body env3 counter)))
                  (let ((s2 (get r2 :subst)) (t2 (get r2 :type)))
                    {:subst (hm-compose s2 s1) :type t2}))))))))))
 (define ocaml-infer-if
  (fn (c-ast t-ast e-ast env counter)
    (let ((rc (ocaml-infer c-ast env counter)))
      (let ((sc (get rc :subst)) (tc (get rc :type)))
        (let ((sc2 (ocaml-hm-unify tc (hm-bool) sc)))
          (let ((env2 (hm-apply-env sc2 env)))
            (let ((rt (ocaml-infer t-ast env2 counter)))
              (let ((st (get rt :subst)) (tt (get rt :type)))
                (let ((env3 (hm-apply-env st env2)))
                  (let ((re (ocaml-infer e-ast env3 counter)))
                    (let ((se (get re :subst)) (te (get re :type)))
                      (let ((sf (ocaml-hm-unify
                                  (hm-apply se tt)
                                  te
                                  (hm-compose se (hm-compose st sc2)))))
                        {:subst sf
                         :type (hm-apply sf te)}))))))))))))
 (set! ocaml-infer
  (fn (expr env counter)
    (let ((tag (nth expr 0)))
      (cond
        ((= tag "int")    {:subst {} :type (hm-int)})
        ((= tag "float")  {:subst {} :type (hm-int)})  ;; treat float as int for now
        ((= tag "string") {:subst {} :type (hm-string)})
        ((= tag "char")   {:subst {} :type (hm-string)})
        ((= tag "bool")   {:subst {} :type (hm-bool)})
        ((= tag "unit")   {:subst {} :type (hm-con "Unit" (list))})
        ((= tag "var")    (ocaml-infer-var (nth expr 1) env counter))
        ((= tag "fun")    (ocaml-infer-fun (nth expr 1) (nth expr 2) env counter))
        ((= tag "app")    (ocaml-infer-app (nth expr 1) (nth expr 2) env counter))
        ((= tag "let")    (ocaml-infer-let (nth expr 1) (nth expr 2)
                                           (nth expr 3) (nth expr 4) env counter))
        ((= tag "if")     (ocaml-infer-if (nth expr 1) (nth expr 2)
                                          (nth expr 3) env counter))
        ((= tag "neg")
          (let ((r (ocaml-infer (nth expr 1) env counter)))
            (let ((s (get r :subst)) (t (get r :type)))
              (let ((s2 (ocaml-hm-unify t (hm-int) s)))
                {:subst s2 :type (hm-int)}))))
        ((= tag "not")
          (let ((r (ocaml-infer (nth expr 1) env counter)))
            (let ((s (get r :subst)) (t (get r :type)))
              (let ((s2 (ocaml-hm-unify t (hm-bool) s)))
                {:subst s2 :type (hm-bool)}))))
        ((= tag "op")
          ;; Treat (:op OP L R) as (:app (:app (:var OP) L) R) — same rule.
          (ocaml-infer
            (list :app (list :app (list :var (nth expr 1)) (nth expr 2)) (nth expr 3))
            env counter))
        (else (error (str "ocaml-infer: unsupported tag " tag)))))))
 ;; Top-level convenience: parse + infer + render the type.
 (define ocaml-type-of
  (fn (src)
    (let ((expr (ocaml-parse src))
          (env (ocaml-hm-builtin-env))
          (counter (ocaml-hm-counter)))
      (let ((r (ocaml-infer expr env counter)))
        (ocaml-hm-format-type (hm-apply (get r :subst) (get r :type)))))))
 ;; Pretty-print a type as an OCaml-style string for testing. Only handles
 ;; the constructors we use: Int / Bool / String / Unit / -> / type-vars.
 (define ocaml-hm-format-type
  (fn (t)
    (cond
      ((is-var? t) (str "'" (var-name t)))
      ((is-ctor? t)
        (let ((head (ctor-head t)) (args (ctor-args t)))
          (cond
            ((= head "->")
              (let ((a (nth args 0)) (b (nth args 1)))
                (str
                  (cond
                    ((and (is-ctor? a) (= (ctor-head a) "->"))
                      (str "(" (ocaml-hm-format-type a) ")"))
                    (else (ocaml-hm-format-type a)))
                  " -> " (ocaml-hm-format-type b))))
            (else head))))
      (else (str t)))))
--- a/lib/ocaml/parser.sx
+++ b/lib/ocaml/parser.sx
--- a/lib/ocaml/runtime.sx
+++ b/lib/ocaml/runtime.sx
@@ -0,0 +1,207 @@
 ;; lib/ocaml/runtime.sx — minimal OCaml stdlib slice, written in OCaml.
 ;;
 ;; Defines List and Option modules with the most-used functions. Loaded
 ;; on demand via `(ocaml-load-stdlib! env)` from eval.sx, which parses
 ;; this source through `ocaml-parse-program` and evaluates each decl,
 ;; threading the env so stdlib bindings become available to user code.
 ;;
 ;; What's here is intentionally minimal — Phase 6 grows this into the
 ;; full ~150-function slice. Everything is defined in OCaml syntax (not
 ;; SX) on purpose, both as substrate validation and as documentation.
 (define ocaml-stdlib-src
  "module List = struct
     let rec length lst =
       match lst with
       | [] -> 0
       | _ :: t -> 1 + length t
     let rec rev_append xs acc =
       match xs with
       | [] -> acc
       | h :: t -> rev_append t (h :: acc)
     let rev xs = rev_append xs []
     let rec map f lst =
       match lst with
       | [] -> []
       | h :: t -> f h :: map f t
     let rec filter p lst =
       match lst with
       | [] -> []
       | h :: t -> if p h then h :: filter p t else filter p t
     let rec fold_left f init lst =
       match lst with
       | [] -> init
       | h :: t -> fold_left f (f init h) t
     let rec fold_right f lst init =
       match lst with
       | [] -> init
       | h :: t -> f h (fold_right f t init)
     let rec append xs ys =
       match xs with
       | [] -> ys
       | h :: t -> h :: append t ys
     let rec iter f lst =
       match lst with
       | [] -> ()
       | h :: t -> f h; iter f t
     let rec mem x lst =
       match lst with
       | [] -> false
       | h :: t -> if h = x then true else mem x t
     let rec for_all p lst =
       match lst with
       | [] -> true
       | h :: t -> if p h then for_all p t else false
     let rec exists p lst =
       match lst with
       | [] -> false
       | h :: t -> if p h then true else exists p t
     let hd lst =
       match lst with
       | [] -> failwith \"List.hd: empty\"
       | h :: _ -> h
     let tl lst =
       match lst with
       | [] -> failwith \"List.tl: empty\"
       | _ :: t -> t
     let rec nth lst n =
       match lst with
       | [] -> failwith \"List.nth: out of range\"
       | h :: t -> if n = 0 then h else nth t (n - 1)
   end ;;
   module Option = struct
     let map f o =
       match o with
       | None -> None
       | Some x -> Some (f x)
     let bind o f =
       match o with
       | None -> None
       | Some x -> f x
     let value o default =
       match o with
       | None -> default
       | Some x -> x
     let get o =
       match o with
       | None -> failwith \"Option.get: None\"
       | Some x -> x
     let is_none o =
       match o with
       | None -> true
       | Some _ -> false
     let is_some o =
       match o with
       | None -> false
       | Some _ -> true
   end ;;
   module Result = struct
     let map f r =
       match r with
       | Ok x -> Ok (f x)
       | Error e -> Error e
     let bind r f =
       match r with
       | Ok x -> f x
       | Error e -> Error e
     let is_ok r =
       match r with
       | Ok _ -> true
       | Error _ -> false
     let is_error r =
       match r with
       | Ok _ -> false
       | Error _ -> true
   end ;;
   module String = struct
     let length s = _string_length s
     let get s i = _string_get s i
     let sub s i n = _string_sub s i n
     let concat sep xs = _string_concat sep xs
     let uppercase_ascii s = _string_upper s
     let lowercase_ascii s = _string_lower s
     let starts_with prefix s = _string_starts_with prefix s
   end ;;
   module Char = struct
     let code c = _char_code c
     let chr n = _char_chr n
     let lowercase_ascii c = _string_lower c
     let uppercase_ascii c = _string_upper c
   end ;;
   module Int = struct
     let to_string i = _string_of_int i
     let of_string s = _int_of_string s
     let abs n = if n < 0 then 0 - n else n
     let max a b = if a > b then a else b
     let min a b = if a < b then a else b
   end ;;
   module Float = struct
     let to_string f = _string_of_float f
   end ;;
   module Printf = struct
     let sprintf fmt = fmt
     let printf fmt = print_string fmt
   end")
 (define ocaml-stdlib-loaded false)
 (define ocaml-stdlib-env nil)
 ;; Build a stdlib env once, cache it. ocaml-run / ocaml-run-program both
 ;; layer the user program on top of this base env.
 (define ocaml-load-stdlib!
  (fn ()
    (when (not ocaml-stdlib-loaded)
      (let ((env (ocaml-empty-env)))
        (begin
          (define run-decl
            (fn (decl)
              (let ((tag (ocaml-tag-of decl)))
                (cond
                  ((= tag "module-def")
                    (let ((mn (nth decl 1)) (ds (nth decl 2)))
                      (let ((mv (ocaml-eval-module ds env)))
                        (set! env (ocaml-env-extend env mn mv)))))
                  ((= tag "def")
                    (let ((nm (nth decl 1)) (ps (nth decl 2)) (rh (nth decl 3)))
                      (let ((v (if (= (len ps) 0)
                                   (ocaml-eval rh env)
                                   (ocaml-make-curried ps rh env))))
                        (set! env (ocaml-env-extend env nm v)))))))))
          (let ((prog (ocaml-parse-program ocaml-stdlib-src)))
            (begin
              (define loop
                (fn (xs)
                  (when (not (= xs (list)))
                    (begin (run-decl (first xs)) (loop (rest xs))))))
              (loop (rest prog))
              (set! ocaml-stdlib-env env)
              (set! ocaml-stdlib-loaded true))))))))
--- a/lib/ocaml/scoreboard.json
+++ b/lib/ocaml/scoreboard.json
@@ -0,0 +1,21 @@
 {
  "suites": {
    "eval-core": {"pass": 47, "fail": 0},
    "let-and": {"pass": 3, "fail": 0},
    "misc": {"pass": 39, "fail": 0},
    "parser": {"pass": 85, "fail": 0},
    "phase1-params": {"pass": 2, "fail": 0},
    "phase2-exn": {"pass": 6, "fail": 0},
    "phase2-function": {"pass": 3, "fail": 0},
    "phase2-loops": {"pass": 4, "fail": 0},
    "phase2-refs": {"pass": 6, "fail": 0},
    "phase3-adt": {"pass": 13, "fail": 0},
    "phase4-modules": {"pass": 12, "fail": 0},
    "phase5-hm": {"pass": 17, "fail": 0},
    "phase6-stdlib": {"pass": 29, "fail": 0},
    "tokenize": {"pass": 18, "fail": 0}
  },
  "total_pass": 284,
  "total_fail": 0,
  "total": 284
 }
--- a/lib/ocaml/scoreboard.md
+++ b/lib/ocaml/scoreboard.md
@@ -0,0 +1,20 @@
 # OCaml-on-SX scoreboard
 284 / 284 tests passing.
 | Suite | Pass | Fail |
 |---|---:|---:|
 | eval-core | 47 | 0 |
 | let-and | 3 | 0 |
 | misc | 39 | 0 |
 | parser | 85 | 0 |
 | phase1-params | 2 | 0 |
 | phase2-exn | 6 | 0 |
 | phase2-function | 3 | 0 |
 | phase2-loops | 4 | 0 |
 | phase2-refs | 6 | 0 |
 | phase3-adt | 13 | 0 |
 | phase4-modules | 12 | 0 |
 | phase5-hm | 17 | 0 |
 | phase6-stdlib | 29 | 0 |
 | tokenize | 18 | 0 |
--- a/lib/ocaml/test.sh
+++ b/lib/ocaml/test.sh
--- a/lib/ocaml/tests/tokenize.sx
+++ b/lib/ocaml/tests/tokenize.sx
@@ -0,0 +1,21 @@
 ;; lib/ocaml/tests/tokenize.sx — smoke-test helpers.
 ;;
 ;; Tests are exercised via lib/ocaml/test.sh, which drives sx_server.exe
 ;; over the epoch protocol. This file provides small accessors so the
 ;; bash runner can grep short diagnostic values out of one batched run.
 (define
  ocaml-test-tok-type
  (fn (src i) (get (nth (ocaml-tokenize src) i) :type)))
 (define
  ocaml-test-tok-value
  (fn (src i) (get (nth (ocaml-tokenize src) i) :value)))
 (define ocaml-test-tok-count (fn (src) (len (ocaml-tokenize src))))
 (define ocaml-test-parse-str (fn (src) (ocaml-parse src)))
 (define
  ocaml-test-parse-head
  (fn (src) (nth (ocaml-parse src) 0)))
--- a/lib/ocaml/tokenizer.sx
+++ b/lib/ocaml/tokenizer.sx
@@ -0,0 +1,382 @@
 ;; lib/ocaml/tokenizer.sx — OCaml lexer.
 ;;
 ;; Tokens: ident, ctor (uppercase ident), keyword, number, string, char, op, eof.
 ;; Token shape: {:type :value :pos} via lex-make-token.
 ;; OCaml is not indentation-sensitive — no layout pass.
 ;; Block comments (* ... *) nest. There is no line-comment syntax.
 (prefix-rename
  "ocaml-"
  (quote
    ((make-token lex-make-token)
      (digit? lex-digit?)
      (hex-digit? lex-hex-digit?)
      (alpha? lex-alpha?)
      (alnum? lex-alnum?)
      (ident-start? lex-ident-start?)
      (ident-char? lex-ident-char?)
      (ws? lex-whitespace?))))
 (define
  ocaml-keywords
  (list
    "and"
    "as"
    "assert"
    "begin"
    "class"
    "constraint"
    "do"
    "done"
    "downto"
    "else"
    "end"
    "exception"
    "external"
    "false"
    "for"
    "fun"
    "function"
    "functor"
    "if"
    "in"
    "include"
    "inherit"
    "initializer"
    "lazy"
    "let"
    "match"
    "method"
    "module"
    "mutable"
    "new"
    "nonrec"
    "object"
    "of"
    "open"
    "or"
    "private"
    "rec"
    "sig"
    "struct"
    "then"
    "to"
    "true"
    "try"
    "type"
    "val"
    "virtual"
    "when"
    "while"
    "with"
    "land"
    "lor"
    "lxor"
    "lsl"
    "lsr"
    "asr"
    "mod"))
 (define ocaml-keyword? (fn (word) (contains? ocaml-keywords word)))
 (define
  ocaml-upper?
  (fn (c) (and (not (= c nil)) (>= c "A") (<= c "Z"))))
 (define
  ocaml-tokenize
  (fn
    (src)
    (let
      ((tokens (list)) (pos 0) (src-len (len src)))
      (define
        ocaml-peek
        (fn
          (offset)
          (if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
      (define cur (fn () (ocaml-peek 0)))
      (define advance! (fn (n) (set! pos (+ pos n))))
      (define
        push!
        (fn
          (type value start)
          (append! tokens (ocaml-make-token type value start))))
      (define
        skip-block-comment!
        (fn
          (depth)
          (cond
            ((>= pos src-len) nil)
            ((and (= (cur) "*") (= (ocaml-peek 1) ")"))
              (begin
                (advance! 2)
                (when
                  (> depth 1)
                  (skip-block-comment! (- depth 1)))))
            ((and (= (cur) "(") (= (ocaml-peek 1) "*"))
              (begin
                (advance! 2)
                (skip-block-comment! (+ depth 1))))
            (else (begin (advance! 1) (skip-block-comment! depth))))))
      (define
        skip-ws!
        (fn
          ()
          (cond
            ((>= pos src-len) nil)
            ((ocaml-ws? (cur)) (begin (advance! 1) (skip-ws!)))
            ((and (= (cur) "(") (= (ocaml-peek 1) "*"))
              (begin
                (advance! 2)
                (skip-block-comment! 1)
                (skip-ws!)))
            (else nil))))
      (define
        read-ident
        (fn
          (start)
          (begin
            (when
              (and (< pos src-len) (ocaml-ident-char? (cur)))
              (begin (advance! 1) (read-ident start)))
            (when
              (and (< pos src-len) (= (cur) "'"))
              (begin (advance! 1) (read-ident start)))
            (slice src start pos))))
      (define
        read-decimal-digits!
        (fn
          ()
          (when
            (and (< pos src-len) (or (ocaml-digit? (cur)) (= (cur) "_")))
            (begin (advance! 1) (read-decimal-digits!)))))
      (define
        read-hex-digits!
        (fn
          ()
          (when
            (and
              (< pos src-len)
              (or (ocaml-hex-digit? (cur)) (= (cur) "_")))
            (begin (advance! 1) (read-hex-digits!)))))
      (define
        read-exp-part!
        (fn
          ()
          (when
            (and (< pos src-len) (or (= (cur) "e") (= (cur) "E")))
            (let
              ((p1 (ocaml-peek 1)))
              (when
                (or
                  (and (not (= p1 nil)) (ocaml-digit? p1))
                  (and
                    (or (= p1 "+") (= p1 "-"))
                    (< (+ pos 2) src-len)
                    (ocaml-digit? (ocaml-peek 2))))
                (begin
                  (advance! 1)
                  (when
                    (and
                      (< pos src-len)
                      (or (= (cur) "+") (= (cur) "-")))
                    (advance! 1))
                  (read-decimal-digits!)))))))
      (define
        strip-underscores
        (fn
          (s)
          (let
            ((out (list)) (i 0) (n (len s)))
            (begin
              (define
                loop
                (fn
                  ()
                  (when
                    (< i n)
                    (begin
                      (when
                        (not (= (nth s i) "_"))
                        (append! out (nth s i)))
                      (set! i (+ i 1))
                      (loop)))))
              (loop)
              (join "" out)))))
      (define
        read-number
        (fn
          (start)
          (cond
            ((and (= (cur) "0") (< (+ pos 1) src-len) (or (= (ocaml-peek 1) "x") (= (ocaml-peek 1) "X")))
              (begin
                (advance! 2)
                (read-hex-digits!)
                (let
                  ((raw (slice src (+ start 2) pos)))
                  (parse-number (str "0x" (strip-underscores raw))))))
            (else
              (begin
                (read-decimal-digits!)
                (when
                  (and
                    (< pos src-len)
                    (= (cur) ".")
                    (or
                      (>= (+ pos 1) src-len)
                      (not (= (ocaml-peek 1) "."))))
                  (begin (advance! 1) (read-decimal-digits!)))
                (read-exp-part!)
                (parse-number (strip-underscores (slice src start pos))))))))
      (define
        read-string-literal
        (fn
          ()
          (let
            ((chars (list)))
            (begin
              (advance! 1)
              (define
                loop
                (fn
                  ()
                  (cond
                    ((>= pos src-len) nil)
                    ((= (cur) "\\")
                      (begin
                        (advance! 1)
                        (when
                          (< pos src-len)
                          (let
                            ((ch (cur)))
                            (begin
                              (cond
                                ((= ch "n") (append! chars "\n"))
                                ((= ch "t") (append! chars "\t"))
                                ((= ch "r") (append! chars "\r"))
                                ((= ch "b") (append! chars "\\b"))
                                ((= ch "\\") (append! chars "\\"))
                                ((= ch "'") (append! chars "'"))
                                ((= ch "\"") (append! chars "\""))
                                ((= ch " ") nil)
                                (else (append! chars ch)))
                              (advance! 1))))
                        (loop)))
                    ((= (cur) "\"") (advance! 1))
                    (else
                      (begin
                        (append! chars (cur))
                        (advance! 1)
                        (loop))))))
              (loop)
              (join "" chars)))))
      (define
        read-char-literal
        (fn
          ()
          (begin
            (advance! 1)
            (let
              ((value (cond ((= (cur) "\\") (begin (advance! 1) (let ((ch (cur))) (begin (advance! 1) (cond ((= ch "n") "\n") ((= ch "t") "\t") ((= ch "r") "\r") ((= ch "b") "\\b") ((= ch "\\") "\\") ((= ch "'") "'") ((= ch "\"") "\"") (else ch)))))) (else (let ((ch (cur))) (begin (advance! 1) ch))))))
              (begin
                (when
                  (and (< pos src-len) (= (cur) "'"))
                  (advance! 1))
                value)))))
      (define
        try-punct
        (fn
          (start)
          (let
            ((c (cur))
              (c1 (ocaml-peek 1))
              (c2 (ocaml-peek 2)))
            (cond
              ((and (= c ";") (= c1 ";"))
                (begin (advance! 2) (push! "op" ";;" start) true))
              ((and (= c "-") (= c1 ">"))
                (begin (advance! 2) (push! "op" "->" start) true))
              ((and (= c "<") (= c1 "-"))
                (begin (advance! 2) (push! "op" "<-" start) true))
              ((and (= c ":") (= c1 "="))
                (begin (advance! 2) (push! "op" ":=" start) true))
              ((and (= c ":") (= c1 ":"))
                (begin (advance! 2) (push! "op" "::" start) true))
              ((and (= c "|") (= c1 "|"))
                (begin (advance! 2) (push! "op" "||" start) true))
              ((and (= c "&") (= c1 "&"))
                (begin (advance! 2) (push! "op" "&&" start) true))
              ((and (= c "<") (= c1 "="))
                (begin (advance! 2) (push! "op" "<=" start) true))
              ((and (= c ">") (= c1 "="))
                (begin (advance! 2) (push! "op" ">=" start) true))
              ((and (= c "<") (= c1 ">"))
                (begin (advance! 2) (push! "op" "<>" start) true))
              ((and (= c "=") (= c1 "="))
                (begin (advance! 2) (push! "op" "==" start) true))
              ((and (= c "!") (= c1 "="))
                (begin (advance! 2) (push! "op" "!=" start) true))
              ((and (= c "|") (= c1 ">"))
                (begin (advance! 2) (push! "op" "|>" start) true))
              ((and (= c "<") (= c1 "|"))
                (begin (advance! 2) (push! "op" "<|" start) true))
              ((and (= c "@") (= c1 "@"))
                (begin (advance! 2) (push! "op" "@@" start) true))
              ((and (= c "*") (= c1 "*"))
                (begin (advance! 2) (push! "op" "**" start) true))
              ((or (= c "+") (= c "-") (= c "*") (= c "/") (= c "%") (= c "^") (= c "<") (= c ">") (= c "=") (= c "(") (= c ")") (= c "{") (= c "}") (= c "[") (= c "]") (= c ";") (= c ":") (= c ",") (= c ".") (= c "|") (= c "!") (= c "&") (= c "@") (= c "?") (= c "~") (= c "#"))
                (begin (advance! 1) (push! "op" c start) true))
              (else false)))))
      (define
        step
        (fn
          ()
          (begin
            (skip-ws!)
            (when
              (< pos src-len)
              (let
                ((start pos) (c (cur)))
                (cond
                  ((ocaml-ident-start? c)
                    (let
                      ((word (read-ident start)))
                      (begin
                        (cond
                          ((ocaml-keyword? word)
                            (push! "keyword" word start))
                          ((ocaml-upper? c) (push! "ctor" word start))
                          (else (push! "ident" word start)))
                        (step))))
                  ((ocaml-digit? c)
                    (let
                      ((v (read-number start)))
                      (begin (push! "number" v start) (step))))
                  ((= c "\"")
                    (let
                      ((s (read-string-literal)))
                      (begin (push! "string" s start) (step))))
                  ((and (= c "'") (< (+ pos 1) src-len) (or (and (= (ocaml-peek 1) "\\") (< (+ pos 3) src-len) (= (ocaml-peek 3) "'")) (and (not (= (ocaml-peek 1) "\\")) (< (+ pos 2) src-len) (= (ocaml-peek 2) "'"))))
                    (let
                      ((v (read-char-literal)))
                      (begin (push! "char" v start) (step))))
                  ((= c "'")
                    (begin
                      (advance! 1)
                      (when
                        (and (< pos src-len) (ocaml-ident-start? (cur)))
                        (begin
                          (advance! 1)
                          (read-ident (+ start 1))))
                      (push!
                        "tyvar"
                        (slice src (+ start 1) pos)
                        start)
                      (step)))
                  ((try-punct start) (step))
                  (else
                    (error
                      (str "ocaml-tokenize: unexpected char " c " at " pos)))))))))
      (step)
      (push! "eof" nil pos)
      tokens)))
--- a/plans/datalog-on-sx.md
+++ b/plans/datalog-on-sx.md
@@ -58,498 +58,88 @@ Key differences from Prolog:
 ## Roadmap
 ### Phase 1 — tokenizer + parser
- [x] Tokenizer: atoms (lowercase/quoted), variables (uppercase/`_`), numbers, strings,
+- [ ] Tokenizer: atoms (lowercase/quoted), variables (uppercase/`_`), numbers, strings,
-      punct (`( )`, `,`, `.`), operators (`:-`, `?-`, `<=`, `>=`, `!=`, `<`, `>`, `=`,
+      operators (`:- `, `?-`, `,`, `.`), comments (`%`, `/* */`)
-      `+`, `-`, `*`, `/`), comments (`%`, `/* */`)
+      Note: no function symbol syntax (no nested `f(...)` in arg position).
-      Note: no function symbol syntax (no nested `f(...)` in arg position) — but the
+- [ ] Parser:
      parser permits nested compounds for arithmetic; safety analysis (Phase 3) rejects
      non-arithmetic nesting.
 - [x] Parser:
      - Facts: `parent(tom, bob).` → `{:head (parent tom bob) :body ()}`
      - Rules: `ancestor(X,Z) :- parent(X,Y), ancestor(Y,Z).`
              → `{:head (ancestor X Z) :body ((parent X Y) (ancestor Y Z))}`
-      - Queries: `?- ancestor(tom, X).` → `{:query ((ancestor tom X))}`
+      - Queries: `?- ancestor(tom, X).` → `{:query (ancestor tom X)}`
        (`:query` value is always a list of literals; `?- p, q.` → `{:query ((p) (q))}`)
      - Negation: `not(parent(X,Y))` in body position → `{:neg (parent X Y)}`
- [x] Tests in `lib/datalog/tests/parse.sx` (18) and `lib/datalog/tests/tokenize.sx` (26).
+- [ ] Tests in `lib/datalog/tests/parse.sx`
      Conformance harness: `bash lib/datalog/conformance.sh` → 44 / 44 passing.
 ### Phase 2 — unification + substitution
- [x] Ported (not shared) from `lib/prolog/` — term walk, no occurs check.
+- [ ] Share or port unification from `lib/prolog/` — term walk, occurs check off by default
- [x] `dl-unify t1 t2 subst` → extended subst dict, or `nil` on failure.
+- [ ] `dl-unify` `t1` `t2` `subst` → extended subst or nil (no function symbols means simpler)
- [x] `dl-walk`, `dl-bind`, `dl-apply-subst`, `dl-ground?`, `dl-vars-of`.
+- [ ] `dl-ground?` `term` → bool — all variables bound in substitution
- [x] Substitutions are immutable dicts keyed by variable name (string).
+- [ ] Tests: atom/atom, var/atom, var/var, list args
      Lists/tuples unify element-wise (used for arithmetic compounds too).
 - [x] Tests in `lib/datalog/tests/unify.sx` (28). 72 / 72 conformance.
-### Phase 3 — extensional DB + naive evaluation + safety analysis
+### Phase 3 — extensional DB + naive evaluation
- [x] EDB+IDB combined: `{:facts {<rel-name-string> -> (literal ...)}}` —
+- [ ] EDB: `{:relation-name → set-of-ground-tuples}` using SX sets (Phase 18 of primitives)
-      relations indexed by name; tuples stored as full literals so they
+- [ ] `dl-add-fact!` `db` `relation` `args` → add ground tuple
-      unify directly. Dedup on insert via `dl-tuple-equal?`.
+- [ ] `dl-add-rule!` `db` `head` `body` → add rule clause
- [x] `dl-add-fact! db lit` (rejects non-ground) and `dl-add-rule! db rule`
+- [ ] Naive evaluation: iterate rules until fixpoint
-      (rejects unsafe). `dl-program source` parses + loads in one step.
+      For each rule, for each combination of body tuples that unify, derive head tuple.
- [x] Naive evaluation `dl-saturate! db`: iterate rules until no new tuples.
+      Repeat until no new tuples added.
-      `dl-find-bindings` recursively joins body literals; `dl-match-positive`
+- [ ] `dl-query` `db` `goal` → list of substitutions satisfying goal against derived DB
-      unifies a literal against every tuple in the relation.
+- [ ] Tests: transitive closure (ancestor), sibling, same-generation — classic Datalog programs
 - [x] `dl-query db goal` → list of substitutions over `goal`'s vars,
      deduplicated. `dl-relation db name` for derived tuples.
 - [x] Safety analysis at `dl-add-rule!` time: every head variable except
      `_` must appear in some positive body literal. Built-ins and negated
      literals do not satisfy safety. Helpers `dl-positive-body-vars`,
      `dl-rule-unsafe-head-vars` exposed for later phases.
 - [x] Negation and arithmetic built-ins error cleanly at saturate time
      (Phase 4 / Phase 7 will swap in real semantics).
 - [x] Tests in `lib/datalog/tests/eval.sx` (15): transitive closure,
      sibling, same-generation, grandparent, cyclic graph reach, six
      safety cases. 87 / 87 conformance.
-### Phase 4 — built-in predicates + body arithmetic
+### Phase 4 — semi-naive evaluation (performance)
-Almost every real query needs `<`, `=`, simple arithmetic, and string
+- [ ] Delta sets: track newly derived tuples per iteration
-comparisons in body position. These are not EDB lookups — they're
+- [ ] Semi-naive rule: only join against delta tuples from last iteration, not full relation
-constraints that filter bindings.
+- [ ] Significant speedup for recursive rules — avoids re-deriving known tuples
- [x] Recognise built-in predicates in body: `(< X Y)`, `(<= X Y)`, `(> X Y)`,
+- [ ] `dl-stratify` `db` → dependency graph + SCC analysis → stratum ordering
-      `(>= X Y)`, `(= X Y)`, `(!= X Y)` and arithmetic forms `(is Z (+ X Y))`,
+- [ ] Tests: verify semi-naive produces same results as naive; benchmark on large ancestor chain
      `(is Z (- X Y))`, `(is Z (* X Y))`, `(is Z (/ X Y))`. Live in
      `lib/datalog/builtins.sx`.
 - [x] `dl-eval-builtin` dispatches; `dl-eval-arith` recursively evaluates
      `(+ a b)` etc. with full nesting. `=` unifies; `!=` rejects equal
      ground terms.
 - [x] Order-aware safety analysis (`dl-rule-check-safety`): walks body
      left-to-right tracking which vars are bound. `is`'s RHS vars must
      be already bound; LHS becomes bound. Comparisons require both
      sides bound. `=` is special-cased — at least one side bound binds
      the other. Negation vars must be bound (will be enforced fully in
      Phase 7).
 - [x] Wired through SX numeric primitives — no separate number tower.
 - [x] Tests in `lib/datalog/tests/builtins.sx` (19): range filters,
      arithmetic derivations, equality binding, eight safety violations
      and three safe-shape tests. Conformance 106 / 106.
-### Phase 5 — semi-naive evaluation (performance)
+### Phase 5 — stratified negation
- [x] Delta sets `{rel-name -> tuples}` track newly derived tuples per iter.
+- [ ] Dependency graph analysis: which relations depend on which (positively or negatively)
-      `dl-snapshot-facts` builds the initial delta from the EDB.
+- [ ] Stratification check: error if negation is in a cycle (non-stratifiable program)
- [x] Semi-naive rule: for each rule, walk every positive body literal
+- [ ] Evaluation: process strata in order — lower stratum fully computed before using its
-      position; substitute that one with the per-relation delta and join
+      complement in a higher stratum
-      the rest against the previous-iteration DB (`dl-find-bindings-semi`).
+- [ ] `not(P)` in rule body: at evaluation time, check P is NOT in the derived EDB
-      Candidates are collected before mutating the DB so the "full" sides
+- [ ] Tests: non-member (`not(member(X,L))`), colored-graph (`not(same-color(X,Y))`),
-      see a consistent snapshot.
+      stratification error detection
 - [x] `dl-collect-rule-candidates` falls back to a naive single pass when
      a rule has no positive body literal (e.g. `(p X) :- (= X 5).`).
 - [x] `dl-saturate!` is now semi-naive by default; `dl-saturate-naive!`
      kept for differential testing and a reference implementation.
 - [x] Tests in `lib/datalog/tests/semi_naive.sx` (8) — every recursive
      program from earlier suites is run under both saturators with
      per-relation tuple counts compared (cheap, robust under bundled
      conformance session). A chain-5 differential exercises multiple
      semi-naive iterations against the recursive ancestor rule.
      Larger chains hit prohibitive wall-clock under conformance CPU
      contention with other agents — a future Blocker tracks switching
      `dl-tuple-member?` from O(n²) list scan to a hash-set per relation.
-### Phase 6 — magic sets (goal-directed bottom-up, opt-in)
+### Phase 6 — aggregation (Datalog+)
-Naive bottom-up derives **all** consequences before answering. Magic sets
+- [ ] `count(X, Goal)` → number of distinct X satisfying Goal
-rewrite the program so the fixpoint only derives tuples relevant to the
+- [ ] `sum(X, Goal)` → sum of X values satisfying Goal
-goal — a major perf win for "what's reachable from node X" queries on
+- [ ] `min(X, Goal)` / `max(X, Goal)` → min/max of X satisfying Goal
-large graphs.
+- [ ] `group-by` semantics: `count(X, sibling(bob, X))` → count of bob's siblings
- [x] Adornments: `dl-adorn-goal goal` and `dl-adorn-lit lit bound` in
+- [ ] Aggregation breaks stratification — evaluate in a separate post-fixpoint pass
-      `lib/datalog/magic.sx`. Per-arg `b`/`f` based on whether the arg
+- [ ] Tests: social network statistics, grade aggregation, inventory sums
      is a constant or a variable already in the bound set.
 - [x] Magic transformation: `dl-magic-rewrite rules query-rel adn args`
      generates `{:rules <rewritten-rules> :seed <magic-seed>}`. Each
      original rule is gated with a `magic_<rel>^<adn>(bound)` filter,
      and propagation rules are emitted for each positive non-builtin
      body literal. Worklist over `(rel, adn)` pairs starts from the
      query and stops when no new pairs appear. EDB facts pass through
      unchanged.
 - [x] Sideways information passing strategy (SIPS): left-to-right
      `dl-rule-sips rule head-adornment` walks body literals tracking
      the bound set, returning `({:lit :adornment} ...)`. Recognises
      `is`/aggregate result-vars as new binders; comparisons and
      negation pass through with computed adornments. (Pluggable
      strategies are future work.)
 - [x] `dl-set-strategy! db strategy` hook + `dl-get-strategy db`. Default
      `:semi-naive`. `:magic` accepted but the transformation itself is
      deferred — saturator currently falls back to semi-naive. Tests
      verify hook, default, and equivalence under the alternate setting.
 - [x] Equivalence test: rewritten ancestor program over the same EDB
      derives the same number of `ancestor` tuples and returns the
      same query answers as the unrewritten program (chain-3 case).
 - [x] `dl-magic-query db query-goal` — top-level driver. Builds a
      fresh internal db with the caller's EDB facts, the magic seed,
      and the rewritten rules; saturates and queries. Caller's db is
      untouched. Equivalent to `dl-query` for fully-stratifiable
      programs (sole motivation is a perf alternative on goal-shaped
      queries against large recursive relations).
 - [ ] Perf test: 10k-node reachability with magic vs semi-naive.
      Left to a future iteration — would need a benchmarking harness
      for large graphs and the conformance budget can't afford it.
-### Phase 7 — stratified negation
+### Phase 7 — SX embedding API
- [x] Dependency graph: `dl-build-dep-graph db` returns `{head -> ({:rel
+- [ ] `(dl-program facts rules)` → database from SX data directly (no parsing required)
      :neg} ...)}`. Built-ins drop out (they're not relations).
 - [x] Reachability via Floyd-Warshall in `dl-build-reach`; cycles
      detected by `reach[A][B] && reach[B][A]`. Programs are
      non-stratifiable iff any negative dependency falls inside an SCC.
      `dl-check-stratifiable` returns nil on success or a clear message.
 - [x] `dl-compute-strata` propagates stratum numbers iteratively:
      `stratum(R) = max over deps of (stratum(dep) + (1 if negated else 0))`.
 - [x] Saturator refactor: `dl-saturate-rules! db rules` is the semi-
      naive worker; `dl-saturate! db` rejects non-stratifiable programs,
      groups rules by head's stratum, and runs the worker on each
      stratum in increasing order.
 - [x] `not(P)` in body: `dl-match-negation` walks the inner literal
      under the current subst and uses `dl-match-positive` — succeeds
      iff zero matches. Order-aware safety in `dl-rule-check-safety`
      (already present from Phase 4) requires negation vars to be
      bound by an earlier positive literal.
 - [x] Tests in `lib/datalog/tests/negation.sx` (10): EDB and IDB
      negation, two-step strata, multi-level strata, with-arithmetic,
      empty-result and always-fail cases, non-stratifiability
      rejection, and a negation safety violation.
 ### Phase 8 — aggregation (Datalog+)
 - [x] `(count R V Goal)`, `(sum R V Goal)`, `(min R V Goal)`,
      `(max R V Goal)`, `(findall L V Goal)` — first arg is the result
      variable, second is the aggregated variable, third is the goal
      literal. `findall` returns the distinct-value list itself; the
      others reduce. Live in `lib/datalog/aggregates.sx`.
 - [x] `dl-eval-aggregate`: runs `dl-find-bindings` on the goal under the
      current subst (which provides outer-context bindings), collects
      distinct values of the aggregated var, applies the aggregate.
      `count`/`sum` produce 0 when no matches; `min`/`max` produce no
      binding (rule fails) when empty.
 - [x] Group-by emerges naturally: outer-context vars in the goal are
      substituted from the current subst, so `popular(P) :- post(P),
      count(N, U, liked(U, P)), >=(N, 3).` correctly counts per-post.
 - [x] Stratification: `dl-aggregate-dep-edge` returns a negation-like
      edge so the aggregate's goal relation is fully derived before the
      aggregate fires. Non-monotonicity respected.
 - [x] Safety: aggregate body lit binds the result var; goal-internal
      vars are existentially quantified and don't need outer binding.
 - [x] Tests in `lib/datalog/tests/aggregates.sx` (10): count siblings,
      sum prices, min/max scores, count over derived relation,
      empty-input cases for each operator, popularity threshold with
      group-by, distinct-counted-once.
 ### Phase 9 — SX embedding API
 - [x] `(dl-program-data facts rules)` builds a db from SX data —
      `facts` is a list of literals, `rules` is a list of either
      dicts `{:head … :body …}` or lists `(<head…> <- <body…>)`.
      Variables are SX symbols whose first char is uppercase or `_`,
      matching the parser's convention.
      ```
-      (dl-program-data
+      (dl-program
-        '((parent tom bob) (parent bob ann))
+        '((parent tom bob) (parent tom liz) (parent bob ann))
-        '((ancestor X Y <- (parent X Y))
+        '((ancestor X Z :- (parent X Y) (ancestor Y Z))
-          (ancestor X Z <- (parent X Y) (ancestor Y Z))))
+          (ancestor X Y :- (parent X Y))))
      ```
- [x] `(dl-rule head body)` constructor for the dict form.
+- [ ] `(dl-query db '(ancestor tom ?X))` → `((ann) (bob) (liz) (pat))`
- [x] `(dl-query db '(ancestor tom X))` already worked — same query API
+- [ ] `(dl-assert! db '(parent ann pat))` → incremental fact addition + re-derive
-      consumes the SX-data goal. Now also accepts a *list* of body
+- [ ] `(dl-retract! db '(parent tom bob))` → fact removal + re-derive from scratch
      literals for conjunctive queries:
      `(dl-query db '((p X) (q X)))`,
      `(dl-query db (list '(n X) '(> X 2)))`. Auto-dispatched via
      `dl-query-coerce` on first-element shape.
 - [x] `(dl-assert! db '(parent ann pat))` → adds the fact and re-saturates.
 - [x] `(dl-retract! db '(parent bob ann))` → drops matching tuples from
      the EDB list, wipes every relation that has a rule (those are IDB),
      and re-saturates from the surviving EDB.
 - [x] Tests in `lib/datalog/tests/api.sx` (9): closure via data API,
      dict-rule form, dl-rule constructor, dl-assert! incremental,
      dl-retract! removes derived, cyclic-graph reach via data,
      assert into empty db, fact-style rule (no arrow), coerce dict.
 - [ ] Integration demo: federation graph query — `(ancestor actor1 actor2)` over
-      rose-ash ActivityPub follow relationships (Phase 10).
+      rose-ash ActivityPub follow relationships
-### Phase 10 — Datalog as a query language for rose-ash
+### Phase 8 — Datalog as a query language for rose-ash
- [x] Schema sketches in `lib/datalog/demo.sx`:
+- [ ] Schema: map SQLAlchemy model relationships to Datalog EDB facts
-      - **Federation**: `(follows A B)` → `(mutual A B)`, `(reachable A B)`,
+      (e.g. `(follows user1 user2)`, `(authored user post)`, `(tagged post tag)`)
-        `(foaf A C)` (friend-of-a-friend, distinct).
+- [ ] Loader: `dl-load-from-db!` — query PostgreSQL, populate Datalog EDB
-      - **Content**: `(authored A P)`, `(liked U P)`, `(tagged P T)` →
+- [ ] Query examples:
-        `(post-likes P N)` via aggregation, `(popular P)` for likes ≥ 3,
+      - `?- ancestor(me, X), authored(X, Post), tagged(Post, cooking).`
-        `(interesting Me P)` joining follows + authored + popular.
+        → posts about cooking by people I follow (transitively)
-      - **Permissions**: `(member A G)`, `(subgroup C P)`, `(allowed G R)`
+      - `?- popular(Post) :- tagged(Post, T), count(L, (liked(L, Post))) >= 10.`
-        → `(in-group A G)` over transitive subgroups, `(can-access A R)`.
+        → posts with 10+ likes
-      - **Cooking-posts** (the canonical example): `(reach Me Them)` over
+- [ ] Expose as a rose-ash service endpoint: `POST /internal/datalog` with program + query
        the follow graph, then `(cooking-post-by-network Me P)` joining
        reach + authored + `(tagged P cooking)`.
 - [ ] Loader `dl-load-from-db!` — out of scope for this loop
      (would need to edit `shared/services/` outside `lib/datalog/`).
      Programs in `demo.sx` already document the EDB shape expected
      from such a loader. `dl-program-data` consumes the same shape.
 - [x] Query examples covered by `lib/datalog/tests/demo.sx` (10):
      mutuals, transitive reach, FOAF, popular posts, interesting feed,
      post likes count, direct/subgroup/transitive group access, no
      access without grant.
 - [ ] Service endpoint `POST /internal/datalog` — out of scope as above.
      Once exposed, server-side handler would be `dl-program-data` +
      `dl-query`, returning JSON-encoded substitutions.
 ## Blockers
- **Saturation perf**: three rounds done.
+_(none yet)_
  - hash-set membership in `dl-add-fact!` (Phase 5b)
  - indexed iteration in `dl-find-bindings` (Phase 5c)
  - first-arg index per relation (Phase 5e) — when a body literal's
    first arg walks to a non-variable, dl-match-positive looks up
    by `(str arg)` instead of scanning the full relation.
  chain-25 saturation drops from ~33s to ~18s real (10s user).
  chain-50 still long (~120s+) due to dict-copy overhead in
  unification subst threading. Future: per-rule "compiled" body
  with pre-resolved var positions, slot-based subst representation
  to avoid `assoc` per binding.
 ## Progress log
 _Newest first._
- 2026-05-08 — Phase 6 driver: `dl-magic-query db query-goal`.
+_(awaiting phase 1)_
  Builds a fresh internal db from the caller's EDB + magic seed +
  rewritten rules, saturates, queries, returns substitutions —
  caller's db is untouched. Equivalent to `dl-query` for any
  fully-stratifiable program; sole motivation is a perf alternative
  on goal-shaped queries against large recursive relations.
  2 new tests cover equivalence and non-mutation.
 - 2026-05-08 — Phase 6 magic-sets rewriter. `dl-magic-rewrite rules
  query-rel adn args` returns `{:rules <rewritten> :seed <seed-fact>}`.
  Worklist over `(rel, adn)` pairs starts from the query, gates each
  original rule with a `magic_<rel>^<adn>(bound)` filter, and emits
  propagation rules for each positive non-builtin body literal so
  that magic spreads to body relations. EDB facts pass through.
  3 new tests cover seed structure, equivalence on chain-3 by
  ancestor-relation tuple count, and same-query-answers under
  the rewritten program. The plumbing for a `dl-saturate-magic!`
  driver and large-graph perf benchmarks is still future work.
 - 2026-05-08 — Phase 6 building blocks for the magic-sets
  transformation: `dl-magic-rel-name`, `dl-magic-lit`,
  `dl-bound-args`. The rewriter that generates magic seed and
  propagation rules is still future work; with these primitives
  in place it's a straightforward worklist algorithm. 4 new tests.
 - 2026-05-08 — Phase 6 adornments + SIPS in
  `lib/datalog/magic.sx`. Inspection helpers — `dl-adorn-goal` and
  `dl-adorn-lit` compute per-arg `b`/`f` patterns under a bound
  set; `dl-rule-sips rule head-adornment` walks body literals
  left-to-right propagating the bound set, recognising `is` and
  aggregate result-vars as new binders. Lays groundwork for a
  later magic-sets transformation. 10 new tests cover pure
  adornment, SIPS over a chain rule, head-fully-bound rules,
  comparisons, and `is`. Saturator does not yet consume these.
 - 2026-05-08 — Comprehensive integration test in api suite: a
  single program exercising recursion (`reach` transitive closure)
  + stratified negation (`safe X Y :- reach X Y, not banned Y`) +
  aggregation (`reach_count` via count) + comparison (`>= N 2`)
  composed end-to-end via `dl-eval source query-source`. Confirms
  the full pipeline (parser → safety → stratifier → semi-naive +
  aggregate post-pass → query) on a non-trivial program.
 - 2026-05-08 — Bug fix: aggregates work as top-level query goals.
  `dl-match-lit` (the naive matcher used by `dl-find-bindings`) was
  missing the `dl-aggregate?` dispatch — it was only present in
  `dl-fbs-aux` (semi-naive). Symptom: `(dl-query db '(count N X (p X)))`
  silently returned `()`. Also updated `dl-query-user-vars` to project
  only the result var (first arg) of an aggregate goal — the
  aggregated var and inner-goal vars are existentials and should not
  appear in the projected substitution. 2 new aggregate tests cover
  the regression.
 - 2026-05-08 — Convenience: `dl-eval source query-source`. Parses
  both strings, builds a db, saturates, runs the query, returns
  the substitution list. Single-call user-friendly entry. 2 new
  api tests cover ancestor and multi-goal queries.
 - 2026-05-08 — Phase 6 stub: `dl-set-strategy! db strategy` and
  `dl-get-strategy db` user-facing hooks. Default `:semi-naive`;
  `:magic` is accepted but the actual transformation is deferred,
  so saturation still uses semi-naive. Lets us tick the
  "Optional pass — guarded behind dl-set-strategy!" Phase 6 box.
  3 new eval tests.
 - 2026-05-08 — Demo: weighted-DAG shortest path. `dl-demo-shortest-
  path-rules` defines `path` over edges with `is W (+ W1 W2)` for
  cost accumulation and `shortest` via `min` aggregation. 3 demo
  tests cover direct/multi-hop choice, multi-hop wins on cheaper
  route, and unreachable-empty. Added `dl-summary db` inspection
  helper returning `{<rel>: count}` (4 eval tests).
 - 2026-05-08 — Phase 5e perf: first-arg index per relation. db gains
  `:facts-index {<rel>: {<first-arg-key>: tuples}}` mirroring the
  existing `:facts-keys` membership index. `dl-add-fact!` populates
  it; `dl-match-positive` walks the body literal's first arg under
  the current subst — if it's bound to a non-var, look up by
  `(str arg)` and iterate only the matching subset. chain-25
  saturation 33s → 18s real (~2x). chain-50 still slow (~120s+)
  but tractable; next bottleneck is subst dict copies during
  unification. Differential test bumped to chain-12, semi-only
  count to chain-25.
 - 2026-05-08 — Demo: tag co-occurrence. `(cotagged P T1 T2)` — post
  has both T1 and T2 with T1 != T2 — and `(tag-pair-count T1 T2 N)`
  counting posts per distinct tag pair. Demonstrates count
  aggregation grouped by outer-context vars. 2 new demo tests.
 - 2026-05-08 — `dl-query` accepts a list of body literals for
  conjunctive queries, in addition to a single positive literal.
  `dl-query-coerce` dispatches based on the first element's shape:
  positive lit (head is a symbol) or `:neg` dict → wrap as singleton;
  list of lits → use as-is. `dl-query-user-vars` collects the union
  of vars across all goals (deduped, `_` filtered) for projection.
  2 new api tests: multi-goal AND, and conjunction with comparison.
 - 2026-05-08 — Bug fix: `dl-check-stratifiable` now rejects recursion
  through aggregation (e.g., `q(N) :- count(N, X, q(X))`). The
  stratifier was already adding negation-like edges for aggregates,
  but the cycle scan only looked at explicit `:neg` literals. Added
  the matching aggregate branch to the body iteration. Also adds
  doc-only `lib/datalog/datalog.sx` with the public-API surface
  (since `load` is an epoch command and can't recurse from within an
  `.sx` file). 3 new aggregate tests cover recursion-rejection,
  negation-and-aggregation coexistence, and min-over-empty-derived.
 - 2026-05-08 — Phase 10 demo + canonical query. Added the "cooking
  posts by people I follow (transitively)" example from the plan:
  `dl-demo-cooking-rules` defines `reach` over the follow graph
  (recursive transitive closure) and `cooking-post-by-network` that
  joins reach with `authored` and `(tagged P cooking)`. 3 demo
  tests cover transitive network, direct-only follow, and
  empty-network cases.
 - 2026-05-08 — Phase 8 extension: `findall L V Goal` aggregate. Bind
  L to the list of distinct V values for which Goal holds (or the
  empty list when no matches). Implemented as a one-line case in
  `dl-do-aggregate`. 3 new tests: EDB, derived relation, empty.
  Useful for "give me all the X such that …" queries without
  scalar reduction.
 - 2026-05-08 — Phase 5d semantic fix: anonymous `_` variables are
  renamed per occurrence at `dl-add-rule!` and `dl-query` time so
  `(p X _) (p _ Y)` no longer unifies the two `_`s. New helpers
  `dl-rename-anon-term`, `dl-rename-anon-lit`, `dl-make-anon-renamer`,
  `dl-rename-anon-rule` in db.sx; eval.sx's dl-query renames the goal
  before search and projects only user-named vars (`_` is filtered
  out of the projection list). The "underscore in head" test now
  correctly rejects `(p X _) :- q(X).` — after renaming, the head's
  fresh anon var has no body binder. Two new eval tests verify
  rule-level and goal-level independence. 155/155 expected.
 - 2026-05-08 — Phase 5c perf: indexed `dl-find-bindings`. Replaced
  the recursive `(rest lits)` walk with `dl-fb-aux lits db subst i n`
  using `nth lits i`. Eliminates O(N²) list-copy per body of length
  N. chain-15 saturation 25s → 16s; chain-25 finishes in 33s real
  (vs. timeout previously). Bumped semi_naive tests: differential
  on chain-10, semi-only count on chain-15 (was chain-5/chain-5).
  153/153.
 - 2026-05-08 — Phase 10 syntactic demo. New `lib/datalog/demo.sx`
  with three programs over rose-ash-shaped data: federation
  (`mutual`, `reachable`, `foaf`), content recommendation
  (`post-likes` via count aggregation, `popular`, `interesting`),
  and role-based permissions (`in-group` over transitive subgroups,
  `can-access`). 10 demo tests pass against synthetic EDB tuples.
  Postgres loader and `/internal/datalog` HTTP endpoint remain
  out of scope for this loop (they need service-tree edits beyond
  `lib/datalog/**`). Conformance now 153/153.
 - 2026-05-08 — Phase 5b perf: hash-set membership in `dl-add-fact!`.
  db gains a parallel `:facts-keys {<rel>: {<tuple-string>: true}}`
  index alongside `:facts`. `dl-tuple-key` derives a stable string
  key via `(str lit)` — `(p 30)` and `(p 30.0)` collide correctly
  because SX prints them identically. Insertion is O(1) instead of
  O(n). chain-7 saturation drops from ~12s to ~6s; chain-15 from
  ~50s to ~25s under shared CPU. Larger chains are still slow due
  to body-join overhead in dl-find-bindings (Blocker updated).
  `dl-retract!` updated to keep both indices consistent. 143/143.
 - 2026-05-08 — Phase 9 done. New `lib/datalog/api.sx` exposes a
  parser-free embedding: `dl-program-data facts rules` accepts SX
  data lists, with rules in either dict form or list form using
  `<-` as the rule arrow (since SX parses `:-` as a keyword).
  `dl-rule head body` constructs the dict. `dl-assert! db lit` adds
  a fact and re-saturates; `dl-retract! db lit` drops the fact from
  EDB, wipes all rule-headed (IDB) relations, and re-saturates from
  scratch — the simplest correct semantics until provenance tracking
  arrives in a later phase. 9 API tests; conformance now 143/143.
 - 2026-05-08 — Phase 8 done. New `lib/datalog/aggregates.sx` (~110
  LOC): count / sum / min / max. Each is a body literal of shape
  `(op R V Goal)` — `dl-eval-aggregate` runs `dl-find-bindings` on
  the goal under the outer subst (so outer vars in the goal get
  substituted, giving group-by-style aggregation), collects the
  distinct values of `V`, and binds `R`. Empty input: count/sum
  return 0; min/max produce no binding (rule fails). Stratifier
  extended via `dl-aggregate-dep-edge` so the aggregate's goal
  relation is fully derived before the aggregate fires. Safety check
  treats goal-internal vars as existentials (no outer binding
  required); only the result var becomes bound. Conformance now
  134 / 134.
 - 2026-05-08 — Phase 7 done (Phase 6 magic sets deferred — opt-in,
  semi-naive default suffices for current test suite). New
  `lib/datalog/strata.sx` (~290 LOC): dep graph build, Floyd-Warshall
  reachability, SCC-via-mutual-reachability for non-stratifiability
  detection, iterative stratum computation, rule grouping by head
  stratum. eval.sx split: `dl-saturate-rules!` is the per-rule-set
  semi-naive worker, `dl-saturate!` is now the stratified driver
  (errors out on non-stratifiable programs). `dl-match-negation` in
  eval.sx: succeeds iff inner positive match is empty. Stratum-keyed
  dicts use `(str s)` since SX dicts only accept string/keyword keys.
  10 negation tests cover EDB/IDB negation, multi-level strata,
  non-stratifiability rejection, and a negation safety violation.
 - 2026-05-08 — Phase 5 done. `lib/datalog/eval.sx` rewritten to
  semi-naive default. `dl-saturate!` tracks a per-relation delta and
  on each iteration walks every positive body position substituting
  delta for that one literal — joining the rest against the full DB
  snapshot. `dl-saturate-naive!` retained as the reference. Rules
  with no positive body literal (e.g. `(p X) :- (= X 5).`) fall back
  to a naive one-shot via `dl-collect-rule-candidates`. 8 tests
  differentially compare the two saturators using per-relation tuple
  counts (cheap). Chain-5 differential exercises multi-iteration
  recursive saturation. Larger chains made conformance.sh time out
  due to O(n) `dl-tuple-member?` × CPU sharing with other loop
  agents — added a Blocker to swap to a hash-set for membership.
  Also tightened `dl-tuple-member?` to use indexed iteration instead
  of recursive `rest` (was creating a fresh list per step).
 - 2026-05-07 — Phase 4 done. `lib/datalog/builtins.sx` (~280 LOC) adds
  `(< X Y)`, `(<= X Y)`, `(> X Y)`, `(>= X Y)`, `(= X Y)`, `(!= X Y)`,
  and `(is X expr)` with `+ - * /`. `dl-eval-builtin` dispatches;
  `dl-eval-arith` recursively evaluates nested compounds. Safety
  check is now order-aware — it walks body literals left-to-right
  tracking the bound set, requires comparison/`is` inputs to be
  already bound, and special-cases `=` (binds the var-side; both
  sides must include at least one bound to bind the other). Phase 3's
  simple safety check stays in db.sx as a forward-reference fallback;
  builtins.sx redefines `dl-rule-check-safety` to the comprehensive
  version. eval.sx's `dl-match-lit` now dispatches built-ins through
  `dl-eval-builtin`. 19 builtins tests; conformance 106 / 106.
 - 2026-05-07 — Phase 3 done. `lib/datalog/db.sx` (~250 LOC) holds facts
  indexed by relation name plus the rules list, with `dl-add-fact!` /
  `dl-add-rule!` (rejects non-ground facts and unsafe rules);
  `lib/datalog/eval.sx` (~150 LOC) implements the naive bottom-up
  fixpoint via `dl-find-bindings`/`dl-match-positive`/`dl-saturate!`
  and `dl-query` (deduped projected substitutions). Safety analysis
  rejects unsafe head vars at load time. Negation and arithmetic
  built-ins raise clean errors (lifted in later phases). 15 eval
  tests cover transitive closure, sibling, same-generation, cyclic
  graph reach, and six safety violations. Conformance 87 / 87.
 - 2026-05-07 — Phase 2 done. `lib/datalog/unify.sx` (~140 LOC):
  `dl-var?` (case + underscore), `dl-walk`, `dl-bind`, `dl-unify` (returns
  extended dict subst or `nil`), `dl-apply-subst`, `dl-ground?`, `dl-vars-of`.
  Substitutions are immutable dicts; `assoc` builds extended copies. 28
  unify tests; conformance now 72 / 72.
 - 2026-05-07 — Phase 1 done. `lib/datalog/tokenizer.sx` (~190 LOC) emits
  `{:type :value :pos}` tokens; `lib/datalog/parser.sx` (~150 LOC) produces
  `{:head … :body …}` / `{:query …}` clauses, with nested compounds
  permitted for arithmetic and `not(...)` desugared to `{:neg …}`. 44 / 44
  via `bash lib/datalog/conformance.sh` (26 tokenize + 18 parse). Local
  helpers namespace-prefixed (`dl-emit!`, `dl-peek`) after a host-primitive
  shadow clash. Test harness uses a custom `dl-deep-equal?` that handles
  out-of-order dict keys and number repr (`equal?` fails on dict key order
  and on `30` vs `30.0`).
--- a/plans/ocaml-on-sx.md
+++ b/plans/ocaml-on-sx.md
@@ -116,47 +116,63 @@ SX CEK evaluator (both JS and OCaml hosts)
 ### Phase 1 — Tokenizer + parser
- [ ] **Tokenizer:** keywords (`let`, `rec`, `in`, `fun`, `function`, `match`, `with`,
+- [x] **Tokenizer:** keywords (`let`, `rec`, `in`, `fun`, `function`, `match`, `with`,
      `type`, `of`, `module`, `struct`, `end`, `functor`, `sig`, `open`, `include`,
      `if`, `then`, `else`, `begin`, `try`, `exception`, `raise`, `mutable`,
      `for`, `while`, `do`, `done`, `and`, `as`, `when`), operators (`->`, `|>`,
      `<|`, `@@`, `@`, `:=`, `!`, `::`, `**`, `:`, `;`, `;;`), identifiers (lower,
-      upper/ctor, labels `~label:`, optional `?label:`), char literals `'c'`,
+      upper/ctor), char literals `'c'`, string literals (escaped),
-      string literals (escaped + heredoc `{|...|}`), int/float literals,
+      int/float literals (incl. hex, exponent, underscores), nested block
-      line comments `(*` nested block comments `*)`.
+      comments `(* ... *)`. _(labels `~label:` / `?label:` and heredoc `{|...|}`
- [ ] **Parser:** top-level `let`/`let rec`/`type`/`module`/`exception`/`open`/`include`
+      deferred — surface tokens already work via `~`/`?` punct + `{`/`|` punct.)_
-      declarations; expressions: literals, identifiers, constructor application,
+- [~] **Parser:** expressions: literals, identifiers, constructor application,
-      lambda, application (left-assoc), binary ops with precedence table,
+      lambda, application (left-assoc), binary ops with precedence (29 ops via
-      `if`/`then`/`else`, `match`/`with`, `try`/`with`, `let`/`in`, `begin`/`end`,
+      `lib/guest/pratt.sx`), `if`/`then`/`else`, `let`/`in`, `let rec`,
-      `fun`/`function`, tuples, list literals, record literals/updates, field access,
+      `fun`/`->`, `match`/`with`, tuples, list literals, sequences `;`,
-      sequences `;`, unit `()`.
+      `begin`/`end`, unit `()`. Top-level decls: `let [rec] name params* = expr`
- [ ] **Patterns:** constructor, literal, variable, wildcard `_`, tuple, list cons `::`,
+      and bare expressions, `;;`-separated via `ocaml-parse-program`. _(Pending:
-      list literal, record, `as`, or-pattern `P1 | P2`, `when` guard.
+      `type`/`module`/`exception`/`open`/`include` decls, `try`/`with`,
      `function`, record literals/updates, field access, `and` mutually-recursive
      bindings.)_
 - [~] **Patterns:** constructor (nullary + with args, incl. flattened tuple
      args `Pair (a, b)` → `(:pcon "Pair" PA PB)`), literal (int/string/char/
      bool/unit), variable, wildcard `_`, tuple, list cons `::`, list literal.
      _(Pending: record patterns, `as` binding, or-pattern `P1 | P2`, `when`
      guard.)_
 - [ ] OCaml is **not** indentation-sensitive — no layout algorithm needed.
 - [ ] Tests in `lib/ocaml/tests/parse.sx` — 50+ round-trip parse tests.
 ### Phase 2 — Core evaluator (untyped)
- [ ] `ocaml-eval` entry: walks OCaml AST, produces SX values.
+- [x] `ocaml-eval` entry: walks OCaml AST, produces SX values.
- [ ] `let`/`let rec`/`let ... in` (mutually recursive with `and`).
+- [x] `let`/`let rec`/`let ... in`. Mutually recursive `let rec f = … and
- [ ] Lambda + application (curried by default — auto-curry multi-param defs).
+      g = …` works at top level via `(:def-rec-mut BINDINGS)`; placeholders
- [ ] `fun`/`function` (single-arg lambda with immediate match on arg).
+      are bound first, rhs evaluated in the joint env, cells filled in.
- [ ] `if`/`then`/`else`, `begin`/`end`, sequence `;`.
+      `let x = … and y = …` (non-rec) emits `(:def-mut BINDINGS)` —
- [ ] Arithmetic, comparison, boolean ops, string `^`, `mod`.
+      sequential bindings against the parent env.
- [ ] Unit `()` value; `ignore`.
+- [x] Lambda + application (curried by default — auto-curry multi-param defs).
- [ ] References: `ref`, `!`, `:=`.
+- [x] `fun`/`function` (single-arg lambda with immediate match on arg).
 - [x] `if`/`then`/`else`, `begin`/`end`, sequence `;`.
 - [x] Arithmetic, comparison, boolean ops, string `^`, `mod`.
 - [x] Unit `()` value; `ignore`.
 - [x] References: `ref`, `!`, `:=`.
 - [ ] Mutable record fields.
- [ ] `for i = lo to hi do ... done` loop; `while cond do ... done`.
+- [x] `for i = lo to hi do ... done` loop; `while cond do ... done` (incl.
- [ ] `try`/`with` — maps to SX `guard`; `raise` via perform.
+      `downto` direction).
 - [x] `try`/`with` — maps to SX `guard`; `raise` is a builtin that calls
      host SX `raise`. `failwith` and `invalid_arg` ship as builtins.
 - [ ] Tests in `lib/ocaml/tests/eval.sx` — 50+ tests, pure + imperative.
 ### Phase 3 — ADTs + pattern matching
 - [ ] `type` declarations: `type t = A | B of t1 * t2 | C of { x: int }`.
- [ ] Constructors as tagged lists: `A` → `(:A)`, `B(1, "x")` → `(:B 1 "x")`.
+      _(Parser + evaluator currently inferred-arity at runtime; type decls
- [ ] `match`/`with`: constructor, literal, variable, wildcard, tuple, list cons/nil,
+      pending.)_
-      `as` binding, or-patterns, nested patterns, `when` guard.
+- [x] Constructors as tagged lists: `A` → `("A")`, `B(1, "x")` → `("B" 1 "x")`.
- [ ] Exhaustiveness: runtime error on incomplete match (no compile-time check yet).
+- [~] `match`/`with`: constructor, literal, variable, wildcard, tuple, list
      cons/nil, nested patterns. _(Pending: `as` binding, or-patterns,
      `when` guard.)_
 - [x] Exhaustiveness: runtime error on incomplete match (no compile-time check yet).
 - [ ] Built-in types: `option` (`None`/`Some`), `result` (`Ok`/`Error`),
      `list` (nil/cons), `bool`, `unit`, `exn`.
 - [ ] `exception` declarations; built-in: `Not_found`, `Invalid_argument`,
@@ -166,27 +182,48 @@ SX CEK evaluator (both JS and OCaml hosts)
 ### Phase 4 — Modules + functors
- [ ] `module M = struct let x = 1 let f y = x + y end` → SX dict `{:x 1 :f <fn>}`.
+- [x] `module M = struct let x = 1 let f y = x + y end` → SX dict
- [ ] `module type S = sig val x : int val f : int -> int end` → interface record
+      `{"x" 1 "f" <fn>}`.
-      (runtime stub; typed checking in Phase 5).
+- [~] `module type S = sig val x : int val f : int -> int end` — signature
- [ ] `module M : S = struct ... end` — coercive sealing (runtime: pass-through).
+      annotations are parsed-and-skipped (`skip-optional-sig`); typed
- [ ] `functor (M : S) -> struct ... end` → SX `(fn (M) ...)`.
+      checking deferred to Phase 5.
- [ ] `module F = Functor(Base)` — functor application.
+- [x] `module M : S = struct ... end` — coercive sealing (signature ignored).
- [ ] `open M` — merge M's dict into current env (`env-merge`).
+- [x] `functor (M : S) -> struct ... end` via shorthand `module F (M) = …`.
- [ ] `include M` — same as open at structure level.
+- [x] `module F = Functor(Base)` — functor application; multi-param via
- [ ] `M.name` — dict get via `:name` key.
+      `module P = F(A)(B)`.
 - [x] `open M` — merge M's dict into current env (via
      `ocaml-env-merge-dict`). Module path `M.Sub` resolves via
      `ocaml-resolve-module-path`.
 - [x] `include M` — at top level same as `open`; inside a module also
      copies M's bindings into the surrounding module's exports.
 - [x] `M.name` — dict get via field access.
 - [ ] First-class modules (pack/unpack) — deferred to Phase 5.
 - [ ] Standard module hierarchy: `List`, `Option`, `Result`, `String`, `Char`,
      `Int`, `Float`, `Bool`, `Unit`, `Printf`, `Format` (stubs, filled in Phase 6).
 - [ ] Tests in `lib/ocaml/tests/modules.sx` — 30+ tests.
 ### Phase 5.1 — Conformance scoreboard
 - [x] `lib/ocaml/conformance.sh` runs the full test suite, classifies
      each test by description prefix into a suite (tokenize, parser,
      eval-core, phase2-refs, phase2-loops, phase2-function, phase2-exn,
      phase3-adt, phase4-modules, phase5-hm, phase6-stdlib, let-and,
      phase1-params, misc), and emits `scoreboard.json` + `scoreboard.md`.
 - [ ] Vendor a slice of the OCaml testsuite at `lib/ocaml/baseline/`
      and feed it through `ocaml-run-program`, scoring per-file
      conformance. _(Pending — needs more stdlib coverage and ADT type
      decls to make most testsuite files runnable.)_
 ### Phase 5 — Hindley-Milner type inference
- [ ] Algorithm W: `gen`/`inst`, `unify`, `infer-expr`, `infer-decl`.
+- [~] Algorithm W: `gen`/`inst` from `lib/guest/hm.sx`, `unify` from
- [ ] Type variables: `'a`, `'b`; unification with occur-check.
+      `lib/guest/match.sx`, `infer-expr` written here. Covers atoms, var,
- [ ] Let-polymorphism: generalise at let-bindings.
+      lambda, app, let, if, op, neg, not. _(Pending: tuples, lists,
      pattern matching, let-rec, modules.)_
 - [x] Type variables: `'a`, `'b`; unification with occur-check (kit).
 - [x] Let-polymorphism: generalise at let-bindings (kit `hm-generalize`).
 - [ ] ADT types: `type 'a option = None | Some of 'a`.
- [ ] Function types, tuple types, record types.
+- [~] Function types `T1 -> T2` work; tuples/records pending.
 - [ ] Type signatures: `val f : int -> int` — verify against inferred type.
 - [ ] Module type checking: seal against `sig` (Phase 4 stubs become real checks).
 - [ ] Error reporting: position-tagged errors with expected vs actual types.
@@ -196,14 +233,24 @@ SX CEK evaluator (both JS and OCaml hosts)
 ### Phase 6 — Standard library
- [ ] `List`: `map`, `filter`, `fold_left`, `fold_right`, `length`, `rev`, `append`,
+- [~] `List`: `map`, `filter`, `fold_left`, `fold_right`, `length`, `rev`,
-      `concat`, `flatten`, `iter`, `iteri`, `mapi`, `for_all`, `exists`, `find`,
+      `append`, `iter`, `for_all`, `exists`, `mem`, `nth`, `hd`, `tl`,
-      `find_opt`, `mem`, `assoc`, `assq`, `sort`, `stable_sort`, `nth`, `hd`, `tl`,
+      `rev_append`. _(Pending: concat/flatten, iteri/mapi, find/find_opt,
-      `init`, `combine`, `split`, `partition`.
+      assoc/assq, sort, init, combine, split, partition.)_
- [ ] `Option`: `map`, `bind`, `fold`, `get`, `value`, `join`, `iter`, `to_list`,
+- [~] `Option`: `map`, `bind`, `value`, `get`, `is_none`, `is_some`.
-      `to_result`, `is_none`, `is_some`.
+      _(Pending: fold/join/iter/to_list/to_result.)_
- [ ] `Result`: `map`, `bind`, `fold`, `get_ok`, `get_error`, `map_error`,
+- [~] `Result`: `map`, `bind`, `is_ok`, `is_error`. _(Pending:
-      `to_option`, `is_ok`, `is_error`.
+      fold/get_ok/get_error/map_error/to_option.)_
 - [~] `String`: `length`, `get`, `sub`, `concat`, `uppercase_ascii`,
      `lowercase_ascii`, `starts_with`. _(Pending: split_on_char, trim,
      contains, ends_with, index_opt, replace_all.)_
 - [~] `Char`: `code`, `chr`, `lowercase_ascii`, `uppercase_ascii`.
      _(Pending: escaped.)_
 - [~] `Int`: `to_string`, `of_string`, `abs`, `max`, `min`.
      _(Pending: arithmetic helpers, min_int/max_int.)_
 - [~] `Float`: `to_string`. _(Pending: of_string, arithmetic helpers.)_
 - [~] `Printf`: stub `sprintf`/`printf`. _(Real format-string
      interpretation pending.)_
 - [ ] `String`: `length`, `get`, `sub`, `concat`, `split_on_char`, `trim`,
      `uppercase_ascii`, `lowercase_ascii`, `contains`, `starts_with`, `ends_with`,
      `index_opt`, `replace_all` (non-stdlib but needed).
@@ -308,7 +355,171 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means:
 _Newest first._
-_(awaiting phase 1)_
+- 2026-05-08 Phase 1+2 — record literals `{ x = 1; y = 2 }` and
  functional update `{ r with x = 99 }`. Parser produces `(:record (F E)
  ...)` and `(:record-update BASE-EXPR (F E) ...)`. Eval builds a dict
  from field bindings; record-update merges over the base dict (the same
  dict-based representation we already use for modules). Field access
  via existing `:field` postfix. Record patterns deferred. 289/289 (+6).
 - 2026-05-08 Phase 5.1 — `lib/ocaml/conformance.sh` + `scoreboard.json`
  + `scoreboard.md`. Classifies tests into 14 suites by description
  prefix and emits structured pass/fail counts. Current: 284 pass / 0
  fail (one test counted twice in classifier, hence 284 vs 283
  underlying). Vendoring real OCaml testsuite is the next step but
  needs more stdlib coverage to make .ml files runnable end-to-end.
 - 2026-05-08 Phase 1 — unit `()` and wildcard `_` parameters in `let f ()
  = …` / `fun _ -> …` / `let f _ = …`. Parser helper `try-consume-param!`
  now handles ident, wildcard `_` (renamed to `__wild_N`), unit `()`
  (renamed to `__unit_N`), and typed `(x : T)` (signature skipped).
  Same for top-level `parse-decl-let`. test.sh timeout extended from
  60s to 180s for the growing suite. 283/283 (+5).
 - 2026-05-08 Phase 6 — extended stdlib slice (+13 tests, 278 total).
  Host primitives exposed via `_string_*`, `_char_*`, `_int_*`,
  `_string_of_*` underscore-prefixed builtins so the OCaml-side
  `lib/ocaml/runtime.sx` modules can wrap them: String (length, get,
  sub, concat, uppercase_ascii, lowercase_ascii, starts_with), Char
  (code, chr, lowercase_ascii, uppercase_ascii), Int (to_string,
  of_string, abs, max, min), Float.to_string, Printf stubs. Also added
  `print_string`/`print_endline`/`print_int` builtins.
 - 2026-05-08 Phase 5 — Hindley-Milner type inference, paired-sequencing
  consumer of `lib/guest/hm.sx` (algebra) and `lib/guest/match.sx`
  (unify). `lib/ocaml/infer.sx` ships Algorithm W rules for OCaml AST:
  atoms, var (instantiate), fun (auto-curry through fresh-tv), app
  (unify against arrow), let (generalize over rhs), if (unify branches),
  neg/not, op (treat as app of builtin). Builtin env types `+`/`-`/etc.
  as monomorphic int->int->int and `=`/`<>` as polymorphic 'a->'a->bool.
  Tested: literals, +1, identity polymorphism `'a -> 'a`, let-poly so
  `let id = fun x -> x in id true : Bool`, `twice` infers
  `('a -> 'a) -> 'a -> 'a`. Mandate satisfied: OCaml-on-SX is the
  deferred second consumer for lib-guest Step 8. 265/265 (+14).
 - 2026-05-08 Phase 2 — `let ... and ...` mutual recursion at top level.
  Parser collects all bindings into a list, emitting `(:def-rec-mut)` or
  `(:def-mut)` when there are 2+. Eval allocates a placeholder cell per
  recursive binding, builds an env with all of them visible, then fills
  the cells. Even/odd mutual-recursion test passes. 251/251 (+3).
 - 2026-05-08 Phase 6 — `lib/ocaml/runtime.sx` minimal stdlib slice
  written entirely in OCaml syntax: List (length, rev, rev_append, map,
  filter, fold_left/right, append, iter, mem, for_all, exists, hd, tl,
  nth), Option (map, bind, value, get, is_none, is_some), Result (map,
  bind, is_ok, is_error). Loaded once via `ocaml-load-stdlib!`, cached
  in `ocaml-stdlib-env`; `ocaml-run` and `ocaml-run-program` layer user
  code on top via `ocaml-base-env`. The fact that these are written in
  OCaml (not SX) and parse + evaluate cleanly is a substrate-validation
  win: every parser, eval, match, ref, and module path proven by a
  single nontrivial Ocaml program. 248/248 (+23).
 - 2026-05-08 Phase 4 — functors + module aliases (+5 tests, 225 total).
  Parser: `module F (M) = struct DECLS end` → `(:functor-def NAME PARAMS
  DECLS)`. `module N = expr` (where expr isn't `struct`) → `(:module-alias
  NAME BODY-SRC)`. Functor params accept `(P)` or `(P : Sig)` (signatures
  parsed-and-skipped). Eval: `ocaml-make-functor` builds a curried
  host-SX closure that takes module dicts and returns a module dict;
  `ocaml-resolve-module-path` extended for `:app` so `F(A)`, `F(A)(B)`,
  `Outer.Inner` all resolve to dicts. Tested: 1-arg functor, 2-arg
  curried `Pair(One)(Two)`, module alias, submodule alias, identity
  functor with include. Phase 4 LOC ~290 (still well under 2000).
 - 2026-05-08 Phase 4 — `open M` / `include M` (+5 tests, 220 total).
  Parser: top-level `open Path` / `include Path` decls; path is `Ctor (.
  Ctor)*`. Eval resolves the path via `ocaml-resolve-module-path` (the
  same `:con`-as-module-lookup escape hatch used for `:field`); merges
  the dict bindings into the current env via `ocaml-env-merge-dict`.
  `include` inside a module also adds the bindings to the module's
  resulting dict, so `module Sphere = struct include Math let area r =
  ... end` exposes both Math's `pi` and Sphere's `area`. Phase 4 LOC
  cumulative: ~165.
 - 2026-05-08 Phase 4 — modules + field access (+11 tests, 215 total). Parser:
  `module M = struct DECLS end` decl in `ocaml-parse-program`. Body parsed
  by sub-tokenising the source between `struct` and the matching `end`,
  tracking nesting via `struct`/`begin`/`sig`/`end`. Field access added
  as a postfix layer above `parse-atom`, binding tighter than application:
  `f r.x` → `(:app f (:field r "x"))`. Eval: `(:module-def NAME DECLS)`
  builds a dict via new `ocaml-eval-module` that runs decls in a sub-env;
  `(:field EXPR NAME)` looks up the field, with the special case that
  `(:con NAME)` heads are interpreted as module-name lookups instead of
  nullary ctors. Tested: simple module, multi-decl module, nested modules
  (`Outer.Inner.v`), `let rec` inside a module, module containing tuple
  pattern match. Phase 4 LOC: ~110 (well under 2000 budget).
 - 2026-05-08 Phase 2 — `try`/`with` + `raise` builtin. Parser produces
  `(:try EXPR CLAUSES)`; eval delegates to SX `guard` with `else`
  matching the raised value against clause patterns and re-raising on
  no-match. `raise`/`failwith`/`invalid_arg` exposed as builtins;
  failwith builds `("Failure" msg)` so `Failure msg -> ...` patterns
  match. 204/204 (+6).
 - 2026-05-08 Phase 2 — `function | pat -> body | …` parser + eval.
  Sugar for `fun x -> match x with | …`. AST: `(:function CLAUSES)`
  evaluated to a unary closure that runs `ocaml-match-clauses` on the
  argument. `let rec` knot also triggers when rhs is `:function`, so
  `let rec map f = function | [] -> [] | h::t -> f h :: map f t` works.
  ocaml-match-eval refactored to share `ocaml-match-clauses` with the
  function form. 198/198 (+4).
 - 2026-05-08 Phase 2 — `for`/`while` loops. `(:for NAME LO HI DIR BODY)`
  with `:ascend`/`:descend` direction (`to`/`downto`); `(:while COND BODY)`.
  Both eval to unit and re-bind the loop var per iteration. 194/194 (+5).
 - 2026-05-08 Phase 2 — references (`ref`/`!`/`:=`). `ref` is a builtin
  that boxes its argument in a one-element list (the mutable cell);
  prefix `!` parses to `(:deref EXPR)` and reads `(nth cell 0)`; `:=`
  joins the precedence table at the lowest binop level (right-assoc) and
  short-circuits in eval to mutate via `set-nth!`. Closures capture refs
  by sharing the underlying list. 189/189 (+6).
 - 2026-05-08 Phase 3 — pattern matching evaluator + constructors (+18
  tests, 183 total). Constructor application: `(:app (:con NAME) arg)`
  builds a tagged list `(NAME …args)` with tuple args flattened (so
  `Pair (a, b)` → `("Pair" a b)` matches the parser's pattern flatten).
  Standalone ctor `(:con NAME)` → `(NAME)` (nullary). Pattern matcher:
  :pwild / :pvar / :plit (unboxed compare) / :pcon (head + arity match) /
  :pcons (cons-decompose) / :plist (length+items) / :ptuple (after `tuple`
  tag). Match drives clauses until first success; runtime error on
  exhaustion. Tested with option match, literal match, tuple match,
  recursive list functions (`len`, `sum`), nested ctor (`Pair(a,b)`).
  Note: arity flattening happens for any tuple-arg ctor — without ADT
  declarations there's no way to distinguish `Some (1,2)` (single tuple
  payload) from `Pair (1,2)` (two-arg ctor). All-flatten convention is
  consistent across parser + evaluator.
 - 2026-05-08 Phase 2 — `lib/ocaml/eval.sx`: ocaml-eval + ocaml-run +
  ocaml-run-program. Coverage: atoms, var lookup, :app (curried),
  :op (arithmetic/comparison/boolean/^/mod/::/|>), :neg, :not, :if,
  :seq, :tuple, :list, :fun (auto-curried host-SX closures), :let,
  :let-rec (recursive knot via one-element-list mutable cell). Initial
  env exposes `not`/`succ`/`pred`/`abs`/`max`/`min`/`fst`/`snd`/`ignore`
  as host-SX functions. Tests: literals, arithmetic, comparison, boolean,
  string concat, conditionals, lambda + closures + recursion (fact 5,
  fib 10, sum 100), sequences, top-level program decls, |> pipe. 165/165
  passing (+42).
 - 2026-05-07 Phase 1 — sequence operator `;`. Lowest-precedence binary;
  `e1; e2; e3` → `(:seq e1 e2 e3)`. Two-phase grammar: `parse-expr-no-seq`
  is the prior expression entry point; new `parse-expr` wraps it with
  `;` chaining. List-literal items still use `parse-expr-no-seq` so `;`
  retains its separator role inside `[…]`. Match-clause bodies use the
  seq variant and stop at `|`, matching real OCaml semantics. Trailing `;`
  before `end`/`)`/`|`/`in`/`then`/`else`/eof is permitted. 123/123 tests
  passing (+10).
 - 2026-05-07 Phase 1 — `match`/`with` + pattern parser. Patterns: wildcard,
  literal, var, ctor (nullary + with arg, with tuple-arg flattening so
  `Pair (a, b)` → `(:pcon "Pair" PA PB)`), tuple, list literal, cons `::`
  (right-assoc), parens, unit. Match clauses: leading `|` optional, body
  parsed via `parse-expr`. AST: `(:match SCRUT CLAUSES)` where each clause
  is `(:case PAT BODY)`. 113/113 tests passing (+9). Note: parse-expr is
  used for case bodies, so a trailing `| pat -> body` after a complex body
  will be reached because `|` is not in the binop table for level 1.
 - 2026-05-07 Phase 1 — top-level program parser `ocaml-parse-program`. Parses
  a sequence of `let [rec] name params* = expr` decls and bare expressions
  separated by `;;`. Output `(:program DECLS)` with each decl one of `(:def …)`,
  `(:def-rec …)`, `(:expr E)`. Decl bodies parsed by re-feeding the source
  slice through `ocaml-parse` (cheap stand-in until shared-state refactor).
  104/104 tests now passing (+9).
 - 2026-05-07 Phase 1 — `lib/ocaml/parser.sx` expression parser consuming
  `lib/guest/pratt.sx` for binop precedence (29 operators across 8 levels,
  incl. keyword-spelled binops `mod`/`land`/`lor`/`lxor`/`lsl`/`lsr`/`asr`).
  Atoms (literals + var/con/unit/list), application (left-assoc), prefix
  `-`/`not`, tuples, parens, `if`/`then`/`else`, `fun x y -> body`,
  `let`/`let rec` with function shorthand. AST shapes match Haskell-on-SX
  conventions (`(:int N)` `(:op OP L R)` `(:fun PARAMS BODY)` etc.). Total
  95/95 tests now passing via `lib/ocaml/test.sh`.
 - 2026-05-07 Phase 1 — `lib/ocaml/tokenizer.sx` consuming `lib/guest/lex.sx`
  via `prefix-rename`. Covers idents, ctors, 51 keywords, numbers (int / float
  / hex / exponent / underscored), strings (with escapes), chars (with escapes),
  type variables (`'a`), nested block comments, and 26 operator/punct tokens
  (incl. `->` `|>` `<-` `:=` `::` `;;` `@@` `<>` `&&` `||` `**` etc.). 58/58
  tokenizer tests pass via `lib/ocaml/test.sh` driving `sx_server.exe`.
 ## Blockers
Author	SHA1	Message	Date
giles	7fb65cd26a	ocaml: phase 1+2 records {x=1;y=2} + with-update (+6 tests, 289 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 51s Details Parser: { f = e; f = e; ... } -> (:record (F E)...). { base with f = e; ... } -> (:record-update BASE (F E)...). Eval builds a dict from field bindings; record-update merges the new fields over the base dict — the same dict representation already used for modules. { also added to at-app-start? so records are valid arg atoms. Field access via the existing :field postfix unifies record/module access. Record patterns deferred to a later iteration.	2026-05-08 09:26:24 +00:00
giles	9473911cf3	ocaml: phase 5.1 conformance.sh + scoreboard (283 tests across 14 suites) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 45s Details lib/ocaml/conformance.sh runs the full test suite, classifies each result by description prefix into one of 14 suites (tokenize, parser, eval-core, phase2-refs/loops/function/exn, phase3-adt, phase4-modules, phase5-hm, phase6-stdlib, let-and, phase1-params, misc), and emits scoreboard.json + scoreboard.md. Per the briefing: "Once the scoreboard exists (Phase 5.1), it is your north star." Real OCaml testsuite vendoring deferred — needs more stdlib + ADT decls to make .ml files runnable.	2026-05-08 09:23:06 +00:00
giles	74b80e6b0e	ocaml: phase 1 unit/wildcard params + 180s timeout (+5 tests, 283 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 34s Details Parser: try-consume-param! handles ident, wildcard _ (fresh __wild_N name), unit () (fresh __unit_N), typed (x : T) (skips signature). parse-fun and parse-let (inline) reuse the helper; top-level parse-decl-let inlines a similar test. test.sh timeout bumped from 60s to 180s — the growing suite was hitting the cap and reporting spurious failures.	2026-05-08 09:21:06 +00:00
giles	c8bfd22786	ocaml: phase 6 String/Char/Int/Float/Printf modules (+13 tests, 278 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 53s Details Host primitives _string_length / _string_sub / _char_code / etc. exposed in the base env (underscore-prefixed to avoid user clash). lib/ocaml/ runtime.sx wraps them into OCaml-syntax modules: String (length, get, sub, concat, uppercase/lowercase_ascii, starts_with), Char (code, chr, lowercase/uppercase_ascii), Int (to_string, of_string, abs, max, min), Float.to_string, Printf stubs. Also added print_string / print_endline / print_int IO builtins.	2026-05-08 09:10:06 +00:00
giles	26863242a0	ocaml: phase 5 HM type inference — closes lib-guest step 8 (+14 tests, 265 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 53s Details OCaml-on-SX is the deferred second consumer for lib/guest/hm.sx step 8. lib/ocaml/infer.sx assembles Algorithm W on top of the shipped algebra: - Var: lookup + hm-instantiate. - Fun: fresh-tv per param, auto-curried via recursion. - App: unify against hm-arrow, fresh-tv for result. - Let: generalize rhs over (ftv(t) - ftv(env)) — let-polymorphism. - If: unify cond with Bool, both branches with each other. - Op (+, =, <, etc.): builtin signatures (int*int->int monomorphic, =/<> polymorphic 'a->'a->bool). Tests pass for: literals, fun x -> x : 'a -> 'a, let id ... id 5/id true, fun f x -> f (f x) : ('a -> 'a) -> 'a -> 'a (twice). Pending: tuples, lists, pattern matching, let-rec, modules in HM.	2026-05-08 09:02:25 +00:00
giles	4c6790046c	ocaml: phase 2 let..and.. mutual recursion (+3 tests, 251 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 51s Details Parser collects multiple bindings via 'and', emitting (:def-rec-mut BINDINGS) for let-rec chains and (:def-mut BINDINGS) for non-rec. Single bindings keep the existing (:def …) / (:def-rec …) shapes. Eval (def-rec-mut): allocate placeholder cell per binding, build joint env where each name forwards through its cell, then evaluate each rhs against the joint env and fill the cells. Even/odd mutual-rec works.	2026-05-08 08:53:53 +00:00
giles	19f1cad11d	ocaml: phase 6 stdlib slice (List/Option/Result, +23 tests, 248 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 45s Details lib/ocaml/runtime.sx defines the stdlib in OCaml syntax (not SX): every function exercises the parser, evaluator, match engine, and module machinery built in earlier phases. Loaded once via ocaml-load-stdlib!, cached in ocaml-stdlib-env, layered under user code via ocaml-base-env. List: length, rev, rev_append, map, filter, fold_left/right, append, iter, mem, for_all, exists, hd, tl, nth. Option: map, bind, value, get, is_none, is_some. Result: map, bind, is_ok, is_error. Substrate validation: this stdlib is a nontrivial OCaml program — its mere existence proves the substrate works.	2026-05-08 08:49:44 +00:00
giles	5603ecc3a6	ocaml: phase 4 functors + module aliases (+5 tests, 225 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 53s Details Parser: module F (M) (N) ... = struct DECLS end -> (:functor-def NAME PARAMS DECLS). module N = expr (non-struct) -> (:module-alias NAME BODY-SRC). Functor params accept (P) or (P : Sig) — signatures parsed-and-skipped via skip-optional-sig. Eval: ocaml-make-functor builds curried host-SX closures from module dicts to a module dict. ocaml-resolve-module-path extended for :app so F(A), F(A)(B), and Outer.Inner all resolve to dicts. Phase 4 LOC ~290 cumulative (still well under 2000).	2026-05-08 08:44:54 +00:00
giles	d45e653a87	ocaml: phase 4 open / include (+5 tests, 220 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 57s Details Parser: open Path and include Path top-level decls; Path is Ctor (.Ctor)*. Eval resolves via ocaml-resolve-module-path (same :con-as-module-lookup escape hatch used by :field). open extends the env with the module's bindings; include also merges into the surrounding module's exports (when inside a struct...end). Path resolver lets M.Sub.x work for nested modules. Phase 4 LOC ~165.	2026-05-08 08:39:13 +00:00
giles	317f93b2af	ocaml: phase 4 modules + field access (+11 tests, 215 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 54s Details module M = struct DECLS end parsed by sub-tokenising the body source between struct and the matching end (nesting tracked via struct/begin/ sig/end). Field access is a postfix layer above parse-atom, binding tighter than application: f r.x -> (:app f (:field r "x")). Eval (:module-def NAME DECLS) builds a dict via ocaml-eval-module running decls in a sub-env. (:field EXPR NAME) looks up dict fields, treating (:con NAME) heads as module-name lookups instead of nullary ctors so M.x works with M as a module. Phase 4 LOC so far: ~110 lines (well under 2000 budget).	2026-05-08 08:33:34 +00:00
giles	6a1f63f0d1	ocaml: phase 2 try/with + raise (+6 tests, 204 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 57s Details Parser: try EXPR with \| pat -> handler \| ... -> (:try EXPR CLAUSES). Eval delegates to SX guard with else matching the raised value against clause patterns; re-raises on no-match. raise/failwith/invalid_arg shipped as builtins. failwith "msg" raises ("Failure" msg) so \| Failure msg -> ... patterns match.	2026-05-08 08:20:11 +00:00
giles	937342bbf0	ocaml: phase 2 function \| pat -> body (+4 tests, 198 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 54s Details Sugar for fun + match. AST (:function CLAUSES) -> unary closure that runs ocaml-match-clauses on its arg. let rec recognises :function as a recursive rhs and ties the knot via cell, so let rec map f = function \| [] -> [] \| h::t -> f h :: map f t works. ocaml-match-eval refactored to share clause-walk with function.	2026-05-08 08:15:38 +00:00
giles	9b8b0b4325	ocaml: phase 2 for/while loops (+5 tests, 194 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 52s Details Parser: for i = lo to\|downto hi do body done, while cond do body done. AST: (:for NAME LO HI :ascend\|:descend BODY) and (:while COND BODY). Eval re-binds the loop var per iteration; both forms evaluate to unit.	2026-05-08 08:11:13 +00:00
giles	a11f3c33b6	ocaml: phase 2 references ref/!/:= (+6 tests, 189 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 55s Details ref is a builtin boxing its arg in a one-element list. Prefix ! parses to (:deref ...) and reads via (nth cell 0). := joins the binop precedence table at level 1 right-assoc and mutates via set-nth!. Closures share the underlying cell.	2026-05-08 08:07:26 +00:00
giles	9b833a9442	ocaml: phase 3 pattern matching + constructors (+18 tests, 183 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 56s Details Constructor app: (:app (:con NAME) arg) -> (NAME …args). Tuple args flatten so Pair(a,b) -> ("Pair" a b), matching the parser's pattern flatten. Standalone (:con NAME) -> (NAME) nullary. Pattern matcher: :pwild, :pvar, :plit, :pcon (head + arity), :pcons (decompose), :plist (length match), :ptuple (after tuple tag). Match walks clauses until first success; runtime error on exhaustion. Recursive list functions (len, sum, fact) work end-to-end.	2026-05-08 08:02:56 +00:00
giles	4dca583ee3	ocaml: phase 2 evaluator slice (+42 tests, 165 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 52s Details ocaml-eval walks the AST and yields SX values. ocaml-run / ocaml-run-program wrap parse + eval. Coverage: atoms, vars, app (curried), 22 binary ops, prefix - and not, if/seq/tuple/list, fun (auto-curried via host SX lambdas), let, let-rec (mutable-cell knot for recursive functions). Initial env: not/succ/pred/abs/max/min/fst/snd/ignore. Tests: arithmetic, comparison, string concat, closures, fact 5 / fib 10 / sum 100, top-level decls, \|> pipe.	2026-05-08 07:57:20 +00:00
giles	a6ab944c39	ocaml: phase 1 sequence operator ; (+10 tests, 123 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 53s Details Two-phase grammar: parse-expr-no-seq (prior entry) + parse-expr wraps it with ;-chaining. List bodies keep parse-expr-no-seq so ; remains a separator inside [...]. Match clause bodies use the seq variant and stop at \| — real OCaml semantics. Trailing ; before end/)/\|/in/then/else/eof permitted.	2026-05-08 07:48:52 +00:00
giles	9102e57d89	ocaml: phase 1 match/with + pattern parser (+9 tests, 113 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 52s Details Patterns: wildcard, literal, var, ctor (nullary + arg, flattens tuple args so Pair(a,b) -> (:pcon "Pair" PA PB)), tuple, list literal, cons :: (right-assoc), unit. Match: leading \| optional, (:match SCRUT CLAUSES) with each clause (:case PAT BODY). Body parsed via parse-expr because \| is below level-1 binop precedence.	2026-05-08 07:29:02 +00:00
giles	9648dac88d	ocaml: phase 1 top-level decls (+9 tests, 104 total) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 49s Details ocaml-parse-program: program = decls + bare exprs, ;;-separated. Each decl is (:def …), (:def-rec …), or (:expr …). Body parsing re-feeds the source slice through ocaml-parse — shared-state refactor deferred.	2026-05-08 07:25:11 +00:00
giles	9a090c6e42	ocaml: phase 1 expression parser (+37 tests, 95 total) — consumes lib/guest/pratt.sx Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 55s Details Atoms (literals/var/con/unit/list), application (left-assoc), prefix - / not, 29-op precedence table via pratt-op-lookup (incl. keyword-spelled mod/land/ lor/lxor/lsl/lsr/asr), tuples, parens, if/then/else, fun, let, let rec with function shorthand. AST follows Haskell-on-SX (:int / :op / :fun / etc).	2026-05-07 23:26:48 +00:00
giles	85b7fed4fc	ocaml: phase 1 tokenizer (+58 tests) — consumes lib/guest/lex.sx Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 52s Details Idents, ctors, 51 keywords, numbers (int/float/hex/exp/underscored), strings + chars with escapes, type variables, 26 op/punct tokens, and nested (* ... *) block comments. Tests via epoch protocol against sx_server.exe.	2026-05-07 23:04:40 +00:00