diff --git a/docs/BUILT.md b/docs/BUILT.md index 7bc9549f..2afa2c8f 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -1507,12 +1507,15 @@ still fails as it always did. A `(defclass ...)` whose slot list changed is a constructor whose signature changed, and takes this road; the bespoke caller walk that refused it is gone. `defn-` privacy is not bypassed: a caller is excused only for a body that -calls a changed signature, and one that also broke privacy reports that when it is recompiled. The prelude and -packages are compiled bodies like any other and are listed by their own file and line. +calls a changed signature, and one that also broke privacy reports that when it is recompiled. A package's callers are +compiled bodies like any other and are listed by their own file and line, the calls a package's macros wrote into the +importer included. The prelude has no stale callers to list, because a session cannot redefine a prelude function at +all — the form is refused as a second definition. A release build has no cells, so it has neither the word nor the compare. Measured on a 200M-call loop of a one-line -function, dev build: x86 median 2.91 s against 2.59 s without the check (about 1.6 ns a call); LLVM `-O2` 0.32 s -against 0.39 s, the checked build faster — inside code-layout noise. +function, dev build, both sides with three-word cells so the difference is the compare alone: x86 median 2.91 s +against 2.59 s without it (about 1.6 ns a call); LLVM `-O2` median 0.32 s against 0.39 s — the checked build ran faster +in all nine rounds, which is most likely code layout and was not investigated. ### The agent — dev loop step 3 diff --git a/emacs/flan.el b/emacs/flan.el index e9f07990..94c7c210 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -2356,7 +2356,7 @@ of the tenth name tells you neither how many there were nor which." (defun flan--stale-message (site) "The sentence for SITE, one entry of a reply's `:stale' list." (let ((callee (plist-get site :callee))) - (format "this call to %s was compiled for %s, and %s is now %s. \ + (format "this call to %s was compiled for %s, and %s is defined as %s. \ Evaluate %s again to compile it against the new definition." callee (plist-get site :compiled) callee (plist-get site :current) (plist-get site :caller)))) diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 01a937c3..846f8c91 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -1011,7 +1011,7 @@ already rely on it — so nothing here is a stand-in for the real thing." (string-match-p (regexp-quote "f.flan:23:15: this call to scale was compiled for \ -[i64] i64, and scale is now [i64 i64] i64.") +[i64] i64, and scale is defined as [i64 i64] i64.") s)) (test-flan--check "and names the function to evaluate again" (string-match-p "Evaluate step again" s)))) diff --git a/lib/check.ml b/lib/check.ml index 48797b70..f653ae58 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -12156,10 +12156,30 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) : | None -> f () | Some ok -> let lifted = env.lifted and instances = env.instances in + (* The generic-copy cache as well as the copies. A copy the failed body + asked for would otherwise stay cached, and the next body asking for + it would be handed the name of a copy the program does not have. *) + let insts = + Hashtbl.fold (fun g r acc -> (g, r, !r) :: acc) env.insts [] + in (match f () with | x -> x | exception (Loc.Error d as e) -> if ok env name d then begin + Hashtbl.filter_map_inplace + (fun g r -> + match List.find_opt (fun (h, _, _) -> String.equal g h) insts with + | None -> + List.iter (fun (_, _, sym) -> Hashtbl.remove env.fns sym) !r; + None + | Some (_, _, before) -> + List.iter + (fun ((_, _, sym) as e) -> + if not (List.memq e before) then Hashtbl.remove env.fns sym) + !r; + r := before; + Some r) + env.insts; env.lifted <- lifted; env.instances <- instances; tolerated := name :: !tolerated; diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 3d994fb8..5c3f14dc 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1117,7 +1117,7 @@ void flan_stale_call(const char *site, const char *callee, const char *want, } rt_flush_out(); fprintf(stderr, - "%s: this call to %s was compiled for %s, and %s is now %s. " + "%s: this call to %s was compiled for %s, and %s is defined as %s. " "Evaluate the function this call is in again, so that it is " "compiled against the new definition.\n", site, callee, want, callee, now); diff --git a/test/programs/stale-generic.flan b/test/programs/stale-generic.flan new file mode 100644 index 00000000..d959c123 --- /dev/null +++ b/test/programs/stale-generic.flan @@ -0,0 +1,13 @@ +;;;; A stale caller that asks for a generic copy on its way to failing. +;;;; +;;;; When [scale]'s return type changes to f64, [through]'s unchanged source +;;;; instantiates [same] at f64 and then fails to return it as an i64. The +;;;; session excuses that — [through] is a caller compiled against the old +;;;; signature — and the checker takes back what the failed check made. The +;;;; copy has to go with it, or a body in the same form that really needs +;;;; [same] at f64 is handed a copy nothing generated. +(defn same [x $t] $t x) + +(defn scale [x i64] i64 (* x 2)) + +(defn through [] i64 (same (scale 1))) diff --git a/test/test_session.ml b/test/test_session.ml index be6cefd7..456cd8ce 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -141,6 +141,24 @@ let () = | exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing a signature back was refused: %s" m)); + (* What a tolerated caller's failed check made is taken back, generic copies + included, so a body in the same form that needs the same copy gets one + generated for it rather than a cached name. *) + (let t, _ = Session.create ~file:"programs/stale-generic.flan" () in + match + Session.eval t + "(defn scale [x i64] f64 (f64 (* x 2))) (defn other [] f64 (same 2.5))" + with + | c -> + if not (List.mem "same-f64" c.Session.fns) then + fail "a copy a tolerated caller asked for was not generated again: %s" + (String.concat " " c.Session.fns); + if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale + <> [ "through" ] + then fail "the generic fixture named the wrong stale callers" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a stale caller that instantiates a generic: %s" m); + (* A caller whose source fails for some other reason is still refused: the tolerance is for a body compiled against a signature that changed, and [twice] here is new, in the form, and wrong. *) @@ -691,6 +709,63 @@ let () = | _ -> () | exception Loc.Error { Loc.dmsg = m; _ } -> fail "a defn- in the program's own file: %s" m); + (* A package function whose signature changes names its callers outside the + package, at their own file and line — and inside it: [mix] gaining a + parameter leaves [combine] and [twice] in the package's two files, the + value [via-value] takes, and the calls the package's macros wrote into + [main]. Making it private in the same breath does + not let a stale caller outside the package off: recompiling it is still + refused by the privacy check. *) + (let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in + match + Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp + "(defn- combine [a i32 b i32 c i32] i32 (mix a (+ b c)))" + with + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a package function's signature change was refused: %s" m + | c -> + let where = + List.map + (fun (x : Session.stale) -> + (x.Session.caller, Filename.basename x.Session.at.Loc.file, + x.Session.at.Loc.line)) + c.Session.stale + in + if where <> [ ("main", "pkg-private.flan", 8) ] then + fail "the package's stale callers were %s" + (String.concat ", " + (List.map (fun (n, f, l) -> Printf.sprintf "%s %s:%d" n f l) where)); + (match + Session.eval ~origin:"programs/pkg-private.flan" tp + "(defn main [] i32 (print (secret/combine 1 2 3)) 0)" + with + | _ -> fail "a stale caller recompiled past a defn- was accepted" + | exception Loc.Error { Loc.dmsg = m; _ } -> + if not (has m "secret/combine is private to its package") then + fail "the recompiled stale caller was refused for another reason: %s" m)); + (let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in + match + Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp + "(defn- mix [a i32 b i32 c i32] i32 (+ (* a 10) (+ b c)))" + with + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a private package function's signature change was refused: %s" m + | c -> + let where = + List.sort compare + (List.map + (fun (x : Session.stale) -> + (x.Session.caller, Filename.basename x.Session.at.Loc.file)) + c.Session.stale) + in + (* [main] twice: the package's macros write calls to [mix] into it. *) + if where + <> [ ("main", "pkg-private.flan"); ("main", "pkg-private.flan"); + ("secret/combine", "secret.flan"); ("secret/twice", "more.flan"); + ("secret/via-value", "more.flan") ] + then + fail "mix's stale callers were %s" + (String.concat ", " (List.map (fun (n, f) -> n ^ " " ^ f) where))); (* And a single-file package: redefined from its own file, it stays private to that file, so the file beside it that imports it is still refused. *) let tl, _ = Session.create ~file:"programs/loose/use.flan" () in