datalog: built-ins + body arithmetic + order-aware safety (Phase 4, 106/106)

New lib/datalog/builtins.sx: (< <= > >= = !=) and (is X expr) with
+ - * /. dl-eval-arith recursively evaluates nested compounds.
Safety analysis now walks body left-to-right tracking the bound
set: comparisons require all args bound, is RHS vars must be bound
(LHS becomes bound), = special-cases the var/non-var combos.
db.sx keeps the simple safety check as a forward-reference
fallback; builtins.sx redefines dl-rule-check-safety to the
comprehensive version. eval.sx dispatches built-ins through
dl-eval-builtin instead of erroring. 19 new tests.

lib/datalog/builtins.sx

@@ -0,0 +1,300 @@
+;; 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-lit!
+          (fn
+            (lit)
+            (when
+              (nil? err)
+              (cond
+                ((and (dict? lit) (has-key? lit :neg))
+                  (dl-process-neg! 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))))

lib/datalog/conformance.conf

@@ -0,0 +1,21 @@
+# 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/eval.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!)"
+)

lib/datalog/conformance.sh

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

lib/datalog/db.sx

@@ -0,0 +1,227 @@
+;; 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 {} :rules (list)}))
+
+(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)
+    (cond
+      ((= (len lits) 0) false)
+      ((dl-tuple-equal? lit (first lits)) true)
+      (else (dl-tuple-member? lit (rest lits))))))
+
+(define
+  dl-ensure-rel!
+  (fn
+    (db rel-key)
+    (let
+      ((facts (get db :facts)))
+      (do
+        (when
+          (not (has-key? facts rel-key))
+          (dict-set! facts rel-key (list)))
+        (get facts rel-key)))))
+
+(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)))
+            (cond
+              ((dl-tuple-member? lit tuples) false)
+              (else (do (append! tuples 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-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
+          ((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))))

lib/datalog/eval.sx

@@ -0,0 +1,147 @@
+;; lib/datalog/eval.sx — naive bottom-up fixpoint evaluator.
+;;
+;; (dl-saturate! db) iterates rules until no new tuples are derived.
+;; The Herbrand base is finite (no function symbols) so termination is
+;; guaranteed by the language.
+;;
+;; Body literal kinds handled here:
+;;   positive (rel arg ... arg)  → match against EDB+IDB tuples (dl-match-positive)
+;;   built-in (< X Y), (is X e)  → constraint via dl-eval-builtin (Phase 4)
+;;   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
+            ((tuples (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)))))))
+
+(define
+  dl-match-lit
+  (fn
+    (lit db subst)
+    (cond
+      ((and (dict? lit) (has-key? lit :neg))
+        (error "datalog: negation not yet supported (Phase 7)"))
+      ((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)
+    (cond
+      ((nil? subst) (list))
+      ((= (len lits) 0) (list subst))
+      (else
+        (let
+          ((options (dl-match-lit (first lits) db subst))
+            (results (list)))
+          (do
+            (for-each
+              (fn
+                (s)
+                (for-each
+                  (fn (s2) (append! results s2))
+                  (dl-find-bindings (rest lits) db s)))
+              options)
+            results))))))
+
+(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!
+  (fn
+    (db)
+    (let
+      ((changed true))
+      (do
+        (define
+          dl-sat-loop
+          (fn
+            ()
+            (when
+              changed
+              (do
+                (set! changed false)
+                (for-each
+                  (fn (r) (when (dl-apply-rule! db r) (set! changed true)))
+                  (dl-rules db))
+                (dl-sat-loop)))))
+        (dl-sat-loop)
+        db))))
+
+(define
+  dl-query
+  (fn
+    (db goal)
+    (do
+      (dl-saturate! db)
+      (let
+        ((substs (dl-find-bindings (list goal) db (dl-empty-subst)))
+          (vars (dl-vars-of goal))
+          (results (list)))
+        (do
+          (for-each
+            (fn
+              (s)
+              (let
+                ((proj (dl-project-subst s vars)))
+                (when
+                  (not (dl-tuple-member? proj results))
+                  (append! results proj))))
+            substs)
+          results)))))
+
+(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)))

lib/datalog/parser.sx

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

lib/datalog/scoreboard.json

@@ -0,0 +1,14 @@
+{
+  "lang": "datalog",
+  "total_passed": 106,
+  "total_failed": 0,
+  "total": 106,
+  "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":15,"failed":0,"total":15},
+    {"name":"builtins","passed":19,"failed":0,"total":19}
+  ],
+  "generated": "2026-05-07T23:50:44+00:00"
+}

lib/datalog/scoreboard.md

@@ -0,0 +1,11 @@
+# datalog scoreboard
+
+**106 / 106 passing** (0 failure(s)).
+
+| Suite | Passed | Total | Status |
+|-------|--------|-------|--------|
+| tokenize | 26 | 26 | ok |
+| parse | 18 | 18 | ok |
+| unify | 28 | 28 | ok |
+| eval | 15 | 15 | ok |
+| builtins | 19 | 19 | ok |

lib/datalog/tests/builtins.sx

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

lib/datalog/tests/eval.sx

@@ -0,0 +1,206 @@
+;; 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)
+      (dl-et-test!
+        "underscore var ok"
+        (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))))
+
+(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})))

lib/datalog/tests/parse.sx

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

lib/datalog/tests/tokenize.sx

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

lib/datalog/tests/unify.sx

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

lib/datalog/tokenizer.sx

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

lib/datalog/unify.sx

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

lib/ocaml/eval.sx

@@ -1,432 +0,0 @@
-;; 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))))))
-
-(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)))
-
-(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-eval
-  (fn (scrut-ast clauses env)
-    (let ((val (ocaml-eval scrut-ast 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)))))
-
-;; 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 "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 "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")
-          ;; For function bindings: tie the knot via a mutable cell. The
-          ;; placeholder closure that's bound first dereferences the cell
-          ;; on each call, so the function can call itself once the cell
-          ;; is set to the real closure.
-          (let ((name (nth ast 1)) (params (nth ast 2))
-                (rhs (nth ast 3)) (body (nth ast 4)))
-            (cond
-              ((= (len params) 0)
-                ;; Non-functional let-rec — OCaml only allows this when the
-                ;; rhs is "syntactically a function or constructor". For the
-                ;; common case of a value, evaluate non-recursively.
-                (let ((rhs-val (ocaml-eval rhs env)))
-                  (ocaml-eval body (ocaml-env-extend env name rhs-val))))
-              (else
-                ;; Use a one-element list as a mutable cell to tie the
-                ;; recursive knot. The placeholder closure dereferences
-                ;; the cell on each call.
-                (let ((cell (list nil)))
-                  (let ((env2 (ocaml-env-extend env name
-                                (fn (arg) ((nth cell 0) arg)))))
-                    (let ((rhs-val (ocaml-make-curried params rhs env2)))
-                      (begin
-                        (set-nth! cell 0 rhs-val)
-                        (ocaml-eval body env2)))))))))
-        (else (error
-          (str "ocaml-eval: unknown AST tag " tag)))))))
-
-;; ocaml-run — convenience wrapper: parse + eval.
-(define ocaml-run
-  (fn (src)
-    (ocaml-eval (ocaml-parse src) (ocaml-empty-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-empty-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)))
-                    (cond
-                      ((= (len params) 0)
-                        (let ((v (ocaml-eval rhs env)))
-                          (begin
-                            (set! env (ocaml-env-extend env name v))
-                            (set! last v))))
-                      (else
-                        (let ((cell (list nil)))
-                          (let ((env2 (ocaml-env-extend env name
-                                        (fn (arg) ((nth cell 0) arg)))))
-                            (let ((v (ocaml-make-curried params rhs env2)))
-                              (begin
-                                (set-nth! cell 0 v)
-                                (set! env env2)
-                                (set! last v)))))))))
-                ((= tag "expr")
-                  (set! last (ocaml-eval (nth decl 1) env)))
-                (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))))

lib/ocaml/parser.sx

