An eval or load reply carries the compiler's warnings, which Emacs marks at their sites and counts in the echo line, and a load says each warning once.

emacs/flan.el

@@ -1847,6 +1847,62 @@ Returns non-nil when it put an overlay somewhere."
                 (goto-char beg))
               t)))))))
 
+;;; Warnings
+
+;; A warning is drawn the way an error is — a mark at the site, the message
+;; beside it, gone at the next command — and logged the same way, in the
+;; compiler's own `file:line:col: warning: text' shape, which is what gives it
+;; `compilation-minor-mode''s warning face in the log.  The marks carry
+;; `flan-error' as well, so every path that takes an error mark down takes
+;; these with it.
+
+(defface flan-warning-face
+  '((t :inherit warning :underline (:style wave)))
+  "Face for the text a compiler warning is about."
+  :group 'flan)
+
+(defface flan-warning-message-face
+  '((t :inherit warning :height 0.9))
+  "Face for a warning's message, shown beside the form it is about."
+  :group 'flan)
+
+(defun flan--warning-overlays (&optional buffer)
+  "The Flan warning overlays in BUFFER, or in the current buffer."
+  (with-current-buffer (or buffer (current-buffer))
+    (seq-filter (lambda (o) (overlay-get o 'flan-warning))
+                (overlays-in (point-min) (point-max)))))
+
+(defun flan--show-warning (file line col msg)
+  "Mark MSG at LINE and COL of FILE, if some buffer is visiting it."
+  (let ((buf (flan--buffer-visiting file)))
+    (when buf
+      (with-current-buffer buf
+        (let* ((beg (flan--position line col))
+               (end (save-excursion (goto-char beg) (line-end-position)))
+               (ov (make-overlay beg end buf t nil)))
+          (overlay-put ov 'flan-error t)
+          (overlay-put ov 'flan-warning t)
+          (overlay-put ov 'face 'flan-warning-face)
+          (overlay-put ov 'help-echo msg)
+          (overlay-put ov 'priority 90)
+          (overlay-put ov 'after-string
+                       (propertize (concat "  " msg)
+                                   'face 'flan-warning-message-face))
+          (add-hook 'pre-command-hook #'flan--clear-errors-on-command nil t)
+          t)))))
+
+(defun flan--report-warnings (warnings)
+  "Log and mark each of WARNINGS, a reply's `:warnings' list."
+  (dolist (w warnings)
+    (let ((file (plist-get w :file))
+          (line (plist-get w :line))
+          (col (plist-get w :col))
+          (msg (plist-get w :message)))
+      (ignore-errors
+        (flan--record-diagnostic (format "%s:%d:%d" file line col)
+                                 (concat "warning: " msg)))
+      (ignore-errors (flan--show-warning file line col msg)))))
+
 ;;; Inline results
 
 ;; The value of an expression, drawn after the form it came from, the way eros
@@ -2599,7 +2655,8 @@ has nothing to sit beside."
             (names (plist-get reply :names))
             (note (plist-get reply :note))
             (value (plist-get reply :value))
-            (stale (plist-get reply :stale)))
+            (stale (plist-get reply :stale))
+            (warnings (plist-get reply :warnings)))
         ;; Accepted, so whatever the last rejection marked is no longer true.
         ;; Redundant now that any command clears it — the command that ran this
         ;; evaluation already did — and kept because it is the claim being
@@ -2623,6 +2680,7 @@ has nothing to sit beside."
         ;; written first is wiped by whatever the drawing does to the buffer.
         (when value (ignore-errors (flan--show-result value at)))
         (when stale (ignore-errors (flan--report-stale stale)))
+        (when warnings (ignore-errors (flan--report-warnings warnings)))
         (when flan-echo-result
           (cond
            ;; An expression's value, rendered inside the running program —
@@ -2646,9 +2704,13 @@ has nothing to sit beside."
             ;; is then empty by construction rather than a repeat of it.  Now
             ;; that `C-x C-e' reaches this path too, that sentence is also how
             ;; you tell an installed declaration from an expression's `=>'.
-            (message "flan: %s installed in %.0f ms%s%s"
+            (message "flan: %s installed in %.0f ms%s%s%s"
                      (flan--names-phrase (or fns names) what)
                      (or (plist-get reply :ms) 0)
+                     (if warnings
+                         (format ", %d warning%s" (length warnings)
+                                 (if (= (length warnings) 1) "" "s"))
+                       "")
                      (let ((vars (and fns (seq-difference names fns))))
                        (if vars (format " (also %s)"
                                         (flan--names-phrase vars ""))

emacs/test-flan.el

@@ -899,6 +899,30 @@ already rely on it — so nothing here is a stand-in for the real thing."
     (goto-char (point-max))
     (delete-region beg (point-max)))
 
+  ;; A form the compiler warns about installs, and the warning is shown as an
+  ;; error is — marked at its site — and counted in the echo line.
+  (goto-char (point-max))
+  (let ((beg (point)))
+    (insert "\n(defn spin-forever [n i64] i64\n  (println n)\n  (spin-forever n))")
+    (search-backward "(println")
+    (let ((said (test-flan--said (flan-eval-defun))))
+      (test-flan--check "a warned-about form says so in the echo line"
+                        (and said
+                             (string-match-p "installed in [0-9]+ ms, 1 warning\\'"
+                                             said))))
+    (test-flan--check "and the warning is marked at the call it is about"
+                      (let ((ovs (flan--warning-overlays)))
+                        (and (= 1 (length ovs))
+                             (string-match-p
+                              "cannot return without first calling itself"
+                              (or (overlay-get (car ovs) 'help-echo) ""))
+                             (save-excursion
+                               (goto-char (overlay-start (car ovs)))
+                               (looking-at-p "(spin-forever n)")))))
+    (flan-clear-errors)
+    (goto-char (point-max))
+    (delete-region beg (point-max)))
+
   ;; A declaration can be written where it is prose and not a declaration, and
   ;; the depth at its open delimiter says nothing about that: a form at column
   ;; 1 inside a comment or a string is at depth 0 like any other, so the head

lib/check.ml

@@ -20811,6 +20811,10 @@ let print_warnings = ref true
    is a build or a check, which says everything. *)
 let warn_within : Loc.t list option ref = ref None
 
+(* The warnings [say_warnings] kept since [build_program] began, in order:
+   what a dev eval hands the editor in its reply as well as printing. *)
+let said_warnings : Loc.diag list ref = ref []
+
 let say_warnings (ds : Loc.diag list) =
   let within (at : Loc.t) =
     match !warn_within with
@@ -20822,12 +20826,13 @@ let say_warnings (ds : Loc.diag list) =
            && s.Loc.line <= at.Loc.line && at.Loc.line <= max s.Loc.line s.Loc.eline)
         spans
   in
+  let ds = List.filter (fun (d : Loc.diag) -> within d.Loc.dloc) ds in
+  said_warnings := !said_warnings @ ds;
   if !print_warnings then
     List.iter
       (fun (d : Loc.diag) ->
-         if within d.Loc.dloc then
+         prerr_endline
-           prerr_endline
+           (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
-             (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
       ds
 
 (* A name the renaming above made, which nobody wrote: left out of every
@@ -21007,8 +21012,8 @@ let unconditional_recursion env (decls : Ast.decl list) : Loc.diag list =
            let fln = fln_source at in
            Loc.diag ~kind:"check/unconditional-recursion" at
              (Printf.sprintf
-                "%s calls itself on line %d on every path, so it never \
+                "%s cannot return without first calling itself on line %d, \
-                 returns. If that call was meant to come after %s, it is %s \
+                 so it never returns. If that call was meant to come after %s, it is %s \
                  by mistake; otherwise %s needs a base case, a path that \
                  returns without calling itself"
                 name at.Loc.line
@@ -21025,6 +21030,7 @@ let unconditional_recursion env (decls : Ast.decl list) : Loc.diag list =
 let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
   Tast.program * env * string list =
   let env = new_env () in
+  said_warnings := [];
   Hashtbl.reset arm_failed;
   (* ── A declaration left as it was compiled ───────────────────────────
      A dev session installs a function whose signature changed, and a

lib/dev.ml

@@ -1073,6 +1073,21 @@ let errors_field (ds : Loc.diag list) =
                   (Wire.quote d.Loc.dmsg))
              ds) ]
 
+(* The compiler's warnings about the forms an eval sent, which it also
+   printed: the editor marks each where it is, as it marks an error. *)
+let warnings_field (ds : Loc.diag list) =
+  match ds with
+  | [] -> []
+  | ds ->
+    [ ":warnings "
+      ^ Wire.list
+          (List.map
+             (fun (d : Loc.diag) ->
+                Printf.sprintf "(:file %s :line %d :col %d :kind %s :message %s)"
+                  (Wire.quote d.Loc.dloc.Loc.file) d.Loc.dloc.Loc.line
+                  d.Loc.dloc.Loc.col (Wire.quote d.Loc.kind) (Wire.quote d.Loc.dmsg))
+             ds) ]
+
 (* A refusal with several diagnostics: the first where every refusal puts its
    message, all of them under [:errors]. *)
 let errors_reply (ds : Loc.diag list) =
@@ -1118,7 +1133,7 @@ let eval ?forms ?base ?(extra = []) ?(step = false) t ~code ~origin ~pause =
            ^ Wire.quote
                "loaded; the program has ended, so this is in it when M-x \
                 flan-rerun starts it again" ]
-         @ extra)
+         @ warnings_field c.Session.warnings @ extra)
     | exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } ->
       Session.restore t.session before;
       error ~loc:(Loc.to_string l) msg
@@ -1136,7 +1151,7 @@ let eval ?forms ?base ?(extra = []) ?(step = false) t ~code ~origin ~pause =
       ok
         ([ ":names " ^ Wire.strings c.Session.names; ":fns ()";
            ":note " ^ Wire.quote "nothing to install" ]
-         @ extra)
+         @ warnings_field c.Session.warnings @ extra)
     | c ->
       (* Everything from here to the delivery is inside the restore, and by
          exception type as well as by arm. The three named below are the ones
@@ -1184,6 +1199,7 @@ let eval ?forms ?base ?(extra = []) ?(step = false) t ~code ~origin ~pause =
                  Printf.sprintf ":ms %.1f"
                    (timing.Build.llc_ms +. timing.Build.link_ms) ]
                @ stale_field c.Session.stale
+               @ warnings_field c.Session.warnings
                @ (match pause with
                   | Some (l, c) ->
                     [ ":pause " ^ Wire.quote (Printf.sprintf "%d:%d" l c) ]
@@ -1227,10 +1243,16 @@ let load_file t ~code ~origin =
        is. *)
     let base = if Sys.file_exists origin then Some origin else None in
     let running = liveness t <> Parked in
+    (* A trial, which [Session.pruned] may run several times over the same
+       forms: only the [eval] of what survives says the warnings. *)
     let check forms =
       let before = Session.held t.session in
+      let was = !Check.print_warnings in
+      Check.print_warnings := false;
       Fun.protect
-        ~finally:(fun () -> Session.restore t.session before)
+        ~finally:(fun () ->
+          Check.print_warnings := was;
+          Session.restore t.session before)
         (fun () ->
            ignore (Session.eval ~origin ?base ~forms ~running t.session code))
     in

lib/session.ml

@@ -688,6 +688,8 @@ type change = {
      change leaves behind, and the ones earlier changes left that this one
      did not recompile. Empty for anything that builds no module. *)
   stale : stale list;
+  (* The compiler's warnings about the forms sent, as it printed them. *)
+  warnings : Loc.diag list;
 }
 
 (* The bodies a change installed, as whoever reads the reply wrote them: a
@@ -1095,6 +1097,7 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
   (* Every error in the form sent, not the first: [keep_going] checks past a
      refused subexpression (see [Check.check]). One error is still raised as
      [Loc.Error], which is what every caller of one form expects. *)
+  let said = ref [] in
   let program, env, tolerated =
     (* A tolerated body whose return type is read off it keeps the
        signature the process has for it. *)
@@ -1115,7 +1118,7 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
         Check.program_tolerant ~keep_going:true ~tolerate:stale_owner ~previous
           decls)
     with
-    | r -> r
+    | r -> said := !Check.said_warnings; r
     | exception Loc.Errors [ d ] -> raise (Loc.Error d)
   in
   let program =
@@ -1568,7 +1571,8 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
       fns <> [] || allocates || consts <> [] || run_thunk <> None;
     stale =
       stale_sites ~live ~running ~inferred:(Check.inferred_cause env) built
-        program }
+        program;
+    warnings = !said }
 
 (* ── Evaluating an expression ──────────────────────────────────────── *)
 
@@ -2278,7 +2282,7 @@ let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
                    Tast.fns = t.program.Tast.fns @ fresh;
                    structs = t.program.Tast.structs @ copies };
                Ok
-                 ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] },
+                 ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = []; warnings = [] },
                   where, Types.to_string shown.Tast.ty))))
 
 (* ── A typed restart, taken from the break loop ──────────────────────── *)
