JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
flan/test/test_flan.ml
Joseph Ferano a0278378ab Five randomness functions, and a draw wide enough to answer them 
rand-int, rand, rand-bool, rand-int-range and rand-float-range, at the widths
the author ruled: a u64 draw and an f64 in [0, 1). rand-seed and rand-state
keep their names. The four old names are not names, and each is refused by the
one that is, with a call that compiles — in both the call and the bare-name
position, because a Lisp-1 makes the second a real thing to write.

The generator's step is untouched, so a seed means what it meant. Its output
function is not: PCG-XSH-RR folded the state to 32 bits, and no honest u64 or
53-bit f64 comes out of 32 bits without a second step. PCG-RXS-M-XS 64 answers
64 from the same one, so all five still cost exactly one draw and a seeded run
is reproducible. The price, written where it lives: the permutation is a
bijection of the state, which is what 64 output bits from 64 state bits costs.

The sequence is therefore a different one, and programs/rand.flan pins it —
reproducibility across the five, the single-draw cost of each, the half-open
boundaries, and rand-bool's count over a thousand flips.

sand.flan is not touched. It calls rand-f32, so the cases that compile or
re-evaluate it skip themselves on the fixture rather than on a comment: fix
its two calls and every one of them runs again. Its hash is the old
generator's grid and gets re-taken then.
2026-09-21 10:57:18 +07:00

6087 lines
324 KiB
OCaml
Raw Blame History