@@ -1,789 +0,0 @@
-;; lib/ocaml/parser.sx — OCaml expression parser.
-;;
-;; Input: token list from (ocaml-tokenize src).
-;; Output: an OCaml AST. Nodes are plain lists tagged by a keyword head;
-;; keywords serialize to their string name so `(list :var "x")` is the
-;; same value as `(list "var" "x")` at runtime.
-;;
-;; Expression scope:
-;;   atoms     int/float/string/char/bool, unit (), var, con, list literal
-;;   application   left-associative, f x y z
-;;   prefix    -E unary minus, not E
-;;   infix     29 ops via lib/guest/pratt.sx
-;;   tuple     a, b, c   (lower than infix, higher than let/if)
-;;   parens    (e)
-;;   if        if c then t else e   (else optional → unit)
-;;   fun       fun x y -> body
-;;   let       let x = e in body          (no rec, function shorthand)
-;;             let rec f x = e in body
-;;   match     match e with [|] p -> body | p -> body | ...
-;;   sequence  e1 ; e2  → (:seq e1 e2 …)   (lowest-precedence binary)
-;;
-;; Pattern scope:
-;;   _ (wildcard), int/string/char/bool literals, ident (var binding),
-;;   ctor (no args), ctor pat, (), parens, tuple (pat,pat,…),
-;;   list literal [pat;pat;…], cons p1 :: p2.
-;;
-;; AST shapes:
-;;   (:int N) (:float N) (:string S) (:char C) (:bool B) (:unit)
-;;   (:var NAME) (:con NAME)
-;;   (:app FN ARG)
-;;   (:op OP LHS RHS)
-;;   (:neg E) (:not E)
-;;   (:tuple ITEMS) (:list ITEMS)
-;;   (:seq EXPRS)
-;;   (:if C T E)
-;;   (:fun PARAMS BODY)
-;;   (:let NAME PARAMS EXPR BODY) (:let-rec NAME PARAMS EXPR BODY)
-;;   (:match SCRUTINEE CLAUSES)        CLAUSES = ((:case PAT BODY) ...)
-;;
-;;   (:pwild) (:pvar N) (:plit LIT)
-;;   (:pcon NAME ARG-PATS)            — ARG-PATS empty for nullary
-;;   (:ptuple PATS) (:plist PATS) (:pcons HEAD TAIL)
-
-(define ocaml-tok-type (fn (t) (if (= t nil) "eof" (get t :type))))
-
-(define ocaml-tok-value (fn (t) (if (= t nil) nil (get t :value))))
-
-(define
-  ocaml-op-table
-  (list
-    (list ":=" 1 :right)
-    (list "||" 2 :right)
-    (list "or" 2 :right)
-    (list "&&" 3 :right)
-    (list "&" 3 :right)
-    (list "=" 4 :left)
-    (list "<" 4 :left)
-    (list ">" 4 :left)
-    (list "<=" 4 :left)
-    (list ">=" 4 :left)
-    (list "<>" 4 :left)
-    (list "==" 4 :left)
-    (list "!=" 4 :left)
-    (list "|>" 4 :left)
-    (list "@" 5 :right)
-    (list "^" 5 :right)
-    (list "::" 6 :right)
-    (list "+" 7 :left)
-    (list "-" 7 :left)
-    (list "*" 8 :left)
-    (list "/" 8 :left)
-    (list "%" 8 :left)
-    (list "mod" 8 :left)
-    (list "land" 8 :left)
-    (list "lor" 8 :left)
-    (list "lxor" 8 :left)
-    (list "**" 9 :right)
-    (list "lsl" 9 :right)
-    (list "lsr" 9 :right)
-    (list "asr" 9 :right)))
-
-(define
-  ocaml-binop-prec
-  (fn
-    (op)
-    (let
-      ((entry (pratt-op-lookup ocaml-op-table op)))
-      (if (= entry nil) 0 (pratt-op-prec entry)))))
-
-(define
-  ocaml-binop-right?
-  (fn
-    (op)
-    (let
-      ((entry (pratt-op-lookup ocaml-op-table op)))
-      (and (not (= entry nil)) (= (pratt-op-assoc entry) :right)))))
-
-(define
-  ocaml-tok-is-binop?
-  (fn
-    (tok)
-    (let
-      ((tt (ocaml-tok-type tok)) (tv (ocaml-tok-value tok)))
-      (cond
-        ((= tt "op") (not (= (ocaml-binop-prec tv) 0)))
-        ((= tt "keyword") (not (= (ocaml-binop-prec tv) 0)))
-        (else false)))))
-
-(define
-  ocaml-parse
-  (fn
-    (src)
-    (let
-      ((tokens (ocaml-tokenize src)) (idx 0) (tok-len 0))
-      (begin
-        (set! tok-len (len tokens))
-        (define peek-tok (fn () (nth tokens idx)))
-        (define advance-tok! (fn () (set! idx (+ idx 1))))
-        (define
-          check-tok?
-          (fn
-            (type value)
-            (let
-              ((t (peek-tok)))
-              (and
-                (= (ocaml-tok-type t) type)
-                (or (= value nil) (= (ocaml-tok-value t) value))))))
-        (define
-          consume!
-          (fn
-            (type value)
-            (if
-              (check-tok? type value)
-              (let ((t (peek-tok))) (begin (advance-tok!) t))
-              (error
-                (str
-                  "ocaml-parse: expected "
-                  type
-                  " "
-                  value
-                  " got "
-                  (ocaml-tok-type (peek-tok))
-                  " "
-                  (ocaml-tok-value (peek-tok)))))))
-        (define at-kw? (fn (kw) (check-tok? "keyword" kw)))
-        (define at-op? (fn (op) (check-tok? "op" op)))
-        (define parse-pattern (fn () nil))
-        (define parse-pattern-cons (fn () nil))
-        (define parse-pattern-app (fn () nil))
-        (define parse-pattern-atom (fn () nil))
-        (define
-          at-pattern-atom?
-          (fn
-            ()
-            (let
-              ((tt (ocaml-tok-type (peek-tok)))
-                (tv (ocaml-tok-value (peek-tok))))
-              (cond
-                ((= tt "number") true)
-                ((= tt "string") true)
-                ((= tt "char") true)
-                ((= tt "ident") true)
-                ((= tt "ctor") true)
-                ((and (= tt "keyword") (or (= tv "true") (= tv "false")))
-                  true)
-                ((and (= tt "op") (or (= tv "(") (= tv "["))) true)
-                (else false)))))
-        (set!
-          parse-pattern-atom
-          (fn
-            ()
-            (let
-              ((tt (ocaml-tok-type (peek-tok)))
-                (tv (ocaml-tok-value (peek-tok))))
-              (cond
-                ((= tt "number")
-                  (begin
-                    (advance-tok!)
-                    (if
-                      (= (round tv) tv)
-                      (list :plit (list :int tv))
-                      (list :plit (list :float tv)))))
-                ((= tt "string")
-                  (begin (advance-tok!) (list :plit (list :string tv))))
-                ((= tt "char")
-                  (begin (advance-tok!) (list :plit (list :char tv))))
-                ((and (= tt "keyword") (= tv "true"))
-                  (begin (advance-tok!) (list :plit (list :bool true))))
-                ((and (= tt "keyword") (= tv "false"))
-                  (begin (advance-tok!) (list :plit (list :bool false))))
-                ((and (= tt "ident") (= tv "_"))
-                  (begin (advance-tok!) (list :pwild)))
-                ((= tt "ident") (begin (advance-tok!) (list :pvar tv)))
-                ((= tt "ctor") (begin (advance-tok!) (list :pcon tv)))
-                ((and (= tt "op") (= tv "("))
-                  (begin
-                    (advance-tok!)
-                    (cond
-                      ((at-op? ")")
-                        (begin (advance-tok!) (list :plit (list :unit))))
-                      (else
-                        (let
-                          ((first (parse-pattern)))
-                          (cond
-                            ((at-op? ",")
-                              (let
-                                ((items (list first)))
-                                (begin
-                                  (define
-                                    loop
-                                    (fn
-                                      ()
-                                      (when
-                                        (at-op? ",")
-                                        (begin
-                                          (advance-tok!)
-                                          (append! items (parse-pattern))
-                                          (loop)))))
-                                  (loop)
-                                  (consume! "op" ")")
-                                  (cons :ptuple items))))
-                            (else (begin (consume! "op" ")") first))))))))
-                ((and (= tt "op") (= tv "["))
-                  (begin
-                    (advance-tok!)
-                    (cond
-                      ((at-op? "]") (begin (advance-tok!) (list :plist)))
-                      (else
-                        (let
-                          ((items (list)))
-                          (begin
-                            (append! items (parse-pattern))
-                            (define
-                              loop
-                              (fn
-                                ()
-                                (when
-                                  (at-op? ";")
-                                  (begin
-                                    (advance-tok!)
-                                    (when
-                                      (not (at-op? "]"))
-                                      (begin
-                                        (append! items (parse-pattern))
-                                        (loop)))))))
-                            (loop)
-                            (consume! "op" "]")
-                            (cons :plist items)))))))
-                (else
-                  (error
-                    (str
-                      "ocaml-parse: unexpected pattern token "
-                      tt
-                      " "
-                      tv
-                      " at idx "
-                      idx)))))))
-        (set!
-          parse-pattern-app
-          (fn
-            ()
-            (let
-              ((head (parse-pattern-atom)))
-              (cond
-                ((and (= (nth head 0) :pcon) (at-pattern-atom?))
-                  (let
-                    ((arg (parse-pattern-atom)))
-                    (let
-                      ((args (cond ((= (nth arg 0) :ptuple) (rest arg)) (else (list arg)))))
-                      (concat (list :pcon (nth head 1)) args))))
-                (else head)))))
-        (set!
-          parse-pattern-cons
-          (fn
-            ()
-            (let
-              ((lhs (parse-pattern-app)))
-              (cond
-                ((at-op? "::")
-                  (begin
-                    (advance-tok!)
-                    (list :pcons lhs (parse-pattern-cons))))
-                (else lhs)))))
-        (set! parse-pattern (fn () (parse-pattern-cons)))
-        (define parse-expr (fn () nil))
-        (define parse-expr-no-seq (fn () nil))
-        (define parse-tuple (fn () nil))
-        (define parse-binop-rhs (fn (lhs min-prec) lhs))
-        (define parse-prefix (fn () nil))
-        (define parse-app (fn () nil))
-        (define parse-atom (fn () nil))
-        (set!
-          parse-atom
-          (fn
-            ()
-            (let
-              ((t (peek-tok))
-                (tt (ocaml-tok-type (peek-tok)))
-                (tv (ocaml-tok-value (peek-tok))))
-              (cond
-                ((= tt "number")
-                  (begin
-                    (advance-tok!)
-                    (if (= (round tv) tv) (list :int tv) (list :float tv))))
-                ((= tt "string") (begin (advance-tok!) (list :string tv)))
-                ((= tt "char") (begin (advance-tok!) (list :char tv)))
-                ((and (= tt "keyword") (= tv "true"))
-                  (begin (advance-tok!) (list :bool true)))
-                ((and (= tt "keyword") (= tv "false"))
-                  (begin (advance-tok!) (list :bool false)))
-                ((= tt "ident") (begin (advance-tok!) (list :var tv)))
-                ((= tt "ctor") (begin (advance-tok!) (list :con tv)))
-                ((and (= tt "op") (= tv "("))
-                  (begin
-                    (advance-tok!)
-                    (cond
-                      ((at-op? ")") (begin (advance-tok!) (list :unit)))
-                      (else
-                        (let
-                          ((e (parse-expr)))
-                          (begin (consume! "op" ")") e))))))
-                ((and (= tt "op") (= tv "["))
-                  (begin
-                    (advance-tok!)
-                    (cond
-                      ((at-op? "]") (begin (advance-tok!) (list :list)))
-                      (else
-                        (let
-                          ((items (list)))
-                          (begin
-                            (append! items (parse-expr-no-seq))
-                            (define
-                              loop
-                              (fn
-                                ()
-                                (when
-                                  (at-op? ";")
-                                  (begin
-                                    (advance-tok!)
-                                    (when
-                                      (not (at-op? "]"))
-                                      (begin
-                                        (append! items (parse-expr-no-seq))
-                                        (loop)))))))
-                            (loop)
-                            (consume! "op" "]")
-                            (cons :list items)))))))
-                ((at-kw? "begin")
-                  (begin
-                    (advance-tok!)
-                    (let
-                      ((e (parse-expr)))
-                      (begin (consume! "keyword" "end") e))))
-                (else
-                  (error
-                    (str
-                      "ocaml-parse: unexpected token "
-                      tt
-                      " "
-                      tv
-                      " at idx "
-                      idx)))))))
-        (define
-          at-app-start?
-          (fn
-            ()
-            (let
-              ((tt (ocaml-tok-type (peek-tok)))
-                (tv (ocaml-tok-value (peek-tok))))
-              (cond
-                ((= tt "number") true)
-                ((= tt "string") true)
-                ((= tt "char") true)
-                ((= tt "ident") true)
-                ((= tt "ctor") true)
-                ((and (= tt "keyword") (or (= tv "true") (= tv "false") (= tv "begin")))
-                  true)
-                ((and (= tt "op") (or (= tv "(") (= tv "["))) true)
-                (else false)))))
-        (set!
-          parse-app
-          (fn
-            ()
-            (let
-              ((head (parse-atom)))
-              (begin
-                (define
-                  loop
-                  (fn
-                    ()
-                    (when
-                      (at-app-start?)
-                      (let
-                        ((arg (parse-atom)))
-                        (begin (set! head (list :app head arg)) (loop))))))
-                (loop)
-                head))))
-        (set!
-          parse-prefix
-          (fn
-            ()
-            (cond
-              ((at-op? "-")
-                (begin (advance-tok!) (list :neg (parse-prefix))))
-              ((at-op? "!")
-                (begin (advance-tok!) (list :deref (parse-prefix))))
-              ((at-kw? "not")
-                (begin (advance-tok!) (list :not (parse-prefix))))
-              (else (parse-app)))))
-        (set!
-          parse-binop-rhs
-          (fn
-            (lhs min-prec)
-            (let
-              ((tok (peek-tok)))
-              (cond
-                ((not (ocaml-tok-is-binop? tok)) lhs)
-                (else
-                  (let
-                    ((op (ocaml-tok-value tok))
-                      (prec (ocaml-binop-prec (ocaml-tok-value tok))))
-                    (cond
-                      ((< prec min-prec) lhs)
-                      (else
-                        (begin
-                          (advance-tok!)
-                          (let
-                            ((rhs (parse-prefix))
-                              (next-min
-                                (if
-                                  (ocaml-binop-right? op)
-                                  prec
-                                  (+ prec 1))))
-                            (begin
-                              (set! rhs (parse-binop-rhs rhs next-min))
-                              (parse-binop-rhs (list :op op lhs rhs) min-prec))))))))))))
-        (define
-          parse-binary
-          (fn
-            ()
-            (let ((lhs (parse-prefix))) (parse-binop-rhs lhs 1))))
-        (set!
-          parse-tuple
-          (fn
-            ()
-            (let
-              ((first (parse-binary)))
-              (cond
-                ((at-op? ",")
-                  (let
-                    ((items (list first)))
-                    (begin
-                      (define
-                        loop
-                        (fn
-                          ()
-                          (when
-                            (at-op? ",")
-                            (begin
-                              (advance-tok!)
-                              (append! items (parse-binary))
-                              (loop)))))
-                      (loop)
-                      (cons :tuple items))))
-                (else first)))))
-        (define
-          parse-fun
-          (fn
-            ()
-            (let
-              ((params (list)))
-              (begin
-                (define
-                  collect-params
-                  (fn
-                    ()
-                    (when
-                      (check-tok? "ident" nil)
-                      (begin
-                        (append! params (ocaml-tok-value (peek-tok)))
-                        (advance-tok!)
-                        (collect-params)))))
-                (collect-params)
-                (when
-                  (= (len params) 0)
-                  (error "ocaml-parse: fun expects at least one parameter"))
-                (consume! "op" "->")
-                (let ((body (parse-expr))) (list :fun params body))))))
-        (define
-          parse-let
-          (fn
-            ()
-            (let
-              ((reccy false))
-              (begin
-                (when
-                  (at-kw? "rec")
-                  (begin (advance-tok!) (set! reccy true)))
-                (let
-                  ((name (ocaml-tok-value (consume! "ident" nil)))
-                    (params (list)))
-                  (begin
-                    (define
-                      collect-params
-                      (fn
-                        ()
-                        (when
-                          (check-tok? "ident" nil)
-                          (begin
-                            (append! params (ocaml-tok-value (peek-tok)))
-                            (advance-tok!)
-                            (collect-params)))))
-                    (collect-params)
-                    (consume! "op" "=")
-                    (let
-                      ((rhs (parse-expr)))
-                      (begin
-                        (consume! "keyword" "in")
-                        (let
-                          ((body (parse-expr)))
-                          (if
-                            reccy
-                            (list :let-rec name params rhs body)
-                            (list :let name params rhs body)))))))))))
-        (define
-          parse-if
-          (fn
-            ()
-            (let
-              ((cond-expr (parse-expr-no-seq)))
-              (begin
-                (consume! "keyword" "then")
-                (let
-                  ((then-expr (parse-expr-no-seq)))
-                  (cond
-                    ((at-kw? "else")
-                      (begin
-                        (advance-tok!)
-                        (let
-                          ((else-expr (parse-expr-no-seq)))
-                          (list :if cond-expr then-expr else-expr))))
-                    (else (list :if cond-expr then-expr (list :unit)))))))))
-        (define
-          parse-match
-          (fn
-            ()
-            (let
-              ((scrut (parse-expr-no-seq)))
-              (begin
-                (consume! "keyword" "with")
-                (when (at-op? "|") (advance-tok!))
-                (let
-                  ((cases (list)))
-                  (begin
-                    (define
-                      one
-                      (fn
-                        ()
-                        (let
-                          ((p (parse-pattern)))
-                          (begin
-                            (consume! "op" "->")
-                            (let
-                              ((body (parse-expr)))
-                              (append! cases (list :case p body)))))))
-                    (one)
-                    (define
-                      loop
-                      (fn
-                        ()
-                        (when
-                          (at-op? "|")
-                          (begin (advance-tok!) (one) (loop)))))
-                    (loop)
-                    (cons :match (cons scrut (list cases)))))))))
-        (define parse-for
-          (fn ()
-            (let ((name (ocaml-tok-value (consume! "ident" nil))))
-              (begin
-                (consume! "op" "=")
-                (let ((lo (parse-expr-no-seq)))
-                  (let ((dir
-                          (cond
-                            ((at-kw? "to") (begin (advance-tok!) :ascend))
-                            ((at-kw? "downto") (begin (advance-tok!) :descend))
-                            (else (error "ocaml-parse: expected to/downto in for")))))
-                    (let ((hi (parse-expr-no-seq)))
-                      (begin
-                        (consume! "keyword" "do")
-                        (let ((body (parse-expr)))
-                          (begin
-                            (consume! "keyword" "done")
-                            (list :for name lo hi dir body)))))))))))
-        (define parse-while
-          (fn ()
-            (let ((cond-expr (parse-expr-no-seq)))
-              (begin
-                (consume! "keyword" "do")
-                (let ((body (parse-expr)))
-                  (begin
-                    (consume! "keyword" "done")
-                    (list :while cond-expr body)))))))
-        (set!
-          parse-expr-no-seq
-          (fn
-            ()
-            (cond
-              ((at-kw? "fun") (begin (advance-tok!) (parse-fun)))
-              ((at-kw? "let") (begin (advance-tok!) (parse-let)))
-              ((at-kw? "if") (begin (advance-tok!) (parse-if)))
-              ((at-kw? "match") (begin (advance-tok!) (parse-match)))
-              ((at-kw? "for") (begin (advance-tok!) (parse-for)))
-              ((at-kw? "while") (begin (advance-tok!) (parse-while)))
-              (else (parse-tuple)))))
-        (set!
-          parse-expr
-          (fn
-            ()
-            (let
-              ((lhs (parse-expr-no-seq)))
-              (cond
-                ((at-op? ";")
-                  (let
-                    ((items (list lhs)))
-                    (begin
-                      (define
-                        loop
-                        (fn
-                          ()
-                          (when
-                            (at-op? ";")
-                            (begin
-                              (advance-tok!)
-                              (cond
-                                ((at-kw? "end") nil)
-                                ((at-op? ")") nil)
-                                ((at-op? "|") nil)
-                                ((at-kw? "in") nil)
-                                ((at-kw? "then") nil)
-                                ((at-kw? "else") nil)
-                                ((= (ocaml-tok-type (peek-tok)) "eof") nil)
-                                (else
-                                  (begin
-                                    (append! items (parse-expr-no-seq))
-                                    (loop))))))))
-                      (loop)
-                      (cons :seq items))))
-                (else lhs)))))
-        (let
-          ((result (parse-expr)))
-          (begin
-            (when
-              (not (= (ocaml-tok-type (peek-tok)) "eof"))
-              (error
-                (str
-                  "ocaml-parse: trailing tokens at idx "
-                  idx
-                  " — got "
-                  (ocaml-tok-type (peek-tok))
-                  " "
-                  (ocaml-tok-value (peek-tok)))))
-            result))))))
-
-(define
-  ocaml-parse-program
-  (fn
-    (src)
-    (let
-      ((tokens (ocaml-tokenize src))
-        (idx 0)
-        (tok-len 0)
-        (decls (list)))
-      (begin
-        (set! tok-len (len tokens))
-        (define peek-tok (fn () (nth tokens idx)))
-        (define advance-tok! (fn () (set! idx (+ idx 1))))
-        (define
-          check-tok?
-          (fn
-            (type value)
-            (let
-              ((t (peek-tok)))
-              (and
-                (= (ocaml-tok-type t) type)
-                (or (= value nil) (= (ocaml-tok-value t) value))))))
-        (define
-          consume!
-          (fn
-            (type value)
-            (if
-              (check-tok? type value)
-              (let ((t (peek-tok))) (begin (advance-tok!) t))
-              (error
-                (str
-                  "ocaml-parse-program: expected "
-                  type
-                  " "
-                  value
-                  " got "
-                  (ocaml-tok-type (peek-tok))
-                  " "
-                  (ocaml-tok-value (peek-tok)))))))
-        (define at-kw? (fn (kw) (check-tok? "keyword" kw)))
-        (define at-op? (fn (op) (check-tok? "op" op)))
-        (define
-          skip-double-semi!
-          (fn
-            ()
-            (when (at-op? ";;") (begin (advance-tok!) (skip-double-semi!)))))
-        (define
-          cur-pos
-          (fn
-            ()
-            (let ((t (peek-tok))) (if (= t nil) (len src) (get t :pos)))))
-        (define
-          skip-to-boundary!
-          (fn
-            ()
-            (cond
-              ((>= idx tok-len) nil)
-              ((= (ocaml-tok-type (peek-tok)) "eof") nil)
-              ((at-op? ";;") nil)
-              ((at-kw? "let") nil)
-              (else (begin (advance-tok!) (skip-to-boundary!))))))
-        (define
-          parse-decl-let
-          (fn
-            ()
-            (advance-tok!)
-            (let
-              ((reccy false))
-              (begin
-                (when
-                  (at-kw? "rec")
-                  (begin (advance-tok!) (set! reccy true)))
-                (let
-                  ((name (ocaml-tok-value (consume! "ident" nil)))
-                    (params (list)))
-                  (begin
-                    (define
-                      collect-params
-                      (fn
-                        ()
-                        (when
-                          (check-tok? "ident" nil)
-                          (begin
-                            (append! params (ocaml-tok-value (peek-tok)))
-                            (advance-tok!)
-                            (collect-params)))))
-                    (collect-params)
-                    (consume! "op" "=")
-                    (let
-                      ((expr-start (cur-pos)))
-                      (begin
-                        (skip-to-boundary!)
-                        (let
-                          ((expr-src (slice src expr-start (cur-pos))))
-                          (let
-                            ((expr (ocaml-parse expr-src)))
-                            (if
-                              reccy
-                              (list :def-rec name params expr)
-                              (list :def name params expr))))))))))))
-        (define
-          parse-decl-expr
-          (fn
-            ()
-            (let
-              ((expr-start (cur-pos)))
-              (begin
-                (skip-to-boundary!)
-                (let
-                  ((expr-src (slice src expr-start (cur-pos))))
-                  (let ((expr (ocaml-parse expr-src))) (list :expr expr)))))))
-        (define
-          loop
-          (fn
-            ()
-            (begin
-              (skip-double-semi!)
-              (when
-                (< idx tok-len)
-                (cond
-                  ((= (ocaml-tok-type (peek-tok)) "eof") nil)
-                  ((at-kw? "let")
-                    (begin (append! decls (parse-decl-let)) (loop)))
-                  (else (begin (append! decls (parse-decl-expr)) (loop))))))))
-        (loop)
-        (cons :program decls)))))

