diff --git a/lib/check.ml b/lib/check.ml index 305b1d8..6bd480e 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -5540,6 +5540,54 @@ let program (decls : Ast.decl list) : Tast.program = let program_all (decls : Ast.decl list) : Tast.program = fst (build_program ~keep_going:true decls) +(* ── What a session needs to know about instantiations ────────────────── + A generic [defn] never reaches [Tast.fns] — only its copies do — so the + editor's [C-c C-c], which installs the bodies named by the form it was + sent, would install nothing at all for a generic. These are what + [Session.eval] expands the name with. They are here rather than there + because [env]'s tables are the only record that a symbol was ever generic: + past this module an instantiation is an ordinary function and nothing knows + it was written once. *) + +(* Is this name a generic definition rather than an ordinary one? *) +let is_generic env n = Hashtbl.mem env.gsigs n + +(* Every copy of [gname] this check produced, by symbol. Transitivity needs no + walk: a whole-program check has already generated every copy every call + site asked for, including the ones a generic pulled in by calling another + generic at its own variable. *) +let instantiations env gname = + match Hashtbl.find_opt env.insts gname with + | None -> [] + | Some l -> List.rev_map (fun (_, _, sym) -> sym) !l + +(* The generic a symbol came from, and the types it was asked for — [None] for + an ordinary function. What a refusal about [sort!-i32] needs in order to + say which line the programmer should look at, since [sort!-i32] appears + nowhere in the source. *) +let instantiation_origin env sym = + Hashtbl.fold + (fun gname l acc -> + match acc with + | Some _ -> acc + | None -> + (match List.find_opt (fun (_, _, s) -> String.equal s sym) !l with + | Some (ps, _, _) -> Some (gname, ps) + | None -> None)) + env.insts None + +(* Checking one expression against a live session can *generate* a copy: the + first [C-x C-e] of [(id 3)] instantiates [id] at [i32] and the copy is in + [env.instances] and in no program anywhere. Without these two the module + that gets built calls a symbol it never defined. A mark before and the + difference after is the whole protocol. *) +let instance_mark env = List.length env.instances + +let instances_since env mark = + let fresh = List.length env.instances - mark in + List.rev + (List.filteri (fun i _ -> i < fresh) env.instances) + (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing function — so the slots it needs are whatever its own [let]s allocate. *) diff --git a/lib/session.ml b/lib/session.ml index 3218d1e..1fe1103 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -128,7 +128,8 @@ let known t n = (* Everything here is a change that would load cleanly and then be wrong. The house rule (NEXT.md, Watch for) says recognise it and refuse with the reason, so each one names what it would have broken. *) -let compatible ~loc (old_ : Tast.program) (new_ : Tast.program) = +let compatible ?(origin = fun _ -> None) ~loc (old_ : Tast.program) + (new_ : Tast.program) = let find_fn p n = List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name n) p.Tast.fns in @@ -154,15 +155,46 @@ let compatible ~loc (old_ : Tast.program) (new_ : Tast.program) = until they do, rather than becoming a silent mismatch. See plan.org, Hot reload, and open decision #6. *) if not same then + (* ── When the name is not one the programmer wrote ────────────── + A generic's instantiations are named [sort!-i32], [sort!-f32] + and so on, and the mangling carries only the *type variables* + — so editing the generic's other parameters changes every copy's + signature at once, under the same names. The refusal then + arrives about [sort!-i32], which appears nowhere in the file + being edited, for a reason invisible at the edited line. + + So the refusal says where the name came from: which generic, at + which types, and that every copy changed together. The + programmer's next move is a restart either way — the point is + that they can tell *why* without going looking for a function + that does not exist in the source. + + Note what does *not* come through here: adding or removing a + [where] clause changes no signature at all. It changes which + call sites are legal, and those refusals land at the call sites, + in the checker, before this is ever reached. *) + let what, note = + match origin f.Tast.name with + | None -> f.Tast.name, "" + | Some (gname, tys) -> + ( Printf.sprintf "%s, the copy of the generic %s at %s" + f.Tast.name gname + (String.concat ", " (List.map Types.to_string tys)), + Printf.sprintf + " Editing %s changed every copy of it at once, so this \ + refusal is about a function the source does not name." + gname ) + in fail loc "%s changes signature, from (Fn [%s] %s) to (Fn [%s] %s); \ the calls already compiled into the running program pass the old \ - one. Restart to change it." - f.Tast.name + one.%s Restart to change it." + what (String.concat " " (List.map Types.to_string g.Tast.params)) (Types.to_string g.Tast.ret) (String.concat " " (List.map Types.to_string f.Tast.params)) - (Types.to_string f.Tast.ret)) + (Types.to_string f.Tast.ret) + note) new_.Tast.fns; List.iter (fun (g : Tast.global) -> @@ -354,9 +386,29 @@ let eval ?(origin = "") ?pause t src : change = (* Nothing above this line has changed the session. A [Loc.Error] from here leaves it exactly as it was. *) let program, env = Check.program_with_env decls in - compatible ~loc t.program program; + compatible ~origin:(Check.instantiation_origin env) ~loc t.program program; compatible_enums ~loc t.decls decls; - let fns = + (* ── The bodies to install ──────────────────────────────────────────── + The names the form declared that have a body in the checked program — + and, for a generic, the bodies its *copies* have, because a generic + [defn] never reaches [Tast.fns] at all. Without the second clause + [C-c C-c] on a generic reports [installs=false, fns=[]]: it installs + nothing and says nothing went wrong, which is the feature being unusable + in the loop the project exists for. + + Transitivity is free. The check above was a whole-program check, so + [env.insts] already holds every copy every call site asked for, including + the ones a redefined generic pulled in by calling another generic at its + own variable. + + The third clause is the one that makes a redefinition reach a type the + process was never built with. Redefining a *caller* so that it uses a + generic at a new element type generates a brand-new symbol the host has + never had — it is not [known t] and no name in [names] mentions it — so + it has to be found by being an instantiation that the running process + lacks. [Emit.redefinition] then writes it as a new by-name cell, which is + the same path a [defn] the process was never built with already takes. *) + let declared_fns = List.filter (fun n -> List.exists @@ -364,6 +416,26 @@ let eval ?(origin = "") ?pause t src : change = program.Tast.fns) names in + let from_generics = + List.concat_map + (fun n -> + if Check.is_generic env n then Check.instantiations env n else []) + names + in + let new_instances = + List.filter_map + (fun (f : Tast.fn) -> + if known t f.Tast.name then None + else + match Check.instantiation_origin env f.Tast.name with + | Some _ -> Some f.Tast.name + | None -> None) + program.Tast.fns + in + let fns = + List.sort_uniq String.compare + (declared_fns @ from_generics @ new_instances) + in (* A constant that changed and can be published: known to the host, not consumed by the checker. The module stores its new value at the frame boundary, exactly as it stores a new function body. *) @@ -1010,7 +1082,15 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = Ast.loc = parsed.Ast.loc } else parsed in + (* Checking against the live environment can *generate* code: the first + [C-x C-e] of a call to a generic at a type nothing has used yet + instantiates it here, and the copy lands in [t.env] and in no program + anywhere. Marked before and collected after, and spliced into the module + below — without this the thunk calls a symbol the module never defines + and the host has no cell for. *) + let mark = Check.instance_mark t.env in let checked, base, bnames = Check.expression t.env parsed in + let fresh = Check.instances_since t.env mark in (* The thunk's frame starts at whatever [Check.expression] needed and grows as the walk finds slices in it, so the slots the renderer asks for are appended past [base] and collected here to size the frame below. *) @@ -1047,15 +1127,21 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = for every expression ever typed. *) let program = { t.program with - Tast.fns = t.program.Tast.fns @ [ thunk ]; + Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ]; externs = t.program.Tast.externs @ externs } in + (* The copies stay in the session's program, unlike the thunk: the thunk is + not a declaration and there is nothing to keep, but a copy that has been + built and loaded *is* part of the running process from here on, and + forgetting it would generate a second one under the same name at the next + evaluation. *) + t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh }; let ir = (* The thunk gets debug info on the same flag as everything else. It is a function nobody sets a breakpoint on by name, but it is a frame on the stack when the expression signals, and a frame the debugger cannot name is the thing the conditions buffer is trying to stop showing. *) Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name - program ~fns:[ name ] + program ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ name ]) in { ir; names = []; fns = []; installs = true } diff --git a/test/programs/reload-generic.flan b/test/programs/reload-generic.flan new file mode 100644 index 0000000..3e7db4a --- /dev/null +++ b/test/programs/reload-generic.flan @@ -0,0 +1,39 @@ +;;;; The session's fixture for generics in the dev loop. +;;;; +;;;; A generic [defn] never reaches [Tast.fns] — only its copies do — so every +;;;; question the editor asks about one has to be answered by expanding the +;;;; name. This file is the smallest program that makes each of those +;;;; questions concrete: one generic used at two element types, one generic +;;;; that calls another so that instantiation has to be transitive, and one +;;;; call site whose element type is *not* used anywhere else, so that a +;;;; redefinition can reach a copy the process was never built with. + +(defvar counter i64) + +(defn put! [xs [$t] i i32 v $t] () + {:where (copyable? $t)} + (set (at xs i) v)) + +;;; Calls [put!] at its own variable, so the copy of [put!] is generated when +;;; [hold!] is instantiated and not before. +(defn hold! [xs [$t] v $t] () + {:where (copyable? $t)} + (put! xs 0 v)) + +(defn pick [xs [$t]] $t + {:where (ordered? $t)} + (let [m (at xs 0)] + (dotimes [i (len xs)] + (set m (min m (at xs i)))) + m)) + +(defn step [] () + (let [ns [5 3 9 1] + fs [2.5 0.5 1.5]] + (hold! (slice ns 0 4) 7) + (hold! (slice fs 0 3) 0.25) + (set counter (+ counter (i64 (pick (slice ns 0 4))))))) + +(defn main [] () + (step) + (println counter)) diff --git a/test/test_session.ml b/test/test_session.ml index 2bce7b3..413bd0b 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -265,6 +265,147 @@ let () = if has str.Session.ir "@flan_reload_transient" then fail "an expression holding a string claimed to be unloadable"; + (* ── Generics in the dev loop ───────────────────────────────────────── + A generic [defn] produces no [Tast.fn] of its own — only its copies do — + so every one of these is a question the editor asks that the ordinary + name-to-body path cannot answer. *) + let gen () = fst (Session.create ~file:"programs/reload-generic.flan" ()) in + + (* 1. [C-c C-c] on a generic used to report [installs=false, fns=[]]: it + installed nothing and did not say anything had gone wrong. Both copies + have to be named, and the copy of [put!] that [hold!] pulls in has to be + there too, which is transitivity. *) + (match Session.eval (gen ()) "(defn hold! [xs [$t] v $t] () {:where (copyable? $t)} (put! xs 0 v) (put! xs 0 v))" with + | c -> + if not c.Session.installs then + fail "redefining a generic installed nothing"; + List.iter + (fun want -> + if not (List.mem want c.Session.fns) then + fail "redefining a generic did not install %s; it installed %s" + want (String.concat " " c.Session.fns)) + [ "hold!-i32"; "hold!-f64" ]; + (* And only its own copies: [put!] did not change, and its copies are + reached through their cells, so reinstalling them would be work with + no effect. *) + if List.mem "put!-i32" c.Session.fns then + fail "redefining a generic reinstalled an unchanged generic's copies" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "redefining a generic: %s" m); + + (* The callee side of the same rule: redefining [put!] reinstalls the copies + of [put!], which exist only because [hold!] asked for them — the + instantiation that generated them was transitive, and finding them again + is one table lookup rather than a walk, because a whole-program check has + already regenerated all of them. *) + (match Session.eval (gen ()) "(defn put! [xs [$t] i i32 v $t] () {:where (copyable? $t)} (set (at xs i) v))" with + | c -> + List.iter + (fun want -> + if not (List.mem want c.Session.fns) then + fail "redefining a called generic did not install %s; it \ + installed %s" want (String.concat " " c.Session.fns)) + [ "put!-i32"; "put!-f64" ] + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "redefining a generic: %s" m); + + (* 2. Staleness, and the answer is that there is none to have. The + instantiation cache lives in the [Check.env] that [Check.program_with_env] + builds *fresh* on every evaluation, so a redefined generic's copies are + regenerated from the new body and there is no cached copy of the old one + anywhere to invalidate. Pinned here because the alternative — a cache that + survived between evaluations — would make [C-c C-c] appear to succeed + while the program kept running the old body, which is the quiet version + of failure (1). *) + (let t = gen () in + let c = + Session.eval t + "(defn pick [xs [$t]] $t {:where (ordered? $t)} (let [m (at xs 0)] \ + (dotimes [i (len xs)] (set m (max m (at xs i)))) m))" + in + if not (List.mem "pick-i32" c.Session.fns) then + fail "redefining a generic did not reinstall pick-i32"; + (* The new body is the one that got emitted, not a cached copy of the old: + [max] lowers to a [>] where [min] lowered to a [<]. *) + if not (has c.Session.ir "icmp sgt") then + fail "the reinstalled copy carried the old body"; + (* And again, to show the second evaluation is not served from a cache the + first one left behind. *) + let c2 = Session.eval t "(defn pick [xs [$t]] $t {:where (ordered? $t)} (at xs 0))" in + if not (List.mem "pick-i32" c2.Session.fns) then + fail "a second redefinition of a generic installed nothing"); + + (* 3. A redefinition that needs a copy the process was never built with. The + fixture never calls [pick] at f64, so [pick-f64] exists in no program + anywhere; redefining the *caller* to ask for it has to build and install + it. Nothing in the form names [pick-f64] — it is found by being an + instantiation the host lacks. *) + (match + Session.eval (gen ()) + "(defn step [] () (let [ns [5 3 9 1] fs [2.5 0.5 1.5]] \ + (set counter (+ counter (i64 (pick (slice ns 0 4)))) ) \ + (set counter (+ counter (i64 (pick (slice fs 0 3)))))))" + with + | c -> + if not (List.mem "pick-f64" c.Session.fns) then + fail "a redefinition needing a new instantiation did not install \ + pick-f64; it installed %s" (String.concat " " c.Session.fns) + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a redefinition needing a new instantiation: %s" m); + + (* 4. A signature change on a generic is refused, and the refusal is about a + name the source does not contain: the mangling carries only the type + variables, so every copy changes signature at once and under the same + name. It has to say where that name came from. *) + (* The change has to be one the *checker* accepts, which is the narrow case + and worth saying why. A generic whose arity or variable positions move is + refused at its call sites, in the checker, with the call site's own + location — a better error than this one and the reason this path is + reached less often than it looks. What reaches here is a change every + call site still accepts and every *copy* does not: widening the index + from i32 to i64 leaves [(put! xs 0 v)] checking, because the literal + adapts, and changes [put!-i32]'s signature underneath every compiled + caller. *) + (match + Session.eval (gen ()) + "(defn put! [xs [$t] i i64 v $t] () {:where (copyable? $t)} \ + (set (at xs (i32 i)) v))" + with + | _ -> fail "a generic's changed parameter type was accepted" + | exception Loc.Error { Loc.dmsg = m; _ } -> + if not (has m "changes signature") then + fail "a generic's changed parameter type: %S" m; + if not (has m "the copy of the generic put!") then + fail "the refusal did not say the name came from put!: %S" m; + if not (has m "every copy of it at once") then + fail "the refusal did not say every copy changed together: %S" m); + + (* And what is *not* refused, which the notes expected to be: adding a + [where] clause changes no signature at all. What it changes is which call + sites are legal, and an illegal one is a checker refusal at the call site + long before the session is asked anything. *) + (match + Session.eval (gen ()) + "(defn pick [xs [$t]] $t {:where [(ordered? $t) (copyable? $t)]} (at xs 0))" + with + | c -> + if not (List.mem "pick-i32" c.Session.fns) then + fail "adding a where predicate did not reinstall the copies" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "adding a where predicate was refused: %s" m); + + (* [C-x C-e] checks against the *live* environment rather than re-checking + the program, so an expression that instantiates a generic at a type + nothing has used generates a copy that exists in no program. The module + has to carry it, or the thunk calls a symbol nothing defines. *) + (let t = gen () in + match Session.eval_expr t "(println (pick (slice [1.5 0.5] 0 2)))" with + | e -> + if not (has e.Session.ir "pick-f64") then + fail "an expression that instantiated a generic did not carry the copy" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "an expression that instantiates a generic: %s" m); + if !failures = 0 then print_endline "session: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures;