Merge branch 'master' into worktree-agent-a46233a32d1912c78

TODO.org

@@ -327,10 +327,6 @@ keyword resolves against the expected type and against nothing else, so two enum
 could always share a member spelling. What the prefix buys is the call site read
 on its own.
 
-** NEXT The .fln printer writes a flat let where the scope does not matter
-Decided 2026-09-25: a let whose name no later statement of its block mentions prints
-flat, not as a nested block; a one-argument and/or prints as its argument.
-
 ** WAIT ML-style patterns
 Held 2026-09-25 as a future direction, like the JS backend: nested destructuring,
 guards, or-patterns, literals at any depth, exhaustiveness over the nesting.
@@ -1485,11 +1481,6 @@ Its signature changes in the session but its body is not recompiled, so every ca
 stops on StaleCall naming a type nobody wrote. Proposal: recompile such callers.
 Postponed 2026-09-25 while .fln takes priority.
 
-** TODO A prelude function shadowed live is reached by the prelude's own calls
-A defn of a prelude function's name sent to a running =flan dev= installs into the
-host's cell for that name, so the prelude's calls compiled into the host follow it;
-a rebuild gives them the prelude's again, as =Check.shadow_prelude= intends.
-
 ** DONE The dev loop, step 1: the reload primitive
 A list of top-level forms is recompiled and installed into a running process, and
 call sites compiled before those forms existed follow them through an indirection
@@ -1662,9 +1653,6 @@ CLOSED: [2026-09-25]
 ** TODO The inspector holds a value
 Reading needs no module now, so an address and a type are enough to keep a value on the daemon's side between requests, the way CIDER keeps a JVM object. Nothing holds one yet: the Emacs stack is still a stack of expressions.
 
-** TODO A frame that prints is skipped from the globals section
-A frame whose body calls =print= comes back in =:skipped= as "running a body that has been redefined since" though nothing was redefined: its global-reference fingerprint differs between the build and the daemon. test/programs/dev-parity.flan stores each global to itself instead of printing it for this reason.
-
 ** DONE The watch table stays pushed
 CLOSED: [2026-09-25]
 The watch table stays pushed, and shares the push channel program output moves to.
@@ -1794,17 +1782,6 @@ crashed session keeping its directory.
 The fork pool is drained before anything reads the failure count, and a nonzero
 count is an exit status. A red row used to be able to print and pass.
 
-** TODO test_dev dies on Wire.Closed after the half-write abort
-Intermittent, on an unmodified tree too: the =--llvm= half-write daemon in
-=test_dev.ml='s =half_written= sometimes exits before it replies to =abort=, and
-=request= raises =Wire.Closed= uncaught, so test_dev ends with a fatal, no =FAIL=
-line and every later row unrun.
-
-** TODO flan build and flan run leave an empty flan-<pid> directory
-=Build.workdir= is created per process and nothing removes it once the IR is
-gone. The dev daemon now removes its own on a clean end; the one-shot commands do
-not.
-
 ** WAIT An x86 dev session's read of a dyn global after an allocating thunk failed once
 WAIT on a recurrence; the test now prints the failing read's own reply.
 The one failure's message came from a second read, which said "kept"; the failing
@@ -1943,6 +1920,8 @@ and an =eval-expr= of the =get=, all succeed. In a session every installed
 function of no arguments returning =()= has the type =(CFn [] ())=, not only
 =pause= — a bare =pause= or =tick= asked of the session says so — so the
 keyword may not be what resolved. The next report wants the exact form sent.
+Nor (2026-09-25) by a mark at the =:pause= or the =when=, frame evaluation, the
+indented syntax, or =load-file= after slot changes and with a program =pause=.
 
 ** DONE A digit does not take the restart RET takes
 CLOSED: [2026-09-25]

bin/main.ml

@@ -337,7 +337,8 @@ let () =
       if Flan.Source.is_indented path then
         print_string (Flan.Paren_printer.program ~source forms)
       else
-        match Flan.Indent_printer.program ~source forms with
+        let macros = Flan.Body_macros.table ~file:path forms in
+        match Flan.Indent_printer.program ~source ~macros forms with
         | text -> print_string text
         | exception Flan.Indent_printer.Unprintable (f, why) ->
           Flan.Loc.failk "convert/unprintable" f.Flan.Form.loc
@@ -949,12 +950,36 @@ let () =
                 ~csrcs:f.csrcs ~lflags:f.lflags
                 ~pnames:(if debug then param_names f.load else [])
                 f.program ~out:exe);
-      let code =
+      (* Spawned and waited on here rather than through [Sys.command], so a
-        Sys.command
+         SIGTERM or SIGHUP sent to flan reaches the program and flan still
-          (String.concat " " (List.map Filename.quote (exe :: prog_args)))
+         removes the executable and its work directory: the default action
+         would end flan inside the wait with neither removed. SIGINT and
+         SIGQUIT are ignored while the program runs, as [system] does, since
+         the terminal sends them to the program too. A flan killed outright
+         takes the program with it ([Spawn.dying]). *)
+      let pid = Flan.Spawn.dying exe (Array.of_list (exe :: prog_args)) in
+      let caught = ref None in
+      let forward s =
+        Sys.Signal_handle (fun _ ->
+          caught := Some s;
+          try Unix.kill pid s with Unix.Unix_error _ -> ())
       in
+      Sys.set_signal Sys.sigterm (forward Sys.sigterm);
+      Sys.set_signal Sys.sighup (forward Sys.sighup);
+      Sys.set_signal Sys.sigint Sys.Signal_ignore;
+      Sys.set_signal Sys.sigquit Sys.Signal_ignore;
+      let rec wait () =
+        match Unix.waitpid [] pid with
+        | _, Unix.WEXITED c -> c
+        | _, (Unix.WSIGNALED s | Unix.WSTOPPED s) -> 128 + Flan.Spawn.host_signal s
+        | exception Unix.Unix_error (Unix.EINTR, _, _) -> wait ()
+      in
+      let code = wait () in
       (try Sys.remove exe with Sys_error _ -> ());
-      exit code)
+      exit (match !caught with
+            | Some s when s = Sys.sigterm -> 143
+            | Some _ -> 129
+            | None -> code))
   | _ ->
     prerr_endline
       "usage: flan (read|parse|check|emit|shim) <file.flan>...\n       flan check <file.flan>... [--warn-memory]\n       flan emit <file.flan> [--x86] [--dev] [--debug] [--no-bounds-checks]\n\

emacs/flan.el

@@ -673,6 +673,26 @@ Set to nil to leave the program's state to whatever replies happen to say."
               flan-socket-name)))
     (and dir (expand-file-name flan-socket-name dir))))
 