lib/ocaml/test.sh

@@ -1,820 +0,0 @@
-#!/usr/bin/env bash
-# Fast OCaml-on-SX test runner — epoch protocol direct to sx_server.exe.
-# Mirrors lib/lua/test.sh.
-#
-# Usage:
-#   bash lib/ocaml/test.sh           # run all tests
-#   bash lib/ocaml/test.sh -v        # verbose
-
-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. Run: cd hosts/ocaml && dune build"
-  exit 1
-fi
-
-VERBOSE="${1:-}"
-PASS=0
-FAIL=0
-ERRORS=""
-TMPFILE=$(mktemp)
-trap "rm -f $TMPFILE" EXIT
-
-cat > "$TMPFILE" << 'EPOCHS'
-(epoch 1)
-(load "lib/guest/lex.sx")
-(load "lib/guest/prefix.sx")
-(load "lib/guest/pratt.sx")
-(load "lib/ocaml/tokenizer.sx")
-(load "lib/ocaml/parser.sx")
-(load "lib/ocaml/eval.sx")
-(load "lib/ocaml/tests/tokenize.sx")
-
-;; ── empty / eof ────────────────────────────────────────────────
-(epoch 100)
-(eval "(ocaml-test-tok-count \"\")")
-(epoch 101)
-(eval "(ocaml-test-tok-type \"\" 0)")
-
-;; ── numbers ────────────────────────────────────────────────────
-(epoch 110)
-(eval "(ocaml-test-tok-type \"42\" 0)")
-(epoch 111)
-(eval "(ocaml-test-tok-value \"42\" 0)")
-(epoch 112)
-(eval "(ocaml-test-tok-value \"3.14\" 0)")
-(epoch 113)
-(eval "(ocaml-test-tok-value \"0xff\" 0)")
-(epoch 114)
-(eval "(ocaml-test-tok-value \"1e3\" 0)")
-(epoch 115)
-(eval "(ocaml-test-tok-value \"1_000_000\" 0)")
-(epoch 116)
-(eval "(ocaml-test-tok-value \"3.14e-2\" 0)")
-
-;; ── identifiers / constructors / keywords ─────────────────────
-(epoch 120)
-(eval "(ocaml-test-tok-type \"foo\" 0)")
-(epoch 121)
-(eval "(ocaml-test-tok-value \"foo_bar1\" 0)")
-(epoch 122)
-(eval "(ocaml-test-tok-type \"Some\" 0)")
-(epoch 123)
-(eval "(ocaml-test-tok-value \"Some\" 0)")
-(epoch 124)
-(eval "(ocaml-test-tok-type \"let\" 0)")
-(epoch 125)
-(eval "(ocaml-test-tok-value \"match\" 0)")
-(epoch 126)
-(eval "(ocaml-test-tok-type \"true\" 0)")
-(epoch 127)
-(eval "(ocaml-test-tok-value \"false\" 0)")
-(epoch 128)
-(eval "(ocaml-test-tok-value \"name'\" 0)")
-
-;; ── strings ────────────────────────────────────────────────────
-(epoch 130)
-(eval "(ocaml-test-tok-type \"\\\"hi\\\"\" 0)")
-(epoch 131)
-(eval "(ocaml-test-tok-value \"\\\"hi\\\"\" 0)")
-(epoch 132)
-(eval "(ocaml-test-tok-value \"\\\"a\\\\nb\\\"\" 0)")
-
-;; ── chars ──────────────────────────────────────────────────────
-(epoch 140)
-(eval "(ocaml-test-tok-type \"'a'\" 0)")
-(epoch 141)
-(eval "(ocaml-test-tok-value \"'a'\" 0)")
-(epoch 142)
-(eval "(ocaml-test-tok-value \"'\\\\n'\" 0)")
-
-;; ── type variables ─────────────────────────────────────────────
-(epoch 145)
-(eval "(ocaml-test-tok-type \"'a\" 0)")
-(epoch 146)
-(eval "(ocaml-test-tok-value \"'a\" 0)")
-
-;; ── multi-char operators ───────────────────────────────────────
-(epoch 150)
-(eval "(ocaml-test-tok-value \"->\" 0)")
-(epoch 151)
-(eval "(ocaml-test-tok-value \"|>\" 0)")
-(epoch 152)
-(eval "(ocaml-test-tok-value \"<-\" 0)")
-(epoch 153)
-(eval "(ocaml-test-tok-value \":=\" 0)")
-(epoch 154)
-(eval "(ocaml-test-tok-value \"::\" 0)")
-(epoch 155)
-(eval "(ocaml-test-tok-value \";;\" 0)")
-(epoch 156)
-(eval "(ocaml-test-tok-value \"@@\" 0)")
-(epoch 157)
-(eval "(ocaml-test-tok-value \"<>\" 0)")
-(epoch 158)
-(eval "(ocaml-test-tok-value \"&&\" 0)")
-(epoch 159)
-(eval "(ocaml-test-tok-value \"||\" 0)")
-
-;; ── single-char punctuation ────────────────────────────────────
-(epoch 160)
-(eval "(ocaml-test-tok-value \"+\" 0)")
-(epoch 161)
-(eval "(ocaml-test-tok-value \"|\" 0)")
-(epoch 162)
-(eval "(ocaml-test-tok-value \";\" 0)")
-(epoch 163)
-(eval "(ocaml-test-tok-value \"(\" 0)")
-(epoch 164)
-(eval "(ocaml-test-tok-value \"!\" 0)")
-(epoch 165)
-(eval "(ocaml-test-tok-value \"@\" 0)")
-
-;; ── comments ───────────────────────────────────────────────────
-(epoch 170)
-(eval "(ocaml-test-tok-count \"(* hi *)\")")
-(epoch 171)
-(eval "(ocaml-test-tok-value \"(* c *) 42\" 0)")
-(epoch 172)
-(eval "(ocaml-test-tok-count \"(* outer (* inner *) end *) 1\")")
-(epoch 173)
-(eval "(ocaml-test-tok-value \"(* outer (* inner *) end *) 1\" 0)")
-
-;; ── compound expressions ───────────────────────────────────────
-(epoch 180)
-(eval "(ocaml-test-tok-count \"let x = 1\")")
-(epoch 181)
-(eval "(ocaml-test-tok-type \"let x = 1\" 0)")
-(epoch 182)
-(eval "(ocaml-test-tok-value \"let x = 1\" 0)")
-(epoch 183)
-(eval "(ocaml-test-tok-type \"let x = 1\" 1)")
-(epoch 184)
-(eval "(ocaml-test-tok-value \"let x = 1\" 2)")
-(epoch 185)
-(eval "(ocaml-test-tok-value \"let x = 1\" 3)")
-
-(epoch 190)
-(eval "(ocaml-test-tok-count \"match x with | None -> 0 | Some y -> y\")")
-(epoch 191)
-(eval "(ocaml-test-tok-value \"fun x -> x + 1\" 2)")
-(epoch 192)
-(eval "(ocaml-test-tok-type \"fun x -> x + 1\" 2)")
-(epoch 193)
-(eval "(ocaml-test-tok-type \"Some 42\" 0)")
-(epoch 194)
-(eval "(ocaml-test-tok-value \"a |> f |> g\" 1)")
-(epoch 195)
-(eval "(ocaml-test-tok-value \"x := !y\" 1)")
-
-;; ── Phase 1.parse: parser ──────────────────────────────────────
-;; Atoms
-(epoch 200)
-(eval "(ocaml-parse \"42\")")
-(epoch 201)
-(eval "(ocaml-parse \"3.14\")")
-(epoch 202)
-(eval "(ocaml-parse \"\\\"hi\\\"\")")
-(epoch 203)
-(eval "(ocaml-parse \"'a'\")")
-(epoch 204)
-(eval "(ocaml-parse \"true\")")
-(epoch 205)
-(eval "(ocaml-parse \"false\")")
-(epoch 206)
-(eval "(ocaml-parse \"x\")")
-(epoch 207)
-(eval "(ocaml-parse \"Some\")")
-(epoch 208)
-(eval "(ocaml-parse \"()\")")
-
-;; Application (left-assoc)
-(epoch 210)
-(eval "(ocaml-parse \"f x\")")
-(epoch 211)
-(eval "(ocaml-parse \"f x y\")")
-(epoch 212)
-(eval "(ocaml-parse \"f (g x)\")")
-(epoch 213)
-(eval "(ocaml-parse \"Some 42\")")
-
-;; Binops with precedence
-(epoch 220)
-(eval "(ocaml-parse \"1 + 2\")")
-(epoch 221)
-(eval "(ocaml-parse \"a + b * c\")")
-(epoch 222)
-(eval "(ocaml-parse \"a * b + c\")")
-(epoch 223)
-(eval "(ocaml-parse \"a && b || c\")")
-(epoch 224)
-(eval "(ocaml-parse \"a = b\")")
-(epoch 225)
-(eval "(ocaml-parse \"a ^ b ^ c\")")
-(epoch 226)
-(eval "(ocaml-parse \"a :: b :: []\")")
-(epoch 227)
-(eval "(ocaml-parse \"(a + b) * c\")")
-(epoch 228)
-(eval "(ocaml-parse \"a |> f |> g\")")
-(epoch 229)
-(eval "(ocaml-parse \"x mod 2\")")
-
-;; Prefix
-(epoch 230)
-(eval "(ocaml-parse \"-x\")")
-(epoch 231)
-(eval "(ocaml-parse \"-1 + 2\")")
-
-;; Tuples & lists
-(epoch 240)
-(eval "(ocaml-parse \"(1, 2, 3)\")")
-(epoch 241)
-(eval "(ocaml-parse \"[1; 2; 3]\")")
-(epoch 242)
-(eval "(ocaml-parse \"[]\")")
-
-;; if / fun / let / let rec
-(epoch 250)
-(eval "(ocaml-parse \"if x then 1 else 2\")")
-(epoch 251)
-(eval "(ocaml-parse \"if c then x\")")
-(epoch 252)
-(eval "(ocaml-parse \"fun x -> x + 1\")")
-(epoch 253)
-(eval "(ocaml-parse \"fun x y -> x + y\")")
-(epoch 254)
-(eval "(ocaml-parse \"let x = 1 in x\")")
-(epoch 255)
-(eval "(ocaml-parse \"let f x = x + 1 in f 2\")")
-(epoch 256)
-(eval "(ocaml-parse \"let rec f x = f x in f 1\")")
-(epoch 257)
-(eval "(ocaml-parse \"let f x y = x + y in f 1 2\")")
-
-;; begin/end
-(epoch 260)
-(eval "(ocaml-parse \"begin 1 + 2 end\")")
-
-;; ── Top-level decls ────────────────────────────────────────────
-(epoch 270)
-(eval "(ocaml-parse-program \"let x = 1\")")
-(epoch 271)
-(eval "(ocaml-parse-program \"let x = 1 ;;\")")
-(epoch 272)
-(eval "(ocaml-parse-program \"let f x = x + 1\")")
-(epoch 273)
-(eval "(ocaml-parse-program \"let rec fact n = if n = 0 then 1 else n * fact (n - 1)\")")
-(epoch 274)
-(eval "(ocaml-parse-program \"let x = 1 let y = 2\")")
-(epoch 275)
-(eval "(ocaml-parse-program \"1 + 2 ;;\")")
-(epoch 276)
-(eval "(ocaml-parse-program \"let x = 1 ;; let y = 2 ;; x + y\")")
-(epoch 277)
-(eval "(len (ocaml-parse-program \"let x = 1 ;; let y = 2 ;; x + y\"))")
-(epoch 278)
-(eval "(ocaml-parse-program \"\")")
-
-;; ── Match / patterns ───────────────────────────────────────────
-(epoch 300)
-(eval "(ocaml-parse \"match x with | None -> 0 | Some y -> y\")")
-(epoch 301)
-(eval "(ocaml-parse \"match x with None -> 0 | Some y -> y\")")
-(epoch 302)
-(eval "(ocaml-parse \"match l with | [] -> 0 | h :: t -> 1\")")
-(epoch 303)
-(eval "(ocaml-parse \"match p with | (a, b) -> a + b\")")
-(epoch 304)
-(eval "(ocaml-parse \"match n with | 0 -> 1 | _ -> n\")")
-(epoch 305)
-(eval "(ocaml-parse \"match x with | true -> 1 | false -> 0\")")
-(epoch 306)
-(eval "(ocaml-parse \"match x with | Pair (a, b) -> a + b\")")
-(epoch 307)
-(eval "(ocaml-parse \"match x with | \\\"hi\\\" -> 1 | _ -> 0\")")
-(epoch 308)
-(eval "(ocaml-parse \"match x with | () -> 0\")")
-
-;; ── Sequences (;) ──────────────────────────────────────────────
-(epoch 320)
-(eval "(ocaml-parse \"1; 2\")")
-(epoch 321)
-(eval "(ocaml-parse \"1; 2; 3\")")
-(epoch 322)
-(eval "(ocaml-parse \"(1; 2)\")")
-(epoch 323)
-(eval "(ocaml-parse \"begin a; b; c end\")")
-(epoch 324)
-(eval "(ocaml-parse \"let x = 1 in x; x\")")
-(epoch 325)
-(eval "(ocaml-parse \"if c then (a; b) else c\")")
-(epoch 326)
-(eval "(ocaml-parse \"[1; 2; 3]\")")
-(epoch 327)
-(eval "(ocaml-parse \"1; 2;\")")
-(epoch 328)
-(eval "(ocaml-parse \"begin a; end\")")
-(epoch 329)
-(eval "(ocaml-parse \"match x with | _ -> a; b\")")
-
-;; ── Phase 2: evaluator ─────────────────────────────────────────
-;; Atoms
-(epoch 400)
-(eval "(ocaml-run \"42\")")
-(epoch 401)
-(eval "(ocaml-run \"3.14\")")
-(epoch 402)
-(eval "(ocaml-run \"true\")")
-(epoch 403)
-(eval "(ocaml-run \"false\")")
-(epoch 404)
-(eval "(ocaml-run \"\\\"hi\\\"\")")
-
-;; Arithmetic
-(epoch 410)
-(eval "(ocaml-run \"1 + 2\")")
-(epoch 411)
-(eval "(ocaml-run \"10 - 3\")")
-(epoch 412)
-(eval "(ocaml-run \"4 * 5\")")
-(epoch 413)
-(eval "(ocaml-run \"20 / 4\")")
-(epoch 414)
-(eval "(ocaml-run \"10 mod 3\")")
-(epoch 415)
-(eval "(ocaml-run \"2 ** 10\")")
-(epoch 416)
-(eval "(ocaml-run \"(1 + 2) * 3\")")
-(epoch 417)
-(eval "(ocaml-run \"1 + 2 * 3\")")
-(epoch 418)
-(eval "(ocaml-run \"-5 + 10\")")
-
-;; Comparison & boolean
-(epoch 420)
-(eval "(ocaml-run \"1 < 2\")")
-(epoch 421)
-(eval "(ocaml-run \"3 > 2\")")
-(epoch 422)
-(eval "(ocaml-run \"2 = 2\")")
-(epoch 423)
-(eval "(ocaml-run \"1 <> 2\")")
-(epoch 424)
-(eval "(ocaml-run \"true && false\")")
-(epoch 425)
-(eval "(ocaml-run \"true || false\")")
-(epoch 426)
-(eval "(ocaml-run \"not false\")")
-
-;; String
-(epoch 430)
-(eval "(ocaml-run \"\\\"a\\\" ^ \\\"b\\\"\")")
-(epoch 431)
-(eval "(ocaml-run \"\\\"hello\\\" ^ \\\" \\\" ^ \\\"world\\\"\")")
-
-;; Conditional
-(epoch 440)
-(eval "(ocaml-run \"if true then 1 else 2\")")
-(epoch 441)
-(eval "(ocaml-run \"if 1 > 2 then 100 else 200\")")
-
-;; Let / lambda / app
-(epoch 450)
-(eval "(ocaml-run \"let x = 5 in x * 2\")")
-(epoch 451)
-(eval "(ocaml-run \"let f x = x + 1 in f 41\")")
-(epoch 452)
-(eval "(ocaml-run \"let f x y = x + y in f 3 4\")")
-(epoch 453)
-(eval "(ocaml-run \"(fun x -> x * x) 7\")")
-(epoch 454)
-(eval "(ocaml-run \"(fun x -> fun y -> x + y) 10 20\")")
-(epoch 455)
-(eval "(ocaml-run \"let f = fun x -> x + 1 in f 9\")")
-
-;; Closures capture
-(epoch 460)
-(eval "(ocaml-run \"let x = 10 in let f y = x + y in f 5\")")
-(epoch 461)
-(eval "(ocaml-run \"let make_adder n = fun x -> n + x in (make_adder 100) 1\")")
-
-;; Recursion
-(epoch 470)
-(eval "(ocaml-run \"let rec fact n = if n = 0 then 1 else n * fact (n - 1) in fact 5\")")
-(epoch 471)
-(eval "(ocaml-run \"let rec fib n = if n < 2 then n else fib (n - 1) + fib (n - 2) in fib 10\")")
-(epoch 472)
-(eval "(ocaml-run \"let rec sum n = if n = 0 then 0 else n + sum (n - 1) in sum 100\")")
-
-;; Sequence
-(epoch 480)
-(eval "(ocaml-run \"1; 2; 3\")")
-(epoch 481)
-(eval "(ocaml-run \"begin 10 end\")")
-
-;; Programs (top-level decls)
-(epoch 490)
-(eval "(ocaml-run-program \"let x = 1;; let y = 2;; x + y\")")
-(epoch 491)
-(eval "(ocaml-run-program \"let rec fact n = if n = 0 then 1 else n * fact (n - 1);; fact 6\")")
-(epoch 492)
-(eval "(ocaml-run-program \"let inc x = x + 1;; let double x = x * 2;; double (inc 4)\")")
-
-;; Pipe
-(epoch 495)
-(eval "(ocaml-run \"let f x = x * 2 in 5 |> f\")")
-
-;; ── Phase 3: ADTs + match (eval) ───────────────────────────────
-;; Constructors
-(epoch 500)
-(eval "(ocaml-run \"None\")")
-(epoch 501)
-(eval "(ocaml-run \"Some 42\")")
-(epoch 502)
-(eval "(ocaml-run \"Some (1, 2)\")")
-
-;; Match — option
-(epoch 510)
-(eval "(ocaml-run \"match Some 5 with | None -> 0 | Some y -> y\")")
-(epoch 511)
-(eval "(ocaml-run \"match None with | None -> 0 | Some y -> y\")")
-
-;; Match — literals
-(epoch 520)
-(eval "(ocaml-run \"match 3 with | 1 -> 100 | 2 -> 200 | _ -> 999\")")
-(epoch 521)
-(eval "(ocaml-run \"match true with | true -> 1 | false -> 0\")")
-(epoch 522)
-(eval "(ocaml-run \"match \\\"hi\\\" with | \\\"hi\\\" -> 1 | _ -> 0\")")
-
-;; Match — tuples
-(epoch 530)
-(eval "(ocaml-run \"match (1, 2) with | (a, b) -> a + b\")")
-(epoch 531)
-(eval "(ocaml-run \"match (1, 2, 3) with | (a, b, c) -> a * b * c\")")
-
-;; Match — list cons / nil
-(epoch 540)
-(eval "(ocaml-run \"match [1; 2; 3] with | [] -> 0 | h :: _ -> h\")")
-(epoch 541)
-(eval "(ocaml-run \"match [] with | [] -> 0 | h :: _ -> h\")")
-(epoch 542)
-(eval "(ocaml-run \"match [1; 2; 3] with | [a; b; c] -> a + b + c | _ -> 0\")")
-(epoch 543)
-(eval "(ocaml-run \"let rec len lst = match lst with | [] -> 0 | _ :: t -> 1 + len t in len [1; 2; 3; 4; 5]\")")
-(epoch 544)
-(eval "(ocaml-run \"let rec sum lst = match lst with | [] -> 0 | h :: t -> h + sum t in sum [1; 2; 3; 4; 5]\")")
-
-;; Match — wildcard + var
-(epoch 550)
-(eval "(ocaml-run \"match 99 with | _ -> 1\")")
-(epoch 551)
-(eval "(ocaml-run \"match 99 with | x -> x + 1\")")
-
-;; Constructors with tuple args
-(epoch 560)
-(eval "(ocaml-run \"match Pair (1, 2) with | Pair (a, b) -> a * b\")")
-
-;; ── References (ref / ! / :=) ──────────────────────────────────
-(epoch 600)
-(eval "(ocaml-run \"let r = ref 5 in !r\")")
-(epoch 601)
-(eval "(ocaml-run \"let r = ref 5 in r := 10; !r\")")
-(epoch 602)
-(eval "(ocaml-run \"let r = ref 0 in r := !r + 1; r := !r + 1; !r\")")
-(epoch 603)
-(eval "(ocaml-run \"let r = ref 100 in let f x = r := !r + x in f 5; f 10; !r\")")
-(epoch 604)
-(eval "(ocaml-run \"let r = ref \\\"a\\\" in r := \\\"b\\\"; !r\")")
-(epoch 605)
-(eval "(ocaml-run \"let count = ref 0 in let rec loop n = if n = 0 then !count else (count := !count + n; loop (n - 1)) in loop 5\")")
-
-;; ── for / while loops ──────────────────────────────────────────
-(epoch 620)
-(eval "(ocaml-run \"let s = ref 0 in for i = 1 to 5 do s := !s + i done; !s\")")
-(epoch 621)
-(eval "(ocaml-run \"let s = ref 0 in for i = 5 downto 1 do s := !s + i done; !s\")")
-(epoch 622)
-(eval "(ocaml-run \"let i = ref 0 in let s = ref 0 in while !i < 5 do i := !i + 1; s := !s + !i done; !s\")")
-(epoch 623)
-(eval "(ocaml-run \"let s = ref 0 in for i = 1 to 100 do s := !s + i done; !s\")")
-(epoch 624)
-(eval "(ocaml-run \"let p = ref 1 in for i = 1 to 5 do p := !p * i done; !p\")")
-
-EPOCHS
-
-OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
-
-check() {
-  local epoch="$1" desc="$2" expected="$3"
-  local actual
-  actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1)
-  if [ -z "$actual" ]; then
-    actual=$(echo "$OUTPUT" | grep "^(ok $epoch " || true)
-  fi
-  if [ -z "$actual" ]; then
-    actual=$(echo "$OUTPUT" | grep "^(error $epoch " || true)
-  fi
-  if [ -z "$actual" ]; then
-    actual="<no output for epoch $epoch>"
-  fi
-
-  if echo "$actual" | grep -qF -- "$expected"; then
-    PASS=$((PASS + 1))
-    [ "$VERBOSE" = "-v" ] && echo "  ok $desc"
-  else
-    FAIL=$((FAIL + 1))
-    ERRORS+="  FAIL $desc (epoch $epoch)
-    expected: $expected
-    actual:   $actual
-"
-  fi
-}
-
-# empty / eof
-check 100 "empty tokens length"          '1'
-check 101 "empty first is eof"           '"eof"'
-
-# numbers
-check 110 "int type"                     '"number"'
-check 111 "int value"                    '42'
-check 112 "float value"                  '3.14'
-check 113 "hex value"                    '255'
-check 114 "exponent"                     '1000'
-check 115 "underscored int"              '1000000'
-check 116 "neg exponent"                 '0.0314'
-
-# idents / ctors / keywords
-check 120 "ident type"                   '"ident"'
-check 121 "ident value"                  '"foo_bar1"'
-check 122 "ctor type"                    '"ctor"'
-check 123 "ctor value"                   '"Some"'
-check 124 "let keyword type"             '"keyword"'
-check 125 "match keyword value"          '"match"'
-check 126 "true is keyword"              '"keyword"'
-check 127 "false value"                  '"false"'
-check 128 "primed ident"                 "\"name'\""
-
-# strings
-check 130 "string type"                  '"string"'
-check 131 "string value"                 '"hi"'
-check 132 "escape sequence"              '"a'
-
-# chars
-check 140 "char type"                    '"char"'
-check 141 "char value"                   '"a"'
-check 142 "char escape"                  '"'
-
-# tyvars
-check 145 "tyvar type"                   '"tyvar"'
-check 146 "tyvar value"                  '"a"'
-
-# multi-char ops
-check 150 "->"                           '"->"'
-check 151 "|>"                           '"|>"'
-check 152 "<-"                           '"<-"'
-check 153 ":="                           '":="'
-check 154 "::"                           '"::"'
-check 155 ";;"                           '";;"'
-check 156 "@@"                           '"@@"'
-check 157 "<>"                           '"<>"'
-check 158 "&&"                           '"&&"'
-check 159 "||"                           '"||"'
-
-# single ops
-check 160 "+"                            '"+"'
-check 161 "|"                            '"|"'
-check 162 ";"                            '";"'
-check 163 "("                            '"("'
-check 164 "!"                            '"!"'
-check 165 "@"                            '"@"'
-
-# comments
-check 170 "block comment alone -> eof"   '1'
-check 171 "num after block comment"      '42'
-check 172 "nested comment count"         '2'
-check 173 "nested comment value"         '1'
-
-# compound
-check 180 "let x = 1 count"              '5'
-check 181 "let is keyword"               '"keyword"'
-check 182 "let value"                    '"let"'
-check 183 "x is ident"                   '"ident"'
-check 184 "= value"                      '"="'
-check 185 "1 value"                      '1'
-
-check 190 "match expr count"             '13'
-check 191 "fun -> arrow value"           '"->"'
-check 192 "fun -> arrow type"            '"op"'
-check 193 "Some is ctor"                 '"ctor"'
-check 194 "first |> value"               '"|>"'
-check 195 "ref assign :="                '":="'
-
-# ── Parser tests ────────────────────────────────────────────────
-check 200 "parse int"                    '("int" 42)'
-check 201 "parse float"                  '("float" 3.14)'
-check 202 "parse string"                 '("string" "hi")'
-check 203 "parse char"                   '("char" "a")'
-check 204 "parse true"                   '("bool" true)'
-check 205 "parse false"                  '("bool" false)'
-check 206 "parse var"                    '("var" "x")'
-check 207 "parse ctor"                   '("con" "Some")'
-check 208 "parse unit"                   '("unit")'
-
-check 210 "parse f x"                    '("app" ("var" "f") ("var" "x"))'
-check 211 "parse f x y left-assoc"       '("app" ("app" ("var" "f") ("var" "x")) ("var" "y"))'
-check 212 "parse f (g x)"                '("app" ("var" "f") ("app" ("var" "g") ("var" "x")))'
-check 213 "parse Some 42"                '("app" ("con" "Some") ("int" 42))'
-
-check 220 "parse 1+2"                    '("op" "+" ("int" 1) ("int" 2))'
-check 221 "parse a + b * c prec"         '("op" "+" ("var" "a") ("op" "*"'
-check 222 "parse a*b + c prec"           '("op" "+" ("op" "*"'
-check 223 "parse && / || prec"           '("op" "||" ("op" "&&"'
-check 224 "parse a = b"                  '("op" "=" ("var" "a") ("var" "b"))'
-check 225 "parse ^ right-assoc"          '("op" "^" ("var" "a") ("op" "^"'
-check 226 "parse :: right-assoc"         '("op" "::" ("var" "a") ("op" "::"'
-check 227 "parse parens override"        '("op" "*" ("op" "+"'
-check 228 "parse |> chain"               '("op" "|>" ("op" "|>"'
-check 229 "parse mod kw-binop"           '("op" "mod" ("var" "x") ("int" 2))'
-
-check 230 "parse -x"                     '("neg" ("var" "x"))'
-check 231 "parse -1+2"                   '("op" "+" ("neg" ("int" 1)) ("int" 2))'
-
-check 240 "parse tuple"                  '("tuple" ("int" 1) ("int" 2) ("int" 3))'
-check 241 "parse list literal"           '("list" ("int" 1) ("int" 2) ("int" 3))'
-check 242 "parse []"                     '("list")'
-
-check 250 "parse if/then/else"           '("if" ("var" "x") ("int" 1) ("int" 2))'
-check 251 "parse if w/o else"            '("if" ("var" "c") ("var" "x") ("unit"))'
-check 252 "parse fun x -> ..."           '("fun" ("x") ("op" "+" ("var" "x") ("int" 1)))'
-check 253 "parse fun x y ->"             '("fun" ("x" "y")'
-check 254 "parse let x = 1 in x"         '("let" "x" () ("int" 1) ("var" "x"))'
-check 255 "parse let f x ="              '("let" "f" ("x") ("op" "+"'
-check 256 "parse let rec f x ="          '("let-rec" "f" ("x")'
-check 257 "parse let f x y ="            '("let" "f" ("x" "y")'
-
-check 260 "parse begin/end"              '("op" "+" ("int" 1) ("int" 2))'
-
-# ── Top-level decls ─────────────────────────────────────────────
-check 270 "program: let x = 1"           '("program" ("def" "x" () ("int" 1)))'
-check 271 "program: let x = 1 ;;"        '("program" ("def" "x" () ("int" 1)))'
-check 272 "program: let f x = x+1"       '("program" ("def" "f" ("x") ("op" "+"'
-check 273 "program: let rec fact"        '("def-rec" "fact" ("n")'
-check 274 "program: two decls"           '("def" "x" () ("int" 1)) ("def" "y"'
-check 275 "program: bare expr"           '("program" ("expr" ("op" "+" ("int" 1) ("int" 2))))'
-check 276 "program: mixed decls + expr"  '("def" "y" () ("int" 2)) ("expr"'
-check 277 "program: 4 forms incl head"   '4'
-check 278 "program: empty"               '("program")'
-
-# ── Match / patterns ────────────────────────────────────────────
-check 300 "match Some/None"              '("match" ("var" "x") (("case" ("pcon" "None") ("int" 0)) ("case" ("pcon" "Some" ("pvar" "y")) ("var" "y")))'
-check 301 "match no leading bar"         '("match" ("var" "x") (("case" ("pcon" "None") ("int" 0)) ("case" ("pcon" "Some"'
-check 302 "match list cons"              '("case" ("plist") ("int" 0)) ("case" ("pcons" ("pvar" "h") ("pvar" "t")) ("int" 1))'
-check 303 "match tuple pat"              '("ptuple" ("pvar" "a") ("pvar" "b"))'
-check 304 "match int + wildcard"         '("case" ("plit" ("int" 0)) ("int" 1)) ("case" ("pwild")'
-check 305 "match bool literals"          '("plit" ("bool" true))'
-check 306 "match ctor with tuple arg"    '("pcon" "Pair" ("pvar" "a") ("pvar" "b"))'
-check 307 "match string literal"         '("plit" ("string" "hi"))'
-check 308 "match unit pattern"           '("plit" ("unit"))'
-
-# ── Sequences ───────────────────────────────────────────────────
-check 320 "seq 1;2"                      '("seq" ("int" 1) ("int" 2))'
-check 321 "seq 1;2;3"                    '("seq" ("int" 1) ("int" 2) ("int" 3))'
-check 322 "seq in parens"                '("seq" ("int" 1) ("int" 2))'
-check 323 "seq in begin/end"             '("seq" ("var" "a") ("var" "b") ("var" "c"))'
-check 324 "let body absorbs seq"         '("let" "x" () ("int" 1) ("seq" ("var" "x") ("var" "x")))'
-check 325 "if-branch parens for seq"     '("if" ("var" "c") ("seq" ("var" "a") ("var" "b"))'
-check 326 "list ; is separator"          '("list" ("int" 1) ("int" 2) ("int" 3))'
-check 327 "trailing ; OK"                '("seq" ("int" 1) ("int" 2))'
-check 328 "begin a; end singleton seq"   '("seq" ("var" "a"))'
-check 329 "match clause body absorbs ;"  '("case" ("pwild") ("seq" ("var" "a") ("var" "b")))'
-
-# ── Phase 2: evaluator ──────────────────────────────────────────
-# atoms
-check 400 "eval int"                     '42'
-check 401 "eval float"                   '3.14'
-check 402 "eval true"                    'true'
-check 403 "eval false"                   'false'
-check 404 "eval string"                  '"hi"'
-
-# arithmetic
-check 410 "eval 1+2"                     '3'
-check 411 "eval 10-3"                    '7'
-check 412 "eval 4*5"                     '20'
-check 413 "eval 20/4"                    '5'
-check 414 "eval 10 mod 3"                '1'
-check 415 "eval 2 ** 10"                 '1024'
-check 416 "eval (1+2)*3"                 '9'
-check 417 "eval 1+2*3 prec"              '7'
-check 418 "eval -5+10"                   '5'
-
-# comparison & boolean
-check 420 "eval 1<2"                     'true'
-check 421 "eval 3>2"                     'true'
-check 422 "eval 2=2"                     'true'
-check 423 "eval 1<>2"                    'true'
-check 424 "eval true && false"           'false'
-check 425 "eval true || false"           'true'
-check 426 "eval not false"               'true'
-
-# string
-check 430 'eval "a" ^ "b"'               '"ab"'
-check 431 "eval string concat 3"         '"hello world"'
-
-# conditional
-check 440 "eval if true 1 else 2"        '1'
-check 441 "eval if 1>2 100 else 200"     '200'
-
-# let / lambda / app
-check 450 "eval let x=5 x*2"             '10'
-check 451 "eval let f x = x+1; f 41"     '42'
-check 452 "eval let f x y = x+y; f 3 4"  '7'
-check 453 "eval (fun x -> x*x) 7"        '49'
-check 454 "eval curried lambdas"         '30'
-check 455 "eval named lambda"            '10'
-
-# closures
-check 460 "eval closure capture"         '15'
-check 461 "eval make_adder"              '101'
-
-# recursion
-check 470 "eval fact 5"                  '120'
-check 471 "eval fib 10"                  '55'
-check 472 "eval sum 100"                 '5050'
-
-# sequence
-check 480 "eval 1; 2; 3 → 3"             '3'
-check 481 "eval begin 10 end"            '10'
-
-# programs
-check 490 "run-prog x+y"                 '3'
-check 491 "run-prog fact 6"              '720'
-check 492 "run-prog inc + double"        '10'
-
-# pipe
-check 495 "eval x |> f"                  '10'
-
-# ── Phase 3: ADTs + match (eval) ────────────────────────────────
-# constructors
-check 500 "eval None"                    '("None")'
-check 501 "eval Some 42"                 '("Some" 42)'
-check 502 "eval Pair tuple-arg"          '("Some" 1 2)'
-
-# option match
-check 510 "match Some 5 -> 5"            '5'
-check 511 "match None -> 0"              '0'
-
-# literal match
-check 520 "match 3 -> _ -> 999"          '999'
-check 521 "match bool true"              '1'
-check 522 "match string lit"             '1'
-
-# tuple match
-check 530 "match (1,2)"                  '3'
-check 531 "match (1,2,3)"                '6'
-
-# list match
-check 540 "match list cons head"         '1'
-check 541 "match empty list"             '0'
-check 542 "match list literal pat"       '6'
-check 543 "match recursive len"          '5'
-check 544 "match recursive sum"          '15'
-
-# wildcard + var
-check 550 "match _ -> 1"                 '1'
-check 551 "match x -> x+1"               '100'
-
-# ctor with tuple arg
-check 560 "Pair(a,b) → a*b"              '2'
-
-# ── References ──────────────────────────────────────────────────
-check 600 "deref new ref"                '5'
-check 601 ":= then deref"                '10'
-check 602 "increment cell twice"         '2'
-check 603 "ref captured by closure"      '115'
-check 604 "ref of string"                '"b"'
-check 605 "ref + recursion"              '15'
-
-# ── for / while ─────────────────────────────────────────────────
-check 620 "for 1..5 sum"                 '15'
-check 621 "for 5 downto 1 sum"           '15'
-check 622 "while loop"                   '15'
-check 623 "for 1..100 sum"               '5050'
-check 624 "for 1..5 product = 120"       '120'
-
-TOTAL=$((PASS + FAIL))
-if [ $FAIL -eq 0 ]; then
-  echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
-else
-  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
-  echo ""
-  echo "$ERRORS"
-fi
-
-[ $FAIL -eq 0 ]