@@ -2407,7 +2411,7 @@ let arm_restart ?(origin = "<restart>") t ~index ~(params : Types.t list)
         Tast.fns = t.program.Tast.fns @ fresh;
         structs = t.program.Tast.structs @ copies };
     Ok
-      ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] },
+      ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = []; warnings = [] },
        List.map Types.to_string params)
 
 (* [pause] is [C-u C-x C-e] — §9's "last expression" target. It is a flag and
@@ -2626,7 +2630,7 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) ?frame t src : change =
     { t.program with
       Tast.fns = t.program.Tast.fns @ fresh;
       structs = t.program.Tast.structs @ copies };
-  { ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] }
+  { ir; x86 = t.x86; names = []; fns = []; installs = true; stale = []; warnings = [] }
 
 (* ── What a macro call expands to ──────────────────────────────────── *)
 

test/test_dev.ml

@@ -9581,6 +9581,41 @@ let () =
         if not (contains_sub (value "(good)") "refused") then
           fail "a form that called one left out was installed"
       end;
+      (* A load checks its forms more than once to find the ones that do not
+         compile, and says each warning once: for a file that compiles whole
+         and for one with a form left out. The reply carries it too. *)
+      let times () =
+        let s = In_channel.with_open_bin mout In_channel.input_all in
+        let needle = "cannot return without first calling itself" in
+        let k = String.length needle and n = ref 0 in
+        for i = 0 to String.length s - k do
+          if String.sub s i k = needle then incr n
+        done;
+        !n
+      in
+      let warned what code =
+        let before = times () in
+        let r =
+          request mc
+            (Printf.sprintf "(:op \"load-file\" :file %S :code %s)"
+               ("programs/dev-load-" ^ what ^ ".flan") (Wire.quote code))
+        in
+        let sent =
+          match Wire.field r "warnings" with
+          | Some { Form.v = Form.List l; _ } -> List.length l
+          | _ -> 0
+        in
+        if status r <> "ok" then fail "a load of %s: %s" what (said r)
+        else begin
+          if sent <> 1 then fail "a load of %s replied with %d warnings" what sent;
+          let after = times () in
+          if after - before <> 1 then
+            fail "a load of %s printed its warning %d times" what (after - before)
+        end
+      in
+      warned "spin" "(defn spin [n i64] i64 (println n) (spin n))";
+      warned "spin-bad"
+        "(defn spin2 [n i64] i64 (println n) (spin2 n))\n(defn bad2 [] i64 \"x\")";
       (* Nothing compiles: a refusal, with the error where every refusal
          puts it and the list beside it. *)
       let r =

