From 8cba440acac4d27667da2590ba4a9bd20a95cce2 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 18:01:08 +0700 Subject: [PATCH] Four more from the worst-20: the constant, the let annotation, the quote, the operand MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Ranks 15, 6, 11 and 18, all of them the same fault in different words — the message states a fact the reader already had and leaves out the half only the compiler can see. 'k is a constant' was four words. It says what a constant is, names defvar, and notes the defconst — [no_container_defconst] is the house's shape for this and [declared_note]'s is the note's. (let [x i32 5] ...) is what everyone arriving from a typed language writes, and let has no annotation slot, so the i32 became x's value and the 5 was left over: 'binding 5 has no value', which reads as if they had miscounted. The annotation is blamed now, at its own span. Checked only when the vector was about to be refused anyway, and the test for 'this names a type' is syntactic because nothing resolves at parse time. The unterminated string had one column on the opening quote and no note, alone among this reader's three two-place errors. It has the same note its neighbours have. '+ takes numbers, found string' pointed at the whole form when the operand was right there — the same whole-form-vs-operand fault the condition work fixed once already. Text gets the extra clause it was reaching for, naming concat and join without a call shape: the spelling that builds a slice of byte slices out of string literals is not a clause in a sentence, and a message that guessed at one would be wrong. --- lib/check.ml | 61 +++++++++++++++++++++++++++++++++++++----- lib/parse.ml | 41 ++++++++++++++++++++++++++++- lib/reader.ml | 8 +++++- test/test_flan.ml | 67 ++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 167 insertions(+), 10 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 530b16b..0ee8d6e 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -89,6 +89,10 @@ type env = { pointer — [declared_note]'s rule. *) fparams : (string, Ast.field list) Hashtbl.t; globals : (string, Types.t * bool) Hashtbl.t; (* type, is a constant *) + (* Where each global was declared, so a refusal about one can show it. A + second table rather than a third field, because every other reader of + [globals] wants the type and the constness and nothing else. *) + global_locs : (string, Loc.t) Hashtbl.t; (* Functions the checker made up: a handler-bind clause is lifted into one, because a handler is called from wherever the signal was and cannot be a branch in the function that established it. *) @@ -156,6 +160,7 @@ let new_env () = { fns = Hashtbl.create 32; fparams = Hashtbl.create 32; globals = Hashtbl.create 16; + global_locs = Hashtbl.create 16; lifted = []; generics = Hashtbl.create 8; gsigs = Hashtbl.create 8; @@ -4477,7 +4482,21 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t = Tast.Plocal b.slot, b.bty | None -> match Hashtbl.find_opt ctx.env.globals name with - | Some (_, true) -> fail loc "%s is a constant" name + | Some (_, true) -> + (* Four words, before: the name and the fact, and nothing about what + to do or where the decision was made. [no_container_defconst] is + the house's own shape for this and the note is [declared_note]'s. + A defconst is what the linker writes into the image, so there is + no assignment to allow — the fix is the other declaration. *) + let notes = + match Hashtbl.find_opt ctx.env.global_locs name with + | Some at -> [ Loc.note at (name ^ " is declared a constant here") ] + | None -> [] + in + Loc.failk "check/set-constant" loc ~notes + "%s 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" name | Some (ty, false) -> Tast.Pglobal name, ty | None -> captured ctx loc name; unknown_name ctx loc name) | Ast.Pfield (target, name) -> @@ -4636,6 +4655,32 @@ and fold_arity loc name args = (* The first two operands decide the type — [binary] picks which of them is allowed to, and that decision is not re-made per pair — and every operand after them is checked against it. *) +(* The operand, not the form. "[+] takes numbers, found string" with the caret + over the whole [(+ "a" "b")] is the exact "whole form vs operand" shape the + [check_truthy] work already fixed once: the reader has to find which of the + operands is the one being talked about, and the compiler knew. + + And a text operand gets the extra clause, because [+] on two strings is a + reach for concatenation and the answer is a function rather than an + operator here. Named without a call shape on purpose: [concat] and [join] + take a slice of byte slices and the spelling that builds one from string + literals is not a clause in a sentence. *) +and not_numeric name what (a : Tast.expr) = + let text = + match a.Tast.ty with + | Types.String -> true + | Types.Slice (Types.Int Types.U8) -> true + | _ -> false + in + let where = a.Tast.loc in + if text then + fail where + "%s takes %s, and this is %s — there is no %s on text. The prelude \ + concatenates with concat and join" + name what (Types.to_string a.Tast.ty) name + else + fail where "%s takes %s, found %s" name what (Types.to_string a.Tast.ty) + and fold_left_prim ctx ~want loc name p ok what args = let x, y, rest = match args with x :: y :: rest -> x, y, rest | _ -> assert false @@ -4651,8 +4696,7 @@ and fold_left_prim ctx ~want loc name p ok what args = (* Past [unconstrained] a variable here is one the [where] clause admitted, so the concrete predicate below has nothing to say about it — it is answered again, per copy, at the instantiation. *) - if not (ok a.Tast.ty || generic_ty a.Tast.ty) then - fail loc "%s takes %s, found %s" name what (Types.to_string a.Tast.ty); + if not (ok a.Tast.ty || generic_ty a.Tast.ty) then not_numeric name what a; let ty = a.Tast.ty in let acc = List.fold_left @@ -4986,7 +5030,7 @@ and named_call ctx ~want loc name args = else begin unconstrained ctx.env loc name ~needs:"numeric?" a.Tast.ty; if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then - fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty); + not_numeric name "numbers" a; prim Tast.Rem a.Tast.ty [ a; b ] end | "=" | "!=" | "<" | "<=" | ">" | ">=" -> @@ -5120,7 +5164,7 @@ and named_call ctx ~want loc name args = not [numeric?]. A generic that declares [ordered?] gets both. *) unconstrained ctx.env loc name ~needs:"ordered?" a.Tast.ty; if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then - fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty); + not_numeric name "numbers" a; let ty = a.Tast.ty in let cmp = if String.equal name "min" then Tast.Lt else Tast.Gt in let pick a b = @@ -7652,11 +7696,14 @@ let collect env (decls : Ast.decl list) = | Some t -> resolve env t | None -> fail loc "defvar %s needs a type" n in - Hashtbl.replace env.globals n (ty, false) + Hashtbl.replace env.globals n (ty, false); + Hashtbl.replace env.global_locs n loc | Ast.Defconst (n, Some t, _) -> - Hashtbl.replace env.globals n (resolve env t, true) + Hashtbl.replace env.globals n (resolve env t, true); + Hashtbl.replace env.global_locs n loc | Ast.Defconst (n, None, v) -> defconst_type_shaped env n v; + Hashtbl.replace env.global_locs n loc; untyped := (n, v) :: !untyped (* [Classes.expand] ran at the top of [build_program] and left none of these behind, the way [Shim.expand] leaves no [declare-c] behind. A diff --git a/lib/parse.ml b/lib/parse.ml index 6a5ac37..3116fd4 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -716,7 +716,46 @@ and bindings f (items : Form.t list) : Ast.binding list = Loc.fail odd.loc "binding %s has no value — let takes name/value pairs" (Form.to_string odd) in - if items = [] then Loc.fail f.loc "let needs at least one binding" else go items + (* [(let [x i32 5] ...)] is the first thing anyone arriving from a typed + language writes, and [let] has no annotation slot: the [i32] is read as + [x]'s value and the [5] is left with no name, so the refusal was "binding + 5 has no value", which reads as if the writer had miscounted. + + Only checked when the count is odd — that is, only on the path that was + about to refuse anyway — so a binding vector that parses is never + examined for this. The test for "this names a type" is syntactic, because + nothing is resolved at parse time: a primitive's name, or a capitalised + one, which is the convention the whole corpus keeps and the only two + spellings somebody writes an annotation with. *) + let annotation () = + let type_shaped (x : Form.t) = + match x.Form.v with + | Form.Sym n -> + List.mem n Types.primitive_names + || (n <> "" && n.[0] = Char.uppercase_ascii n.[0] + && n.[0] <> Char.lowercase_ascii n.[0]) + | _ -> false + in + let rec scan i = function + | a :: b :: rest -> + if i mod 2 = 1 && type_shaped a then Some (a, b) else scan (i + 1) (b :: rest) + | _ -> None + in + scan 0 items + in + if items = [] then Loc.fail f.loc "let needs at least one binding" + else begin + if List.length items mod 2 = 1 then + (match annotation () with + | Some (t, v) -> + Loc.failk "parse/let-type-annotation" t.Form.loc + "a let binding takes no type annotation, so %s here is read as the \ + value and %s is left with no name. Write the pair alone — the \ + type is inferred from the value" + (Form.to_string t) (Form.to_string v) + | None -> ()); + go items + end (* ── Destructuring ─────────────────────────────────────────────────── *) diff --git a/lib/reader.ml b/lib/reader.ml index 66b2ff0..0e098a7 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -89,7 +89,13 @@ let read_string st = advance st; (* opening quote *) let buf = Buffer.create 16 in let rec go () = - if at_end st then Loc.failk "reader/unterminated-string" loc "unterminated string" + if at_end st then + (* The same two places [reader/unclosed] reports, for the same reason: + the fix goes at the quote that is still open, and how far the reader + got before running out is the half a single caret cannot show. *) + Loc.failk "reader/unterminated-string" loc + ~notes:[ Loc.note (here st) "the input ends here, still inside it" ] + "unterminated string — no closing quote" else match peek st with | '"' -> advance st | '\\' -> diff --git a/test/test_flan.ml b/test/test_flan.ml index 949b430..2b91f3c 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1663,7 +1663,10 @@ let () = 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:"is a constant"; + "(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))))"); @@ -3795,6 +3798,53 @@ let () = "(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 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. *) @@ -3813,6 +3863,21 @@ let () = 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