JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Three more: the return slot, the case payload, the missing collection

Browse Source 
Ranks 13, 14 and 9.

A body form in the return slot was blamed at whatever leaf the type parser
gave up on — the [1] in [(defn f [x i32] (+ x 1))], three forms deep — where
the mistake is that the whole form is in the slot. The slot is blamed now and
the parser's own reason keeps its span as a note. Where the parser gave up on
the slot form itself the old shape stands, because a message like 'unit is
written (), not Unit' already names the right thing and leading with it is
better than restating it. The literal -- is an em dash now, like everything
else in the tree.

A one-field case binds the payload itself, so [(match s (Circle c) (.r c))]
reached for a field of an f64 and got a type fact. The binding carries what
the pattern made it, in words, derived at the arm from the case and the
subject; the refusal says the value is already in hand. Set by that path and
nowhere else, so every other binding's refusal says exactly what it said.

The missing collection asserted a thing and contradicted it in the same
sentence — 'is a directory named nosuch somewhere above X, and there is
none'. It states the rule and the two ends of the search instead. The bare
/. it printed was Filename.concat of a directory and a dot, and is cleaned
where the path is made absolute.
This commit is contained in:
Joseph Ferano 2026-09-20 18:06:13 +07:00
parent 8cba440aca
commit ea84394dd0
4 changed files with 116 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
lib/check.ml
View File