+(defun flan--short-socket (socket)
+  "The path to connect to SOCKET by.
+A unix socket path holds at most 107 bytes, and a longer one cannot be
+connected to by name.  For such a SOCKET the daemon makes a symlink at a
+short path computed from it, and this computes the same one: see
+`Wire.short_socket_path' in lib/wire.ml."
+  (let ((abs (expand-file-name socket)))
+    (if (<= (string-bytes abs) 107)
+        socket
+      (let* ((env (getenv "XDG_RUNTIME_DIR"))
+             (dir (if (and env (not (string= env "")) (file-directory-p env))
+                      env
+                    "/tmp")))
+        (expand-file-name
+         (concat "flan-"
+                 (substring (secure-hash 'md5 (encode-coding-string abs 'utf-8))
+                            0 16)
+                 ".sock")
+         dir)))))
+
 (defun flan--open (socket)
   "Open a connection to SOCKET and make it the current one."
   (when (process-live-p flan--connection)
@@ -683,7 +703,7 @@ Set to nil to leave the program's state to whatever replies happen to say."
     (with-current-buffer buf (erase-buffer) (set-buffer-multibyte nil))
     (setq flan--connection
           (make-network-process
-           :name "flan" :buffer buf :family 'local :service socket
+           :name "flan" :buffer buf :family 'local :service (flan--short-socket socket)
            :coding 'binary :noquery t
            :filter #'flan--filter :sentinel #'flan--sentinel))
     (setq flan--socket socket))

lib/ast.ml

@@ -491,7 +491,9 @@ let map_children f (e : expr) : expr =
   in
   { e with e = kind }
 
-let pause_call loc = { e = Call ({ e = Var "pause"; loc }, []); loc }
+(* [fn] is the name the prelude's function answers to, which is not its own
+   when the program defines one of that name: see [Session.prelude_fn]. *)
+let pause_call ?(fn = "pause") loc = { e = Call ({ e = Var fn; loc }, []); loc }
 
 (* The stepper. [instrument_step ds] is [ds] with every [defn] rebuilt so a
    call stops before each form of its body, at any depth of body: the forms of
@@ -509,36 +511,36 @@ let pause_call loc = { e = Call ({ e = Var "pause"; loc }, []); loc }
    the local is visibly the compiler's and hidden from the locals listing. *)
 let step_flag = "flan~step"
 
-let step_point loc =
+let step_point fn loc =
   let v = { e = Var step_flag; loc } in
   { e =
       If (v,
-          { e = Set (Pvar step_flag, { e = Call ({ e = Var "step-point"; loc }, []); loc });
+          { e = Set (Pvar step_flag, { e = Call ({ e = Var fn; loc }, []); loc });
             loc },
           None);
     loc }
 
-let rec step_body (es : expr list) : expr list =
+let rec step_body fn (es : expr list) : expr list =
-  List.concat_map (fun (e : expr) -> [ step_point e.loc; step_expr e ]) es
+  List.concat_map (fun (e : expr) -> [ step_point fn e.loc; step_expr fn e ]) es
 
-and step_expr (e : expr) : expr =
+and step_expr fn (e : expr) : expr =
   let branch (x : expr) =
     match x.e with
-    | Do _ -> step_expr x
+    | Do _ -> step_expr fn x
-    | _ -> { e = Do [ step_point x.loc; step_expr x ]; loc = x.loc }
+    | _ -> { e = Do [ step_point fn x.loc; step_expr fn x ]; loc = x.loc }
   in
   match e.e with
-  | Do es -> { e with e = Do (step_body es) }
+  | Do es -> { e with e = Do (step_body fn es) }
-  | Let (bs, es) -> { e with e = Let (bs, step_body es) }
+  | Let (bs, es) -> { e with e = Let (bs, step_body fn es) }
   | If (c, a, b) -> { e with e = If (c, branch a, Option.map branch b) }
-  | While (l, c, es) -> { e with e = While (l, c, step_body es) }
+  | While (l, c, es) -> { e with e = While (l, c, step_body fn es) }
-  | Loop (bs, es) -> { e with e = Loop (bs, step_body es) }
+  | Loop (bs, es) -> { e with e = Loop (bs, step_body fn es) }
-  | Dotimes (l, n, b, es) -> { e with e = Dotimes (l, n, b, step_body es) }
+  | Dotimes (l, n, b, es) -> { e with e = Dotimes (l, n, b, step_body fn es) }
   | Match (sc, arms) ->
-    { e with e = Match (sc, List.map (fun a -> { a with body = step_body a.body }) arms) }
+    { e with e = Match (sc, List.map (fun a -> { a with body = step_body fn a.body }) arms) }
   | _ -> e
 
-let instrument_step (ds : decl list) : decl list option =
+let instrument_step ?(fn = "step-point") (ds : decl list) : decl list option =
   let hit = ref false in
   let ds =
     List.map
@@ -551,7 +553,7 @@ let instrument_step (ds : decl list) : decl list option =
                bval = { e = Var "true"; loc = d.dloc }; bloc = d.dloc }
            in
            { d with
-             d = Defn { f with fbody = [ { e = Let ([ on ], step_body f.fbody);
+             d = Defn { f with fbody = [ { e = Let ([ on ], step_body fn f.fbody);
                                            loc = d.dloc } ] } }
          | _ -> d)
       ds
@@ -573,7 +575,7 @@ let instrument_step (ds : decl list) : decl list option =
    A whole top-level [defn] is the third target from §9 and cannot be wrapped:
    [(do (pause) (defn ...))] is not an expression. Marking one means stopping
    on entry, so the call goes at the front of its body. *)
-let mark_pause ~line ~col (ds : decl list) : decl list option =
+let mark_pause ?fn ~line ~col (ds : decl list) : decl list option =
   let at (l : Loc.t) = l.Loc.line = line && l.Loc.col = col in
   let hit = ref false in
   let rec walk (e : expr) =
@@ -583,7 +585,7 @@ let mark_pause ~line ~col (ds : decl list) : decl list option =
       (* The [Do] takes the target's own location, and the target keeps its
          own: a wrapper at [Loc.unknown] would put the frame the break loop
          reports, and the line DWARF names, nowhere. *)
-      { e with e = Do [ pause_call e.loc; e ] }
+      { e with e = Do [ pause_call ?fn e.loc; e ] }
     end
     else map_children walk e
   in
@@ -592,7 +594,7 @@ let mark_pause ~line ~col (ds : decl list) : decl list option =
     match d.d with
     | Defn f when (not !hit) && at d.dloc ->
       hit := true;
-      { d with d = Defn { f with fbody = pause_call d.dloc :: f.fbody } }
+      { d with d = Defn { f with fbody = pause_call ?fn d.dloc :: f.fbody } }
     | Defn f -> { d with d = Defn { f with fbody = body f.fbody } }
     (* A method's body and a defmulti's dispatch body are code someone wrote
        and can stop inside, so both are walked. Marking the whole declaration

lib/body_macros.ml

@@ -0,0 +1,196 @@
+(** What the indented printer needs to know of macros: which take a body run
+    in order and at which argument it starts, and which names their
+    expansions spell.
+
+    A body is read off the macro's definition. A macro whose rest parameter
+    is spliced, whole or from a fixed index on, only into places whose forms
+    run in order — a [do], the body of a [let], [fn], [when], [while] or
+    [loop], or the body of another such macro — takes a body there, provided
+    nothing else of it depends on how the body is split into arguments: out
+    of its templates the rest parameter may only be counted against the
+    body's start ([(< (length r) 1)]), read before the body ([(at r 0)] when
+    the body starts at 1), or have the body's first form tested with a
+    predicate ([(form-empty-list? (at r 0))]), since a [let] taking in the
+    forms after it changes how many there are and nothing about the first.
+    [comment] counts too: nothing in it runs. The printer lets a [let] in such
+    a body take in the statements after it, as it does in a [do].
+
+    The names a template spells outside its unquotes are what its expansion
+    can refer to without its call spelling them: a [let] of one of those
+    names is not given a longer scope over a call of that macro. *)
+
+type t = {
+  bodies : (string, int) Hashtbl.t;  (** called name -> argument the body starts at *)
+  names : (string, string list) Hashtbl.t;  (** called name -> names its templates spell *)
+}
+
+let create () = { bodies = Hashtbl.create 32; names = Hashtbl.create 64 }
+
+(* Core forms whose trailing arguments are a body run in order, and how many
+   arguments come before it. *)
+let core = [ ("do", 0); ("let", 1); ("fn", 1); ("when", 1); ("while", 1); ("loop", 1);
+             ("defer", 0); ("with-allocator", 1) ]
+
+let body_start (t : t) h =
+  match List.assoc_opt h core with Some k -> Some k | None -> Hashtbl.find_opt t.bodies h
+
+(* The names a template spells outside its unquotes. *)
+let rec template_names (f : Form.t) acc =
+  match f.v with
+  | Form.List ({ v = Form.Sym ("unquote" | "unquote-splicing"); _ } :: _) -> acc
+  | Form.Sym s -> s :: acc
+  | Form.List l | Form.Vec l | Form.Map l -> List.fold_left (fun a x -> template_names x a) acc l
+  | _ -> acc
+
+let rec templates (f : Form.t) acc =
+  match f.v with
+  | Form.List [ { v = Form.Sym "quasiquote"; _ }; x ] -> x :: acc
+  | Form.List l | Form.Vec l | Form.Map l -> List.fold_left (fun a x -> templates x a) acc l
+  | _ -> acc
+
+(* The argument index the body of [(defmacro name [p ... & r] body ...)]
+   starts at, or [None]. [known] gives another macro's. *)
+let body_of ~(known : string -> int option) name ps body : int option =
+  if name = "comment" then Some 0
+  else
+    let rec split fixed = function
+      | { Form.v = Form.Sym "&"; _ } :: [ { Form.v = Form.Sym r; _ } ] -> Some (fixed, r)
+      | { Form.v = Form.Sym "&"; _ } :: _ -> None
+      | _ :: rest -> split (fixed + 1) rest
+      | [] -> None
+    in
+    match split 0 ps with
+    | None -> None
+    | Some (fixed, r) ->
+      let is_r (f : Form.t) = f.v = Form.Sym r in
+      let rec mentions (f : Form.t) =
+        match f.v with
+        | Form.Sym s -> s = r
+        | Form.List l | Form.Vec l | Form.Map l -> List.exists mentions l
+        | _ -> false
+      in
+      let int (f : Form.t) = match f.v with Form.Int i -> Some (Int64.to_int i) | _ -> None in
+      let at_r (f : Form.t) =
+        match f.v with
+        | Form.List [ { v = Form.Sym "at"; _ }; x; i ] when is_r x -> int i
+        | _ -> None
+      in
+      let bodies = ref [] and reads = ref [] and bad = ref false in
+      (* Splices of [r] in a template, each where it lands. *)
+      let splice_from (e : Form.t) =
+        match e.v with
+        | Form.Sym s when s = r -> Some 0
+        | Form.List [ { v = Form.Sym "form-rest"; _ }; x; k ] when is_r x -> int k
+        | _ -> None
+      in
+      let lookup h = match List.assoc_opt h core with Some k -> Some k | None -> known h in
+      let rec template (f : Form.t) =
+        match f.v with
+        | Form.List [ { v = Form.Sym "unquote"; _ }; e ] ->
+          (match at_r e with
+           | Some i -> reads := i :: !reads
+           | None -> if mentions e then bad := true)
+        | Form.List [ { v = Form.Sym "unquote-splicing"; _ }; e ] ->
+          (* Anywhere but in a list's items: a vector, a map. *)
+          if mentions e then bad := true
+        | Form.List l ->
+          let head = match l with { v = Form.Sym h; _ } :: _ -> Some h | _ -> None in
+          (* A label after while, until or dotimes comes before the test. *)
+          let label =
+            match head, l with
+            | Some ("while" | "until" | "dotimes"), _ :: { v = Form.Kw _; _ } :: _ -> 1
+            | _ -> 0
+          in
+          List.iteri
+            (fun i (x : Form.t) ->
+               match x.v with
+               | Form.List [ { v = Form.Sym "unquote-splicing"; _ }; e ] ->
+                 (match splice_from e, Option.bind head lookup with
+                  | Some k, Some b when i >= b + 1 + label -> bodies := k :: !bodies
+                  | _ -> if mentions e then bad := true)
+               | _ -> template x)
+            l
+        | Form.Vec l | Form.Map l ->
+          List.iter
+            (fun (x : Form.t) ->
+               match x.v with
+               | Form.List [ { v = Form.Sym "unquote-splicing"; _ }; e ] ->
+                 if mentions e then bad := true
+               | _ -> template x)
+            l
+        | _ -> ()
+      in
+      (* The macro's own code, out of its templates: [r] only counted, read
+         before the body, or its first form tested. [k] is the body's start
+         within [r], known once the templates are read. *)
+      let rec code k (f : Form.t) =
+        match f.v with
+        | Form.List [ { v = Form.Sym "quasiquote"; _ }; x ] -> template x
+        | Form.Sym s when s = r -> bad := true
+        | Form.List [ { v = Form.Sym ("<" | ">=" | "=" | "<=" | ">"); _ }; a; b ] ->
+          (match a.v, b.v with
+           | Form.List [ { v = Form.Sym "length"; _ }; x ], _ when is_r x ->
+             (match int b with Some c when c <= k + 1 -> () | _ -> code k b; bad := true)
+           | _, Form.List [ { v = Form.Sym "length"; _ }; x ] when is_r x ->
+             (match int a with Some c when c <= k + 1 -> () | _ -> code k a; bad := true)
+           | _ -> code k a; code k b)
+        | Form.List [ { v = Form.Sym p; _ }; e ]
+          when String.length p > 1 && p.[String.length p - 1] = '?' && at_r e <> None ->
+          (match at_r e with Some i when i <= k -> () | _ -> bad := true)
+        | Form.List _ when at_r f <> None ->
+          (match at_r f with Some i when i < k -> () | _ -> bad := true)
+        | Form.List l | Form.Vec l | Form.Map l -> List.iter (code k) l
+        | _ -> ()
+      in
+      (* The templates first, for [k]; then the rest of the code against it. *)
+      List.iter (fun t -> template t) (List.fold_left (fun a x -> templates x a) [] body);
+      match !bodies with
+      | k :: more when (not !bad) && List.for_all (( = ) k) more
+                       && List.for_all (fun i -> i < k) !reads ->
+        List.iter (code k) body;
+        if !bad then None else Some (fixed + k)
+      | _ -> None
+
+let add (t : t) ~qualify forms =
+  let local = Hashtbl.create 8 in
+  List.iter
+    (fun (f : Form.t) ->
+       match f.v with
+       | Form.List ({ v = Form.Sym "defmacro"; _ } :: { v = Form.Sym name; _ }
+                    :: { v = Form.Vec ps; _ } :: body) ->
+         let known h =
+           match Hashtbl.find_opt local h with
+           | Some k -> Some k
+           | None -> Hashtbl.find_opt t.bodies h
+         in
+         Hashtbl.replace t.names (qualify name)
+           (List.fold_left (fun a x -> template_names x a) []
+              (List.fold_left (fun a x -> templates x a) [] body));
+         (match body_of ~known name ps body with
+          | Some k -> Hashtbl.replace local name k; Hashtbl.replace t.bodies (qualify name) k
+          (* A definition of the same name as a prelude macro replaces it. *)
+          | None -> Hashtbl.remove local name; Hashtbl.remove t.bodies (qualify name))
+       | _ -> ())
+    forms
+
+(** The prelude's macros, those of the packages [forms] imports (qualified
+    by their alias) and [forms]' own. An import that cannot be found or read
+    adds nothing. *)
+let table ?file (forms : Form.t list) : t =
+  let t = create () in
+  let prelude = try Reader.read_all ~file:Prelude.file Prelude.source with _ -> [] in
+  add t ~qualify:Fun.id prelude;
+  (match file with
+   | None -> ()
+   | Some file ->
+     List.iter
+       (fun (alias, path, loc) ->
+          try
+            let d = Load.resolve_dir ~file loc path in
+            let files = if Sys.is_directory d then Load.source_entries d else [ d ] in
+            let fs = List.concat_map Source.read_file files in
+            add t ~qualify:(fun n -> alias ^ "/" ^ n) fs
+          with _ -> ())
+       (Load.imports_of forms));
+  add t ~qualify:Fun.id forms;
+  t

lib/build.ml

@@ -64,8 +64,18 @@ let workdir () =
     workdir_exit := Some d;
     let pid = Unix.getpid () in
     at_exit (fun () ->
-      if Unix.getpid () = pid then
+      if Unix.getpid () = pid then begin
-        try Unix.rmdir d with Unix.Unix_error _ -> ())
+        (* The dyn header [compile_c] leaves for every compile in the process
+           to include, and not a build's own: gone when it is all that is
+           left, kept beside a failed build's C that includes it. *)
+        (match Sys.readdir d with
+         | [| "flan_dyn.h" |] ->
+           (try Unix.unlink (Filename.concat d "flan_dyn.h")
+            with Unix.Unix_error _ -> ())
+         | _ -> ()
+         | exception Sys_error _ -> ());
+        try Unix.rmdir d with Unix.Unix_error _ -> ()
+      end)
   end;
   d
 

lib/dev.ml

@@ -213,7 +213,7 @@ let over_socket t line =
   Fun.protect
     ~finally:(fun () -> try Unix.close s with Unix.Unix_error _ -> ())
     (fun () ->
-       Unix.connect s (Unix.ADDR_UNIX t.agent);
+       Wire.connect_socket s t.agent;
        let msg = line ^ "\n" in
        ignore (Unix.write_substring s msg 0 (String.length msg));
        let b = Bytes.create 4096 in
@@ -940,8 +940,7 @@ let refusal ~parked reply =
    frame boundary is the next one it reaches. That includes a running program
    whose agent socket is not bound. The agent package binds it in a
    constructor before [main], so the one way to be running and unbound with
-   the agent linked is a bind that failed — a socket path longer than
+   the agent linked is a bind that failed, and there
-   [max_socket_path], which [session_dir] refuses before building — and there
    the module is still queued through the in-process call. A note saying the
    program "has not called (agent/start ...)" named a cause that was not the
    cause, so there is none. *)
@@ -2592,11 +2591,11 @@ let stopped_frame t ~frame ~what : (string * Tast.fn, string) result =
                    up" is a claim about the body this session holds, and a
                    zero-slot frame whose body has since been replaced by one
                    with slots is a frame that claim is false about. *)
-                if nslots <> Array.length fn.Tast.slots then
+                if nslots <> Emit.recorded_slots fn then
                   Error
                     (Printf.sprintf
                        "%s on the stack has %d slots and the %s this session holds has %d — the frame is running a body that has been redefined since"
-                       name nslots name (Array.length fn.Tast.slots))
+                       name nslots name (Emit.recorded_slots fn))
                 else if sig_ <> Emit.slot_fingerprint fn then
                   (* The count matching is not the same as the body matching.
                      A redefinition that renames a local, or changes its type
@@ -2632,7 +2631,7 @@ let eval_expr ?frame ?at_stop t ~code ~origin ~pause =
           (* A frame with no slots has no locals to bind, and the program
              has no table to answer for it: the expression sees globals. *)
           let bound =
-            if Array.length fn.Tast.slots = 0 then Ok []
+            if Emit.recorded_slots fn = 0 then Ok []
             else bound_slots t ~frame:index
           in
           (* [at_stop] is the stop the editor drew the frame at. It is not
@@ -2681,7 +2680,7 @@ let locals t ~frame =
   match stopped_frame t ~frame ~what:"locals" with
   | Error m -> error m
   | Ok (name, fn) ->
-    if Array.length fn.Tast.slots = 0 then
+    if Emit.recorded_slots fn = 0 then
       ok
         [ ":frame " ^ Wire.quote name; ":locals ()"; ":refused ()";
           ":note " ^ Wire.quote "this frame has no named locals" ]
@@ -3461,7 +3460,7 @@ let globals_op t =
                     "not a function this session holds; a lifted handler clause \
                      has no declaration of its own to read references from"
                 | Some fn ->
-                  if nslots <> Array.length fn.Tast.slots then
+                  if nslots <> Emit.recorded_slots fn then
                     skip
                       "the frame is running a body that has been redefined \
                        since, so what this session holds is a different body's \
@@ -5360,20 +5359,42 @@ let remove_session_dirs t =
   remove t.dir;
   remove (Build.workdir ())
 
-(* The longest path a unix socket can be bound at: [sun_path] is 108 bytes on
+(* A socket path longer than [Wire.max_socket_path] is bound through its
-   Linux and the path is written into it with its terminating NUL. A longer one
+   directory, so only a file name too long for that is refused. *)
-   fails at the bind, where the reason reaches nobody — the agent's constructor
-   drops it, and [connect] later answers "File name too long" with no path. *)
-let max_socket_path = 107
-
 let socket_fits ~what ~fix path =
-  let n = String.length path in
+  if not (Wire.socket_fits path) then
-  if n > max_socket_path then
     failwith
       (Printf.sprintf
-         "%s would be at %s, which is %d bytes long, and a unix socket path \
+         "%s would be at %s, and its file name, %s, is too long for a unix \
-          can be at most %d bytes. %s"
+          socket. %s"
-         what path n max_socket_path fix)
+         what path (Filename.basename path) fix)
+
+(* An editor socket too long to connect to by path gets a symlink at
+   [Wire.short_socket_path], made before the bind so it is there by the time
+   the socket is, and removed on a clean end only while it is still this
+   socket's. *)
+let absolute p =
+  if Filename.is_relative p then Filename.concat (Sys.getcwd ()) p else p
+
+let link_short_socket sock =
+  if String.length sock > Wire.max_socket_path then begin
+    let s = Wire.short_socket_path sock in
+    (match (Unix.lstat s).Unix.st_kind with
+     | Unix.S_LNK -> (try Unix.unlink s with Unix.Unix_error _ -> ())
+     | _ -> ()
+     | exception Unix.Unix_error _ -> ());
+    try Unix.symlink (absolute sock) s with Unix.Unix_error _ -> ()
+  end
+
+let unlink_short_socket sock =
+  if String.length sock > Wire.max_socket_path then begin
+    let s = Wire.short_socket_path sock in
+    match Unix.readlink s with
+    | target when String.equal target (absolute sock) ->
+      (try Unix.unlink s with Unix.Unix_error _ -> ())
+    | _ -> ()
+    | exception Unix.Unix_error _ -> ()
+  end
 
 (* The directory a session keeps its program, its modules and the agent's
    socket in, checked before anything is built so that a TMPDIR that cannot
@@ -5381,11 +5402,6 @@ let socket_fits ~what ~fix path =
 let session_dir ~file ~sock =
   let tmp = Filename.get_temp_dir_name () in
   let dir = Filename.concat tmp (Printf.sprintf "flan-dev-%d" (Unix.getpid ())) in
-  let shorter =
-    Printf.sprintf
-      "Set TMPDIR to a shorter directory, for example: TMPDIR=/tmp flan dev %s"
-      (Filename.quote file)
-  in
   if not (Sys.file_exists tmp && Sys.is_directory tmp) then
     failwith
       (Printf.sprintf
@@ -5393,10 +5409,8 @@ let session_dir ~file ~sock =
           program there. Create it, or set TMPDIR to a directory that exists, \
           for example: TMPDIR=/tmp flan dev %s"
          tmp (Filename.quote file));
-  socket_fits ~what:"the program's agent socket" ~fix:shorter
-    (Filename.concat dir "agent.sock");
   socket_fits ~what:"the editor's socket"
-    ~fix:"Give flan dev -s a shorter path." sock;
+    ~fix:"Give flan dev -s a shorter file name." sock;
   dir
 
 (* Made only once the program has been found to have something to run, so a
@@ -5589,7 +5603,8 @@ let two_process ?(debug = false) ?(sanitize = false) ?(x86 = true) ~file ~sock (
   ignore_sigpipe ();
   (try Unix.unlink sock with Unix.Unix_error _ -> ());
   let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
-  Unix.bind ls (Unix.ADDR_UNIX sock);
+  link_short_socket sock;
+  Wire.bind_socket ls sock;
   Unix.listen ls 4;
   Printf.eprintf "flan dev: %s ready on %s (%.0fms)\n%!" file sock
     ((Unix.gettimeofday () -. t0) *. 1000.);
@@ -5601,7 +5616,8 @@ let two_process ?(debug = false) ?(sanitize = false) ?(x86 = true) ~file ~sock (
        | None -> ());
       (try Unix.close ls with Unix.Unix_error _ -> ());
       (try Unix.close t.stdout with Unix.Unix_error _ -> ());
-      (try Unix.unlink sock with Unix.Unix_error _ -> ()))
+      (try Unix.unlink sock with Unix.Unix_error _ -> ());
+      unlink_short_socket sock)
     (fun () -> accept_loop t ls);
   (* Here only when the loop returned: an exception out of it has already
      left through the [finally]. A child killed by a signal is the crash that
@@ -6451,7 +6467,8 @@ let merged_setup () =
     ignore_sigpipe ();
     (try Unix.unlink sock with Unix.Unix_error _ -> ());
     let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
-    Unix.bind ls (Unix.ADDR_UNIX sock);
+    link_short_socket sock;
+    Wire.bind_socket ls sock;
     Unix.listen ls 4;
     merged_state := Some (t, ls, sock);
     Printf.eprintf "flan dev: %s ready on %s (%.0fms, one process)\n%!" file
@@ -6511,6 +6528,7 @@ let merged_serve () =
     in
     (try Unix.close ls with Unix.Unix_error _ -> ());
     (try Unix.unlink sock with Unix.Unix_error _ -> ());
+    unlink_short_socket sock;
     (* The program is this process, so a program that crashed never gets here;
        the one end that does and is not clean is the loop raising. *)
     if clean then remove_session_dirs t;

lib/dune

@@ -13,7 +13,7 @@
  ; only C the compiler itself is built from. See lib/dynload_stubs.c.
  (foreign_stubs
   (language c)
-  (names dynload_stubs))
+  (names dynload_stubs spawn_stubs))
  ; No (c_library_flags (-ldl)): since glibc 2.34 dlopen lives in libc itself
  ; and libdl is a stub, and naming it breaks the merged build -- the partial
  ; link -output-complete-obj performs cannot resolve -ldl, so `flan dev` in

lib/emit.ml

@@ -2022,6 +2022,17 @@ let slot_fingerprint (fn : Tast.fn) =
     fn.Tast.slots;
   Hashtbl.hash (Buffer.contents b) land 0x3fffffff
 
+(* How many slots a frame's record says it has: all of them when any is named,
+   and none otherwise, since only a function with a named slot gets a slot
+   table (see the shadow stack's push in [emit_fn]). Both backends write it and
+   [Dev] compares a frame against it, so a body whose slots are all the
+   compiler's own — a [print]'s temporaries — reads as the same body at both
+   ends. *)
+let recorded_slots (fn : Tast.fn) =
+  if Array.exists (fun n -> n <> None) fn.Tast.snames then
+    Array.length fn.Tast.slots
+  else 0
+
 let fninfo m (fn : Tast.fn) ~nslots =
   let nid, nlen = fi_bytes m fn.Tast.name in
   let lid, llen = fi_bytes m (Loc.to_string fn.Tast.floc) in

lib/indent_printer.ml

@@ -69,6 +69,226 @@ let rec same (a : Form.t) (b : Form.t) =
 
 let is_sym s (f : Form.t) = match f.v with Form.Sym x -> x = s | _ -> false
 
+(* Inside a quasiquote the forms are a template, not code: an unquote may put
+   anything in place, a name a flat [let] would then capture included, so no
+   [let] there takes in what follows it and no one-argument [and] is dropped. *)
+let quasi = ref 0
+
+let in_quasi (f : Form.t) k =
+  match f.v with
+  | Form.List ({ v = Form.Sym "quasiquote"; _ } :: _) ->
+    incr quasi;
+    Fun.protect ~finally:(fun () -> decr quasi) k
+  | _ -> k ()
+
+(* ── Flat lets ─────────────────────────────────────────────────────── *)
+
+(* A [let] in the indented syntax is always flat: [let x = v] scopes to the
+   end of its block. So a [let] with statements after it in a body is printed
+   as the [let] taking those statements into its own body. That changes
+   nothing when none of them refers to a name it binds — a [let] is no frame
+   and a [defer] is function-scoped, so the longer scope releases nothing
+   later. When one does, the name is renamed inside the [let] to one the
+   whole top-level form does not use. Where a rename cannot be trusted, or
+   where the statements are not a body run in order, the [let] goes in a
+   [do:] block of its own instead. *)
+
+(* Macros whose trailing arguments are a body run in order, by the name they
+   are called by, and the argument the body starts at. Set by [program]. *)
+let macros : Body_macros.t ref = ref (Body_macros.create ())
+
+(* Every name spelled in the top-level form being printed, and every part of
+   a dotted or slashed one: a new name is none of them. *)
+let used : (string, unit) Hashtbl.t = Hashtbl.create 64
+
+let rec note_used (f : Form.t) =
+  match f.v with
+  | Form.Sym s ->
+    List.iter (fun p -> Hashtbl.replace used p ())
+      (s :: List.concat_map (String.split_on_char '/') (String.split_on_char '.' s))
+  | Form.List l | Form.Vec l | Form.Map l -> List.iter note_used l
+  | _ -> ()
+
+(* Each new name, and the name it was made from: renaming [x-3] again makes
+   [x-4], not [x-3-2]. *)
+let made : (string, string) Hashtbl.t = Hashtbl.create 16
+
+let fresh n =
+  let n = Option.value (Hashtbl.find_opt made n) ~default:n in
+  let rec go i =
+    let c = n ^ "-" ^ string_of_int i in
+    if Hashtbl.mem used c then go (i + 1)
+    else (Hashtbl.replace used c (); Hashtbl.replace made c n; c)
+  in
+  go 2
+
+let prefixed pre s =
+  String.length s > String.length pre && String.sub s 0 (String.length pre) = pre
+
+let dotted s = String.length s > 1 && s.[0] = '.'
+
+let all f l =
+  List.fold_right
+    (fun x acc -> match f x, acc with Some y, Some ys -> Some (y :: ys) | _ -> None)
+    l (Some [])
+
+(* A struct pattern's entries as [name .field] pairs, in order: [.x] is
+   [x .x], and [:keys [x y]] is [x .x y .y] ([Parse.dmap]). [None] for a
+   shape [Parse] refuses. *)
+let struct_pairs (items : Form.t list) =
+  let rec go = function
+    | [] -> Some []
+    | ({ Form.v = Form.Sym s; _ } as f) :: rest when dotted s ->
+      let n = String.sub s 1 (String.length s - 1) in
+      Option.map (fun r -> ({ f with v = Form.Sym n }, f) :: r) (go rest)
+    | { Form.v = Form.Kw "keys"; _ } :: { Form.v = Form.Vec ns; _ } :: rest ->
+      Option.bind
+        (all (fun (n : Form.t) -> match n.v with
+             | Form.Sym s -> Some (n, { n with v = Form.Sym ("." ^ s) })
+             | _ -> None) ns)
+        (fun ps -> Option.map (fun r -> ps @ r) (go rest))
+    | pat :: ({ Form.v = Form.Sym s; _ } as f) :: rest when dotted s ->
+      Option.map (fun r -> (pat, f) :: r) (go rest)
+    | _ -> None
+  in
+  go items
+
+(* The names a binding target binds, or [None] for a target [Parse] would
+   refuse. *)
+let rec pat_names (t : Form.t) : string list option =
+  match t.v with
+  | Form.Sym s -> Some [ s ]
+  | Form.Vec l ->
+    Option.map List.concat
+      (all (fun (x : Form.t) -> if x.v = Form.Sym "&" then Some [] else pat_names x) l)
+  | Form.Map l ->
+    Option.bind (struct_pairs l) (fun ps ->
+        Option.map List.concat (all (fun (p, _) -> pat_names p) ps))
+  | _ -> None
+
+let binds n t = match pat_names t with Some ns -> List.mem n ns | None -> false
+
+(* Whether [f] mentions [n]: the name, or a field path or qualified name
+   starting with it. Any occurrence counts, a quoted one or one under an
+   unquote included. A macro whose expansion names a variable its call does
+   not spell is [flatten]'s to see, through [!macros.names]; one defined
+   nowhere [Body_macros.table] reads is the case nothing here can see. *)
+let rec mentions n (f : Form.t) =
+  match f.v with
+  | Form.Sym s -> s = n || prefixed (n ^ ".") s || prefixed (n ^ "/") s
+  | Form.List l | Form.Vec l | Form.Map l -> List.exists (mentions n) l
+  | _ -> false
+
+(* [mentions], less what a [let] inside [f] rebinds before any use: a later
+   [let a = ...] of the same name is a new [a], not the one before it. *)
+let rec refers n (f : Form.t) =
+  match f.v with
+  | Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: body) ->
+    let rec go = function
+      | t :: v :: rest -> refers n v || ((not (binds n t)) && go rest)
+      | [ t ] -> refers n t
+      | [] -> List.exists (refers n) body
+    in
+    go bs
+  | Form.List l | Form.Vec l | Form.Map l -> List.exists (refers n) l
+  | _ -> mentions n f
+
+(* A binding target with [n] renamed [n']. A struct pattern that binds [n]
+   is written out as pairs, so the field keeps its name. *)
+let rec rename_pat n n' (t : Form.t) : Form.t option =
+  match t.v with
+  | Form.Sym s when s = n -> Some { t with v = Form.Sym n' }
+  | Form.Sym _ -> Some t
+  | Form.Vec l -> Option.map (fun l -> { t with v = Form.Vec l }) (all (rename_pat n n') l)
+  | Form.Map l ->
+    Option.bind (struct_pairs l) (fun ps ->
+        if not (binds n t) then Some t
+        else
+          Option.map
+            (fun ps -> { t with v = Form.Map (List.concat_map (fun (p, f) -> [ p; f ]) ps) })
+            (all (fun (p, f) -> Option.map (fun p -> (p, f)) (rename_pat n n' p)) ps))
+  | _ -> None
+
+(* [f] with [n] renamed [n'], or [None] where the rename cannot be trusted:
+   a quoted [n] is data, [n/x] names a package, and [(n ...)] may call a
+   function of that name rather than the local. A [let] inside renames its
+   targets as patterns. *)
+let rec rename n n' (f : Form.t) : Form.t option =
+  match f.v with
+  | Form.Sym s when s = n -> Some { f with v = Form.Sym n' }
+  | Form.Sym s when prefixed (n ^ ".") s ->
+    let k = String.length n in
+    Some { f with v = Form.Sym (n' ^ String.sub s k (String.length s - k)) }
+  | Form.Sym s when prefixed (n ^ "/") s -> None
+  | Form.List ({ v = Form.Sym ("quote" | "quasiquote"); _ } :: _) when mentions n f -> None
+  | Form.List ({ v = Form.Sym s; _ } :: _) when s = n -> None
+  | Form.List (({ v = Form.Sym "let"; _ } as h) :: ({ v = Form.Vec bs; _ } as bv) :: body) ->
+    let rec go = function
+      | t :: v :: rest ->
+        (match rename_pat n n' t, rename n n' v, go rest with
+         | Some t, Some v, Some r -> Some (t :: v :: r)
+         | _ -> None)
+      | rest -> all (rename n n') rest
+    in
+    (match go bs, all (rename n n') body with
+     | Some bs, Some body -> Some { f with v = Form.List (h :: { bv with v = Form.Vec bs } :: body) }
+     | _ -> None)
+  | Form.List l -> Option.map (fun l -> { f with v = Form.List l }) (all (rename n n') l)
+  | Form.Vec l -> Option.map (fun l -> { f with v = Form.Vec l }) (all (rename n n') l)
+  | Form.Map l -> Option.map (fun l -> { f with v = Form.Map l }) (all (rename n n') l)
+  | _ -> Some f
+
+(* [n] renamed [n'] in a [let]'s bindings [bs] and [body], from the binding
+   that binds it on: the values up to and including that binding's see the
+   outer [n]. *)
+let rename_let n n' (bs : Form.t list) (body : Form.t list) =
+  let rec go = function
+    | t :: v :: rest when binds n t ->
+      (* From here on, the rest reads as a [let] of its own. *)
+      (match rename_pat n n' t,
+             rename n n' { t with v = Form.List (Form.make (Form.Sym "let") t.loc
+                                                 :: Form.make (Form.Vec rest) t.loc :: body) } with
+       | Some t', Some { v = Form.List (_ :: { v = Form.Vec rest'; _ } :: body'); _ } ->
+         Some (t' :: v :: rest', body')
+       | _ -> None)
+    | t :: v :: rest -> Option.map (fun (r, b) -> (t :: v :: r, b)) (go rest)
+    | _ -> Some (bs, body)
+  in
+  go bs
+
+(* The [let] [f] taking [rest] in as the end of its body, its names that
+   [rest] refers to renamed; [None] when a rename cannot be trusted. *)
+let flatten (f : Form.t) (rest : Form.t list) =
+  match f.v with
+  | Form.List (({ v = Form.Sym "let"; _ } as h) :: ({ v = Form.Vec bs; _ } as bv) :: (_ :: _ as body))
+    when rest <> [] && bs <> [] && List.length bs mod 2 = 0 ->
+    Option.bind
+      (all pat_names (List.filteri (fun i _ -> i mod 2 = 0) bs))
+      (fun names ->
+         (* A call of a macro whose expansion names one of [ns]: that name
+            in the expansion means whatever is in scope where it lands, so
+            the let's scope may not newly reach it and a name it means may
+            not be renamed. *)
+         let rec captures ns (f : Form.t) =
+           match f.v with
+           | Form.List ({ v = Form.Sym m; _ } :: _)
+             when (match Hashtbl.find_opt !macros.names m with
+                 | Some ms -> List.exists (fun n -> List.mem n ms) ns
+                 | None -> false) -> true
+           | Form.List l | Form.Vec l | Form.Map l -> List.exists (captures ns) l
+           | _ -> false
+         in
+         let names = List.sort_uniq compare (List.concat names) in
+         let clash = List.filter (fun n -> List.exists (refers n) rest) names in
+         if List.exists (captures names) rest || List.exists (captures clash) body then None
+         else
+         List.fold_left
+           (fun acc n -> Option.bind acc (fun (bs, body) -> rename_let n (fresh n) bs body))
+           (Some (bs, body)) clash
+         |> Option.map (fun (bs, body) ->
+             { f with v = Form.List (h :: { bv with v = Form.Vec bs } :: (body @ rest)) }))
+  | _ -> None
+
 (* ── Expressions ───────────────────────────────────────────────────── *)
 
 (* Text and syntactic level, the same scale [Indent_reader] reads: 10 an atom
@@ -94,7 +314,7 @@ let rec expr (f : Form.t) : string * int =
   | Form.Vec xs -> ("[" ^ vec_text xs ^ "]", 10)
   | Form.Map xs -> ("{" ^ map_text xs ^ "}", 10)
   | Form.List [] -> ("()", 10)
-  | Form.List (h :: args) -> list f h args
+  | Form.List (h :: args) -> in_quasi f (fun () -> list f h args)
 
 and sym f s =
   if s = "==" then unprintable f "the name == (it reads as =)"
@@ -166,6 +386,8 @@ and list _f h args =
     if l >= 9 && t <> "" && R.is_neg_char t.[0] then ("-" ^ t, 8)
     else ("-(" ^ at 0 x ^ ")", 9)
   | Form.Sym "not", [ x ] -> ("not " ^ at 3 x, 3)
+  (* [and] or [or] of one value is that value. *)
+  | Form.Sym ("and" | "or"), [ x ] when !quasi = 0 -> expr x
   | Form.Sym "at", t :: (_ :: _ as idx) -> (at 9 t ^ "[" ^ commas idx ^ "]", 9)
   | Form.Sym s, [ t ]
     when String.length s > 1 && s.[0] = '.' && name_ok s
@@ -282,7 +504,7 @@ let stmts_of (f : Form.t) =
   | _ -> [ f ]
 
 (* Heads whose trailing arguments are a body, and how many come before it. *)
-let body_split (h : Form.t) args =
+let body_guess (h : Form.t) args =
   match h.v with
   | Form.Sym s ->
     let base =
@@ -326,21 +548,70 @@ let body_split (h : Form.t) args =
        else None)
   | _ -> None
 
+let let_sugar (f : Form.t) =
+  match f.v with
+  | Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: _ :: _) ->
+    (match pairs bs with None | Some [] -> false | Some _ -> true)
+  | _ -> false
+
+(* [Some (k, seq)]: the arguments from [k] on print as a block, and [seq]
+   when that block is a body run in order ([Body_macros]), whose start the
+   definition gives rather than the guess. *)
+let body_split (h : Form.t) args =
+  match body_guess h args, h.v with
+  | None, Form.Sym s ->
+    (* A body with a [let] in it is written as a block, where the [let] can
+       be flat. *)
+    (match Hashtbl.find_opt !macros.bodies s with
+     | Some b when List.exists let_sugar (List.filteri (fun i _ -> i >= b) args) ->
+       Some (b, true)
+     | _ ->
+       (* Any other call with a [let] among its arguments: the trailing run
+          of lists as a block, each [let] in a [do:] of its own, rather than
+          the [let] written as a call. *)
+       if List.exists let_sugar args then begin
+         let k = ref 0 in
+         List.iteri (fun i (a : Form.t) ->
+             match a.v with Form.List (_ :: _) -> () | _ -> k := i + 1) args;
+         if List.exists let_sugar (List.filteri (fun i _ -> i >= !k) args)
+         then Some (!k, false) else None
+       end
+       else None)
+  | None, _ -> None
+  | Some k, Form.Sym s ->
+    let n = List.length args in
+    (match List.assoc_opt s Body_macros.core, Hashtbl.find_opt !macros.bodies s with
+     | Some b, _ | None, Some b when b < n -> Some (b, true)
+     | _ -> Some (k, List.mem s [ "defmacro"; "defmethod" ]))
+  | Some k, _ -> Some (k, false)
+
 let sugar_heads =
   [ "let"; "set"; "if"; "when"; "cond"; "while"; "until"; "dotimes"; "match";
     "handler-case"; "handler-bind"; "restart-case"; "return"; "defer"; "do";
     "quasiquote"; "update" ]
 
-let rec block n (fs : Form.t list) : string list =
+
+(* [(do x)]: printed as [do:] and [x] as the one statement of its block. *)
+let in_do (x : Form.t) = { x with v = Form.List [ Form.make (Form.Sym "do") x.loc; x ] }
+
+(* [seq] when the block is a body run in order, where a [let] may take in
+   the statements after it. Not for the arguments of a call that happen to
+   print as a block, whose count that would change. *)
+let rec block ?(seq = true) n (fs : Form.t list) : string list =
   let rec go = function
     | [] -> []
-    | [ x ] -> stmt n ~last:true x
+    | [ x ] -> stmt n x
-    | x :: rest -> stmt n ~last:false x @ go rest
+    | x :: rest when let_sugar x ->
+      (match (if seq && !quasi = 0 then flatten x rest else None) with
+       | Some x' -> stmt n x'
+       | None -> stmt n (in_do x) @ go rest)
+    | x :: rest -> stmt n x @ go rest
   in
   go fs
 
-and stmt n ~last (f : Form.t) : string list =
+and stmt n (f : Form.t) : string list =
-  let ls = match sugar n ~last f with Some ls -> ls | None -> plain n f in
+  in_quasi f @@ fun () ->
+  let ls = match sugar n f with Some ls -> ls | None -> plain n f in
   (* The first line carries the line the form came from, for
      [Source_text.weave] to put the comments back by. *)
   match ls with
@@ -359,7 +630,7 @@ and plain n (f : Form.t) : string list =
   match f.v with
   | Form.List (h :: args) when args <> [] ->
     (match body_split h args with
-     | Some k when k < List.length args ->
+     | Some (k, seq) when k < List.length args ->
        let fixed = List.filteri (fun i _ -> i < k) args in
        let rest = List.filteri (fun i _ -> i >= k) args in
        let opener =
@@ -369,7 +640,7 @@ and plain n (f : Form.t) : string list =
          | Form.Sym s, [] when name_ok s && not (List.mem s reserved) -> s ^ ":"
          | _ -> head_text h ^ "(" ^ commas fixed ^ "):"
        in
-       [ ind n ^ guard opener ] @ block (n + 2) rest
+       [ ind n ^ guard opener ] @ block ~seq (n + 2) rest
      | _ when n + String.length text > width && fst (expr f) = text ->
        wrapped n "" f
      | _ -> one)
@@ -438,13 +709,13 @@ and label_of = function
   | ({ Form.v = Form.Kw k; _ }) :: rest when kw_ok k -> (":" ^ k ^ " ", rest)
   | rest -> ("", rest)
 
-and sugar n ~last (f : Form.t) : string list option =
+and sugar n (f : Form.t) : string list option =
   let i = ind n in
   match f.v with
   | Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: (_ :: _ as body)) ->
     (match pairs bs with
      | None | Some [] -> None
-     | Some prs -> Some (let_lines n ~last prs body))
+     | Some prs -> Some (let_lines n prs body))
   | Form.List [ { v = Form.Sym "update"; _ }; t; { v = Form.Sym ("+" | "-" | "*" | "/"); _ }; _ ]
     when not (R.simple_place t) ->
     Some [ i ^ guard (inline_text f) ]
@@ -592,7 +863,9 @@ and sugar n ~last (f : Form.t) : string list option =
        (match body with
         | [] -> Some [ head ]
         | [ x ] when (match x.v with
-            | Form.List ({ v = Form.Sym h; _ } :: _) -> not (List.mem h sugar_heads)
+            | Form.List (({ v = Form.Sym h; _ } as hf) :: args) ->
+              (* A call that takes a block is a statement, not a value. *)
+              not (List.mem h sugar_heads) && body_split hf args = None
             | _ -> true)
                   && String.length head + 3 + String.length (at 0 x) <= width
                   && not (!inside f) ->
@@ -677,10 +950,9 @@ and handler_clauses n cls =
   let cs = List.map clause cls in
   if List.mem None cs then None else Some (List.concat_map Option.get cs)
 
-(* A [let] last in its block reads to the block's end, so it is written flat.
+(* A [let] is always written flat: [block] has made it the last statement of
-   One with siblings after it takes its body as an indented block under the
+   its block, so its body is the rest of the block. *)
-   first binding, and the rest of the bindings go inside that block. *)
+and let_lines n prs body =
-and let_lines n ~last prs body =
   (* [(let [x (the T v)])] is [let x: T = v]. *)
   let bind ((t : Form.t), (v : Form.t)) =
     match t.v, v.v with
@@ -695,18 +967,13 @@ and let_lines n ~last prs body =
     | [] -> []
   in
   let lines n b = let p, v = bind b in tagged b (value_lines n p v) in
-  if last then List.concat_map (lines n) prs @ block n body
+  List.concat_map (lines n) prs @ block n body
-  else
-    match prs with
-    | b :: rest ->
-      let p, v = bind b in
-      tagged b [ ind n ^ p ^ " = " ^ at 0 v ]
-      @ List.concat_map (lines (n + 2)) rest
-      @ block (n + 2) body
-    | [] -> block n body
 
-(** A whole file: top-level forms with a blank line between them. *)
+(** A whole file: top-level forms with a blank line between them. [macros]
-let program ?source (fs : Form.t list) : string =
+    is [Body_macros.table] of the file; without it, the prelude's and the
+    file's own macros are known and no imported package's. *)
+let program ?source ?macros:m (fs : Form.t list) : string =
+  macros := (match m with Some m -> m | None -> Body_macros.table fs);
   spelling :=
     (match source with Some src -> Source_text.spelling src | None -> fun _ -> None);
   let cs = match source with Some src -> Source_text.comments src | None -> [] in
@@ -716,10 +983,18 @@ let program ?source (fs : Form.t list) : string =
          (fun (c : Source_text.comment) ->
             f.loc.Loc.line <= c.line && c.line < f.loc.Loc.eline)
          cs);
+  (* A flat [let] at the top level would take in the forms after it, so one
+     that is not last goes in a [do:] block. *)
+  let top x =
+    Hashtbl.reset used;
+    Hashtbl.reset made;
+    note_used x;
+    String.concat "\n" (stmt 0 x)
+  in
   let rec go = function
     | [] -> []
-    | [ x ] -> [ String.concat "\n" (stmt 0 ~last:true x) ]
+    | [ x ] -> [ top x ]
-    | x :: rest -> String.concat "\n" (stmt 0 ~last:false x) :: go rest
+    | x :: rest -> top (if let_sugar x then in_do x else x) :: go rest
   in
   let text =
     try String.concat "\n\n" (go fs) ^ "\n"

lib/indent_reader.ml

@@ -1118,10 +1118,13 @@ and let_stmt (s : st) : Form.t list =
       make (target :: v :: bs) body
     | _ -> make [ target; v ] body
   in
-  if (peek p).tok = INDENT then begin
+  (* A let has no block: its name lasts to the end of the block it is in. *)
-    let f = merged (block s ~after:"let") in
+  if (peek p).tok = INDENT then
-    f :: stmts s
+    failk "let-block" (peek_at p 1).loc
-  end
+      "this line is indented under let %s, which takes no block. A let's \
+       name lasts to the end of the block the let is in, so the lines after \
+       it go at the let's column"
+      (text_of target)
   else [ merged (stmts s) ]
 
 and stmt (s : st) : Form.t =

lib/session.ml

@@ -831,6 +831,21 @@ let shadowing_fns t origin =
        | _ -> None)
     t.decls
 
+(* The name a prelude function the session splices a call to — [pause] for a
+   mark, [step-point] for the stepper — answers to in [decls]. A program's own
+   function or global of that name takes the name over and the prelude's is
+   renamed (see [Check.shadow_prelude]), and the spliced call is the
+   prelude's, not the program's. *)
+let prelude_fn (decls : Ast.decl list) n =
+  let takes (d : Ast.decl) =
+    match d.Ast.d with
+    | Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) ->
+      String.equal fn.Ast.name n
+    | Ast.Defvar (m, _, _, _) | Ast.Defconst (m, _, _) -> String.equal m n
+    | _ -> false
+  in
+  if List.exists takes decls then Check.prelude_alias ^ "/" ^ n else n
+
 (* [forms], when given, are [src] already read — [pruned] runs this over a
    file a form fewer each round and has no text for the subset. [base] is the
    file an [(import ...)] in them is resolved against, the session's own when
@@ -920,7 +935,10 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
     match pause with
     | None -> incoming
     | Some (line, col) ->
-      (match Ast.mark_pause ~line ~col incoming with
+      (match
+         Ast.mark_pause ~fn:(prelude_fn (t.decls @ incoming) "pause") ~line ~col
+           incoming
+       with
        | Some ds -> ds
        | None ->
          fail loc "nothing to pause at line %d, column %d of the form sent"
@@ -931,7 +949,10 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
   let incoming =
     if not step then incoming
     else
-      match Ast.instrument_step incoming with
+      match
+        Ast.instrument_step ~fn:(prelude_fn (t.decls @ incoming) "step-point")
+          incoming
+      with
       | Some ds -> ds
       | None -> fail loc "there is no defn in the form sent to step through"
   in
@@ -1189,9 +1210,55 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
            | None -> None)
       program.Tast.fns
   in
+  (* A name that takes over a prelude function's moves the prelude's body to
+     [Check.prelude_alias] and the prelude's own calls with it (see
+     [Check.shadow_prelude]). The process was built with those calls going
+     through the name's cell, which the new body is about to be installed
+     into, so the prelude's body is installed under its new name and every
+     body whose calls moved is compiled again: the prelude keeps its own
+     function, as a rebuild would give it. *)
+  let prelude_moved =
+    if not (List.exists (fun (f : Tast.fn) -> Check.internal_name f.Tast.name)
+              program.Tast.fns)
+    then []
+    else
+      let calls_moved (f : Tast.fn) (b : built) =
+        let hit = ref false in
+        let see (e : Tast.expr) =
+          match e.Tast.e with
+          | Tast.Call (m, _)
+          | Tast.FnAddr (Tast.Fnval m) | Tast.Closure (Tast.Fnval m, _)
+            when Check.internal_name m
+                 && not (List.exists
+                           (fun (s : site) -> String.equal s.callee m) b.sites) ->
+            hit := true
+          | _ -> ()
+        in
+        List.iter (Tast.walk see) f.Tast.body;
+        List.iter (Tast.walk see) f.Tast.fdefers;
+        !hit
+      in
+      List.filter_map
+        (fun (f : Tast.fn) ->
+           (* A moved body not yet in the process is installed; one that is
+              — moved by an earlier shadowing — is compiled again like any
+              other when a later shadowing moves a call inside it. *)
+           if Check.internal_name f.Tast.name
+              && not (known t f.Tast.name || SM.mem f.Tast.name t.built)
+           then Some f.Tast.name
+           else
+             match SM.find_opt f.Tast.name t.built with
+             | Some b when calls_moved f b ->
+               (* A lifted clause is compiled with the body it came from. *)
+               (match f.Tast.fparent with
+                | Some p when p <> "<thick>" -> Some p
+                | _ -> Some f.Tast.name)
+             | _ -> None)
+        program.Tast.fns
+  in
   let fns =
     List.sort_uniq String.compare
-      (declared_fns @ def_inits @ from_generics @ new_instances)
+      (declared_fns @ def_inits @ from_generics @ new_instances @ prelude_moved)
   in
   (* A constant that changed and can be published: known to the host, not
      consumed by the checker. The module stores its new value at the frame
@@ -2313,7 +2380,10 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) ?frame t src : change =
      the break loop reports reads it. *)
   let parsed =
     if pause then
-      { Ast.e = Ast.Do [ Ast.pause_call parsed.Ast.loc; parsed ];
+      { Ast.e =
+          Ast.Do
+            [ Ast.pause_call ~fn:(prelude_fn t.decls "pause") parsed.Ast.loc;
+              parsed ];
         Ast.loc = parsed.Ast.loc }
     else parsed
   in

lib/spawn.ml

@@ -0,0 +1,6 @@
+(** Starting a program that dies with this process; see spawn_stubs.c. *)
+
+external dying : string -> string array -> int = "flan_spawn_dying"
+
+(** The host number of an OCaml signal number. *)
+external host_signal : int -> int = "flan_host_signal"

lib/spawn_stubs.c

@@ -0,0 +1,58 @@
+/* Starting a program that dies with the process that started it.
+ *
+ * `flan run` builds a program, runs it and deletes it. A flan killed by
+ * SIGKILL runs nothing on the way out, so without this the program would go on
+ * running with nobody waiting for it. On Linux the child asks the kernel for
+ * SIGKILL when its parent dies, between the fork and the exec; elsewhere it is
+ * an ordinary fork and exec.
+ */
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+/* Exported by the runtime, declared only under CAML_INTERNALS. */
+extern int caml_convert_signal_number(int);
+#include <errno.h>
+#include <signal.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#ifdef __linux__
+#include <sys/prctl.h>
+#endif
+
+value flan_spawn_dying(value path, value argv) {
+  CAMLparam2(path, argv);
+  mlsize_t n = Wosize_val(argv), i;
+  char **args = malloc((n + 1) * sizeof(char *));
+  char *file = strdup(String_val(path));
+  pid_t parent = getpid(), pid;
+  if (args == NULL || file == NULL) caml_failwith("flan_spawn_dying: out of memory");
+  for (i = 0; i < n; i++) args[i] = strdup(String_val(Field(argv, i)));
+  args[n] = NULL;
+  pid = fork();
+  if (pid == 0) {
+    sigset_t none;
+    sigemptyset(&none);
+    sigprocmask(SIG_SETMASK, &none, NULL);
+#ifdef __linux__
+    prctl(PR_SET_PDEATHSIG, SIGKILL);
+    /* The parent may have died before the request was made. */
+    if (getppid() != parent) _exit(137);
+#endif
+    execv(file, args);
+    _exit(127);
+  }
+  for (i = 0; i < n; i++) free(args[i]);
+  free(args);
+  free(file);
+  if (pid < 0) caml_failwith(strerror(errno));
+  CAMLreturn(Val_int(pid));
+}
+
+/* OCaml numbers the signals it knows by negative constants; a shell's exit
+ * status wants the host's number. */
+value flan_host_signal(value s) {
+  return Val_int(caml_convert_signal_number(Int_val(s)));
+}

lib/wire.ml

@@ -29,6 +29,56 @@ let quote s =
 let list items = "(" ^ String.concat " " items ^ ")"
 let strings ss = list (List.map quote ss)
 
+(* A unix socket path is at most 107 bytes: [sun_path] is 108 and holds the
+   terminating NUL. A longer one is reached through its directory instead,
+   opened and named as [/proc/self/fd/N/], which Linux resolves like the path
+   itself, so only the file's own name has to fit. The descriptor is closed as
+   soon as the bind or connect returns; the socket file stays where it was
+   made. *)
+let max_socket_path = 107
+
+let proc_prefix = String.length "/proc/self/fd/2147483647/"
+
+let socket_fits path =
+  String.length path <= max_socket_path
+  || String.length (Filename.basename path) + proc_prefix <= max_socket_path
+
+let with_socket_addr path k =
+  if String.length path <= max_socket_path then k (Unix.ADDR_UNIX path)
+  else begin
+    let d =
+      Unix.openfile (Filename.dirname path) [ Unix.O_RDONLY; Unix.O_CLOEXEC ] 0
+    in
+    Fun.protect
+      ~finally:(fun () -> try Unix.close d with Unix.Unix_error _ -> ())
+      (fun () ->
+         (* A [file_descr] is the fd number on Unix. *)
+         k (Unix.ADDR_UNIX
+              (Printf.sprintf "/proc/self/fd/%d/%s" (Obj.magic d : int)
+                 (Filename.basename path))))
+  end
+
+(* Where a client that cannot use the directory route above — Emacs, whose
+   [make-network-process] takes only a path — finds a socket whose own path is
+   too long: a symlink the daemon makes at a short path computed from the long
+   one, the same way on both sides. emacs/flan.el's [flan--short-socket] is
+   the other copy of this rule. *)
+let short_socket_path path =
+  let abs =
+    if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
+    else path
+  in
+  let dir =
+    match Sys.getenv_opt "XDG_RUNTIME_DIR" with
+    | Some d when d <> "" && Sys.file_exists d && Sys.is_directory d -> d
+    | _ -> "/tmp"
+  in
+  Filename.concat dir
+    ("flan-" ^ String.sub (Digest.to_hex (Digest.string abs)) 0 16 ^ ".sock")
+
+let bind_socket s path = with_socket_addr path (Unix.bind s)
+let connect_socket s path = with_socket_addr path (Unix.connect s)
+
 let send fd payload =
   let framed = Printf.sprintf "%d\n%s" (String.length payload) payload in
   let n = String.length framed in

spec-syntax.md

@@ -180,8 +180,24 @@ Each item: the proposal, then the reason in one line.
 
 - **`let x = v`** scopes to the end of its block and reads as
   `(let [x v] rest…)`. Consecutive `let`s merge into one binding vector.
-  `let x = v` followed by a deeper-indented block scopes to that block only,
+  A `let` is always flat: a line indented deeper under `let x = v` is
-  which is how the printer writes a `let` that has siblings after it.
+  refused. To end a `let`'s scope early, put it in a `do:` block.
+  The printer writes every `let` flat. A `let` with statements after it
+  takes them into its body; when one of them means an outer name the `let`
+  rebinds, the `let`'s is renamed (`x` to `x-2`, a name the top-level form
+  does not use; a struct pattern is written as `{x-2 .x}` pairs). A macro's
+  body counts as statements run in order when its definition splices its
+  rest parameter only into a `do`, a `let`/`fn`/`when`/`while`/`loop` body or
+  another such macro's body; `comment` counts too. Where a rename cannot be
+  trusted (the name quoted, qualified as `x/y`, or called as `x(...)`), and
+  at the top level, among a call's other arguments and in a quasiquote, the
+  `let` goes in a `do:` block instead, and so does one whose longer scope
+  would reach a call of a macro whose template names the `let`'s name. A
+  macro's body counts only if nothing but its templates depends on how the
+  body splits into arguments (a count against the body's start, a predicate
+  on its first form). One case this cannot see: a macro defined nowhere the
+  printer reads (not the prelude, the file or an imported package) whose
+  expansion names a variable its call does not spell.
   Destructuring: `let {.x .y} = p`, `let [head & tail] = xs`. (`defer` is
   function-scoped, not let-scoped, `TODO.org` "defer may be written in a let",
   so merging never moves a cleanup.) **Built**; `let x =` with the value as an
@@ -348,8 +364,14 @@ Each step lands on its own, with `dune test --root .` green.
 3. **The printer**, `Form.t` → indented text, and a `flan convert` command.
    **Test:** for every corpus file, read with parens, print indented, read
    indented; the forms must be equal to the first read, after one normalisation:
-   a `let` whose whole body is another `let` counts as equal to the merged
+   every name a `let` binds is renamed through its scope to one numbered by
-   `let`. That covers 394 files and runs on readers alone, so it's fast.
+   binding order; then, in a body run in order, a `let` counts as equal to
+   itself taking in the later statements of the body (a macro's body by the
+   same rule as the printer's); `(do x)` with `x` a
+   `let` counts as `x`; a `let` whose whole body is another `let` counts as
+   equal to the merged `let`; `(and x)` and `(or x)` count as `x`. Taking in
+   and the one-argument `and` stop at a quote or quasiquote. That covers 394
+   files and runs on readers alone, so it's fast.
 4. **The dev loop.** Code-carrying wire ops (`eval`, `eval-expr`,
    `macroexpand`, `set`) get an explicit `:syntax` field instead of guessing
    from `:file`. The `:file` guess breaks for `<repl>`/`<inspect>` origins and

test/programs/dev-parity.flan

@@ -54,18 +54,19 @@
 (defonce pair (Pair i32))
 
 ;; The innermost frame names every global above, so the break loop's section
-;; holds all of them; then it stops. Each is stored back to itself rather than
+;; holds all of them; then it stops. It prints them, and a frame whose only
-;; printed: a frame that prints is refused attribution today (TODO.org, "A
+;; slots are the printer's temporaries is still attributed its globals.
-;; frame that prints is skipped from the globals section"), and this is about
+;; [nowhere] is stored to itself as well: a pointer prints as <ptr> without
-;; the values.
+;; reading the variable, so printing it alone would not name it.
 (defn inner [] i64
-  (set small small) (set mid mid) (set large large) (set huge huge)
+  (print small) (print mid) (print large) (print huge)
-  (set neg neg) (set ratio ratio) (set far far) (set odd odd) (set yes yes)
+  (print neg) (print ratio) (print far) (print odd) (print yes)
-  (set byte byte) (set text text) (set colour colour) (set stray stray)
+  (print byte) (print text) (print colour) (print stray)
-  (set some some) (set none none) (set wide wide) (set deep deep)
+  (print some) (print none) (print wide) (print deep)
-  (set dot dot) (set empty empty) (set row row) (set words words)
+  (print dot) (print empty) (print row) (print words)
-  (set nums nums) (set live live) (set dead dead) (set nowhere nowhere)
+  (print nums) (print live) (print dead) (print nowhere)
-  (set un un) (set anything anything) (set pair pair)
+  (print un) (print anything) (print pair) (set nowhere nowhere)
+  (println "")
   (error (Boom {.why 3}))
   0)
 

test/syntax/flat/capture.flan

@@ -0,0 +1,6 @@
+(defmacro show-it [] `(println it))
+(defn main [] i32
+  (let [it 1]
+    (let [it 2] (show-it))
+    (show-it))
+  0)

