From f39612bc7c0709d789c0f4ed1338bf65ed7dae2d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:21:07 +0700 Subject: [PATCH] Code a request sends without :syntax is read in its file's syntax, or the program's when it names none, and a dotted dyn name points to its accessor. --- lib/check.ml | 9 +++ lib/dev.ml | 17 ++++-- spec-syntax.md | 8 ++- test/programs/dev-fln-dyn.fln | 26 +++++++++ test/test_dev.ml | 105 ++++++++++++++++++++++++++++++---- test/test_flan.ml | 6 ++ 6 files changed, 154 insertions(+), 17 deletions(-) create mode 100644 test/programs/dev-fln-dyn.fln diff --git a/lib/check.ml b/lib/check.ml index 73ebfae8..8edfa59f 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -9529,6 +9529,15 @@ and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a = else Loc.failk "check/dot-access" loc ~notes "unknown name %s — %s, and %s has no field %s" name how sn field + | None, Some Types.Dyn -> + let how = + if setting then Printf.sprintf "(set (.%s %s) ...)" field head + else Printf.sprintf "(.%s %s)" field head + in + Loc.failk "check/dot-access" loc + "unknown name %s — a dot is part of the name here, not field access. \ + %s is dyn, and its :%s is reached with %s" + name head field how | None, Some t -> Loc.failk "check/dot-access" loc "unknown name %s — a dot is part of the name here, not field access. \ diff --git a/lib/dev.ml b/lib/dev.ml index 7bf0d8d6..4f078e5f 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -4590,10 +4590,19 @@ let rec handle t req = match Wire.string_field req "syntax", Wire.string_field req "op", Wire.string_field req "file" with | (Some _ as s), _, _ -> Source.syntax_of_field s - (* A whole file named with no [:syntax] is in the syntax its name says: - that is not a guess, it is what [Source.read_file] would do. *) - | None, Some "load-file", Some f when Source.is_indented f -> Source.Indented - | None, _, _ -> Source.Paren + (* With no [:syntax], a file named is in the syntax its name says — what + [Source.read_file] would do — for every op, so code sent from a .fln + buffer by a client that left the field out is not read as parens. A + paren expansion sent back under a .fln name says [:syntax "paren"]. *) + | None, _, Some f when Source.is_source f -> + if Source.is_indented f then Source.Indented else Source.Paren + (* A pseudo-name — "", "", whose text is built in parens — + is paren. No file at all is the program's own syntax: evaluating in a + stopped frame names none, and its code is written as the program is. *) + | None, _, Some _ -> Source.Paren + | None, _, None -> + if Source.is_indented t.session.Session.file then Source.Indented + else Source.Paren in let at = match Wire.int_field req "line", Wire.int_field req "col" with diff --git a/spec-syntax.md b/spec-syntax.md index 0f1f0381..887b4fe6 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -462,9 +462,11 @@ Each step lands on its own, with `dune test --root .` green. space-padding in `flan--text-at` (`emacs/flan.el:2602-2622`), which breaks significant indentation, with `:line`/`:col` fields; the reader seeds its indent stack with that column. **Built** (also `load-file` and restart - arguments; no `:syntax` means paren, except a `load-file` of a `.fln` - file; several indented statements sent as one expression read as - `(do …)`). + arguments; with no `:syntax` a request is read in the syntax of the + source `:file` it names, as paren under a pseudo-name such as ``, + and with no `:file` at all in the program's — so + evaluating in a stopped frame of a `.fln` program reads indented; + several indented statements sent as one expression read as `(do …)`). 5. **Emacs mode** for `.fln`: - A top-level form runs from a column-0 line that isn't `else`, `elif`, `on` or `restart` to just before the next one, minus trailing blank and diff --git a/test/programs/dev-fln-dyn.fln b/test/programs/dev-fln-dyn.fln new file mode 100644 index 00000000..aa66939b --- /dev/null +++ b/test/programs/dev-fln-dyn.fln @@ -0,0 +1,26 @@ +;; A dyn class instance in a .fln program, for code evaluated from its buffer: +;; eval-expr reads the request's syntax, at a stop as well as at a park. +import agent "vendor:agent" + +defclass(State, [paused bool step bool]) + +once state = State(false, false) +once go = false + +struct Missing(id: i32) + +fn boom() -> i64 + restart-case + error(Missing{.id 1}) + 0 + restart carry-on() + -1 + +fn main() -> i32 + agent/start("/tmp/flan-dev-fln-dyn-fallback.sock") + for i in range(4000) + agent/wait(5) + if go + go = false + boom() + 0 diff --git a/test/test_dev.ml b/test/test_dev.ml index c97466da..be21fb4e 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -7283,6 +7283,78 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ xsock2; xout2; msock; mout ]; + (* ── Code from a .fln program, with no :syntax ────────────────────── + A request that leaves :syntax out is read in the syntax of the file it + names, and with no file — evaluating in a stopped frame names none — + in the program's. So a dyn instance's dot assignment evaluates from a + .fln buffer at a park and in the program's own stopped frame. *) + List.iter + (fun backend -> + let fsock = tmp ("flndyn" ^ backend ^ ".sock") + and fout = tmp ("flndyn" ^ backend ^ ".out") in + (try Sys.remove fsock with Sys_error _ -> ()); + let ffd = + Unix.openfile fout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let fpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-fln-dyn.fln"; "-s"; fsock; + "--" ^ backend |] + Unix.stdin ffd Unix.stderr + in + Unix.close ffd; + if not (listening ~pid:fpid fsock) then begin + fail "the .fln dyn daemon (--%s) %s" backend !listen_why; + (try Unix.kill fpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect fsock in + let ask ?frame code = + request c + (match frame with + | Some n -> + Printf.sprintf "(:op \"eval-expr\" :frame %d :code %s)" n + (Wire.quote code) + | None -> + Printf.sprintf + "(:op \"eval-expr\" :code %s :file \"programs/dev-fln-dyn.fln\")" + (Wire.quote code)) + in + let answer r = + match Wire.string_field r "value" with + | Some v -> v + | None -> Option.value ~default:(status r) (Wire.string_field r "message") + in + let is ?frame what code want = + let a = answer (ask ?frame code) in + if a <> want then fail "--%s: %s answered %S, not %S" backend what a want + in + if not (await ~ms:20000 (fun () -> status (ask "1") = "ok")) then + fail "--%s: the .fln dyn program never took an expression" backend + else begin + is "a dot assignment from a .fln file" "state.paused = not(state.paused)" "()"; + is "and a dot read" "state.paused" "true"; + ignore (ask "go = true"); + let stopped () = + match Wire.field (request c "(:op \"describe\")") "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + if not (await ~ms:20000 stopped) then + fail "--%s: the .fln dyn program did not stop in boom" backend + else begin + is ~frame:0 "a dot assignment in a stopped frame" + "state.paused = not(state.paused)" "()"; + is ~frame:0 "and a dot read there" "state.paused" "false" + end + end; + (try Unix.close c with Unix.Unix_error _ -> ()); + (try Unix.kill fpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] fpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ fsock; fout ]) + [ "x86"; "llvm" ]; + (* ── The dyn globals a park holds ─────────────────────────────────── *) (* The banner a finished run prints says the globals are as it left them, @@ -9382,16 +9454,9 @@ let () = "(if (= (type-of (at instances 1)) :point) 1 0)"; holds "and a kind for anything that is not an instance" "(if (= (type-of (get (at instances 1) :w)) :nil) 1 0)" - end; - - (* ── A definition that did not change ── - Every C-c C-k re-runs a file's class definitions, and re-running - an unchanged one has to leave its instances' values alone. *) - let r = redefine "(defclass point [x z w])" in - if status r <> "ok" then fail "re-evaluating an unchanged class: %s" (said r) - else - holds "an unchanged definition keeps the values" - "(if (= (get (at instances 1) :x) 5) 1 0)" + end + (* A definition that did not change migrates nothing: the hook block + below asks that with a method that would mark the instance. *) end; (try Unix.close c with Unix.Unix_error _ -> ()); (try Unix.kill mpid Sys.sigkill with Unix.Unix_error _ -> ()); @@ -9623,6 +9688,26 @@ let () = if not (await warned) then fail "%sno warning for a kept value that does not fit: %S" what (output ()) + end; + (* ── A definition that did not change ── + Every C-c C-k re-runs a file's class definitions, and one that + bumped the generation per registration rather than per change + would migrate every instance on every save. A method that marks + the instance says whether a migration ran: not for the same + definition again, and once for a changed one. *) + if defined "a method that marks the instance" + "(defmethod update-instance-for-redefined-class point \ + [p added discarded] (set (get p :radius) 777) nil)" + && defined "the same definition again" + "(defclass point [x str radius z n i32 note str])" + then begin + holds "an unchanged definition migrates nothing" + "(if (= (get (at instances 0) :radius) 4) 1 0)"; + if defined "a changed definition after it" + "(defclass point [x str radius z n i32 note str w])" + then + holds "a changed one runs the method" + "(if (= (get (at instances 0) :radius) 777) 1 0)" end end; (try Unix.close c with Unix.Unix_error _ -> ()); diff --git a/test/test_flan.ml b/test/test_flan.ml index 1f3d72cb..7bd14bb5 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2888,6 +2888,12 @@ let () = "(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (set (.x p) 2) (.x p)))"; rejects_check "a dotted head that is not a struct says what it is" "(defn f [] i32 (let [n 1] n.x))" ~needle:"n is i32, which has no fields"; + rejects_check "a dotted dyn head points to the accessor" + "(defn f [] i32 (let [s {:p 1}] (println s.p) 0))" + ~needle:"s is dyn, and its :p is reached with (.p s)"; + rejects_check "and to the place in a set" + "(defn f [] i32 (let [s {:p 1}] (set s.p 2) 0))" + ~needle:"s is dyn, and its :p is reached with (set (.p s) ...)"; (* The fourth shape: nothing is bound under the head either, so the message claims nothing about what q is — only that the dot is not the operator the writer took it for. *)