Four more from the worst-20: the constant, the let annotation, the quote, the operand

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

@@ -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
+  if not (ok a.Tast.ty || generic_ty a.Tast.ty) then not_numeric name what a;
-    fail loc "%s takes %s, found %s" name what (Types.to_string a.Tast.ty);
   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

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 ─────────────────────────────────────────────────── *)
 

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
       | '\\' ->

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