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

Four copies in the checker become four callers

Browse Source 
get and map-remove asked the runtime the same question through two
identical bodies; only the symbol differed, so map_lookup takes it and
both entry points keep their own preambles and their own prose.

invented_ctx existed and six sites still wrote the sixteen-field literal
out by hand. All six go through it now — three verbatim, three with the
two or three fields that make them a written body rather than an
invented one — so a field added to the record is one edit.

dyn_descriptors and dyn_sites each walked every place a value can live,
and the two walks had already drifted: an unnamed frame slot was "a
local of f" in one and "a local in f" in the other. One value_sites
walker now, with the callers' filters kept on their side; the surviving
text is "a local in f", because a named slot has always read "n in f"
and neither spelling was pinned by a test.

The duplicate-field scan appeared three times and the ZII fill twice —
check_case's own comment conceded the copy. given_once and zii_fill.
The union keeps its unknown-member pass ahead of the scan rather than
folding it in, because that ordering is what it reports today.
This commit is contained in:
Joseph Ferano 2026-09-20 11:50:19 +07:00
parent 7db5ec1885
commit 001f17b8bf
1 changed files with 198 additions and 210 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

408
lib/check.ml
View File

@ -1837,9 +1837,21 @@ let rec bytewise_key = function
let hash_ty = Types.Int Types.U64 let hash_ty = Types.Int Types.U64
(* A context for a function the checker is about to invent. Nothing is (* The fresh context a frame starts from: no outer scope, no defers, no loops,
reachable from it: no outer scope, no defers, and [defer_ok] false, because and [defer_ok] false. As written it is a function the checker invented —
none of these is a body anyone wrote. *) nothing is reachable from it because none of it is a body anyone wrote — and
that is how the emitted hashers and the constant-inference pass take it.
A body someone *did* write starts here too and then reattaches the few
fields that make it theirs: [owner] is the function's name, and an fn or a
handler sets [outer] to the enclosing scope so that a reference to the
enclosing function's locals is refused for the reason it is really refused
for. Those are [with] clauses on this record rather than a literal of their
own, so that a field added here is added to all of them.
Each caller calls it again rather than sharing one value: [slots] and
[slot_tys] are counted up per frame, and two frames that shared a context
would share a slot counter. *)
let invented_ctx env ret = let invented_ctx env ret =
{ env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = [];
defers = []; defer_slot = None; outer = []; outer_what = None; in_frames = None; loops = []; tail = false; defers = []; defer_slot = None; outer = []; outer_what = None; in_frames = None; loops = []; tail = false;
@ -2103,6 +2115,67 @@ let deferred_key env loc what (k : Types.t) =
true true
| _ -> false | _ -> false
(* The body shared by [get] and [map-remove]: both answer an (Option V), both
ask the runtime one question over (key address, out address, sizes, hash,
equality), and the only thing that differs between them is which symbol is
called. [sym] is therefore the whole of the difference, and the entry points
above keep their own preambles — the dyn case and the deferred-key case are
not the same on the two sides.
The key is checked and the out slot zeroed by the caller's [k] and by
[Tast.Zero] here; the Option is built here rather than in the runtime,
because the runtime answers 1/0 and fills [out] only when it answers 1. It
has no idea what an Option's layout is, and keeping it that way is what lets
one entry point serve every value type. *)
let map_lookup ctx ~want loc sym target kt vt k =
let hash, eq = key_fns ctx.env loc kt in
let ks = fresh_slot ctx kt in
let out = fresh_slot ctx vt in
let found =
rt loc (Types.Int Types.I8) sym
[ target; addr_of loc (mk loc kt (Tast.Local ks));
addr_of loc (mk loc vt (Tast.Local out));
size_of loc kt; size_of loc vt; hash; eq; here loc ]
in
let oty = Types.Option vt in
let some = mk loc oty (Tast.Some_ (mk loc vt (Tast.Local out))) in
let none = mk loc oty Tast.None_ in
let cond =
mk loc Types.Bool
(Tast.Prim (Tast.Ne,
[ found;
mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
in
expect ctx loc ~want
(mk loc oty
(Tast.Let ([ (ks, k);
(out, mk loc vt (Tast.Zero vt)) ],
[ mk loc oty (Tast.If (cond, some, none)) ])))
(* The braced-pairs scan a struct literal, a union value and a data case all
do: each key is refused if it has already been given, with a note at the
first mention, and the table of what was given comes back for the fill that
follows. [noun] is the word the message uses — a union's are members, the
other two have fields — and [~known] is the caller's own unknown-key
refusal, run after the duplicate check on the same pair so that a key given
twice is reported as the duplicate it is rather than as whatever the second
mention is. A caller that wants its unknown-key pass run over all the pairs
first, before any of this, passes no [~known] and keeps its own loop. *)
let given_once ~noun ?(known = fun _ _ -> ()) kvs =
let seen = Hashtbl.create 8 in
List.iter
(fun (k, (v : Ast.expr)) ->
(match Hashtbl.find_opt seen k with
| Some (first : Ast.expr) ->
Loc.failk "check/duplicate-field" v.Ast.loc
~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
"%s %s is given twice" noun k
| None -> ());
known k v;
Hashtbl.add seen k v)
kvs;
seen
let rec check ctx ?want (e : Ast.expr) : Tast.expr = let rec check ctx ?want (e : Ast.expr) : Tast.expr =
let loc = e.Ast.loc in let loc = e.Ast.loc in
(* Read the permission this form was given and withdraw it in the same (* Read the permission this form was given and withdraw it in the same
@ -2671,11 +2744,8 @@ and check_fn ctx ~want loc (params : string list) body =
reference to the enclosing function's locals is refused for the reason it reference to the enclosing function's locals is refused for the reason it
is really refused for. *) is really refused for. *)
let fctx = let fctx =
{ env = ctx.env; ret; slots = 0; slot_tys = []; slot_names = []; { (invented_ctx ctx.env ret) with
scope = []; defers = []; defer_slot = None; outer = ctx.scope; outer = ctx.scope; outer_what = Some "an fn"; owner = ctx.owner }
outer_what = Some "an fn"; in_frames = None; loops = []; tail = false;
in_defer = false; defer_ok = false; defer_block = "a nested form";
owner = ctx.owner }
in in
List.iter2 List.iter2
(fun n t -> ignore (bind fctx n t ~assignable:false)) params pts; (fun n t -> ignore (bind fctx n t ~assignable:false)) params pts;
@ -2753,8 +2823,8 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body =
(* Its own context: a fresh frame, an empty scope, and no way to reach (* Its own context: a fresh frame, an empty scope, and no way to reach
the enclosing one. *) the enclosing one. *)
let hctx = let hctx =
{ env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; { (invented_ctx ctx.env Types.Unit) with
scope = []; defers = []; defer_slot = None; outer = ctx.scope; outer_what = Some "a handler"; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" } outer = ctx.scope; outer_what = Some "a handler" }
in in
(* The condition crosses as a pointer, because the handler runs while (* The condition crosses as a pointer, because the handler runs while
the signalling frame is still alive and there is nothing to copy. the signalling frame is still alive and there is nothing to copy.
@ -3557,32 +3627,15 @@ and check_struct ctx ~want loc name kvs =
Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name) Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name)
"unknown struct %s" name) "unknown struct %s" name)
| Some s -> | Some s ->
let seen = Hashtbl.create 8 in let seen =
List.iter given_once ~noun:"field" kvs
(fun (k, (v : Ast.expr)) -> ~known:(fun k (v : Ast.expr) ->
(match Hashtbl.find_opt seen k with if Tast.field_index s k = None then
| Some (first : Ast.expr) -> Loc.failk "check/unknown-field" v.Ast.loc
Loc.failk "check/duplicate-field" v.Ast.loc ~notes:(declared_note ctx.env name)
~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ] "%s has no field %s" name k)
"field %s is given twice" k
| None -> ());
if Tast.field_index s k = None then
Loc.failk "check/unknown-field" v.Ast.loc
~notes:(declared_note ctx.env name)
"%s has no field %s" name k;
Hashtbl.add seen k v)
kvs;
(* Omitted fields are zeroed — ZII, the same rule as a declaration with no
initialiser (plan.org, Data model). Every field is present from here on,
in declaration order, so no backend has to know about omission. *)
let fields =
map_lr
(fun (f : Tast.field) ->
match Hashtbl.find_opt seen f.Tast.fname with
| Some v -> check ctx ~want:f.Tast.fty v
| None -> mk loc f.Tast.fty (Tast.Zero f.Tast.fty))
s.Tast.fields
in in
let fields = zii_fill ctx loc seen s.Tast.fields in
expect ctx loc ~want (mk loc (Types.Named name) (Tast.Make (name, fields))) expect ctx loc ~want (mk loc (Types.Named name) (Tast.Make (name, fields)))
(* [(U {.member v})] — an untagged union value. (* [(U {.member v})] — an untagged union value.
@ -3609,21 +3662,14 @@ and check_union ctx ~want loc name kvs =
~notes:(declared_note ctx.env name) ~notes:(declared_note ctx.env name)
"%s has no member %s" name k) "%s has no member %s" name k)
kvs; kvs;
let seen = Hashtbl.create 8 in (* Before the two-member refusal below, so [(U {.i 1 .i 2})] is told it named
List.iter one member twice rather than that [i] and [i] are the same bytes — which is
(fun (k, (v : Ast.expr)) -> true and useless. Same helper, same note and the same [check/duplicate-
(* Before the two-member refusal below, so [(U {.i 1 .i 2})] is told it field] kind as the struct path, because it is the same mistake; only the
named one member twice rather than that [i] and [i] are the same noun changes. The unknown-member refusal above stays its own full pass
bytes — which is true and useless. Same words and same note as the rather than being handed to [~known], so that [(U {.i 1 .i 1 .bad 2})] is
struct path, because it is the same mistake. *) still told about [.bad] first, as it is today. *)
(match Hashtbl.find_opt seen k with ignore (given_once ~noun:"member" kvs : (string, Ast.expr) Hashtbl.t);
| Some (first : Ast.expr) ->
Loc.failk "check/duplicate-field" v.Ast.loc
~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
"member %s is given twice" k
| None -> ());
Hashtbl.add seen k v)
kvs;
(match kvs with (match kvs with
| (a, _) :: (b, (second : Ast.expr)) :: _ -> | (a, _) :: (b, (second : Ast.expr)) :: _ ->
Loc.failk "check/union-two-members" second.Ast.loc Loc.failk "check/union-two-members" second.Ast.loc
@ -3663,36 +3709,36 @@ and first_case_name env dname =
| _ -> "Case" | _ -> "Case"
(* [(U.C {.f v ...})]. The fields are checked and filled in exactly as a (* [(U.C {.f v ...})]. The fields are checked and filled in exactly as a
struct's are — same ZII, same duplicate and unknown-field refusals — and the struct's are — literally so: the same [given_once] and [zii_fill], with only
only difference is the node at the end and the type it carries. *) the index function and the name in the unknown-field message differing — and
the only other difference is the node at the end and the type it carries. *)
and check_case ctx ~want loc dname (c : Tast.variant) kvs = and check_case ctx ~want loc dname (c : Tast.variant) kvs =
let full = dname ^ "." ^ c.Tast.vname in let full = dname ^ "." ^ c.Tast.vname in
let seen = Hashtbl.create 8 in let seen =
List.iter given_once ~noun:"field" kvs
(fun (k, (v : Ast.expr)) -> ~known:(fun k (v : Ast.expr) ->
(match Hashtbl.find_opt seen k with if Tast.vfield_index c k = None then
| Some (first : Ast.expr) -> Loc.failk "check/unknown-field" v.Ast.loc
Loc.failk "check/duplicate-field" v.Ast.loc ~notes:(declared_note ctx.env dname)
~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ] "%s has no field %s" full k)
"field %s is given twice" k
| None -> ());
if Tast.vfield_index c k = None then
Loc.failk "check/unknown-field" v.Ast.loc
~notes:(declared_note ctx.env dname)
"%s has no field %s" full k;
Hashtbl.add seen k v)
kvs;
let fields =
map_lr
(fun (f : Tast.field) ->
match Hashtbl.find_opt seen f.Tast.fname with
| Some v -> check ctx ~want:f.Tast.fty v
| None -> mk loc f.Tast.fty (Tast.Zero f.Tast.fty))
c.Tast.vfields
in in
let fields = zii_fill ctx loc seen c.Tast.vfields in
expect ctx loc ~want expect ctx loc ~want
(mk loc (Types.Named dname) (Tast.MakeCase (dname, c.Tast.vname, fields))) (mk loc (Types.Named dname) (Tast.MakeCase (dname, c.Tast.vname, fields)))
(* Omitted fields are zeroed — ZII, the same rule as a declaration with no
initialiser (plan.org, Data model). Every field is present from here on, in
declaration order, so no backend has to know about omission. [seen] is what
[given_once] collected; [fields] is the declaration, and it is the
declaration that fixes the order. *)
and zii_fill ctx loc seen fields =
map_lr
(fun (f : Tast.field) ->
match Hashtbl.find_opt seen f.Tast.fname with
| Some v -> check ctx ~want:f.Tast.fty v
| None -> mk loc f.Tast.fty (Tast.Zero f.Tast.fty))
fields
and check_arr ctx ~want loc items = and check_arr ctx ~want loc items =
let elem_want = let elem_want =
match want with match want with
@ -5198,33 +5244,7 @@ and named_call ctx ~want loc name args =
if deferred_key ctx.env loc "get" kt then if deferred_key ctx.env loc "get" kt then
expect ctx loc ~want (mk loc (Types.Option vt) Tast.None_) expect ctx loc ~want (mk loc (Types.Option vt) Tast.None_)
else else
let hash, eq = key_fns ctx.env loc kt in map_lookup ctx ~want loc "flan_map_get" target kt vt k
let ks = fresh_slot ctx kt in
let out = fresh_slot ctx vt in
let found =
rt loc (Types.Int Types.I8) "flan_map_get"
[ target; addr_of loc (mk loc kt (Tast.Local ks));
addr_of loc (mk loc vt (Tast.Local out));
size_of loc kt; size_of loc vt; hash; eq; here loc ]
in
let oty = Types.Option vt in
(* The runtime answers 1/0 and fills [out] only when it answers 1, so
the Option is built here rather than there: the runtime has no idea
what an Option's layout is, and keeping it that way is what lets one
entry point serve every value type. *)
let some = mk loc oty (Tast.Some_ (mk loc vt (Tast.Local out))) in
let none = mk loc oty Tast.None_ in
let cond =
mk loc Types.Bool
(Tast.Prim (Tast.Ne,
[ found;
mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
in
expect ctx loc ~want
(mk loc oty
(Tast.Let ([ (ks, k);
(out, mk loc vt (Tast.Zero vt)) ],
[ mk loc oty (Tast.If (cond, some, none)) ])))
end end
| _ -> assert false) | _ -> assert false)
@ -5270,31 +5290,7 @@ and named_call ctx ~want loc name args =
if deferred_key ctx.env loc "map-remove" kt then if deferred_key ctx.env loc "map-remove" kt then
expect ctx loc ~want (mk loc (Types.Option vt) Tast.None_) expect ctx loc ~want (mk loc (Types.Option vt) Tast.None_)
else else
let hash, eq = key_fns ctx.env loc kt in map_lookup ctx ~want loc "flan_map_remove" target kt vt k
let ks = fresh_slot ctx kt in
let out = fresh_slot ctx vt in
let found =
rt loc (Types.Int Types.I8) "flan_map_remove"
[ target; addr_of loc (mk loc kt (Tast.Local ks));
addr_of loc (mk loc vt (Tast.Local out));
size_of loc kt; size_of loc vt; hash; eq; here loc ]
in
let oty = Types.Option vt in
(* Built here and not there, as [get]'s is: the runtime fills [out] only
when it answers 1 and has no idea what an Option's layout is. *)
let some = mk loc oty (Tast.Some_ (mk loc vt (Tast.Local out))) in
let none = mk loc oty Tast.None_ in
let cond =
mk loc Types.Bool
(Tast.Prim (Tast.Ne,
[ found;
mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
in
expect ctx loc ~want
(mk loc oty
(Tast.Let ([ (ks, k);
(out, mk loc vt (Tast.Zero vt)) ],
[ mk loc oty (Tast.If (cond, some, none)) ])))
| _ -> assert false) | _ -> assert false)
(* (map-next m (addr cur) (addr k) (addr v)) -> bool, and the whole of map (* (map-next m (addr cur) (addr k) (addr v)) -> bool, and the whole of map
@ -7054,10 +7050,7 @@ let collect env (decls : Ast.decl list) =
defined in terms of another declared after it. A constant that still does defined in terms of another declared after it. A constant that still does
not check once no progress is left has a real error, so the last round is not check once no progress is left has a real error, so the last round is
run without swallowing it. *) run without swallowing it. *)
let infer (_, v) = let infer (_, v) = (check (invented_ctx env Types.Unit) v).Tast.ty in
(check { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; defer_slot = None;
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" } v).Tast.ty
in
let pending = ref (List.rev !untyped) in let pending = ref (List.rev !untyped) in
let rec settle () = let rec settle () =
let left = let left =
@ -7184,9 +7177,7 @@ let check_union_members env =
let rec check_fn env (fn : Ast.fn) : Tast.fn = let rec check_fn env (fn : Ast.fn) : Tast.fn =
let params, ret = Hashtbl.find env.fns fn.Ast.name in let params, ret = Hashtbl.find env.fns fn.Ast.name in
let ctx = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; defer_slot = None; let ctx = { (invented_ctx env ret) with owner = fn.Ast.name } in
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form";
owner = fn.Ast.name } in
List.iter2 List.iter2
(fun (p : Ast.field) ty -> (fun (p : Ast.field) ty ->
if List.mem_assoc p.Ast.fname ctx.scope then begin if List.mem_assoc p.Ast.fname ctx.scope then begin
@ -7525,8 +7516,7 @@ let lift_ginit ctx loc n ty (v : Tast.expr) =
{ Tast.e = Tast.Call (fname, []); ty; loc } { Tast.e = Tast.Call (fname, []); ty; loc }
let check_global env (d : Ast.decl) : Tast.global option = let check_global env (d : Ast.decl) : Tast.global option =
let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; defer_slot = None; let ctx () = invented_ctx env Types.Unit in
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" } in
match d.Ast.d with match d.Ast.d with
| Ast.Defvar (n, _, init) -> | Ast.Defvar (n, _, init) ->
let ty, _ = Hashtbl.find env.globals n in let ty, _ = Hashtbl.find env.globals n in
@ -8034,10 +8024,57 @@ let rec hidden_dyn p seen (t : Types.t) : Types.t option =
| None -> None) | None -> None)
| _ -> None | _ -> None
(* Every place a value can live: a global, a parameter, a return, a frame slot.
Two passes want exactly this list — the descriptor refusal below and the
[--no-gc] site collection at the bottom of the file — and each walked it
itself until the phrase naming an unnamed slot drifted between the two. One
walk now; the callers keep their own filters, which is where they really
differ.
[visit] is handed the location, the phrase naming the place, and the type.
[~slot] says whether this is a frame slot: that is the one distinction a
caller filters on, and a caller cannot recover it from the type. [?after_fn]
runs at the end of each function, before the next is begun, so that a caller
which also walks the body emits its diagnostics in the order a single loop
over [p.Tast.fns] gave them. *)
let value_sites (p : Tast.program) ?(after_fn = fun (_ : Tast.fn) -> ())
(visit : slot:bool -> _) =
List.iter
(fun (g : Tast.global) ->
visit ~slot:false g.Tast.ginit.Tast.loc
(Printf.sprintf "the global %s" g.Tast.gname) g.Tast.gty)
p.Tast.globals;
List.iter
(fun (fn : Tast.fn) ->
List.iteri
(fun i t ->
visit ~slot:false fn.Tast.floc
(Printf.sprintf "parameter %d of %s" (i + 1) fn.Tast.name) t)
fn.Tast.params;
visit ~slot:false fn.Tast.floc
(Printf.sprintf "the return type of %s" fn.Tast.name) fn.Tast.ret;
Array.iteri
(fun i t ->
(* A slot the program named is called by that name; one the checker
synthesised has none to give, and "a local" is the phrase both
passes now use for it. The preposition is [in] either way,
because a named slot has always read "%s in %s". *)
let named =
if i < Array.length fn.Tast.snames then fn.Tast.snames.(i)
else None
in
visit ~slot:true fn.Tast.floc
(Printf.sprintf "%s in %s"
(match named with Some n -> n | None -> "a local")
fn.Tast.name)
t)
fn.Tast.slots;
after_fn fn)
p.Tast.fns
(* Over the whole program rather than at each declaration, because the type (* Over the whole program rather than at each declaration, because the type
that hides a dyn may be declared after the one that names it — and because that hides a dyn may be declared after the one that names it — and because
a struct nobody ever holds a value of costs nothing either way. Every place a struct nobody ever holds a value of costs nothing either way. *)
a value can live is here: a global, a parameter, a return, a frame slot. *)
let dyn_descriptors (p : Tast.program) = let dyn_descriptors (p : Tast.program) =
let check loc what (t : Types.t) = let check loc what (t : Types.t) =
(match hidden_dyn p [] t with (match hidden_dyn p [] t with
@ -8112,33 +8149,7 @@ let dyn_descriptors (p : Tast.program) =
refuse "the return type" e.Tast.eret refuse "the return type" e.Tast.eret
"What C hands back points at storage this compiler never rooted") "What C hands back points at storage this compiler never rooted")
p.Tast.externs; p.Tast.externs;
List.iter value_sites p (fun ~slot:_ loc what t -> check loc what t)
(fun (g : Tast.global) ->
check g.Tast.ginit.Tast.loc
(Printf.sprintf "the global %s" g.Tast.gname) g.Tast.gty)
p.Tast.globals;
List.iter
(fun (fn : Tast.fn) ->
List.iteri
(fun i t ->
check fn.Tast.floc
(Printf.sprintf "parameter %d of %s" (i + 1) fn.Tast.name) t)
fn.Tast.params;
check fn.Tast.floc
(Printf.sprintf "the return type of %s" fn.Tast.name) fn.Tast.ret;
Array.iteri
(fun i t ->
let what =
match
(if i < Array.length fn.Tast.snames then fn.Tast.snames.(i)
else None)
with
| Some n -> Printf.sprintf "%s in %s" n fn.Tast.name
| None -> Printf.sprintf "a local of %s" fn.Tast.name
in
check fn.Tast.floc what t)
fn.Tast.slots)
p.Tast.fns
let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
let env = new_env () in let env = new_env () in
@ -8327,10 +8338,7 @@ let instances_since env mark =
than a second sentence written here that would drift from it. *) than a second sentence written here that would drift from it. *)
let expressions env (es : (Types.t option * Ast.expr) list) : let expressions env (es : (Types.t option * Ast.expr) list) :
Tast.expr list * Types.t array * string option array = Tast.expr list * Types.t array * string option array =
let ctx = let ctx = invented_ctx env Types.Unit in
{ env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; defer_slot = None;
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" }
in
(* Folded rather than mapped, because [List.map]'s order is unspecified and (* Folded rather than mapped, because [List.map]'s order is unspecified and
every one of these calls has a side effect on [ctx] — the slot counter it every one of these calls has a side effect on [ctx] — the slot counter it
shares. An order nobody chose is one that can differ between builds, and shares. An order nobody chose is one that can differ between builds, and
@ -8382,48 +8390,28 @@ let dyn_sites (p : Tast.program) : Loc.diag list =
expression in it ever having the type [dyn] — a zeroed one, never filled, expression in it ever having the type [dyn] — a zeroed one, never filled,
whose dyn word the collector is still asked to mark. *) whose dyn word the collector is still asked to mark. *)
let holds t = dyn_anywhere p [] t in let holds t = dyn_anywhere p [] t in
List.iter value_sites p
(fun (g : Tast.global) -> (* The filter this pass has and the descriptor pass does not: a frame slot
if holds g.Tast.gty then whose type is bare [dyn] is passed over here. A parameter or a global of
add g.Tast.ginit.Tast.loc (Printf.sprintf "the global %s" g.Tast.gname)) that type is still named. *)
p.Tast.globals; (fun ~slot loc what t ->
List.iter if holds t && not (slot && t = Types.Dyn) then add loc what)
(fun (fn : Tast.fn) -> ~after_fn:(fun (fn : Tast.fn) ->
List.iteri (* The body's own dyn values, which are the ones a signature does not
(fun i t -> show: a let bound to a boxed literal, a (vec-new dyn) deep inside an
if holds t then expression. Reported at the node, because that is the character to
add fn.Tast.floc change. *)
(Printf.sprintf "parameter %d of %s" (i + 1) fn.Tast.name)) List.iter
fn.Tast.params; (Tast.walk
if holds fn.Tast.ret then (fun (e : Tast.expr) ->
add fn.Tast.floc (Printf.sprintf "the return type of %s" fn.Tast.name); match e.Tast.e with
Array.iteri | Tast.Prim (Tast.Rt sym, _)
(fun i t -> when e.Tast.ty = Types.Dyn
if holds t && not (t = Types.Dyn) then && String.length sym > 8
add fn.Tast.floc && String.sub sym 0 8 = "flan_dyn" ->
(Printf.sprintf "%s in %s" add e.Tast.loc (Printf.sprintf "this value in %s" fn.Tast.name)
(match | _ -> ()))
(if i < Array.length fn.Tast.snames then fn.Tast.snames.(i) fn.Tast.body);
else None)
with Some n -> n | None -> "a local")
fn.Tast.name))
fn.Tast.slots;
(* The body's own dyn values, which are the ones a signature does not
show: a let bound to a boxed literal, a (vec-new dyn) deep inside an
expression. Reported at the node, because that is the character to
change. *)
List.iter
(Tast.walk
(fun (e : Tast.expr) ->
match e.Tast.e with
| Tast.Prim (Tast.Rt sym, _)
when e.Tast.ty = Types.Dyn
&& String.length sym > 8
&& String.sub sym 0 8 = "flan_dyn" ->
add e.Tast.loc (Printf.sprintf "this value in %s" fn.Tast.name)
| _ -> ()))
fn.Tast.body)
p.Tast.fns;
List.rev_map List.rev_map
(fun (loc, what) -> (fun (loc, what) ->
Loc.diag ~kind:"check/no-gc" loc Loc.diag ~kind:"check/no-gc" loc