A generic's copy made by an evaluated expression is disassembled from that expression's module, and one copy that cannot be shown no longer hides the others

emacs/flan.el

@@ -3056,7 +3056,11 @@ the types its variables were bound to."
             (insert "\n")
             (flan-disassemble--comment
              (format ";; %s at %s" (plist-get c :generic) (plist-get c :types)))
-            (flan-disassemble--listing c)))
+            (if (plist-get c :refused)
+                (progn
+                  (flan-disassemble--header "signature" (plist-get c :signature))
+                  (flan-disassemble--header "no listing" (plist-get c :refused)))
+              (flan-disassemble--listing c))))
       (flan-disassemble--comment
        (if (plist-get r :generic)
            (format "; %s for %s at %s" what (plist-get r :generic)

lib/dev.ml

@@ -668,9 +668,9 @@ let generic_signature t name =
          (String.concat " " (List.map show params)) (show ret))
 
 (* The copies of generic [name] the program holds, each with the types its
-   variables were bound to, spelled [$t = i32]. Read off the program and not
+   variables were bound to, spelled [$t = i32]. Read off the program: a copy
-   off the instantiation table: a copy a [C-x C-e] thunk asked for is in the
+   a [C-x C-e] made is kept in it, and [eval_expr] records the thunk's module
-   table and in no program, and there is no build of it to show. *)
+   as that copy's owner, since no other module defines it. *)
 let generic_copies t name =
   let env = t.session.Session.env in
   match Hashtbl.find_opt env.Check.gsigs name with
@@ -1099,6 +1099,9 @@ let eval_expr t ~code ~origin ~pause =
        the same instantiation would list it as already there. *)
     let held = Session.held t.session in
     let refused msg = Session.restore t.session held; error msg in
+    let had =
+      List.map (fun (f : Tast.fn) -> f.Tast.name) t.session.Session.program.Tast.fns
+    in
     match Session.eval_expr ~origin ~pause t.session code with
     | c ->
       let before = match result t with Some (g, _) -> g | None -> 0L in
@@ -1130,10 +1133,32 @@ let eval_expr t ~code ~origin ~pause =
       let entered_gen = stop_gen t in
       t.n <- t.n + 1;
       let out = Filename.concat t.dir (Printf.sprintf "e%d.so" t.n) in
+      (* A generic called at a new type makes a copy that is defined in this
+         thunk's module and in no other, so this module is where [disassemble]
+         has to look for it — and its IR is kept for the reason [eval] keeps
+         a module's. *)
+      let ll =
+        Filename.concat t.dir (Printf.sprintf "e%d%s" t.n (module_ext c))
+      in
+      write_file ll c.Session.ir;
+      let copies =
+        List.filter_map
+          (fun (f : Tast.fn) ->
+             if List.mem f.Tast.name had then None else Some f.Tast.name)
+          t.session.Session.program.Tast.fns
+      in
       (match build_module c ~debug:t.session.Session.debug ~out with
        | _ ->
          (match deliver t out with
           | "ok" ->
+            if copies <> [] then begin
+              t.gen <- t.gen + 1;
+              List.iter
+                (fun n ->
+                   Hashtbl.replace t.owners n
+                     { ogen = t.gen; oso = out; oll = ll; oloc = fn_loc t n })
+                copies
+            end;
             (* Strictly after the delivery, and that ordering is the whole of
                it: the sleeper is woken to look at a ring, so waking it before
                the module is in one buys an empty poll and a five-second wait.
@@ -3936,21 +3961,25 @@ let disassemble t ~name ~form =
        | [ c ] ->
          (match copy c with Ok fields -> ok fields | Error m -> error m)
        | cs ->
-         let rec all acc = function
+         (* One copy that cannot be shown is that copy's entry, named with
-           | [] -> Ok (List.rev acc)
+            the reason, and not the whole reply: the others still have code
-           | c :: rest ->
+            to read. *)
-             (match copy c with
+         let entry (((f : Tast.fn), bound) as c) =
-              | Ok fields -> all (Wire.list fields :: acc) rest
+           match copy c with
-              | Error m -> Error m)
+           | Ok fields -> Wire.list fields
+           | Error m ->
+             Wire.list
+               [ ":name " ^ Wire.quote f.Tast.name;
+                 ":signature " ^ Wire.quote (signature_of_fn f);
+                 ":loc " ^ Wire.quote (fn_loc t f.Tast.name);
+                 ":generic " ^ Wire.quote name; ":types " ^ Wire.quote bound;
+                 ":refused " ^ Wire.quote m ]
          in
-         (match all [] cs with
+         ok
-          | Error m -> error m
+           [ ":name " ^ Wire.quote name; ":form " ^ Wire.quote form;
-          | Ok copies ->
+             ":generic " ^ Wire.quote name;
-            ok
+             ":signature " ^ Wire.quote sign;
-              [ ":name " ^ Wire.quote name; ":form " ^ Wire.quote form;
+             ":copies " ^ Wire.list (List.map entry cs) ])
-                ":generic " ^ Wire.quote name;
-                ":signature " ^ Wire.quote sign;
-                ":copies " ^ Wire.list copies ]))
     | None ->
       (match kind_of t name with
        | Some k ->

test/test_dev.ml

@@ -3400,6 +3400,47 @@ let () =
                    if text = "" then fail "%s: the copy %s has no listing" backend name)
                 [ a; b ]
             | _ -> fail "%s: two copies did not come back as two" backend
+        end;
+        (* A copy made by an evaluated expression is defined only in that
+           expression's module, which is where its code has to be read from —
+           and the copies made before it are still shown beside it. *)
+        let r =
+          request c
+            "(:op \"eval-expr\" :code \"(selection-sort (slice [(i64 3) (i64 1)] 0 2))\")"
+        in
+        if status r <> "ok" then
+          fail "%s: calling the generic at i64 from an expression: %s" backend (said r)
+        else begin
+          let r = ask () in
+          if status r <> "ok" then
+            fail "%s: the generic with a copy an expression made: %s" backend (said r)
+          else
+            match Wire.field r "copies" with
+            | Some { Form.v = Form.List [ _; _; _ ] as l; _ } ->
+              let l = match l with Form.List l -> l | _ -> [] in
+              List.iter
+                (fun f ->
+                   let name = Option.value ~default:"" (Wire.string_field f "name") in
+                   match Wire.string_field f "refused" with
+                   | Some m -> fail "%s: the copy %s has no listing: %s" backend name m
+                   | None ->
+                     let text = Option.value ~default:"" (Wire.string_field f "text") in
+                     if form = "ir" && not (contains_sub text ("flan." ^ name)) then
+                       fail "%s: the copy %s shows some other code" backend name;
+                     if text = "" then fail "%s: the copy %s has no listing" backend name)
+                l;
+              (match
+                 List.find_opt
+                   (fun f -> Wire.string_field f "types" = Some "$t = i64") l
+               with
+               | Some f ->
+                 (match Wire.string_field f "object" with
+                  | Some o when String.starts_with ~prefix:"e" (Filename.basename o) -> ()
+                  | o ->
+                    fail "%s: the expression's copy is not read from its module: %s"
+                      backend (Option.value ~default:"" o))
+               | None -> fail "%s: the expression's copy is not listed" backend)
+            | _ -> fail "%s: three copies did not come back as three" backend
         end
       end
     in