@ -39,6 +39,14 @@ type binding = {
slot : int;
bty : Types.t;
assignable : bool; (* locals are places; parameters are not — spec-memory *)
(* Where the name came from, in words, when that is worth saying in a
refusal about it. Set by the match-arm path and nowhere else: a case
pattern binds the case's fields positionally, so [(Circle c)] over a
one-field case binds [c] to an [f64] and the reach for [(.r c)] gets a
type fact about [f64] instead of the one sentence that helps, which is
that the field is already in hand. [None] everywhere else, and a refusal
with [None] says exactly what it said before. *)
bwhat : string option;
}
type env = {
@ -437,7 +445,7 @@ let fresh_slot ?name ctx ty =
variables properly means emitting a [!DILexicalBlock] per [Let] and moving
the [llvm.dbg.declare]s out of the entry block to the binding sites, which
needs block structure this IR does not carry. *)
let bind ctx name bty ~assignable =
let bind ctx ?what name bty ~assignable =
let taken n = List.exists (fun s -> s = Some n) ctx.slot_names in
let name' =
if not (taken name) then name
@ -451,7 +459,7 @@ let bind ctx name bty ~assignable =
let slot = fresh_slot ~name:name' ctx bty in
(* [ctx.scope] keeps the *source* name: the suffix is a debug-info artifact
and resolving [v] must still find the innermost binding. *)
ctx.scope <- (name, { slot; bty; assignable }) :: ctx.scope;
ctx.scope <- (name, { slot; bty; assignable; bwhat = what }) :: ctx.scope;
slot
let lookup ctx name = List.assoc_opt name ctx.scope
@ -4272,9 +4280,32 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
fail a.Ast.aloc "this match has two %s arms" c;
Hashtbl.add seen c ());
branch ctx (fun () ->
(* What each name in this arm is, in words, for the one refusal
that needs it: a case pattern binds fields positionally, so the
i'th name is the i'th field of the case the arm named. Derived
here rather than carried out of [resolve_pat], because the case
and the subject are both still in hand and the alternative was
widening that function's result for one message. *)
let fields =
match subject, ctor with
| `Data u, Some c ->
(match Tast.case_index u c with
| Some (_, v) ->
List.map
(fun (fd : Tast.field) ->
Printf.sprintf "%s.%s's field %s" u.Tast.dname c
fd.Tast.fname)
v.Tast.vfields
| None -> [])
| `Option _, Some "Some" -> [ "the Option's payload" ]
| _ -> []
in
let binds =
List.map
(fun (n, ty) -> bind ctx n ty ~assignable:false) binds
List.mapi
(fun i (n, ty) ->
let what = List.nth_opt fields i in
bind ctx ?what n ty ~assignable:false)
binds
in
(* Every arm is the tail, exactly as an [if]'s two arms are.
Restored here because checking the scrutinee withdrew it. *)
@ -4467,6 +4498,20 @@ and struct_target ctx (target : Ast.expr) : Tast.expr * string =
whose arms bind the fields of the case they matched"
n
| other ->
(* The pattern bound this, and it looks like a destructuring that did not
take: [(match s (Circle c) (.r c))] over a one-field case binds [c] to
the payload itself. "f64 is not a struct" is true and is a type fact
where the reader needs to be told the value is already in hand. *)
(match target.Ast.e with
| Ast.Var n ->
(match lookup ctx n with
| Some { bwhat = Some w; _ } ->
fail target.Ast.loc
"%s is %s — the pattern bound it to %s, so the value is already \
in hand and there is no field left to read"
n (Types.to_string other) w
| _ -> ())
| _ -> ());
fail target.Ast.loc "%s is not a struct, so it has no fields"
(Types.to_string other)

21
lib/load.ml
View File

@ -103,11 +103,15 @@ let is_package_file path =
Filename.check_suffix path ".flan" && Sys.file_exists path
&& not (Sys.is_directory path)
(* [Filename.concat] of a directory and "." leaves the dot on the end, and the
dot was being printed at the reader in the one message that shows this
path. Nothing else depends on the spelling, so it is cleaned here. *)
let absolute d =
let d = if Filename.is_relative d then Filename.concat (Sys.getcwd ()) d else d in
if Filename.basename d = Filename.current_dir_name then Filename.dirname d else d
let resolve_dir ~file loc path =
let here =
let d = Filename.dirname file in
if Filename.is_relative d then Filename.concat (Sys.getcwd ()) d else d
in
let here = absolute (Filename.dirname file) in
let ok d = (Sys.file_exists d && Sys.is_directory d) || is_package_file d in
match split_path path with
| None, rel ->
@ -117,9 +121,14 @@ let resolve_dir ~file loc path =
| Some collection, rel ->
(match find_collection here collection with
| None ->
(* Stated, rather than asserted and then contradicted in the same
sentence. What the reader needs is the rule — where a collection is
looked for — and the two ends of the search that was run. *)
fail loc
"the collection %s: is a directory named %s somewhere above %s, and \
there is none" collection collection here
"no collection named %s. A collection is a directory of that name in \
the importing file's own directory or in one above it, and there is \
none between %s and the root"
collection here
| Some root ->
let d = Filename.concat root rel in
if ok d then d else fail loc "the package %s is not at %s" path d)

25
lib/parse.ml
View File

@ -1286,10 +1286,27 @@ let rec decl (f : Form.t) : Ast.decl =
would be true and unhelpful. *)
let rty =
try texpr ret with
| Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
Loc.fail loc
"%s. This is the return type, which every defn states -- a \
function that returns nothing writes ()" msg
| Loc.Error { Loc.dloc = inner; dmsg = msg; _ } ->
(* The slot, not whatever inside it [texpr] happened to give 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 return
slot. What [texpr] said keeps its own span as a note, because it
is still the reason. *)
if inner.Loc.line = ret.Form.loc.Loc.line
&& inner.Loc.col = ret.Form.loc.Loc.col
then
(* [texpr] gave up on the slot form itself, so what it said is
already about the right thing — [unit is written (), not Unit]
leads, and the slot's own clause follows it. *)
Loc.failk "parse/return-type-expected" inner
"%s — this is the return type, which every defn states, and a \
function that returns nothing writes ()" msg
else
Loc.failk "parse/return-type-expected" ret.Form.loc
~notes:[ Loc.note inner msg ]
"the return type goes here, and this is %s — every defn states \
one, and a function that returns nothing writes ()"
(Form.to_string ret)
in
let fwhere, body = constraints body in
mk (Ast.Defn { Ast.name = sym n; params = []; praw = Some (pitems ps);

31
test/test_flan.ml
View File

@ -3845,6 +3845,37 @@ let () =
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";
(* 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. *)