JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 17:59:59 +07:00
parent 09ffc27883
commit 83bb65957d
4 changed files with 141 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
lib/check.ml
View File

@ -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

26
test/programs/dev-as.fln Normal file
View File

@ -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

69
test/test_dev.ml
View File

@ -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

10
test/test_session.ml
View File

@ -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" ()