lib/ocaml/tests/tokenize.sx

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

lib/ocaml/tokenizer.sx

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

plans/datalog-on-sx.md

@@ -58,50 +58,108 @@ Key differences from Prolog:
 ## Roadmap
 
 ### Phase 1 — tokenizer + parser
-- [ ] Tokenizer: atoms (lowercase/quoted), variables (uppercase/`_`), numbers, strings,
+- [x] Tokenizer: atoms (lowercase/quoted), variables (uppercase/`_`), numbers, strings,
-      operators (`:- `, `?-`, `,`, `.`), comments (`%`, `/* */`)
+      punct (`( )`, `,`, `.`), operators (`:-`, `?-`, `<=`, `>=`, `!=`, `<`, `>`, `=`,
-      Note: no function symbol syntax (no nested `f(...)` in arg position).
+      `+`, `-`, `*`, `/`), comments (`%`, `/* */`)
-- [ ] Parser:
+      Note: no function symbol syntax (no nested `f(...)` in arg position) — but the
+      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)}`
-- [ ] Tests in `lib/datalog/tests/parse.sx`
+- [x] Tests in `lib/datalog/tests/parse.sx` (18) and `lib/datalog/tests/tokenize.sx` (26).
+      Conformance harness: `bash lib/datalog/conformance.sh` → 44 / 44 passing.
 
 ### Phase 2 — unification + substitution
-- [ ] Share or port unification from `lib/prolog/` — term walk, occurs check off by default
+- [x] Ported (not shared) from `lib/prolog/` — term walk, no occurs check.
-- [ ] `dl-unify` `t1` `t2` `subst` → extended subst or nil (no function symbols means simpler)
+- [x] `dl-unify t1 t2 subst` → extended subst dict, or `nil` on failure.
-- [ ] `dl-ground?` `term` → bool — all variables bound in substitution
+- [x] `dl-walk`, `dl-bind`, `dl-apply-subst`, `dl-ground?`, `dl-vars-of`.
-- [ ] Tests: atom/atom, var/atom, var/var, list args
+- [x] Substitutions are immutable dicts keyed by variable name (string).
+      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
+### Phase 3 — extensional DB + naive evaluation + safety analysis
-- [ ] EDB: `{:relation-name → set-of-ground-tuples}` using SX sets (Phase 18 of primitives)
+- [x] EDB+IDB combined: `{:facts {<rel-name-string> -> (literal ...)}}` —
-- [ ] `dl-add-fact!` `db` `relation` `args` → add ground tuple
+      relations indexed by name; tuples stored as full literals so they
-- [ ] `dl-add-rule!` `db` `head` `body` → add rule clause
+      unify directly. Dedup on insert via `dl-tuple-equal?`.
-- [ ] Naive evaluation: iterate rules until fixpoint
+- [x] `dl-add-fact! db lit` (rejects non-ground) and `dl-add-rule! db rule`
-      For each rule, for each combination of body tuples that unify, derive head tuple.
+      (rejects unsafe). `dl-program source` parses + loads in one step.
-      Repeat until no new tuples added.
+- [x] Naive evaluation `dl-saturate! db`: iterate rules until no new tuples.
-- [ ] `dl-query` `db` `goal` → list of substitutions satisfying goal against derived DB
+      `dl-find-bindings` recursively joins body literals; `dl-match-positive`
-- [ ] Tests: transitive closure (ancestor), sibling, same-generation — classic Datalog programs
+      unifies a literal against every tuple in the relation.
+- [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 — semi-naive evaluation (performance)
+### Phase 4 — built-in predicates + body arithmetic
+Almost every real query needs `<`, `=`, simple arithmetic, and string
+comparisons in body position. These are not EDB lookups — they're
+constraints that filter bindings.
+- [x] Recognise built-in predicates in body: `(< X Y)`, `(<= X Y)`, `(> X Y)`,
+      `(>= X Y)`, `(= X Y)`, `(!= X Y)` and arithmetic forms `(is Z (+ X Y))`,
+      `(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)
 - [ ] Delta sets: track newly derived tuples per iteration
 - [ ] Semi-naive rule: only join against delta tuples from last iteration, not full relation
 - [ ] Significant speedup for recursive rules — avoids re-deriving known tuples
