coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use match for value dispatch in evaluator and compiler

Browse Source 
Convert large cond chains doing string equality dispatch to use the
match special form: step-eval-list (42 arms), step-continue (31 arms),
compile-list (30 arms), ho-setup-dispatch (7 arms), value-matches-type?
(10 arms). Also fix test-canonical.sx to use defsuite/deftest format
and load canonical.sx in both test runners.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-29 07:53:16 +00:00
parent 394c86b474
commit 8bba02fbc9
5 changed files with 1399 additions and 1414 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
hosts/javascript/run_tests.js
View File

@@ -82,6 +82,18 @@ env["env-merge"] = function(a, b) { return Object.assign({}, a, b); };
// Missing primitives referenced by tests
// primitive? is now in platform.py PRIMITIVES
env["contains-char?"] = function(s, c) { return typeof s === "string" && typeof c === "string" && s.indexOf(c) >= 0; };
env["escape-string"] = function(s) { return s.replace(/\\/g, "\\\\").replace(/"/g, '\\"').replace(/\n/g, "\\n").replace(/\t/g, "\\t"); };
env["trim-right"] = function(s) { return typeof s === "string" ? s.trimEnd() : s; };
env["sha3-256"] = function(s) {
// Simple hash stub for testing — not real SHA3
var h = 0;
for (var i = 0; i < s.length; i++) { h = ((h << 5) - h + s.charCodeAt(i)) | 0; }
h = Math.abs(h);
var hex = h.toString(16);
while (hex.length < 64) hex = "0" + hex;
return hex;
};
env["upcase"] = function(s) { return s.toUpperCase(); };
env["downcase"] = function(s) { return s.toLowerCase(); };
env["make-keyword"] = function(name) { return new Sx.Keyword(name); };
@@ -291,6 +303,18 @@ if (fs.existsSync(harnessPath)) {
}
}
// Load canonical.sx (content-addressing, serialization)
const canonicalPath = path.join(projectDir, "spec", "canonical.sx");
if (fs.existsSync(canonicalPath)) {
const canonicalSrc = fs.readFileSync(canonicalPath, "utf8");
const canonicalExprs = Sx.parse(canonicalSrc);
for (const expr of canonicalExprs) {
try { Sx.eval(expr, env); } catch (e) {
console.error(`Error loading canonical.sx: ${e.message}`);
}
}
}
// Load compiler + VM from lib/ when running full tests
if (fullBuild) {
const libDir = path.join(projectDir, "lib");

18
hosts/ocaml/bin/run_tests.ml
View File

@@ -390,6 +390,22 @@ let make_test_env () =
bind "defeffect" (fun _args -> Nil);
(* --- Primitives for canonical.sx / content tests --- *)
bind "symbol-name" (fun args ->
match args with
| [Symbol s] -> String s
| _ -> raise (Eval_error "symbol-name: expected symbol"));
bind "keyword-name" (fun args ->
match args with
| [Keyword k] -> String k
| _ -> raise (Eval_error "keyword-name: expected keyword"));
bind "trim-right" (fun args ->
match args with
| [String s] ->
let len = String.length s in
let i = ref (len - 1) in
while !i >= 0 && (s.[!i] = ' ' || s.[!i] = '\t' || s.[!i] = '\n' || s.[!i] = '\r') do decr i done;
String (String.sub s 0 (!i + 1))
| _ -> raise (Eval_error "trim-right: expected string"));
bind "contains-char?" (fun args ->
match args with
| [String s; String c] when String.length c = 1 ->
@@ -809,6 +825,8 @@ let run_spec_tests env test_files =
with e -> Printf.eprintf "Warning: %s: %s\n%!" name (Printexc.to_string e))
end
in
(* Content-addressing, serialization *)
load_module "canonical.sx" spec_dir;
(* Render adapter for test-render-html.sx *)
load_module "render.sx" spec_dir;
load_module "adapter-html.sx" web_dir;

1112
lib/compiler.sx
View File

File diff suppressed because it is too large Load Diff

369
spec/evaluator.sx
View File

@@ -306,34 +306,27 @@
value-matches-type?
(fn
(val expected-type)
(cond
(= expected-type "any")
true
(= expected-type "number")
(number? val)
(= expected-type "string")
(string? val)
(= expected-type "boolean")
(boolean? val)
(= expected-type "nil")
(nil? val)
(= expected-type "list")
(list? val)
(= expected-type "dict")
(dict? val)
(= expected-type "lambda")
(lambda? val)
(= expected-type "symbol")
(= (type-of val) "symbol")
(= expected-type "keyword")
(= (type-of val) "keyword")
(match
expected-type
("any" true)
("number" (number? val))
("string" (string? val))
("boolean" (boolean? val))
("nil" (nil? val))
("list" (list? val))
("dict" (dict? val))
("lambda" (lambda? val))
("symbol" (= (type-of val) "symbol"))
("keyword" (= (type-of val) "keyword"))
(_
(if
(and (string? expected-type) (ends-with? expected-type "?"))
(or
(nil? val)
(value-matches-type?
val
(slice expected-type 0 (- (string-length expected-type) 1))))
:else true)))
true)))))
(define
strict-check-args
@@ -1019,91 +1012,58 @@
(= (type-of head) "symbol")
(let
((name (symbol-name head)))
(match
name
("if" (step-sf-if args env kont))
("when" (step-sf-when args env kont))
("cond" (step-sf-cond args env kont))
("case" (step-sf-case args env kont))
("and" (step-sf-and args env kont))
("or" (step-sf-or args env kont))
("let" (step-sf-let args env kont))
("let*" (step-sf-let args env kont))
("lambda" (step-sf-lambda args env kont))
("fn" (step-sf-lambda args env kont))
("define" (step-sf-define args env kont))
("defcomp" (make-cek-value (sf-defcomp args env) env kont))
("defisland" (make-cek-value (sf-defisland args env) env kont))
("defmacro" (make-cek-value (sf-defmacro args env) env kont))
("begin" (step-sf-begin args env kont))
("do" (step-sf-begin args env kont))
("quote"
(make-cek-value
(if (empty? args) nil (first args))
env
kont))
("quasiquote"
(make-cek-value (qq-expand (first args) env) env kont))
("->" (step-sf-thread-first args env kont))
("set!" (step-sf-set! args env kont))
("letrec" (step-sf-letrec args env kont))
("reset" (step-sf-reset args env kont))
("shift" (step-sf-shift args env kont))
("deref" (step-sf-deref args env kont))
("scope" (step-sf-scope args env kont))
("provide" (step-sf-provide args env kont))
("context" (step-sf-context args env kont))
("emit!" (step-sf-emit args env kont))
("emitted" (step-sf-emitted args env kont))
("handler-bind" (step-sf-handler-bind args env kont))
("restart-case" (step-sf-restart-case args env kont))
("signal" (step-sf-signal args env kont))
("invoke-restart" (step-sf-invoke-restart args env kont))
("match" (step-sf-match args env kont))
("dynamic-wind"
(make-cek-value (sf-dynamic-wind args env) env kont))
("map" (step-ho-map args env kont))
("map-indexed" (step-ho-map-indexed args env kont))
("filter" (step-ho-filter args env kont))
("reduce" (step-ho-reduce args env kont))
("some" (step-ho-some args env kont))
("every?" (step-ho-every args env kont))
("for-each" (step-ho-for-each args env kont))
(_
(cond
(= name "if")
(step-sf-if args env kont)
(= name "when")
(step-sf-when args env kont)
(= name "cond")
(step-sf-cond args env kont)
(= name "case")
(step-sf-case args env kont)
(= name "and")
(step-sf-and args env kont)
(= name "or")
(step-sf-or args env kont)
(= name "let")
(step-sf-let args env kont)
(= name "let*")
(step-sf-let args env kont)
(= name "lambda")
(step-sf-lambda args env kont)
(= name "fn")
(step-sf-lambda args env kont)
(= name "define")
(step-sf-define args env kont)
(= name "defcomp")
(make-cek-value (sf-defcomp args env) env kont)
(= name "defisland")
(make-cek-value (sf-defisland args env) env kont)
(= name "defmacro")
(make-cek-value (sf-defmacro args env) env kont)
(= name "begin")
(step-sf-begin args env kont)
(= name "do")
(step-sf-begin args env kont)
(= name "quote")
(make-cek-value (if (empty? args) nil (first args)) env kont)
(= name "quasiquote")
(make-cek-value (qq-expand (first args) env) env kont)
(= name "->")
(step-sf-thread-first args env kont)
(= name "set!")
(step-sf-set! args env kont)
(= name "letrec")
(step-sf-letrec args env kont)
(= name "reset")
(step-sf-reset args env kont)
(= name "shift")
(step-sf-shift args env kont)
(= name "deref")
(step-sf-deref args env kont)
(= name "scope")
(step-sf-scope args env kont)
(= name "provide")
(step-sf-provide args env kont)
(= name "context")
(step-sf-context args env kont)
(= name "emit!")
(step-sf-emit args env kont)
(= name "emitted")
(step-sf-emitted args env kont)
(= name "handler-bind")
(step-sf-handler-bind args env kont)
(= name "restart-case")
(step-sf-restart-case args env kont)
(= name "signal")
(step-sf-signal args env kont)
(= name "invoke-restart")
(step-sf-invoke-restart args env kont)
(= name "match")
(step-sf-match args env kont)
(= name "dynamic-wind")
(make-cek-value (sf-dynamic-wind args env) env kont)
(= name "map")
(step-ho-map args env kont)
(= name "map-indexed")
(step-ho-map-indexed args env kont)
(= name "filter")
(step-ho-filter args env kont)
(= name "reduce")
(step-ho-reduce args env kont)
(= name "some")
(step-ho-some args env kont)
(= name "every?")
(step-ho-every args env kont)
(= name "for-each")
(step-ho-for-each args env kont)
(has-key? *custom-special-forms* name)
(make-cek-value
((get *custom-special-forms* name) args env)
@@ -1115,7 +1075,7 @@
(make-cek-state (expand-macro mac args env) env kont))
(and *render-check* (*render-check* expr env))
(make-cek-value (*render-fn* expr env) env kont)
:else (step-eval-call head args env kont)))
:else (step-eval-call head args env kont)))))
(step-eval-call head args env kont))))))
(define
@@ -1690,8 +1650,9 @@
((ordered (ho-swap-args ho-type evaled)))
(let
((f (first ordered)))
(cond
(= ho-type "map")
(match
ho-type
("map"
(let
((coll (nth ordered 1)))
(if
@@ -1702,8 +1663,8 @@
(list (first coll))
env
(list)
(kont-push (make-map-frame f (rest coll) (list) env) kont))))
(= ho-type "map-indexed")
(kont-push (make-map-frame f (rest coll) (list) env) kont)))))
("map-indexed"
(let
((coll (nth ordered 1)))
(if
@@ -1716,8 +1677,8 @@
(list)
(kont-push
(make-map-indexed-frame f (rest coll) (list) env)
kont))))
(= ho-type "filter")
kont)))))
("filter"
(let
((coll (nth ordered 1)))
(if
@@ -1729,9 +1690,14 @@
env
(list)
(kont-push
(make-filter-frame f (rest coll) (list) (first coll) env)
kont))))
(= ho-type "reduce")
(make-filter-frame
f
(rest coll)
(list)
(first coll)
env)
kont)))))
("reduce"
(let
((init (nth ordered 1)) (coll (nth ordered 2)))
(if
@@ -1742,8 +1708,8 @@
(list init (first coll))
env
(list)
(kont-push (make-reduce-frame f (rest coll) env) kont))))
(= ho-type "some")
(kont-push (make-reduce-frame f (rest coll) env) kont)))))
("some"
(let
((coll (nth ordered 1)))
(if
@@ -1754,8 +1720,8 @@
(list (first coll))
env
(list)
(kont-push (make-some-frame f (rest coll) env) kont))))
(= ho-type "every")
(kont-push (make-some-frame f (rest coll) env) kont)))))
("every"
(let
((coll (nth ordered 1)))
(if
@@ -1766,8 +1732,8 @@
(list (first coll))
env
(list)
(kont-push (make-every-frame f (rest coll) env) kont))))
(= ho-type "for-each")
(kont-push (make-every-frame f (rest coll) env) kont)))))
("for-each"
(let
((coll (nth ordered 1)))
(if
@@ -1778,8 +1744,8 @@
(list (first coll))
env
(list)
(kont-push (make-for-each-frame f (rest coll) env) kont))))
:else (error (str "Unknown HO type: " ho-type)))))))
(kont-push (make-for-each-frame f (rest coll) env) kont)))))
(_ (error (str "Unknown HO type: " ho-type))))))))
(define
step-ho-map
@@ -1863,16 +1829,20 @@
((frame (kont-top kont))
(rest-k (kont-pop kont))
(ft (frame-type frame)))
(cond
(= ft "if")
(match
ft
("if"
(if
(and value (not (nil? value)))
(make-cek-state (get frame "then") (get frame "env") rest-k)
(if
(nil? (get frame "else"))
(make-cek-value nil env rest-k)
(make-cek-state (get frame "else") (get frame "env") rest-k)))
(= ft "when")
(make-cek-state
(get frame "else")
(get frame "env")
rest-k))))
("when"
(if
(and value (not (nil? value)))
(let
@@ -1886,9 +1856,11 @@
(make-cek-state
(first body)
fenv
(kont-push (make-begin-frame (rest body) fenv) rest-k)))))
(make-cek-value nil env rest-k))
(= ft "begin")
(kont-push
(make-begin-frame (rest body) fenv)
rest-k)))))
(make-cek-value nil env rest-k)))
("begin"
(let
((remaining (get frame "remaining"))
(fenv (get frame "env")))
@@ -1903,8 +1875,8 @@
fenv
(kont-push
(make-begin-frame (rest remaining) fenv)
rest-k)))))
(= ft "let")
rest-k))))))
("let"
(let
((name (get frame "name"))
(remaining (get frame "remaining"))
@@ -1926,8 +1898,8 @@
local
(kont-push
(make-let-frame vname (rest remaining) body local)
rest-k)))))
(= ft "define")
rest-k))))))
("define"
(let
((name (get frame "name"))
(fenv (get frame "env"))
@@ -1940,7 +1912,7 @@
(when
has-effects
(let
((effect-names (if (= (type-of effect-list) "list") (map (fn (e) (if (= (type-of e) "symbol") (symbol-name e) (str e))) effect-list) (list (str effect-list))))
((effect-names (map (fn (e) (if (= (type-of e) "symbol") (symbol-name e) e)) effect-list))
(effect-anns
(if
(env-has? fenv "*effect-annotations*")
@@ -1948,13 +1920,13 @@
(dict))))
(dict-set! effect-anns name effect-names)
(env-bind! fenv "*effect-annotations*" effect-anns)))
(make-cek-value value fenv rest-k))
(= ft "set")
(make-cek-value value fenv rest-k)))
("set"
(let
((name (get frame "name")) (fenv (get frame "env")))
(env-set! fenv name value)
(make-cek-value value env rest-k))
(= ft "and")
(make-cek-value value env rest-k)))
("and"
(if
(not value)
(make-cek-value value env rest-k)
@@ -1971,8 +1943,8 @@
rest-k
(kont-push
(make-and-frame (rest remaining) (get frame "env"))
rest-k))))))
(= ft "or")
rest-k)))))))
("or"
(if
value
(make-cek-value value env rest-k)
@@ -1989,8 +1961,8 @@
rest-k
(kont-push
(make-or-frame (rest remaining) (get frame "env"))
rest-k))))))
(= ft "cond")
rest-k)))))))
("cond"
(let
((remaining (get frame "remaining"))
(fenv (get frame "env"))
@@ -2021,7 +1993,7 @@
value
(make-cek-state (nth remaining 1) fenv rest-k)
(let
((next (slice remaining 2)))
((next (slice remaining 2 (len remaining))))
(if
(< (len next) 2)
(make-cek-value nil fenv rest-k)
@@ -2035,8 +2007,8 @@
fenv
(kont-push
(make-cond-frame next fenv false)
rest-k)))))))))
(= ft "case")
rest-k))))))))))
("case"
(let
((match-val (get frame "match-val"))
(remaining (get frame "remaining"))
@@ -2044,8 +2016,8 @@
(if
(nil? match-val)
(sf-case-step-loop value remaining fenv rest-k)
(sf-case-step-loop match-val remaining fenv rest-k)))
(= ft "thread")
(sf-case-step-loop match-val remaining fenv rest-k))))
("thread"
(let
((remaining (get frame "remaining"))
(fenv (get frame "env")))
@@ -2075,7 +2047,7 @@
fenv
new-kont)
(let
((result (if (= (type-of form) "list") (let ((f (trampoline (eval-expr (first form) fenv))) (rargs (map (fn (a) (trampoline (eval-expr a fenv))) (rest form))) (all-args (cons value rargs))) (cond (and (callable? f) (not (lambda? f))) (apply f all-args) (lambda? f) (trampoline (call-lambda f all-args fenv)) :else (error (str "-> form not callable: " (inspect f))))) (let ((f (trampoline (eval-expr form fenv)))) (cond (and (callable? f) (not (lambda? f))) (f value) (lambda? f) (trampoline (call-lambda f (list value) fenv)) :else (error (str "-> form not callable: " (inspect f))))))))
((result (thread-insert-arg form value fenv)))
(if
(empty? rest-forms)
(make-cek-value result fenv rest-k)
@@ -2084,8 +2056,8 @@
fenv
(kont-push
(make-thread-frame rest-forms fenv)
rest-k))))))))
(= ft "arg")
rest-k)))))))))
("arg"
(let
((f (get frame "f"))
(evaled (get frame "evaled"))
@@ -2134,8 +2106,8 @@
fenv
raw-args
hname)
rest-k))))))
(= ft "dict")
rest-k)))))))
("dict"
(let
((remaining (get frame "remaining"))
(results (get frame "results"))
@@ -2166,8 +2138,8 @@
completed
(list (list (first next-entry))))
fenv)
rest-k))))))
(= ft "ho-setup")
rest-k)))))))
("ho-setup"
(let
((ho-type (get frame "ho-type"))
(remaining (get frame "remaining"))
@@ -2180,13 +2152,16 @@
(first remaining)
fenv
(kont-push
(make-ho-setup-frame ho-type (rest remaining) evaled fenv)
rest-k))))
(= ft "reset")
(make-cek-value value env rest-k)
(= ft "deref")
(make-ho-setup-frame
ho-type
(rest remaining)
evaled
fenv)
rest-k)))))
("reset" (make-cek-value value env rest-k))
("deref"
(let
((val value) (fenv (get frame "env")))
((val (get frame "value")) (fenv (get frame "env")))
(if
(not (signal? val))
(make-cek-value val fenv rest-k)
@@ -2195,7 +2170,7 @@
(reactive-shift-deref val fenv rest-k)
(do
(let
((ctx (context "sx-reactive" nil)))
((ctx (get-tracking-context)))
(when
ctx
(let
@@ -2205,16 +2180,16 @@
(not (contains? dep-list val))
(append! dep-list val)
(signal-add-sub! val notify-fn)))))
(make-cek-value (signal-value val) fenv rest-k)))))
(= ft "reactive-reset")
(make-cek-value (signal-value val) fenv rest-k))))))
("reactive-reset"
(let
((update-fn (get frame "update-fn"))
(first? (get frame "first-render")))
(when
(and update-fn (not first?))
(cek-call update-fn (list value)))
(make-cek-value value env rest-k))
(= ft "scope")
(make-cek-value value env rest-k)))
("scope"
(let
((name (get frame "name"))
(remaining (get frame "remaining"))
@@ -2227,8 +2202,8 @@
fenv
(kont-push
(make-scope-frame name (rest remaining) fenv)
rest-k))))
(= ft "provide")
rest-k)))))
("provide"
(let
((remaining (get frame "remaining"))
(fenv (get frame "env")))
@@ -2244,8 +2219,8 @@
(get frame "value")
(rest remaining)
fenv)
rest-k))))
(= ft "scope-acc")
rest-k)))))
("scope-acc"
(let
((remaining (get frame "remaining"))
(fenv (get frame "env")))
@@ -2257,11 +2232,11 @@
fenv
(kont-push
(let
((new-frame (make-scope-acc-frame (get frame "name") (get frame "value") (rest remaining) fenv)))
((new-frame (make-scope-acc-frame (get frame "name") (rest remaining) fenv)))
(dict-set! new-frame "emitted" (get frame "emitted"))
new-frame)
rest-k))))
(= ft "map")
rest-k)))))
("map"
(let
((f (get frame "f"))
(remaining (get frame "remaining"))
@@ -2283,14 +2258,18 @@
(rest remaining)
new-results
fenv)
(make-map-frame f (rest remaining) new-results fenv))))
(make-map-frame
f
(rest remaining)
new-results
fenv))))
(continue-with-call
f
call-args
fenv
(list)
(kont-push next-frame rest-k))))))
(= ft "filter")
(kont-push next-frame rest-k)))))))
("filter"
(let
((f (get frame "f"))
(remaining (get frame "remaining"))
@@ -2314,8 +2293,8 @@
new-results
(first remaining)
fenv)
rest-k)))))
(= ft "reduce")
rest-k))))))
("reduce"
(let
((f (get frame "f"))
(remaining (get frame "remaining"))
@@ -2330,8 +2309,8 @@
(list)
(kont-push
(make-reduce-frame f (rest remaining) fenv)
rest-k))))
(= ft "for-each")
rest-k)))))
("for-each"
(let
((f (get frame "f"))
(remaining (get frame "remaining"))
@@ -2346,8 +2325,8 @@
(list)
(kont-push
(make-for-each-frame f (rest remaining) fenv)
rest-k))))
(= ft "some")
rest-k)))))
("some"
(let
((f (get frame "f"))
(remaining (get frame "remaining"))
@@ -2365,8 +2344,8 @@
(list)
(kont-push
(make-some-frame f (rest remaining) fenv)
rest-k)))))
(= ft "every")
rest-k))))))
("every"
(let
((f (get frame "f"))
(remaining (get frame "remaining"))
@@ -2384,8 +2363,8 @@
(list)
(kont-push
(make-every-frame f (rest remaining) fenv)
rest-k)))))
(= ft "handler")
rest-k))))))
("handler"
(let
((remaining (get frame "remaining"))
(fenv (get frame "env")))
@@ -2400,16 +2379,14 @@
(get frame "f")
(rest remaining)
fenv)
rest-k))))
(= ft "restart")
(make-cek-value value env rest-k)
(= ft "signal-return")
rest-k)))))
("restart" (make-cek-value value env rest-k))
("signal-return"
(let
((saved-kont (get frame "f")))
(make-cek-value value (get frame "env") saved-kont))
(= ft "comp-trace")
(make-cek-value value env rest-k)
:else (error (str "Unknown frame type: " ft))))))))
((saved-kont (get frame "saved-kont")))
(make-cek-value value (get frame "env") saved-kont)))
("comp-trace" (make-cek-value value env rest-k))
(_ (error (str "Unknown frame type: " ft)))))))))
(define
continue-with-call

66
spec/tests/test-canonical.sx
View File

@@ -1,91 +1,97 @@
(test-group
(defsuite
"canonical-serialize"
(test "nil" (assert= (canonical-serialize nil) "nil"))
(test
(deftest "nil" (assert= (canonical-serialize nil) "nil"))
(deftest
"booleans"
(assert= (canonical-serialize true) "true")
(assert= (canonical-serialize false) "false"))
(test
(deftest
"integers"
(assert= (canonical-serialize 0) "0")
(assert= (canonical-serialize 42) "42")
(assert= (canonical-serialize -7) "-7"))
(test
(deftest
"strings"
(assert= (canonical-serialize "hello") "\"hello\"")
(assert= (canonical-serialize "") "\"\"")
(assert= (canonical-serialize "a\"b") "\"a\\\"b\""))
(test
(deftest
"symbols"
(assert= (canonical-serialize (quote deref)) "deref")
(assert= (canonical-serialize (quote swap!)) "swap!"))
(test
(deftest
"keywords"
(assert= (canonical-serialize :class) ":class")
(assert= (canonical-serialize :arity) ":arity"))
(test "empty list" (assert= (canonical-serialize (list)) "()"))
(test "flat list" (assert= (canonical-serialize (list 1 2 3)) "(1 2 3)"))
(test
(assert= (canonical-serialize (make-keyword "class")) ":class")
(assert= (canonical-serialize (make-keyword "arity")) ":arity"))
(deftest "empty list" (assert= (canonical-serialize (list)) "()"))
(deftest
"flat list"
(assert= (canonical-serialize (list 1 2 3)) "(1 2 3)"))
(deftest
"nested list"
(assert=
(canonical-serialize
(list (quote div) :class "flex" (list (quote h2) "title")))
(list
(quote div)
(make-keyword "class")
"flex"
(list (quote h2) "title")))
"(div :class \"flex\" (h2 \"title\"))"))
(test
(deftest
"dict keys sorted"
(let
((d (dict "zebra" 1 "alpha" 2 "middle" 3)))
((d {:zebra 1 :middle 3 :alpha 2}))
(assert= (canonical-serialize d) "{:alpha 2 :middle 3 :zebra 1}")))
(test
(deftest
"dict with nested values"
(let
((d (dict "a" (list 1 2) "b" "hello")))
((d {:b "hello" :a (list 1 2)}))
(assert= (canonical-serialize d) "{:a (1 2) :b \"hello\"}"))))
(test-group
(defsuite
"content-id"
(test
(deftest
"same expression same CID"
(assert= (content-id (list 1 2 3)) (content-id (list 1 2 3))))
(test
(deftest
"different expression different CID"
(assert
(not (= (content-id (list 1 2 3)) (content-id (list 1 2 4))))))
(test
(deftest
"CID is a hex string"
(let
((cid (content-id 42)))
(assert (string? cid))
(assert= (len cid) 64)))
(test
(deftest
"short CID is 16 chars"
(let ((cid (content-id-short 42))) (assert= (len cid) 16)))
(test
(deftest
"short CID is prefix of full CID"
(let
((full (content-id 42)) (short (content-id-short 42)))
(assert= short (slice full 0 16)))))
(test-group
(defsuite
"bytecode-module"
(test
(deftest
"make and query"
(let
((m (make-bytecode-module 1 "abc123" (list (quote code) :bytecode (list 1 2 3)))))
((m (make-bytecode-module 1 "abc123" (list 1 2 3))))
(assert (bytecode-module? m))
(assert= (bytecode-module-version m) 1)
(assert= (bytecode-module-source-hash m) "abc123")))
(test
(deftest
"non-module fails predicate"
(assert (not (bytecode-module? (list 1 2 3))))
(assert (not (bytecode-module? "hello")))))
(test-group
(defsuite
"provenance"
(test
(deftest
"make provenance record"
(let
((p (make-provenance "src-cid" "bc-cid" "compiler-cid" "2026-03-27T00:00:00Z")))
((p (make-provenance "src-cid" "bc-cid" "v1" "js")))
(assert= (first p) (quote provenance))
(assert= (nth p 2) "src-cid")
(assert= (nth p 4) "bc-cid"))))