diff --git a/bin/main.ml b/bin/main.ml index 2da76c62..21a88a7f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -878,7 +878,7 @@ let () = (* [as] where the other path has [llc], which is the number the whole backend exists to move. Named for what ran. *) Printf.eprintf "%s %s %s %.1fms ld %.1fms\n" out - (String.concat " " c.Flan.Session.fns) + (String.concat " " (Flan.Session.shown_fns c)) (if x86 then "as " else "llc") timing.Flan.Build.llc_ms timing.Flan.Build.link_ms) (* [run] builds and execs. A .wasm is not executable, and picking a runtime diff --git a/emacs/test-flan.el b/emacs/test-flan.el index f1bf3f6f..6021b4dd 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -1920,6 +1920,18 @@ already rely on it — so nothing here is a stand-in for the real thing." (user-error (setq raised (error-message-string err)))) (and raised (string-match-p "not a function" raised)))) + ;; A fn with several arities is compiled under a name per arity, and the + ;; install is said with the name written, once. + (let* ((file (concat socket3 "-arities.flan")) + (r (flan--request + (list :op "eval" :file file + :code "(defn grp ([a i64] i64 a) ([a i64 b i64] i64 (+ a b)))"))) + (said (test-flan--said (flan--report r "form")))) + (test-flan--check "a fn with two arities is installed under the name written, once" + (and said + (string-match-p "\\`flan: grp installed in" said) + (not (string-match-p "~\\|(also" said))))) + ;; A generic has no code under its own name, only a copy per type it is ;; called at, so its name is answered with those: refused while there are ;; none, and one listing per copy, each headed by its types, once there diff --git a/lib/dev.ml b/lib/dev.ml index 3e1718d7..5710aec3 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -1180,7 +1180,7 @@ let eval ?forms ?base ?(extra = []) ?(step = false) t ~code ~origin ~pause = c.Session.fns; ok ([ ":names " ^ Wire.strings c.Session.names; - ":fns " ^ Wire.strings c.Session.fns; + ":fns " ^ Wire.strings (Session.shown_fns c); Printf.sprintf ":ms %.1f" (timing.Build.llc_ms +. timing.Build.link_ms) ] @ stale_field c.Session.stale diff --git a/lib/session.ml b/lib/session.ml index 59f61cbb..37d32618 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -690,6 +690,18 @@ type change = { stale : stale list; } +(* The bodies a change installed, as whoever reads the reply wrote them: a + fn with several arities is compiled under a name per arity, and is one + name to the person who sent it. [fns] itself stays by symbol — the + daemon's module ownership is keyed on it. *) +let shown_fns (c : change) = + List.fold_left + (fun acc f -> + let n = Check.written_name f in + if List.mem n acc then acc else n :: acc) + [] c.fns + |> List.rev + (* [pause] is [C-u C-c C-c]: the position, in the source just sent, of the form the program should stop at — TODO.org, "A breakpoint is marked from the editor, without editing the buffer". It arrives as a separate field diff --git a/test/test_session.ml b/test/test_session.ml index aa53f06f..2f9306a1 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -99,6 +99,9 @@ let () = | Some c -> if List.sort compare c.Session.fns <> [ "outer~0"; "outer~2" ] then fail "two arities installed %s" (String.concat " " c.Session.fns); + (* The reply's :fns, which the editor says: the name written, once. *) + if Session.shown_fns c <> [ "outer" ] then + fail "two arities were shown as %s" (String.concat " " (Session.shown_fns c)); if c.Session.stale <> [] then fail "two arities left a caller behind" | None -> ()); (match eval "the form again" "(defn outer ([] i64 (bump)) ([a i64 b i64] i64 (* a b)))" with