-- [ ] `dl-stratify` `db` → dependency graph + SCC analysis → stratum ordering
 - [ ] Tests: verify semi-naive produces same results as naive; benchmark on large ancestor chain
 
-### Phase 5 — stratified negation
+### Phase 6 — magic sets (goal-directed bottom-up, opt-in)
+Naive bottom-up derives **all** consequences before answering. Magic sets
+rewrite the program so the fixpoint only derives tuples relevant to the
+goal — a major perf win for "what's reachable from node X" queries on
+large graphs.
+- [ ] Adornments: annotate rule predicates with bound (`b`) / free (`f`)
+      patterns based on how they're called.
+- [ ] Magic transformation: for each adorned predicate, generate a
+      `magic_<pred>` relation and rewrite rule bodies to filter through it.
+- [ ] Sideways information passing strategy (SIPS): left-to-right by
+      default; pluggable.
+- [ ] Optional pass — `(dl-set-strategy! db :magic)`; default semi-naive.
+- [ ] Tests: equivalence vs naive on small inputs; perf win on a 10k-node
+      reachability query from a single root.
+
+### Phase 7 — stratified negation
 - [ ] Dependency graph analysis: which relations depend on which (positively or negatively)
 - [ ] Stratification check: error if negation is in a cycle (non-stratifiable program)
