JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
flan/test/test_flan.ml

4840 lines
253 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", { e = Int 10L; _ }, [ _ ]) -> ()
| _ -> check "dotimes binds" 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 "(defvar grid [4 u32])").d with
| Defvar ("grid", Some _, Zeroed) -> ()
| _ -> check "defvar is ZII" false);
(match (parse_decl "(defvar buf [4 u8] uninit)").d with
| Defvar (_, _, Uninit) -> () | _ -> check "defvar uninit opts out" false);
(* A three-element defvar 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 "(defvar score 0)").d with
| Defvar ("score", Some { t = Tname "dyn"; _ }, Init _) -> ()
| _ -> 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 "(defvar total foo)").d with
| Defvar ("total", Some { t = Tname "foo"; _ }, Ambiguous _) -> ()
| _ -> check "a symbol third element parses undecided" false);
(match (parse_decl "(defvar v (Vec i32))").d with
| Defvar ("v", Some { t = Tapp ("Vec", _); _ }, Ambiguous _) -> ()
| _ -> check "a parenthesised third element parses undecided" false);
(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 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 defvar 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 [defvar] 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
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]]";
infers "bytes of a string" "(bytes \"hi\")" "[u8]";
infers "len is i32" "(len (bytes \"hi\"))" "i32";
infers "slice of a slice" "(slice (bytes \"hi\") 0 1)" "[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"
"(defvar a i32) (defn g [x i64] ()) (defn f [] () (g a))";
accepts "unsigned widens into a wider signed"
"(defvar a u32) (defn g [x i64] ()) (defn f [] () (g a))";
accepts "u8 widens into i16"
"(defvar a u8) (defn g [x i16] ()) (defn f [] () (g a))";
accepts "f32 widens into f64"
"(defvar 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"
"(defvar 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"
"(defvar a i64) (defn g [x i32] ()) (defn f [] () (g a))"
~needle:"i32 widens into i64 by itself";
rejects_check "float narrowing is refused too"
"(defvar 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"
"(defvar 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"
"(defvar 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"
"(defvar a i32) (defn g [x f64] ()) (defn f [] () (g a))";
accepts "u32 reaches f64 exactly"
"(defvar a u32) (defn g [x f64] ()) (defn f [] () (g a))";
accepts "i16 reaches f32 exactly"
"(defvar a i16) (defn g [x f32] ()) (defn f [] () (g a))";
rejects_check "i64 does not reach f64 — above 2^53 it would round"
"(defvar 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"
"(defvar 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"
"(defvar a i64) (defvar b i32) (defn f [] i64 (+ a b))";
accepts "and decides when it is written second"
"(defvar a i64) (defvar b i32) (defn f [] i64 (+ b a))";
accepts "min and max join the same way"
"(defvar a i8) (defvar b i16) (defn f [] i16 (max a b))";
rejects_check "i32 and u32 have no join"
"(defvar a i32) (defvar 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)))";
(* 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"
"(defvar v i64) (defvar n u8) (defn f [] i64 (<< v n))";
rejects_check "a wider count does not drag the value up with it"
"(defvar v u8) (defvar 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 is still an unimplemented type variable everywhere a
type is the only thing a slot can hold. A defn's parameter vector stopped
being such a place — a slot there may be a parameter instead — so the rule
is exercised where it still decides, at a field. *)
rejects_check "a real type variable" "(defstruct Holder [x elem])"
~needle:"milestone 5";
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"
"(defvar 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"
"(defvar 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"
"(defvar a [4 i64])\n\
(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take a))";
accepts "a bool Vec's view"
"(defvar 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"
"(defvar 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"
"(defvar 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"
"(defvar 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"
"(defvar 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
(defvar 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"
"(defvar 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"
"(defvar 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"
"(defvar 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"
"(defvar 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"
"(defvar 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"
"(defvar 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(defvar 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\
(defvar 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\
(defvar 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"
"(defvar 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 = "(defvar 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"
"(defvar 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))";
(* (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 defvar 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 defvar 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. *)
rejects_check "a capitalised call with arguments is generics"
"(defvar x (Pair i32)) (defn f [] i32 0)"
~needle:"is generic code, which is milestone 5";
rejects_check "defined twice" "(defn f [] ()) (defn f [] ())"
~needle:"defined twice";
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 defvar 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"
"(defvar 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 defvar 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"
"(defvar 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 defvar 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 defvar ─────────────────────────────────
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"
"(defvar current-color i32) (defn f [] i32 current-color)"
"current-color" ~ty:"i32" ~zeroed:true;
defvar_reading "a bracketed type stays a zeroed static array"
"(defvar 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]) (defvar 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]) (defvar 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"
"(defvar v (Vec i32)) (defn f [] i32 (len v))"
"v" ~ty:"(Vec i32)" ~zeroed:true;
rejects_check "a malformed parenthesised type stays a type error"
"(defvar 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"
"(defvar 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}) (defvar 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"
"(defvar seed i64 3) (defvar 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"
"(defvar score dyn 0) (defn f [] dyn score)"
"score" ~ty:"dyn" ~zeroed:false;
defvar_reading "the explicit dyn form with no value is unchanged"
"(defvar config dyn) (defn f [] dyn config)"
"config" ~ty:"dyn" ~zeroed:true;
(* 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"
"(defvar total foo) (defn f [] ())"
~needle:
"foo is neither a type nor a value, and the third element of a defvar \
has to be one or the other: a type there declares a zeroed global of \
that type — (defvar total i64) — and a value there declares a dyn \
global holding it — (defvar total 0). Nothing named foo is declared \
as either";
rejects_check "the near miss is over the value names as well as the types"
"(defvar score i64 1) (defvar 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"
"(defvar 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"
"(defvar 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])]) (defvar 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: (defvar 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"
"(defvar a i64 1) (defvar b i64 2) (defvar 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"
"(defvar a i64 1) (defvar b i64 2) (defvar g [a b]) (defn f [] ())"
~needle:"put dyn in front of the same brackets — (defvar g dyn ...)";
accepts "which is a real form"
"(defvar a i64 1) (defvar b i64 2) (defvar 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 defvar"
"(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 defvar it names is the form that works"
"(defconst rows 4) (defconst cols 4) (defvar 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?";
(* ── 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"
"(defvar b i64 (+ a 10)) (defvar 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\
(defvar a i64 (fa)) (defvar b i64 (fb))\n(defn f [] i64 (+ a b))"
~needle:"initialise each other";
rejects_check "a global initialised from itself"
"(defn fa [] i64 a) (defvar 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)) (defvar a i64 (fa)) (defvar 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\
(defvar 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"
"(defvar 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\
(defvar 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"
"(defvar g (Vec u8)) \
(defn f [] () (set g (vec-new u8)) (push g 1) (set (at g 0) 2) \
(println (len (as-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)))";
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";
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"
"(defvar x i32 1) (defvar x i32 2)" ~needle:"defined twice";
rejects_check "a constant shadowing a variable"
"(defconst c 1) (defvar c i32 2)" ~needle:"defined twice";
rejects_check "a function and a global"
"(defn item [] i32 1) (defvar 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 defvar, whose third element is read as a type: a
zeroed static and not a dyn global holding a value called [int]. *)
accepts "a defvar whose type is int" "(defvar g int) (defn f [] int g)";
accepts "and one whose type is float" "(defvar 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]: the mixed
arithmetic that i32 refuses, int refuses identically and by the same
message. Pinned as identity rather than as a widening rule, so it says
the same thing whatever the widening table grows into. *)
rejects_check "int mixes with i64 exactly as i32 does"
"(defvar a int) (defvar b i64) (defn f [] i64 (+ a b))"
~needle:"expected i64, found i32";
(* 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" "(defvar a [4 u32]) (defn f [] u32 (let [i 2] (at a (u32 i))))";
rejects_check "an i64 index"
"(defvar 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 "type variables are milestone 5" "(defn f [] a 0)"
~needle:"milestone 5";
(* 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"
"(defvar 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"
"(defvar grid [rows i32]) (defconst rows 8)";
accepts "constants defined out of order"
"(defconst a (+ b 1)) (defconst b 1)";
(* A typed [defvar] here and not an untyped [defconst], which it was until
2026-09-20: a computed initialiser belongs to a defvar 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"
"(defvar 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 (defvar 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 defvar, 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]) (defvar 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 defvar 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(defvar 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(defvar 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(defvar 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");
(* 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);
(* 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]) (defvar 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]) (defvar 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";
(* A defn whose name is a builtin's is silently unreachable — the dispatch
reaches every builtin arm before it looks in the function table — and the
arity refusal was measured against the builtin while pointing at a call
the reader had written for their own. *)
(match diag_of "(defstruct P [x i32])\n(defn get [p P] i32 (.x p))\n (defn f [] i32 (let [p (P {.x 1})] (get p)))" with
| Some d ->
check "a shadowed builtin's arity has a kind"
(d.Loc.kind = "check/builtin-arity");
check "and says whose count it is"
(contains d.Loc.dmsg
"this is the builtin get, which a defn of the same name does not \
replace");
(match d.Loc.notes with
| [ n ] ->
check "and notes the definition that is not being reached"
(n.Loc.nloc.Loc.line = 2
&& contains n.Loc.nmsg "this call is not reaching it")
| _ -> check "a shadowed builtin has one note" false)
| None -> check "a shadowed builtin's call 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))";
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))";
(* 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 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)))";
(* ── 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 first 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. *)
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"
"(defvar wide i64 999999999999999)\n\
(defvar 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"
"(defvar 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