(* Reader tests. Plain assertions, no test framework — another dependency that
   would have to be reimplemented if the compiler is ever self-hosted. *)

open Flan

let failures = ref 0

let check name cond =
  if not cond then begin
    incr failures;
    Printf.printf "FAIL  %s\n" name
  end

let contains hay needle =
  let n = String.length needle and h = String.length hay in
  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
  n = 0 || go 0

let reads name src expected =
  match Reader.read_all ~file:"<test>" 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, msg) ->
    incr failures;
    Printf.printf "FAIL  %s\n        src: %s\n      error: %s: %s\n"
      name src (Loc.to_string loc) msg

(* [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 Reader.read_all ~file:"<test>" src with
  | _ -> incr failures; Printf.printf "FAIL  %s: expected a read error\n" name
  | exception Loc.Error (_, 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";
  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)]";

  (* 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 (Reader.read_all ~file:"<test>" 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";
  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 Reader.read_all ~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 Reader.read_all ~file:"f.flan" "(f\n  bad" with
   | _ -> check "unclosed reports opening loc" false
   | exception Loc.Error (loc, _) ->
     check "unclosed reports opening loc" (loc.line = 1 && loc.col = 1));

  if !failures = 0 then print_endline "reader: all tests passed"
  else begin
    Printf.printf "\n%d failure(s)\n" !failures;
    exit 1
  end

(* ═══ Parse: forms → AST ═══════════════════════════════════════════ *)

let parse1 src =
  match Reader.read_all ~file:"<test>" src with
  | [ f ] -> Parse.expr f
  | _ -> failwith "test source must be exactly one form"

let parse_decl src =
  match Reader.read_all ~file:"<test>" 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 Reader.read_all ~file:"<test>" src |> Parse.program with
  | _ -> incr failures; Printf.printf "FAIL  %s: expected a parse error\n" name
  | exception Loc.Error (_, 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);

  (match (parse1 "(unless c a)").e with
   | If ({ e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, _, None) -> ()
   | _ -> check "unless -> if(not)" false);

  (match (parse1 "(until c a)").e with
   | While ({ 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 *)
  (match (parse1 "(and a b)").e with
   | If (_, _, Some { e = Var "false"; _ }) -> ()
   | _ -> check "and short-circuits" false);
  (match (parse1 "(or a b)").e with
   | If (_, { e = Var "true"; _ }, Some _) -> ()
   | _ -> 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 ("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 ─────────── *)
  let ty src =
    match parse_decl (Printf.sprintf "(defn f [x %s])" src) with
    | { d = Defn { params = [ { fty; _ } ]; _ }; _ } -> fty.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);
  (match ty "{string i32}" with
   | Tmap (_, _) -> () | _ -> check "{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 _; params = [ _ ]; fbody = [ _ ]; _ } -> ()
   | _ -> check "defn with return type" false);
  (* An omitted return type means Unit — the body must not be eaten as a type *)
  (match (parse_decl "(defn f [x i32] (g x))").d with
   | Defn { ret = None; fbody = [ _ ]; _ } -> ()
   | _ -> check "defn without return type" 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);
  (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: the front half is here, the expander is not ───────── *)
  (* Was "unknown top-level form (defmacro ...)" — refused, but not by name and
     with no reason, which is the hole the house rule had at the top level. *)
  parse_rejects "defmacro declaration" "(defmacro m [x] x)"
    ~needle:"not expanded";
  (* Shape and feature are separate mistakes and get 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:"expected a name";
  parse_rejects "defmacro in expression position" "(defn f [] (defmacro m [] 1))"
    ~needle:"top-level declaration";

  (* The reader now hands these three to the parser, so each says what is
     actually wrong rather than arriving at the checker as an unknown name. *)
  parse_rejects "quasiquote in a function" "(defn f [] `(a b))"
    ~needle:"not expanded";
  (* 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";
  parse_rejects "gensym outside a macro" "(defn f [] (gensym))"
    ~needle:"only meaningful inside a macro body";

  (* ── 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)";

  (* ── The corpus parses ─────────────────────────────────────────── *)
  List.iter
    (fun path ->
       match Reader.read_file path |> Parse.program with
       | _ -> ()
       | exception Loc.Error (loc, 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" ];

  if !failures = 0 then print_endline "parse: all tests passed"
  else begin
    Printf.printf "\n%d failure(s)\n" !failures;
    exit 1
  end

(* ═══ The return type / body ambiguity ═════════════════════════════ *)
(* (Option f64) and (Some 1) are the same s-expression shape. Which one is a
   return type is decided by the set of names that are actually types, not by
   capitalisation — otherwise a body starting with a constructor call gets
   silently eaten as a return type. *)

let program src = Reader.read_all ~file:"<test>" 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 "known type ctor is a return type"
    (ret_and_body "option" "(defn f [] (Option f64) (g))" = (true, 1));

  check "value ctor is NOT a return type"
    (ret_and_body "some" "(defn f [] (Some 1) (bar))" = (false, 2));

  check "user struct is a return type"
    (ret_and_body "user"
       "(defstruct Cursor [pos i32]) (defn f [] Cursor (g))" = (true, 1));

  (* Order-independent: the type is declared after the function that returns it *)
  check "type declared later is still known"
    (ret_and_body "later"
       "(defn f [] Cursor (g)) (defstruct Cursor [pos i32])" = (true, 1));

  check "unknown capitalised head is a body form"
    (ret_and_body "unknown" "(defn f [] (Nope 1) (bar))" = (false, 2));

  ()

(* ── Checker: AST → typed IR ───────────────────────────────────────── *)

let checked src = program src |> Check.program

(* The type a defconst's value infers to, as the checker prints it. Enough to
   pin down literal defaulting and every primitive's result. *)
let infers name src expected =
  match checked (Printf.sprintf "(defconst probe %s)" src) with
  | p ->
    (match List.find_opt (fun (g : Tast.global) -> g.gname = "probe") p.globals with
     | Some g ->
       let got = Types.to_string g.gty 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
     | None -> incr failures; Printf.printf "FAIL  %s: no probe\n" name)
  | exception Loc.Error (loc, msg) ->
    incr failures;
    Printf.printf "FAIL  %s\n        src: %s\n      error: %s: %s\n"
      name src (Loc.to_string loc) msg

let accepts name src =
  match checked src with
  | _ -> ()
  | exception Loc.Error (loc, msg) ->
    incr failures;
    Printf.printf "FAIL  %s\n        src: %s\n      error: %s: %s\n"
      name src (Loc.to_string loc) msg

(* [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 (_, 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
     | _ -> ())

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]]";
  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";

  (* ── 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";
  rejects_check "if branches disagree"
    "(defn f [] i32 (if true 1 true))" ~needle:"expected i32";

  (* ── 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?";
  (* Nothing close: the type-variable rule still applies, and still names the
     milestone. *)
  rejects_check "a real type variable" "(defn f [x t])"
    ~needle:"milestone 5";
  rejects_check "an unknown concrete type" "(defn f [x Widget])"
    ~needle:"unknown type Widget";

  (* ── 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))";

  (* ── 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";
  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:"parameters are not assignable";
  rejects_check "a constant is not assignable"
    "(defconst k 1) (defn f [] (set k 2))" ~needle:"is a constant";
  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";

  (* ── 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";
  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";

  (* ── Unconstrained operators, and everything past milestone 2 ──── *)
  rejects_check "no built-in = on strings"
    "(defn f [] bool (= \"a\" \"b\"))" ~needle:"no built-in comparison";
  rejects_check "Vec is milestone 6"    "(defn f [x (Vec i32)])"
    ~needle:"milestone 6";
  rejects_check "Map is milestone 6"    "(defn f [x {string i32}])"
    ~needle:"milestone 6";
  rejects_check "Result is milestone 6" "(defn f [] (Result i32 i32) None)"
    ~needle:"milestone 6";
  rejects_check "try is milestone 6"    "(defn f [] i32 (try 1))"
    ~needle:"milestone 6";
  (* dotimes and defer are implemented; what is still rejected is a defer that
     is not a top-level form, because it would run at function exit rather than
     at the exit of the block it was written in. *)
  rejects_check "defer must be top-level"
    "(defn f [] (let [x 1] (defer (g))))" ~needle:"top-level";
  (* 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 and against nothing else. *)
  rejects_check "a keyword needs an enum"
    "(defn g [x i32]) (defn f [] (g :space))" ~needle:"is expected here";
  rejects_check "a keyword with no expectation"
    "(defn f [] (print (i64 :space)))" ~needle:"no keyword type";
  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))";
  (* 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";
  (* 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";
  rejects_check "fn values are milestone 5" "(defn f [] (fn [x] x))"
    ~needle:"milestone 5";
  rejects_check "type variables are milestone 5" "(defn f [x a])"
    ~needle:"milestone 5";
  rejects_check "a function name as a value is milestone 5"
    "(defn g []) (defn f [] i32 g)" ~needle:"milestone 5";

  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)";
  accepts "an untyped constant from a later function"
    "(defconst k (g)) (defn g [] u8 1)";
  rejects_check "a genuinely unknown constant still reports itself"
    "(defconst a (+ nope 1))" ~needle:"unknown name nope";

  (* ── 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";
  (* The two halves of §3 this version does not do, each refused by name with
     the reason rather than parsed into something that means less. *)
  rejects_check "a restart with parameters"
    "(defn f [] i32 (restart-case 1 (skip [n i32] n)))"
    ~needle:"a restart takes no parameters yet";
  rejects_check "invoke-restart with arguments"
    "(defn f [] (invoke-restart 'skip 1))"
    ~needle:"a restart takes no arguments yet";
  rejects_check "invoke-restart on an unquoted name"
    "(defn f [] (invoke-restart skip))"
    ~needle:"quoted restart name";
  (* §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")
    [ "handler-case",     "(defn f [] (handler-case 1))";
      "find-restart",     "(defn f [] (find-restart 'skip))";
      "compute-restarts", "(defn f [] (compute-restarts))" ];

  (* ── 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)))");

  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 field name with no pattern before it"
    (pt ^ "(defn f [p Point] i32 (let [{:x} p] 0))")
    ~needle:"has no :field";
  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";

  (* 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. An Option
     still gets that answer, and still should. *)
  rejects_check "match over something that is neither"
    "(defn f [n i32] i32 (match n _ 2))"
    ~needle:"match works on an Option at milestone 2, 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 acceptance program checks end to end ──────────────────── *)
  accepts "calc-me.flan type checks"
    (In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);

  if !failures = 0 then print_endline "all tests passed"
  else begin
    Printf.printf "\n%d failure(s)\n" !failures;
    exit 1
  end