(* Reader tests. Plain assertions, no test framework — another dependency that
would have to be reimplemented if the compiler is ever self-hosted. *)
open Flan
(* The watchdog first: a hang is the one failure mode that reports
nothing at all. See watchdog.ml. *)
let () = Watchdog.arm ~seconds:600 "test_flan"
let failures = Test_support.failures
let check name cond =
if not cond then begin
incr failures;
Printf.printf "FAIL %s\n" name
end
let contains = Test_support.contains
(* Every read in this table runs under a five-second alarm. The reader is the
one part of the compiler whose mistakes loop rather than raise — a branch
that forgets to advance reads the same character for ever — and a hanging
case reports nothing at all. Five seconds is thousands of times what any
row here needs; what it buys is that a loop becomes a named failing row and
the rest of the table still runs. *)
(* Once one read has not returned, the reader is looping and every row after
it would spend the same five seconds proving the same thing — a hundred
rows is eight minutes of that. So the first timeout wedges the rest: they
fail immediately and the binary still reports, which is the whole point of
the alarm. *)
let wedged = ref false
let guarded seconds f =
if !wedged then raise Watchdog.Timeout
else
match Watchdog.within seconds f with
| x -> x
| exception Watchdog.Timeout -> wedged := true; raise Watchdog.Timeout
let read ?(file = "<test>") src =
guarded 5 (fun () -> Reader.read_all ~file src)
(* The corpus files, which are larger and are read from disk. *)
let read_file path = guarded 30 (fun () -> Reader.read_file path)
let reads name src expected =
match read src with
| forms ->
let got = String.concat " " (List.map Form.to_string forms) in
if got <> expected then begin
incr failures;
Printf.printf "FAIL %s\n src: %s\n got: %s\n wanted: %s\n"
name src got expected
end
| exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n"
name src (Loc.to_string loc) msg
| exception Watchdog.Timeout ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n the reader did not return\n"
name src
(* [needle] is the point: a read error that fires for the wrong reason is not
the test passing. Without it "backtick at end of input" would be green even
if the backtick were still an ordinary symbol character. *)
let rejects ?needle name src =
match read src with
| _ -> incr failures; Printf.printf "FAIL %s: expected a read error\n" name
| exception Watchdog.Timeout ->
incr failures;
Printf.printf "FAIL %s: the reader did not return\n" name
| exception Loc.Error { Loc.dmsg = msg; _ } ->
(match needle with
| Some n when not (contains msg n) ->
incr failures;
Printf.printf "FAIL %s\n error: %s\n wanted: ...%s...\n" name msg n
| _ -> ())
let () =
(* ── Atoms ─────────────────────────────────────────────────────── *)
reads "integer" "42" "42";
reads "negative" "-1" "-1";
(* A sign is part of the number, both ways. [+5] is the one that reads as a
symbol the moment the '+' case is dropped from the dispatch, and a symbol
named "+5" is an unknown name much later and somewhere else. *)
reads "leading plus" "+5" "5";
reads "plus float" "+0.5" "0.5";
reads "plus in a call" "(f +5 -5)" "(f 5 -5)";
(* And the operator is still itself: [+] alone is the addition symbol, and
[(+ 1 2)] must not read its head as a number. *)
reads "bare plus" "+" "+";
reads "float" "0.05" "0.05";
reads "hex" "0xE6B800FF" "3870818559";
reads "string" "\"SAND\"" "\"SAND\"";
reads "symbol" "empty-at?" "empty-at?";
reads "qualified" "rl/draw-fps" "rl/draw-fps";
reads "field access" ".pos" ".pos";
reads "operator" "->>" "->>";
reads "bare minus" "-" "-";
reads "keyword" ":space" ":space";
reads "else keyword" ":else" ":else";
(* Byte literals, as used by calc-me's tokenizer. *)
reads "byte named" "\\space" "\\space";
reads "byte digit" "\\0" "\\0";
reads "byte paren" "\\(" "\\(";
reads "byte dot" "\\." "\\.";
(* ── Sequences ─────────────────────────────────────────────────── *)
reads "list" "(+ 1 2)" "(+ 1 2)";
reads "vector" "[1 2 3]" "[1 2 3]";
reads "map literal" "{.src src .pos 0}" "{.src src .pos 0}";
reads "type notation" "[4 f32]" "[4 f32]";
reads "nested type" "[rows [cols u32]]" "[rows [cols u32]]";
reads "commas as space" "[1, 2, 3]" "[1 2 3]";
reads "nested" "(a (b [c {.d e}]))" "(a (b [c {.d e}]))";
(* ── Trivia ────────────────────────────────────────────────────── *)
reads "line comment" "; nope\n42" "42";
reads "trailing comment" "42 ; nope" "42";
reads "banner comment" ";;;; header\n(f)" "(f)";
reads "multiple forms" "(a) (b)" "(a) (b)";
reads "empty source" "" "";
reads "only comments" "; nothing here" "";
(* ── Quote ─────────────────────────────────────────────────────── *)
(* Restart names are quoted symbols. Before this existed, 'skip-form read as
a symbol *named* "'skip-form", which is silently a different symbol from
skip-form and nothing would ever have reported it. *)
reads "quote symbol" "'skip-form" "(quote skip-form)";
reads "quote in call" "(invoke-restart 'use-placeholder)"
"(invoke-restart (quote use-placeholder))";
reads "quote list" "'(a b)" "(quote (a b))";
(* ── Quasiquote ────────────────────────────────────────────────── *)
(* The bug this closes: a backtick was an ordinary symbol character, so
`(a b) came back as the unknown name "`" — the apostrophe's old failure
mode, still open one sigil over. Clojure's ` ~ ~@ rather than Common
Lisp's ` , ,@ because a comma is whitespace here and every binding vector
depends on that. *)
reads "quasiquote list" "`(a b)" "(quasiquote (a b))";
reads "unquote" "`(a ~b)" "(quasiquote (a (unquote b)))";
reads "unquote-splicing" "`(a ~@bs)" "(quasiquote (a (unquote-splicing bs)))";
reads "unquote a call" "`(+ ~(f x) 1)"
"(quasiquote (+ (unquote (f x)) 1))";
(* Nesting: the reader does not count levels, it just wraps again. Which
level an unquote belongs to is the expander's problem, not the reader's. *)
reads "nested quasiquote" "`(a `(b ~c))"
"(quasiquote (a (quasiquote (b (unquote c)))))";
(* An unquote outside any quasiquote still reads. It has to: the reader is
dumb and has no idea where it is. Parse refuses it — see the parse tests. *)
reads "unquote alone" "~x" "(unquote x)";
reads "splice alone" "~@x" "(unquote-splicing x)";
(* A quote inside a quasiquote stays a quote; the two sigils do not merge. *)
reads "quote in quasi" "`(a 'b)" "(quasiquote (a (quote b)))";
(* The delimiter half of the fix: without it ~x is one symbol named "~x". *)
reads "tilde ends a name" "(f a~b)" "(f a (unquote b))";
reads "backtick ends a name" "(f a`b)" "(f a (quasiquote b))";
reads "backtick in vec" "[`a ~b]" "[(quasiquote a) (unquote b)]";
(* ── Discard ───────────────────────────────────────────────────── *)
(* [#_] reads the next form and throws it away, so commenting out a form does
not mean counting its closing parens. Clojure's spelling and Clojure's
semantics, including the repeated form. *)
reads "discard in a call" "(f #_a b)" "(f b)";
reads "discard the last" "(f a #_b)" "(f a)";
reads "discard the first" "(#_f g a)" "(g a)";
reads "discard a list" "(f #_(g x) b)" "(f b)";
reads "discard in a vector" "[a #_b c]" "[a c]";
reads "discard in a map" "{:a 1 #_:b #_2 :c 3}" "{:a 1 :c 3}";
(* Two discards drop two forms, and that is the recursion rather than a
count: the outer discard reads one form, and the form it reads is itself a
discard that returns the one after. *)
reads "two discards" "(f #_#_a b c)" "(f c)";
reads "three discards" "(f #_#_#_a b c d)" "(f d)";
(* Every position a form can appear in. *)
reads "discard at top level" "#_(defn a [] () 1) (defn b [] () 2)" "(defn b [] () 2)";
reads "discard a whole file" "#_(defn a [] () 1)" "";
reads "discard before quote" "(f #_a 'b)" "(f (quote b))";
reads "discard of a quote" "(f #_'a b)" "(f b)";
(* Nested, which the recursive read gives for free. *)
reads "discard inside a discarded form" "(f #_(g #_h i) j)" "(f j)";
(* A name may still contain '#' — it is only a discard at the start of a
form, after trivia. *)
reads "hash inside a name" "(f a#_b)" "(f a#_b)";
(* Nothing to discard is an error, not a silent nothing. *)
rejects ~needle:"end of input" "discard at end of input" "(f a #_";
rejects ~needle:"unbalanced" "discard of a closing paren" "(f a #_)";
(* The whole class: no reader-significant character may end up inside a name. *)
let rec bad_names f =
let open Form in
match f.v with
| Sym s | Kw s ->
if String.exists (fun c -> c = '\'' || c = '^' || c = '`' || c = '~') s
then [ s ] else []
| List l | Vec l | Map l -> List.concat_map bad_names l
| _ -> []
in
let corpus =
"(invoke-restart 'skip-form) (a 'b [c 'd] {.e 'f}) '(g 'h) \
`(i ~j ~@k) `(l `(m ~n)) [`o ~p] {.q `r} (f a~b x`y)"
in
check "no sigils leak into names"
(bad_names (Form.make (Form.List (read corpus))
Loc.unknown) = []);
(* ── Errors ────────────────────────────────────────────────────── *)
rejects "unclosed list" "(f x";
rejects "unbalanced close" ")";
rejects "mismatched" "(f x]";
rejects "unterminated str" "\"abc";
rejects "empty keyword" ":";
rejects "unknown char" "\\bogus";
(* An escape the reader does not know is a typo, not a character: accepting
\q as 'q' silently reads a different string than the one that was
written, and nothing downstream can tell. *)
rejects "unknown string escape" "\"a\\qb\"" ~needle:"unknown string escape";
(* The escapes it does know still decode, which is what says the rejection
above rejects the unknown one and not escaping itself. Asserted on the
string's bytes rather than through [Form.to_string], which escapes them
again and would compare the source with itself. *)
(match read "\"a\\nb\\tc\\\\d\\\"e\\0f\"" with
| [ { Form.v = Form.Str s; _ } ] ->
check "known escapes" (s = "a\nb\tc\\d\"e\000f")
| _ -> check "known escapes: one string" false);
rejects "metadata" "^:async";
rejects "dangling quote" "'";
(* Each of these asserts the reason, not merely that something failed. *)
rejects "backtick at end" "`" ~needle:"unexpected end of input";
rejects "tilde at end" "~" ~needle:"unexpected end of input";
rejects "splice at end" "~@" ~needle:"unexpected end of input";
rejects "quasiquote unclosed" "`(a b" ~needle:"unclosed";
(* ── Locations ─────────────────────────────────────────────────── *)
(match read ~file:"f.flan" "(a)\n (b)" with
| [ a; b ] ->
check "loc line 1" (a.loc.line = 1 && a.loc.col = 1);
check "loc line 2" (b.loc.line = 2 && b.loc.col = 3);
check "loc file" (a.loc.file = "f.flan")
| _ -> check "loc: two forms" false);
(match read ~file:"f.flan" "(f\n bad" with
| _ -> check "unclosed reports opening loc" false
| exception Loc.Error { Loc.dloc = loc; _ } ->
check "unclosed reports opening loc" (loc.line = 1 && loc.col = 1));
(* ── Spans ─────────────────────────────────────────────────────
A location ends where the form ends, which is what an underline needs
and what a column number cannot give. Asserted on the width rather than
on the end column alone: a span that never got widened is zero wide, and
that is the failure mode worth catching — the field would exist, nothing
would fill it, and every squiggle would be one character long. *)
(match read ~file:"f.flan" "(foo bar)" with
| [ l ] ->
check "span covers the list" (Loc.width l.loc = Some 9);
(match l.Form.v with
| Form.List [ head; arg ] ->
check "span covers the head symbol" (Loc.width head.loc = Some 3);
check "span covers the argument" (Loc.width arg.loc = Some 3);
check "span starts at the symbol" (arg.loc.col = 6)
| _ -> check "span: two elements" false)
| _ -> check "span: one form" false);
(match read ~file:"f.flan" "\"hi\" 42 :kw" with
| [ s; n; k ] ->
check "span covers a string with its quotes" (Loc.width s.loc = Some 4);
check "span covers a number" (Loc.width n.loc = Some 2);
check "span covers a keyword with its colon" (Loc.width k.loc = Some 3)
| _ -> check "span: three atoms" false);
(* A form that runs over a line end has no width on its first line, and says
so rather than reporting a negative one. *)
(match read ~file:"f.flan" "(a\n b)" with
| [ l ] ->
check "multi-line span is flagged" (Loc.multiline l.loc);
check "multi-line span has no single-line width" (Loc.width l.loc = None)
| _ -> check "span: one multi-line form" false);
Test_support.report ~label:"reader" ()
(* ═══ Parse: forms → AST ═══════════════════════════════════════════ *)
let parse1 src =
match read src with
| [ f ] -> Parse.expr f
| _ -> failwith "test source must be exactly one form"
let parse_decl src =
match read src with
| [ f ] -> Parse.decl f
| _ -> failwith "test source must be exactly one form"
(* [needle] again: the house rule is that an unimplemented form is refused by
name with the reason, so a test that only proves *something* failed does not
observe the rule it is there for. *)
let parse_rejects ?needle name src =
match read src |> Parse.program with
| _ -> incr failures; Printf.printf "FAIL %s: expected a parse error\n" name
| exception Loc.Error { Loc.dmsg = msg; _ } ->
(match needle with
| Some n when not (contains msg n) ->
incr failures;
Printf.printf "FAIL %s: wrong reason\n wanted: %s\n got: %s\n"
name n msg
| _ -> ())
let () =
let open Ast in
(* ── Sugar is desugared, not preserved ─────────────────────────── *)
(match (parse1 "(when c a b)").e with
| If (_, { e = Do [ _; _ ]; _ }, None) -> ()
| _ -> check "when -> if+do" false);
(* An empty body is the same [Do []] that [(do)] already is, and not a
refusal. (when test) is a guard whose consequent has not been written yet
-- a state a program passes through while it is being written -- and
refusing it bought nothing that the empty [do] does not already allow.
[unless] in the prelude took the same change; it is a macro now, so it is
asserted in programs/prelude-macros.flan instead of here. *)
(match (parse1 "(when c)").e with
| If (_, { e = Do []; _ }, None) -> ()
| _ -> check "(when test) with no body -> if+(do)" false);
(* The test is still required, because there is nothing to branch on
without one. *)
parse_rejects "when with no test at all" "(defn f [] () (when))"
~needle:"when is (when test body ...)";
(* The same rule for a function with nothing in it. A [defn] whose declared
return type is () and whose body is empty has always been legal -- there
is a unit to answer and no forms needed to reach it -- and [Check] refuses
the case where the declaration disagrees, "returns i32 but has no body".
An [fn] now parses the same way; it declares no return type, so the
position it sits in is what decides, and the two rows below check.ml's
arms are in the checker section further down. *)
(match (parse1 "(fn [])").e with
| Fn ([], []) -> ()
| _ -> check "(fn []) parses with an empty body" false);
parse_rejects "fn with no parameter vector" "(defn f [] () (fn))"
~needle:"fn is (fn [param ...] body ...)";
(* unless was here, and is not any more: it is a defmacro in the prelude,
and the parser has nothing to say about it. What it expands to is the
same if-over-(not) this used to assert, and it is asserted where it can
be now -- test/programs/macro-unless.flan, through a compiler that has to
run the macro to get there. *)
(* The label is peeled off the head, and [break] carries the name it was
given rather than anything resolved — resolving it is the checker's job,
which is what makes it not a goto. *)
(match (parse1 "(while :outer c a)").e with
| While (Some "outer", _, [ _ ]) -> ()
| _ -> check "while takes a label" false);
(match (parse1 "(break :outer)").e with
| Break (Some "outer") -> ()
| _ -> check "break takes a label" false);
(match (parse1 "(continue)").e with
| Continue None -> ()
| _ -> check "bare continue" false);
(match (parse1 "(until c a)").e with
| While (None, { e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, [ _ ]) -> ()
| _ -> check "until -> while(not)" false);
(match (parse1 "(cond a 1 b 2 :else 3)").e with
| If (_, _, Some { e = If (_, _, Some { e = Int 3L; _ }); _ }) -> ()
| _ -> check "cond -> nested if with :else last" false);
(* and/or short-circuit, so they must not become calls. Both bind the test
to a temp and answer the temp on the deciding path -- Clojure's own
expansion, (let [t a] (if t b t)) for and and (let [t a] (if t t b))
for or -- which is what hands back the actual deciding operand rather
than a bare bool, and what evaluates the test exactly once (M2 queue
item 7 and its review pass).
The bound name, the bound value and the arm are all pinned, not just
the shape: a desugaring that dropped the temp and wrote the operand
into the arm twice, (if a b a), would still match a pattern that left
the binding as [_]. *)
(match (parse1 "(and a b)").e with
| Let ([ { bname; bval = { e = Var "a"; _ }; _ } ],
[ { e = If ({ e = Var t1; _ },
{ e = Var "b"; _ },
Some { e = Var t2; _ }); _ } ])
when bname = t1 && t1 = t2 -> ()
| _ -> check "and short-circuits" false);
(match (parse1 "(or a b)").e with
| Let ([ { bname; bval = { e = Var "a"; _ }; _ } ],
[ { e = If ({ e = Var t1; _ },
{ e = Var t2; _ },
Some { e = Var "b"; _ }); _ } ])
when bname = t1 && t1 = t2 -> ()
| _ -> check "or short-circuits" false);
(* ── Forms that bind or alter control are never calls ──────────── *)
(* This is the class that silently misparses: it reads fine as a call and
means something entirely different. *)
(match (parse1 "(dotimes [i 10] (f i))").e with
| Dotimes (None, "i",
{ dstart = None; dstop = { e = Int 10L; _ }; dstep = None },
[ _ ]) -> ()
| _ -> check "dotimes binds" false);
(* The written bound is always the *stop*, so the shorter forms are the
longer one with its defaults left off. *)
(match (parse1 "(dotimes [i 9 -1 -1] (f i))").e with
| Dotimes (None, "i",
{ dstart = Some { e = Int 9L; _ };
dstop = { e = Int (-1L); _ };
dstep = Some { e = Int (-1L); _ } },
[ _ ]) -> ()
| _ -> check "dotimes takes start, stop and step" false);
(match (parse1 "(fn [x y] x)").e with
| Fn ([ "x"; "y" ], [ _ ]) -> ()
| _ -> check "fn binds" false);
(match (parse1 "(defer (close f))").e with
| Defer [ _ ] -> ()
| _ -> check "defer is not a call" false);
(match (parse1 "(some (find x))").e with
| Unwrap (Usome, _) -> ()
| _ -> check "some is not a call" false);
(match (parse1 "(try (read x))").e with
| Unwrap (Utry, _) -> ()
| _ -> check "try is not a call" false);
(* ── Places: the fixed assignable list, not setf ───────────────── *)
(match (parse1 "(set x 1)").e with
| Set (Pvar "x", _) -> () | _ -> check "set local" false);
(match (parse1 "(set (.hp e) 1)").e with
| Set (Pfield (_, "hp"), _) -> () | _ -> check "set field" false);
(match (parse1 "(set (at g r c) 1)").e with
| Set (Pindex (_, [ _; _ ]), _) -> () | _ -> check "set index" false);
(match (parse1 "(set (deref p) 1)").e with
| Set (Pderef _, _) -> () | _ -> check "set deref" false);
parse_rejects "set on a call" "(set (foo x) 1)";
(* ── Field access and struct literals ──────────────────────────── *)
(match (parse1 "(.pos c)").e with
| Field ({ e = Var "c"; _ }, "pos") -> ()
| _ -> check "field access" false);
(match (parse1 "(Cursor {.src s .pos 0})").e with
| Struct ("Cursor", [ ("src", _); ("pos", _) ]) -> ()
| _ -> check "struct literal" false);
(match (parse1 "[1 2 3]").e with
| Arr [ _; _; _ ] -> () | _ -> check "array literal" false);
(* ── Types: brackets mean different things by position ─────────── *)
(* Read out of [praw], not [params]: a defn's parameter vector is carried
undecided until Check pairs it, so the parser no longer fills [params] at
all. Every type spelled here is one the parser still resolves on sight —
brackets and lists are types by their shape whatever the environment says
— so [Ptype] is the shape under test and a [Pname] here would mean the
spelling stopped being recognised as a type. *)
let ty src =
match parse_decl (Printf.sprintf "(defn f [x %s] ())" src) with
| { d = Defn { praw = Some [ Pname ("x", _); Ptype t ]; _ }; _ } -> t.t
| _ -> failwith "bad type test"
in
(match ty "[u8]" with Tslice _ -> () | _ -> check "[T] is a slice" false);
(match ty "[4 f32]" with
| Tarray (Lint 4L, _) -> () | _ -> check "[n T] is an array" false);
(match ty "[rows [cols u32]]" with
| Tarray (Lname "rows", { t = Tarray (Lname "cols", _); _ }) -> ()
| _ -> check "nested array with named lengths" false);
(match ty "(Ptr Cursor)" with
| Tapp ("Ptr", [ _ ]) -> () | _ -> check "(Ptr T)" false);
(* A map type is an application like (Ptr T) and (Vec T) now that the brace
spelling is gone: [Ast.Tmap] survives only as what [Cimport] builds. *)
(match ty "(Map string i32)" with
| Tapp ("Map", [ _; _ ]) -> () | _ -> check "(Map K V) is a map type" false);
(match ty "(Fn [a a] bool)" with
| Tfn ([ _; _ ], _) -> () | _ -> check "(Fn [T] R)" false);
(* ── Declarations ──────────────────────────────────────────────── *)
(match (parse_decl "(defn f [x i32] bool x)").d with
| Defn { ret = Some _; praw = Some [ _; _ ]; fbody = [ _ ]; _ } -> ()
| _ -> check "defn with return type" false);
(* () is the unit return type, and the body is what follows it. *)
(match (parse_decl "(defn f [x i32] () (g x))").d with
| Defn { ret = Some { t = Tname "Unit"; _ }; fbody = [ _ ]; _ } -> ()
| _ -> check "defn returning ()" false);
(* A lone () is the return type and an empty body, not a body of one form. *)
(match (parse_decl "(defn f [x i32] ())").d with
| Defn { ret = Some { t = Tname "Unit"; _ }; fbody = []; _ } -> ()
| _ -> check "defn returning () with no body" false);
(match (parse_decl "(defonce grid [4 u32])").d with
| Defvar ("grid", Some _, Zeroed, Once) -> ()
| _ -> check "defonce is ZII" false);
(match (parse_decl "(defonce buf [4 u8] uninit)").d with
| Defvar (_, _, Uninit, Once) -> ()
| _ -> check "defonce uninit opts out" false);
(* A three-element defonce whose third element cannot be a type is settled
here, by its shape, and comes out as the dyn global it means. *)
(match (parse_decl "(defonce score 0)").d with
| Defvar ("score", Some { t = Tname "dyn"; _ }, Init _, Once) -> ()
| _ -> check "a literal third element parses as a dyn initialiser" false);
(* A bare symbol could be either and parse does not know any names, so both
readings are carried out of here for [Check] to pick between. *)
(match (parse_decl "(defonce total foo)").d with
| Defvar ("total", Some { t = Tname "foo"; _ }, Ambiguous _, Once) -> ()
| _ -> check "a symbol third element parses undecided" false);
(match (parse_decl "(defonce v (Vec i32))").d with
| Defvar ("v", Some { t = Tapp ("Vec", _); _ }, Ambiguous _, Once) -> ()
| _ -> check "a parenthesised third element parses undecided" false);
(* [def] takes exactly the spellings [defonce] takes — the same parse arm
reads both — and differs in the one field that says what a re-run does.
One row per spelling, each asserting the [Every]. *)
(match (parse_decl "(def grid [4 u32])").d with
| Defvar ("grid", Some _, Zeroed, Every) -> ()
| _ -> check "def is ZII" false);
(match (parse_decl "(def buf [4 u8] uninit)").d with
| Defvar (_, _, Uninit, Every) -> ()
| _ -> check "def uninit opts out" false);
(match (parse_decl "(def score 0)").d with
| Defvar ("score", Some { t = Tname "dyn"; _ }, Init _, Every) -> ()
| _ -> check "a literal third element of def is a dyn initialiser" false);
(match (parse_decl "(def total foo)").d with
| Defvar ("total", Some { t = Tname "foo"; _ }, Ambiguous _, Every) -> ()
| _ -> check "a symbol third element of def parses undecided" false);
(match (parse_decl "(def counter i64 (start))").d with
| Defvar ("counter", Some { t = Tname "i64"; _ }, Init _, Every) -> ()
| _ -> check "a typed def with an initialiser" false);
(* The old name, refused with the migration in the message: what it is
called now, why the name, and both new spellings — each of which
compiles as written. *)
parse_rejects "the old defvar spelling names defonce"
"(defvar counter i64 7)"
~needle:"defvar is now called defonce — the name says what it does: it \
initialises once and keeps its value across re-runs. Write \
(defonce counter i64 7), or (def counter i64 7) if the value \
should follow the source on every re-run";
(match read "(defvar counter i64 7)" |> Parse.program with
| _ -> check "the old defvar spelling has a kind" false
| exception Loc.Error { Loc.kind; _ } ->
check "the old defvar spelling has a kind" (kind = "parse/defvar-renamed"));
(* A form with nothing after the keyword has nothing to echo, and the
answer must not be "(defonce )" — a malformed old form getting a
malformed new one as its fix. *)
parse_rejects "the old spelling with no arguments names the shapes"
"(defvar)"
~needle:"It is (defonce name Type value?), or (def name Type value?) if \
the value should follow the source on every re-run";
(match (parse_decl "(import rl \"vendor:raylib\")").d with
| Import ("rl", "vendor:raylib") -> () | _ -> check "import" false);
(* ── Unimplemented forms are rejected, not silently called ─────── *)
parse_rejects "handler-bind" "(handler-bind [E h] body)";
parse_rejects "restart-case" "(restart-case body (r [] 1))";
parse_rejects "loop/recur" "(loop [x 1] (recur x))";
(* ── Macros ─────────────────────────────────────────────────────── *)
(* A defmacro is a defn. There is no Ast.Defmacro and there is not going to
be one: a macro is [Form] -> Form, compiled by the same backend as
everything else, and what makes it a macro is that the expander calls it
at compile time rather than the program calling it at run time. *)
(match (parse_decl "(defmacro m [& args] (at args 0))").d with
| Defn { name = "m"; params = [ p ]; ret = Some r; _ } ->
(match p.fty.t, r.t with
| Tslice { t = Tname "Form"; _ }, Tname "Form" -> ()
| _ -> check "defmacro is [Form] -> Form" false)
| _ -> check "defmacro parses as a defn" false);
(* The declared type is the same whatever the author wrote as a parameter
list: the list is bindings over the one slice, opened by [macro_body], and
nothing below the parser learns there was a list at all. *)
(match (parse_decl "(defmacro m [[a b] c & rest] (at rest 0))").d with
| Defn { name = "m"; params = [ p ]; ret = Some r; _ } ->
(match p.fty.t, r.t with
| Tslice { t = Tname "Form"; _ }, Tname "Form" -> ()
| _ -> check "a parameter list is still [Form] -> Form" false)
| _ -> check "a macro with a parameter list parses as a defn" false);
(* Several parameters is the feature now. What is still refused is a list
that cannot be read: [&] with nothing or too much after it, a pattern that
binds nothing, a name bound twice, and a map pattern — which is deferred
rather than unimplemented by accident, see FIX.org. *)
parse_rejects "defmacro with a dangling &" "(defmacro m [a &] a)"
~needle:"& needs a name after it";
parse_rejects "defmacro with two names after &" "(defmacro m [& a b] a)"
~needle:"& takes one name and it is the last thing";
parse_rejects "defmacro with a pattern after &" "(defmacro m [& [a b]] a)"
~needle:"& binds one name for the rest of the arguments";
parse_rejects "defmacro with an empty pattern" "(defmacro m [a []] a)"
~needle:"binds nothing";
parse_rejects "defmacro binding a name twice" "(defmacro m [a [b a]] a)"
~needle:"a is bound twice in this parameter list";
parse_rejects "defmacro with a map pattern" "(defmacro m [{:keys [a]}] a)"
~needle:"map destructuring is not implemented in a macro's parameter list";
(* Shape and feature were separate mistakes and stay separate reasons. *)
parse_rejects "defmacro with no body" "(defmacro m [x])"
~needle:"defmacro is (defmacro name [param ...] body ...)";
parse_rejects "defmacro with no params" "(defmacro m x)"
~needle:"defmacro is (defmacro name [param ...] body ...)";
parse_rejects "defmacro with a non-name param" "(defmacro m [1] x)"
~needle:"a macro's parameter is a name or a [ ] pattern";
parse_rejects "defmacro in expression position" "(defn f [] () (defmacro m [] 1))"
~needle:"top-level declaration";
(* The tagged sum is [defdata] now. The old spelling is refused by name
rather than aliased, because the name is reserved for a type with
different semantics — a file that kept [defunion] must be made to say
which of the two it means instead of being quietly given one of them. *)
parse_rejects "the old defunion spelling"
"(defunion Shape [(Circle [r f32]) (Square [s f32])])"
~needle:"the tagged sum is defdata now";
(* The shape that would otherwise parse: two bare case names read as one
member of a type. Same refusal, and this is the one that matters — it
would have compiled. *)
parse_rejects "the old defunion spelling with payload-less cases"
"(defunion U [A B])"
~needle:"the tagged sum is defdata now";
(match read "(defunion U [A B])" |> Parse.program with
| _ -> check "the old spelling has a kind" false
| exception Loc.Error { Loc.kind; _ } ->
check "the old spelling has a kind" (kind = "parse/defunion-renamed"));
(* The return type is not optional. A void function writes (), and the
refusal says so rather than leaving someone to find it in a grammar. *)
parse_rejects "defn with no return type" "(defn f [] (g))"
~needle:"a function that returns nothing writes ()";
parse_rejects "defn with nothing after the parameters" "(defn f [])"
~needle:"The return type is not optional";
(* One spelling for unit, and the old one names the new one. *)
parse_rejects "the old Unit spelling in return position" "(defn f [] Unit (g))"
~needle:"unit is written (), not Unit";
parse_rejects "the old Unit spelling anywhere else"
"(defn f [g (Fn [i32] Unit)] () (g 1))"
~needle:"unit is written (), not Unit";
(* Quasiquote is a desugaring over Form, and it has already run by the time
the parser sees anything, so what is written here is what a macro body
actually compiles to: the prelude's three form-building functions and
nothing else. Spelled out rather than described, because the desugaring
*is* the contract with the prelude. *)
let desugars name src want =
match read src with
| [ f ] ->
let got = Form.to_string (Expand.quasiquote f) in
if got <> want then begin
incr failures;
Printf.printf "FAIL %s\n got: %s\n wanted: %s\n"
name got want
end
| _ -> check (name ^ ": one form") false
in
desugars "a quasiquoted list is form-cons over Form nodes" "`(a ~b)"
"(Form.List {.xs (form-cons (Form.Sym {.s \"a\"}) (form-cons b (form-nil)))})";
desugars "a splice is form-append" "`(a ~@bs)"
"(Form.List {.xs (form-cons (Form.Sym {.s \"a\"}) (form-append bs (form-nil)))})";
(* A vector keeps its bracket through the desugaring: a binding vector is the
commonest thing a macro builds and Form.Vec is not Form.List. *)
desugars "a quasiquoted vector stays a vector" "`[~x 1]"
"(Form.Vec {.xs (form-cons x (form-cons (Form.Int {.i 1}) (form-nil)))})";
(* Levels are not counted -- not by the reader, deliberately, and not here,
which is why the inner one is refused by name rather than given a meaning
nobody chose. *)
parse_rejects "a quasiquote inside a quasiquote" "(defn f [] Form `(a `(b)))"
~needle:"quasiquote inside a quasiquote";
(* Not a missing feature — an unquote outside a quasiquote is a mistake, and
the reader cannot catch it because it does not track where it is. *)
parse_rejects "unquote outside a quasiquote" "(defn f [] () ~x)"
~needle:"means nothing outside a quasiquote";
parse_rejects "splice where a splice makes no sense" "(defn f [] () (+ 1 ~@xs))"
~needle:"splices only into a list or a vector";
(* A splice with no bracket around it. The quasiquote is real here, so this
one is the desugaring's refusal and not the parser's. *)
parse_rejects "splice not inside a bracket" "(defn f [] Form `~@xs)"
~needle:"nothing here for it to splice into";
(* ── defenum: a value is optional, and autoincrements ──────────── *)
(* The numbers are the whole of what the form means, so they are what is
asserted on -- the parser has resolved them by the time a decl exists, and
nothing downstream can tell an implicit value from a written one. *)
let enum_values name src want =
match (parse_decl src).d with
| Defenum (_, ms) ->
let show vs = String.concat " " (List.map Int64.to_string vs) in
let got = List.map snd ms in
if got <> want then begin
incr failures;
Printf.printf "FAIL %s\n wanted: [%s]\n got: [%s]\n"
name (show want) (show got)
end
| _ -> check (name ^ ": parses as a defenum") false
in
enum_values "every member implicit" "(defenum E [A B C])" [ 0L; 1L; 2L ];
enum_values "every member explicit" "(defenum E [A 3 B 9 C -1])"
[ 3L; 9L; -1L ];
(* The mixed case is the point of the feature: an explicit value resets the
count, and the members below it carry on from there. *)
enum_values "an implicit member follows the explicit one above it"
"(defenum E [A B C 10 D])" [ 0L; 1L; 10L; 11L ];
(* The C idiom the explicit-duplicate rule exists for. *)
enum_values "a written duplicate is an alias and is kept"
"(defenum E [First 0 Second 1 Last 1])" [ 0L; 1L; 1L ];
enum_values "an enum with no members at all" "(defenum E [])" [];
(* A value autoincrement walked into is refused, because nothing in the
source chose it -- and the refusal has to name the *other* member, which
is the half a reader cannot see from the line that failed. Three needles
for one source: the message is only doing its job if both names, the
number, and the way out are all in it. *)
parse_rejects "an autoincrement onto a value already taken"
"(defenum E [A 0 B 1 C 0 D])"
~needle:"D has no value of its own, so it autoincrements to 1";
parse_rejects "the refusal names the member already holding the value"
"(defenum E [A 0 B 1 C 0 D])"
~needle:"which is the value B already has";
parse_rejects "the refusal says how to say the alias was meant"
"(defenum E [A 0 B 1 C 0 D])"
~needle:"Give D its value explicitly";
(* The member collided with is as often below as above: here it is [A], the
implicit one, that is refused, and a left-to-right check would pass it. *)
parse_rejects "an autoincrement onto a value written further down"
"(defenum E [A B 0])"
~needle:"A has no value of its own, so it autoincrements to 0";
(* A member is an i32 at run time, so a value outside i32 is refused where it
is resolved -- and the first of these is why the check has to happen
*before* the collision scan above rather than after it. 0 and 2^32 are
different int64s and the same i32, so the scan compares them, finds them
unequal, and passes a program in which both members are 0; the range
refusal is what stops it ever reaching that comparison. *)
parse_rejects "an explicit member too large for i32"
"(defenum E [A 0 B 4294967296])"
~needle:"the member B of E is 4294967296, which does not fit i32";
parse_rejects "the out-of-range refusal says what the range is"
"(defenum E [A 0 B 4294967296])"
~needle:"its members run from -2147483648 to 2147483647";
(* Nothing in the source wrote 2147483648, so the sentence has to say where
it came from before it can say it is wrong. *)
parse_rejects "an autoincrement off the top of i32"
"(defenum E [A 2147483647 B])"
~needle:"B of E has no value of its own, so it autoincrements to 2147483648";
(* The int64 end of the same problem. The member refused is [A], the one
whose value is actually wrong: were the range check to run after the
recursive call rather than before it, [Int64.add] would wrap past max_int
and the refusal would name B and the number min_int, which appears nowhere
in the program. This needle is the pin on that ordering. *)
parse_rejects "an explicit member at the top of i64 does not wrap"
"(defenum E [A 9223372036854775807 B])"
~needle:"the member A of E is 9223372036854775807, which does not fit i32";
(* Genuinely malformed input still says what a member is, in the grammar the
form now has. *)
parse_rejects "an enum member that is not a name" "(defenum E [1 A])"
~needle:"an enum member is a name, optionally followed by an integer";
parse_rejects "a defenum with no member vector" "(defenum E)"
~needle:"defenum is (defenum Name [member value? ...])";
(* ── Malformed syntax is caught with a location ────────────────── *)
parse_rejects "odd let bindings" "(let [a])";
parse_rejects "odd field pairs" "(defstruct S [a])";
parse_rejects "cond without body" "(cond a)";
parse_rejects "unknown top form" "(nope x)";
parse_rejects "break takes only a label" "(defn f [] () (break 1))"
~needle:"break is (break) or (break :label)";
parse_rejects "continue takes only a label" "(defn f [] () (continue x))"
~needle:"continue is (continue) or (continue :label)";
parse_rejects "a labelled while still needs a test" "(defn f [] () (while :o))"
~needle:"(while :label test body ...)";
parse_rejects "array with no type" "(defn f [] () (array 4))"
~needle:"array is (array COUNT TYPE)";
parse_rejects "array given a value, not a type" "(defn f [] () (array 4 5))"
~needle:"expected a type";
parse_rejects "array with a non-constant count" "(defn f [] () (array (+ 1 1) f32))"
~needle:"an array length is an integer or a constant's name";
(* The dimensions are read in [Parse], and this is the whole reason: without
the bracket being read here it would arrive as an ordinary argument, and
an [Arr] of two names is a perfectly good array literal wherever those
names are constants. So the bracket is required and its contents are
[len]s, refused by the same message [4 f32] gets. *)
parse_rejects "array-fill wants its dimensions in brackets"
"(defn f [] () (array-fill 3 0))"
~needle:"array-fill is (array-fill [n ...] value)";
parse_rejects "array-fill wants a fill value"
"(defn f [] () (array-fill [3]))"
~needle:"array-fill is (array-fill [n ...] value)";
parse_rejects "array-fill has no rank zero"
"(defn f [] () (array-fill [] 0))"
~needle:"array-fill is (array-fill [n ...] value)";
parse_rejects "an array-fill dimension is a length, not an expression"
"(defn f [] () (array-fill [(+ 1 1)] 0))"
~needle:"an array length is an integer or a constant's name";
parse_rejects "array-gen says its own name in its usage"
"(defn f [] () (array-gen 3 g))"
~needle:"array-gen is (array-gen [n ...] f)";
(* ── The corpus parses ─────────────────────────────────────────── *)
List.iter
(fun path ->
match read_file path |> Parse.program with
| _ -> ()
| exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL %s does not parse: %s: %s\n"
path (Loc.to_string loc) msg)
(* dune runs tests in _build/default/test/; the corpus is declared as a
dep in test/dune and lands at the build root. *)
[ "../calc-me.flan"; "../sand.flan" ];
Test_support.report ~label:"parse" ()
(* ═══ The return type is the slot, not a guess ══════════════ *)
(* (Option f64) and (Some 1) are the same s-expression shape, and the parser
used to tell them apart by looking the head up in a set of the file's type
names. The set had to be complete, it twice was not, and the failure was a
body form silently eaten as a return type. The slot is mandatory now, so
there is nothing to look up: whatever is written there is a type, and
whatever follows is the body. These pin that down from both sides. *)
(* Through [read], so the parser and checker tables are under the reader's
alarm too: their sources go through the same reader. *)
let program src = read src |> Parse.program
let () =
let open Ast in
(* Pick the defn out; some sources also declare a struct. *)
let ret_and_body name src =
match
List.find_map
(fun (d : decl) ->
match d.d with Defn fn -> Some fn | _ -> None)
(program src)
with
| Some { ret; fbody; _ } -> (ret <> None, List.length fbody)
| None -> check (name ^ ": has a defn") false; (false, 0)
in
check "the slot is the return type"
(ret_and_body "option" "(defn f [] (Option f64) (g))" = (true, 1));
(* The two that used to be decided by the table, and are decided by position
now: a constructor call and a prelude struct literal are body forms
because they are not in the slot, not because anything knows what they
are. [(Rune {.code 65})] is the one that was misparsed in every file in
the language. *)
check "a ctor after the slot is a body form"
(ret_and_body "some" "(defn f [] () (Some 1) (bar))" = (true, 2));
check "a prelude struct literal after the slot is a body form"
(ret_and_body "preludelit" "(defn f [] () (Rune {.code 65}) (bar))"
= (true, 2));
(* And what is *in* the slot is a type whether or not the parser could know
it: a struct declared further down the file, a package's type behind an
alias the parser has not resolved, a prelude type. None of these needed a
pre-pass any more. *)
check "a type declared later is still the return type"
(ret_and_body "later"
"(defn f [] Cursor (g)) (defstruct Cursor [pos i32])" = (true, 1));
check "a prelude type is the return type"
(ret_and_body "prelude" "(defn f [] Form (g))" = (true, 1));
check "an unknown name in the slot is still the return type"
(ret_and_body "unknown" "(defn f [] Nope (bar))" = (true, 1));
(* The body may be empty, which is the shape the old optional slot could not
produce: [(defn f [])] had nowhere to put the type. *)
check "a function with a return type and no body"
(ret_and_body "nobody" "(defn f [] ())" = (true, 0));
()
(* ── Checker: AST → typed IR ───────────────────────────────────────── *)
let checked src = program src |> Check.program
(* The environment a bare expression is checked against: the prelude and
nothing else, built once because building it is the expensive half and no
probe below declares anything. *)
let probe_env = lazy (snd (Check.program_with_env []))
(* The type an expression infers to, as the checker prints it. Enough to pin
down literal defaulting and every primitive's result.
Checked as an expression, the way a session checks one sent from the editor.
It used to be the type of [(defconst probe <src>)], which stopped working on
2026-09-20: a defconst's initialiser has to be a compile-time constant now
and most of the probes below are calls — (cast ...), (len ...), a
comparison. A defonce would not do either, since only the defconst form
takes no type. This asks [check] the question the wrapper was only ever a
way of asking. *)
let infers name src expected =
match
let form = List.hd (read src) in
let e = Parse.with_imported [] (fun () -> Parse.expr form) in
let t, _, _ = Check.expression (Lazy.force probe_env) e in
Types.to_string t.Tast.ty
with
| got ->
if got <> expected then begin
incr failures;
Printf.printf "FAIL %s\n src: %s\n got: %s\n wanted: %s\n"
name src got expected
end
| exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n"
name src (Loc.to_string loc) msg
| exception Watchdog.Timeout ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n the reader did not return\n"
name src
let accepts name src =
match checked src with
| _ -> ()
| exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n"
name src (Loc.to_string loc) msg
| exception Watchdog.Timeout ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n the reader did not return\n"
name src
(* [needle] pins the *reason* down: a rejection for the wrong reason is not a
passing test, and the unimplemented-feature errors are the whole point. *)
let rejects_check name ?needle src =
match checked src with
| _ ->
incr failures;
Printf.printf "FAIL %s: expected a type error\n src: %s\n" name src
| exception Loc.Error { Loc.dmsg = msg; _ } ->
(match needle with
| Some n
when not
(List.exists
(fun i -> String.length msg - i >= String.length n
&& String.sub msg i (String.length n) = n)
(List.init (max 1 (String.length msg)) Fun.id)) ->
incr failures;
Printf.printf "FAIL %s: wrong reason\n wanted: %s\n got: %s\n"
name n msg
| _ -> ())
(* Which reading a three-element [defonce] got, pinned by what the global came
out as rather than by what compiled: the two readings differ in the type and
in whether anything runs at startup, and a test that only asked "does this
check" would pass on either one. [zeroed] is the static reading — the
all-bytes-zero initialiser the linker writes — and its negation is the dyn
one, whose initialiser is an expression [Emit] lifts into the startup
function. *)
let defvar_reading name src gname ~ty ~zeroed =
match checked src with
| p ->
(match List.find_opt (fun (g : Tast.global) -> g.gname = gname) p.globals with
| Some g ->
let got = Types.to_string g.gty in
let got_zeroed =
match g.Tast.ginit.Tast.e with Tast.Zero _ -> true | _ -> false
in
if got <> ty || got_zeroed <> zeroed then begin
incr failures;
Printf.printf
"FAIL %s\n src: %s\n got: %s, %s\n wanted: %s, %s\n"
name src got (if got_zeroed then "zeroed" else "initialised")
ty (if zeroed then "zeroed" else "initialised")
end
| None ->
incr failures;
Printf.printf "FAIL %s: no global named %s\n src: %s\n"
name gname src)
| exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n"
name src (Loc.to_string loc) msg
(* What a [def] came out as: the type, the [grerun] that makes the startup
store unguarded, and the lifted initialiser. The last is a property
[defonce] has only when its initialiser is computed and [def] has always —
zero and literal included — because it is what a re-evaluation swaps: the
host's startup calls [global/<n>] through its cell, so the lifted function
is the one place an edited initialiser can land. An [uninit] def is the
documented exception and is not asked this. *)
let def_reading name src gname ~ty =
match checked src with
| p ->
(match List.find_opt (fun (g : Tast.global) -> g.gname = gname) p.globals with
| Some g ->
let got = Types.to_string g.gty in
let lifted =
match g.Tast.ginit.Tast.e with
| Tast.Call (f, []) -> f = "global/" ^ gname
| _ -> false
in
if got <> ty then begin
incr failures;
Printf.printf "FAIL %s: the type is %s, wanted %s\n src: %s\n"
name got ty src
end;
if not g.Tast.grerun then begin
incr failures;
Printf.printf "FAIL %s: not marked for re-run\n src: %s\n"
name src
end;
if not lifted then begin
incr failures;
Printf.printf
"FAIL %s: the initialiser is not the lifted global/%s\n src: %s\n"
name gname src
end
| None ->
incr failures;
Printf.printf "FAIL %s: no global named %s\n src: %s\n"
name gname src)
| exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n"
name src (Loc.to_string loc) msg
let () =
(* ── Literal defaulting and inference ──────────────────────────── *)
infers "int defaults to i32" "42" "i32";
infers "float defaults to f64" "0.5" "f64";
infers "byte is u8" "\\space" "u8";
infers "string" "\"hi\"" "string";
infers "bool" "true" "bool";
infers "arithmetic keeps kind" "(+ 1 2)" "i32";
infers "comparison is bool" "(< 1 2)" "bool";
infers "cast" "(f64 3)" "f64";
infers "array literal" "[1 2 3]" "[3 i32]";
infers "nested array" "[[1 2] [3 4]]" "[2 [2 i32]]";
(* (array COUNT TYPE): the constructor a [let] binding needs, because a let
has no type slot and [4 P] there is a two-element literal whose second
element is a name nothing declares. The type spelling is unchanged — the
two [infers] above still hold — and this is the position that had no way
to say it. *)
infers "array constructor" "(array 4 f32)" "[4 f32]";
infers "array of a struct" "(array 2 i32)" "[2 i32]";
infers "array of an array" "(array 2 [3 u8])" "[2 [3 u8]]";
(* (array-fill [r c] v): the same type at any rank, with the element type
taken from the fill value. Unlike [array] above this one is a value and
not a zero, which is what lets it be a defonce's initialiser — see
programs/array-fill.flan for what it puts in the elements. *)
infers "array-fill, rank 1" "(array-fill [5] 7)" "[5 i32]";
infers "array-fill, rank 2" "(array-fill [2 3] 0.5)" "[2 [3 f64]]";
infers "array-fill, rank 3" "(array-fill [2 3 4] true)" "[2 [3 [4 bool]]]";
(* A zero dimension is a legal array with no elements, and the fill loop
runs no passes over it. *)
infers "array-fill of nothing" "(array-fill [0] 1)" "[0 i32]";
infers "bytes of a string" "(bytes \"hi\")" "[u8]";
infers "bytes-view of a string" "(bytes-view \"hi\")" "[u8]";
infers "len is i32" "(len (bytes \"hi\"))" "i32";
infers "slice of a slice" "(slice (bytes \"hi\") 0 1)" "[u8]";
infers "slice of the whole" "(slice (bytes \"hi\"))" "[u8]";
infers "slice from n" "(slice (bytes \"hi\") 1)" "[u8]";
(* A string slices to a string and indexes to a byte. Not to a [u8]: the
result views bytes the program does not own, and a byte slice is
writable-looking. *)
infers "slice of a string" "(slice \"hi\" 0 1)" "string";
infers "whole of a string" "(slice \"hi\")" "string";
infers "string index is a u8" "(at \"hi\" 0)" "u8";
infers "parse text to f64" "(bytes->f64 (bytes \"1.5\"))" "f64";
(* An untyped integer constant is usable where a float is wanted, as in
Odin; the reverse is not. *)
infers "int literal into a float" "(+ 1 0.5)" "f64";
rejects_check "float literal into an int"
"(defn f [] i32 (+ 1 0.5))" ~needle:"expected i32";
(* ── Implicit widening, FIX.org 2026-09-20 ─────────────────────────
The lattice, pinned at its edges rather than row by row: what is in, what
is out, and the two boundaries that were a judgement call and could be
argued the other way — int-into-float admitting only the exact ones, and
equal-width cross-signedness admitting nothing.
[programs/widening.flan] is the other half and asserts the bits; these
assert which programs exist. *)
accepts "same signedness widens"
"(defonce a i32) (defn g [x i64] ()) (defn f [] () (g a))";
accepts "unsigned widens into a wider signed"
"(defonce a u32) (defn g [x i64] ()) (defn f [] () (g a))";
accepts "u8 widens into i16"
"(defonce a u8) (defn g [x i16] ()) (defn f [] () (g a))";
accepts "f32 widens into f64"
"(defonce a f32) (defn g [x f64] ()) (defn f [] () (g a))";
(* Narrowing is the thing that did not change, and the message has to say
narrowing rather than "these are different types" — it also names the
direction that needs nothing, because that is the half a reader coming
from the old rule will not expect. *)
rejects_check "narrowing is still refused, and says so"
"(defonce a i64) (defn g [x i32] ()) (defn f [] () (g a))"
~needle:"i64 into i32 can lose";
rejects_check "and says the other direction is free"
"(defonce a i64) (defn g [x i32] ()) (defn f [] () (g a))"
~needle:"i32 widens into i64 by itself";
rejects_check "float narrowing is refused too"
"(defonce a f64) (defn g [x f32] ()) (defn f [] () (g a))"
~needle:"f64 into f32 can lose";
(* Equal width across signedness: each holds values the other cannot, so
there is no direction at all and the message says that instead. *)
rejects_check "signed does not reach the same-width unsigned"
"(defonce a i32) (defn g [x u32] ()) (defn f [] () (g a))"
~needle:"neither widens into the other";
rejects_check "and a signed value never reaches an unsigned, wider or not"
"(defonce a i32) (defn g [x u64] ()) (defn f [] () (g a))"
~needle:"neither widens into the other";
(* Int into float, exact only. This is where the rule is tighter than
Odin's, which admits any integer into any float; i64 has values no f64
holds, so it is out, and the cast is written. *)
accepts "i32 reaches f64 exactly"
"(defonce a i32) (defn g [x f64] ()) (defn f [] () (g a))";
accepts "u32 reaches f64 exactly"
"(defonce a u32) (defn g [x f64] ()) (defn f [] () (g a))";
accepts "i16 reaches f32 exactly"
"(defonce a i16) (defn g [x f32] ()) (defn f [] () (g a))";
rejects_check "i64 does not reach f64 — above 2^53 it would round"
"(defonce a i64) (defn g [x f64] ()) (defn f [] () (g a))"
~needle:"(f64 x)";
rejects_check "i32 does not reach f32 — above 2^24 it would round"
"(defonce a i32) (defn g [x f32] ()) (defn f [] () (g a))"
~needle:"(f32 x)";
(* Containers are invariant: widening rewrites a value with a cast, and
there is no value to rewrite in a slice that does not own its bytes. *)
rejects_check "a slice of i32 is not a slice of i64"
"(defn g [s [i64]] ()) (defn f [t [i32]] () (g t))"
~needle:"expected [i64]";
(* The binary join. The wider operand decides, in either written order, and
an equal-width cross-signed pair still has nothing to decide on. *)
accepts "the wider operand decides, wider written first"
"(defonce a i64) (defonce b i32) (defn f [] i64 (+ a b))";
accepts "and decides when it is written second"
"(defonce a i64) (defonce b i32) (defn f [] i64 (+ b a))";
accepts "min and max join the same way"
"(defonce a i8) (defonce b i16) (defn f [] i16 (max a b))";
rejects_check "i32 and u32 have no join"
"(defonce a i32) (defonce b u32) (defn f [] i32 (+ a b))"
~needle:"neither widens into the other";
(* The literal rule is untouched, which is what keeps a u64 constant's
arithmetic at u64 rather than defaulting the 1 to an i32. *)
accepts "a literal still takes the other operand's type"
"(defconst fnv u64 0xcbf29ce484222325) (defn f [] u64 (+ fnv 1))";
(* The form DISCUSS.org's note named: an unannotated let of a u64 constant.
It binds a u64 and nothing about widening reaches it — a let with no type
has no expectation to widen against, and the constant is what it says. *)
accepts "an unannotated let of a u64 constant still binds a u64"
"(defconst fnv u64 0xcbf29ce484222325) \
(defn f [] u64 (let [h fnv] (* h 2)))";
(* A literal that does not fit is the program's mistake, not a pair of types
that failed to meet, so the join must not reconsider it — the operand it
would reconsider against is the one the literal was supposed to take its
width *from*. Both spellings: the literal written as the operand, and the
literal buried in one. *)
rejects_check "a literal that does not fit is still refused"
"(defonce m u8) (defn f [] u8 (+ m 300))" ~needle:"300 does not fit in u8";
rejects_check "and is refused inside an operand too"
"(defonce m u8) (defn f [] u8 (+ m (+ 300 1)))"
~needle:"300 does not fit in u8";
rejects_check "a float literal still cannot stand where an int is wanted"
"(defonce n i32) (defn f [] i32 (+ n 1.5))"
~needle:"found the float literal 1.5";
accepts "a literal that does fit still takes the operand's type"
"(defonce m u8) (defn f [] u8 (+ m 200))";
(* The join reconsiders a refused operand, and a reconsidered pass must leave
nothing behind. [scoped] cannot see to that — it puts the scope back on
the way out, which an exception does not take — so [binary] snapshots and
restores around each trial. Both symptoms of not doing it: a binding that
outlives the pass that made it, and the same binding *shadowing* a live
one, which is an uninitialised read in a program the compiler accepted. *)
(* The other half, and the one that bites harder: a form that opens a window
and closes it on the way out leaves it *open* when a trial inside it is
abandoned, and then refuses a program that is fine. Both windows — the
frames [handler-bind] establishes, and the loop [loop] pushes — with the
refusal each would wrongly produce written as the second half of the
test, so a regression shows up as the message coming back rather than as
a silent accept. *)
accepts "an abandoned trial inside handler-bind does not leave its frames up"
"(defonce n i32) (defonce w i64) \
(defn f [] i32 (println (+ n (handler-bind [] w))) (return 0))";
accepts "nor does one inside a loop leave the loop up"
"(defonce n i32) (defonce w i64) \
(defn f [] i32 (println (+ n (loop [i 0] w))) (defer (println 1)) 0)";
rejects_check "and a break outside every loop still says so plainly"
"(defonce n i32) (defonce w i64) \
(defn f [] i32 (println (+ n (loop [i 0] w))) (break) 0)"
~needle:"break is only allowed inside a loop";
rejects_check "an abandoned trial leaves no binding behind"
"(defonce n i32) (defonce w i64) \
(defn f [] i32 (println (+ n (let [q w] q))) (println q) 0)"
~needle:"unknown name q";
accepts "and does not shadow the binding it was nested in"
"(defonce n i32) (defonce w i64) \
(defn f [] i32 (let [t n] (println (+ n (let [t w] t))) (println t)) 0)";
(* Shifts are the carve-out: the value's type decides and the count widens
to it, never the reverse, because the result's width and the poison check
both belong to the value. *)
accepts "a narrower count widens to the value"
"(defonce v i64) (defonce n u8) (defn f [] i64 (<< v n))";
rejects_check "a wider count does not drag the value up with it"
"(defonce v u8) (defonce n i32) (defn f [] u8 (<< v n))"
~needle:"expected u8";
(* ── Bidirectional flow ────────────────────────────────────────── *)
accepts "return type types the literal" "(defn f [] u8 0)";
accepts "return type types None" "(defn f [] (Option f64) None)";
rejects_check "bare None has no type" "(defconst x None)"
~needle:"what None is an Option of";
accepts "param types the literal"
"(defn g [x u8] ()) (defn f [] () (g 3))";
rejects_check "wrong argument type"
"(defn g [x u8] ()) (defn f [] () (g 0.5))" ~needle:"expected u8";
rejects_check "wrong arity"
"(defn g [x u8] ()) (defn f [] () (g 1 2))" ~needle:"takes 1 argument";
rejects_check "wrong return type"
"(defn f [] bool 1)" ~needle:"expected bool";
(* What the mandatory slot bought: a mistyped type in return position is a
mistyped type. It used to be parsed as the first form of the body and
reported as an unknown *name*, which points at the wrong mistake. *)
rejects_check "a mistyped return type says which type was meant"
"(defn f [] f65 0.0)" ~needle:"did you mean f64";
rejects_check "if branches disagree"
"(defn f [] i32 (if true 1 true))" ~needle:"expected i32";
(* M2 queue item 7: a dyn if's scrutinee is truthiness-tested (Clojure's
rule -- nil and false are the only falsey values); a typed if keeps
needing a strict bool, exactly as before. The runtime survey is
programs/dyn-if-truthy.flan; these three pin the checker's own half. *)
accepts "typed if still takes a bare bool" "(defn f [] i32 (if true 1 2))";
rejects_check "typed if still refuses a non-bool scrutinee"
"(defn f [] i32 (if 1 1 2))"
~needle:"expected bool, found the integer literal 1";
(* Not just refused -- refused with the exact sentence a typed if has
always given here. check_truthy's dyn-or-bool check runs first, but a
value that is neither is re-checked with the old want:Bool so the
message a literal gets is the one it names itself with, not the type
it silently defaulted to along the way. *)
rejects_check "typed if still refuses None with its own message"
"(defn f [] i32 (if None 1 2))" ~needle:"expected bool, found None";
(* None is the other shape of "asked the wrong question first": checked
with no expectation at all it has no answer -- "nothing here says what
None is an Option of" -- rather than a wrong one, so check_truthy's
first attempt *raises* here instead of returning some non-bool,
non-dyn type. The re-check has to run on that path too. *)
accepts "dyn if accepts a non-bool dyn scrutinee"
"(defn f [x] dyn (if x 1 2))";
(* not, while: not [if] under the hood, so check_truthy is reached at
their own call sites (check.ml) rather than for free through
desugaring -- both take a non-bool dyn condition too. *)
accepts "dyn not accepts a non-bool dyn argument"
"(defn f [x] dyn (not x))";
accepts "dyn while accepts a non-bool dyn condition"
"(defn f [x] () (let [y x] (while y (set y false))))";
(* when, cond, and, or: sugar built out of [Ast.If] in parse.ml, so a
non-bool dyn condition reaches them with no separate check.ml case --
confirmed here rather than assumed. *)
accepts "dyn when accepts a non-bool dyn condition"
"(defn f [x] () (when x 0))";
accepts "dyn cond accepts a non-bool dyn condition"
"(defn f [x] dyn (cond x 1 :else 2))";
accepts "dyn and accepts a non-bool dyn operand"
"(defn f [x] i32 (let [y x] (if (and y true) 0 1)))";
accepts "dyn or accepts a non-bool dyn operand"
"(defn f [x] i32 (let [y x] (if (or y true) 0 1)))";
(* A bare keyword condition used to be checked with want:Bool from the
start, landing on the keyword arm's enum-or-refuse case and refusing
by name -- ":kw is an enum member where an enum is expected ... but
bool is expected here", since there was no enum in play. Checked with
no expectation first, as every scrutinee now is, it resolves as the
dyn keyword instead, and a dyn keyword is unconditionally truthy: a
typed if with a bare keyword condition now compiles, and always takes
the then branch. The author's call, recorded at check_truthy: lispy
truthiness wins here, the lost diagnostic is not brought back, and
this pins the new answer down so it does not regress by accident. *)
accepts "a typed if with a bare keyword condition now compiles"
"(defn f [] i32 (if :kw 1 2))";
(* ── Unknown types ─────────────────────────────────────────────── *)
(* A lowercase name is a type variable (plan.org, Types), so a mistyped
primitive would otherwise be reported as unimplemented generics and send
you to plan.org instead of to the character you mistyped. *)
rejects_check "a mistyped primitive" "(defn f [x f65] ())"
~needle:"did you mean f64?";
rejects_check "a transposed primitive" "(defn f [x stirng] ())"
~needle:"did you mean string?";
rejects_check "a mistyped struct"
"(defstruct Cursor [x i32]) (defn f [c Curser] ())"
~needle:"did you mean Cursor?";
(* [(defn f [x t] ())] used to be one parameter of an unimplemented generic
type and is now two parameters of type dyn — a lowercase name resembling
no type is a parameter, which is the whole of dynamic-by-default. The
milestone-5 reading is still reachable, by writing the type variable with
the sigil the signature binds it with. *)
(match checked "(defn f [x t] ())" with
| p ->
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "f") p.Tast.fns with
| Some { Tast.params = [ Types.Dyn; Types.Dyn ]; _ } -> ()
| _ -> check "an unannotated pair is two dyn parameters" false)
| exception _ -> check "an unannotated pair is two dyn parameters" false);
(* A bare lowercase name where a type is the only thing a slot can hold. It
used to be reported as unimplemented generics; generics are implemented,
and a lowercase name is a type variable only where a defn signature
introduced one with the sigil — a struct field is not such a place and
never will be, since only a signature binds. The message used to tell a
field to "write $elem in the parameter vector", and a field has no
parameter vector — the suggestion could not be followed where it was
printed. A field now gets its own sentence, naming the two things that
can actually be written there; the parameter-vector suggestion survives
where it works, which the return-type pin further down exercises. *)
rejects_check "a real type variable at a field" "(defstruct Holder [x elem])"
~needle:"a field is built at one type for every value";
rejects_check "and the field message offers what a field can hold"
"(defstruct Holder [x elem])"
~needle:"Write a concrete type here, or dyn to hold any value";
rejects_check "an unknown concrete type" "(defn f [x Widget] ())"
~needle:"unknown type Widget";
(* ── dyn, and what it does not do yet ──────────────────────────── *)
(* The pairing rule's own refusal. A name that is also a type's has no good
reading — taken as written it is a parameter called [i64] — and the
likelier intent is a pair the wrong way round, which the message names. *)
rejects_check "a parameter named after a type" "(defn f [i64 x] ())"
~needle:"cannot also be this parameter's name";
(* M2 item 3 lifted the container-into-dyn refusal: a [(Vec T)], a slice or
a fixed array with an i64/f64/bool element now crosses as a VIEW rather
than refusing — but only when its storage is permanent, a global's,
which review added after the first landing: a view's descriptor chases
the container's own address on every operation, and a container whose
address dies with a frame is exactly the dangling dyn value the dynamic
side refuses to hand back. Every accepting row below views a global. A
[(Map K V)] still refuses regardless of storage — it rides a
representation this milestone does not give a view — and so does any
container whose element is outside the three the view can hold. *)
accepts "a typed Vec boxed into dyn is a view, not a refusal"
"(defonce v (Vec i64) (vec-new i64))\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take v))";
accepts "a slice boxed into dyn is a view"
"(defonce xs [3 i64])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take (slice xs 0 3)))";
accepts "a fixed array boxed into dyn is a view"
"(defonce a [4 i64])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take a))";
accepts "a bool Vec's view"
"(defonce v (Vec bool) (vec-new bool))\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take v))";
accepts "an f64 Vec's view"
"(defonce v (Vec f64) (vec-new f64))\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take v))";
(* The element restriction is still refused, and by name: a string element
would need a dyn string's own boxing, whose payload is a pointer into
the collector's heap, planted where nothing will ever trace it. *)
rejects_check "a Vec of strings does not view into dyn yet"
"(defonce v (Vec string) (vec-new string))\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take v))"
~needle:"does not cross into dyn yet";
rejects_check "an i32 element is not one of the view's three"
"(defonce v (Vec i32) (vec-new i32))\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take v))"
~needle:"does not cross into dyn yet";
(* A typed (Map K V) is unrelated to item 3 and keeps its own refusal. *)
rejects_check "a typed Map still refuses into dyn"
"(defonce m (Map i64 i64) (map-new i64 i64))\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take m))"
~needle:"does not cross into dyn yet";
(* Which of the two refusals wins when both apply. A LOCAL (Vec string)
fails the lifetime guard and the element check both, and the element
one has to be the one that speaks: the lifetime message names
(defonce g ...) as the spelling that works, and for a string element
the global spelling is refused too, so the other order would hand back
advice that fails when taken. *)
rejects_check "a local Vec of strings gets the element refusal, not the \
lifetime one"
"(defn take [d dyn] i32 1)\n\
(defn main [] i32 (let [v (vec-new string)] (take v)))"
~needle:"does not cross into dyn yet";
(* ── The lifetime guard, added on review ─────────────────────────
A local, a parameter and a temporary all answer false to
[permanent_root], and each gets the same message rather than "cannot be
indexed" or some other accident of which path noticed. *)
rejects_check "a local Vec does not view into dyn — its frame ends"
"(defn take [d dyn] i32 1)\n\
(defn main [] i32 (let [v (vec-new i64)] (take v)))"
~needle:"does not cross into dyn as a view here";
rejects_check "a Vec parameter does not view into dyn"
"(defn take [d dyn] i32 1)\n\
(defn give [v (Vec i64)] i32 (take v))\n\
(defn main [] i32 0)"
~needle:"does not cross into dyn as a view here";
rejects_check "a fixed array local does not view into dyn"
"(defn take [d dyn] i32 1)\n\
(defn main [] i32 (let [a (array 4 i64)] (take a)))"
~needle:"does not cross into dyn as a view here";
(* A slice cut from a global is permanent; the same slice expression
rebound to a local first loses the trace back to it and is refused —
conservative rather than wrong, and the message says what does work. *)
accepts "a slice cut from a global inline is still permanent"
"(defonce xs [3 i64])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take (slice xs 0 3)))";
rejects_check "a slice rebound to a local loses the trace and is refused"
"(defonce xs [3 i64])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (let [s (slice xs 0 3)] (take s)))"
~needle:"does not cross into dyn as a view here";
(* An element of a global is permanent only when the global is an ARRAY.
An array's elements are inside the global's own storage; a slice's are
not — a global [[T]] holds ptr+len and nothing more, and what they
point at may be a frame that has already returned. The refusal row
below is one word different from the acceptance row above it, which is
the point: it is the [At] arm's demand for an array at the level being
indexed and nothing else deciding. Before that guard the refusal row
compiled and segfaulted with no diagnostic at all. *)
accepts "an element of a global array is permanent"
"(defonce rows [2 (Vec i64)])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take (at rows 0)))";
rejects_check "an element of a global slice is not permanent"
"(defonce sv [(Vec i64)])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take (at sv 0)))"
~needle:"does not cross into dyn as a view here";
(* [(at g i j)] is ONE typed node holding both indices, not two nested
ones, so a guard that reads the target's type alone sees level zero and
nothing after it. These two rows pin the multi-index spelling on both
sides: every level an array is permanent, and a slice at ANY level is
not — including the second, which the one-level guard accepted and
which then printed a dead frame's contents with exit 0. *)
accepts "an element of a global array of arrays is permanent"
"(defonce rows [2 [3 (Vec i64)]])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take (at rows 0 1)))";
rejects_check "an element reached through a slice level is not permanent"
"(defonce g [2 [[3 i64]]])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take (at g 0 1)))"
~needle:"does not cross into dyn as a view here";
(* A Vec behind a Ptr is refused even though some Ptrs really are
heap-durable — the checker cannot tell this one from a Ptr taken off a
local, and admitting one admits the other. *)
rejects_check "a Vec behind a Ptr does not view into dyn"
"(defn take [d dyn] i32 1)\n\
(defn use [p (Ptr (Vec i64))] i32 (take (deref p)))\n\
(defn main [] i32 0)"
~needle:"does not cross into dyn as a view here";
(* A bracket *literal* is not a typed container yet, and where a dyn is
wanted it builds the runtime's own vec instead — the lowering the map
literal's values ride on, and what makes {:xs [1 2]} mean what it
reads as. *)
accepts "a bracket literal where a dyn is wanted is a dyn vec"
"(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take [1 2 3]))";
(* ── Per-type descriptors — M2 item 2 ──────────────────────────
Both of these were refusals until the descriptors landed, and for one
reason: the collector's roots were frames, so a struct's dyn field was a
live value reachable only through memory the marker never walked. A type
that holds dyn words at static offsets now has a descriptor naming them,
and every slot, global and temporary holding one goes on the root stack
with that descriptor beside it — so the instance never has to carry a
pointer to its own type, which is what would have cost a header word. *)
accepts "a dyn field in a struct"
"(defstruct S [x dyn])\n(defn main [] i32 0)";
accepts "a dyn in a condition's payload"
"(defstruct Boom [what dyn])\n\
(defn main [] () (signal (Boom {.what 1})))";
(* Nested by value, which is the case the flattening is for: the inner
struct's dyn word appears in the outer's table at the sum of the two
offsets, and there is no second descriptor to follow at run time. *)
accepts "a dyn inside a struct inside a struct"
"(defstruct Inner [x dyn])\n\
(defstruct Outer [n i32 in Inner])\n\
(defn main [] i32 (let [o (Outer {.n 1 .in (Inner {.x 2})})] (.n o)))";
(* And a fixed array of them, which is the same flattening once per
element — an array is a value and its storage is the slot's. *)
accepts "a fixed array of structs with dyn fields"
"(defstruct S [x dyn])\n\
(defn main [] i32 (let [a (array 4 S)] (set (.x (at a 0)) 7) 0))";
(* A global, rooted before the startup function runs and never popped. *)
accepts "a global struct with a dyn field"
"(defstruct S [x dyn])\n(defonce s S)\n(defn main [] i32 0)";
(* What the descriptor still cannot reach, each by name. A typed container
owns storage of a length nothing static knows, so the dyn words of one
are not a list of offsets — that is the M2 queue's item 3, and it is a
different shape of descriptor on purpose. *)
rejects_check "a dyn field under a typed container"
"(defstruct S [x dyn])\n\
(defn main [] i32 (let [v (vec-new S)] 0))"
~needle:"no descriptor can find";
(* A data type's cases overlay one another, so which words are dyn depends
on the tag, which is a run-time question a static table cannot answer. *)
rejects_check "a dyn field in a data type's payload"
"(defdata D [(A [x dyn]) (B [n i32])])\n\
(defn main [] i32 (let [d (D.B {.n 1})] 0))"
~needle:"no descriptor can find";
(* An Option's payload exists only under the tag. A None's words are zero
and marking them would be harmless, but that is how this compiler happens
to build one and not something the type says. *)
(* And the one cap, which is arithmetic rather than representation: an
array's offsets are flattened one element at a time, so a big enough
array would be a megabyte of static table. The repeat form that avoids
it is the typed container view's machinery, so this says so. *)
rejects_check "an array too big for a flattened descriptor"
"(defstruct S [x dyn])\n\
(defn main [] i32 (let [a (array 5000 S)] 0))"
~needle:"the most this compiler will write out";
(* And the length that wrapped the multiplication rather than tripping the
cap: an honest product of this by one is negative, so the test read as
under the cap, the declaration was accepted, and the emitter then sat
building the offset list until something killed it. The count is
saturated now. *)
(* And the other end of the same arm: negative rather than enormous. It
reaches the multiplication as a small number, which is exactly what the
cap must not be handed. *)
rejects_check "a negative array length"
"(defstruct S [x dyn])\n\
(defonce neg [-1 S])\n\
(defn main [] i32 0)"
~needle:"the most this compiler will write out";
rejects_check "an array length that overflows the flattened count"
"(defstruct S [x dyn])\n\
(defonce big [4611686018427387904 S])\n\
(defn main [] i32 0)"
~needle:"the most this compiler will write out";
(* A pointer is not storage. A vector of pointers to structs that hold dyn
holds no dyn words of its own, and refusing it said the opposite. *)
accepts "a typed container of pointers to a dyn-bearing struct"
"(defstruct Cond [why dyn])\n\
(defn f [v (Vec (Ptr Cond))] i32 0)\n\
(defn main [] i32 0)";
(* The one honest hole, named at the boundary where it opens — and it is a
question about *ownership*, not about shape, so the two directions get
asked different things.
A return, and everything reachable from it however many pointers deep, is
C's storage. All three shapes, because a check that followed one pointer
and stopped let the other two through: each of them stores a dyn into C
memory and reads it back after a collection, and each is a
heap-use-after-free in flan_dyn_tag under ASan. *)
(* Each on the *type* it names and not on the shared half of the sentence:
three rows against one needle would all still pass if the message named
the wrong shape, which is the one thing these rows exist to tell apart. *)
rejects_check "a pointer to a dyn-bearing struct returned from C"
"(defstruct S [x dyn])\n\
(declare grab [] (Ptr S) \"c_grab\")\n\
(defn main [] i32 0)"
~needle:"the return type of grab (the C symbol c_grab) is (Ptr S)";
rejects_check "a pointer to a pointer to one, returned from C"
"(defstruct S [x dyn])\n\
(declare grab [] (Ptr (Ptr S)) \"c_grab\")\n\
(defn main [] i32 0)"
~needle:"is (Ptr (Ptr S)), and a dyn is reachable through it";
(* The shape shim.ml's own advice tells people to write for an aggregate
result, which is what made this one worth having a test of its own. *)
rejects_check "a pointer to a slice of them, returned from C"
"(defstruct S [x dyn])\n\
(declare grab [] (Ptr [S]) \"c_grab\")\n\
(defn main [] i32 0)"
~needle:"is (Ptr [S]), and a dyn is reachable through it";
(* And an out-parameter, which is a return wearing a parameter's clothes:
the cell is this compiler's, the pointer C writes into it is C's. *)
rejects_check "an out-parameter handing back a pointer to one"
"(defstruct S [x dyn])\n\
(declare out [p (Ptr (Ptr S))] () \"c_out\")\n\
(defn main [] i32 0)"
~needle:"what lies below it is C's";
(* The other direction stays writable, and this is the half a shape-only
rule got wrong. A foreign parameter receives the address of a *place* —
a frame slot, a global, an array inside one — and every one of those is
rooted with its descriptor and marked for the whole call. So the
read-only borrow and the slice argument are ordinary and allowed. *)
accepts "a pointer to a dyn-bearing struct passed to C"
"(defstruct S [x dyn])\n\
(declare inspect [p (Ptr S)] () \"c_inspect\")\n\
(defn main [] i32 0)";
accepts "a slice of them passed to C"
"(defstruct S [x dyn])\n\
(declare take [s [S]] () \"c_take\")\n\
(defn main [] i32 0)";
(* A pointer field back to the type's own name, which is the shape that had
no row and needed four passes to surface. The two walks at this boundary
ask different questions — one counts a direct dyn and the other does not
— and they shared a visited set, so [Node] was marked seen on the way
down and then pruned from the question below the pointer. It came out
accepted while the same thing written as two types came out refused,
which is the tell. C hung a malloc'd node off [next], put a dyn in it and
read it back after a hundred thousand allocations: heap-use-after-free in
flan_dyn_tag, freed by gc_sweep. *)
rejects_check "a struct with a pointer to itself and a dyn field"
"(defstruct Node [next (Ptr Node) x dyn])\n\
(declare walk [p (Ptr Node)] () \"c_walk\")\n\
(defn main [] i32 0)"
~needle:"is (Ptr Node), and a dyn is reachable through it";
(* And the same fact through a cycle of two, because a fix that only reset
the set for a self-reference would pass the row above and fail this. *)
rejects_check "two structs pointing at each other, with a dyn in one"
"(defstruct A [b (Ptr B) x dyn])\n\
(defstruct B [a (Ptr A)])\n\
(declare walk [p (Ptr A)] () \"c_walk\")\n\
(defn main [] i32 0)"
~needle:"is (Ptr A), and a dyn is reachable through it";
(* The other side of resetting the set: it must still terminate, and it must
not start refusing a recursive shape with no dyn anywhere under it. Both
of these walk a cycle and both are ordinary. *)
accepts "a self-referential struct with no dyn in it"
"(defstruct L [next (Ptr L) n i64])\n\
(declare walk [p (Ptr L)] () \"c_walk\")\n\
(defn main [] i32 0)";
accepts "a cycle of two with no dyn in either"
"(defstruct M [other (Ptr N) n i64])\n\
(defstruct N [back (Ptr M)])\n\
(declare walk [p (Ptr M)] () \"c_walk\")\n\
(defn main [] i32 0)";
rejects_check "a dyn field under an Option"
"(defstruct S [x dyn])\n\
(defn f [] (Option S) None)\n\
(defn main [] i32 0)"
~needle:"no descriptor can find";
(* And the C boundary, which is the one that would otherwise pass silently:
a dyn is one word and would cross as an integer, and nothing on the other
side can ask what the word means. *)
rejects_check "a dyn crossing to C"
"(declare c-take [d dyn] () \"c_take\")"
~needle:"does not cross to C";
(* ── dyn maps, keywords and nil — M2 item 1 ────────────────────── *)
(* The literal parses and checks: braces whose first form is not a .field
symbol are a dyn map, in binding position and as a call argument alike —
the argument spelling used to be swallowed by the struct-literal rule. *)
accepts "a map literal in a binding"
"(defn main [] i32 (let [m {:a 1 :b \"two\"}] (len m)))";
accepts "a map literal as an argument"
"(defn take [d dyn] i32 1)\n(defn main [] i32 (take {:a 1}))";
accepts "the empty braces are an empty map"
"(defn main [] i32 (let [m {}] (len m)))";
accepts "map literals nest, and brackets inside are dyn vecs"
"(defn main [] i32 (let [m {:xs [1 2] :inner {:c 2.5}}] (len m)))";
rejects_check "a map literal with an odd number of forms"
"(defn main [] i32 (let [m {:a 1 :b}] (len m)))"
~needle:"odd number of forms";
(* The struct spelling is untouched on both of its sides: bare braces
opening on a .field are still a struct field list and not a map, and
(Type {.field v}) still builds one. What changed is *where* the two
rows below are refused — at checking now, not at parsing, because a
.field-keyed brace with a type expected of it is a struct literal and
only the checker can see the expectation. Neither position has one: a
let binding takes its type from its value, and a form that is not a
body's last is not the return value. It is untouched at the head of a
defn body too, single-form or not — [constraints] (parse.ml) leaves a
[.field]-first map alone precisely so this dedicated message, not "a
constraint map is keyword/value pairs", is what a program gets there. *)
rejects_check "bare struct-shaped braces with nothing to infer from"
"(defn main [] i32 (let [m {.x 1}] 0))"
~needle:"does not say which struct it builds";
rejects_check "bare struct-shaped braces at a defn body's head, too"
"(defn main [] i32 {.x 1} 0)"
~needle:"does not say which struct it builds";
accepts "a struct literal still builds"
"(defstruct P [x i32])\n\
(defn main [] i32 (let [p (P {.x 1})] (.x p)))";
(* And the {:where ...} constraint map is still peeled off a defn body —
it opens on :where, which is what now tells it from a map literal
standing as the body's first form. *)
accepts "a where clause is still a constraint map"
"(defn biggest [a $t b $t] $t {:where (ordered? $t)} (if (> a b) a b))\n\
(defn main [] i32 (biggest 1 2))";
(* A where clause with nothing after it is what a moved closing paren
produces -- the body fell outside the defn. It stays a constraint map
even alone, so this is "no body", not the "unknown function ordered?"
it used to print from a stray predicate read as ordinary body code. *)
rejects_check "a where clause with no body after it"
"(defn ordered? [x] bool true)\n\
(defn mx [a $t b $t] $t {:where (ordered? $t)})"
~needle:"has no body";
(* A keyword-keyed map at the head of a multi-form body, other than
:where, is a typo almost every time -- its value is discarded, and a
map literal has no reason to sit somewhere its value goes unused. An
empty map there gets its own message, since it has no key for [keys]
to name. *)
rejects_check "a discarded keyword-keyed map at a defn body's head"
"(defn main [] i32 {:a 1} 0)"
~needle:"is not a key a defn's constraint map takes";
rejects_check "a discarded empty map at a defn body's head"
"(defn main [] i32 {} 0)"
~needle:"an empty map literal here is discarded";
rejects_check "a discarded string-keyed map at a defn body's head"
"(defn main [] i32 {\"a\" 1} 0)"
~needle:"keyword/value pairs — found";
(* Not discarded, because nothing follows it: the map IS the single-form
body, a real dyn value and not a mistake to flag. *)
accepts "a keyword-keyed map as a defn's whole body"
"(defn f [] dyn {:a 1})\n(defn main [] i32 0)";
accepts "an empty map as a defn's whole body"
"(defn f [] dyn {})\n(defn main [] i32 0)";
(* :where does not get the same exception :a and {} get above -- it is
peeled unconditionally, even as a defn's whole single-form body, so
{:where 1} here is read as a constraint map with a malformed predicate
and not as a dyn map with one key named :where. That does narrow the
language: a dyn map genuinely wanting :where as a key has no way to
write one at a defn body's head (it still can anywhere else -- (let
[m {:where 1}] m) is untouched, since [constraints] only ever looks at
a defn's own body). The trade is deliberate: :where is what catches a
moved closing paren leaving a stray predicate as ordinary body code
(see above), and that only works if :where means constraint map with no
exceptions, single-form body included. Pinned so the next edit to this
arm has to notice it is choosing to narrow the language again, rather
than finding out from a bug report. *)
rejects_check ":where is reserved at a defn body's head, even alone"
"(defn f [] dyn {:where 1})\n(defn main [] i32 0)"
~needle:"a where predicate is";
(* Keywords: dyn where nothing else is asked, still an enum member where an
enum is, and refused where a concrete non-dyn type is wanted. *)
accepts "a keyword is a dyn value"
"(defn main [] i32 (let [k :foo] (if (= k :foo) 0 1)))";
accepts "a keyword where an enum is expected still resolves"
"(defenum Axis [x y])\n\
(defn pick [a Axis] i32 1)\n\
(defn main [] i32 (pick :x))";
rejects_check "a keyword where an i32 is expected"
"(defn take [n i32] i32 n)\n(defn main [] i32 (take :foo))"
~needle:"but i32 is expected here";
accepts "keyword takes a string"
"(defn main [] i32 (let [k (keyword \"foo\")] (if (= k :foo) 0 1)))";
rejects_check "keyword takes bytes, not a number"
"(defn main [] i32 (let [k (keyword 3)] 0))"
~needle:"keyword takes a string";
(* nil is a literal now — the dyn absence value, and what (get m k) answers
for a key a map does not hold. It is always dyn. *)
accepts "nil is a dyn literal"
"(defn main [] i32 (let [n nil] (if (= n nil) 0 1)))";
(* Superseded by the M2 item 4 boundary below: a literal [nil] at a bare
typed want is now refused by name, at compile time, rather than by the
generic dyn-boundary message — see "nil at a bare T is refused at
compile time" further down. *)
(* ── nil <-> None at (Option T), M2 queue item 4 ──────────────────
nil and None are the same absence at the one boundary where both are
meaningful. The three sites a dyn can be unboxed at own nil's half of
it too: a parameter, a return type and a global's declared type. *)
accepts "nil becomes None at a return type"
"(defn f [] (Option i64) nil)\n\
(defn main [] i32 (match (f) (Some _) 1 None 0))";
accepts "nil becomes None at a parameter"
"(defn h [o (Option i64)] i32 (match o (Some _) 1 None 0))\n\
(defn main [] i32 (h nil))";
accepts "nil becomes None at a global's declared type"
"(defonce ov (Option i64) nil)\n\
(defn main [] i32 (match ov (Some _) 1 None 0))";
(* The other direction: None crossing into dyn is nil, and a program can
compare the result the same way it compares any other nil. *)
accepts "None becomes nil crossing into dyn"
"(defn g [] dyn None)\n\
(defn main [] i32 (if (= (g) nil) 0 1))";
(* A bare T has no None to become. This nil is the one the checker can see
— the literal, right where the mismatch is — so it is refused here
rather than waiting for the run-time trap the same mismatch reaches for
one call deeper (dyn-not-visibly-nil case, test_acceptance.ml). *)
rejects_check "nil at a bare T is refused at compile time"
"(defn take [n i32] i32 n)\n(defn main [] i32 (take nil))"
~needle:"nil has no None to become";
rejects_check "nil at a bare T is refused at compile time, return position"
"(defn f [] i64 nil)\n(defn main [] i32 0)"
~needle:"nil has no None to become";
(* (Some nil) would make nil and None the same case of an (Option dyn), so
it cannot be built — refused at compile time when the argument is the
literal nil, which is exactly what "the checker can see" means here. *)
rejects_check "(Some nil) is refused at compile time"
"(defn main [] i32 (let [o (Some nil)] 0))"
~needle:"(Some nil) cannot be built";
(* The same refusal where the argument's own want is already (Option T)'s
inner type — a function parameter typed (Option i64), say. [nil] checked
against that inner type directly would hit [expect]'s bare-T refusal
first ("wrap the type in Option"), which is nonsense here: the type
already is one. A regression for the review that found it. *)
rejects_check "(Some nil) at an already-Option want gets Some's message, \
not expect's bare-T one"
"(defn f [o (Option i64)] i64 (match o (Some v) v None -1))\n\
(defn main [] i32 (f (Some nil)))"
~needle:"(Some nil) cannot be built";
(* (Option (Option T)) is legal on the typed side — nothing above refuses
the type — but boxing its Some of an inner None would box that None as
nil, indistinguishable from the outer None, so the crossing into dyn
does not exist for it. *)
rejects_check "(Option (Option T)) does not cross into dyn"
"(defn f [] (Option (Option i64)) None)\n\
(defn g [] dyn (f))\n\
(defn main [] i32 0)"
~needle:"does not cross into dyn";
(* (Option dyn): the payload is already dyn, so [box_option]/[unbox_option]
treat it as the identity — no [box]/[unbox] call, just the tag test —
and the only thing that has to hold is that the payload is never nil,
which is (Some nil)'s refusal above and not this boundary's.
That is what the code does; it is not yet what a program can hold. A
value of type (Option dyn) is refused wherever it would need a GC root
— global, parameter, return or local slot — by the *separate*,
pre-existing per-type-descriptor pass (M2 item 2): the collector marks a
struct's dyn fields by their byte offsets, and (Option dyn)'s payload
has none, the same reason (Vec dyn) and (Map K dyn) are refused today.
Item 4 does not lift that gate; it only makes sure the boundary is
already correct for the day items 2/3 do. The refusal below is that
gate, not a nil-boundary message — proof the two are not tangled. *)
rejects_check "(Option dyn) is a legal type but not yet a storable value"
"(defn k [] (Option dyn) None)\n(defn main [] i32 0)"
~needle:"no descriptor can find";
(* A full round trip through the boundary: a typed i64 boxed into dyn at
one annotated site, then read back as an (Option i64) at another. *)
accepts "a value round-trips through dyn and (Option T)"
"(defn box-it [x i64] dyn x)\n\
(defn unbox-opt [d dyn] (Option i64) d)\n\
(defn main [] i32\n\
\ (match (unbox-opt (box-it 42)) (Some x) (if (= x 42) 0 1) None 1))";
(* A numeric cast opens a dyn box — FIX.org 2026-09-20. The checker's half
is small: every cast name the language has admits a dyn operand now, and
that is what these rows are. What the cast then *does* is a run-time
question and lives in test_acceptance.ml's dyn-cast rows — the same split
as the typed boundary, whose refusal is here and whose trap is there. *)
accepts "every numeric cast takes a dyn"
"(defn d [] dyn 7)\n\
(defn main [] i32\n\
\ (do (i64 (d)) (i32 (d)) (i16 (d)) (i8 (d))\n\
\ (u64 (d)) (u32 (d)) (u16 (d)) (u8 (d))\n\
\ (f64 (d)) (f32 (d))\n\
\ 0))";
(* And a cast the checker could already see was wrong is wrong for the same
reason it was: dyn is admitted by name, not by the numeric test going
soft. A string is not a number and never reaches a runtime tag. *)
rejects_check "a cast still refuses a non-numeric typed operand"
"(defn main [] i32 (i64 \"hi\"))"
~needle:"converts a number";
(* The *generic* cast — [($t x)] in a body whose signature says
[{:where (numeric? $t)}] — is a separate arm in the checker and did not
grow a dyn case. It did not need one: the operand's type there is what
the bound admits, and [numeric?] does not admit dyn, so a dyn cannot
reach that arm to begin with. The refusal is the bound's, at the call
that would have instantiated it. *)
rejects_check "a generic cast's operand is still what its bound admits"
"(defn conv [x $t] $t {:where (numeric? $t)} (t x))\n\
(defn d [] dyn 7)\n\
(defn main [] i32 (i32 (conv (d))))"
~needle:"numeric?";
(* The map operations ride the words the typed map already owns: get, put,
len, has-key? — one question, one word, on both sides. has-key? on a
typed map still checks against its K. *)
accepts "get, put, len and has-key? over a dyn map"
"(defn main [] i32\n\
\ (let [m {:a 1}]\n\
\ (put m :b 2)\n\
\ (if (has-key? m :b) (len m) 0)))";
accepts "has-key? still serves the typed map"
"(defn main [] i32\n\
\ (let [m (map-new string i32 (heap-allocator))]\n\
\ (if (has-key? m \"a\") 1 0)))";
(* The x86 backend used to refuse dyn by name, and what was pinned here was
the sentence it refused with. It compiles it now, which is the thing this
row is for: that backend is the dev daemon's default and dyn is the
iteration feature, so a refusal there was the two of them never meeting.
The assertion is the same shape inverted — it lowers, and it emits the
root discipline while it does. The roots are asserted rather than only
the absence of an exception, because a build that emits the calls and
forgets the roots is exactly the failure that passes every output test:
the collector simply never hears about a value.
Which programs *agree* between the backends is the @x86 sweep's question
and all five dyn programs are in it; this one only has to know that the
lowering exists. *)
let dyn_asm =
X86.program ~checks:true
(Check.program_all
(program "(defn add [x y] dyn (+ x y))\n\
(defn main [] () (print (add 1 2)))"))
in
check "the x86 backend lowers dyn"
(contains dyn_asm "flan_dyn_add");
check "the x86 backend roots its dyn values"
(contains dyn_asm "flan_dyn_root_push"
&& contains dyn_asm "flan_dyn_root_pop");
(* The site travels with the operands, on this backend as on the other: a
dyn arithmetic trap is the type error of a dynamic program, and it used
to print with no file and no line. This backend writes a string constant
as [.byte] hex rather than as text, so the needle is the encoding of the
":1:21" that ends the site of the [(+ x y)] above — the path in front of
it is the test runner's temporary directory and is not pinnable. *)
check "the x86 backend hands the dyn operators their site"
(contains dyn_asm "0x3a,0x31,0x3a,0x32,0x31");
(* And a program with no dyn in it emits not one byte of any of it, which is
what lets the sweep's other MATCHes stand as a regression check on this
lane rather than being re-measured by it. *)
check "a dyn-free program pays nothing for the collector"
(let plain =
X86.program ~checks:true
(Check.program_all
(program "(defn add [x i32 y i32] i32 (+ x y))\n\
(defn main [] () (print (add 1 2)))"))
in
(not (contains plain "flan_dyn_root_push"))
&& not (contains plain "flan_gc_init"));
(* ── Static bounds ─────────────────────────────────────────────── *)
(* A literal index into a fixed array is known now, so it is an error now
rather than a trap later; everything else is the emitted bounds check's
job. A [defconst] is a global in the typed IR, not a folded constant, so
it deliberately stays a runtime trap. *)
let arr = "(defonce a [3 i32]) " in
accepts "last valid index" (arr ^ "(defn f [] i32 (at a 2))");
rejects_check "index past the end" (arr ^ "(defn f [] i32 (at a 3))")
~needle:"out of bounds for length 3";
rejects_check "negative index" (arr ^ "(defn f [] i32 (at a -1))")
~needle:"is negative";
rejects_check "index past the end of an inner dimension"
"(defonce g [2 [4 i32]]) (defn f [] i32 (at g 1 4))"
~needle:"out of bounds for length 4";
accepts "a variable index is checked at runtime, not here"
(arr ^ "(defn f [i i32] i32 (at a i))");
accepts "a defconst index is not folded"
("(defconst k 9) " ^ arr ^ "(defn f [] i32 (at a k))");
(* A slice bound may sit one past the end; an index may not. *)
accepts "slice ending at len" (arr ^ "(defn f [] [i32] (slice a 1 3))");
accepts "empty slice at len" (arr ^ "(defn f [] [i32] (slice a 3 3))");
rejects_check "slice bound past len" (arr ^ "(defn f [] [i32] (slice a 1 4))")
~needle:"out of bounds for length 3";
rejects_check "negative slice bound" (arr ^ "(defn f [] [i32] (slice a -1 2))")
~needle:"is negative";
rejects_check "reversed slice" (arr ^ "(defn f [] [i32] (slice a 2 1))")
~needle:"runs backwards";
(* A slice has no static length, so only the two target-independent rules
apply to one. *)
rejects_check "reversed slice of a slice"
"(defn f [s [u8]] [u8] (slice s 2 1))" ~needle:"runs backwards";
accepts "a slice's length is not known here"
"(defn f [s [u8]] [u8] (slice s 0 99))";
(* The short arities are the three-argument form written out, so they are
held to the same standard: the implicit hi on a fixed array is the same
literal (len a) folds to, and a lo past it is refused here and not later.
A 1-argument slice cannot fail either check — 0 and the length are both
in range by construction — so what is pinned about it is that it is
accepted on each of the three things slice takes. *)
accepts "the whole of an array" (arr ^ "(defn f [] [i32] (slice a))");
accepts "the tail of an array" (arr ^ "(defn f [] [i32] (slice a 3))");
rejects_check "tail past len" (arr ^ "(defn f [] [i32] (slice a 4))")
~needle:"out of bounds for length 3";
rejects_check "negative tail" (arr ^ "(defn f [] [i32] (slice a -1))")
~needle:"is negative";
accepts "the whole of a slice" "(defn f [s [u8]] [u8] (slice s))";
accepts "the tail of a slice" "(defn f [s [u8]] [u8] (slice s 2))";
rejects_check "slice with no target" "(defn f [] i32 (slice))"
~needle:"(slice a lo hi)";
rejects_check "slice of four" (arr ^ "(defn f [] [i32] (slice a 0 1 2))")
~needle:"given 4 arguments";
rejects_check "slice of something with no elements"
"(defn f [n i32] [i32] (slice n))"
~needle:"slice takes an array, a slice, a string or a Vec";
(* A Vec is the fourth thing slice takes, and it is the one that borrows:
the view is of storage the Vec owns and a push may move it. That is a
rule about the push and is written down beside the push; here what is
pinned is that all three arities reach a Vec, the two-argument one
included — it had no spelling at all while the Vec had a name of its
own. There is no static length to check a bound against, so the only
refusal left is the literal pair that runs backwards. *)
let vec = "(defn f [v (Vec i32)] " in
accepts "the whole of a Vec" (vec ^ "[i32] (slice v))");
accepts "the tail of a Vec" (vec ^ "[i32] (slice v 2))");
accepts "a range of a Vec" (vec ^ "[i32] (slice v 1 3))");
accepts "a Vec bound is not known here" (vec ^ "[i32] (slice v 0 9999))");
rejects_check "reversed slice of a Vec" (vec ^ "[i32] (slice v 2 1))")
~needle:"runs backwards";
rejects_check "slice of a Vec of four"
(vec ^ "[i32] (slice v 0 1 2))") ~needle:"given 4 arguments";
(* A negative bound reads the same on a Vec as on an array, and it has to be
asked of what the reader wrote: the implicit hi the short forms pass *is*
a -1, so a check on the finished pair would refuse (slice v) itself. The
one-argument form is the case that proves it runs in the right place. *)
rejects_check "negative Vec tail" (vec ^ "[i32] (slice v -1))")
~needle:"is negative";
rejects_check "negative Vec lo" (vec ^ "[i32] (slice v -1 2))")
~needle:"is negative";
rejects_check "the sentinel is not a bound anybody may write"
(vec ^ "[i32] (slice v 0 -1))") ~needle:"is negative";
(* A Vec a call returned is *accepted*, where an array a call returned is
not. The array dangles; this does not — the storage outlives the
expression — and what it loses is the owner, which is a leak, which is
defined behaviour here. (len (mk)) and (at (mk) 0) lose the same owner
and compile, so refusing only the third would be a rule about a spelling
rather than about a hazard. *)
accepts "slice of a returned Vec"
"(defn mk [] (Vec i32) (vec-new i32)) (defn f [] [i32] (slice (mk)))";
accepts "slice of a returned Vec, three arguments"
"(defn mk [] (Vec i32) (vec-new i32)) (defn f [] [i32] (slice (mk) 0 1))";
(* There is no [as-slice]: one word takes the view and what it is given says
what the view is. The refusal names [slice] and writes the call back out,
because a reader meeting it has no reason to know there was ever a second
name. *)
rejects_check "as-slice is not a name"
(vec ^ "[i32] (as-slice v))") ~needle:"there is no as-slice";
rejects_check "as-slice suggests the call that replaces it"
(vec ^ "[i32] (as-slice v 1 3))") ~needle:"Write (slice v 1 3)";
rejects_check "as-slice over an expression suggests a form that compiles"
"(defn mk [] (Vec i32) (vec-new i32)) \
(defn f [] [i32] (as-slice (mk) 1 3))"
~needle:"Write (slice v 1 3)";
(* A program's own definition of the name still reaches its own. *)
accepts "a program may define as-slice"
"(defn as-slice [n i32] i32 n) (defn f [] i32 (as-slice 3))";
(* An array a call returned is a temporary the slice would outlive. It
dangled silently on both backends before, at the three-argument
spelling; (slice (mk)) is the spelling that would have made it
idiomatic, so it is refused rather than written more often. A literal
is not this case — the frame holds one for as long as the form it is
written in, which is what the acceptance program sorts. *)
rejects_check "slice of a returned array"
"(defn mk [] [3 i32] [7 8 9]) (defn f [] [i32] (slice (mk)))"
~needle:"a returned array is a temporary";
rejects_check "slice of a returned array, three arguments"
"(defn mk [] [3 i32] [7 8 9]) (defn f [] [i32] (slice (mk) 0 3))"
~needle:"a returned array is a temporary";
accepts "slice of an array literal"
"(defn f [] [i32] (slice [7 8 9]))";
(* One builtin, one answer about a bound. A slice bound is a subscript and
goes through [index_expr] like every other one, so a u32 is admitted on
an array exactly as it always was on a Vec, and an i64 is refused by name
on both. The array path used to expect an i32 outright, which made
(at a c) compile and (slice a c) not. *)
accepts "a u32 bound over an array"
(arr ^ "(defn f [c u32] [i32] (slice a c))");
accepts "a u32 bound over a Vec"
"(defn f [v (Vec i32) c u32] [i32] (slice v c))";
rejects_check "an i64 bound over an array"
(arr ^ "(defn f [c i64] [i32] (slice a c))") ~needle:"an index is an i32";
rejects_check "an i64 bound over a Vec"
"(defn f [v (Vec i32) c i64] [i32] (slice v c))"
~needle:"an index is an i32";
(* A string indexes and slices, and neither is a place: it is a view of
bytes the program does not own — a literal's are in constant storage —
so there is no store through one to allow. *)
accepts "a string slices" "(defn f [s string] string (slice s 1))";
accepts "a string indexes" "(defn f [s string] u8 (at s 1))";
(* Both routes to a Pindex, because there are two and they do not share a
line of code: one index goes through the [set] arm that checks its own
target, two through [check_place]. The one-index spelling is the one a
person writes, and it is the one that would silently store into
constant data. *)
rejects_check "set through a string"
"(defn f [s string] () (set (at s 0) 65))" ~needle:"not a place";
rejects_check "set through a string, two indices"
"(defn f [s [2 string]] () (set (at s 0 0) 65))" ~needle:"not a place";
(* The mirror, and the one the walk could break by moving the question a
level up: the refusal is about the type being *indexed*, not about the
element that comes out. An array of strings has a string element and
indexes nothing but the array, so assigning a whole one stays legal. *)
accepts "set an array's string element"
"(defn f [s [2 string]] () (set (at s 0) \"world\"))";
rejects_check "set through a string's slice"
"(defn f [s string] () (set (at (slice s 1) 0) 65))"
~needle:"not a place";
(* The address of one is the same question and gets the same answer, so
the message has to fit a reader who asked for a pointer and not a
store. *)
rejects_check "the address of a string's byte"
"(defn f [s string] (Ptr u8) (addr (at s 0)))"
~needle:"take the address of";
(* And a string is still not a [u8]: slicing one does not smuggle a byte
slice out of it. *)
rejects_check "a string slice is not a byte slice"
"(defn g [b [u8]] i32 (len b)) (defn f [s string] i32 (g (slice s)))"
~needle:"expected [u8], found string";
(* (slice-from-ptr p n). The one form in the language whose central claim the
compiler cannot check — whether n is the truth about what p addresses — so
what it does check is worth pinning: the argument really is a pointer, the
length is not absurd on its face, and the result owns nothing. *)
accepts "a pointer plus a length is a slice"
"(defn f [p (Ptr i32) n i32] i32 (at (slice-from-ptr p n) 0))";
accepts "zero is a length"
"(defn f [p (Ptr i32)] i32 (len (slice-from-ptr p 0)))";
rejects_check "slice-from-ptr of something that is not a pointer"
"(defn f [s [i32]] i32 (len (slice-from-ptr s 3)))"
~needle:"takes a (Ptr T)";
rejects_check "slice-from-ptr with a negative literal length"
"(defn f [p (Ptr i32)] i32 (len (slice-from-ptr p -1)))"
~needle:"is negative";
(* The storage stays C's. A slice carries no allocator, so free refuses one
by the rule it already had — this pins that the new form did not become
a thing anybody could hand to free. *)
rejects_check "free of a slice made from a pointer"
"(defn f [p (Ptr i32)] () (free (slice-from-ptr p 3)))"
~needle:"free takes an owning container";
(* ── Structs, fields and auto-deref ────────────────────────────── *)
let cursor = "(defstruct Cursor [src [u8] pos i32]) " in
accepts "struct literal, omitted field zeroed"
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {.src s}))");
rejects_check "unknown field"
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {.nope s}))")
~needle:"has no field nope";
rejects_check "field given twice"
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {.pos 0 .pos 1}))")
~needle:"given twice";
(* {:src s} is a dyn map literal now, not a struct field list with the
wrong punctuation — the colon is wanted for keys, and this is one. What
used to be caught as a mispunctuated struct is caught one level up
instead: (Cursor {:src s}) is a struct type applied to one argument, and
since positional construction landed that is a Cursor built from too few
arguments. The refusal still points at the struct spelling, which is why
the needle below did not have to move. *)
rejects_check "a struct type called with a colon-keyed map"
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {:src s}))")
~needle:"a struct value is written (Cursor {.field value ...})";
(* ── A bare {.field v}, typed by its position ──────────────────── *)
(* The five positions that carry an expectation, and the three that do
not. Everything the named form checks — unknown field, duplicate
field, ZII for the ones left out — is checked here by *being* the
named form: [check_bare] reads the type name off the want and hands
the very same field list to [check_struct]. The two rows below the
accepts are what says so, since they are the named form's own kinds
and messages arriving at a literal with no name on it. *)
let cell = "(defstruct Cell [row i32 col i32]) " in
accepts "bare literal in a defn's return position"
(cell ^ "(defn f [] Cell {.row 1 .col 2})");
accepts "bare literal with a field omitted is ZII, as the named form is"
(cell ^ "(defn f [] Cell {.row 1})");
accepts "bare literal as the only argument of a call"
(cell ^ "(defn g [c Cell] i32 (.row c)) (defn f [] i32 (g {.row 1}))");
accepts "bare literal as a later argument of a call"
(cell ^ "(defn g [n i32 c Cell] i32 (+ n (.row c))) \
(defn f [] i32 (g 1 {.row 2}))");
accepts "bare literal as a field of another literal"
(cell ^ "(defstruct Grid [a Cell b Cell]) \
(defn f [] Grid (Grid {.a {.row 1} .b {.col 2}}))");
accepts "bare literal set into a typed place"
(cell ^ "(defn f [] i32 (let [c (Cell 0 0)] (set c {.row 7}) (.row c)))");
accepts "bare literal at a union want"
"(defunion U [i i32 f f32]) (defn f [] U {.i 5})";
rejects_check "bare literal with an unknown field"
(cell ^ "(defn f [] Cell {.nope 1})") ~needle:"Cell has no field nope";
rejects_check "bare literal with a field given twice"
(cell ^ "(defn f [] Cell {.row 1 .row 2})") ~needle:"given twice";
(* The three no-reading positions. The dyn one is the boundary that
matters most: braces at a dyn want are the dyn map literal and stay
it, so a .field-keyed brace is refused there rather than quietly
given a second meaning — and told which punctuation a map uses. *)
rejects_check "bare literal with no expectation to read"
(cell ^ "(defn f [] i32 (let [c {.row 1}] (.row c)))")
~needle:"does not say which struct it builds";
rejects_check "bare literal at a dyn want is not a dyn map"
(cell ^ "(defn f [] dyn {.row 1})")
~needle:"a dyn map's keys are keywords, as {:row value ...}";
rejects_check "bare literal at a want that is not a struct type"
(cell ^ "(defn f [] i32 {.row 1})")
~needle:"i32 is expected here, which is not a struct type";
(* A data type's name is an expectation, but not a specific enough one:
the want says D and a value of D is one of its cases. The existing
message for that already names them, so the bare path inherits it. *)
rejects_check "bare literal at a data type want names the cases"
"(defdata D [(A [x i32]) (B [y i32])]) (defn f [] D {.x 1})"
~needle:"write (D.A {.field value ...})";
(* Patterns are a separate parser ([dmap], not [expr]), so nothing here
reaches them: the struct pattern is still {name .field} and a bare
{.field v} is still not a pattern of any kind. Both rows answer the
same as they did before this feature — checked against the tip by
hand, not only asserted here. *)
accepts "a struct pattern still destructures in a let"
(cell ^ "(defn f [c Cell] i32 (let [{r .row} c] r))");
parse_rejects "braces are still not a pattern in a match arm"
(cell ^ "(defn f [c Cell] i32 (match c {r .row} r))")
~needle:"expected a pattern, found {r .row}";
(* The dyn map literal is untouched on every side of this. *)
accepts "a keyword-keyed literal is still a dyn map at a dyn want"
"(defn f [] dyn {:a 1 :b [2 3]})";
accepts "the empty braces are still an empty dyn map"
"(defn main [] i32 (let [m {}] (len m)))";
(* ── (Cell 1 2), positional ────────────────────────────────────── *)
accepts "positional struct construction"
(cell ^ "(defn f [] Cell (Cell 1 2))");
accepts "a zero-field struct called with no arguments"
"(defstruct E []) (defn f [] E (E))";
(* Exact arity, and the refusal names the first field it did not reach.
ZII is not withdrawn — it is what the designated form does, and the
message says so — but a positional list cannot say *which* field it
left out, so it is not allowed to leave one out. *)
rejects_check "positional with too few arguments names the missing field"
(cell ^ "(defn f [] Cell (Cell 1))")
~needle:".col has no value";
rejects_check "positional with too few also offers the designated form"
(cell ^ "(defn f [] Cell (Cell 1))")
~needle:"a struct value is written (Cell {.field value ...})";
rejects_check "positional with too many points at the extra argument"
(cell ^ "(defn f [] Cell (Cell 1 2 3))")
~needle:"Cell has 2 fields, and this is argument 3";
(* The mismatch is reported at the argument, in the words a call's
argument already gets; the note is what names the field, because a
positional call site is the one place the source does not show it. *)
rejects_check "positional argument of the wrong type"
"(defstruct Cell [row i32 col f32]) \
(defn f [] Cell (Cell 1 \"x\"))"
~needle:"expected f32, found string";
(* A struct type and a function cannot share a name — [collect]'s
[claimed] table spans every declaration kind — so the head of a call
resolves to exactly one of them and this refusal is what proves it. *)
rejects_check "a struct name and a function name cannot collide"
(cell ^ "(defn Cell [] i32 1)") ~needle:"Cell is defined twice";
(* Mixed spellings are not a thing: the struct-literal arm in [Parse]
takes the braces only as the *whole* argument list. *)
parse_rejects "a struct literal followed by more arguments"
(cell ^ "(defn f [] Cell (Cell {.row 1} 2))")
~needle:"a struct literal is (Cell {.field value ...})";
accepts "field through a pointer auto-derefs"
(cursor ^ "(defn f [c (Ptr Cursor)] i32 (.pos c))");
accepts "set through a pointer"
(cursor ^ "(defn f [c (Ptr Cursor)] () (set (.pos c) 1))");
rejects_check "field of a non-struct"
"(defn f [x i32] i32 (.pos x))" ~needle:"is not a struct";
(* ── Places ────────────────────────────────────────────────────── *)
accepts "a local is assignable"
"(defn f [] i32 (let [x 1] (set x 2) x))";
rejects_check "a parameter is not assignable"
"(defn f [x i32] () (set x 2))" ~needle:"a parameter is not a place you can assign to";
rejects_check "a constant is not assignable"
"(defconst k 1) (defn f [] () (set k 2))"
~needle:"k is a constant, and a constant is not assignable — it is \
written into the image and there is nothing to assign to. \
Declare it with defonce if it has to change";
accepts "addr of a local gives a pointer"
(cursor ^ "(defn g [c (Ptr Cursor)] i32 (.pos c)) \
(defn f [s [u8]] i32 (let [c (Cursor {.src s})] (g (addr c))))");
rejects_check "addr of a non-place"
"(defn f [] () (addr (+ 1 2)))" ~needle:"addr takes the address of a place";
(* An Option's two fields exist in both backends' layouts — the tag and the
value — and the structural printer reads the tag through them. What has no
spelling in the source language is reaching one: [match] and [some] are
how an Option is opened, and a (.field o) that read the value of a None
would be reading storage the tag says is not there. FIX.org recorded
[Addr (Pfield ...)] on an Option as a hole in both backends; this is the
pair of rows that says the hole has no door — the refusal is the field
access itself, so (addr ...) never gets a place to take the address of. *)
rejects_check "a field of an Option"
"(defstruct Point [x i32 y i32])\n\
(defn f [o (Option Point)] i32 (.x o))"
~needle:"(Option Point) is not a struct, so it has no fields";
rejects_check "the address of a field of an Option"
"(defstruct Point [x i32 y i32])\n\
(defn f [o (Option Point)] (Ptr i32) (addr (.x o)))"
~needle:"(Option Point) is not a struct, so it has no fields";
(* ── Option, some, match ───────────────────────────────────────── *)
accepts "some unwraps in an Option-returning function"
"(defn g [] (Option i32) None) (defn f [] (Option i32) (Some (some (g))))";
rejects_check "some outside an Option-returning function"
"(defn g [] (Option i32) None) (defn f [] i32 (some (g)))"
~needle:"must return an Option";
accepts "match on Option"
"(defn g [] (Option i32) None) \
(defn f [] i32 (match (g) (Some v) v None 0))";
rejects_check "match must be exhaustive"
"(defn g [] (Option i32) None) (defn f [] i32 (match (g) (Some v) v))"
~needle:"not exhaustive";
accepts "a wildcard arm is exhaustive"
"(defn g [] (Option i32) None) (defn f [] i32 (match (g) (Some v) v _ 0))";
rejects_check "match on a non-Option"
"(defn f [x i32] i32 (match x _ 0))" ~needle:"match works on an Option";
(* ── Names, order-independence, entry point ────────────────────── *)
accepts "mutually recursive, no forward declaration"
"(defn even? [n i32] bool (if (= n 0) true (odd? (- n 1)))) \
(defn odd? [n i32] bool (if (= n 0) false (even? (- n 1))))";
rejects_check "unknown name" "(defn f [] i32 nope)" ~needle:"unknown name";
rejects_check "unknown function" "(defn f [] i32 (nope 1))"
~needle:"unknown function";
(* ── Did-you-mean, and the dot habit ───────────────────────────────
[near_miss] was written, tested and wired to the type tables alone, so a
mistyped *value* got the bare refusal. The candidate list at a value
position is the scope, the globals and the functions — and, at a call,
the builtin names, which live in no table the checker keeps. No type
names on either list: a symbol written where a value goes was not a
mistyped struct. *)
rejects_check "a mistyped local is a near miss"
"(defn f [] i32 (let [total 1] totl))" ~needle:"did you mean total?";
rejects_check "a mistyped defn is a near miss"
"(defn helper [x i32] i32 x) (defn f [] i32 (helpr 1))"
~needle:"unknown function helpr — did you mean helper?";
rejects_check "a mistyped builtin is a near miss"
"(defn f [] () (prinltn \"hi\"))"
~needle:"unknown function prinltn — did you mean println?";
(* [p.x] is the habit from C, Go and Odin, and the checker can see exactly
what the head is, so the refusal names the accessor rather than reporting
a name nobody wrote. The declaration comes along as a note, which is
[declared_note]'s shape. *)
rejects_check "dot-infix field access names the accessor"
"(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] p.x))"
~needle:"a field is read with an accessor, so write (.x p)";
rejects_check "and says so when the field is not there either"
"(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] p.z))"
~needle:"(.z p), and P has no field z";
rejects_check "and in a set it is the place that is spelled"
"(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (set p.x 2) 0))"
~needle:"a field is assigned through an accessor, so write (set (.x p) ...)";
accepts "which is a real form"
"(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (set (.x p) 2) (.x p)))";
rejects_check "a dotted head that is not a struct says what it is"
"(defn f [] i32 (let [n 1] n.x))" ~needle:"n is i32, which has no fields";
(* The fourth shape: nothing is bound under the head either, so the message
claims nothing about what q is — only that the dot is not the operator
the writer took it for. *)
rejects_check "and an unbound head claims nothing about it"
"(defn f [] i32 q.x)"
~needle:"unknown name q.x — nothing named q is in scope either. A field \
is reached through an accessor, (.x q), not with a dot";
(* A capitalised head keeps the case spelling it always had: [Shape.Circle]
is real here, so a typo in one is not the dot habit. *)
(* Both sides of the rule, because only the pair says what it is. A
capitalised head is a real spelling here — Shape.Circle — so a typo in
one is a mistyped case and gets none of the accessor advice; the same
text with a lowercase head does. The earlier spelling of this row used
(data ...), which is not a top-level form at all, so it refused as an
unknown top-level form and the needle "unknown" matched that instead of
anything this rule does. *)
(match (try ignore (checked "(defdata Shape [(Circle [r f64])]) \
(defn f [] Shape Shape.Crcle)"); None
with Loc.Error d -> Some d) with
| Some d ->
check "a capitalised dotted name gets no accessor advice"
(contains d.Loc.dmsg "unknown name Shape.Crcle"
&& not (contains d.Loc.dmsg "accessor"))
| None -> check "a mistyped case is refused" false);
(match (try ignore (checked "(defdata Shape [(Circle [r f64])]) \
(defn f [] Shape shape.Crcle)"); None
with Loc.Error d -> Some d) with
| Some d ->
check "and a lowercase one does"
(contains d.Loc.dmsg
"nothing named shape is in scope either. A field is reached through \
an accessor, (.Crcle shape), not with a dot")
| None -> check "a lowercase dotted name is refused" false);
(* [(Pair i32)] in a defonce falls down the value fork now that the third
element takes either reading, and the generics answer the type fork gave
it has to be reachable from here too. *)
(* A capitalised head with arguments is a *type* given type arguments, and
that is the half of generics that is not built — Types.Named is a bare
string with no room for parameters. The sentence says which half, since
generic functions are here and pointing at them is the useful part. *)
rejects_check "a capitalised call with arguments is a generic type"
"(defonce x (Pair i32)) (defn f [] i32 0)"
~needle:"is a generic type, which is not there yet";
accepts "and the generic function it points at is"
"(defn pair-fst [a $t b $u] $t (do b a))\n\
(defn main [] () (println (pair-fst 1 true)))";
rejects_check "defined twice" "(defn f [] ()) (defn f [] ())"
~needle:"defined twice";
(* ── The randomness surface ────────────────────────────────────────
Four names the prelude does not have, each refused with the name it does
have. A reader who arrives at one of these has copied a line from
somewhere and needs the spelling that works, so the message is checked on
the name it hands back and every call it prints is compiled below. Both
positions, because a bare name and a call take different paths through
the checker and a Lisp-1 makes the bare one a real thing to write. *)
rejects_check "no rand-u32" "(defn f [] u64 (rand-u32))"
~needle:"there is no rand-u32 — a random integer is (rand-int)";
rejects_check "no rand-f32" "(defn f [] f64 (rand-f32))"
~needle:"there is no rand-f32 — a random float in [0, 1) is (rand)";
rejects_check "no rand-i32-range" "(defn f [] i64 (rand-i32-range 0 10))"
~needle:"there is no rand-i32-range";
rejects_check "no rand-f32-range" "(defn f [] f64 (rand-f32-range 0.0 1.0))"
~needle:"there is no rand-f32-range";
(* And the newer machinery is still in front of every name that is not one
of the four: a typo near one of them is a typo, and gets the did-you-mean
the checker has for typos rather than the sentence about a name nobody
wrote. A dotted head keeps the dot-access reading for the same reason. *)
rejects_check "a near miss of a rand name is still a near miss"
"(defn f [] i64 (rand-int-rang 0 10))" ~needle:"did you mean";
rejects_check "and a dotted name is still read as field access"
"(defstruct Point [x i32]) (defn f [p Point] i32 p.x)"
~needle:"accessor";
rejects_check "no rand-f32, named rather than called"
"(defn f [] i32 (let [g rand-f32] 0))" ~needle:"there is no rand-f32";
rejects_check "no rand-i32-range, named rather than called"
"(defn f [] i32 (let [g rand-i32-range] 0))"
~needle:"there is no rand-i32-range";
(* And the five names it does have, at the types it has them at, with every
call the four refusals print. A suggestion that does not compile is worse
than no suggestion, so each is here as well as in the message. *)
infers "rand-int is a u64" "(rand-int)" "u64";
infers "rand is an f64" "(rand)" "f64";
infers "rand-bool is a bool" "(rand-bool)" "bool";
infers "rand-int-range is an i64" "(rand-int-range 0 10)" "i64";
infers "rand-float-range is an f64" "(rand-float-range 0.0 1.0)" "f64";
accepts "the 32 bits a rand-u32 caller wanted"
"(defn f [] u32 (u32 (>> (rand-int) 32)))";
accepts "the f32 a rand-f32 caller wanted" "(defn f [] f32 (f32 (rand)))";
accepts "the i32 a rand-i32-range caller wanted"
"(defn f [] i32 (i32 (rand-int-range 0 10)))";
accepts "main with no parameters and no return" "(defn main [] ())";
accepts "main with argv and a status" "(defn main [args [string]] i32 0)";
rejects_check "main with a wrong parameter" "(defn main [n i32] ())"
~needle:"main takes no parameters";
rejects_check "main returning the wrong type" "(defn main [] bool true)"
~needle:"main returns i32";
(* And both of them point at the [main] that is wrong. They used to open with
<unknown>:0:0 — the checker's rule about the entry point is the one place
that had a name and no span, because [env.locs] records where a *type* was
declared and a function is not in it. The span is the whole difference
between a message you can act on and a message you have to go looking for,
so it is pinned here rather than left to the reader of a report. *)
let main_at name src =
match checked src with
| _ ->
incr failures;
Printf.printf "FAIL %s: expected a type error\n" name
| exception Loc.Error { Loc.dloc; _ } ->
let got = Loc.to_string dloc in
if got <> "<test>:1:7" then begin
incr failures;
Printf.printf "FAIL %s\n wanted: %s\n got: %s\n"
name "<test>:1:7" got
end
in
main_at "a wrong main parameter points at main" "(defn main [n i32] ())";
main_at "a wrong main return type points at main" "(defn main [] bool true)";
(* ── Classes and generic functions — M2 item 6 ─────────────────── *)
(* A class is a constructor and a shape tag. The constructor is the class's
own name, positional over the slots, and everything that reads or writes
an instance is the dyn map operation that was already there. *)
accepts "a class and its constructor"
"(defclass point [x y])\n\
(defn main [] i32 (let [p (point 1 2)] (if (= (get p :x) 1) 0 1)))";
accepts "a class with no slots"
"(defclass marker [])\n(defn main [] i32 (let [m (marker)] 0))";
accepts "class-of answers nil for anything that is not an instance"
"(defn main [] i32 (if (= (class-of 1) nil) 0 1))";
(* The constructor is an ordinary function, so its arity is the ordinary
arity check and a wrong one names the class. *)
rejects_check "a constructor takes one argument per slot"
"(defclass point [x y])\n(defn main [] i32 (let [p (point 1)] 0))"
~needle:"point";
(* A slot vector holds names and nothing else. [(defclass point [x i64])]
is therefore two slots, one of them unfortunately named — the parser
cannot tell a type's name from a slot's and does not have to, since a
slot has no type to write. What it can tell is a form that is not a name
at all. *)
rejects_check "a slot is a name, not a type expression"
"(defclass point [x (Ptr i64)])\n(defn main [] i32 0)"
~needle:"a class slot is a name";
rejects_check "a class does not name a slot twice"
"(defclass point [x x])\n(defn main [] i32 0)"
~needle:"names the slot x twice";
(* Both halves of the dispatch, and the fact that they are one mechanism:
a defgeneric is a defmulti whose dispatch is (class-of first-argument),
so a method written for a class is a method written for its keyword. *)
accepts "class dispatch"
"(defclass point [x y])\n\
(defgeneric area [self] dyn)\n\
(defmethod area point [p] (* (get p :x) (get p :y)))\n\
(defn main [] i32 (if (= (area (point 2 3)) 6) 0 1))";
accepts "arbitrary dispatch, with a fallback"
"(defmulti describe [x] dyn (get x :kind))\n\
(defmethod describe :square [s] 1)\n\
(defmethod describe :else [s] 2)\n\
(defn main [] i32 (if (= (describe {:kind :round}) 2) 0 1))";
accepts "a method may name its parameters whatever it likes"
"(defclass point [x y])\n\
(defgeneric area [self] dyn)\n\
(defmethod area point [whatever] (get whatever :x))\n\
(defn main [] i32 0)";
(* The rebinding that gives a method its own parameter names is parallel.
A [let] binds in sequence, so the pairwise spelling reads a name it has
just bound: these two type-check either way and the values are what is
wrong, which is why dyn-class.flan is where they are really pinned. What
is pinned here is that both shapes are legal at all. *)
accepts "a method may reverse its generic's parameter names"
"(defmulti g [a b] () (class-of a))\n\
(defmethod g :else [b a] (println b) (println a))\n\
(defn main [] i32 0)";
accepts "a method may shift its generic's parameter names along"
"(defmulti g [a b] () (class-of a))\n\
(defmethod g :else [b c] (println b) (println c))\n\
(defn main [] i32 0)";
accepts "a method may be written above its generic"
"(defclass point [x y])\n\
(defmethod area point [p] (get p :x))\n\
(defgeneric area [self] dyn)\n\
(defn main [] i32 0)";
(* A generic with no methods at all is legal and always misses; that is a
run-time answer (the NoMethod condition), not a compile-time refusal. *)
accepts "a generic with no methods"
"(defgeneric area [self] dyn)\n(defn main [] i32 0)";
rejects_check "a method needs a generic"
"(defclass point [x y])\n(defmethod area point [p] 1)\n\
(defn main [] i32 0)"
~needle:"no defgeneric or defmulti names area";
rejects_check "a method dispatching on an unknown class"
"(defgeneric area [self] dyn)\n(defmethod area square [p] 1)\n\
(defn main [] i32 0)"
~needle:"no defclass names square";
rejects_check "two methods for one dispatch value"
"(defclass point [x y])\n\
(defgeneric area [self] dyn)\n\
(defmethod area point [p] 1)\n\
(defmethod area point [p] 2)\n\
(defn main [] i32 0)"
~needle:"already has a method for point";
(* A class's name and its keyword are one value: a class stands for the
keyword its instances carry, so these two methods are the same method
written twice and the second would be dead code. *)
rejects_check "a class and its keyword are one dispatch value"
"(defclass point [x y])\n\
(defgeneric area [self] dyn)\n\
(defmethod area point [p] 1)\n\
(defmethod area :point [p] 2)\n\
(defn main [] i32 0)"
~needle:"already has a method for :point";
rejects_check "two :else methods for one generic"
"(defmulti d [x] dyn x)\n\
(defmethod d :else [x] 1)\n\
(defmethod d :else [x] 2)\n\
(defn main [] i32 0)"
~needle:"already has a method for :else";
rejects_check "a method's arity is its generic's"
"(defclass point [x y])\n\
(defgeneric area [self] dyn)\n\
(defmethod area point [p q] 1)\n\
(defn main [] i32 0)"
~needle:"and this method of it takes 2";
rejects_check "a generic's parameter is a bare name"
"(defgeneric area [self (Ptr i64)] dyn)\n(defn main [] i32 0)"
~needle:"parameter is a bare name";
rejects_check "a defgeneric has no body"
"(defgeneric area [self] dyn (class-of self))\n(defn main [] i32 0)"
~needle:"It has no body";
rejects_check "a defmulti has one"
"(defmulti describe [x] dyn)\n(defn main [] i32 0)"
~needle:"the body is the dispatch";
rejects_check "a defgeneric needs something to dispatch on"
"(defgeneric area [] dyn)\n(defn main [] i32 0)"
~needle:"dispatches on the class of its first";
rejects_check "a dispatch value is written out, not computed"
"(defmulti d [x] dyn x)\n(defmethod d (f 1) [x] 1)\n\
(defn main [] i32 0)"
~needle:"is written out rather than computed";
(* A method has no return slot: the generic states the type once, for all
of them. What that means for anyone writing the defn spelling by habit
is that the slot they would have written is read as the first form of
the body, and a lone type name there is an unknown name. *)
rejects_check "a method has no return slot"
"(defclass point [x y])\n\
(defgeneric area [self] dyn)\n\
(defmethod area point [p] dyn (get p :x))\n\
(defn main [] i32 0)"
~needle:"dyn";
(* A class and a function are one namespace, as a defn and a defonce are:
the constructor is a defn, so the collision is the ordinary one. *)
rejects_check "a class collides with a function of the same name"
"(defclass point [x y])\n(defn point [] i32 0)\n(defn main [] i32 0)"
~needle:"point";
(* ── Unconstrained operators, and everything past milestone 2 ──── *)
(* M2 queue item 5: typed = and != grow strings, bytewise. Ordering does
not — there is no collation the language has picked, so < stays
refused, on the grounds that a string is equatable but not ordered. *)
accepts "typed = on strings" "(defn f [] bool (= \"a\" \"b\"))";
accepts "typed != on strings" "(defn f [] bool (!= \"a\" \"b\"))";
rejects_check "no built-in < on strings"
"(defn f [] bool (< \"a\" \"b\"))" ~needle:"orders machine numbers and enums";
rejects_check "no built-in <= on strings"
"(defn f [] bool (<= \"a\" \"b\"))" ~needle:"orders machine numbers and enums";
rejects_check "no built-in > on strings"
"(defn f [] bool (> \"a\" \"b\"))" ~needle:"orders machine numbers and enums";
rejects_check "no built-in >= on strings"
"(defn f [] bool (>= \"a\" \"b\"))" ~needle:"orders machine numbers and enums";
(* (Vec T) is built. What is still refused is the arity: one element type,
and a near-miss there would otherwise resolve to a type variable and come
back as generics. *)
rejects_check "Vec takes one type" "(defn f [x (Vec i32 i32)] ())"
~needle:"exactly one type";
(* (Map K V) is the map type spelling, and now the only one: the brace form
is withdrawn from type position, so braces there are refused with the
surviving spelling named. What is refused here is the arity, for the same
reason Vec's is: a near-miss would otherwise resolve to a type variable
and come back as generics. *)
rejects_check "Map takes two types" "(defn f [x (Map i32)] ())"
~needle:"exactly two types";
rejects_check "Result is milestone 6" "(defn f [] (Result i32 i32) None)"
~needle:"milestone 6";
(* ── The region rule, spec-memory.md's arena rule ────────────────────
The compile-time half of it, which is the only half a checker row can
see: which declarations are admitted, and which are still refused. The
run-time half — the branch that decides whether a given construction site
met a region allocator — is programs/arena-region.flan, because it needs
a program that dies to say anything. *)
(* The recursive dynamic value, which is the whole point: a union naming
itself through a container. Admitted because such a container can only
have been built against a region, and one free-all takes the graph. *)
accepts "a data type case holding a Vec of itself"
"(defdata Value [Nil (List [items (Vec Value)])])";
accepts "a data type case holding a Map of itself"
"(defdata Value [Nil (Table [entries (Map string Value)])])";
(* Since the second repeal the plain case is admitted too: a struct or a
case holding a heap-backed Vec copies as bytes, the copies alias one
buffer, and a free through two copies is the program's bug — Odin's
contract exactly. These pin the admission. *)
accepts "a data type case holding a plain Vec"
"(defdata Value [Nil (Bytes [bs (Vec u8)])])";
accepts "a struct field holding a plain Vec"
"(defstruct B [buf (Vec u8)])";
(* free does not recurse and does not quietly release the outer block: it
names free-all, which is the operation that actually releases the graph. *)
rejects_check "free on a container of owning elements"
"(defdata V [Nil (L [xs (Vec V)])])\n\
(defn f [v (Vec V)] () (free v))"
~needle:"(free-all a) takes it";
(* clone is refused for a reason the region does *not* dissolve: it promises
an independent copy and a bytewise one is an alias. *)
rejects_check "clone on a container of owning elements"
"(defdata V [Nil (L [xs (Vec V)])])\n\
(defn f [v (Vec V)] () (let [c (clone v)] (free c)))"
~needle:"cannot be cloned";
(* ── A move-only global ─────────────────────────────────────────────
Legal, started zeroed, and since the repeal of the flow analysis it is
ownable like anything else: passing, binding and freeing one all
type-check, and the process-long lifetime is the program's to keep. The
accepted side is programs/vec-global.flan. What is still refused about
one is declaration-shaped, below. *)
(* And the two declaration shapes. The computed one is the half that changed:
there is an init-at-startup path now, on both backends, so a global Vec
loaded by its own initialiser is an ordinary program — which is what the
commented-out line in sand.flan was reaching for. The defconst is refused
as it always was, and for a reason the startup path does not touch: a
constant is not an assignable place, so nothing could ever load it. *)
accepts "a global Vec with a computed initialiser"
"(defonce g (Vec u8) (slurp \"game-data.edn\")) (defn f [] ())";
rejects_check "a move-only global as a defconst"
"(defconst g (Vec u8) (slurp \"game-data.edn\")) (defn f [] ())"
~needle:"a defonce and not a defconst";
(* uninit is the one initialiser a container still refuses, and it is a
different rule: a garbage block pointer is not a garbage number. *)
rejects_check "a global Vec declared uninit"
"(defonce g (Vec u8) uninit) (defn f [] ())"
~needle:"steers every read of it";
(* ── What may be filled with raw bytes ─────────────────────────────
[(filled b)] and [(dead-beef)] are [zeroed]'s siblings, and the
boundary is the whole of what is new about them: zero is a value every
type can have and 0xDE is not, so the checker says which types survive
arbitrary bytes. The accepting side is programs/fill.flan; what is here
is the catalogue of what it refuses and why each refusal is the runtime's
and not a matter of taste.
The dyn row is the one that would corrupt the collector: a struct holding
a dyn is rooted with a descriptor naming that word's offset, so a filled
one is a root pointing at nothing. *)
accepts "a fixed array of numbers may be filled"
"(defn f [] () (let [a (array 4 u8)] (set a (filled 0xFF))))";
accepts "a struct of numbers may be dead-beefed"
"(defstruct S [a i32 b f64]) \
(defn f [] () (let [s (S {})] (set s (dead-beef))))";
(* Both arities, and a pattern that is not a literal — the operand is an
ordinary u32 expression, which is the byte arm's rule at four times the
width. *)
accepts "dead-beef takes a pattern"
"(defn f [] () (let [a (array 4 u8)] (set a (dead-beef 0xBAADF00D))))";
accepts "dead-beef takes a computed pattern"
"(defn f [p u32] () (let [a (array 4 u8)] (set a (dead-beef p))))";
rejects_check "a struct holding a dyn cannot be filled"
"(defstruct S [a i32 d dyn]) \
(defn f [] () (let [s (S {})] (set s (dead-beef))))"
~needle:"a root pointing at nothing";
rejects_check "a Vec cannot be filled"
"(defn f [] () (let [v (vec-new i32)] (set v (filled 0xFF))))"
~needle:"frees a wild address";
rejects_check "a string cannot be filled"
"(defn f [] () (let [s \"hi\"] (set s (filled 0xFF))))"
~needle:"a length every bounds check believes";
rejects_check "a pointer field cannot be filled"
"(defstruct S [p (Ptr i32)]) \
(defn f [] () (let [s (S {})] (set s (filled 0xFF))))"
~needle:"an address every deref trusts";
(* The one refusal that is about the two backends rather than the runtime:
LLVM reads a bool's low bit and x86 compares the whole byte, so 0xDE is
false on one and true on the other. Byte-identical behaviour across the
backends is what this feature is pinned on, so the divergence is refused
rather than documented. *)
rejects_check "a bool cannot be filled"
"(defn f [] () (let [b false] (set b (filled 0xFF))))"
~needle:"would not even agree with itself";
(* Each of the tagged and address-carrying types names its own reason. They
shared one "it carries a tag that names a case" line until review caught
that it was false for two of them — a union is untagged (env.unions is
"the untagged unions") and a function value is a code pointer, not a
tag. Pinned per type so the reasons cannot quietly re-merge. *)
rejects_check "a union cannot be filled, and not because of a tag"
"(defunion U [a i32 b f64]) \
(defn f [] () (let [u (U {})] (set u (dead-beef))))"
~needle:"a union's members overlay";
rejects_check "a function value cannot be filled"
"(defn g [] ()) (defn f [] () (let [h g] (set h (dead-beef))))"
~needle:"it is a code address";
rejects_check "an enum cannot be filled"
"(defenum K [lo 0 hi 1]) \
(defn f [k K] () (let [e k] (set e (dead-beef))))"
~needle:"the members it declared";
rejects_check "an Option cannot be filled"
"(defn f [] () (let [o (Some 1)] (set o (dead-beef))))"
~needle:"whether the value is there";
(* A data type's tag is a case index, and no byte pattern names a real
case. The type itself is what the message names, because a data type
overlays its cases. *)
rejects_check "a data type cannot be filled"
"(defdata U [(A [x i32]) (B [y i32])]) \
(defn f [] () (let [u (U.A {.x 1})] (set u (filled 0xFF))))"
~needle:"names a case";
(* [zeroed]'s own refusal, worn by both siblings: a fill is the bytes of
whatever type is expected of it, and in a position that expects nothing
there is no type and nothing to fill. This is the shape's cost and it is
paid on purpose — the alternative was a second, place-taking spelling
for an operation [set] already expresses. *)
rejects_check "a fill in a position with no expected type"
"(defn f [] () (print (filled 0xFF)))"
~needle:"needs to know the type it is filling";
rejects_check "a dead-beef in a position with no expected type"
"(defn f [] () (print (dead-beef)))"
~needle:"needs to know the type it is filling";
(* The byte is a u8 and the ordinary literal rule applies to it — there is
no range check of this builtin's own, and there does not need to be. *)
rejects_check "a fill byte out of range"
"(defn f [] () (let [a (array 4 u8)] (set a (filled 300))))"
~needle:"does not fit in u8";
rejects_check "filled takes exactly one byte"
"(defn f [] () (let [a (array 4 u8)] (set a (filled))))"
~needle:"takes 1 argument";
rejects_check "dead-beef takes at most one pattern"
"(defn f [] () (let [a (array 4 u8)] (set a (dead-beef 1 2))))"
~needle:"takes the pattern or nothing at all, given 2";
(* The pattern is four bytes, so a wider literal is a typo rather than
something to truncate. The refusal is [in_range]'s, located at the
literal — this builtin has no range check of its own and does not need
one, exactly as the byte arm does not. *)
rejects_check "a dead-beef pattern out of u32 range"
"(defn f [] () (let [a (array 4 u8)] (set a (dead-beef 0x1DEADBEEF))))"
~needle:"does not fit in u32";
(* A fill is never a value the linker can write into the image, so a
defconst of one is refused by the constant rule rather than by anything
of this feature's own. A defonce is fine: its initialiser runs at
startup, which programs/fill.flan pins. *)
rejects_check "a defconst cannot be filled"
"(defconst g [4 u8] (filled 0xFF)) (defn f [] ())"
~needle:"defconst";
(* ── The third element of a defonce ─────────────────────────────────
The rule, 2026-09-20: a type there is the zeroed static global it has
always been, and anything else is a dyn global initialised from the
expression at startup. The four rows below are the four spellings, each
pinned with its meaning and not merely with the fact that it compiles. *)
defvar_reading "a primitive third element stays a zeroed static"
"(defonce current-color i32) (defn f [] i32 current-color)"
"current-color" ~ty:"i32" ~zeroed:true;
defvar_reading "a bracketed type stays a zeroed static array"
"(defonce grid [2 [3 u32]]) (defn f [] u32 (at grid 0 0))"
"grid" ~ty:"[2 [3 u32]]" ~zeroed:true;
(* The edge the rule turns on: [Point] is a type, so the type reading wins
and this is the zeroed struct it was before the rule existed. A value
named [Point] cannot exist to compete with it — [collect] refuses one
name declared twice, across every declaration kind there is. *)
defvar_reading "a struct's name stays a zeroed static struct"
"(defstruct Point [x i32 y i32]) (defonce p Point) (defn f [] i32 (.x p))"
"p" ~ty:"Point" ~zeroed:true;
rejects_check "a type's name and a value's name cannot collide"
"(defstruct Point [x i32 y i32]) (defonce Point i32 1) (defn f [] ())"
~needle:"defined twice";
(* A parenthesised type is still a type, so this is the zeroed Vec it was —
which is also why a malformed one stays a type error rather than turning
into a call to something named Vec. *)
defvar_reading "a parenthesised type stays a zeroed static"
"(defonce v (Vec i32)) (defn f [] i32 (len v))"
"v" ~ty:"(Vec i32)" ~zeroed:true;
rejects_check "a malformed parenthesised type stays a type error"
"(defonce v (Vec i32 i32)) (defn f [] ())"
~needle:"(Vec T) takes exactly one type";
(* And the new spelling, which is the explicit dyn form with the keyword
left out. *)
defvar_reading "a literal third element is a dyn global holding it"
"(defonce score 0) (defn f [] () (set score (+ score 1)))"
"score" ~ty:"dyn" ~zeroed:false;
defvar_reading "a call as the third element is a dyn global"
"(defn load [] dyn {:n 1}) (defonce game-data (load)) (defn f [] dyn game-data)"
"game-data" ~ty:"dyn" ~zeroed:false;
(* A bare symbol naming a value, which is the shape only a name can settle:
[seed] is not a type, so this is a dyn global initialised from it. *)
defvar_reading "a value's name as the third element is a dyn global"
"(defonce seed i64 3) (defonce score seed) (defn f [] dyn score)"
"score" ~ty:"dyn" ~zeroed:false;
(* The explicit spellings are untouched by all of it. *)
defvar_reading "the explicit dyn form with a value is unchanged"
"(defonce score dyn 0) (defn f [] dyn score)"
"score" ~ty:"dyn" ~zeroed:false;
defvar_reading "the explicit dyn form with no value is unchanged"
"(defonce config dyn) (defn f [] dyn config)"
"config" ~ty:"dyn" ~zeroed:true;
(* [def] through the same third-element rule, one row per spelling. Each
asserts what makes it a def: [grerun], and the initialiser lifted into
[global/<n>] whatever it is — the zero and the literal included, which
is what lets a re-evaluated form swap it through the cell. A defonce
keeps those constants inline; the [defvar_reading] rows above pin that
side (a zeroed one's ginit *is* the zero). *)
def_reading "a def with a type is the zeroed static, repainted"
"(def grid [2 u32]) (defn f [] i32 (i32 (at grid 0)))"
"grid" ~ty:"[2 u32]";
def_reading "a typed def with a constant initialiser still lifts it"
"(def speed i64 3) (defn f [] i64 speed)"
"speed" ~ty:"i64";
def_reading "a computed typed def"
"(defn start [] i64 40) (def counter i64 (start)) (defn f [] i64 counter)"
"counter" ~ty:"i64";
def_reading "a literal third element of a def is a dyn global"
"(def score 0) (defn f [] () (set score (+ score 1)))"
"score" ~ty:"dyn";
(* The defonce beside it stays unmarked: the pair is the whole feature. *)
(match checked "(defonce keep i64 3) (def fresh i64 4) (defn f [] i64 keep)" with
| p ->
let g n = List.find (fun (g : Tast.global) -> g.Tast.gname = n) p.globals in
check "a defonce is not marked for re-run" (not (g "keep").Tast.grerun);
check "and the def beside it is" (g "fresh").Tast.grerun
| exception Loc.Error _ ->
check "a defonce and a def can stand together" false);
(* Lisp-1, same as every other pair of declarations: [collect]'s claimed
table spans def too. *)
rejects_check "a def and a defn cannot share a name"
"(def step 0) (defn step [] i64 1)" ~needle:"step is defined twice";
rejects_check "a def and a defonce cannot share a name"
"(defonce total i64) (def total 0) (defn f [] ())"
~needle:"total is defined twice";
(* The teaching paragraph speaks the form's own name when the form is a
def. *)
rejects_check "a symbol that is neither, under def, says def"
"(def total foo) (defn f [] ())"
~needle:
"foo is neither a type nor a value, and the third element of a def \
has to be one or the other: a type there declares a zeroed global of \
that type — (def total i64) — and a value there declares a dyn \
global holding it — (def total 0)";
(* The symbol that is neither, which is the one position the rule made
ambiguous: before it there was a single reading and "unknown type" was
the whole story, and a message that still said only that would send a
reader looking for the wrong mistake. Both readings, both spellings, and
the near miss over the value names too. *)
rejects_check "a symbol that is neither a type nor a value"
"(defonce total foo) (defn f [] ())"
~needle:
"foo is neither a type nor a value, and the third element of a defonce \
has to be one or the other: a type there declares a zeroed global of \
that type — (defonce total i64) — and a value there declares a dyn \
global holding it — (defonce total 0). Nothing named foo is declared \
as either";
rejects_check "the near miss is over the value names as well as the types"
"(defonce score i64 1) (defonce total scor) (defn f [] ())"
~needle:"Nothing named scor is declared as either — did you mean score?";
(* Three things that know which of the two readings was meant, and get in
ahead of the paragraph rather than being buried under it. A paragraph
about a fork the reader is not standing at is worse than a line. *)
rejects_check "a plain type typo keeps the short answer"
"(defonce total i33) (defn f [] ())"
~needle:"unknown type i33 — did you mean i32?";
(* [int] used to be this row. It resolves now — it is a builtin alias for
[i32] — so the spelling that still teaches has to be one of the ones the
exception did not cover. *)
rejects_check "and another language's spelling is answered by name"
"(defonce total long) (defn f [] ())"
~needle:"unknown type long — Flan spells it i64";
rejects_check "a data case is not a type, and says what is"
"(defdata Shape [(Circle [r f64])]) (defonce g Circle) (defn f [] ())"
~needle:"Circle is a case of the data type Shape, and a case is not a \
type of its own — the global's type is the data type: (defonce g \
Shape). Assign the case you want, as (set g (Shape.Circle \
{.field value ...}))";
(* A bracket form never reaches that fork — the parser gives it the type
reading outright — so a value name inside one used to land in
[resolve_name] and come back as a lecture about generic code. Both
readings at the element that decided it, and the dyn spelling is the one
that works. *)
rejects_check "a bracket type whose element names a value says both readings"
"(defonce a i64 1) (defonce b i64 2) (defonce g [a b]) (defn f [] ())"
~needle:"b names a value, not a type, and the brackets around it were \
read as a type";
rejects_check "and names the dyn spelling that does work"
"(defonce a i64 1) (defonce b i64 2) (defonce g [a b]) (defn f [] ())"
~needle:"put dyn in front of the same brackets — (defonce g dyn ...)";
accepts "which is a real form"
"(defonce a i64 1) (defonce b i64 2) (defonce g dyn [a b]) (defn f [] ())";
(* defconst's two-element form has no type slot, so a type written in one
was read as a name in an array literal and reported as unknown. It is
unambiguous evidence: a type and a value cannot share a name here. *)
rejects_check "a type in a two-element defconst names defonce"
"(defconst rows 4) (defconst cols 4) (defconst grid [rows [cols u8]]) \
(defn f [] ())"
~needle:"u8 is a type, and this is a value: a two-element defconst has no \
type slot";
accepts "and the defonce it names is the form that works"
"(defconst rows 4) (defconst cols 4) (defonce grid [rows [cols u8]]) \
(defn f [] ())";
accepts "an ordinary array constant is untouched" "(defconst xs [1 2 3])";
(* A parameter name is not a mistyped type. This language sizes its machine
types in the name, so a typo in one keeps the digits and a parameter
called [i] or [n] has none — which is the whole of the rule that stopped
[(defn idx [v i] dyn ...)] being refused. *)
accepts "a short parameter name is not a mistyped type"
"(defn idx [v i] dyn v)";
rejects_check "but a mistyped machine type still is"
"(defn g [x f65] f64 x)" ~needle:"unknown type f65 — did you mean f64?";
(* ── (array-fill ...) and (array-gen ...) as initialisers ──────────
DISCUSS.org's "need a value-producing array constructor" wanted
[(defonce grid (array-fill [rows cols] 255))] — the grid filled as part of
its declaration rather than in a mutation step after it. What falls out of
the rules already settled, and it is not a carve-out either way:
The four-element spelling is the one that works. It is a typed global with
a computed initialiser, which is the startup-lifted path a defonce already
had, and the value it stores is an ordinary fixed array.
The three-element spelling does not mean this, and could not. A defonce
whose third element is not a type is a *dyn* global by the 2026-09-20
rule, and a typed fixed array crosses into dyn only as a view of storage
that outlives the view. A freshly built array is a temporary, so the view
lifetime guard refuses it — and where the elements are an array rather
than one of the three scalar widths a view carries, the element refusal
gets there first. Both refusals are the ones any other temporary gets;
neither was written for this form. *)
defvar_reading "a typed array-fill global is computed, not zeroed"
"(defconst rows 2) (defconst cols 3)\n\
(defonce grid [rows [cols u8]] (array-fill [rows cols] 255))\n\
(defn f [] u8 (at grid 0 0))"
"grid" ~ty:"[2 [3 u8]]" ~zeroed:false;
rejects_check "a three-element array-fill defonce is the dyn reading"
"(defonce xs (array-fill [3] (i64 1))) (defn f [] ())"
~needle:"does not cross into dyn as a view here";
rejects_check "and its element type is asked about first"
"(defonce grid (array-fill [2 3] 255)) (defn f [] ())"
~needle:"does not cross into dyn yet";
(* A defconst is not a second path to it: its value is what the linker
writes into the image, and a fill is a loop. *)
rejects_check "array-fill is not a constant's value"
"(defconst g [2 u8] (array-fill [2] (u8 1))) (defn f [] ())"
~needle:"a constant's value must be a compile-time constant";
(* The element type the annotation asks for is the one the fill value is
checked against, so the disagreement is reported at the value. *)
rejects_check "the annotation and the fill value must agree"
"(defonce g [2 [3 u8]] (array-fill [2 3] (f32 1.0))) (defn f [] ())"
~needle:"expected u8, found f32";
rejects_check "the annotation's shape has to be the fill's shape"
"(defonce g [2 u8] (array-fill [3] (u8 1))) (defn f [] ())"
~needle:"expected [2 u8], found [3 u8]";
(* A dimension is the same compile-time length [n T] takes, and a local is
not one. The refusal is [array_len]'s own, which is what "the same rule"
means here. *)
rejects_check "a dimension is a compile-time constant"
"(defn f [] i32 (let [n 3 a (array-fill [n] 0)] 0))"
~needle:"is not a compile-time integer constant";
(* The one condition this form has that the [n T] type spelling does not:
the fill counts in i32 like every other index, so a dimension no i32 can
reach has no loop that could end. Written as a literal, because a
[defconst] that big is refused as an i32 constant before it is ever a
dimension. *)
rejects_check "a dimension has to fit an i32 index"
"(defn f [] i32 (let [a (array-fill [3000000000] 0)] 0))"
~needle:"is not a dimension a fill can count to";
(* The generator. Its type decides the element type, its arity has to be the
rank, and its arguments are indices. *)
accepts "array-gen takes a named function"
"(defn cell [r i32 c i32] i32 (+ (* r 100) c))\n\
(defonce grid [2 [3 i32]] (array-gen [2 3] cell))\n\
(defn f [] i32 (at grid 1 2))";
rejects_check "array-gen's second element is a function"
"(defn f [] i32 (let [a (array-gen [3] 7)] 0))"
~needle:"array-gen's second element is a function value";
rejects_check "the generator takes one argument per dimension"
"(defn g [i i32 j i32] i32 0) (defn f [] i32 (let [a (array-gen [3] g)] 0))"
~needle:"this array-gen has 1 dimension, so its generator is called with \
1 index — and this one takes 2 arguments";
rejects_check "the generator's arguments are i32 indices"
"(defn g [i i64] i32 0) (defn f [] i32 (let [a (array-gen [3] g)] 0))"
~needle:"an index is an i32, and this generator's argument 1 is i64";
(* [resolve] refuses a fixed array of function values — a zeroed one would
be a null pointer — and the type these forms build never goes through
[resolve], so the guard is asked again where the type is built. *)
rejects_check "an array of function values is refused here too"
"(defn h [x i32] i32 x) (defn g [i i32] (Fn [i32] i32) h)\n\
(defn f [] i32 (let [a (array-gen [2] g)] 0))"
~needle:"a fixed array's element cannot be (Fn [i32] i32)";
(* The inline form, the design's canonical one. An fn normally takes its
types from a (Fn ...) want, and this position has none — the *form*
supplies them instead: one i32 index per dimension, and the annotated
element type as the return where there is one. With no annotation the
element type is the body's, the same inference the fill value gets. *)
infers "array-gen takes an inline fn, rank 1"
"(array-gen [5] (fn [i] (* i i)))" "[5 i32]";
infers "array-gen takes an inline fn, rank 2"
"(array-gen [2 3] (fn [i j] (+ (* i 100) j)))" "[2 [3 i32]]";
infers "an inline generator's element type is read off its body"
"(array-gen [3] (fn [i] (i64 i)))" "[3 i64]";
accepts "an annotated defonce takes an inline generator"
"(defonce grid [2 [3 u8]] (array-gen [2 3] (fn [i j] (u8 (+ i j)))))\n\
(defn f [] i32 (i32 (at grid 1 2)))";
(* The annotated element type is the want the body is checked against, so a
disagreement is reported at the generator's answer, in the ordinary
expected/found words — not as a whole-array mismatch a line up. *)
rejects_check "an inline generator's body has to answer the element type"
"(defonce grid [2 [3 u8]] (array-gen [2 3] (fn [i j] 1.5)))\n\
(defn f [] i32 0)"
~needle:"expected u8, found f64";
rejects_check "an inline generator takes one argument per dimension too"
"(defn f [] i32 (let [a (array-gen [2] (fn [i j] i))] 0))"
~needle:"this array-gen has 1 dimension, so its generator is called with \
1 index — and this one takes 2 arguments";
(* ── Computed global initialisers ──────────────────────────────────
The order they run in is the compiler's to choose, so a global written
above the one it reads is fine... *)
accepts "a global initialised from another, written above it"
"(defonce b i64 (+ a 10)) (defonce a i64 (+ 1 2)) (defn f [] i64 b)";
(* ...and a ring is refused with every name in it, because there is no
answer: whichever one started first would read the other's zero. *)
rejects_check "two globals that initialise each other"
"(defn fa [] i64 b) (defn fb [] i64 a)\n\
(defonce a i64 (fa)) (defonce b i64 (fb))\n(defn f [] i64 (+ a b))"
~needle:"initialise each other";
rejects_check "a global initialised from itself"
"(defn fa [] i64 a) (defonce a i64 (fa)) (defn f [] i64 a)"
~needle:"initialised from itself";
(* The dependency is through the call, not only through what the initialiser
names: [fa] reads [b] and nothing in [a]'s text mentions it. *)
accepts "a global that reads another through a function it calls"
"(defn fa [] i64 (+ b 1)) (defonce a i64 (fa)) (defonce b i64 (+ 1 2))\n\
(defn f [] i64 a)";
(* Nothing outside an initialiser can establish a handler or a restart, so an
unanswered signal is a no-op and an unanswered invoke-restart fails at the
invoke site. Both are refused by name. *)
rejects_check "a signal in a global initialiser"
"(defstruct Oops [id i32])\n\
(defonce w i64 (do (signal (Oops {.id 1})) 1))\n(defn f [] i64 w)"
~needle:"with no handler-bind or restart-case around it";
rejects_check "an invoke-restart in a global initialiser"
"(defonce w i64 (do (invoke-restart 'retry) 1))\n(defn f [] i64 w)"
~needle:"an initialiser runs at startup";
(* And what is *inside* one runs like any other code: the frames a
restart-case pushes it also pops, before the initialiser returns. This is
[slurp]'s shape, which is why a global loaded from a file works at all. *)
accepts "a restart-case inside a global initialiser"
"(defstruct Oops [id i32])\n\
(defonce w i64 (restart-case (do (signal (Oops {.id 1})) 7) (use-zero [] 0)))\n\
(defn f [] i64 w)";
(* The borrows, which are what is left once ownership is off the table: a
global Vec is read, mutated in place, viewed and copied, and the copy is
the one thing something else may own. *)
accepts "a global Vec is borrowed, mutated and cloned"
"(defonce g (Vec u8)) \
(defn f [] () (set g (vec-new u8)) (push g 1) (set (at g 0) 2) \
(println (len (slice g))) (let [c (clone g)] (free c)))";
rejects_check "try is milestone 6" "(defn f [] i32 (try 1))"
~needle:"milestone 6";
(* dotimes and defer are implemented, and a defer in a [let] is now one of
the places it may be written: a let at the top level of a function body
has exactly the function's extent (see test/programs/defer-let.flan). What
is still rejected is a loop body and a branch, because a defer is copied
into every exit path — so a loop body's would fire once at function exit
rather than once per iteration, and a branch cannot say "maybe
registered". *)
rejects_check "defer is refused in a loop body"
"(defn g [] () 0) (defn f [] () (while true (defer (g))))"
~needle:"a loop body";
rejects_check "defer is refused in a branch"
"(defn g [] () 0) (defn f [] () (if true (defer (g)) 0))"
~needle:"a branch";
(* break and continue. The interesting half is the *relative* rule: a jump
may not cross a construct that has work to do on the way out, and the
refusal names which construct. That is what replaced the blanket refusal
[return] still carries, and the accepting cases below are the ones a
blanket rule would have got wrong. *)
accepts "break leaves the innermost loop"
"(defn f [] () (while true (break)))";
accepts "a labelled break leaves the named loop"
"(defn f [] () (while :o true (while true (break :o))))";
accepts "continue in a dotimes"
"(defn f [] () (dotimes [i 3] (continue)))";
(* And in the other two arities, counting either way. The output side of
this is test/programs/dotimes-range.flan; what is checked here is that
nothing about the longer forms disturbs the loop stack. *)
accepts "break and continue in a start/stop dotimes"
"(defn f [] () (dotimes [i 2 5] (when (= i 3) (continue)) (break)))";
accepts "break and continue in a down-counting dotimes"
"(defn f [] () (dotimes :o [i 9 -1 -1] (when (= i 3) (continue :o)) \
(break :o)))";
(* A step of 0 written as a literal is an infinite loop spelled as an
accident, so it is refused where it is written. A step that is only a
value cannot be refused here and runs no times at all — the sign test
that picks the direction leaves it with neither. *)
rejects_check "a literal step of 0"
"(defn f [] () (dotimes [i 0 10 0] (print i)))"
~needle:"a step of 0 never moves the counter";
accepts "a step whose sign is not known until run time"
"(defn f [] () (let [s 0] (dotimes [i 0 10 s] (print i))))";
(* Three bounds is the most there are. A fourth is refused by the parser,
which names all three arities. *)
rejects_check "a dotimes with four bounds"
"(defn f [] () (dotimes [i 0 10 2 1] (print i)))"
~needle:"(dotimes [name start stop step] body ...)";
rejects_check "a dotimes with no bound at all"
"(defn f [] () (dotimes [i] (print i)))"
~needle:"(dotimes [name stop] body ...)";
(* Every bound is an index, so it is i32 like the one bound always was.
There is no width to join: a wider one is the ordinary type error. *)
rejects_check "a dotimes bound of another width"
"(defn f [] () (let [n (i64 10)] (dotimes [i 0 n] (print i))))"
~needle:"expected i32, found i64";
rejects_check "break outside a loop"
"(defn f [] () (break))" ~needle:"only allowed inside a loop";
rejects_check "continue outside a loop"
"(defn f [] () (continue))" ~needle:"only allowed inside a loop";
rejects_check "a label naming no enclosing loop"
"(defn f [] () (while true (break :nope)))" ~needle:"no loop named :nope";
(* The rule the blanket one could not express, both ways round. A loop
wholly inside a restart-case body keeps its local break; a break that
would *leave* the restart-case is refused, and says so. *)
accepts "a loop inside a restart-case may break out of itself"
"(defn f [] () (restart-case (while true (break)) (go [] (println \"\"))))";
rejects_check "break may not leave a restart-case"
"(defn f [] () (while true (restart-case (break) (go [] (println \"\")))))"
~needle:"a restart-case";
(* A clause is a barrier for the same reason the body is: it runs after a
transfer landed, with the form's frames still to be popped. *)
rejects_check "break may not leave a restart-case from a clause"
"(defn f [] () (while true (restart-case (println \"\") (go [] (break)))))"
~needle:"a restart-case";
accepts "a loop inside a handler-bind may break out of itself"
"(defstruct C [n i32]) (defn f [] () (handler-bind [(C [c] 0)] (while true (break))))";
rejects_check "break may not leave a handler-bind"
"(defstruct C [n i32]) (defn f [] () (while true (handler-bind [(C [c] 0)] (break))))"
~needle:"a handler-bind";
(* loop and recur. The same stack, the same barriers, and one rule of its
own: a recur must be in the loop body's tail. That is what makes this
better than a silent TCO rather than only cheaper — the mistake is a
compile error here and would be a stack overflow there. *)
accepts "recur in the tail of the body"
"(defn f [] i32 (loop [i 0] (if (= i 3) i (recur (+ i 1)))))";
accepts "recur in the tail of a when"
"(defn f [] () (loop [i 0] (when (< i 3) (recur (+ i 1)))))";
accepts "recur in the tail of a nested let"
"(defn f [] i32 (loop [i 0] (let [n (+ i 1)] (if (= i 3) i (recur n)))))";
rejects_check "recur that is not in tail position"
"(defn f [] () (loop [i 0] (recur (+ i 1)) (println \"\")))"
~needle:"tail position";
rejects_check "recur under a call is not in tail position"
"(defn f [] i32 (loop [i 0] (+ 1 (recur (+ i 1)))))"
~needle:"tail position";
rejects_check "recur in a nested loop body is not in tail position"
"(defn f [] () (loop [i 0] (while true (recur (+ i 1)))))"
~needle:"tail position";
(* Where the "refuse mutual recursion by name" answer lives: there are no
tail calls, so a function cannot recur into itself either. *)
rejects_check "recur outside a loop"
"(defn f [] () (recur))" ~needle:"no tail calls";
rejects_check "recur with the wrong number of values"
"(defn f [] i32 (loop [i 0 j 1] (recur 1)))"
~needle:"binds 2 names and this recur passes 1";
(* The barrier, asked the same question break asks and given the same
answer, rather than a second mechanism. *)
rejects_check "recur may not leave a restart-case"
"(defn f [] () (loop [i 0] (restart-case (recur (+ i 1)) (go [] (println \"\")))))"
~needle:"a restart-case";
(* And the restriction this form adds: a loop answers with the value of its
body, so a jump out of one would have no value to give. A while written
inside a loop is untouched, which is the relative rule again. *)
accepts "a while inside a loop keeps its own break"
"(defn f [] () (loop [i 0] (while true (break))))";
rejects_check "break may not leave a loop"
"(defn f [] () (loop [i 0] (break)))" ~needle:"no value to give";
rejects_check "a labelled break may not leave a loop"
"(defn f [] () (while :o true (loop [i 0] (break :o))))"
~needle:"no value to give";
accepts "a while condition is an ordinary expression"
"(defn f [] () (let [v (vec-new i32) n 0] \
(while (and (< n 10) (> (len v) 0)) (set n (+ n 1))) (free v)))";
rejects_check "loop takes no label"
"(defn f [] () (loop :o [i 0] (recur i)))" ~needle:"loop takes no label";
rejects_check "a loop binding is a plain name"
"(defn f [] () (loop [[a b] 0] (recur 0)))" ~needle:"destructuring pattern";
(* into. The expansion is asserted in programs/into.flan, where the values
coming out are the test; what belongs here is the three things it refuses,
each through the one facility a macro has — a name nothing defines. *)
rejects_check "into needs a source and a destination"
"(defn f [] () (free (into [1 2 3])))"
~needle:"into-takes-a-source-a-destination-and-transforms";
rejects_check "a transform is map or filter"
"(defn f [] () (free (into [1 2 3] (vec-new i32) (take 2))))"
~needle:"into-transform-is-map-or-filter";
rejects_check "a transform names one function"
"(defn f [] () (free (into [1 2 3] (vec-new i32) (map))))"
~needle:"into-transform-is-map-or-filter-of-one-function";
(* An import is resolved by [Load] before the checker runs, so one that
reaches [Check] means a driver skipped that step. *)
rejects_check "an unresolved import is a driver bug"
"(import rl \"vendor:raylib\")" ~needle:"not resolved";
(* Keywords resolve against an enum where one is expected, and everywhere
else are the dyn value from M2 — there is no third reading left to
refuse, so a call that wants a concrete non-dyn type still refuses, just
through the ordinary found-dyn sentence of that boundary rather than a
keyword-specific one. *)
rejects_check "a keyword needs an enum"
"(defn g [x i32] ()) (defn f [] () (g :space))" ~needle:"is expected here";
(* This row used to be a rejection, and the sentence it wanted was the cast
arm's "converts a number, found dyn". FIX.org 2026-09-20 took that
refusal away on purpose: a numeric cast opens a dyn box, so [(i64 d)]
compiles for every dyn [d] and the question of what the box holds moved
to run time. A keyword's box holds no number and traps there —
[flan_dyn_cast_kind]'s sentence, the same one a bool's box gets, pinned
in test_acceptance.ml's dyn-cast rows. What is left here is that the
program is now well-typed, which is the change. *)
accepts "a keyword is dyn, and a numeric cast on it is a run-time question"
"(defn f [] () (print (i64 :space)))";
rejects_check "a keyword that is not a member"
"(defenum Key [space 32]) (defn g [k Key] ()) (defn f [] () (g :spcae))"
~needle:"has no member :spcae";
(* The near miss. A typo one edit away is suggested, and so is the bare
name of a member that carries a disambiguating prefix — raylib's Key
spells its members key-r, key-space, and :r is the natural mistake. *)
rejects_check "a member one edit away is suggested"
"(defenum Key [space 32]) (defn g [k Key] ()) (defn f [] () (g :spcae))"
~needle:"did you mean :space?";
rejects_check "a bare name suggests the prefixed member"
"(defenum Key [key-space 32 key-r 82]) (defn g [k Key] ()) \
(defn f [] () (g :r))"
~needle:"did you mean :key-r?";
accepts "a keyword that is a member"
"(defenum Key [space 32 r 82]) (defn g [k Key] ()) (defn f [] () (g :r))";
(* Converting an enum, explicitly, in both directions. The point of the
conversion is that it is written at the site: a bare integer still does
not fit an enum parameter, so the checked property — a typo is an error
here rather than a wrong number later — is untouched. *)
accepts "an enum converts to an integer"
"(defenum Key [space 32]) (defn f [k Key] i32 (i32 k))";
accepts "an enum converts to a float, through its i32"
"(defenum Key [space 32]) (defn f [k Key] f32 (f32 k))";
accepts "an integer converts to an enum"
"(defenum Key [space 32]) (defn g [k Key] ()) (defn f [i i32] () (g (Key i)))";
accepts "a value that is no declared member converts"
"(defenum Key [space 32]) (defn g [k Key] ()) (defn f [] () (g (Key 999)))";
rejects_check "an integer still does not fit an enum on its own"
"(defenum Key [space 32]) (defn g [k Key] ()) (defn f [i i32] () (g i))"
~needle:"expected Key";
rejects_check "an enum does not convert to another enum"
"(defenum A [x 1]) (defenum B [y 1]) (defn f [a A] B (B a))"
~needle:"converts an integer to an enum";
rejects_check "a float does not convert to an enum"
"(defenum Key [space 32]) (defn f [x f32] Key (Key x))"
~needle:"converts an integer to an enum";
(* An enum is a return type, which needed parse.ml to know enum names. It
knows them under a key of their own: (Key n) is a value now, so putting
Key in [types] would make a body starting with one be eaten as a return
type — the exact trap [is_type_form]'s comment is about. *)
accepts "an enum is a return type"
"(defenum Key [space 32]) (defn f [i i32] Key (Key i))";
accepts "an enum conversion at the head of a body is not a return type"
"(defenum Key [space 32]) (defn g [k Key] ()) \
(defn f [] () (Key 1) (g :space))";
rejects_check "an enum conversion takes one argument"
"(defenum Key [space 32]) (defn f [] Key (Key 1 2))"
~needle:"1 argument";
(* A folded constant skips [check], so its range check has to be its own. *)
rejects_check "a folded constant is still range-checked"
"(defconst c u8 300) (defn f [] u8 c)" ~needle:"does not fit in u8";
(* One top-level namespace, enforced across declaration kinds. Each of these
used to pass the checker — the tables are per-kind — and be caught by LLVM
as a redefinition of an emitted symbol, or not caught at all. *)
rejects_check "a global defined twice"
"(defonce x i32 1) (defonce x i32 2)" ~needle:"defined twice";
rejects_check "a constant shadowing a variable"
"(defconst c 1) (defonce c i32 2)" ~needle:"defined twice";
rejects_check "a function and a global"
"(defn item [] i32 1) (defonce item i32 2)" ~needle:"defined twice";
rejects_check "a struct and an alias"
"(defstruct P [x i32]) (defalias P i32)" ~needle:"defined twice";
rejects_check "an enum and a struct"
"(defenum E [a 1]) (defstruct E [x i32])" ~needle:"defined twice";
rejects_check "an extern and a constant"
"(declare cw [] \"flan_cw\") (defconst cw 1)" ~needle:"defined twice";
(* ── The two builtin aliases ────────────────────────────────────────
[int] is [i32] and [float] is [f32], as of 2026-09-20, and they are the
whole of the exception: every other foreign spelling still teaches. They
are entries in [Types.ikind_of_name] and [Types.fkind_of_name] rather
than prelude [defalias]es, so the claim under test is identity, not
resolution — the rows below are the positions where a merely-resolving
name and the machine type would part company.
The corpus half is test/programs/int-float.flan, which runs on both
backends; what cannot be a program is here, because it does not
compile. *)
accepts "int in a return type and a parameter"
"(defn f [a int] int a)";
accepts "float likewise"
"(defn f [a float] float a)";
(* The position a prelude alias could not have reached: [is_cast] asks the
two [*kind_of_name] functions and never the alias table. *)
accepts "int and float as cast heads"
"(defn f [] int (int (float 1)))";
accepts "int as a generic type argument"
"(defn f [] i64 (let [v (vec-new int) m (map-new int float)] 0))";
accepts "int as a struct field, and float beside it"
"(defstruct P [x int y float]) (defn f [] int (let [p (P {.x 1 .y 2.0})] (.x p)))";
(* The three-element defonce, whose third element is read as a type: a
zeroed static and not a dyn global holding a value called [int]. *)
accepts "a defonce whose type is int" "(defonce g int) (defn f [] int g)";
accepts "and one whose type is float" "(defonce g float) (defn f [] float g)";
accepts "a user alias over int" "(defalias Row (Vec int)) (defn f [] i64 0)";
(* Identity, stated where identity is the only thing that could make it
pass: the two spellings meet as one type with no conversion between
them. *)
accepts "int and i32 are one type"
"(defn g [x i32] i32 x) (defn f [a int] i32 (g a))";
accepts "float and f32 are one type"
"(defn g [x f32] f32 x) (defn f [a float] f32 (g a))";
(* Erasure: the compiler answers in the machine type's name whichever
spelling the source used, which is what the inspector and DWARF show
too — [ikind_name] and [fkind_name] have no [int] to give back. *)
rejects_check "a type error under int names i32"
"(defn f [] int 1.5)" ~needle:"expected i32";
rejects_check "and one under float names f32"
"(defn f [] float (f64 1.0))" ~needle:"expected f32";
(* Widening needs no entry for [int] because [int] *is* [i32], and this pin
says exactly that and nothing about what the widening table holds. It used
to read the other way round — the mixed arithmetic that i32 *refuses*,
int refuses identically — which was true when it was written and stopped
being true when implicit widening landed (FIX.org 2026-09-20): an i32 and
an i64 now meet at i64, so the same form under [int] has to be accepted,
and accepted at i64. Kept pointing at identity by pinning both directions:
the one that widens, and the one that still cannot. *)
accepts "int mixes with i64 exactly as i32 does"
"(defonce a int) (defonce b i64) (defn f [] i64 (+ a b))";
rejects_check "and refuses the narrowing exactly as i32 does"
"(defonce a int) (defonce b i64) (defn f [] int (+ a b))"
~needle:"expected i32, found i64";
(* A program that declared the alias itself — which this one's author did,
before it was builtin. True as written, it is the no-op it says it is;
pointed anywhere else it is refused, because the alias table is never
consulted for the name and the declaration would silently mean i32. *)
accepts "a defalias restating the builtin is a no-op"
"(defalias int i32) (defn f [] int 1)";
accepts "and so is the float one"
"(defalias float f32) (defn f [] float 1.0)";
rejects_check "a defalias redefining int is refused"
"(defalias int i64) (defn f [] int 1)"
~needle:"int is a builtin alias for i32 and cannot be redefined as i64";
rejects_check "and so is one redefining float"
"(defalias float f64) (defn f [] float 1.0)"
~needle:"float is a builtin alias for f32 and cannot be redefined as f64";
rejects_check "a defalias pointing int at a compound type"
"(defalias int (Vec i32)) (defn f [] i32 1)"
~needle:"int is a builtin alias for i32 and cannot be redefined";
(* The exception stops at two names. [integer] is [int]'s own sibling and
still teaches, which is the sharpest statement of where the line is. *)
rejects_check "integer still teaches"
"(defn f [] integer 1)" ~needle:"unknown type integer — Flan spells it i32";
rejects_check "double still teaches"
"(defn f [] double 1.0)" ~needle:"unknown type double — Flan spells it f64";
rejects_check "long still teaches"
"(defn f [] long 1)" ~needle:"unknown type long — Flan spells it i64";
(* A shift by the operand's own width or more is poison in LLVM, and at -O2
a poison return is a function that returns nothing at all. A literal count
is rejected; a computed one is masked in [emit]. *)
rejects_check "a shift past the operand's width"
"(defn f [] i32 (<< 1 32))" ~needle:"out of range";
rejects_check "a right shift past the operand's width"
"(defn f [] u8 (>> (u8 1) 8))" ~needle:"out of range";
accepts "a shift by the widest count in range"
"(defn f [] i32 (<< 1 31))";
(* An index converts from a narrower integer and never from a wider one. *)
accepts "a u32 index" "(defonce a [4 u32]) (defn f [] u32 (let [i 2] (at a (u32 i))))";
rejects_check "an i64 index"
"(defonce a [4 u32]) (defn f [] u32 (let [i 2] (at a (i64 i))))"
~needle:"is wider";
(* An aggregate cannot cross to C — the shim's job, in C, per target. *)
rejects_check "an extern may not take a struct"
"(defstruct V [x f32]) (declare f [v V] \"c_f\")" ~needle:"cannot cross to C";
rejects_check "an extern may not return a struct"
"(defstruct V [x f32]) (declare f [] V \"c_f\")" ~needle:"cannot cross to C";
(* Function values landed; what stayed refused is what they do not include.
An fn takes its parameter types from the position it is written in, and a
defn's body that just answers one says nothing about them. *)
rejects_check "an fn with nothing to say what it takes"
"(defn f [] () (fn [x] x))" ~needle:"nothing here says what this fn";
rejects_check "a lowercase return type no signature introduced"
"(defn f [] a 0)" ~needle:"write $a in the parameter vector";
(* The other half: a name in value position now *works*, and the arity is
checked against the function it names. *)
rejects_check "a function value at the wrong arity"
"(defn g [x i32] i32 x) (defn u [f (Fn [i32] i32)] i32 (f 1 2)) \
(defn f [] i32 (u g))"
~needle:"takes 1 argument, given 2";
rejects_check "a struct cannot contain itself by value"
"(defstruct Node [next Node])" ~needle:"contains itself by value";
rejects_check "nor through a fixed array"
"(defstruct Node [kids [2 Node]])" ~needle:"contains itself by value";
accepts "a pointer breaks the cycle"
"(defstruct Node [next (Ptr Node)])";
rejects_check "an integer literal must fit its type"
"(defn f [] u8 300)" ~needle:"does not fit in u8";
accepts "sequential let bindings"
"(defn f [] i32 (let [a 1 b (+ a 1)] b))";
(* An array literal is [n T] and does not satisfy a slice expectation:
the two are distinct in type and in ownership (spec-memory.md). *)
rejects_check "array literal is not a slice"
"(defn f [] [u8] [1 2 3])" ~needle:"expected [u8]";
rejects_check "array literal is not a struct"
"(defstruct C [pos i32]) (defn f [] C [1 2])" ~needle:"expected C";
rejects_check "wrong element count"
"(defonce xs [2 i32] [1 2 3])" ~needle:"expected 2 elements";
(* Top-level names are order-independent (plan.org, Modules) — including
constants used as array lengths and constants defined in terms of each
other. *)
accepts "a constant declared after its use as a length"
"(defonce grid [rows i32]) (defconst rows 8)";
accepts "constants defined out of order"
"(defconst a (+ b 1)) (defconst b 1)";
(* A typed [defonce] here and not an untyped [defconst], which it was until
2026-09-20: a computed initialiser belongs to a defonce now, and only the
defconst form takes no type. The order-independence being pinned is the
same one either way — [g] is resolved from a declaration further down the
file. *)
accepts "a global initialised from a later function"
"(defonce k u8 (g)) (defn g [] u8 1)";
rejects_check "a genuinely unknown constant still reports itself"
"(defconst a (+ nope 1))" ~needle:"unknown name nope";
(* ── What a defconst's value may be, decided 2026-09-20 ─────────── *)
(* The author's rule: a defconst is the equivalent of a compiler const, so
its value is what the linker writes and never something that runs. The
accepted set is [Tast.const_init]'s, which is [Emit.const]'s — and the
integer arithmetic below is in it because [collect]'s folding pass has
already turned it into its answer by the time the initialiser is looked
at, which is the same pass that makes (/ w cell) usable as an array
length. Both backends refuse the computed one here now, at the checker,
rather than one of them refusing and the other running it at startup. *)
rejects_check "a computed defconst"
"(defn seed [] i64 7) (defconst c i64 (seed))"
~needle:"a constant's value must be a compile-time constant";
rejects_check "a computed defconst names the way through"
"(defn seed [] i64 7) (defconst c i64 (seed))"
~needle:"Write (defonce c ...)";
(* The search for a case goes down through the aggregates, because a case
inside a struct literal is the same value the image cannot hold and the
general message's advice — make it a defonce, or write a literal — is not
followable for one. [Emit.const] recursed for the same reason. *)
rejects_check "a data type case nested in a constant struct"
"(defdata U [A (B [x i32])]) (defstruct S [u U]) \
(defconst g S (S {.u (U.B {.x 1})}))"
~needle:"needs a byte-level encoder that does not exist";
accepts "a constant written as a literal"
"(defconst x u64 0xcbf29ce484222325)";
accepts "a constant written as arithmetic over other constants"
"(defconst w i64 640) (defconst cell i64 16) (defconst cols i64 (/ w cell))";
accepts "a constant aggregate of literals"
"(defstruct P [x i32 y i32]) (defconst origin P (P {.x 1 .y 2}))";
accepts "a constant array of literals"
"(defconst xs [3 i32] [1 2 3])";
accepts "a zeroed constant"
"(defstruct P [x i32 y i32]) (defconst origin P (P {}))";
(* The fold is over integers only, so the same shape in floats is computed
and refused — deliberately, because widening it would be a second folder
and this pins that there is not one. *)
rejects_check "float arithmetic is not folded into a constant"
"(defconst half f64 (/ 1.0 2.0))"
~needle:"a constant's value must be a compile-time constant";
(* ── Conditions, spec-conditions.md §1 and §2 ──────────────────── *)
accepts "handler-bind over a struct condition"
"(defstruct C [id i32]) (defonce n i64)\n\
(defn f [] () (handler-bind [(C [c] (set n 1))] (signal (C {.id 2}))))";
(* Matching is by type and there is no hierarchy, so a condition has to be a
struct — an integer would have nothing to match against. *)
rejects_check "signalling a non-struct"
"(defn f [] () (signal 1))" ~needle:"a condition is a struct";
rejects_check "erroring with a non-struct"
"(defn f [] () (error 1))" ~needle:"a condition is a struct";
(* §2: error is Never, so it unifies with anything — including the position
where a value of some other type was expected. That is what makes it
usable as a restart-case body's fall-through. *)
accepts "error in value position"
"(defstruct C [id i32])\n\
(defn f [] i32 (error (C {.id 1})))";
(* And signal is not: it is Unit, whatever it finds. *)
rejects_check "signal in value position"
"(defstruct C [id i32])\n\
(defn f [] i32 (signal (C {.id 1})))" ~needle:"expected i32";
(* A handler is lifted into a function of its own, so the establishing
function's locals are not there. Capturing them is a closure, which is
milestone 5 — until then it is refused for the reason it is refused for
rather than as an unknown name. *)
rejects_check "a handler capturing a local"
"(defstruct C [id i32])\n\
(defn f [] () (let [n 0] (handler-bind [(C [c] (set n 1))] (signal (C {.id 2})))))"
~needle:"a handler cannot see n";
(* The frames are popped on the way out of the body, so an early exit would
leave them on the stack pointing into a function that has gone. *)
rejects_check "return inside handler-bind"
"(defstruct C [id i32])\n\
(defn f [] i32 (handler-bind [(C [c] (signal c))] (return 1)) 0)"
~needle:"return is not allowed inside handler-bind";
(* spec-memory.md gives a map an upsert of its own, so there is no store
into a lookup and no place form for one. Refused with that reason rather
than as a milestone that will never arrive. *)
rejects_check "a map entry as a place"
"(defn f [] () (set (get m 1) 2))"
~needle:"a map is written with (put m k v)";
(* ── restart-case and invoke-restart, §3 to §6 ─────────────────── *)
accepts "restart-case with a clause that transfers into it"
"(defstruct C [id i32])\n\
(defn g [] i32 (signal (C {.id 1})) 0)\n\
(defn f [] i32 (restart-case (g) (skip [] 7)))\n\
(defn h [] i32 (handler-bind [(C [c] (invoke-restart 'skip))] (f)))";
(* §3: the body and every clause yield the whole form, so they have to agree
— which is also what makes the fall-through path visible in the source.
With a type expected from outside they are each checked against it; with
none, as in a let binding, the first one that produces a value sets it. *)
rejects_check "a clause that disagrees with the body"
"(defn f [] i32 (restart-case 1 (skip [] \"no\")))"
~needle:"expected i32, found string";
rejects_check "two clauses that disagree, with nothing expected"
"(defn f [] i32 (let [x (restart-case (exit 1) (a [] 1) (b [] \"no\"))] 0))"
~needle:"expected i32, found string";
(* §4 finds the first frame offering a name. Two of one name in one frame
would make that a choice nothing in the source shows. *)
rejects_check "one restart-case offering a name twice"
"(defn f [] i32 (restart-case 1 (skip [] 2) (skip [] 3)))"
~needle:"offers skip twice";
(* Same rule as handler-bind: the restart frames are popped on the way out. *)
rejects_check "return inside restart-case"
"(defn f [] i32 (restart-case (return 1) (skip [] 2)))"
~needle:"return is not allowed inside restart-case";
(* §3's parameters. A clause binds them like a function's, so the body sees
them and nothing outside does; what they are is checked against the
invoke at run time, because the two ends meet on a dynamic stack. *)
accepts "a restart with parameters"
"(defn f [] i32 (restart-case 1 (skip [n i32] n)))";
accepts "invoke-restart with arguments"
"(defn f [] () (invoke-restart 'skip 1))";
rejects_check "a restart parameter outside its clause"
"(defn f [] i32 (+ (restart-case 1 (skip [n i32] n)) n))"
~needle:"unknown name n";
rejects_check "a restart argument that is not a value"
"(defn f [] () (invoke-restart 'skip (println \"\")))"
~needle:"a restart argument must be a value";
rejects_check "invoke-restart on an unquoted name"
"(defn f [] () (invoke-restart skip))"
~needle:"a quoted restart name and then its arguments";
(* §5 runs the defers on the way out, so a defer is already the cleanup path
a transfer uses. One that starts its own transfer has no answer. *)
rejects_check "invoke-restart inside a defer"
"(defn f [] i32 (defer (invoke-restart 'skip)) 0)"
~needle:"not allowed inside a defer";
(* Still unimplemented, and still says so by name — which is the point: an
operator the spec names and the compiler lacks must not fall through to a
call and come back as an unknown name. *)
List.iter
(fun (name, src) ->
rejects_check (name ^ " is still unimplemented") src
~needle:"not implemented yet")
[ "find-restart", "(defn f [] () (find-restart 'skip))";
"compute-restarts", "(defn f [] () (compute-restarts))" ];
(* ── handler-case ──────────────────────────────────────────────── *)
(* The unwinding handler. It is built out of a handler-bind and a
restart-case, so most of what could go wrong is already pinned where
those two are; what is asserted here is the surface it puts in front of
them and the one rule that is its own — every clause and the body agree
on a type, which is the type of the whole form. *)
let boom =
"(defstruct Boom [id i32])\n(defstruct Dud [id i32])\n"
in
accepts "handler-case"
(boom ^ "(defn f [] i32 (handler-case 1 [(Boom [c] (.id c))]))");
accepts "handler-case with several clauses"
(boom ^ "(defn f [] i32 (handler-case 1 [(Boom [c] (.id c)) \
(Dud [c] (+ 1 (.id c)))]))");
(* The whole difference from handler-bind: a clause runs at the form, in the
function that wrote it, so it sees that function's locals. The same body
under a handler-bind is refused by name. *)
accepts "a handler-case clause sees the establishing function's locals"
(boom ^ "(defn f [] i32 (let [n 1] (handler-case 0 [(Boom [c] n)])))");
rejects_check "a handler-bind clause still cannot"
(boom ^ "(defn f [] i32 (let [n 1] (handler-bind [(Boom [c] (set n 2))] 0)))")
~needle:"a handler cannot see n: it is a local of the enclosing function";
(* Nothing static refuses a condition no clause lists: it installs no frame
that matches, so it goes past untouched and the body carries on. *)
accepts "a condition no clause lists"
(boom ^ "(defn f [] i32 (handler-case (do (signal (Dud {.id 1})) 7) \
[(Boom [c] 0)]))");
(* The typing rule, and it fails where an [if] with disagreeing arms fails:
at the form that does not fit, saying what was wanted and what was
found. *)
rejects_check "a handler-case clause that disagrees with the body"
(boom ^ "(defn f [] i32 (handler-case 1 [(Boom [c] \"no\")]))")
~needle:"expected i32, found string";
rejects_check "two handler-case clauses that disagree"
(boom ^ "(defn f [] () (println (handler-case 1 [(Boom [c] 2) \
(Dud [c] \"no\")])))")
~needle:"expected i32, found string";
(* Two clauses for one condition type: the first would take every one of
them and the second could never run. *)
rejects_check "one condition type twice"
(boom ^ "(defn f [] i32 (handler-case 1 [(Boom [c] 2) (Boom [c] 3)]))")
~needle:"handles Boom twice";
rejects_check "a handler-case clause on something that is not a struct"
"(defn f [] i32 (handler-case 1 [(i32 [c] 2)]))"
~needle:"a handler matches a struct type";
(* The frames are established around the body and taken off after it, so an
early exit out of the middle would leave them on the stack — and the
refusal names the form the reader wrote rather than the handler-bind
underneath it. *)
rejects_check "return inside a handler-case body"
(boom ^ "(defn f [] i32 (handler-case (return 1) [(Boom [c] 2)]))")
~needle:"not allowed inside handler-case";
(* A clause is the other side of that rule and not an exception to it. It
runs at the form, in the function that wrote it, with the frames already
off the stack — so a [return] there is an ordinary return and there is
nothing left for it to strand. *)
accepts "return inside a handler-case clause"
(boom ^ "(defn f [] i32 (handler-case 1 [(Boom [c] (return 2))]))");
(* A defer is not, though, and for the reason every nested form is refused
one: it is copied onto every exit path of the *function*, so a defer
written where it looks scoped to the clause would run whether the clause
did or not. The same answer a restart-case clause gets. *)
rejects_check "defer inside a handler-case clause"
(boom ^ "(defn f [] i32 (handler-case 1 [(Boom [c] (defer (println \"\")) 2)]))")
~needle:"defer is not allowed inside a nested form";
(* The other way round works. A defer is the cleanup an unwind runs, so
establishing frames inside one is ordinary — what a defer may not do is
start a transfer that leaves it, and a handler-case begins and ends its
own. *)
accepts "handler-case inside a defer"
(boom ^ "(defn f [] i32 (defer (println (handler-case 1 [(Boom [c] 2)]))) 0)");
(* The shape. The clauses go in a vector after the body, which is the
opposite of handler-bind's order, so a form written the other way round
has to say so rather than parse as something else. *)
rejects_check "handler-case with no clauses"
(boom ^ "(defn f [] i32 (handler-case 1 []))")
~needle:"at least one clause";
rejects_check "handler-case written the handler-bind way round"
(boom ^ "(defn f [] i32 (handler-case [(Boom [c] 2)] 1))")
~needle:"handler-case is (handler-case body";
rejects_check "a handler-case clause that binds nothing"
(boom ^ "(defn f [] i32 (handler-case 1 [(Boom [] 2)]))")
~needle:"a handler-case clause is (Type [name] body ...)";
(* ── A function with nothing in it ─────────────────────────────── *)
(* The empty body, the other half of (when test) with no body: a function
that does nothing is a function, and the only question is whether it has
a value to answer. A declared () says it does not and the body may be
empty; a declared anything else says it does, and an empty body cannot
provide one. *)
accepts "a defn returning () with no body"
"(defn nothing [n i32] ())\n(defn f [] i32 (nothing 1) 0)";
rejects_check "a defn returning a value with no body"
"(defn nothing [n i32] i32)"
~needle:"returns i32 but has no body";
(* An fn declares no return type, so the position decides instead. Both arms
are asserted, because the refusal is the one that would otherwise let a
call read a return value nothing wrote. *)
accepts "an fn with no body where a (Fn [] ()) is wanted"
"(defn call [f (Fn [] ())] () (f))\n(defn f [] i32 (call (fn [])) 0)";
rejects_check "an fn with no body where a value is wanted"
"(defn call [f (Fn [] i32)] i32 (f))\n(defn f [] i32 (call (fn [])))"
~needle:"an fn with no body answers ()";
(* ── Destructuring ─────────────────────────────────────────────── *)
(* A pattern is desugared in [Parse] into the bindings and field accesses that
already existed, so what these assert is that the desugaring is *checked* —
the same errors an equivalent hand-written let would raise, pointing at the
pattern that stands in for it. *)
let pt = "(defstruct Point [x i32 y i32])\n" in
let line = pt ^ "(defstruct Line [a Point b Point])\n" in
accepts "struct pattern with :keys"
(pt ^ "(defn f [p Point] i32 (let [{:keys [x y]} p] (+ x y)))");
accepts "struct pattern with a name/:field pair"
(pt ^ "(defn f [p Point] i32 (let [{a .x b .y} p] (+ a b)))");
accepts "a nested struct pattern"
(line ^ "(defn f [l Line] i32 (let [{{:keys [x y]} .a} l] (+ x y)))");
(* A later binding sees an earlier pattern's names, as in any let. *)
accepts "a binding after a pattern sees its names"
(pt ^ "(defn f [p Point] i32 (let [{:keys [x]} p y (+ x 1)] y))");
(* Shadowing works because the value goes into a temporary first. *)
accepts "a pattern may shadow the name it destructures"
(line ^ "(defn f [a Line] i32 (let [{a .a} a] (.x a)))");
accepts "a pattern over a call"
(pt ^ "(defn mk [] Point (Point {.x 1 .y 2}))\n\
(defn f [] i32 (let [{:keys [x y]} (mk)] (+ x y)))");
(* The shorthand: a lone .field binds a local of the field's own name. It is
:keys said in the spelling the rest of the language uses for a field, and
it mixes with the pair form in one brace because the two are told apart
one item at a time -- a dot in head position is the shorthand, anything
else is a pattern expecting its .field next. *)
accepts "struct pattern with the .field shorthand"
(pt ^ "(defn f [p Point] i32 (let [{.x .y} p] (+ x y)))");
accepts "the shorthand mixed with a pair in one brace"
(pt ^ "(defn f [p Point] i32 (let [{.x b .y} p] (+ x b)))");
accepts "the shorthand inside a nested pattern"
(line ^ "(defn f [l Line] i32 (let [{{.x .y} .a} l] (+ x y)))");
(* The shorthand names a field, so an unknown one is the same refusal the
named form gets -- it is the same field access underneath. *)
rejects_check "the shorthand naming a field the struct does not have"
(pt ^ "(defn f [p Point] i32 (let [{.z} p] 0))")
~needle:"Point has no field z";
(* This used to be "{.x} has no .field": a lone dotted symbol was read as a
name to bind and the brace then wanted a field after it. An even number
of them was worse than a refusal -- {.x .y} parsed as "bind a local
called .x to field y" and the program failed later with "unknown name x",
several lines from the mistake. Both readings are gone. *)
accepts "a lone .field is the shorthand and not a missing pair"
(pt ^ "(defn f [p Point] i32 (let [{.x} p] x))");
(* And the arm that refusal came from is still there for the case it was
written for: a plain name with nothing after it. *)
rejects_check "a name with no field after it"
(pt ^ "(defn f [p Point] i32 (let [{a} p] 0))")
~needle:"has no .field";
(* And where the shorthand does *not* reach, which is not a limitation it
introduced: a struct pattern has never worked in a match arm, and the two
spellings are refused identically there. Pinned as a pair, because "the
shorthand works wherever {name .field} works" is the claim, and a row on
only one of them would not be saying it. *)
List.iter
(fun pat ->
rejects_check ("a struct pattern in a match arm: " ^ pat)
(pt ^ Printf.sprintf
"(defn f [p Point] i32 (match p %s 0))" pat)
~needle:"expected a pattern, found")
[ "{.x .y}"; "{a .x}" ];
rejects_check "a field the struct does not have"
(pt ^ "(defn f [p Point] i32 (let [{:keys [x z]} p] (+ x z)))")
~needle:"Point has no field z";
rejects_check "a struct pattern over something that is not a struct"
"(defn f [n i32] i32 (let [{:keys [x]} n] x))"
~needle:"i32 is not a struct, so it has no fields";
rejects_check "one pattern binding a name twice"
(pt ^ "(defn f [p Point] i32 (let [{:keys [x x]} p] x))")
~needle:"this pattern binds x twice";
rejects_check "an empty struct pattern"
(pt ^ "(defn f [p Point] i32 (let [{} p] 0))")
~needle:"an empty struct pattern {} binds nothing";
rejects_check "a pattern with no field name after it"
(pt ^ "(defn f [p Point] i32 (let [{a b} p] 0))")
~needle:"expected .field after a";
(* The same refusal on the destructuring side: a field is a field wherever it
is named, so the rule is not half-applied. :keys is the one that keeps its
colon, and the test below it says so. *)
rejects_check "a destructured field written with a colon"
(pt ^ "(defn f [p Point] i32 (let [{a :x} p] a))")
~needle:"a field label is written .x, not :x";
accepts ":keys keeps its colon, naming no field"
(pt ^ "(defn f [p Point] i32 (let [{:keys [x y]} p] (+ x y)))");
(* Clojure's other map-destructuring keys. Each is refused by its own name:
"unexpected form" would leave the author guessing which of the four they
wrote is the one this does not have. *)
List.iter
(fun k ->
rejects_check (k ^ " in a struct pattern")
(pt ^ Printf.sprintf
"(defn f [p Point] i32 (let [{:keys [x] %s q} p] x))" k)
~needle:(k ^ " is not implemented in a destructuring pattern"))
[ ":as"; ":or"; ":strs"; ":syms" ];
(* ── Sequential patterns, and the asymmetry ────────────────────── *)
(* A fixed array's length is in its type, so the arity is a claim the checker
can settle. *)
accepts "an array pattern naming every element"
"(defn f [] i32 (let [xs [1 2 3] [a b c] xs] (+ a (+ b c))))";
accepts "an array pattern with & rest"
"(defn f [] i32 (let [xs [1 2 3] [a & r] xs] (+ a (len r))))";
accepts "& rest taking an empty tail"
"(defn f [] i32 (let [xs [1 2] [a b & r] xs] (+ a (+ b (len r)))))";
accepts "a struct pattern nested in an array pattern"
(pt ^ "(defn f [ps [2 Point]] i32 \
(let [[{:keys [x]} {y .y}] ps] (+ x y)))");
rejects_check "an array pattern that names too few elements"
"(defn f [] i32 (let [xs [1 2 3] [a b] xs] (+ a b)))"
~needle:"this pattern binds 2 names, but [3 i32] has 3 elements";
rejects_check "an array pattern that names too many"
"(defn f [] i32 (let [xs [1 2] [a b c] xs] (+ a (+ b c))))"
~needle:"this pattern binds 3 names, but [2 i32] has 2 elements";
rejects_check "& rest with more names before it than there are elements"
"(defn f [] i32 (let [xs [1 2] [a b c & r] xs] a))"
~needle:"binds 3 names before the &, but [2 i32] has only 2 elements";
(* The asymmetry, and the reason this is refused rather than lowered to a
bounds-checked [at]: over a slice the arity is a claim about a number that
does not exist until the program runs, so a pattern that type checks would
be one that kills the program instead. *)
rejects_check "an array pattern over a slice"
"(defn f [s [i32]] i32 (let [[a b] s] (+ a b)))"
~needle:"a slice's length is a runtime value";
rejects_check "an array pattern over a slice, even with & rest"
"(defn f [s [i32]] i32 (let [[a & r] s] (+ a (len r))))"
~needle:"a slice's length is a runtime value";
rejects_check "an array pattern over something with no elements at all"
"(defn f [n i32] i32 (let [[a b] n] (+ a b)))"
~needle:"i32 is not a fixed array";
rejects_check "an empty array pattern"
"(defn f [] i32 (let [xs [1 2] [] xs] 0))"
~needle:"an empty array pattern [] binds nothing";
rejects_check "& with nothing after it"
"(defn f [] i32 (let [xs [1 2] [a &] xs] a))"
~needle:"& needs a name after it";
rejects_check "& with two names after it"
"(defn f [] i32 (let [xs [1 2] [a & r s] xs] a))"
~needle:"& takes one name";
rejects_check "a pattern that is only & rest"
"(defn f [] i32 (let [xs [1 2] [& r] xs] (len r)))"
~needle:"binds the whole value";
rejects_check "one array pattern binding a name twice"
"(defn f [] i32 (let [xs [1 2] [a a] xs] a))"
~needle:"this pattern binds a twice";
(* ── Where a pattern is not a binding form ─────────────────────── *)
(* Every other binding position takes a plain name. A parameter is the one
worth a reason: it is a name/type pair, and a pattern has no name for the
type to pair with. Refused where it is written, not left to fall out of
"expected a name". *)
List.iter
(fun (what, src) ->
rejects_check ("a pattern in " ^ what) src
~needle:"a pattern binds only in let")
[ "a defn parameter", pt ^ "(defn f [{:keys [x]} Point] i32 x)";
"a defstruct field", "(defstruct S [[a b] i32])";
"an fn parameter", "(defn f [] i32 (let [g (fn [[a b]] a)] 0))";
"a dotimes counter", "(defn f [] () (dotimes [[a b] 3] 0))";
"a declare parameter", pt ^ "(declare g [{:keys [x]} Point] \"G\")" ];
(* ── match over an enum ────────────────────────────────────────── *)
(* Not shipped, and refused twice over because there are two ways to write it
and they fail in different files. Both now say the same thing, which is the
point: the lowering is not what is missing — a keyword has no case in
[Ast.pattern], and [lib/load.ml] matches that type exhaustively. *)
rejects_check "match over an enum, members written as keywords"
"(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k :lo 1 :hi 2))"
~needle:"is not implemented as a pattern";
rejects_check "match over an enum, members written as names"
"(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k lo 1 hi 2))"
~needle:"match over the enum K is not implemented";
(* The old message blamed milestone 2, which was never the reason, and the
milestone has since arrived: match now works over a declared data type as
well, so the message names both subjects and no milestone. *)
rejects_check "match over something that is neither"
"(defn f [n i32] i32 (match n _ 2))"
~needle:"match works on an Option or a data type, not on i32";
(* A destructuring pattern in an arm's binds is a name position like any
other. *)
rejects_check "a pattern inside a match arm's binds"
"(defstruct P [x i32])\n\
(defn f [o (Option P)] i32 (match o (Some {:keys [x]}) x None 0))"
~needle:"a pattern binds only in let";
(* The desugaring's own machinery is unspellable: the reader makes [~] a
delimiter, so the name never reaches the parser as one symbol. *)
rejects_check "the desugaring's internal name cannot be written by hand"
"(defn f [] i32 (let [xs [1 2]] (destructure~nth xs 0 2 1)))"
~needle:"means nothing outside a quasiquote";
(* ── The untagged union ────────────────────────────────────────── *)
(* Every one of these is a rule the type would be unsound or useless
without, and each says so in its own words rather than falling through to
something generic. The layout itself is pinned where a layout can only be
pinned, against the backend that computes it — see the DWARF/LLVM oracle
in test_acceptance.ml — and what it *does* is pinned by a program that
writes one member and reads another, which is the whole point of the
type. What is here is the catalogue of what it refuses. *)
(match (parse_decl "(defunion U [i i32 f f32])").Ast.d with
| Ast.Defunion ("U", [ a; b ]) ->
check "defunion parses as a member list"
(a.Ast.fname = "i" && b.Ast.fname = "f")
| _ -> check "defunion parses as a member list" false);
(* Nothing to read out of, and no size. It parses; it is refused where the
message can name the shape. *)
rejects_check "a union with no members"
"(defunion U [])\n(defn f [u U] i32 0)"
~needle:"declares no members";
rejects_check "a union that declares a member twice"
"(defunion U [x i32 x f32])\n(defn f [u U] i32 0)"
~needle:"declares the same member twice";
(* The size is the largest member and the largest member is the whole type,
so this is the same infinite type a self-containing struct is. *)
rejects_check "a union that contains itself by value"
"(defunion U [a i32 b U])\n(defn f [u U] i32 0)"
~needle:"contains itself by value";
(* Nothing records which member is live, and since the second repeal that
is the program's fact to keep rather than a refusal: a union member may
own storage, C's way. *)
accepts "a union member that owns storage"
"(defunion U [n i64 v (Vec i32)])\n(defn f [u U] i32 0)";
(* And the one the optimiser would otherwise be handed: a byte that is
neither 0 nor 1 read as an i1. Refused at any depth, which is why the
second row goes through a struct. *)
rejects_check "a bool member"
"(defunion U [b bool n u8])\n(defn f [u U] i32 0)"
~needle:"a union may not hold one at any depth";
rejects_check "a bool inside a struct member"
"(defstruct S [flag bool n i32])\n\
(defunion U [s S n i64])\n(defn f [u U] i32 0)"
~needle:"a union may not hold one at any depth";
(* The same hazard as uninit on a data type, arriving the other way round: a
member written over the tag leaves a tag no case names, and a match on it
falls into a block the optimiser may treat as unreachable. Refused at any
depth for the reason bool is. *)
rejects_check "a data type member"
"(defdata D [A (B [x i32])])\n\
(defunion U [d D n i64])\n(defn f [u U] i32 0)"
~needle:"a data type's tag steers every match";
rejects_check "a data type inside a struct member"
"(defdata D [A B])\n(defstruct S [d D n i32])\n\
(defunion U [s S n i64])\n(defn f [u U] i32 0)"
~needle:"a data type's tag steers every match";
(* An Option is not on that list, and the difference is the lowering: its
match is a test of the tag byte and a branch, so a scribbled tag reads as
a Some with a payload nobody stored — which is what this language says a
union read is. *)
(match checked "(defunion U [o (Option i32) n i64])\n\
(defn f [u U] i32 (match (.o u) (Some x) x None 0))" with
| _ -> check "an Option member is allowed" true
| exception Loc.Error { Loc.dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL an Option member is allowed: %s\n" msg);
(* One member named twice is a different mistake from two members named, and
it gets the refusal the struct path already had. *)
rejects_check "a union literal naming one member twice"
"(defunion U [i i32])\n\
(defn f [] i32 (let [u (U {.i 1 .i 2})] (.i u)))"
~needle:"member i is given twice";
(* Two members is one storage written twice, and which one survived would be
whatever the compiler happened to do last. *)
rejects_check "a union literal giving two members"
"(defunion U [i i32 f f32])\n\
(defn f [] i32 (let [u (U {.i 1 .f 2.0})] (.i u)))"
~needle:"only one of them can be written";
rejects_check "a union literal giving a member it does not have"
"(defunion U [i i32])\n(defn f [] i32 (let [u (U {.z 1})] (.i u)))"
~needle:"U has no member z";
(* There is no tag, so there is nothing for the arms to be alternatives
over. Said by name because the two kinds of union are one keyword apart
and somebody will write it. *)
rejects_check "match on a union"
"(defunion U [i i32 f f32])\n\
(defn f [u U] i32 (match u _ 0))"
~needle:"there is nothing in one to match on";
(* A member narrower than the union leaves the rest indeterminate, so two
values that agree about everything anybody wrote would hash apart. *)
rejects_check "a union as a map key"
"(defunion U [i i32 f f32])\n\
(defn f [m (Map U i32) k U] () (put m k 1))"
~needle:"a union is not a map key";
(* A constant is what the linker writes into the image and a union member is
a store, so a defconst is refused rather than coming back from the emitter
as "this one is computed". A defonce is not refused any more: its computed
initialiser is lifted into a function that runs at startup, and the member
is written by the same store that writes one in a body. *)
accepts "a global initialised with a union member"
"(defunion U [i i32])\n(defonce g U (U {.i 1}))\n(defn f [] i32 0)";
rejects_check "a constant initialised with a union member"
"(defunion U [i i32])\n(defconst c U (U {.i 1}))\n(defn f [] i32 0)"
~needle:"cannot be written into a constant";
(* The all-bytes-zero value is a constant and goes through, which is what
makes (U {}) and a declaration with no value the same thing. *)
(match checked "(defunion U [i i32])\n(defonce g U (U {}))\n\
(defn f [] i32 (.i g))" with
| _ -> check "a global zeroed through a literal is allowed" true
| exception Loc.Error { Loc.dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL a global zeroed through a literal is allowed: %s\n" msg);
(* uninit is refused on a data type because its tag steers a match into a
block LLVM may treat as unreachable. An untagged union steers nothing, so
the argument does not carry over and the answer is different. *)
(match checked "(defunion U [i i32 f f32])\n(defonce g U uninit)\n\
(defn f [] i32 (.i g))" with
| _ -> check "uninit on a union is allowed" true
| exception Loc.Error { Loc.dmsg = msg; _ } ->
incr failures;
Printf.printf "FAIL uninit on a union is allowed: %s\n" msg);
(* The shim writes structs and has no spelling for a union yet — a refusal
about the generator, not about the type, and it says so. *)
rejects_check "a union crossing to C by value"
"(defunion U [i i32])\n(declare-c take [u U] () \"take\")"
~needle:"the shim generator writes structs only";
(* ── Reading a C header (cimport.ml, cjson.ml) ─────────────────── *)
(* Against test/headers/sample.h, which is one function per decision the
importer makes and is committed so that it cannot move. The raylib case
is better evidence and worse coverage: it needs raylib installed, at the
version whose .so is linked, with FLAN_RAYLIB_H set, so as the only test
of this it would skip everywhere.
The assertions are on the *reasons*, not on the counts, for the reason the
acceptance table gives: a refusal that fires for the wrong cause still
refuses, and a count still matches. *)
let imported, dump, env, fixture_ds =
let fixture =
"(defstruct Pair [x f32 y f32])\n\
(defstruct Shade [r u8 g u8 b u8 a u8])\n\
(defenum Mood [calm 0 cross 1])\n\
(defunion Overlay [i i32 f f32])\n\
(defstruct Slot [kind i32 v Overlay])\n"
in
let ds = program fixture in
let taken = Hashtbl.create 16 in
List.iter
(fun d ->
match Ast.declared_name d with
| Some n -> Hashtbl.replace taken n ()
| None -> ())
ds;
let known_structs =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defstruct (n, _) -> Some n | _ -> None)
ds
and known_unions =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defunion (n, _) -> Some n | _ -> None)
ds
and known_enums =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defenum (n, _) -> Some n | _ -> None)
ds
in
let i, d, e =
Cimport.header ~loc:Loc.unknown ~header:"headers/sample.h" ~flags:[]
~known_structs ~known_unions ~known_enums ~taken ~bound_syms:[]
~config:Cimport.no_config
in
(i, d, e, ds)
in
(* What came out, as source, so a wrong type is visible as the line somebody
would otherwise have had to write by hand. *)
let produced = List.map Cimport.decl_source imported.Cimport.decls in
let emits name line =
check ("import-c emits " ^ name) (List.mem line produced)
in
emits "a scalar signature" "(declare-c set-seed [seed u32] \"set_seed\")";
emits "two scalars and a return"
"(declare-c add-ints [a i32 b i32] i32 \"add_ints\")";
(* An aggregate return is the flattening path: Shim turns it into an
out-pointer, and the declaration it starts from has to say the struct. *)
emits "an aggregate return"
"(declare-c make-pair [x f32 y f32] Pair \"make_pair\")";
emits "an aggregate parameter" "(declare-c pair-len [p Pair] f32 \"pair_len\")";
(* const char * is a string going in — the one C spelling that means
something different in a parameter than it does anywhere else. *)
emits "const char * as a string parameter"
"(declare-c name-length [text string] i32 \"name_length\")";
emits "a pointer parameter"
"(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")";
(* struct Pair is both Pair and Point in the header and the package
describes it once, so both names have to land on the one defstruct —
raylib does exactly this with Texture2D and TextureCubemap. *)
emits "a second typedef name for a described record"
"(declare-c point-of [p Pair] Pair \"point_of\")";
(* A C enum is an int, and so is a Flan defenum at the boundary; matching by
name is what keeps the nicer face. *)
emits "a C enum against a defenum of the same name"
"(declare-c mood-value [m Mood] i32 \"mood_value\")";
emits "a function of no arguments" "(declare-c take-nothing [] \"take_nothing\")";
(* And the refusals, each by its reason rather than by a count. *)
let refused name needle =
check
("import-c refuses " ^ name ^ ": " ^ needle)
(List.exists
(fun (n, why) -> n = name && contains why needle)
imported.Cimport.hidden)
in
refused "name-of" "returns char *";
refused "fill-buffer" "C may write through";
refused "printf-like" "is variadic";
refused "on-event" "is a function pointer";
refused "file-time" "width that differs";
refused "make-undescribed" "the package does not describe";
(* The order-dependent one. Spin2D and spin2d both kebab to spin-2d, so
neither may have it: whichever won would depend on the order the header
declares them in, and moving two lines in somebody else's header would
rebind a name a program is already calling. *)
refused "spin-2d" "would depend on the order";
check "a colliding name is not imported after all"
(not (List.exists (fun l -> contains l "\"Spin2D\"") produced));
check "nor is the other half of the collision"
(not (List.exists (fun l -> contains l "\"spin2d\"") produced));
(* ── The config beside the header (Cimport.read_config) ────────── *)
(* Why there is a config at all: the generated declarations are committed, so
a hand-edit to them is destroyed by the next regeneration and the edit has
to live somewhere regeneration reads instead. These are the two things it
can say. *)
let with_config config =
let taken = Hashtbl.create 16 in
List.iter
(fun d ->
match Ast.declared_name d with
| Some n -> Hashtbl.replace taken n ()
| None -> ())
fixture_ds;
let known_structs =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defstruct (n, _) -> Some n | _ -> None)
fixture_ds
and known_unions =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defunion (n, _) -> Some n | _ -> None)
fixture_ds
and known_enums =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defenum (n, _) -> Some n | _ -> None)
fixture_ds
in
let i, _, _ =
Cimport.header ~loc:Loc.unknown ~header:"headers/sample.h" ~flags:[]
~known_structs ~known_unions ~known_enums ~taken ~bound_syms:[] ~config
in
(List.map Cimport.decl_source i.Cimport.decls, i.Cimport.hidden)
in
let lines, hidden =
with_config { Cimport.no_config with Cimport.excludes = [ "set_seed" ] }
in
check "an excluded symbol is not generated"
(not (List.exists (fun l -> contains l "\"set_seed\"") lines));
(* Not silently absent. "there is no such binding" and "the package decided
against this binding" are different answers and a reader gets the second,
which is what [hidden] is for. *)
check "and it says it was excluded rather than going quiet"
(List.exists
(fun (n, why) -> n = "set-seed" && contains why "excluded by the package")
hidden);
let lines, _ =
with_config { Cimport.no_config with Cimport.excludes = [ "add_*" ] }
in
check "an exclude pattern matches by prefix"
(not (List.exists (fun l -> contains l "\"add_ints\"") lines));
check "and leaves everything it does not match"
(List.exists (fun l -> contains l "\"set_seed\"") lines);
let lines, _ =
with_config
{ Cimport.no_config with Cimport.renames = [ ("set_seed", "seed") ] }
in
(* The C symbol is kept verbatim, so an override changes the Flan face and
nothing else — which is what makes it safe to spell a predicate the way
Lisp spells one. *)
check "a name override is the Flan name, and the C symbol is untouched"
(List.mem "(declare-c seed [seed u32] \"set_seed\")" lines);
(* The collision above is refused because neither Spin2D nor spin2d may take
[spin-2d] by an accident of header order. Naming one of them is the way
out, and it is the reason the kebab rule is consulted in exactly one
place: the groups are computed on the name a function will really take,
so the rename dissolves the group rather than leaving both refused. *)
let lines, hidden =
with_config
{ Cimport.no_config with Cimport.renames = [ ("Spin2D", "spin-2d-upper") ] }
in
check "a rename resolves a collision for both halves"
(List.exists (fun l -> contains l "\"Spin2D\"") lines
&& List.exists (fun l -> contains l "\"spin2d\"") lines);
check "and the collision is no longer refused"
(not (List.mem_assoc "spin-2d" hidden));
(* The file, since a typo in it would otherwise show up as a binding under
the wrong name. A line that is neither directive is an error rather than a
line quietly skipped. *)
let config_file text =
let f = Filename.temp_file "flan-bindings" "" in
let ch = open_out f in
output_string ch text;
close_out ch;
f
in
let c = Cimport.read_config (config_file "# a comment\n\nexclude Mem*\nname IsWindowReady window-ready?\n") in
check "read_config reads an exclude" (c.Cimport.excludes = [ "Mem*" ]);
check "read_config reads a name override"
(c.Cimport.renames = [ ("IsWindowReady", "window-ready?") ]);
check "a missing config is no exclusions and no overrides"
(Cimport.read_config "no-such-bindings-file" = Cimport.no_config);
check "a line that is neither directive is refused"
(match Cimport.read_config (config_file "rename Foo bar\n") with
| _ -> false
| exception Loc.Error { Loc.dmsg = m; _ } -> contains m "and this is neither");
(* The enum line's fourth column: the prefix the members carry on the Flan
side, so `key-r` is checked as KEY_R and not KEY_KEY_R. *)
let c = Cimport.read_config (config_file "enum Key KEY_ key-\n") in
check "read_config reads an enum line's Flan member prefix"
(c.Cimport.enum_prefixes = [ ("Key", "KEY_") ]
&& c.Cimport.enum_flan_prefixes = [ ("Key", "key-") ]);
check "a Flan member prefix on `enum Foo -` is refused"
(match Cimport.read_config (config_file "enum Foo - key-\n") with
| _ -> false
| exception Loc.Error { Loc.dmsg = m; _ } ->
contains m "nothing to check Foo against");
(* The package's own file, and the round trip the prefix exists for: a Flan
keyword a program writes, and the C name the rule reaches from it. All
eleven of raylib's enums declare a Flan prefix now — the uniformity is
the claim, so one member of each is pinned rather than a sample. The C
side of each row was read off vendor/raylib/raylib-5.5.h; `flan
generate-c vendor/raylib` is what re-checks that against the header, and
this is what keeps the *spellings* from drifting between times somebody
runs it.
The prefix is a reading choice and not a collision fix: a keyword
resolves against the expected type and nothing else, so :point at a
TextureFilter site was never ambiguous. What is pinned here is that the
bindings file still says so uniformly. *)
let rl = Cimport.read_config "../vendor/raylib/bindings" in
let c_name enum member =
match
( List.assoc_opt enum rl.Cimport.enum_prefixes,
List.assoc_opt enum rl.Cimport.enum_flan_prefixes )
with
| Some cp, Some fp ->
(match Cimport.strip_prefix fp member with
| Some stem -> Some (cp ^ Cimport.screaming stem)
| None -> None)
| _ -> None
in
List.iter
(fun (enum, member, cname) ->
check
(Printf.sprintf "%s/%s is %s" enum member cname)
(c_name enum member = Some cname))
[ ("Key", "key-left-shift", "KEY_LEFT_SHIFT");
("MouseButton", "mouse-left", "MOUSE_BUTTON_LEFT");
("TraceLogLevel", "log-warning", "LOG_WARNING");
("CameraProjection", "projection-perspective", "CAMERA_PERSPECTIVE");
("CameraMode", "camera-third-person", "CAMERA_THIRD_PERSON");
("GamepadButton", "button-left-face-up", "GAMEPAD_BUTTON_LEFT_FACE_UP");
("GamepadAxis", "axis-left-trigger", "GAMEPAD_AXIS_LEFT_TRIGGER");
("Gesture", "gesture-pinch-out", "GESTURE_PINCH_OUT");
("MouseCursor", "cursor-resize-nesw", "MOUSE_CURSOR_RESIZE_NESW");
("TextureFilter", "filter-bilinear", "TEXTURE_FILTER_BILINEAR");
("PixelFormat", "pixel-uncompressed-r8g8b8a8",
"PIXELFORMAT_UNCOMPRESSED_R8G8B8A8") ];
(* And the other half of the same claim: every enum the file maps declares
a Flan prefix. A twelfth enum added with two columns would otherwise
reintroduce the split this closed. `enum Foo -` is exempt and has to be
— a line that says the header has nothing to check cannot carry a third
column at all, which is pinned a few rows above. *)
check "every mapped raylib enum declares a Flan-side member prefix"
(List.for_all
(fun (e, cp) ->
String.equal cp "-" || List.mem_assoc e rl.Cimport.enum_flan_prefixes)
rl.Cimport.enum_prefixes);
(* A refused name is a name that exists and cannot be had — Zig's failDecl,
which Load.refuse_hidden already implements for main. Nothing may be in
both lists, or asking for a name that works would report that it does
not. *)
check "nothing is both imported and refused"
(not
(List.exists
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n -> List.mem_assoc n imported.Cimport.hidden
| None -> false)
imported.Cimport.decls));
(* The struct check, which is the point of reading a header the generator
does not otherwise need: the defstruct and the header's record have
different authors, so a disagreement is real information. A
_Static_assert was rejected in docs/BUILT.md as circular for want of exactly
that. *)
let structs_of ds =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defstruct (n, fs) -> Some (n, fs) | _ -> None)
ds
in
check "a defstruct that matches the header is not reported"
(Cimport.check_structs ~env ~structs:(structs_of fixture_ds) dump = []);
(* Permuted: the failure docs/BUILT.md says only a test can catch, because every
field still reads as a plausible number. *)
check "a permuted defstruct is reported"
(match
Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Pair [y f32 x f32])\n")) dump
with
| [ ("Pair", why) ] -> contains why "field order"
| _ -> false);
(* Widened: the other half of the same hazard and the one docs/BUILT.md names —
f64 where the library says float lays out eight bytes where there are
four, and every field after it moves. *)
check "a widened field is reported"
(match
Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Pair [x f32 y f64])\n")) dump
with
| [ ("Pair", why) ] -> contains why "f64" && contains why "f32"
| _ -> false);
(* A struct the header says nothing about is not a disagreement: a package
may describe something the library does not name. *)
check "a struct the header does not describe is left alone"
(Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Nowhere [q i32])\n")) dump
= []);
(* An enum field against the header's [int]. A Flan defenum lowers to
int32_t in a struct field exactly as it does in a parameter, so this is
the same four bytes with a better face on it and not a disagreement —
which is what let raylib's Camera3D.projection stop being an i32 with a
conversion function beside it. *)
check "an enum-typed field against the header's int is not reported"
(Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Mode [kind Mood scale f32])\n"))
dump
= []);
(* Symmetric: the header may be the side that names the enum. *)
check "an i32 field against the header's enum is not reported"
(Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Feel [mood i32 n i32])\n")) dump
= []);
(* And the whole point of the check survives it. The tolerance is for a
32-bit integer and nothing else, so the width hazard docs/BUILT.md names — f64
where the library says float — still fails, in the very struct whose
other field is an enum. *)
check "a widened field beside an enum field is still reported"
(match
Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Mode [kind Mood scale f64])\n"))
dump
with
| [ ("Mode", why) ] -> contains why "f64" && contains why "f32"
| _ -> false);
(* An enum is four bytes, so an enum against something that is not four
bytes is a real disagreement and stays one. *)
check "an enum against a field that is not 32 bits is still reported"
(match
Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Feel [mood i64 n i32])\n")) dump
with
| [ ("Feel", why) ] -> contains why "i64"
| _ -> false);
(* The same claim for a [defunion], and what it unlocked. A record holding a
union member used to be skipped entirely — not recorded, so the
[defstruct] beside it was unchecked too — because there was no Flan type
to compare the member against. There is one now, and [Slot] in the
fixture is checked member by member like any other struct. *)
let unions_of ds =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defunion (n, ms) -> Some (n, ms) | _ -> None)
ds
in
check "a defunion that matches the header is not reported"
(Cimport.check_unions ~env ~unions:(unions_of fixture_ds) dump = []);
check "and the struct holding it is checked rather than skipped"
(Cimport.check_structs ~env ~structs:(structs_of fixture_ds) dump = []);
check "a struct whose union member is given the wrong type is reported"
(match
Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Slot [kind i32 v Pair])\n"))
dump
with
| [ ("Slot", why) ] -> contains why "Overlay"
| _ -> false);
(* Order is the whole hazard for a struct and means nothing for a union:
every member is at offset zero, so a permuted defunion is the same type
and reporting it would be a finding that is not one. *)
check "a permuted defunion is not reported"
(Cimport.check_unions ~env
~unions:(unions_of (program "(defunion Overlay [f f32 i i32])\n")) dump
= []);
(* Missing is the one that changes the size, and a union embedded by value
puts every field after it in the wrong place. *)
check "a defunion missing a member is reported"
(match
Cimport.check_unions ~env
~unions:(unions_of (program "(defunion Overlay [i i32])\n")) dump
with
| [ ("Overlay", why) ] -> contains why "f" && contains why "widest"
| _ -> false);
check "a defunion with a member the header lacks is reported"
(match
Cimport.check_unions ~env
~unions:(unions_of
(program "(defunion Overlay [i i32 f f32 d f64])\n")) dump
with
| [ ("Overlay", why) ] -> contains why "d"
| _ -> false);
check "a defunion whose member is the wrong width is reported"
(match
Cimport.check_unions ~env
~unions:(unions_of (program "(defunion Overlay [i i32 f f64])\n")) dump
with
| [ ("Overlay", why) ] -> contains why "f64" && contains why "f32"
| _ -> false);
(* Two different layouts under one name, which is the same class of finding
a permuted struct is and has a one-keyword fix. *)
check "a defstruct against a union in the header is reported"
(match
Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Overlay [i i32 f f32])\n"))
dump
with
| [ ("Overlay", why) ] -> contains why "union in the header"
| _ -> false);
check "a defunion against a struct in the header is reported"
(match
Cimport.check_unions ~env
~unions:(unions_of (program "(defunion Pair [x f32 y f32])\n")) dump
with
| [ ("Pair", why) ] -> contains why "struct in the header"
| _ -> false);
check "a union the header does not describe is left alone"
(Cimport.check_unions ~env
~unions:(unions_of (program "(defunion Nowhere [q i32])\n")) dump
= []);
(* And the gap that remains, said out loud so it is a decision rather than
an oversight: an anonymous union member has no name and no Flan
spelling, so the record holding one is still not recorded and the
defstruct beside it is still unchecked rather than checked wrongly. *)
check "a record with an anonymous union member is still skipped"
(Cimport.check_structs ~env
~structs:(structs_of (program "(defstruct Anon [kind i32 junk i32])\n"))
dump
= []);
(* ── The constants (Cimport.check_constants) ───────────────────── *)
(* The half of generate-c's claim that used to be missing. A wrong flag bit
and a wrong enum member are the two errors here that are completely
silent — no link error, no type error — which is exactly the class the
header read exists to catch.
Shading is anonymous in sample.h and its typedef carries the name, which
is how raylib writes every one of its enums; SHADE_DARK has no
initialiser, so 6 is counted rather than read. *)
let const_fixture ?(mood = "[calm 0 cross 1]")
?(shading = "[light 4 mid 5 dark 6 half-dark 9]") ?(fancy = "4")
?(extra = "") () =
Printf.sprintf
"(defenum Mood %s)\n\
(defenum Shading %s)\n\
(defconst opt-loud u32 1)\n\
(defconst opt-fast u32 2)\n\
(defconst opt-fancy-mode u32 %s)\n\
(defconst lucky u32 7)\n\
%s"
mood shading fancy extra
in
let enums_of ds =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defenum (n, ms) -> Some (n, ms) | _ -> None)
ds
and pconsts_of ds =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.Defconst (n, _, e) -> Some (n, e) | _ -> None)
ds
in
let mapping =
{ Cimport.no_config with
Cimport.enum_prefixes = [ ("Mood", "MOOD_"); ("Shading", "SHADE_") ];
const_prefixes = [ ("opt-", "OPT_") ];
(* SHADE_HALFDARK is one word where its siblings are underscored, so the
prefix rule cannot reach it. The narrow exception, said once. *)
constants = [ ("Shading/half-dark", "SHADE_HALFDARK") ] }
in
let raw_constants ?(config = mapping) src =
Cimport.check_constants ~config ~enums:(enums_of (program src))
~consts:(pconsts_of (program src)) dump
in
let constants ?(config = mapping) src =
List.map
(fun (x : Cimport.const_diff) -> (x.Cimport.cname, x.Cimport.cwhy))
(raw_constants ~config src)
in
check "constants that agree with the header are not reported"
(constants (const_fixture ()) = []);
(* The value is compared, which is the whole point: 340 is KEY_LEFT_SHIFT
and 341 is a key that never fires. *)
check "a wrong enum member value is reported, by its C name"
(match constants (const_fixture ~mood:"[calm 0 cross 2]" ()) with
| [ ("Mood/cross", why) ] ->
contains why "MOOD_CROSS" && contains why "is 2 here"
| _ -> false);
(* An enumerator with no [= n] carries no value in clang's dump at all, so
it has to be counted the way C counts it. raylib's TraceLogLevel is eight
members with one initialiser between them. *)
check "an implicitly-numbered enumerator is counted, not skipped"
(match
constants
(const_fixture ~shading:"[light 4 mid 5 dark 7 half-dark 9]" ())
with
| [ ("Shading/dark", why) ] ->
contains why "SHADE_DARK" && contains why "is 6 in the header"
| _ -> false);
(* A name the rule builds and the header does not have is reported and not
skipped. A mapping that quietly matched nothing would read as coverage
and provide none, which would be worse than no check. *)
check "a member the header has no constant for is reported"
(match constants (const_fixture ~mood:"[calm 0 cross 1 murky 2]" ()) with
| [ ("Mood/murky", why) ] -> contains why "no constant named MOOD_MURKY"
| _ -> false);
(* The defconst half. These are raylib's 16 ConfigFlags bits. *)
check "a wrong defconst value is reported"
(match constants (const_fixture ~fancy:"8" ()) with
| [ ("opt-fancy-mode", why) ] ->
contains why "OPT_FANCY_MODE" && contains why "is 4 in the header"
| _ -> false);
(* And a defconst no rule reaches is not reported: a package's constants are
mostly its own, and raylib's 26 colours have no enumerator behind them. *)
check "a defconst no rule reaches is left alone"
(constants (const_fixture ~extra:"(defconst unmapped u32 99)\n" ()) = []);
(* The [constant] line is what reaches a name the prefix rule gets wrong. *)
check "without the constant line the odd name is reported"
(match
constants ~config:{ mapping with Cimport.constants = [] }
(const_fixture ())
with
| [ ("Shading/half-dark", why) ] ->
contains why "no constant named SHADE_HALF_DARK"
| _ -> false);
(* The Flan-side member prefix, declared as the enum line's fourth column.
raylib's Key spells its members key-r, key-space — a bare member name
collides across enums — and the C name is built by stripping that prefix
first, so key-r is KEY_R and not KEY_KEY_R. *)
let prefixed =
{ mapping with Cimport.enum_flan_prefixes = [ ("Mood", "mood-") ] }
in
check "a declared Flan member prefix is stripped before the C name is built"
(constants ~config:prefixed
(const_fixture ~mood:"[mood-calm 0 mood-cross 1]" ())
= []);
check "a wrong value is still caught through the stripped prefix"
(match
constants ~config:prefixed
(const_fixture ~mood:"[mood-calm 0 mood-cross 2]" ())
with
| [ ("Mood/mood-cross", why) ] ->
contains why "MOOD_CROSS" && contains why "is 2 here"
| _ -> false);
(* A member that does not carry the declared prefix is a finding, not a
member checked under a guessed name: `calm` beside a declared `mood-`
would otherwise build MOOD_CALM, which the header has, and the naming
rule the line declares would erode silently. *)
check "a member without the declared Flan prefix is a mapping finding"
(match raw_constants ~config:prefixed (const_fixture ()) with
| [ a; b ] ->
a.Cimport.cmapping && b.Cimport.cmapping
&& contains a.Cimport.cwhy "carry the prefix mood-"
&& contains b.Cimport.cwhy "carry the prefix mood-"
| _ -> false);
(* Coverage itself must not go quiet. A defenum nobody mapped would be
silently unchecked, which is the same hole one level up. *)
check "a defenum with no enum line is itself a finding"
(match constants (const_fixture ~extra:"(defenum Nobody [a 0])\n" ()) with
| [ ("Nobody", why) ] -> contains why "no `enum` line"
| _ -> false);
(* And the way to say so deliberately, for an enum the header cannot check. *)
check "enum - excuses an enum the header says nothing about"
(constants
~config:
{ mapping with
Cimport.enum_prefixes = ("Nobody", "-") :: mapping.Cimport.enum_prefixes }
(const_fixture ~extra:"(defenum Nobody [a 0])\n" ())
= []);
(* A rule that reaches nothing is a typo, and it would otherwise read as
coverage. *)
check "an enum rule naming no defenum is reported"
(match
constants
~config:
{ mapping with
Cimport.enum_prefixes =
("Ghost", "G_") :: mapping.Cimport.enum_prefixes }
(const_fixture ())
with
| [ ("Ghost", why) ] -> contains why "names no defenum"
| _ -> false);
check "a const rule matching no defconst is reported"
(match
constants
~config:
{ Cimport.no_config with Cimport.const_prefixes = [ ("zzz-", "ZZZ_") ] }
"(defconst lucky u32 7)\n"
with
| [ ("zzz-", why) ] -> contains why "matches no defconst"
| _ -> false);
check "a constant line naming nothing is reported"
(match
constants
~config:
{ Cimport.no_config with
Cimport.constants = [ ("Mood/nope", "MOOD_NOPE") ] }
"(defconst lucky u32 7)\n"
with
| [ ("Mood/nope", why) ] -> contains why "names no defconst"
| _ -> false);
(* The two kinds of finding are told apart, because they have different
dispositions: a value that disagrees with the library stops an ordinary
build, and an enum nobody wrote a line for is about the package's own
config and gates `generate-c` instead. *)
check "a value disagreement is not a mapping finding"
(match raw_constants (const_fixture ~fancy:"8" ()) with
| [ x ] -> not x.Cimport.cmapping
| _ -> false);
check "an unmapped defenum is a mapping finding"
(match raw_constants (const_fixture ~extra:"(defenum Nobody [a 0])\n" ()) with
| [ x ] -> x.Cimport.cmapping
| _ -> false);
(* The name rule, which is not an inverse of kebab and does not need to be:
a constant has no declaration to store its C spelling in. *)
List.iter
(fun (flan, c) ->
check
(Printf.sprintf "screaming %s -> %s" flan c)
(String.equal (Cimport.screaming flan) c))
[ ("left-shift", "LEFT_SHIFT"); ("msaa-4x-hint", "MSAA_4X_HINT");
("a", "A"); ("window-mouse-passthrough", "WINDOW_MOUSE_PASSTHROUGH") ];
(* diff_bound: a hand-written declare-c against the header's own signature.
This is the check with no other source — a wrong declare-c is wrong in the
generated prototype too, so the two halves agree with each other and only
the library knows better. *)
let bound_of src =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with Ast.DeclareC (fn, sym) -> Some (fn, sym) | _ -> None)
(program src)
in
let differs name src needle =
check ("declare-c against the header: " ^ name)
(match Cimport.diff_bound ~env ~bound:(bound_of src) dump with
| [ d ] -> contains d.Cimport.dwhy needle
| _ -> false)
in
check "a declare-c that matches the header is not reported"
(Cimport.diff_bound ~env
~bound:(bound_of "(declare-c add [a i32 b i32] i32 \"add_ints\")") dump
= []);
differs "a wrong parameter width"
"(declare-c add [a f64 b i32] i32 \"add_ints\")" "parameter a is f64";
differs "a wrong arity" "(declare-c add [a i32] i32 \"add_ints\")"
"the header says 2";
differs "a wrong return type"
"(declare-c add [a i32 b i32] f32 \"add_ints\")" "returns f32";
(* A symbol the header does not have at all is the version-drift case, and
it is how a package pinned to the wrong release announces itself. *)
differs "a symbol the header does not declare"
"(declare-c gone [] \"no_such_function\")" "does not declare";
(* An enum face against a plain int is the expected difference and not a
finding: that is what a defenum is at the boundary. *)
check "an enum face against the header's int is not a difference"
(Cimport.diff_bound ~env
~bound:(bound_of "(declare-c mv [m Mood] i32 \"mood_value\")") dump
= []);
(* The pointer arm. The importer renders a C pointer into whichever Flan type
it thinks is the nicest face — [const char *] becomes [string], [void *]
becomes [(Ptr u8)] — and a hand-written line that wants the raw address
instead is disagreeing with that choice rather than with the header. These
say which of those disagreements are real. *)
let agreed name src =
check ("declare-c against the header: " ^ name)
(Cimport.diff_bound ~env ~bound:(bound_of src) dump = [])
in
(* The case docs/PORTING.md §A.1 could not write: GetCodepointPrevious reads
backwards from its pointer, so a Flan string — which crosses as a
NUL-terminated copy — is the one thing it must not be handed. *)
agreed "a (Ptr u8) where the header says const char *"
"(declare-c name-length [text (Ptr u8)] i32 \"name_length\")";
(* And the string face goes on being right, because this is an addition. *)
agreed "a string where the header says const char *"
"(declare-c name-length [text string] i32 \"name_length\")";
agreed "a pointer that matches the header exactly"
"(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")";
(* void * is opaque about what it points at, so there is no element type in
the header to disagree with — §A.2's LoadImageColors → UpdateTexture. *)
agreed "any pointer where the header says void *"
"(declare-c blit [dst (Ptr Pair) src (Ptr Shade) n i32] \"blit\")";
agreed "any pointer where the header returns void *"
"(declare-c scratch [n i32] (Ptr Pair) \"scratch\")";
(* An enum through a pointer is the same four bytes an enum is beside one. *)
agreed "a (Ptr enum) where the header says a pointer to int"
"(declare-c count-at [values (Ptr Mood) n i32] i32 \"count_at\")";
(* And the refusals, which are the whole value of the arm: a binding that
lies about the header still has to be caught, and the message still has to
name the disagreement. *)
differs "a pointer to the wrong named type"
"(declare-c pair-len-p [p (Ptr Shade)] f32 \"pair_len_p\")"
"parameter p is (Ptr Shade) and the header says (Ptr Pair)";
differs "a pointer to the wrong width"
"(declare-c count-at [values (Ptr f64) n i32] i32 \"count_at\")"
"parameter values is (Ptr f64)";
(* void * gives up the element type and nothing else. It is still a pointer,
and a scalar declared against one is still a finding. *)
differs "a scalar where the header says void *"
"(declare-c blit [dst i64 src (Ptr u8) n i32] \"blit\")"
"parameter dst is i64";
differs "a scalar where the header says a pointer"
"(declare-c count-at [values i32 n i32] i32 \"count_at\")"
"parameter values is i32";
(* The byte tolerance is the pointee's and not the world's: inside a pointer
i8 and u8 are two spellings of one byte, and as a scalar they are not. *)
differs "a byte where the header says a wider integer"
"(declare-c add [a u8 b i32] i32 \"add_ints\")" "parameter a is u8";
(* The name rule. Reversibility is by storage — the C symbol is kept verbatim
in the declaration — so what the rule has to be is injective over one
header, which the collision case above asserts. These pin its shape. *)
List.iter
(fun (c, flan) ->
check
(Printf.sprintf "kebab %s -> %s" c flan)
(String.equal (Cimport.kebab c) flan))
[ ("InitWindow", "init-window");
(* An acronym stays one word rather than becoming separate letters. *)
("SetTargetFPS", "set-target-fps");
("ColorToHSV", "color-to-hsv");
("UnloadUTF8", "unload-utf8");
(* A digit run takes the uppercase after it, so 2D is one word. *)
("BeginMode2D", "begin-mode-2d");
("GetScreenToWorld2D", "get-screen-to-world-2d");
("snake_case_already", "snake-case-already") ];
(* cjson.ml, on the shapes clang's dump actually contains. *)
check "json: an escaped string"
(match Cjson.parse "{\"a\":\"x\\ny\"}" with
| Cjson.Obj [ ("a", Cjson.Str "x\ny") ] -> true
| _ -> false);
check "json: nesting, numbers, booleans and null"
(match Cjson.parse "{\"i\":[1,-2,3.5e2],\"b\":true,\"n\":null}" with
| Cjson.Obj
[ ("i", Cjson.Arr [ _; _; _ ]); ("b", Cjson.Bool true);
("n", Cjson.Null) ] -> true
| _ -> false);
check "json: empty containers"
(match Cjson.parse "{\"a\":{},\"b\":[]}" with
| Cjson.Obj [ ("a", Cjson.Obj []); ("b", Cjson.Arr []) ] -> true
| _ -> false);
check "json: trailing bytes are refused"
(match Cjson.parse "{} x" with
| _ -> false
| exception Cjson.Bad _ -> true);
(* ── Lifted function names, and why they are counted per kind ────────
A handler clause and an fn literal are both lifted into functions of their
own, and both are numbered within the function they came out of. One
shared counter would mean that adding a handler-bind above an existing fn
renamed the fn — a rename for a body that did not change, in exactly the
names a dev redefinition module emits and matches on. These check that
each sequence is stable against the other. *)
let lifted_names src =
List.filter_map
(fun (f : Tast.fn) ->
match f.Tast.fparent with Some _ -> Some f.Tast.name | None -> None)
(Check.program (Parse.program (read src))).Tast.fns
in
let with_handler =
"(defstruct Boom [n i32]) (defonce hit i32) \
(defn u [f (Fn [i32] i32)] i32 (f 1)) \
(defn m [] i32 \
(handler-bind [(Boom [c] (set hit (.n c)))] (u (fn [x] x))) 0)"
in
let without_handler =
"(defstruct Boom [n i32]) (defonce hit i32) \
(defn u [f (Fn [i32] i32)] i32 (f 1)) \
(defn m [] i32 (u (fn [x] x)) 0)"
in
check "an fn keeps its number when a handler-bind is added beside it"
(List.mem "fn/m/0" (lifted_names with_handler)
&& List.mem "fn/m/0" (lifted_names without_handler));
check "and the handler clause has a sequence of its own"
(List.exists
(fun n -> contains n "handler/m/0/Boom") (lifted_names with_handler));
(* ── The prelude's own macro calls, and the bootstrap that allows them ──
A macro module is compiled *from* the prelude, so a prelude function that
calls a prelude macro cannot be in the module that would expand it. The
answer is [Macro.reduce]: for that one build the prelude loses every defn
depending on a macro, directly or transitively. These check the reduction
itself, since the thing it prevents is a cycle and a cycle does not show
up as a wrong answer — it shows up as a build that cannot start. *)
let names_of forms =
List.filter_map
(fun (f : Form.t) ->
match f.Form.v with
| Form.List ({ Form.v = Form.Sym ("defn" | "defmacro"); _ }
:: { Form.v = Form.Sym n; _ } :: _) -> Some n
| _ -> None)
forms
in
let reduced = names_of (Macro.reduce (Prelude.forms ())) in
let full = names_of (Prelude.forms ()) in
check "the reduced prelude drops a defn that calls a macro"
(List.mem "format-f64" full && not (List.mem "format-f64" reduced));
(* The macros survive — they are what the module is being built to export —
and so does everything that does not reach one, which is almost all of it. *)
check "the reduced prelude keeps the macros themselves"
(List.mem "clamp" reduced && List.mem "unless" reduced);
check "the reduced prelude keeps a defn that calls no macro"
(List.mem "join" reduced && List.mem "split" reduced);
(* Transitively: a caller of a dropped function is as unbuildable as the
function, so it goes too. Written against a synthetic prelude rather than
the real one, which has no such chain today. *)
let synth src = Reader.read_all ~file:"<synth>" src in
let chain =
synth
"(defmacro m [& args] `(do))\n\
(defn a [] () (m))\n\
(defn b [] () (a))\n\
(defn c [] () (do))\n"
in
check "the reduction is transitive"
(names_of (Macro.reduce chain) = [ "m"; "c" ]);
(* And the one rule that stays: a prelude macro may not call a macro. It used
to fail as an unknown name inside a clang build; it names itself now. *)
let ring = synth "(defmacro m [& args] `(do))\n(defmacro n [& args] (m args))\n" in
check "a prelude macro calling a macro is refused by name"
(match Macro.reduce ring with
| _ -> false
| exception Loc.Error { Loc.dmsg = m; _ } ->
contains m "the prelude macro n calls a macro");
(* ── Diagnostics: kind, notes, and more than one ───────────────
The house rule is that a test asserts the *reason* a thing is refused. A
kind is that assertion made stable: the message may be reworded and the
row still holds, and a row that matches on a kind is saying something a
substring match on prose could only approximate. The messages themselves
are unchanged, so every existing needle still means what it meant. *)
let diag_of src =
match checked src with
| _ -> None
| exception Loc.Error d -> Some d
in
let kind_is name src k =
check name (match diag_of src with Some d -> d.Loc.kind = k | None -> false)
in
kind_is "unknown name has a kind"
"(defn f [] i32 nope)" "check/unknown-name";
kind_is "unknown field has a kind"
"(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" "check/unknown-field";
kind_is "a name defined twice has a kind"
"(defn f [] i32 1)\n(defn f [] i32 2)" "check/defined-twice";
(* The note is the half a location and a string could never carry: the
*other* place, with its own span and its own explanation. *)
(match diag_of "(defn f [] i32 1)\n(defn f [] i32 2)" with
| Some d ->
check "defined twice points at the second" (d.Loc.dloc.Loc.line = 2);
(match d.Loc.notes with
| [ n ] ->
check "and notes the first" (n.Loc.nloc.Loc.line = 1);
check "and says what it is" (contains n.Loc.nmsg "already defined")
| ns -> check "defined twice has one note" (ns = []))
| None -> check "defined twice is refused" false);
(match diag_of "(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" with
| Some d ->
(match d.Loc.notes with
| [ n ] ->
check "an unknown field notes the declaration"
(n.Loc.nloc.Loc.line = 1);
check "and lists the fields there" (contains n.Loc.nmsg "with a")
| _ -> check "an unknown field has one note" false)
| None -> check "an unknown field is refused" false);
(* The call argument, which is the most-hit refusal in the compiler and was
the one that said least: the caret was right and the sentence never named
which argument of which function, nor pointed at the parameter that
wanted the other type. Both halves are asserted here, plus the rule that
keeps the claim honest — a mismatch *inside* an argument is not this
argument's, and is left as it was. *)
(match diag_of "(defn add [a i32 b i32] i32 (+ a b))\n (defn f [] i32 (add 1 \"two\"))" with
| Some d ->
check "a bad call argument has a kind" (d.Loc.kind = "check/argument-type");
check "and says which argument of which function"
(contains d.Loc.dmsg "this is the 2nd argument of add");
(match d.Loc.notes with
| [ n ] ->
check "and notes the parameter's declaration" (n.Loc.nloc.Loc.line = 1);
check "and names the parameter"
(contains n.Loc.nmsg "add's 2nd parameter b is declared i32")
| _ -> check "a bad call argument has one note" false)
| None -> check "a bad call argument is refused" false);
(match diag_of "(defn add [a i32 b i32] i32 (+ a b))\n (defn f [] i32 (add 1 (add 2 \"x\")))" with
| Some d ->
let times needle hay =
let n = String.length needle in
List.length
(List.filter
(fun i -> String.length hay - i >= n && String.sub hay i n = needle)
(List.init (max 1 (String.length hay)) Fun.id))
in
(* Named once, by the call that owns it. The outer call sees a refusal
raised against a span that is not its argument's and passes it on
untouched, which is what stops "the 2nd argument of add" being said
twice about two different forms. *)
check "the inner call owns its own argument, and says so once"
(times "argument of add" d.Loc.dmsg = 1)
| None -> check "a nested bad argument is refused" false);
(* The condition, which used to state a type fact and stop. The rule has two
halves and the dyn half is not the typed half — a dyn condition is
Clojure's, where 0 is true — so the comparison is offered only where it
is right, and with the condition's own name where it has one. *)
rejects_check "a non-bool condition states the rule"
"(defn f [] i32 (let [x 1] (if x 1 0)))"
~needle:"a condition is a bool or a dyn, and this is i32 — test it, as (!= x 0)";
rejects_check "and offers no template for a form it cannot name"
"(defn f [] i32 (if (+ 1 2) 1 0))"
~needle:"this is i32 — test it against 0 with !=";
rejects_check "and offers no comparison at all for a type that has none"
"(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (if p 1 0)))"
~needle:"a condition is a bool or a dyn, and this is P";
(* A literal still names itself: that message knows something the rule does
not, so the re-check's answer is kept wherever it is more specific. *)
rejects_check "a literal condition keeps its own message"
"(defn f [] i32 (if 1 1 2))"
~needle:"expected bool, found the integer literal 1";
(* Four words before this: the name and the fact. The declaration is where
the reader's next move is, so it comes along. *)
(match diag_of "(defconst k 1)\n(defn f [] () (set k 2))" with
| Some d ->
check "assigning a constant has a kind" (d.Loc.kind = "check/set-constant");
(match d.Loc.notes with
| [ n ] ->
check "and notes the defconst" (n.Loc.nloc.Loc.line = 1);
check "and says what it is"
(contains n.Loc.nmsg "k is declared a constant here")
| _ -> check "assigning a constant has one note" false)
| None -> check "assigning a constant is refused" false);
(* A type annotation in a let is the first thing anyone arriving from a
typed language writes, and let has no slot for one. The old refusal
landed on the form left over — "binding 5 has no value" — which reads as
if they had miscounted. Only checked on the path that was refusing
anyway, so a binding vector that parses is never examined for it. *)
(match (try ignore (program "(defn f [] i32 (let [x i32 5] x))"); None
with Loc.Error d -> Some d) with
| Some d ->
check "a let annotation has a kind" (d.Loc.kind = "parse/let-type-annotation");
check "and blames the annotation, not the leftover"
(contains d.Loc.dmsg "a let binding takes no type annotation, so i32 \
here is read as the value and 5 is left with no \
name")
| None -> check "a let annotation is refused" false);
(match (try ignore (program "(defn f [] i32 (let [x 1 y] x))"); None
with Loc.Error d -> Some d) with
| Some d ->
check "and an ordinary odd binding vector is unchanged"
(contains d.Loc.dmsg "binding y has no value")
| None -> check "an odd binding vector is refused" false);
(* The operand, not the whole form — the same "whole form vs operand" the
condition work already fixed once. Text gets the extra clause, because
(+ "a" "b") is a reach for concatenation. *)
(match diag_of "(defn f [] () (println (+ \"a\" \"b\")))" with
| Some d ->
check "a non-numeric operand is blamed at the operand"
(d.Loc.dloc.Loc.col = 27);
check "and text is told where concatenation lives"
(contains d.Loc.dmsg
"+ takes numbers, and this is string — there is no + on text. The \
prelude concatenates with concat and join")
| None -> check "a non-numeric operand is refused" false);
(* The return slot, not whatever inside it the type parser gave up on. For
(defn f [x i32] (+ x 1)) that was the 1, three forms deep, where the
mistake is that the whole form is in the slot. What the type parser said
keeps its own span as a note. *)
(match (try ignore (program "(defn f [x i32] (+ x 1))"); None
with Loc.Error d -> Some d) with
| Some d ->
check "a body in the return slot blames the slot" (d.Loc.dloc.Loc.col = 17);
check "and says what is there"
(contains d.Loc.dmsg
"the return type goes here, and this is (+ x 1) — every defn states \
one, and a function that returns nothing writes ()");
check "and keeps the type parser's reason as a note"
(match d.Loc.notes with
| [ n ] -> contains n.Loc.nmsg "expected a type, found 1"
| _ -> false)
| None -> check "a body in the return slot is refused" false);
(* A one-field case binds the payload itself, so the destructuring reach
that follows gets a type fact where it needs to be told the value is
already in hand. Only where the pattern is what bound it: an ordinary
local keeps the sentence it had. *)
rejects_check "a case payload says the field is already in hand"
"(defdata Shape [(Circle [r f64]) (Square [s f64])]) \
(defn f [s Shape] f64 (match s (Circle c) (.r c) (Square q) 0.0))"
~needle:"c is f64 — the pattern bound it to Shape.Circle's field r, so \
the value is already in hand and there is no field left to read";
rejects_check "and an ordinary local keeps the type fact"
"(defn f [] i32 (let [x 1] (.r x)))"
~needle:"i32 is not a struct, so it has no fields";
(* "Allow shadowing but warn": a defn whose name is a builtin's is legal,
it wins at the call sites of the file that wrote it, and the compiler
says so once at the definition.
This used to be the other way round — the dispatch reached every builtin
arm before it looked in the function table, so the defn was silently
unreachable and the arity refusal carried a note saying so. That note
described a resolution order this compiler no longer has, and the source
below, which used to be refused, is the one that proves it: (get p) is
one argument, and the builtin get takes two. *)
let shadow_src =
"(defstruct P [x i32])\n(defn get [p P] i32 (.x p))\n\
(defn f [] i32 (let [p (P {.x 1})] (get p)))"
in
(match Check.shadowed_builtins (program shadow_src) with
| [ d ] ->
check "a defn named after a builtin is warned about, at the definition"
(d.Loc.kind = "check/shadows-builtin"
&& d.Loc.dloc.Loc.line = 2 && d.Loc.dloc.Loc.col = 7);
check "and the warning says what the name now means"
(d.Loc.dmsg
= "get shadows the builtin get — every call in this program now \
reaches your definition — the builtin stays reachable as \
builtin/get");
check "and it carries no notes, being one sentence about one decision"
(d.Loc.notes = [])
| _ -> check "a shadowing defn is warned about exactly once" false);
check "and the call reaches the defn, at the defn's arity"
(match checked shadow_src with
| _ -> true
| exception Loc.Error _ -> false);
check "a program that shadows nothing is warned at not at all"
(Check.shadowed_builtins (program "(defn f [] i32 1)") = []);
(* An operator is a builtin like any other and shadows like any other.
Pinned in both halves because it is the case most likely to be thought
of as special and quietly excepted later: the warning is the same
sentence, and the call is a [Call] to the definition rather than the
[Add] prim it would otherwise have lowered to. *)
let plus_src = "(defn + [a i32 b i32] i32 99)\n(defn f [] i32 (+ 1 2))" in
(match Check.shadowed_builtins (program plus_src) with
| [ d ] ->
check "an operator shadowed by a defn warns like any other builtin"
(d.Loc.kind = "check/shadows-builtin"
&& d.Loc.dmsg
= "+ shadows the builtin + — every call in this program now \
reaches your definition — the builtin stays reachable as \
builtin/+")
| _ -> check "a shadowed operator warns exactly once" false);
(match checked plus_src with
| p ->
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "f") p.Tast.fns with
| Some { Tast.body = [ { Tast.e = Tast.Call ("+", _); _ } ]; _ } -> ()
| _ -> check "a shadowed operator's call reaches the defn" false)
| exception _ -> check "a shadowed operator's call reaches the defn" false);
(* And the file the definition was written in is what the shadow follows.
Same declaration list, a call whose location is another file: the
builtin, whose arity this call does not satisfy. This is the package
global-initialiser case at its smallest — an initialiser is checked with
no enclosing function, so the enclosing name cannot be what decides.
The shadowing defn takes *two* parameters and the builtin takes one, so
the two readings cannot produce the same sentence: reaching the builtin
is a refusal measured at one, and reaching the defn is no refusal at
all. With both at one argument this check passed under either
resolution, which is a check that cannot fail — found in review. *)
(match
Check.program
(program "(defn len [a string b string] i32 999)"
@ Parse.program (read ~file:"<elsewhere>" "(defn g [] i32 (len \"a\" \"b\"))"))
with
| _ -> check "a call in another file does not reach the shadow" false
| exception Loc.Error d ->
check "a call in another file reaches the builtin, at the builtin's arity"
(contains d.Loc.dmsg "len takes 1 argument, given 2"));
(* ── builtin/, the reserved qualifier ──────────────────────────────
The escape from the dead end above: [builtin/len] is the builtin [len]
whatever the file has decided [len] means. Pinned from both ends —
with a shadow in the way and with nothing in the way at all — because a
spelling that only worked while some other declaration existed would be
one nobody could write down in advance. *)
accepts "builtin/ is legal with nothing shadowed"
"(defn f [] i32 (builtin/len \"abcd\"))";
(* The pair that says the two spellings part company. One declaration list,
two calls: the shadow takes two arguments and the builtin takes one, so
each call is refusable only under one of the two readings. The bare name
at two arguments checks, and the qualified one at two arguments is
measured against the builtin's arity. *)
accepts "the bare name reaches the shadowing defn"
"(defn len [a string b string] i32 999)\n\
(defn f [] i32 (len \"a\" \"b\"))";
rejects_check "and builtin/ beside it reaches the builtin"
"(defn len [a string b string] i32 999)\n\
(defn f [] i32 (builtin/len \"a\" \"b\"))"
~needle:"len takes 1 argument, given 2";
(* The program the earlier lane could not write: a shadowing defn that
*wraps* what it shadows. Without the qualifier the inner call reached
the definition being written and the program stack-overflowed at run
time; what is pinned here is that the body holds no call to [len] at
all, which is the difference between a wrapper and a loop. *)
(match checked "(defn len [s string] i32 (builtin/+ 1 (builtin/len s)))" with
| p ->
let recurs = ref false in
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "len") p.Tast.fns with
| Some f ->
List.iter
(Tast.walk (fun (e : Tast.expr) ->
match e.Tast.e with
| Tast.Call ("len", _) -> recurs := true
| _ -> ()))
f.Tast.body;
check "a shadowing defn wraps the builtin instead of recurring"
(not !recurs)
| None -> check "the wrapping defn is checked" false)
| exception Loc.Error d ->
check "a shadowing defn wraps the builtin instead of recurring" false;
print_endline d.Loc.dmsg);
(* An operator through the qualifier, which is the case a reader would
expect to need an exception and does not: the reader takes [builtin/+]
as one symbol, and the call lowers to the [Add] prim even with [+]
shadowed two lines above. *)
(match checked "(defn + [a i32 b i32] i32 99)\n\
(defn f [] i32 (builtin/+ 1 2))" with
| p ->
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "f") p.Tast.fns with
| Some { Tast.body = [ { Tast.e = Tast.Prim (Tast.Add, _); _ } ]; _ } -> ()
| _ -> check "builtin/+ is the operator and not the shadowing defn" false)
| exception _ ->
check "builtin/+ is the operator and not the shadowing defn" false);
(* The value arms reach the same way, and [builtin/context/allocator] falls
out of one strip rather than needing a rule of its own. *)
accepts "a builtin written as a name is qualified too"
"(defn f [] dyn builtin/nil)";
accepts "and so is a builtin whose own name carries a slash"
"(defn f [] Allocator builtin/context/allocator)";
(* A builtin in a value position has nothing to hand back — it is an arm in
the compiler and has no address — and the refusal has to say so rather
than falling through to the function table, which holds the very
definition the qualifier was written to get away from. *)
rejects_check "a call-only builtin is refused as a value, not resolved"
"(defn len [s string] i32 1)\n(defn f [] () (println builtin/len))"
~needle:"builtin/len is the builtin len, which is a call and not a value";
(* The qualifier reaching nothing. Named as not a builtin, and the
did-you-mean is over the builtins alone. *)
(match diag_of "(defn f [] i32 (builtin/nosuch))" with
| Some d ->
check "builtin/ with no builtin behind it has its own kind"
(d.Loc.kind = "check/unknown-builtin");
check "and says what is wrong with it"
(d.Loc.dmsg
= "nosuch is not a builtin, so builtin/nosuch reaches nothing. The \
builtin/ qualifier reaches the compiler's own names and nothing \
else; an ordinary function is called by the name it was defined \
under")
| None -> check "builtin/nosuch is refused" false);
(match diag_of "(defn f [] i32 (builtin/lne \"ab\"))" with
| Some d ->
check "and a near miss is offered in the qualified spelling"
(d.Loc.dmsg
= "lne is not a builtin, so builtin/lne reaches nothing — did you \
mean builtin/len?")
| None -> check "builtin/lne is refused" false);
(* And the did-you-mean everywhere else is untouched: a bare typo is still
answered with a bare name, not with a qualifier nobody reached for. *)
rejects_check "an unqualified typo is not answered with builtin/"
"(defn f [] i32 (lne \"ab\"))" ~needle:"did you mean len?";
(* The reservation from the other side. [(defn builtin/len ...)] reads —
'/' is an ordinary symbol character — and would land in the function
table under a name nothing can ever call, because the prefix is stripped
before any table is consulted. *)
(match diag_of "(defn builtin/len [s string] i32 1)" with
| Some d ->
check "a declaration cannot take the reserved qualifier"
(contains d.Loc.dmsg
"builtin/len cannot be declared: builtin/ is a reserved qualifier")
| None -> check "a declaration under builtin/ is refused" false);
(* and's last operand is the then arm and the sentinel carrying the previous
operand's location is the else arm, so with no expectation in hand the
mismatch was reported one operand early. FIX.org's accepted fix: blame
the arm that is not a compiler temp. *)
(match diag_of "(defn f [] () (println (and true true (vec-new i32))))" with
| Some d ->
check "and blames its last operand, not the one before it"
(d.Loc.kind = "check/shortcircuit-operand" && d.Loc.dloc.Loc.col = 39);
check "and states what the two answers are"
(contains d.Loc.dmsg
"an and answers false when it stops early and its last operand \
otherwise, so the two have to be one type — this operand is (Vec \
i32), and false is a bool")
| None -> check "a mistyped and operand is refused" false);
(* The reader's own two-place error. The bracket that is open is the error
and the end of input is the note, because the fix goes at the first and
the surprise is at the second. *)
(match read "(f\n bad" with
| _ -> check "unclosed is refused" false
| exception Loc.Error d ->
check "unclosed has a kind" (d.Loc.kind = "reader/unclosed");
check "unclosed notes where the input ran out"
(match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.line = 2 | _ -> false));
(match read "(f x]" with
| _ -> check "a mismatched closer is refused" false
| exception Loc.Error d ->
check "a mismatched closer has a kind"
(d.Loc.kind = "reader/mismatched-closer");
check "and notes the opener"
(match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.col = 1 | _ -> false));
(* The unterminated string had neither half of that shape: one column on the
opening quote and no note at all, where its two neighbours in this file
both have one. *)
(match read "(println \"oops\n" with
| _ -> check "an unterminated string is refused" false
| exception Loc.Error d ->
check "unterminated string has a kind"
(d.Loc.kind = "reader/unterminated-string");
check "and says what is missing"
(contains d.Loc.dmsg "unterminated string — no closing quote");
check "and notes where the input ran out"
(match d.Loc.notes with
| [ n ] -> contains n.Loc.nmsg "the input ends here, still inside it"
| _ -> false));
(* More than one per run, which is the point of the whole batch. Three bad
bodies, three diagnostics, and the count is exact: a checker that reported
the first and a checker that reported thirty pieces of wreckage would both
fail this row. *)
(match
Check.program_all
(Parse.program_all
(read "(defn a [] i32 nope1)\n\
(defn b [] i32 nope2)\n\
(defn c [] i32 nope3)\n"))
with
| _ -> check "three bad bodies are refused" false
| exception Loc.Errors ds ->
check "three bad bodies give three errors" (List.length ds = 3);
check "and they are in source order"
(List.map (fun (d : Loc.diag) -> d.Loc.dloc.Loc.line) ds = [ 1; 2; 3 ]));
(* The parser resynchronises on a top-level form, so two bad declarations are
two errors rather than one. *)
(match Parse.program_all (read "(defn a)\n(defn b)\n") with
| _ -> check "two bad declarations are refused" false
| exception Loc.Errors ds ->
check "two bad declarations give two errors" (List.length ds = 2));
(* [Check.program] is a different function from [Check.program_all], and
that is the guarantee: the session calls this one, it raises one
diagnostic, and nobody can turn it into a list by passing a label. *)
(match Check.program (Parse.program (read "(defn a [] i32 nope1)\n\
(defn b [] i32 nope2)\n")) with
| _ -> check "Check.program still refuses" false
| exception Loc.Errors _ ->
check "Check.program never answers with a list" false
| exception Loc.Error _ -> ());
(* The first line of a report is exactly the GNU format compilation-mode
parses, and the squiggle is on an indented line under it, which that mode
ignores. Both halves are load-bearing and neither is visible from the
message alone. *)
(match diag_of "(defn f [] i32 nope)" with
| Some d ->
let lines = String.split_on_char '\n' (Loc.report d) in
(match lines with
| head :: rest ->
check "the first line is file:line:col: message"
(head = Loc.to_string d.Loc.dloc ^ ": " ^ d.Loc.dmsg);
check "and the rest is indented"
(List.for_all (fun l -> l = "" || l.[0] = ' ') rest)
| [] -> check "a report has a first line" false)
| None -> check "a report needs a diagnostic" false);
(* ── Generics: the syntax, the predicates, and the two defaults ── *)
(* The one syntax question the feature had, and how it stopped being one.
[{K V}] used to be a legal *return type* spelling for (Map K V), so a
defn with a map return type and a constraint map put two braces in a row
meaning different things. The brace spelling is now withdrawn from type
position entirely, so the slot after the return type can be nothing but
the constraint map, and braces in a type say where the spelling went. *)
accepts "a map return type, written the one way there is"
"(defn f [] (Map string i32) (map-new string i32))";
accepts "a map return type followed by a constraint map"
"(defn f [x $t] (Map string i32) {:where (equal? $t)} \
(do x (map-new string i32)))";
rejects_check "braces in type position say where the spelling went"
~needle:"written (Map K V)"
"(defn f [] {string i32} (map-new string i32))";
(* The predicates, and each one gating the operator it is for. *)
accepts "ordered? admits <"
"(defn less [a $t b $t] bool {:where (ordered? $t)} (< a b))";
accepts "equal? admits ="
"(defn same [a $t b $t] bool {:where (equal? $t)} (= a b))";
accepts "numeric? admits +"
"(defn add [a $t b $t] $t {:where (numeric? $t)} (+ a b))";
rejects_check "equal? does not admit <"
~needle:"nothing here says t is ordered?"
"(defn less [a $t b $t] bool {:where (equal? $t)} (< a b))";
(* The entailments, which are the reason a signature is one predicate long
rather than two. Every type the language orders is a number or an enum,
so it is equatable. *)
accepts "ordered? entails equal?"
"(defn same [a $t b $t] bool {:where (ordered? $t)} (= a b))";
accepts "numeric? entails ordered?"
"(defn less [a $t b $t] bool {:where (numeric? $t)} (< a b))";
(* ── integer? — the bound numeric? was one type too wide for ─────────
It admits every integer kind, signed and unsigned, at every width, and
refuses floats and everything else. It exists so a function that can be
generalized does not need a variant per numeric type: an integer body
under numeric? was instantiated at f32 and f64 too, which is why abs
stayed per-width for a milestone. It entails numeric? — every integer
is a number — so the arithmetic, the written 0 and the untyped integer
literal all come with it; the reverse entailment would let floats into
bit-and and does not exist. *)
accepts "integer? admits +, via the entailment"
"(defn bump [x $t] $t {:where (integer? $t)} (+ x 1))";
accepts "integer? admits <, via the entailment"
"(defn small? [x $t] bool {:where (integer? $t)} (< x 10))";
accepts "integer? admits bit-and"
"(defn low? [x $t] bool {:where (integer? $t)} (= (bit-and x 1) 1))";
accepts "integer? admits the shifts"
"(defn dbl [x $t] $t {:where (integer? $t)} (<< x 1))";
rejects_check "numeric? does not admit bit-and"
~needle:"nothing here says t is integer?"
"(defn low? [x $t] bool {:where (numeric? $t)} (= (bit-and x 1) 1))";
rejects_check "nor the shifts"
~needle:"nothing here says t is integer?"
"(defn dbl [x $t] $t {:where (numeric? $t)} (<< x 1))";
(* An integer?-bounded caller satisfies a numeric?-bounded callee: the
entailment carries across generic calls exactly as ordered?-over-equal?
does. *)
accepts "integer? carries a numeric? callee"
"(defn z? [x $t] bool {:where (numeric? $t)} (= x 0))\n\
(defn odd-z? [x $t] bool {:where (integer? $t)} (z? (bit-and x 1)))";
(* The integer literal is admitted at a bounded variable by the same arm
under both bounds — the bound promises the literal a meaning at every
type the variable can become, and integer?'s types are a subset of
numeric?'s. *)
accepts "an integer literal stands where an integer?-bounded $t is wanted"
"(defn bump [x $t] $t {:where (integer? $t)} (+ x 300))";
(* A float at integer?, refused at the call that asked, naming the bound. *)
rejects_check "a float does not instantiate an integer?-bounded variable"
~needle:"f64 does not answer integer?"
"(defn bump [x $t] $t {:where (integer? $t)} (+ x 1))\n\
(defn main [] () (println (bump 1.5)))";
(* And dyn is refused by the bound too — the clause's own refusal, the more
specific of the two answers, exactly as at numeric?. *)
rejects_check "dyn does not instantiate an integer?-bounded variable"
~needle:"dyn does not answer integer?"
"(defn bump [x $t] $t {:where (integer? $t)} (+ x 1))\n\
(defonce d dyn 5)\n\
(defn main [] () (println (bump d)))";
(* A float literal inside an integer?-bounded body is refused at the
definition, in the bound's own words: there is no instantiation at which
it means anything. *)
rejects_check "a float literal has no meaning under integer?"
~needle:"admits no float type"
"(defn h [x $t] $t {:where (integer? $t)} (+ x 1.5))";
(* ── Conversions under a bound ───────────────────────────────────────
A cast asks whether its operand is a number, and a type variable has no
type to answer with — so the bound answers, and the rule is the concrete
arm's rule read off the set a predicate admits: a conversion legal at
every type the bound admits is legal at the variable, and one illegal at
any of them is refused there. Each pair below is the same conversion
written twice, once generic and once concrete, and the two agree. *)
accepts "integer? admits (i32 x), the narrowing conversion"
"(defn to32 [x $t] i32 {:where (integer? $t)} (i32 x))";
accepts "and the concrete conversion it stands for"
"(defn to32 [x i64] i32 (i32 x))";
(* Widening an integer to a float is admitted for the reason every other
cast is: (f64 x) on a written i64 rounds above 2^53 and is not refused,
so the bound does not refuse it either. A conversion is not a promise
that the value survives. *)
accepts "integer? admits (f64 x), the widening one"
"(defn tof [x $t] f64 {:where (integer? $t)} (f64 x))";
accepts "and the concrete widening it stands for"
"(defn tof [x i64] f64 (f64 x))";
(* numeric? admits floats, so (i32 x) under it can truncate — which is
exactly what (i32 x) on a written f64 does, so refusing it at the
variable would make the generic stricter than the code it copies. *)
accepts "numeric? admits (i32 x), which may truncate a float"
"(defn to32 [x $t] i32 {:where (numeric? $t)} (i32 x))";
accepts "and the concrete truncation it stands for"
"(defn to32 [x f64] i32 (i32 x))";
accepts "integer? admits an unsigned target"
"(defn tou [x $t] u8 {:where (integer? $t)} (u8 x))";
(* ordered?, equal? and hashable? say what can be compared or keyed, not
what is a number, so a conversion under one of them alone is refused —
and the message says which predicate to write. *)
rejects_check "ordered? does not admit a conversion"
~needle:"The where clause says t is ordered?, and that does not make it \
a number — add (numeric? $t) to the where clause"
"(defn to32 [x $t] i32 {:where (ordered? $t)} (i32 x))";
rejects_check "nor does equal?"
~needle:"add (numeric? $t) to the where clause"
"(defn to32 [x $t] i32 {:where (equal? $t)} (i32 x))";
rejects_check "nor does hashable?"
~needle:"add (numeric? $t) to the where clause"
"(defn to32 [x $t] i32 {:where (hashable? $t)} (i32 x))";
(* With no clause at all the message hands over the whole clause rather
than a predicate to add to one that is not there. *)
rejects_check "an unbounded variable does not convert"
~needle:"i32 converts a number. Nothing here says t is a number — write \
{:where (numeric? $t)} at the head of the body"
"(defn to32 [x $t] i32 (i32 x))";
(* The operand of a cast to a *variable* target is asked the same question
the target was: the target's bound says nothing about a second variable
standing in the argument. *)
accepts "a cast to a variable target takes a numeric? operand"
"(defn conv [x $u y $t] $t {:where [(numeric? $t) (numeric? $u)]} \
(if (< y y) (t x) (t x)))";
rejects_check "a cast to a variable target refuses an ordered? operand"
~needle:"add (numeric? $u) to the where clause"
"(defn conv [x $u y $t] $t {:where [(numeric? $t) (ordered? $u)]} \
(if (< y y) (t x) (t x)))";
(* The enum direction, where the two numeric bounds part company: an enum
is an i32 and a float has no enum reading, so this conversion needs
integer? exactly — numeric? would admit an f64 copy that the concrete
arm two lines below refuses. *)
accepts "integer? admits the conversion to an enum"
"(defenum K [lo -1 hi 1])\n\
(defn as-k [n $t] K {:where (integer? $t)} (K n))";
rejects_check "numeric? does not, because it admits floats"
~needle:"K converts an integer to an enum. The where clause says t is \
numeric?, and that does not make it an integer — add \
(integer? $t) to the where clause"
"(defenum K [lo -1 hi 1])\n\
(defn as-k [n $t] K {:where (numeric? $t)} (K n))";
rejects_check "and the concrete float it stands for is refused too"
~needle:"K converts an integer to an enum, found f64"
"(defenum K [lo -1 hi 1])\n\
(defn as-k [n f64] K (K n))";
accepts "a variable read twice under one predicate"
"(defn twice [a $t] bool {:where (ordered? $t)} (< a a))";
rejects_check "a predicate nobody has heard of"
~needle:"is not a type predicate"
"(defn f [a $t] $t {:where (sortable? $t)} a)";
rejects_check "a predicate about a variable the signature never bound"
~needle:"is not a type variable of f"
"(defn f [a i32] i32 {:where (ordered? $t)} a)";
(* A generic monomorphises by rechecking its body at the concrete type
(instantiate re-walks the AST, it does not substitute into an
already-built Tast), so [equal? $t] instantiated at string reaches the
same [check.ml] arm the direct = on two string literals above does.
[ordered? $t] never gets that far at string: [instantiate] checks the
{:where} clause itself against the concrete type before the body is
rechecked at all, so the refusal is the predicate one, not [<]'s
no-built-in-comparison message — that one is for a string written
directly in an ordering, where there is no predicate in between to catch
it first. *)
accepts "equal? $t instantiated at string"
"(defn same [a $t b $t] bool {:where (equal? $t)} (= a b)) \
(defn f [] bool (same \"a\" \"b\"))";
rejects_check "ordered? $t instantiated at string"
~needle:"does not answer ordered?"
"(defn less [a $t b $t] bool {:where (ordered? $t)} (< a b)) \
(defn f [] bool (less \"a\" \"b\"))";
(* Everything copies since the second repeal, so a double use of a binding
needs no clause at all — and [copyable?] itself is gone, refused the way
any unknown predicate is, which is this pin's job to remember. *)
accepts "a type variable is usable twice with no clause"
"(defn twice [a $t b (Fn [$t $t] $t)] $t (b a a))";
rejects_check "copyable? is no longer a predicate"
~needle:"is not a type predicate"
"(defn twice [a $t b (Fn [$t $t] $t)] $t {:where (copyable? $t)} (b a a))";
(* The allow-list, and it has two members. println over a type variable is
deferred to the instantiation, because its legality is only decidable
after substituting — which is the one thing the abstract pass otherwise
refuses to do. *)
accepts "println over a type variable is deferred"
"(defn show [x $t] () {:where (equal? $t)} (println x))";
accepts "and so is print"
"(defn show [x $t] () {:where (equal? $t)} (print x))";
(* One generic argument defers the whole call, neighbours included. *)
accepts "a variadic println with a type variable among the arguments"
"(defn show [x $t] () {:where (equal? $t)} (println \"x:\" x 1))";
(* Variadic print/println: any number of arguments, zero included. The
acceptance program pins what comes out; these pin only what the checker
admits, and — the part a program cannot show — where a refusal lands. *)
accepts "println with no arguments" "(defn f [] () (println))";
accepts "print with no arguments" "(defn f [] () (print))";
accepts "println with three arguments of three types"
"(defn f [] () (println \"x:\" 5 true))";
(* An unprintable argument is refused at its own span, not the form's:
each argument is checked carrying its own loc, and render.ml fails on
the expression's loc. Column 43 is the [m], not the [(println]. *)
(let name = "an unprintable argument is refused at the argument" in
match checked "(defn f [m (Map i32 i32)] () (println \"x\" m))" with
| _ ->
incr failures;
Printf.printf "FAIL %s: expected a type error\n" name
| exception Loc.Error { Loc.dloc; dmsg; _ } ->
let got = Loc.to_string dloc in
if got <> "<test>:1:43" || not (contains dmsg "no printer for") then begin
incr failures;
Printf.printf "FAIL %s\n wanted: %s (no printer for)\n got: %s (%s)\n"
name "<test>:1:43" got dmsg
end);
(* A predicate a body relies on has to be carried by every signature between
it and the call site, or the refusal moves into code the caller did not
write. *)
rejects_check "a predicate is not carried through a generic call"
~needle:"has to be carried by every signature"
"(defn outer [s [$t]] () {:where (equal? $t)} (sort s))";
accepts "and is accepted when it is"
"(defn outer [s [$t]] () {:where (ordered? $t)} (sort s))";
(* ── A generic call inside an abandoned widening trial ──────────────
The two features land days apart and meet here. A binary operator whose
operands disagree re-checks the right one at the left one's type inside a
[trial], and on a refusal reconsiders with the join — so a generic call
written on the right is checked twice, once in a pass that is thrown
away. What the discarded pass leaves behind in [env] is the question, and
[env] is the program's table, not the form's: an instantiation made
during it does not go back out, because [instantiate] rewinds only a copy
whose *body* refused.
It does not have to. The answer is that the two passes cannot disagree
about which copy to make, and that is a consequence of the rule above
rather than luck: a generic call's instantiation is read off its
arguments and never off the ambient want — an unbound variable is checked
with no expectation at all, and a bound one no longer widens — so the
trial and the live pass ask [instantiate] for the same types, and the
second ask is a cache hit on the first. One copy is emitted, at the type
the arguments chose, and the widening happens around the call.
(twoq 2 3) is i32 both times; the i8 on the left is what moves. *)
(let p =
checked
"(defn twoq [a $t b $t] $t {:where (numeric? $t)} (+ a b))\n\
(defn main [] () (let [small (i8 1)] \
(println (+ small (twoq 2 3)))))"
in
let copies =
List.filter
(fun (f : Tast.fn) ->
String.length f.Tast.name >= 5 && String.sub f.Tast.name 0 5 = "twoq-")
p.Tast.fns
in
match copies with
| [ { Tast.name = "twoq-i32"; _ } ] -> ()
| l ->
check
(Printf.sprintf
"a generic inside an abandoned trial is instantiated once: %s"
(String.concat " " (List.map (fun (f : Tast.fn) -> f.Tast.name) l)))
false);
(* ── A type variable is not instantiated at dyn ─────────────────────
Nothing stopped it before: dyn is an ordinary case of Types.t, so it
substituted like any other type and the copy was generated. What the copy
then ran into was the dyn answers that are not all there — (Option dyn)
has no descriptor the collector can find — and the refusal arrived from
inside the generic's own source. (or-else (Some d) e) over two dyns used
to be reported against <prelude>:385, a line the caller did not write.
The refusal is at the call site now, and it names the other model rather
than only saying no. *)
rejects_check "a type variable is not instantiated at dyn"
~needle:"is not instantiated at dyn"
"(defn idf [x $t] $t x)\n\
(defonce d dyn 5)\n\
(defn main [] () (println (idf d)))";
rejects_check "and the refusal names the dyn side rather than only saying no"
~needle:"defmethod"
"(defn idf [x $t] $t x)\n\
(defonce d dyn 5)\n\
(defn main [] () (println (idf d)))";
(* Nor at a type that merely *reaches* a dyn, which is the shape that used
to walk furthest before failing: (Option dyn) is the case the collector
has no descriptor for, and the refusal for it arrived from <prelude>:385.
It arrives here now, against the call that asked for the copy. *)
rejects_check "nor at a type that merely reaches a dyn"
~needle:"$t = (Option dyn)"
"(defn maybe [] (Option dyn) None)\n\
(defn idf [x $t] $t x)\n\
(defn main [] () (println (some? (idf (maybe)))))";
(* A variable that carries a clause keeps the clause's refusal, which names
the predicate the signature actually wrote down — the more specific of
the two answers, and the one the generic cast's pin above depends on. *)
rejects_check "a bounded variable is still refused by its bound"
~needle:"numeric?"
"(defn twice [x $t] $t {:where (numeric? $t)} (+ x x))\n\
(defonce d dyn 5)\n\
(defn main [] () (println (twice d)))";
(* ── Mixed widths at one type variable join at the wider type ───────
The rule used to refuse the pair both ways, with the join recorded as
the coherent alternative that could be added without invalidating
anything — the walk-backable direction. The author walked it back on
2026-09-20: a scalar pair at one $t resolves to whichever of the two
the other widens into, value-preserving widening only, and both
argument orders produce the identical copy. A pair with no join — u64
against i64 — keeps a refusal, because there is no type that holds
every value of both. FIX.org, "Generics and implicit widening", and the
2026-09-20 entry that supersedes it. *)
accepts "a scalar pair at one $t joins at the wider type"
"(defn eq2? [a $t b $t] bool {:where (equal? $t)} (= a b))\n\
(defn main [] () (println (eq2? (i64 3) (i8 3))))";
accepts "and the other argument order joins identically"
"(defn eq2? [a $t b $t] bool {:where (equal? $t)} (= a b))\n\
(defn main [] () (println (eq2? (i8 3) (i64 3))))";
(* Order-independence, pinned on the copies and not only on acceptance:
both orders in one program make exactly one instantiation, at i64, and
none at i8. *)
(let syms order_a order_b =
match
checked
("(defn eq2? [a $t b $t] bool {:where (equal? $t)} (= a b))\n\
(defn main [] () (do (println (eq2? " ^ order_a ^ "))\
(println (eq2? " ^ order_b ^ "))))")
with
| p ->
List.filter_map
(fun (f : Tast.fn) ->
if String.length f.Tast.name >= 4
&& String.sub f.Tast.name 0 4 = "eq2?" then Some f.Tast.name
else None)
p.Tast.fns
| exception _ -> [ "did not check" ]
in
check "both orders share one copy, at the wider type"
(syms "(i8 3) (i64 4)" "(i64 5) (i8 6)" = [ "eq2?-i64" ]);
check "and the reversed program instantiates the same one copy"
(syms "(i64 5) (i8 6)" "(i8 3) (i64 4)" = [ "eq2?-i64" ]));
(* The pair that meets at no type is the refusal that stays: neither u64
nor i64 holds every value of the other, and inventing a third type
would be picking one neither argument was written at. *)
rejects_check "u64 and i64 meet at no type"
~needle:"the two meet at no type"
"(defn eq2? [a $t b $t] bool {:where (equal? $t)} (= a b))\n\
(defonce u u64 3)\n(defonce i i64 3)\n\
(defn main [] () (println (eq2? u i)))";
(* And a later, wider argument settles a pair that had no join of its own:
u32 and i32 meet nowhere, but all three meet at the i64 that arrives
third — in either order, which is what the deferred re-ask is for. *)
accepts "a later argument settles a joinless pair"
"(defn tri [a $t b $t c $t] $t {:where (numeric? $t)} (+ a (+ b c)))\n\
(defonce x3 u32 1)\n(defonce y3 i32 2)\n(defonce z3 i64 3)\n\
(defn main [] () (println (tri x3 y3 z3)))";
accepts "and the same trio in the other order"
"(defn tri [a $t b $t c $t] $t {:where (numeric? $t)} (+ a (+ b c)))\n\
(defonce x3 u32 1)\n(defonce y3 i32 2)\n(defonce z3 i64 3)\n\
(defn main [] () (println (tri z3 y3 x3)))";
(* A variable the signature also reaches through a container is bound
exactly — a slice's elements cannot be rewritten to a wider width — so
the join never moves one, in either direction of the mismatch. *)
rejects_check "a container-bound variable does not join wider"
~needle:"binds its element exactly"
"(defn main [] () (let [ns [5 3 9 1]] \
(match (index-of (slice ns 0 4) (i64 9)) \
(Some i) (println i) _ (println -1))))";
(* The one direction a container-fixed binding does admit, and it is new
with the join: a *narrower* scalar widens into the type the container
fixed, through the same cast a monomorphic i32 parameter applies. This
used to refuse with the same both-ways sentence as everything else. *)
accepts "a narrower scalar widens into a container-fixed binding"
"(defn main [] () (let [ns [5 3 9 1]] \
(match (index-of (slice ns 0 4) (i16 9)) \
(Some i) (println i) _ (println -1))))";
(* The written conversion is what the message asks for, and it is accepted:
the refusal is about the *implicit* step, not about reaching i64. *)
accepts "the written conversion is accepted"
"(defn eq2? [a $t b $t] bool {:where (equal? $t)} (= a b))\n\
(defn main [] () (println (eq2? (i64 3) (i64 (i8 3)))))";
(* An untyped constant has no type of its own to keep, so it still takes the
variable's. Nothing is converted here — three i64s were written. *)
accepts "an untyped literal still takes a bound type variable's type"
"(defn clamp3 [x $t lo $t hi $t] $t {:where (ordered? $t)} \
(min (max x lo) hi))\n\
(defn main [] () (println (clamp3 (i64 12) 0 10)))";
(* And the shapes widening cannot reach are untouched, which is the reason
the rule costs so little: [Types.widens_to] admits only numeric scalars,
so a variable bound inside a slice or a function type leaves a parameter
no widening applied to in the first place. *)
accepts "a variable bound inside a constructor is unaffected"
"(defn sort2 [s [$t] before? (Fn [$t $t] bool)] () \
(sort-by s before?))\n\
(defn main [] () (let [ns [5 3 9 1]] \
(sort2 (slice ns 0 4) (fn [a b] (< a b))) (println (at ns 0))))";
(* A form with no type of its own is still checked against the parameter:
the trial that asks for its natural type refuses, and the want it always
had is what it falls back to. *)
accepts "a form that needs a want still gets one at a bound type variable"
"(defn pick [a $t b $t] $t (do b a))\n\
(defn main [] () (println (pick (i64 3) (zeroed))))";
(* ── A numeric literal where a type variable is wanted ──────────────
The author's motivating family — one pos? over every numeric type from
one definition — needs a written 0 to stand where $t stands. The bound
is what makes it sound: every type [numeric?] admits is an integer or a
float, and an untyped integer constant is usable at all of them, so
there is no instantiation of a [numeric?] variable at which the literal
has no meaning. That is the whole rule, and the four pins below are its
two halves and its one asymmetry. *)
accepts "an integer literal stands where a numeric? type variable is wanted"
"(defn above-zero? [x $t] bool {:where (numeric? $t)} (> x 0))";
accepts "and in arithmetic, answering the variable"
"(defn next [x $t] $t {:where (numeric? $t)} (+ x 1))";
(* And the prelude's own three, which are that body under its real name at
every numeric type from one definition. *)
accepts "the prelude's sign family answers at six numeric types"
"(defn main [] () (println (pos? 3) ) (println (neg? (i8 -1))) \
(println (zero? (u8 0))) (println (zero? 0.0)) \
(println (pos? (u64 1))) (println (neg? (f32 -0.5))))";
(* [numeric?] is what admits it and nothing weaker does. [ordered?] admits
an enum, which holds no number, so a literal under it has an
instantiation at which it means nothing — and the refusal below is what
stops that reaching the call site. *)
rejects_check "an unconstrained type variable admits no literal"
~needle:"may be instantiated at a type that holds no number"
"(defn f [x $t] bool (> x 0))";
rejects_check "and ordered? is not the bound that admits one"
~needle:"Declare the bound"
"(defn f [x $t] bool {:where (ordered? $t)} (> x 0))";
(* The asymmetry, and it is the concrete arms' asymmetry rather than a new
one: an untyped integer constant is usable where a float is wanted, and
a float literal is never usable where an integer is wanted. [numeric?]
covers both halves of the numbers, so a body written with a float
literal has no meaning at the integer half of its own bound. Refused at
the definition, which is where the abstract pass promises refusals
arrive — not at whichever call site first asks for i32. *)
rejects_check "a float literal is refused at a type variable even under numeric?"
~needle:"may be instantiated at an integer type"
"(defn half [x $t] $t {:where (numeric? $t)} (* x 0.5))";
(* A map key that is a type variable has no hash and no equality to emit:
they are chosen from the concrete type, which does not exist yet. So the
map operations join print and println on the list of forms the abstract
pass defers to the instantiation — but only under the predicate, which is
what gives the deferred refusal somewhere to land. Without one the type
itself is refused where it is written, at the definition. *)
rejects_check "a map keyed by a type variable that is not hashable?"
~needle:"is not a map key"
"(defn f [m (Map $t i32)] i32 {:where (numeric? $t)} (len m))";
accepts "and hashable? is what says it is"
"(defn f [m (Map $t i32)] i32 {:where (hashable? $t)} (len m))";
accepts "and under it the operations are deferred, not refused"
"(defn f [m (Map $t i32) k $t] () {:where (hashable? $t)} (put m k 1))";
accepts "get over a type-variable key answers an (Option V)"
"(defn f [m (Map $t i32) k $t] i32 {:where (hashable? $t)} \
(match (get m k) (Some v) v _ 0))";
(* And so does the removal, whose placeholder is [get]'s for the same reason:
it answers an (Option V), so the match around it still has to check while
the key is a variable. *)
accepts "map-remove over a type-variable key answers an (Option V)"
"(defn f [m (Map $t i32) k $t] i32 {:where (hashable? $t)} \
(match (map-remove m k) (Some v) v _ 0))";
accepts "and so do has-key?, reserve and clone"
"(defn f [m (Map $t i32) k $t] bool {:where (hashable? $t)} \
(do (reserve m 8) (let [c (clone m)] (free c) (has-key? m k))))";
(* The definition is still where a generic with no clause to point at is
refused: nothing has been written down for an instantiation to be judged
against, so the refusal has nowhere to move to. *)
rejects_check "a map built inside a generic that declares nothing"
~needle:"is not a map key"
"(defn f [k $t] () (let [m (map-new t i32)] (put m k 1) (free m)))";
(* ── A type variable, spelled with the sigil, where a type name goes ──
[$t] is the signature's spelling and [t] is the body's, and they are the
same variable: the tables that record which variables are in scope are
keyed on the bare name, so every membership test has to strip the sigil
before asking. The ones that did not strip were the guards in front of
[vec-new] and [map-new] and the cast arm, which is why a body that wrote
[(vec-new $t)] was told it had not said what the Vec held. *)
accepts "vec-new over a type variable written with the sigil"
"(defn f [x $t] (Vec $t) (let [v (vec-new $t)] (push v x) v))";
accepts "and against a named allocator"
"(defn f [x $t a Allocator] (Vec $t) \
(let [v (vec-new $t a)] (push v x) v))";
accepts "map-new over type variables written with the sigil"
"(defn f [k $t] i32 {:where (hashable? $t)} \
(let [m (map-new $t i32)] (put m k 1) (let [n (len m)] (free m) n)))";
accepts "a zeroed fixed array of a type variable"
"(defn f [x $t] $t (let [a (array 3 $t)] (set (at a 1) x) (at a 1)))";
accepts "a cast to a type variable written with the sigil"
"(defn f [x i32 d $t] $t {:where (numeric? $t)} (do d ($t x)))";
(* The message these were taking is still the message for the case it was
written for: nothing named, and nothing at the site that says. *)
rejects_check "vec-new with no element type and nothing to take one from"
~needle:"nothing here says what (vec-new) is a Vec of"
"(defn f [x $t] i32 (do x (let [v (vec-new)] (free v) 0)))";
(* And a sigil on a name nothing binds is answered as the unbound variable
it is, rather than as a missing element type — with the names that *are*
bound, because inside a signature that introduces one the mistake is
nearly always the second spelling of the first. *)
rejects_check "vec-new over a sigil that names no variable in scope"
~needle:"this signature introduces t, so write t here"
"(defn f [x $t] i32 (do x (let [v (vec-new $u)] (free v) 0)))";
rejects_check "and a cast over one tells the same story"
~needle:"this signature introduces t, so write t here"
"(defn f [x i32 d $t] $t {:where (numeric? $t)} (do d ($u x)))";
rejects_check "two variables in scope are both named"
~needle:"introduces t and u, so write one of those"
"(defn f [a $t b $u] i32 (do a b (let [v (vec-new $w)] (free v) 0)))";
(* Where no variable is in scope there is none to name, and the answer is
the rule: a sigil binds, and only a defn signature is a binding site. *)
rejects_check "a sigil in a struct field, where nothing can bind one"
~needle:"only a defn signature can"
"(defstruct S [v $t])";
(* ── The builtin table against the arms it describes ──────────────
[Check.builtins] is what the editor's C-c C-v and M-. read for a name no
program wrote — [arena-new] and the seventy-seven others. A table like
that is worth less than nothing once it is stale: a builtin added without
an entry answers nothing, and an entry for an arm that was deleted
describes a name that no longer exists, which is worse because it reads
as authoritative.
There is no way to reflect over an OCaml match, so this reads the source
instead. The two regions are [named_call]'s arms and [var]'s, each from
its own [and] down to the catch-all at the same indentation, and the
names are the string literals in the arm heads. It is a regex over one
file and costs nothing, which is why it is in the default run rather
than behind an alias.
The catch-all is [ | _ ->] and not [ | _], because a guarded arm is
not one: [named_call] opens with [| _ when shadows_builtin ...], which
is a name the program defined taking its own call over, and stopping
there would read the region as empty and report every builtin as
undescribed. Guarded arms in between are skipped by the same rule that
skips a comment — they carry no string literal in the head. *)
let arm_names () =
let src =
In_channel.with_open_bin "../lib/check.ml" In_channel.input_all
in
let lines = String.split_on_char '\n' src in
let starts_with p s =
String.length s >= String.length p && String.sub s 0 (String.length p) = p
in
let quoted line =
let out = ref [] and i = ref 0 and n = String.length line in
while !i < n do
if line.[!i] = '"' then begin
let j = ref (!i + 1) in
while !j < n && line.[!j] <> '"' do incr j done;
if !j < n then out := String.sub line (!i + 1) (!j - !i - 1) :: !out;
i := !j + 1
end else incr i
done;
List.rev !out
in
let region head =
let rec drop = function
| [] -> []
| l :: rest -> if starts_with head l then rest else drop rest
in
let rec take = function
| [] -> []
| l :: rest ->
if starts_with " | _ ->" l then []
else if starts_with " | \"" l then quoted l @ take rest
else take rest
in
take (drop lines)
in
region "and named_call " @ region "and var ctx "
in
let arms = arm_names () in
let table = List.map (fun (n, _, _) -> n) Check.builtins in
check "every builtin arm is described" (arms <> [] && List.length arms > 60);
List.iter
(fun n ->
if not (List.mem n table) then begin
incr failures;
Printf.printf
"FAIL the builtin %s has an arm in check.ml and no entry in \
Check.builtins\n" n
end)
arms;
List.iter
(fun n ->
if not (List.mem n arms) then begin
incr failures;
Printf.printf
"FAIL Check.builtins describes %s, which is no longer an arm\n" n
end)
table;
(* A signature and a line, for every one of them: an entry that is present
and empty answers the question no better than a missing one. *)
List.iter
(fun (n, sign, doc) ->
if sign = "" || doc = "" then begin
incr failures;
Printf.printf "FAIL the builtin %s has no %s\n" n
(if sign = "" then "signature" else "description")
end)
Check.builtins;
(* ── Memory diagnostics, --warn-memory ──────────────────────────
[Check.memory_sites] over a checked program: which lines allocate, on
which heap, and — the half that is harder to keep true — which lines do
not.
Pinned exactly, location and message both, and the location matters as
much as the wording: the whole feature is a squiggle under a character,
and a pass that found the right number of sites at the wrong columns
would draw them under the wrong forms. The file is fixed to [<test>] so
the prelude's own pushes, which are real and are not the caller's
business, stay out of the comparison. *)
let memory name src want =
let got =
List.map
(fun (d : Loc.diag) ->
(d.Loc.dloc.Loc.line, d.Loc.dloc.Loc.col, d.Loc.kind, d.Loc.dmsg))
(Check.memory_sites ~file:"<test>" (checked src))
in
let show (l, c, k, m) = Printf.sprintf "\n %d:%d %s %S" l c k m in
if got <> want then begin
incr failures;
Printf.printf "FAIL %s\n wanted:%s\n got:%s\n" name
(String.concat "" (List.map show want))
(String.concat "" (List.map show got))
end
in
let gc = "memory/gc" and native = "memory/native" in
(* The collected heap. Every row here is a [gc_alloc] in flan_dyn.c on the
way through, and the negatives between them are the point: a typed
[vec-new] takes no block, and neither does an immediate. *)
memory "the collected heap, and what does not touch it"
"(defonce wide i64 999999999999999)\n\
(defonce small i32 7)\n\
(defn take [x] () (print x))\n\
(defn main [] ()\n\
\ (let [tv (vec-new i32)\n\
\ dv (vec-new dyn)\n\
\ m {:a 1}]\n\
\ (take \"hi\")\n\
\ (take 5)\n\
\ (take true)\n\
\ (take nil)\n\
\ (take :kw)\n\
\ (take 1.5)\n\
\ (take small)\n\
\ (take wide)\n\
\ (push tv 1)\n\
\ (push dv 2)))"
[ (6, 12, gc, "allocates: a dyn vector is an object on the collector's heap");
(7, 11, gc, "allocates: a dyn map is an object on the collector's heap");
(8, 11, gc,
"allocates: a string crossing into dyn is copied onto the collector's \
heap");
(* The only integer here that can leave the 48-bit payload. [small] is an
i32 widened to i64 at the crossing and provably cannot, [5] is a
literal inside the range, and neither is named. *)
(15, 11, gc,
"may allocate: an i64 outside ±2^47 does not fit a dyn's payload and \
spills onto the collector's heap");
(* The typed push, which is the native side; [(push dv 2)] on the line
below it is the dyn runtime's own vector growing itself and is not a
site the program can do anything about. *)
(16, 5, native,
"may allocate: a push past the Vec's capacity grows it through its \
allocator") ];
(* The allocator side, and the two shapes of [flan_vec_init]: [slurp] sizes
the Vec to the file and takes a block here, [(vec-new i32 a)] passes a
capacity of zero and takes none. Same runtime entry point, two answers,
which is why the classifier reads the capacity argument rather than the
symbol alone. *)
memory "an allocator the program named"
"(defonce gv (Vec i64) (vec-new i64))\n\
(defn take [x] () (print x))\n\
(defn arith [a b] () (take (+ a b)))\n\
(defn main [] ()\n\
\ (let [a (arena-new 4096)\n\
\ tm (map-new string i32 a)\n\
\ tv (vec-new i32 a)\n\
\ txt (slurp \"x\" a)]\n\
\ (take gv)\n\
\ (put tm \"k\" 1)\n\
\ (reserve tv 4)\n\
\ (arith 1 2)\n\
\ (print (len txt))))"
[ (5, 11, native,
"allocates: an arena takes its whole region from the host here");
(8, 13, native,
"allocates: the Vec is sized up front and takes its block from its \
allocator here");
(* A (Vec i64) crossing into dyn is a view, and the view record is a
heap object even though not one element is copied. *)
(9, 11, gc,
"allocates: a typed container crossing into dyn takes a view record on \
the collector's heap — the elements are not copied, the record is");
(10, 5, native,
"may allocate: a put past the map's load factor grows its block through \
its allocator");
(11, 5, native,
"may allocate: a reserve past the Vec's capacity grows it through its \
allocator") ];
(* Two negatives on their own, because they are the ones a careless
classifier gets wrong and a test that only counted rows would not catch.
[(+ a b)] over two dyns ends in [flan_dyn_from_i64] and can spill — but
nothing static knows the operands, and a squiggle under every dyn
addition is the false positive this pass exists not to have. *)
memory "dyn arithmetic stays immediate, and an empty program is silent"
"(defn take [x] () (print x))\n\
(defn add2 [a b] () (take (+ a b)))\n\
(defn main [] () (add2 1 2))"
[];
(* ── The acceptance program checks end to end ──────────────────── *)
accepts "calc-me.flan type checks"
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);
Test_support.report ()
Reference in New Issue View Git Blame Copy Permalink