test/syntax/flat/macros.flan

@@ -0,0 +1,46 @@
+;; Macro bodies the .fln printer must classify from their definitions:
+;; test_syntax converts this file, runs both and wants the same output.
+
+;; Counts its body forms: a let taking in the form after it would change the
+;; count, so the body is not one a let may be flattened in.
+(defmacro counted [& body]
+  (let [two (= (length body) 2)]
+    `(do (println ~(if two (Form.Sym {.s "true"}) (Form.Sym {.s "false"}))) ~@body)))
+
+;; Replaces the prelude's unless, and counts too.
+(defmacro unless [& args]
+  (let [two (= (length args) 3)]
+    `(do (println ~(if two (Form.Sym {.s "true"}) (Form.Sym {.s "false"}))) ~@(form-rest args 1))))
+
+;; The body once in a do and once as a vector's elements.
+(defmacro vtwice [& body]
+  `(do ~@body (println (length [~@body]))))
+
+;; The first body form is the loop's test.
+(defmacro labelled [& body]
+  `(while :l ~@body))
+
+;; A guard that only asks whether there is a body: a body run in order.
+(defmacro guarded [& args]
+  (if (< (length args) 1)
+    `(do)
+    `(do ~@args)))
+
+(defn main [] i32
+  (counted
+    (let [x 1] (println x))
+    (println 2))
+  (unless false
+    (let [y 3] (println y))
+    (println 4))
+  (vtwice
+    (let [z 5] (println z) z)
+    6)
+  (labelled
+    (let [go false] go)
+    (println 9))
+  (let [g 0]
+    (guarded
+      (let [g 1] (println g))
+      (println g)))
+  0)