-- [ ] Evaluation: process strata in order — lower stratum fully computed before using its
+- [ ] `dl-stratify db` → SCC analysis → stratum ordering
-      complement in a higher stratum
+- [ ] Evaluation: process strata in order — lower stratum fully computed
-- [ ] `not(P)` in rule body: at evaluation time, check P is NOT in the derived EDB
+      before using its complement in a higher stratum
-- [ ] Tests: non-member (`not(member(X,L))`), colored-graph (`not(same-color(X,Y))`),
+- [ ] `not(P)` in rule body: at evaluation time, check P is NOT in the
-      stratification error detection
+      derived EDB
+- [ ] Safety extension: head vars in negative literals must also appear in
+      some positive body literal of the same rule
+- [ ] Tests: non-member (`not(member(X,L))`), colored-graph
+      (`not(same-color(X,Y))`), stratification error detection
 
-### Phase 6 — aggregation (Datalog+)
+### Phase 8 — aggregation (Datalog+)
 - [ ] `count(X, Goal)` → number of distinct X satisfying Goal
 - [ ] `sum(X, Goal)` → sum of X values satisfying Goal
 - [ ] `min(X, Goal)` / `max(X, Goal)` → min/max of X satisfying Goal
@@ -109,7 +167,7 @@ Key differences from Prolog:
 - [ ] Aggregation breaks stratification — evaluate in a separate post-fixpoint pass
 - [ ] Tests: social network statistics, grade aggregation, inventory sums
 
