An install reply's :fns and flan reload's summary name each fn once, as it is written.
This commit is contained in:
parent
1215db7d26
commit
ae41ec8454
@ -878,7 +878,7 @@ let () =
|
|||||||
(* [as] where the other path has [llc], which is the number the whole
|
(* [as] where the other path has [llc], which is the number the whole
|
||||||
backend exists to move. Named for what ran. *)
|
backend exists to move. Named for what ran. *)
|
||||||
Printf.eprintf "%s %s %s %.1fms ld %.1fms\n" out
|
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
|
(if x86 then "as " else "llc") timing.Flan.Build.llc_ms
|
||||||
timing.Flan.Build.link_ms)
|
timing.Flan.Build.link_ms)
|
||||||
(* [run] builds and execs. A .wasm is not executable, and picking a runtime
|
(* [run] builds and execs. A .wasm is not executable, and picking a runtime
|
||||||
|
|||||||
@ -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))))
|
(user-error (setq raised (error-message-string err))))
|
||||||
(and raised (string-match-p "not a function" raised))))
|
(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
|
;; 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
|
;; 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
|
;; none, and one listing per copy, each headed by its types, once there
|
||||||
|
|||||||
@ -1180,7 +1180,7 @@ let eval ?forms ?base ?(extra = []) ?(step = false) t ~code ~origin ~pause =
|
|||||||
c.Session.fns;
|
c.Session.fns;
|
||||||
ok
|
ok
|
||||||
([ ":names " ^ Wire.strings c.Session.names;
|
([ ":names " ^ Wire.strings c.Session.names;
|
||||||
":fns " ^ Wire.strings c.Session.fns;
|
":fns " ^ Wire.strings (Session.shown_fns c);
|
||||||
Printf.sprintf ":ms %.1f"
|
Printf.sprintf ":ms %.1f"
|
||||||
(timing.Build.llc_ms +. timing.Build.link_ms) ]
|
(timing.Build.llc_ms +. timing.Build.link_ms) ]
|
||||||
@ stale_field c.Session.stale
|
@ stale_field c.Session.stale
|
||||||
|
|||||||
@ -690,6 +690,18 @@ type change = {
|
|||||||
stale : stale list;
|
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
|
(* [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
|
the program should stop at — TODO.org, "A breakpoint is marked from the
|
||||||
editor, without editing the buffer". It arrives as a separate field
|
editor, without editing the buffer". It arrives as a separate field
|
||||||
|
|||||||
@ -99,6 +99,9 @@ let () =
|
|||||||
| Some c ->
|
| Some c ->
|
||||||
if List.sort compare c.Session.fns <> [ "outer~0"; "outer~2" ] then
|
if List.sort compare c.Session.fns <> [ "outer~0"; "outer~2" ] then
|
||||||
fail "two arities installed %s" (String.concat " " c.Session.fns);
|
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"
|
if c.Session.stale <> [] then fail "two arities left a caller behind"
|
||||||
| None -> ());
|
| None -> ());
|
||||||
(match eval "the form again" "(defn outer ([] i64 (bump)) ([a i64 b i64] i64 (* a b)))" with
|
(match eval "the form again" "(defn outer ([] i64 (bump)) ([a i64 b i64] i64 (* a b)))" with
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user