test/test_flan.ml

@@ -6690,8 +6690,8 @@ let () =
    with
    | Some [ (4, m) ] ->
      check "a self-call after a loop, outside any branch, is warned at"
-       (m = "count-handshakes calls itself on line 4 on every path, so it \
+       (m = "count-handshakes cannot return without first calling itself \
-             never returns. If that call was meant to come after the \
+             on line 4, so it never returns. If that call was meant to come after the \
              function, it is indented into the body by mistake; otherwise \
              count-handshakes needs a base case, a path that returns without \
              calling itself")
@@ -6728,6 +6728,11 @@ let () =
     "fn g(n: i64) -> i64\n  when n > 3\n    return 1\n  g(n + 1)\n";
   quiet "a self-call behind ?? is not warned at" ~fln:true
     "fn c(a: i64?, n: i64) -> i64\n  a ?? c(a, n)\n";
+  (* A call that never comes back but is not typed Never leaves the
+     self-call dead, and the function still never returns, which is all the
+     warning claims. *)
+  warns "a self-call after a call that exits is warned at" ~fln:true
+    "fn boom() -> ()\n  exit(1)\n\nfn f(n: i64) -> ()\n  boom()\n  f(n)\n" 6;
   quiet "a self-call after exit is not warned at" ~fln:true
     "fn q(n: i64)\n  exit(1)\n  q(n)\n";
   quiet "a self-call after an endless loop is not warned at" ~fln:true

test/test_session.ml

@@ -2272,14 +2272,21 @@ let () =
    (match !Check.recursion_warnings with
     | [ d ] when d.Loc.kind = "check/unconditional-recursion" && d.Loc.dloc.Loc.line = 4 -> ()
     | ds -> fail "a dev eval of count-handshakes found %d recursions" (List.length ds));
-   if not (has said "warning: count-handshakes calls itself on line 4 on every path")
+   if not (has said "warning: count-handshakes cannot return without first calling itself on line 4")
    then fail "a dev eval printed no recursion warning: %S" said;
+   (match r.Session.warnings with
+    | [ a; b ] when a.Loc.kind = "check/shadows-builtin"
+                    && b.Loc.kind = "check/unconditional-recursion" -> ()
+    | ds -> fail "the eval's change carries %d warnings, not the 2 it printed"
+              (List.length ds));
    if warnings said <> 2 then
      fail "the eval that sent them printed %d warnings, not 2: %S" (warnings said) said;
-   let _, again =
+   let r2, again =
      stderr_of (fun () ->
        Session.eval ~origin:"other.fln" t "fn other-thing(x: i64) -> i64\n  x + 1\n")
    in
+   if r2.Session.warnings <> [] then
+     fail "an unrelated eval's change carries an earlier form's warnings";
    if warnings again <> 0 then
      fail "an unrelated eval said an earlier form's warnings again: %S" again);