-### Phase 7 — SX embedding API
+### Phase 9 — SX embedding API
 - [ ] `(dl-program facts rules)` → database from SX data directly (no parsing required)
       ```
       (dl-program
@@ -123,7 +181,7 @@ Key differences from Prolog:
 - [ ] Integration demo: federation graph query — `(ancestor actor1 actor2)` over
       rose-ash ActivityPub follow relationships
 
-### Phase 8 — Datalog as a query language for rose-ash
+### Phase 10 — Datalog as a query language for rose-ash
 - [ ] Schema: map SQLAlchemy model relationships to Datalog EDB facts
       (e.g. `(follows user1 user2)`, `(authored user post)`, `(tagged post tag)`)
 - [ ] Loader: `dl-load-from-db!` — query PostgreSQL, populate Datalog EDB
@@ -142,4 +200,42 @@ _(none yet)_
 
 _Newest first._
 
-_(awaiting phase 1)_
+- 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`).

plans/ocaml-on-sx.md

@@ -116,60 +116,47 @@ SX CEK evaluator (both JS and OCaml hosts)
 
 ### Phase 1 — Tokenizer + parser
 
-- [x] **Tokenizer:** keywords (`let`, `rec`, `in`, `fun`, `function`, `match`, `with`,
+- [ ] **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), char literals `'c'`, string literals (escaped),
+      upper/ctor, labels `~label:`, optional `?label:`), char literals `'c'`,
-      int/float literals (incl. hex, exponent, underscores), nested block
+      string literals (escaped + heredoc `{|...|}`), int/float literals,
-      comments `(* ... *)`. _(labels `~label:` / `?label:` and heredoc `{|...|}`
+      line comments `(*` nested block comments `*)`.
-      deferred — surface tokens already work via `~`/`?` punct + `{`/`|` punct.)_
+- [ ] **Parser:** top-level `let`/`let rec`/`type`/`module`/`exception`/`open`/`include`
-- [~] **Parser:** expressions: literals, identifiers, constructor application,
+      declarations; expressions: literals, identifiers, constructor application,
-      lambda, application (left-assoc), binary ops with precedence (29 ops via
+      lambda, application (left-assoc), binary ops with precedence table,
-      `lib/guest/pratt.sx`), `if`/`then`/`else`, `let`/`in`, `let rec`,
+      `if`/`then`/`else`, `match`/`with`, `try`/`with`, `let`/`in`, `begin`/`end`,
-      `fun`/`->`, `match`/`with`, tuples, list literals, sequences `;`,
+      `fun`/`function`, tuples, list literals, record literals/updates, field access,
-      `begin`/`end`, unit `()`. Top-level decls: `let [rec] name params* = expr`
+      sequences `;`, unit `()`.
-      and bare expressions, `;;`-separated via `ocaml-parse-program`. _(Pending:
+- [ ] **Patterns:** constructor, literal, variable, wildcard `_`, tuple, list cons `::`,
-      `type`/`module`/`exception`/`open`/`include` decls, `try`/`with`,
+      list literal, record, `as`, or-pattern `P1 | P2`, `when` guard.
-      `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)
 
-- [x] `ocaml-eval` entry: walks OCaml AST, produces SX values.
+- [ ] `ocaml-eval` entry: walks OCaml AST, produces SX values.
-- [~] `let`/`let rec`/`let ... in` (single-binding done; mutually recursive
+- [ ] `let`/`let rec`/`let ... in` (mutually recursive with `and`).
-      `and` deferred).
+- [ ] Lambda + application (curried by default — auto-curry multi-param defs).
-- [x] Lambda + application (curried by default — auto-curry multi-param defs).
+- [ ] `fun`/`function` (single-arg lambda with immediate match on arg).
-- [ ] `fun`/`function` (single-arg lambda with immediate match on arg). _(`fun`
+- [ ] `if`/`then`/`else`, `begin`/`end`, sequence `;`.
-      done; `function` blocked on parser support.)_
+- [ ] Arithmetic, comparison, boolean ops, string `^`, `mod`.
-- [x] `if`/`then`/`else`, `begin`/`end`, sequence `;`.
+- [ ] Unit `()` value; `ignore`.
-- [x] Arithmetic, comparison, boolean ops, string `^`, `mod`.
+- [ ] References: `ref`, `!`, `:=`.
-- [x] Unit `()` value; `ignore`.
-- [x] References: `ref`, `!`, `:=`.
 - [ ] Mutable record fields.
-- [x] `for i = lo to hi do ... done` loop; `while cond do ... done` (incl.
+- [ ] `for i = lo to hi do ... done` loop; `while cond do ... done`.
-      `downto` direction).
 - [ ] `try`/`with` — maps to SX `guard`; `raise` via perform.
 - [ ] 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 }`.
-      _(Parser + evaluator currently inferred-arity at runtime; type decls
+- [ ] Constructors as tagged lists: `A` → `(:A)`, `B(1, "x")` → `(:B 1 "x")`.
-      pending.)_
+- [ ] `match`/`with`: constructor, literal, variable, wildcard, tuple, list cons/nil,
-- [x] Constructors as tagged lists: `A` → `("A")`, `B(1, "x")` → `("B" 1 "x")`.
+      `as` binding, or-patterns, nested patterns, `when` guard.
-- [~] `match`/`with`: constructor, literal, variable, wildcard, tuple, list
+- [ ] Exhaustiveness: runtime error on incomplete match (no compile-time check yet).
-      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`,
@@ -321,75 +308,7 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means:
 
 _Newest first._
 
-- 2026-05-08 Phase 2 — `for`/`while` loops. `(:for NAME LO HI DIR BODY)`
+_(awaiting phase 1)_
-  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