A caller excused for going stale takes back the generic copies its failed check cached, and a package's stale callers are named at their own file and line

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
+calls a changed signature, and one that also broke privacy reports that when it is recompiled. A package's callers are
-packages are compiled bodies like any other and are listed by their own file and line.
+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
+function, dev build, both sides with three-word cells so the difference is the compare alone: x86 median 2.91 s
-against 0.39 s, the checked build faster — inside code-layout noise.
+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
 

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

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

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;

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);

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

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