From 83bb65957d24241386558f002a232c8bfa22a395 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:59:59 +0700 Subject: [PATCH] Each name an as binds is a slot of its own under its name, so the break loop's locals show it with what the test found. --- lib/check.ml | 66 +++++++++++++++++++++++--------------- test/programs/dev-as.fln | 26 +++++++++++++++ test/test_dev.ml | 69 ++++++++++++++++++++++++++++++++++++++++ test/test_session.ml | 10 +++--- 4 files changed, 141 insertions(+), 30 deletions(-) create mode 100644 test/programs/dev-as.fln diff --git a/lib/check.ml b/lib/check.ml index 17c04445..b69a6d3e 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3184,12 +3184,8 @@ let unnarrowable_in (body : Ast.expr list) = List.iter (walk ~in_fn:false) body; !out -(* A name an [as] bound to what an Option held: the slot holding the Option, - read as its payload, as a narrowed local is, but not assignable. *) -let as_tag = "~as" - let local_of loc (b : binding) = - if b.bwhat = Some narrowed_tag || b.bwhat = Some as_tag then + if b.bwhat = Some narrowed_tag then mk loc b.bty (Tast.Field (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1)) else mk loc b.bty (Tast.Local b.slot) @@ -10797,8 +10793,8 @@ and as_name g = Ast.as_name g (* A condition with [as] in it, as the bool it tests, and each name it binds with the hidden name the block reads it through. The chain runs left to right and stops at the first test that fails, so each value is found - once. What an [as] tests is held in one slot, and its name reads that - slot: the payload of an Option held there, or the dyn itself. *) + once. Each name an [as] binds is one slot, read by the rest of the chain + and, through [Ast.Alias], by the block. *) and as_cond ctx (c : Ast.expr) = let named = ref [] in let no loc = mk loc Types.Bool (Tast.Bool false) in @@ -10820,26 +10816,44 @@ and as_cond ctx (c : Ast.expr) = | Ast.IfLet (e, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ }, Some { Ast.e = Ast.Var "false"; _ }) when as_name g -> let ev = check ctx e in - let hs = fresh_slot ctx ev.Tast.ty in - let hv = mk loc ev.Tast.ty (Tast.Local hs) in - let test, what, ty = - match ev.Tast.ty with - | Types.Option t -> (opt_is_some loc hv, Some as_tag, t) - | Types.Dyn -> (dyn_not_nil loc hv, None, Types.Dyn) - | t -> - Loc.failk "check/as-not-optional" e.Ast.loc - "%s is %s, which always holds a value, so as has nothing to test. \ - as names what an Option or a dyn holds, when it holds something. \ - It is not a conversion: a number is converted with its type's \ - name, as in i32(x)" - (source_text e) (tyname loc t) + let refuse t = + Loc.failk "check/as-not-optional" e.Ast.loc + "%s is %s, which always holds a value, so as has nothing to test. \ + as names what an Option or a dyn holds, when it holds something. \ + It is not a conversion: a number is converted with its type's \ + name, as in i32(x)" + (source_text e) (tyname loc t) in - let b = { slot = hs; bty = ty; assignable = false; bwhat = what; blit = None } in - incr held_n; - named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named; - let qv = scoped ctx (fun () -> ctx.scope <- (g, b) :: ctx.scope; go q) in - mk loc Types.Bool - (Tast.Let ([ (hs, ev) ], [ mk loc Types.Bool (Tast.If (test, qv, no loc)) ])) + (* [g] is a slot of its own under its own name, so locals, the stepper, + the inspector and the watch view show it as the program reads it. A + dyn is held there directly; an Option is held in a hidden slot and + its payload copied into [g]'s once the test holds. *) + let bound ty = + scoped ctx (fun () -> + let slot = bind ctx g ty ~assignable:false in + let b = Option.get (lookup ctx g) in + incr held_n; + named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named; + (slot, go q)) + in + (match ev.Tast.ty with + | Types.Option t -> + let hs = fresh_slot ctx ev.Tast.ty in + let hv = mk loc ev.Tast.ty (Tast.Local hs) in + let slot, qv = bound t in + mk loc Types.Bool + (Tast.Let ([ (hs, ev) ], + [ mk loc Types.Bool + (Tast.If (opt_is_some loc hv, + mk loc Types.Bool + (Tast.Let ([ (slot, opt_payload loc t hv) ], [ qv ])), + no loc)) ])) + | Types.Dyn -> + let slot, qv = bound Types.Dyn in + let sv = mk loc Types.Dyn (Tast.Local slot) in + mk loc Types.Bool + (Tast.Let ([ (slot, ev) ], [ mk loc Types.Bool (Tast.If (dyn_not_nil loc sv, qv, no loc)) ])) + | t -> refuse t) | _ -> check_truthy ctx c in let cv = go c in diff --git a/test/programs/dev-as.fln b/test/programs/dev-as.fln new file mode 100644 index 00000000..ebd78c8a --- /dev/null +++ b/test/programs/dev-as.fln @@ -0,0 +1,26 @@ +;; A program that stops inside an if o as g block (decision 136): the break +;; loop's locals list g, with the value the test found, on both backends. +import agent "vendor:agent" + +struct Boom + why: i32 + +let ticks: i64 = 0 + +fn look(o: i32?, d) -> i64 + if o as g and g > 1 and d as e + restart-case + error(Boom{.why g}) + 0 + restart carry-on() + 5 + else + 0 + +fn main() -> i32 + agent/start("/tmp/flan-dev-as-fallback.sock") + println(look(Some(41), "hi")) + for i in range(4000) + agent/wait(5) + ticks += 1 + 0 diff --git a/test/test_dev.ml b/test/test_dev.ml index e7940991..31bff637 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -2483,6 +2483,75 @@ let () = null_park "--llvm"; null_park "--x86"; + (* A stop inside an [if o as g and ... and d as e] block (decision 136): + each name an [as] binds is a slot of its own under its name, so the + locals list it with what the test found. *) + let as_locals backend = + let asock = tmp ("as" ^ backend ^ ".sock") and aout = tmp ("as" ^ backend ^ ".out") in + (try Sys.remove asock with Sys_error _ -> ()); + let afd = Unix.openfile aout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let apid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-as.fln"; "-s"; asock; backend |] + Unix.stdin afd Unix.stderr + in + Unix.close afd; + if not (listening ~pid:apid asock) then begin + fail "the as daemon (%s) %s" backend !listen_why; + (try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect asock in + let ask sexp = Wire.parse (Wire.send c sexp; Wire.recv c) in + let stopped r = + match Wire.field r "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "the as program never stopped (%s)" backend + else begin + let r = ask "(:op \"locals\" :frame 0)" in + let rows = + match Wire.field r "locals" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (e : Form.t) -> + match e.Form.v with + | Form.List ({ Form.v = Form.Str n; _ } :: { Form.v = Form.Str ty; _ } + :: { Form.v = Form.Str v; _ } :: _) -> Some (n, (ty, v)) + | _ -> None) + l + | _ -> [] + in + (match List.assoc_opt "g" rows with + | Some ("i32", "41") -> () + | Some (ty, v) -> fail "locals show g as %s %s (%s)" ty v backend + | None -> + fail "locals do not show g (%s): %s" backend + (String.concat " " (List.map fst rows))); + (match List.assoc_opt "e" rows with + | Some ("dyn", v) when Test_support.contains v "hi" -> () + | Some (ty, v) -> fail "locals show e as %s %s (%s)" ty v backend + | None -> fail "locals do not show e (%s)" backend) + end; + ignore (ask "(:op \"close\")"); + Unix.close c; + if not + (await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] apid with + | 0, _ -> false + | _ -> true + | exception Unix.Unix_error _ -> true)) + then begin + (try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] apid) with Unix.Unix_error _ -> ()) + end + end + in + as_locals "--llvm"; + as_locals "--x86"; + (* ── The locals of a stopped frame ─────────────────────────────── *) (* A third daemon, over a program that stops with something worth looking diff --git a/test/test_session.ml b/test/test_session.ml index 463038eb..6df9c9d2 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -2072,9 +2072,9 @@ let () = (match Session.eval ~pause:(1, col) t paren with | _ -> () | exception Loc.Error d -> fail "a mark at (and: %s" d.Loc.dmsg); - (* What an as finds is held once, and its name reads that slot: one - binding in the function, where a copy into g's own slot and another - into the block's would be three. *) + (* What an as finds is copied once, into g's own named slot, which the + rest of the chain and the block read: two bindings, the Option held + and g, where another copy into the block's would be three. *) ignore (Source.with_code ~syntax:Source.Indented ~at:None (fun () -> Session.eval ~origin:"copies.fln" t @@ -2089,6 +2089,8 @@ let () = (Tast.walk (fun (e : Tast.expr) -> match e.Tast.e with Tast.Let (bs, _) -> n := !n + List.length bs | _ -> ())) f.Tast.body; - if !n <> 1 then fail "if o? as g binds %d slots, wanted 1" !n); + if !n <> 2 then fail "if o? as g binds %d slots, wanted 2" !n; + if not (Array.exists (fun x -> x = Some "g") f.Tast.snames) then + fail "if o? as g has no slot named g"); Test_support.report ~label:"session" ()