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

A mark or a step spliced into a program that defines its own pause or step-point calls the prelude's

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 22:34:28 +07:00
parent d07c7b4e2c
commit ccdadeeb6e
4 changed files with 83 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.org
View File

@ -1919,6 +1919,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]

40
lib/ast.ml
View File

@ -486,7 +486,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
@ -504,36 +506,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 =
List.concat_map (fun (e : expr) -> [ step_point e.loc; step_expr e ]) es
let rec step_body fn (es : expr list) : expr list =
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
| _ -> { e = Do [ step_point x.loc; step_expr x ]; loc = x.loc }
| Do _ -> step_expr fn x
| _ -> { 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) }
| Let (bs, es) -> { e with e = Let (bs, step_body es) }
| Do es -> { e with e = Do (step_body fn 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) }
| Loop (bs, es) -> { e with e = Loop (bs, step_body es) }
| Dotimes (l, n, b, es) -> { e with e = Dotimes (l, n, b, 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 fn 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
@ -546,7 +548,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
@ -568,7 +570,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) =
@ -578,7 +580,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
@ -587,7 +589,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

30
lib/session.ml
View File

@ -812,6 +812,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
@ -901,7 +916,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"
@ -912,7 +930,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
@ -2323,7 +2344,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

33
test/test_session.ml
View File

@ -286,6 +286,39 @@ let () =
fail "redefining a shadowed rand-int again installed %s"
(String.concat " " c.Session.fns));
(* 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