test/syntax/flat/shadows.flan

@@ -0,0 +1,85 @@
+(defstruct P [x i32 y i32])
+(defn app [g (Fn [i32] i32) v i32] i32 (g v))
+
+(defn shadow-chain [] ()
+  (let [x 1]
+    (let [x (+ x 10)]
+      (println x))
+    (println x)
+    (let [x (+ x 100)]
+      (println x)
+      (let [x (* x 2)] (println x))
+      (println x))
+    (println x)))
+
+(defn closes [] i32
+  (let [x 1]
+    (let [x 5]
+      (println x))
+    (let [f 0]
+      (app (fn [y] (+ x y)) (+ f 2)))))
+
+(defn loopy [] ()
+  (let [i 0]
+    (while (< i 5)
+      (let [i (* i 100)]
+        (println i))
+      (set i (+ i 1))
+      (when (= i 3) (continue))
+      (println i))))
+
+(defn loopr [] i32
+  (loop [n 0 acc 0]
+    (let [n (* n 2)]
+      (println n))
+    (if (< n 4) (recur (+ n 1) (+ acc n)) acc)))
+
+(defn ret [a i32] i32
+  (let [a (+ a 1)]
+    (println a))
+  (when (> a 3)
+    (let [a 0] (println a))
+    (return a))
+  (let [a (- a 1)] (println a))
+  a)
+
+(defn deferring [] ()
+  (let [x 1]
+    (let [x 2]
+      (defer (println x)))
+    (defer (println x))
+    (println "body")))
+
+(defn destr [] ()
+  (let [p (P {.x 3 .y 4}) x 100]
+    (let [{.x .y} p]
+      (println (+ x y)))
+    (println x)
+    (let [{:keys [x]} p]
+      (println x))
+    (println x)
+    (let [[a b] [x 7]]
+      (println a))
+    (println x)))
+
+(defn dos [c bool] i32
+  (let [v 0]
+    (if c
+      (do (let [v 5] (println v)) (println v))
+      (do (let [v 6] (println v)) (println v)))
+    (unless c (let [v 9] (println v)) (println v))
+    (when c (let [v 8] (println v)) (println v))
+    v))
+
+(defn main [] i32
+  (shadow-chain)
+  (println (closes))
+  (loopy)
+  (println (loopr))
+  (println (ret 5))
+  (println (ret 1))
+  (deferring)
+  (destr)
+  (println (dos true))
+  (println (dos false))
+  0)

test/test_acceptance.ml

@@ -7354,6 +7354,15 @@ level "1"
       (Printf.sprintf "run %s" (Filename.quote nomain)) ~code:1
       ~says:[ "has no main"; "(defn main [] i32" ];
     Sys.remove nomain;
+    (* A program killed by a signal ends [flan run] with the shell's
+       128 + n for it, SIGSEGV's 139 here, not a flat 255. *)
+    let killed = Filename.concat scratch "killed.flan" in
+    Out_channel.with_open_bin killed (fun oc ->
+      output_string oc
+        "(declare-c raise [s i32] i32 \"raise\")\n(defn main [] i32 (raise 11))\n");
+    cli_case "run of a program killed by a signal exits 128 + n"
+      (Printf.sprintf "run %s" (Filename.quote killed)) ~code:139 ~says:[];
+    Sys.remove killed;
 
     (* Every row above that went through the pool has been forked; nothing
        after this point may look at [failures] until every one of them has

test/test_dev.ml

@@ -5832,14 +5832,11 @@ let () =
 
     (* ── What stops a session from starting, said at the start ─────────
 
-       Three things a session cannot start without, each refused before
+       Two things a session cannot start without, each refused before
-       anything is built, in both shapes, with the fix named: a TMPDIR that
+       anything is built, with the fix named: a TMPDIR that does not exist (it
-       does not exist (it was an uncaught ENOENT out of mkdir), one so deep
+       was an uncaught ENOENT out of mkdir), and a program with no main (a
-       that the agent's socket path does not fit in a unix socket address
+       link error, or a sentence about the merged build's internals). A TMPDIR
-       (the bind failed where nobody heard it, and every reply after that
+       too deep for a socket path is not one of them; see the session below. *)
-       said "File name too long" or asked about (agent/start ...)), and a
-       program with no main (a link error, or a sentence about the merged
-       build's internals). *)
     let refused_at_start what ~tmpdir ~prog ~mode want =
       let out = tmp "start-refusal.out" in
       let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
@@ -5870,17 +5867,10 @@ let () =
         want
     in
     let here = Filename.get_temp_dir_name () in
-    let deep =
-      Filename.concat here (String.make (max 1 (110 - String.length here)) 'd')
-    in
-    Unix.mkdir deep 0o700;
     let missing = Filename.concat here "no-such-directory" in
     let nomain = "programs/dev-nomain.flan" in
     List.iter
       (fun mode ->
-         refused_at_start "a TMPDIR too deep for a socket path" ~tmpdir:deep
-           ~prog:"programs/dev-lateagent.flan" ~mode
-           [ "at most 107 bytes"; "TMPDIR=/tmp flan dev" ];
          refused_at_start "a TMPDIR that does not exist" ~tmpdir:missing
            ~prog:"programs/dev-lateagent.flan" ~mode
            [ missing ^ " does not exist"; "TMPDIR=/tmp flan dev" ];
@@ -5890,7 +5880,157 @@ let () =
            refused_at_start "a program with no main" ~tmpdir:here ~prog:nomain
              ~mode [ "has no main"; "(defn main [] i32"; "without --two-process" ])
       [ [||]; [| "--two-process" |] ];
-    (try Unix.rmdir deep with Unix.Unix_error _ -> ());
+
+    (* ── A session under a TMPDIR too deep for a socket path ────────────
+
+       Both sockets are past the 107 bytes a unix socket address holds: the
+       editor's, named with -s, and the agent's, which the daemon puts under
+       TMPDIR. Both are bound and reached through their directory, so the
+       session starts and an evaluation reaches the program, in both shapes.
+       It used to be refused, and before that it failed at the bind. *)
+    let deep =
+      Filename.concat here (String.make (max 1 (110 - String.length here)) 'd')
+    in
+    Unix.mkdir deep 0o700;
+    List.iter
+      (fun mode ->
+         let shape = if mode = [||] then "one process" else "--two-process" in
+         let dsock = Filename.concat deep "editor-socket-for-a-deep-tmpdir.sock"
+         and dout = tmp "deep.out" in
+         let fd =
+           Unix.openfile dout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
+         in
+         let env =
+           Array.append [| "TMPDIR=" ^ deep |]
+             (Array.of_list
+                (List.filter
+                   (fun v -> not (String.starts_with ~prefix:"TMPDIR=" v))
+                   (Array.to_list (Unix.environment ()))))
+         in
+         let pid =
+           Unix.create_process_env flan
+             (Array.append
+                [| flan; "dev"; "programs/dev-pause.flan"; "-s"; dsock |] mode)
+             env Unix.stdin fd fd
+         in
+         Unix.close fd;
+         if not (listening ~pid dsock) then begin
+           fail "a deep TMPDIR (%s): the daemon %s (%S)" shape !listen_why
+             (In_channel.with_open_bin dout In_channel.input_all);
+           (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ())
+         end
+         else begin
+           let c = connect dsock in
+           let said r =
+             Option.value ~default:(status r) (Wire.string_field r "message")
+           in
+           let r =
+             request c
+               "(:op \"eval\" :code \"(defn boom [] i64 7)\" :file \
+                \"programs/dev-pause.flan\")"
+           in
+           if status r <> "ok" then
+             fail "a deep TMPDIR (%s): eval: %s" shape (said r);
+           let answered = ref "" in
+           let seven () =
+             let r =
+               request c
+                 "(:op \"eval-expr\" :code \"(boom)\" :file \
+                  \"programs/dev-pause.flan\")"
+             in
+             answered := Option.value ~default:(said r) (Wire.string_field r "value");
+             !answered = "7"
+           in
+           if not (await ~ms:20000 seven) then
+             fail "a deep TMPDIR (%s): (boom) answered %S" shape !answered;
+           (try
+              ignore (Wire.send c "(:op \"close\")");
+              ignore (Wire.recv c)
+            with _ -> ());
+           (try Unix.close c with Unix.Unix_error _ -> ());
+           (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
+           (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
+         end;
+         (try Sys.remove dout with Sys_error _ -> ()))
+      [ [||]; [| "--two-process" |] ];
+    Own_tmp.remove deep;
+
+    (* ── Prelude functions shadowed live keep the prelude's own calls ──
+
+       [rand] and then [rand-int] redefined in a running program: the
+       prelude's [rand-float-range] still reaches the prelude's [rand], which
+       still reaches the prelude's [rand-int], so it answers something other
+       than what 4096 would make of it. The second shadowing moves a call
+       inside a body the first one had already moved. Both backends. *)
+    List.iter
+      (fun backend ->
+         let ssock = tmp ("shadow" ^ backend ^ ".sock")
+         and sout = tmp ("shadow" ^ backend ^ ".out") in
+         (try Sys.remove ssock with Sys_error _ -> ());
+         let fd =
+           Unix.openfile sout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
+         in
+         let pid =
+           Unix.create_process flan
+             [| flan; "dev"; "programs/dev-pause.flan"; "-s"; ssock; backend |]
+             Unix.stdin fd Unix.stderr
+         in
+         Unix.close fd;
+         if not (listening ~pid ssock) then begin
+           fail "the %s shadowing daemon %s" backend !listen_why;
+           (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ())
+         end
+         else begin
+           let c = connect ssock in
+           let said r =
+             Option.value ~default:(status r) (Wire.string_field r "message")
+           in
+           (try
+              List.iter
+                (fun code ->
+                   let r =
+                     request c
+                       (Printf.sprintf
+                          "(:op \"eval\" :code %S :file \"programs/dev-pause.flan\")"
+                          code)
+                   in
+                   if status r <> "ok" then
+                     fail "%s: %s: %s" backend code (said r))
+                [ "(defn rand [] f64 0.5)"; "(defn rand-int [] u64 4096)" ];
+              let ask code =
+                let r =
+                  request c
+                    (Printf.sprintf
+                       "(:op \"eval-expr\" :code %S :file \"programs/dev-pause.flan\")"
+                       code)
+                in
+                Option.value ~default:(said r) (Wire.string_field r "value")
+              in
+              (match ask "(rand-int)", ask "(rand)" with
+               | "4096", "0.5" -> ()
+               | a, b ->
+                 fail "%s: the shadowing bodies answer %s and %s" backend a b);
+              (* 4096 through the prelude's rand is 2^-52, which is what the
+                 prelude's calls answered when they followed the new body. *)
+              let v = ask "(rand-float-range 0.0 1.0)" in
+              match float_of_string_opt v with
+              | Some x when x > 1e-9 && x < 1.0 -> ()
+              | _ ->
+                fail "%s: the prelude's rand-float-range followed a shadowing \
+                      body: %s" backend v
+            with (Wire.Closed | Unix.Unix_error _) as e ->
+              fail "%s: the shadowing session ended: %s" backend
+                (Printexc.to_string e));
+           (try
+              ignore (Wire.send c "(:op \"close\")");
+              ignore (Wire.recv c)
+            with _ -> ());
+           (try Unix.close c with Unix.Unix_error _ -> ());
+           (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
+           (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
+         end;
+         (try Sys.remove sout with Sys_error _ -> ()))
+      [ "--llvm"; "--x86" ];
 
     (* ── A build that fails is a refusal, not the end of the session ── *)
 
@@ -6241,7 +6381,7 @@ let () =
       let hit_and_run () =
         let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
         (try
-           Unix.connect s (Unix.ADDR_UNIX rsock);
+           Wire.connect_socket s rsock;
            Wire.send s "(:op \"describe\")"
          with Unix.Unix_error _ -> ());
         (try Unix.close s with Unix.Unix_error _ -> ())
@@ -6971,6 +7111,9 @@ let () =
                                        :: _); _ } -> n
           | _ -> ""
         in
+        (* A daemon that goes away mid-question is a failure named here, not
+           a [Wire.Closed] that ends the binary with every later row unrun. *)
+        (try
         if not (await (fun () -> inside () = "in-local")) then
           fail "%s: the program never stopped inside the local's assignment" flag
         else begin
@@ -7009,7 +7152,10 @@ let () =
                   (String.concat ", "
                      (List.map (fun (n, ty, v) -> n ^ " " ^ ty ^ " = " ^ v) got))
           end
-        end;
+        end
+        with (Wire.Closed | Unix.Unix_error _) as e ->
+          fail "%s: the half-write session ended under a question: %s" flag
+            (Printexc.to_string e));
         (* No [close]: the program is stopped with nothing left to resume into,
            so the way out is the abort, and the daemon follows the program. An
            abort is refused by a program that is *running*, which is what a

test/test_emacs.ml

@@ -148,3 +148,69 @@ let () =
       exit 1
     end
   end
+
+(* A socket path longer than a unix socket address holds, which Emacs cannot
+   connect to by name: the daemon links it at a short path, the client
+   computes the same one, and the link goes when the session is closed. *)
+let () =
+  let have = Test_support.have in
+  if have "emacs" && have "clang" && have "llc" then begin
+    let deep =
+      Filename.concat Test_support.scratch
+        (String.make (max 1 (110 - String.length Test_support.scratch)) 'd')
+    in
+    Unix.mkdir deep 0o700;
+    let sock = Filename.concat deep "an-editor-socket-past-the-limit.sock"
+    and err = tmp "long.err" in
+    let efd = Unix.openfile err [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
+    let flan = "../bin/main.exe" in
+    let pid =
+      Unix.create_process flan
+        [| flan; "dev"; "programs/dev-pause.flan"; "-s"; sock |]
+        Unix.stdin efd efd
+    in
+    Unix.close efd;
+    let short = Flan.Wire.short_socket_path sock in
+    let failed = ref false in
+    let fail fmt =
+      Printf.ksprintf (fun s -> failed := true; print_endline ("FAIL  " ^ s)) fmt
+    in
+    if not (listening ~pid sock) then fail "the long-socket daemon %s" !listen_why
+    else begin
+      let code =
+        Sys.command
+          (Printf.sprintf
+             "emacs -Q --batch -L ../../../emacs -l flan --eval %s 2>&1"
+             (Filename.quote
+                (Printf.sprintf
+                   "(progn (flan--open %S) \
+                    (flan--send flan--connection '(:op \"describe\")) \
+                    (let ((r (flan--read-reply flan--connection))) \
+                      (flan--send flan--connection '(:op \"close\")) \
+                      (ignore-errors (flan--read-reply flan--connection)) \
+                      (delete-process flan--connection) \
+                      (kill-emacs (if (equal (plist-get r :status) \"ok\") 0 1))))"
+                   sock)))
+      in
+      if code <> 0 then
+        fail "emacs could not talk to a daemon on a %d-byte socket path \
+              (exit %d; daemon: %s)" (String.length sock) code
+          (In_channel.with_open_bin err In_channel.input_all)
+    end;
+    if not (await ~ms:5000 (fun () ->
+              match Unix.waitpid [ Unix.WNOHANG ] pid with
+              | 0, _ -> false
+              | _ -> true
+              | exception Unix.Unix_error _ -> true))
+    then begin
+      (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
+      (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ());
+      fail "the long-socket daemon did not end when the client left"
+    end
+    else if (try ignore (Unix.lstat short); true with Unix.Unix_error _ -> false)
+    then fail "the short link %s was left after a clean end" short;
+    (try Unix.unlink short with Unix.Unix_error _ -> ());
+    (try Sys.remove err with Sys_error _ -> ());
+    Own_tmp.remove deep;
+    if !failed then exit 1 else print_endline "emacs: a long socket path connects"
+  end

test/test_session.ml

@@ -265,6 +265,78 @@ let () =
   if has c.Session.ir "flan_dev_cell" then
     fail "a name the host has went through the registry";
 
+  (* A defn of a prelude function's name, sent live. The host's prelude calls
+     [rand-int] through the cell the new body goes into, so the prelude's body
+     moves to its own name and its callers are compiled again to call it, as
+     a rebuild would have them. Once: a second redefinition moves nothing. *)
+  (let t, _ = Session.create ~file:"programs/reload.flan" () in
+   let c =
+     Session.eval ~origin:"programs/reload.flan" t "(defn rand-int [] u64 4096)"
+   in
+   List.iter
+     (fun n ->
+        if not (List.mem n c.Session.fns) then
+          fail "shadowing rand-int live did not install %s: %s" n
+            (String.concat " " c.Session.fns))
+     [ "rand-int"; "prelude~/rand-int"; "rand"; "rand-int-range" ];
+   let c =
+     Session.eval ~origin:"programs/reload.flan" t "(defn rand-int [] u64 8)"
+   in
+   if c.Session.fns <> [ "rand-int" ] then
+     fail "redefining a shadowed rand-int again installed %s"
+       (String.concat " " c.Session.fns));
+
+  (* Two shadowings, in either order: the prelude body the first one moved is
+     compiled again when the second moves a call inside it. *)
+  List.iter
+    (fun (first, second, want) ->
+       let t, _ = Session.create ~file:"programs/reload.flan" () in
+       ignore (Session.eval ~origin:"programs/reload.flan" t first);
+       let c = Session.eval ~origin:"programs/reload.flan" t second in
+       List.iter
+         (fun n ->
+            if not (List.mem n c.Session.fns) then
+              fail "shadowing %S after %S did not install %s: %s" second first
+                n (String.concat " " c.Session.fns))
+         want)
+    [ ("(defn rand [] f64 0.5)", "(defn rand-int [] u64 4096)",
+       [ "rand-int"; "prelude~/rand-int"; "prelude~/rand" ]);
+      ("(defn rand-int [] u64 4096)", "(defn rand [] f64 0.5)",
+       [ "rand"; "prelude~/rand" ]) ];
+
+  (* And a mark or a step once the program has a [pause] and a [step-point] of
+     its own: the call spliced in is still the prelude's, or a mark would run
+     the program's function and never stop. *)
+  (let t, _ = Session.create ~file:"programs/reload.flan" () in
+   ignore (Session.eval t "(defn pause [] i64 0)");
+   ignore (Session.eval t "(defn step-point [] bool false)");
+   let calls name want =
+     match
+       List.find_opt (fun (f : Tast.fn) -> f.Tast.name = name)
+         t.Session.program.Tast.fns
+     with
+     | None -> false
+     | Some f ->
+       let hit = ref false in
+       List.iter
+         (Tast.walk (fun (e : Tast.expr) ->
+              match e.Tast.e with
+              | Tast.Call (m, _) when m = want -> hit := true
+              | _ -> ()))
+         f.Tast.body;
+       !hit
+   in
+   ignore
+     (Session.eval ~pause:(1, 1) t
+        "(defn bump [] i64 (set counter (+ counter 5)) counter)");
+   if not (calls "bump" "prelude~/pause") then
+     fail "a mark with the program's own pause defined does not call the prelude's";
+   ignore
+     (Session.eval ~step:true t
+        "(defn bump [] i64 (set counter (+ counter 5)) counter)");
+   if not (calls "bump" "prelude~/step-point") then
+     fail "a step with the program's own step-point defined does not call the prelude's");
+
   (* DWARF in a redefinition module, which is a property of the session and
      not of the call. [Emit.redefinition] has taken a ~debug argument all
      along and was tested with it; what was missing was anyone passing it, so

test/test_support.ml

@@ -89,7 +89,12 @@ let scratch = Own_tmp.dir
    same time under dune, so "flan-agent-dev.sock" and "flan-repl-dev.sock"
    being different files is what keeps two suites from unlinking each other's
    sockets. *)
-let tmp prefix name = Filename.concat scratch (prefix ^ name)
+let tmp prefix name =
+  (* A socket goes without the prefix: [scratch] is this binary's alone, and a
+     unix socket path is short (see [Wire.max_socket_path]), which an emacs
+     client connecting by the plain path cannot get around. *)
+  if Filename.check_suffix name ".sock" then Filename.concat scratch name
+  else Filename.concat scratch (prefix ^ name)
 
 (* ── Toolchain probes ─────────────────────────────────────────────── *)
 
@@ -126,7 +131,7 @@ let rec await ?(ms = 5000) f =
    disk, so the race this does catch is the only one left. *)
 let rec connect ?(ms = 5000) path =
   let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
-  match Unix.connect s (Unix.ADDR_UNIX path) with
+  match Wire.connect_socket s path with
   | () -> s
   | exception Unix.Unix_error (Unix.ECONNREFUSED, _, _) when ms > 0 ->
     Unix.close s;

test/test_syntax.ml

@@ -3,7 +3,7 @@
 
    Four parts. Two programs hand-converted from paren to indented must read to
    the same forms. Every corpus file must survive paren -> printed indented ->
-   read indented unchanged, up to the one merge the spec allows. A table pins
+   read indented unchanged, up to the normalisation the spec allows. A table pins
    the lexical edge cases and the refusals, with their kinds. And a program in
    each syntax importing a package in the other builds and runs the same on
    both backends. *)
@@ -49,23 +49,178 @@ let describe_diff a b =
         (Form.to_string w) w.loc.Loc.line w.loc.Loc.col
     | None -> "equal"
 
-(* A [let] whose whole body is another [let] is the merged [let]: spec §4
+(* Spec §4 step 3's normalisation. Each rule keeps the meaning.
-   step 3's one normalisation. Flan's [let] binds in order, so the two mean
+
-   the same thing. *)
+   First every name a [let] binds is renamed, through its scope, to one
-let rec norm (f : Form.t) : Form.t =
+   numbered in the order the binders come: so two forms that differ only in
+   what their [let]s call things compare equal, and one where a name was
+   captured does not. Then, where statements are a body run in order, a
+   [let] takes in the statements after it (the printer's flat [let]; with
+   every [let] name unique by now, nothing after it can mean one of them). A
+   [(do x)] whose [x] is a [let] is [x], a [let] whose whole body is another
+   [let] is the merged [let], and [(and x)] and [(or x)] are [x]. The flat
+   [let] and the one-argument [and] stop at a quote or quasiquote: data, or
+   a template whose unquotes could name anything. *)
+
+(* A binding target with every struct pattern written as [name .field]
+   pairs: [{.x}] and [{:keys [x]}] are [{x .x}] (Parse.dmap). *)
+let rec pairs_pat (t : Form.t) : Form.t =
+  let dotted s = String.length s > 1 && s.[0] = '.' in
+  let rec items = function
+    | ({ Form.v = Form.Sym s; _ } as f) :: rest when dotted s ->
+      { f with v = Form.Sym (String.sub s 1 (String.length s - 1)) } :: f :: items rest
+    | { Form.v = Form.Kw "keys"; _ } :: { Form.v = Form.Vec ns; _ } :: rest ->
+      List.concat_map
+        (fun (n : Form.t) -> match n.v with
+           | Form.Sym x -> [ n; { n with v = Form.Sym ("." ^ x) } ]
+           | _ -> [ n ])
+        ns
+      @ items rest
+    | pat :: f :: rest -> pairs_pat pat :: f :: items rest
+    | rest -> rest
+  in
+  match t.v with
+  | Form.Vec l -> { t with v = Form.Vec (List.map pairs_pat l) }
+  | Form.Map l -> { t with v = Form.Map (items l) }
+  | _ -> t
+
+(* The names a target so written binds, in order. *)
+let rec binders (t : Form.t) =
+  match t.v with
+  | Form.Sym "&" -> []
+  | Form.Sym s -> [ s ]
+  | Form.Vec l -> List.concat_map binders l
+  | Form.Map l -> List.concat (List.filteri (fun i _ -> i mod 2 = 0) (List.map binders l))
+  | _ -> []
+
+let canon (f : Form.t) : Form.t =
+  let k = ref 0 in
+  let look env s =
+    match List.assoc_opt s env with
+    | Some c -> c
+    | None ->
+      (* [x.y], a field path on a bound [x]. *)
+      match String.index_opt s '.' with
+      | Some i when i > 0 ->
+        (match List.assoc_opt (String.sub s 0 i) env with
+         | Some c -> c ^ String.sub s i (String.length s - i)
+         | None -> s)
+      | _ -> s
+  in
+  let rec go env (f : Form.t) =
     let v =
       match f.v with
-    | Form.List (({ v = Form.Sym "let"; _ } as h) :: { v = Form.Vec bs; loc } :: body) ->
+      | Form.Sym s -> Form.Sym (look env s)
-      (match List.map norm body with
+      (* Quoted data keeps its names: renaming them would hide a printer
-       | [ { v = Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs2; _ } :: body2); _ } ] ->
+         that renamed them too. *)
-         Form.List (h :: Form.make (Form.Vec (List.map norm bs @ bs2)) loc :: body2)
+      | Form.List ({ v = Form.Sym ("quote" | "quasiquote"); _ } :: _) -> f.v
-       | body -> Form.List (h :: Form.make (Form.Vec (List.map norm bs)) loc :: body))
+      | Form.List (({ v = Form.Sym "let"; _ } as h) :: ({ v = Form.Vec bs; _ } as bv) :: body) ->
-    | Form.List l -> Form.List (List.map norm l)
+        let rec binds env acc = function
-    | Form.Vec l -> Form.Vec (List.map norm l)
+          | t :: v :: rest ->
-    | Form.Map l -> Form.Map (List.map norm l)
+            let v' = go env v in
+            let t = pairs_pat t in
+            let env' =
+              List.fold_left (fun e n -> incr k; (n, "%" ^ string_of_int !k) :: e)
+                env (binders t)
+            in
+            binds env' (v' :: go env' t :: acc) rest
+          | rest -> (env, List.rev_append acc (List.map (go env) rest))
+        in
+        let env', bs' = binds env [] bs in
+        Form.List (h :: { bv with v = Form.Vec bs' } :: List.map (go env') body)
+      | Form.List l -> Form.List (List.map (go env) l)
+      | Form.Vec l -> Form.Vec (List.map (go env) l)
+      | Form.Map l -> Form.Map (List.map (go env) l)
       | v -> v
     in
     { f with v }
+  in
+  go [] f
+
+(* The macros of the file being compared ([Body_macros.table]). *)
+let macros : Body_macros.t ref = ref (Body_macros.create ())
+
+(* Where the statements of a body start, for a head whose trailing arguments
+   are a body run in order. *)
+let body_start (l : Form.t list) =
+  let label k = match List.nth_opt l 1 with
+    | Some { Form.v = Form.Kw _; _ } -> k + 1 | _ -> k in
+  match l with
+  | { Form.v = Form.Sym h; _ } :: _ ->
+    (match h with
+     | "do" | "defer" -> Some 1
+     | "let" | "when" | "fn" | "loop" -> Some 2
+     | "while" | "until" | "dotimes" -> Some (label 2)
+     | "defmacro" -> Some 3
+     | "defmethod" -> Some 4
+     | "defn" | "defn-" ->
+       Some (match List.nth_opt l 4 with
+           | Some { Form.v = Form.Map _; _ } -> 5 | _ -> 4)
+     | h ->
+       (match List.assoc_opt h Body_macros.core with
+        | Some k -> Some (k + 1)
+        | None -> Option.map (fun k -> k + 1) (Hashtbl.find_opt !macros.bodies h)))
+  | _ -> None
+
+let is_let (f : Form.t) =
+  match f.v with Form.List ({ v = Form.Sym "let"; _ } :: _) -> true | _ -> false
+
+let rec shape ?(q = false) (f : Form.t) : Form.t =
+  let q = q || (match f.v with
+      | Form.List ({ v = Form.Sym ("quote" | "quasiquote"); _ } :: _) -> true | _ -> false) in
+  let sh = shape ~q in
+  (* A body's statements, each [let] taking in the ones after it. *)
+  let rec stmts = function
+    | [] -> []
+    | x :: (_ :: _ as rest) when not q ->
+      (match (sh x).v with
+       | Form.List (({ v = Form.Sym "let"; _ } as h) :: ({ v = Form.Vec (_ :: _); _ } as bv)
+                    :: (_ :: _ as body)) ->
+         [ sh { x with v = Form.List (h :: bv :: (body @ rest)) } ]
+       | _ -> sh x :: stmts rest)
+    | x :: rest -> sh x :: stmts rest
+  in
+  let seq_list l =
+    match body_start l with
+    | Some k when List.length l > k ->
+      List.map sh (List.filteri (fun i _ -> i < k) l)
+      @ stmts (List.filteri (fun i _ -> i >= k) l)
+    | _ -> List.map sh l
+  in
+  (* Handler and restart clauses: [(name [v] body ...)]. *)
+  let clause (c : Form.t) =
+    match c.v with
+    | Form.List (n :: p :: body) -> { c with v = Form.List (sh n :: sh p :: stmts body) }
+    | _ -> sh c
+  in
+  match f.v with
+  | Form.List [ { v = Form.Sym ("and" | "or"); _ }; x ] when not q -> sh x
+  | _ ->
+    let v =
+      match f.v with
+      | Form.List (({ v = Form.Sym "let"; _ } as h) :: { v = Form.Vec bs; loc } :: body) ->
+        (match stmts body with
+         | [ { v = Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs2; _ } :: body2); _ } ] ->
+           Form.List (h :: Form.make (Form.Vec (List.map sh bs @ bs2)) loc :: body2)
+         | body -> Form.List (h :: Form.make (Form.Vec (List.map sh bs)) loc :: body))
+      | Form.List (({ v = Form.Sym "handler-case"; _ } as h) :: body :: ({ v = Form.Vec cls; _ } as cv) :: more) ->
+        Form.List (h :: sh body :: { cv with v = Form.Vec (List.map clause cls) }
+                   :: List.map sh more)
+      | Form.List (({ v = Form.Sym "handler-bind"; _ } as h) :: ({ v = Form.Vec cls; _ } as cv) :: body) ->
+        Form.List (h :: { cv with v = Form.Vec (List.map clause cls) } :: stmts body)
+      | Form.List (({ v = Form.Sym "restart-case"; _ } as h) :: body :: cls) ->
+        Form.List (h :: sh body :: List.map clause cls)
+      | Form.List l ->
+        (match seq_list l with
+         | [ { v = Form.Sym "do"; _ }; x ] when is_let x -> x.v
+         | l -> Form.List l)
+      | Form.Vec l -> Form.Vec (List.map sh l)
+      | Form.Map l -> Form.Map (List.map sh l)
+      | v -> v
+    in
+    { f with v }
+
+let norm f = shape (canon f)
 
 let diag_text = function
   | Loc.Error d -> Printf.sprintf "%s %d:%d %s" d.Loc.kind d.dloc.Loc.line d.dloc.Loc.col d.dmsg
@@ -76,6 +231,10 @@ let diag_text = function
 let pair flan fln =
   match Reader.read_file flan, Source.read_file fln with
   | a, b ->
+    macros := Body_macros.table ~file:flan a;
+    (* Normalised: a hand conversion writes a let flat where its scope does
+       not matter, as the printer does. *)
+    let a = List.map norm a and b = List.map norm b in
     if not (same_forms a b) then
       fail "%s and %s read differently: %s" flan fln (describe_diff a b)
   | exception e -> fail "%s / %s: %s" flan fln (diag_text e)
@@ -113,13 +272,15 @@ let starts_of (fs : Form.t list) =
   let rec walk (f : Form.t) =
     (* Outermost first among forms starting at one place: [x = v] and its
        [x] start together, and the statement is what a comment is about. *)
-    let t = Form.to_string (norm f) in
+    let t = Form.to_string f in
     out := ((f.loc.Loc.line, f.loc.Loc.col, - String.length t), t) :: !out;
     match f.v with
     | Form.List l | Form.Vec l | Form.Map l -> List.iter walk l
     | _ -> ()
   in
-  List.iter walk fs;
+  (* The normalised forms: a [let] a flat line extended is, on both sides,
+     the one that holds what now follows it. *)
+  List.iter walk (List.map norm fs);
   List.map (fun ((l, c, _), t) -> (l, c, t)) (List.sort compare !out)
 
 let attachments src forms =
@@ -211,7 +372,8 @@ let () =
        | exception Loc.Error _ -> ()   (* not a program the paren reader takes *)
        | forms ->
          let source = In_channel.with_open_bin path In_channel.input_all in
-         match Indent_printer.program ~source forms with
+         macros := Body_macros.table ~file:path forms;
+         match Indent_printer.program ~source ~macros:!macros forms with
          | exception Indent_printer.Unprintable (f, why) ->
            fail "round trip %s: %s at %d:%d" path why f.loc.Loc.line f.loc.Loc.col
          | text ->
@@ -359,7 +521,8 @@ let () =
   (* Statements. *)
   reads "lets merge" "fn f() -> i32\n  let a = 1\n  let b = 2\n  a + b"
     "(defn f [] i32 (let [a 1 b 2] (+ a b)))";
-  reads "let with a block" "let a = 1\n  a\nb" "(let [a 1] a)\nb";
+  refuses "let with a block" "let a = 1\n  a\nb" "indent/let-block" "go at the let's column";
+  reads "flat let" "let a = 1\na\nb" "(let [a 1] a b)";
   reads "elif" "if a\n  1\nelif b\n  2\nelse\n  3" "(cond a 1 b 2 :else 3)";
   reads "one-line if" "x = if a then 1 else 2" "(set x (if a 1 2))";
   reads "assignment ops" "a[i] += 1" "(set (at a i) (+ (at a i) 1))";
@@ -421,6 +584,8 @@ let () =
   reads "one-line quote" "defmacro(m, [x]):\n  quote ~x + 1"
     "(defmacro m [x] (quasiquote (+ (unquote x) 1)))";
   reads "typed let" "let x: i32 = 5\nx" "(let [x (the i32 5)] x)";
+  refuses "a let takes no block" "fn f() -> ()\n  let x = 1\n    g(x)\n  h(x)"
+    "indent/let-block" "go at the let's column";
   (* And back: the printer writes the idioms. *)
   let prints name src want =
     match Reader.read_all ~file:"<p>" src with
@@ -440,6 +605,101 @@ let () =
   prints "a statement argument makes a block" "(foo 1 (set x 2))" "foo(1):\n  x = 2";
   prints "no arguments before the block" "(comment (f))" "comment:\n  f()";
   prints "typed let" "(defn f [] i32 (let [x (the i32 5)] x))" "let x: i32 = 5";
+  (* A let is always flat: it takes in the rest of its block. *)
+  prints "flat let" "(defn f [] () (let [j 1] (g j)) (h))" "  let j = 1\n  g(j)\n  h()";
+  prints "a chain of lets, all flat" "(defn f [] () (let [a 1] (let [b 2] (g b)) (k a)) (h))"
+    "  let a = 1\n  let b = 2\n  g(b)\n  k(a)\n  h()";
+  (* A later statement that means an outer name of the same spelling: the
+     let's own is renamed. *)
+  prints "a later outer name of the same spelling renames the let's"
+    "(defn f [x i32] () (let [x 1] (g x)) (h x))" "  let x-2 = 1\n  g(x-2)\n  h(x)";
+  prints "the inner let of a chain renamed"
+    "(defn f [] () (let [a 1] (let [b 2] (g b)) (h b)))" "  let a = 1\n  let b-2 = 2\n  g(b-2)\n  h(b)";
+  prints "the binding's own value keeps the outer name"
+    "(defn f [x i32] () (let [x (+ x 1)] (g x)) (h x))" "  let x-2 = x + 1\n  g(x-2)\n  h(x)";
+  prints "a later binding's value takes the new name"
+    "(defn f [x i32] () (let [x 1 y (+ x 1)] (g y)) (h x))"
+    "  let x-2 = 1\n  let y = x-2 + 1\n  g(y)\n  h(x)";
+  prints "the new name is one the function does not use"
+    "(defn f [x i32] () (let [x 1] (g x x-2)) (h x))" "  let x-3 = 1\n  g(x-3, x-2)\n  h(x)";
+  prints "a later let of the same name is no mention"
+    "(defn f [] () (let [a 1] (g a)) (let [a 2] (k a)))" "  let a = 1\n  g(a)\n  let a = 2\n  k(a)";
+  prints "unless its value uses the name"
+    "(defn f [a i32] () (let [a 1] (g a)) (let [a (+ a 1)] (k a)))"
+    "  let a-2 = 1\n  g(a-2)\n  let a = a + 1\n  k(a)";
+  prints "a destructured name renamed alone" "(defn f [] () (let [[p q] v] (g p q)) (h q))"
+    "  let [p q-2] = v\n  g(p, q-2)\n  h(q)";
+  prints "a qualified name counts" "(defn f [] () (let [p (pt)] (g p)) (h p/x))"
+    "  let p-2 = pt()\n  g(p-2)\n  h(p/x)";
+  prints "a quoted name later counts" "(defn f [] () (let [a 1] (g a)) (h 'a))"
+    "  let a-2 = 1\n  g(a-2)\n  h('a)";
+  (* Where a rename cannot be trusted, a do: block holds the let. *)
+  prints "a quoted name inside is not renamed" "(defn f [] () (let [a 1] (g 'a)) (h a))"
+    "  do:\n    let a = 1\n    g('a)\n  h(a)";
+  prints "a call of the name inside is not renamed" "(defn f [] () (let [len 1] (len v)) (h len))"
+    "  do:\n    let len = 1\n    len(v)\n  h(len)";
+  (* A struct pattern renames as pairs, so the field keeps its name. *)
+  prints "a struct pattern renamed"
+    "(defn f [x i32] () (let [{.x .y} p] (g x y)) (h x))" "  let {x-2 .x y .y} = p\n  g(x-2, y)\n  h(x)";
+  prints "a :keys pattern renamed"
+    "(defn f [x i32] () (let [{:keys [x y]} p] (g x y)) (h x))" "  let {x-2 .x y .y} = p\n  g(x-2, y)\n  h(x)";
+  prints "a struct pattern that binds none of them stays"
+    "(defn f [x i32] () (let [{.y .z} p] (g y)) (h x))" "  let {.y .z} = p\n  g(y)\n  h(x)";
+  prints "a later struct pattern rebinding the name is no mention"
+    "(defn f [] () (let [x 1] (g x)) (let [{.x} p] (k x)))" "  let x = 1\n  g(x)\n  let {.x} = p\n  k(x)";
+  prints "a struct literal inside is renamed"
+    "(defn f [x i32] () (let [x 1] (g (P {.x x}))) (h x))" "  let x-2 = 1\n  g(P{.x x-2})\n  h(x)";
+  (* A macro whose body its definition splices into a do is a body run in
+     order; one that splices it anywhere else is not. *)
+  prints "a macro's in-order body"
+    "(defmacro twice [n & body] `(do ~@body ~@body))\n(defn f [] () (twice 2 (let [a 1] (g a)) (h)))"
+    "  twice(2):\n    let a = 1\n    g(a)\n    h()";
+  prints "a macro's list of arguments"
+    "(defmacro listed [& xs] `(list ~@xs))\n(defn f [] () (listed (let [a 1] (g a)) (set x 2)))"
+    "  listed:\n    do:\n      let a = 1\n      g(a)\n    x = 2";
+  prints "comment is a body in order" "(comment (let [a 1] (g a)) (h))" "comment:\n  let a = 1\n  g(a)\n  h()";
+  prints "a later lambda keeps the outer name"
+    "(defn f [] i32 (let [x 1] (let [x 5] (g x)) (app (fn [y] (+ x y)) 2)))"
+    "  let x = 1\n  let x-2 = 5\n  g(x-2)\n  app(fn(y) = x + y, 2)";
+  prints "a renamed name renamed again counts on"
+    "(defn f [] () (let [x 1] (let [x 2] (let [x 3] (g x)) (g x)) (g x)))"
+    "  let x = 1\n  let x-2 = 2\n  let x-3 = 3\n  g(x-3)\n  g(x-2)\n  g(x)";
+  prints "a macro that names the let's name keeps its scope"
+    "(defmacro show-it [] `(println it))\n(defn f [] () (let [it 1] (let [it 2] (show-it)) (show-it)))"
+    "  let it = 1\n  do:\n    let it = 2\n    show-it()\n  show-it()";
+  (* Which macros take a body run in order, read off their definitions. *)
+  let body name src want =
+    let t = Body_macros.table (Reader.read_all ~file:"<m>" src) in
+    let got = Hashtbl.find_opt t.Body_macros.bodies name in
+    if got <> want then
+      fail "%s: body at %s, wanted %s" name
+        (match got with Some k -> string_of_int k | None -> "none")
+        (match want with Some k -> string_of_int k | None -> "none")
+  in
+  body "twice" "(defmacro twice [n & b] `(do ~@b ~@b))" (Some 1);
+  body "tail" "(defmacro tail [& a] `(let [x ~(at a 0)] ~@(form-rest a 1)))" (Some 1);
+  body "nested" "(defmacro inner [& b] `(do ~@b))\n(defmacro nested [& b] `(inner ~@b))" (Some 0);
+  body "listed" "(defmacro listed [& b] `(list ~@b))" None;
+  body "vtwice" "(defmacro vtwice [& b] `(do ~@b (println (length [~@b]))))" None;
+  body "counted" "(defmacro counted [& b] (let [n (length b)] `(do ~n ~@b)))" None;
+  body "counts" "(defmacro counts [& b] (if (= (length b) 2) `(do) `(do ~@b)))" None;
+  body "guarded" "(defmacro guarded [& b] (if (< (length b) 1) `(do) `(do ~@b)))" (Some 0);
+  body "labelled" "(defmacro labelled [& b] `(while :l ~@b))" None;
+  body "labelled-test" "(defmacro labelled-test [& b] `(while :l true ~@b))" (Some 0);
+  body "reads-body" "(defmacro reads-body [& b] `(do ~(at b 0) ~@b))" None;
+  body "unless" "" (Some 1);
+  body "comment" "" (Some 0);
+  body "with-drawing"
+    "(defmacro with-drawing [& args]\n  (if (or (< (length args) 1) (and (= (length args) 1) (form-empty-list? (at args 0))))\n    `(takes-a-body)\n    `(do (begin) ~@args (end))))"
+    (Some 0);
+  prints "in a quasiquote" "(defmacro m [x] (quasiquote (do (let [a 1] (g a)) (h ~x))))"
+    "  do:\n      let a = 1\n      g(a)\n    h(~x)";
+  prints "among a call's arguments" "(foo 1 (let [a 1] (g a)) (set x 2))"
+    "foo(1):\n  do:\n    let a = 1\n    g(a)\n  x = 2";
+  prints "at the top level" "(let [a 1] (g a))\n(h)" "do:\n  let a = 1\n  g(a)\n\nh()";
+  prints "one-argument and" "(defn f [] () (while (and (< i n)) (g)))" "  while i < n\n";
+  prints "one-argument or" "(defn f [] () (when (or c) (g)))" "  if c\n";
+  prints "one-argument and in a quasiquote" "(defmacro m [x] (quasiquote (and ~x)))" "and(~x)";
   prints "do in an arm is a block" "(defn f [] () (match s _ (do (a) (b))))" "_ ->\n      a()";
   prints "hex spelling" "(def c dyn 0xFFF00FFF)" "0xFFF00FFF";
   prints "own-line comment above its form" "(defn f [] ()\n  ;; why\n  (g))" "  ;; why\n  g()";
@@ -685,8 +945,41 @@ let run_both path want =
              (if x86 then " --x86" else "") text code want)
     [ false; true ]
 
+(* A program and its conversion print the same: the flat lets, the renames
+   and the macro bodies they rest on keep what each name means. *)
+let run_converted path =
+  let run p =
+    let exe = Filename.concat scratch
+        (Printf.sprintf "flan-flat-%s-%d" (Filename.basename p) (Unix.getpid ())) in
+    let prog, csrcs, lflags = Test_support.linked p in
+    ignore (Build.executable ~opts:Build.default ~csrcs ~lflags prog ~out:exe);
+    let out = exe ^ ".out" in
+    let code = Sys.command (Filename.quote exe ^ " > " ^ Filename.quote out ^ " 2>&1") in
+    let text = In_channel.with_open_bin out In_channel.input_all in
+    (try Sys.remove out; Sys.remove exe with Sys_error _ -> ());
+    (code, text)
+  in
+  match
+    let forms = Reader.read_file path in
+    let source = In_channel.with_open_bin path In_channel.input_all in
+    let macros = Body_macros.table ~file:path forms in
+    let fln = Filename.concat scratch
+        (Printf.sprintf "%d-%s.fln" (Unix.getpid ()) (Filename.remove_extension (Filename.basename path))) in
+    Out_channel.with_open_bin fln (fun oc ->
+        output_string oc (Indent_printer.program ~source ~macros forms));
+    let a = run path and b = run fln in
+    (try Sys.remove fln with Sys_error _ -> ());
+    (a, b)
+  with
+  | exception e -> fail "%s converted: %s" path (diag_text e)
+  | ((0, a), (0, b)) when a = b -> ()
+  | ((c, a), (d, b)) ->
+    fail "%s printed %S (exit %d), and converted %S (exit %d)" path a c b d
+
 let () =
   if Test_support.have "clang" then begin
+    List.iter run_converted
+      [ "syntax/flat/shadows.flan"; "syntax/flat/macros.flan"; "syntax/flat/capture.flan" ];
     run_both "syntax/mixed/main.flan" "12\n12\n0\n55\n";
     run_both "syntax/mixed/main.fln" "25\n7\nfar\n3\n";
     (* Return types read off the body, in both spellings of [_]. *)

vendor/agent/flan_agent.c

@@ -43,6 +43,7 @@
 #endif
 #include <dlfcn.h>
 #include <errno.h>
+#include <fcntl.h>
 #include <stdlib.h>
 #include <pthread.h>
 #include <setjmp.h>
@@ -1015,6 +1016,10 @@ int32_t flan_agent_poll(void);
  * came from. */
 static char bound_sock[sizeof(((struct sockaddr_un *)0)->sun_path)];
 
+/* The directory a socket path too long for sun_path was bound through, or -1;
+ * see [start_on]. */
+static int sock_dir_fd = -1;
+
 /* A socket file outlives the process that bound it, and a stale one answers
  * the next client with ECONNREFUSED — which reads like a program that is there
  * and refusing rather than one that has gone. So the bind registers its own
@@ -2732,10 +2737,32 @@ static int32_t start_on(const char *path) {
   int made = 0;
   if (atomic_exchange(&started, 1)) return 1;
   len = strlen(path);
-  if (len == 0 || len >= sizeof addr.sun_path) goto failed;
+  if (len == 0) goto failed;
   memset(&addr, 0, sizeof addr);
   addr.sun_family = AF_UNIX;
+  if (len < sizeof addr.sun_path) {
     memcpy(addr.sun_path, path, len);
+  } else {
+    /* Too long for sun_path: bound through its directory, opened and named
+     * as /proc/self/fd/N/, which Linux resolves like the path itself. The
+     * descriptor stays open for the life of the process, because the unlinks
+     * at exit go through the same name. */
+    const char *slash = strrchr(path, '/');
+    char dir[4096];
+    int n;
+    size_t dlen = slash == NULL ? 0 : (size_t)(slash - path);
+    if (slash == NULL || dlen >= sizeof dir) goto failed;
+    memcpy(dir, path, dlen);
+    dir[dlen] = '\0';
+    if (sock_dir_fd < 0)
+      sock_dir_fd = open(dlen == 0 ? "/" : dir,
+                         O_RDONLY | O_DIRECTORY | O_CLOEXEC);
+    if (sock_dir_fd < 0) goto failed;
+    n = snprintf(addr.sun_path, sizeof addr.sun_path, "/proc/self/fd/%d/%s",
+                 sock_dir_fd, slash + 1);
+    if (n < 0 || (size_t)n >= sizeof addr.sun_path) goto failed;
+    len = (size_t)n;
+  }
   unlink(addr.sun_path);
   fd = socket(AF_UNIX, SOCK_STREAM, 0);
   if (fd < 0) goto failed;
@@ -2814,7 +2841,7 @@ static const char *daemon_socket(void) {
  * and guessing wrong fails silently: everything compiles, the module is built,
  * and nothing ever receives it. */
 int32_t flan_agent_start(const uint8_t *path, int64_t len) {
-  char buf[sizeof(((struct sockaddr_un *)0)->sun_path)];
+  char buf[4096];
   const char *env = daemon_socket();
   if (env != NULL) return start_on(env) < 0 ? -1 : 0;
   if (len <= 0 || (size_t)len >= sizeof buf) return -1;