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

C-c C-s installs a defn that stops before each form of its body, and the break buffer steps it with s and runs the rest of the call with c

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 15:43:24 +07:00
parent da9f21ddcd
commit 9a91440486
11 changed files with 385 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
TODO.org
View File

@ -2029,14 +2029,10 @@ because =locals= and the inspector are asked by it. The innermost frame is
shown even when it is the prelude's, unless the stop is =(pause)=, because it
is where the program stopped. Rules out renumbering the visible frames.
** NEXT There is no stepper
Decided 2026-09-25: stepping happens inside a stopped frame, so the game loop and its clock are frozen, as under =(pause)=.
=(pause)= stops and offers restarts, frames, locals and the inspector, but
nothing advances a form at a time. CIDER instruments a form and steps the
instrumented copy; the equivalent here is a dev-build-only instrumented
redefinition, which the cell indirection already makes deliverable. Open:
whether stepping suspends the frame loop, and what it does to a game's clock.
** DONE There is no stepper
CLOSED: [2026-09-25]
C-c C-s instruments a defn with a step point before each body form; no step
into a callee, no argument positions, and no value shown after a form.
** DONE A NaN cast says "does not fit", which reads as too big
CLOSED: [2026-09-25]
Two more =ArithError= codes: 5 for a cast of NaN and 6 for a cast of an infinity,

9
emacs/MANUAL.md
View File

@ -236,6 +236,12 @@ breakpoint is just a condition nobody handled.
hit it as many times as you like; an ordinary `C-c C-c` over the same form (or
`C-c C-k` over the buffer) takes it off.
**Stepping.** `C-c C-s` installs the `defn` at point so that a call stops
before each form of its body. Each stop is a break like `(pause)`, and the
source of the form about to run is shown beside it. `s` goes to the next form,
`c` runs the rest of the call, and the next call steps again. `C-c C-c` over the
same form installs it plain.
`C-u C-x C-e` does the same for the expression before point: it stops *at* the
expression instead of printing its value. That one does not stick, because there
is no definition for it to stick to. `C-u C-c C-c` on a top-level form that is
@ -375,6 +381,9 @@ Keys in that buffer:
| `v` | visit the source of the frame at point |
| `P` | show or hide the prelude's frames |
| `i` | inspect the local or global at point |
| `e` | evaluate an expression in the frame at point; it sees that frame's locals |
| `s` | at a step, go to the next form |
| `c` | take `continue`: at a step, run the rest of the call |
| `a` | abort |
| `g` | read the program again |
| `q` | close the buffer |

64
emacs/flan-cnr.el
View File

@ -63,6 +63,7 @@
;;; Code:
(require 'seq)
(require 'pulse)
(require 'subr-x)
(require 'flan-mode)
@ -170,6 +171,15 @@ nothing in the compiler knows a breakpoint from an error and this buffer is the
first place that can tell the difference. Named here rather than spelled at
its use, because it is a fact about the prelude.")
(defconst flan-cnr-step "StepPoint"
"The condition the stepper's `(step-point)' signals, before each form of a
defn sent with `C-c C-s'. A stop like `(pause)', with `next' and `continue'
restarts: `s' takes the first and `c' the second.")
(defun flan-cnr--stepping-p (state)
"Whether STATE is a stop of the stepper."
(equal (plist-get state :condition) flan-cnr-step))
(defun flan-cnr--headline-fields (fields)
"The condition's own numbers, folded into the headline.
FIELDS is the fields list; the result is \"low 9, high 9, length 4\" over the
@ -229,7 +239,7 @@ indexing or the division itself, so it sits directly under the headline."
;; only thing that can be wrong here is the word for it. Calling a
;; breakpoint unhandled would be a small lie told at the top of the
;; one buffer that exists to say what happened.
(paused (equal name flan-cnr-breakpoint))
(paused (member name (list flan-cnr-breakpoint flan-cnr-step)))
(numbers (flan-cnr--headline-fields (plist-get state :fields))))
(insert (propertize name 'face (if paused 'warning 'error)))
(when numbers (insert " — " numbers))
@ -240,9 +250,11 @@ indexing or the division itself, so it sits directly under the headline."
(let ((sentence (plist-get state :sentence)))
(when sentence (insert sentence "\n")))
(insert (propertize
(if paused
"stopped at (pause); nothing has been unwound\n"
"unhandled; stopped where it erred, nothing unwound\n")
(cond
((flan-cnr--stepping-p state)
"stepping: stopped before the form below; s steps to the next, c runs the rest of the call\n")
(paused "stopped at (pause); nothing has been unwound\n")
(t "unhandled; stopped where it erred, nothing unwound\n"))
'face 'shadow))
(flan-cnr--insert-site state))
(insert "\n")
@ -439,7 +451,8 @@ breakpoint the program's author wrote, not a step of the program."
(if (and (not flan-cnr--show-prelude)
(flan-cnr--prelude-frame-p fr)
(or (> i 0)
(equal (plist-get state :condition) flan-cnr-breakpoint)))
(equal (plist-get state :condition) flan-cnr-breakpoint)
(flan-cnr--stepping-p state)))
(setq hidden (1+ hidden))
(when (> hidden 0)
(flan-cnr--insert-hidden hidden)
@ -574,7 +587,7 @@ puts the likely culprit on top."
;; an entry is annotated with have to be on screen above it to read.
(flan-cnr--insert-globals state)
(insert (propertize
"RET/0-9 take RET on a frame visits it TAB fold P prelude frames i inspect e eval in frame a abort g refresh q quit\n"
"RET/0-9 take RET on a frame visits it TAB fold P prelude frames i inspect e eval in frame s step c continue a abort g refresh q quit\n"
'face 'shadow))
(goto-char (point-min))
;; Point starts on the restart that abandons the evaluation, when there is
@ -861,6 +874,41 @@ local of, and CODE is read from the minibuffer."
v)
(user-error "flan: %s" (or (plist-get r :message) "refused")))))
(defun flan-cnr--take-named (name)
"Take the innermost restart called NAME, or refuse by name."
(let ((i (seq-position (plist-get flan-cnr--state :restarts) name)))
(unless i (user-error "flan: there is no %s restart at this stop" name))
(flan-cnr--invoke i name)))
(defun flan-cnr-step ()
"Step to the next form: take the stepper's `next' restart."
(interactive)
(flan-cnr--take-named "next"))
(defun flan-cnr-continue ()
"Take the innermost `continue' restart.
At a stepper's stop it runs the rest of the call; at a `(pause)' it resumes."
(interactive)
(flan-cnr--take-named "continue"))
(defun flan-cnr--step-site (state)
"Where a stepper's STATE stopped: the first frame that is not the prelude's."
(seq-some (lambda (fr)
(and (not (flan-cnr--prelude-frame-p fr))
(plist-get fr :loc)))
(plist-get state :stack)))
(defun flan-cnr--show-step-site (state)
"At a stepper's stop, show the form about to run in its source, highlighted.
The break buffer keeps the selection; the source is shown beside it."
(let ((loc (and (flan-cnr--stepping-p state) (flan-cnr--step-site state))))
(when loc
(ignore-errors
(save-selected-window
(with-current-buffer (flan-visit-loc loc "the step")
(pulse-momentary-highlight-region
(point) (save-excursion (ignore-errors (forward-sexp)) (point)))))))))
(defun flan-cnr-refresh ()
"Ask the program again what it is offering."
(interactive)
@ -920,6 +968,9 @@ anyone who would rather TAB always moved."
;; SLIME's `e': evaluate in the frame at point.
(define-key map "e" #'flan-cnr-eval-in-frame)
(define-key map "a" #'flan-cnr-abort)
;; The stepper's two, CIDER's `c' and SLIME's `s' (`n' moves).
(define-key map "s" #'flan-cnr-step)
(define-key map "c" #'flan-cnr-continue)
(define-key map "g" #'flan-cnr-refresh)
(define-key map "q" #'quit-window)
;; Numbered, as SBCL's are, and for SBCL's reason: the names are not
@ -1162,6 +1213,7 @@ walk from a running program."
;; the program running again: see `flan--forget-break-stack'.
(setq next-error-last-buffer buf))
(pop-to-buffer buf)
(flan-cnr--show-step-site (buffer-local-value 'flan-cnr--state buf))
buf)))
(provide 'flan-cnr)

3
emacs/flan-mode.el
View File

@ -87,6 +87,7 @@
;; wiring they need.
(autoload 'flan-inspect "flan-inspect" nil t)
(autoload 'flan-cnr-show "flan-cnr" nil t)
(autoload 'flan-step-defun "flan" nil t)
(autoload 'flan-doc "flan" nil t)
(autoload 'flan "flan" nil t)
(autoload 'flan-quit "flan" nil t)
@ -448,6 +449,8 @@ For `syntax-propertize-function'."
;; reads as the client being broken rather than as the key being free.
(define-key map (kbd "C-M-x") #'flan-eval-defun)
(define-key map (kbd "C-c C-k") #'flan-eval-buffer)
;; The stepper: the defn at point, installed to stop before each form.
(define-key map (kbd "C-c C-s") #'flan-step-defun)
(define-key map (kbd "C-x C-e") #'flan-eval-last-sexp)
(define-key map (kbd "C-c C-z") #'flan-connect)
(define-key map (kbd "C-c C-q") #'flan-disconnect)

23
emacs/flan.el
View File

@ -2590,7 +2590,7 @@ signature, listed in %s"
(user-error "flan: %s%s" (or msg "rejected")
(if loc (format " (%s)" loc) "")))))
(defun flan--eval (code what &optional start end pause)
(defun flan--eval (code what &optional start end pause step)
"Send CODE to the running program. WHAT names it for the echo area.
START and END, when given, are the region it came from, flashed on success.
PAUSE, when given, is (BEG . END): the bounds of the form inside CODE the
@ -2605,7 +2605,8 @@ breakpoint is marked from the editor, without editing the buffer\"."
(append
(list :op "eval" :code code :file (or buffer-file-name "<buffer>"))
(when pause
(list :pause (flan--wire-position (car pause))))))))
(list :pause (flan--wire-position (car pause))))
(when step (list :step t))))))
;; END as the place a value could go. Every caller of this sends a
;; declaration and declarations have no value, so this is the path that
;; stays open rather than one anybody takes today.
@ -2632,6 +2633,10 @@ breakpoint is marked from the editor, without editing the buffer\"."
(cond
((and pause (plist-get reply :pause))
(flan--show-pause (car pause) (cdr pause)))
;; An instrumented defn is marked whole, as a pause mark is, and an
;; ordinary C-c C-c of it takes the mark down with the instrumentation.
((and step start end (plist-get reply :step))
(flan--show-pause start end))
((and start end) (flan-clear-pause start end)))
reply))
@ -2913,6 +2918,20 @@ declaration for it to live in."
;; `flan--report' signals on a rejection.
(pulse-momentary-highlight-region (car b) end))))))
;;;###autoload
(defun flan-step-defun ()
"Install the defn at point so that a call stops before each form of its body.
A stepper, CIDER's `C-u C-M-x': each stop is a break like `(pause)', with the
program and its clock frozen, and the break buffer shows the form about to
run. There `s' steps to the next form and `c' runs the rest of the call; the
next call steps again. `C-c C-c' on the defn installs it plain."
(interactive)
(let* ((b (flan--defun-bounds))
(head (and (< (car b) (cdr b))
(flan--declaration-head-at (car b) flan--defun-heads))))
(unless head (user-error "flan: no defn at point to step through"))
(flan--eval (flan--text (car b) (cdr b)) "form" (car b) (cdr b) nil t)))
;;;###autoload
(defun flan-eval-buffer ()
"Load this buffer into the running program, as `C-c C-k' does in SLIME and CIDER.

54
emacs/test-flan-cider.el
View File

@ -1507,6 +1507,60 @@ would be overwritten. Look again and re-do the edit")
(test-flan--check "`e' is the break buffer's own key"
(eq (lookup-key flan-cnr-mode-map "e") #'flan-cnr-eval-in-frame))))
;; The stepper's stop: said as a step, the prelude's own frame hidden, and
;; `s' and `c' take its `next' and `continue' by index.
(let* ((asked nil)
(flan-cnr-request-function
(lambda (form) (push form asked) '(:status "ok"))))
(with-current-buffer (test-flan--cnr
(list :condition "StepPoint"
:restarts '("next" "continue" "continue")
:stack (list (list :fn "step-point" :loc "<prelude>:250:3")
(list :fn "step" :loc "/s.flan:1:19"))))
(let ((text (buffer-string)))
(test-flan--check "a step's headline says it is stepping"
(string-match-p "stepping: stopped before the form" text))
(test-flan--check "and the prelude's step-point frame is hidden"
(not (string-match-p "step-point" text))))
(test-flan--check "the step site is the stepped frame's location"
(equal (flan-cnr--step-site flan-cnr--state) "/s.flan:1:19"))
(save-window-excursion (flan-cnr-step))
(test-flan--check "`s' takes next"
(and (equal (plist-get (car asked) :op) "restart-at")
(equal (plist-get (car asked) :name) "next")
(= 0 (plist-get (car asked) :index)))))
(with-current-buffer (test-flan--cnr
(list :condition "StepPoint"
:restarts '("next" "continue" "continue")))
(save-window-excursion (flan-cnr-continue))
(test-flan--check "`c' takes the innermost continue"
(and (equal (plist-get (car asked) :name) "continue")
(= 1 (plist-get (car asked) :index)))))
(test-flan--check "`s' and `c' are the break buffer's own keys"
(and (eq (lookup-key flan-cnr-mode-map "s") #'flan-cnr-step)
(eq (lookup-key flan-cnr-mode-map "c") #'flan-cnr-continue))))
;; C-c C-s sends the defn at point for stepping and marks it.
(let ((sent nil))
(with-temp-buffer
(flan-mode)
(insert "(defn step [] i64\n (set ticks 1)\n ticks)\n")
(goto-char (point-min))
(forward-line 1)
(cl-letf (((symbol-function 'flan--request)
(lambda (form) (setq sent form)
'(:status "ok" :fns ("step") :names ("step") :step t)))
((symbol-function 'flan-refresh-defs) #'ignore))
(flan-step-defun))
(test-flan--check "C-c C-s sends the defn with :step"
(and (equal (plist-get sent :op) "eval")
(plist-get sent :step)
(string-prefix-p "(defn step" (plist-get sent :code))))
(test-flan--check "and marks it as instrumented"
(flan--pause-overlays))
(test-flan--check "C-c C-s is flan-mode's key for it"
(eq (lookup-key flan-mode-map (kbd "C-c C-s")) #'flan-step-defun))))
;; `flan-cnr-show' refuses a running program by name rather than opening an
;; empty buffer.
;; The layout without the values: what a `layout' op alone would buy. The

65
lib/ast.ml
View File

@ -481,6 +481,71 @@ let map_children f (e : expr) : expr =
let pause_call loc = { e = Call ({ e = Var "pause"; 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
a [do], a [let], a loop, a [match] arm and each branch of an [if]. Not
inside an argument, an [fn] or a handler clause, which are not forms a
person reads as steps, and the last two are functions of their own. [None]
when there is no [defn] to instrument.
A step is [(step-point)] from the prelude — [error] of a [StepPoint] under a
[restart-case], so the break loop takes it as it takes [(pause)], with the
game loop and its clock frozen. It answers whether to go on stepping: its
[next] restart says yes and its [continue] says no, and the answer is kept
in a local of the call, [flan~step], so [continue] runs the rest of this
call and the next call steps again. [~] cannot occur in a source symbol, so
the local is visibly the compiler's and hidden from the locals listing. *)
let step_flag = "flan~step"
let step_point 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 });
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
and step_expr (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 }
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) }
| 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) }
| Match (sc, arms) ->
{ e with e = Match (sc, List.map (fun a -> { a with body = step_body a.body }) arms) }
| _ -> e
let instrument_step (ds : decl list) : decl list option =
let hit = ref false in
let ds =
List.map
(fun (d : decl) ->
match d.d with
| Defn f ->
hit := true;
let on =
{ bname = step_flag; bty = None;
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);
loc = d.dloc } ] } }
| _ -> d)
ds
in
if !hit then Some ds else None
(* [mark_pause ~line ~col ds] is [ds] with a [(pause)] put in front of whatever
starts at that position, or [None] when nothing does.

13
lib/dev.ml
View File

@ -1022,7 +1022,7 @@ let errors_reply (ds : Loc.diag list) =
String.sub e 0 (String.length e - 1)
^ " " ^ String.concat " " (errors_field ds) ^ ")"
let eval ?forms ?base ?(extra = []) t ~code ~origin ~pause =
let eval ?forms ?base ?(extra = []) ?(step = false) t ~code ~origin ~pause =
let now = liveness t in
let parked_now = now = Parked in
(* A park that is over takes its note with it: the long sentence below is
@ -1046,7 +1046,7 @@ let eval ?forms ?base ?(extra = []) t ~code ~origin ~pause =
if now = Gone then error gone
else
match
Session.eval ~origin ?base ?forms ?pause ~running:(not parked_now)
Session.eval ~origin ?base ?forms ?pause ~step ~running:(not parked_now)
t.session code
with
| c when not c.Session.installs ->
@ -1109,6 +1109,7 @@ let eval ?forms ?base ?(extra = []) t ~code ~origin ~pause =
| Some (l, c) ->
[ ":pause " ^ Wire.quote (Printf.sprintf "%d:%d" l c) ]
| None -> [])
@ (if step then [ ":step t" ] else [])
@ install_note t ~parked:parked_now
@ unpolled_note t ~parked:parked_now
@ extra)
@ -4399,7 +4400,13 @@ let handle t req =
let origin =
match Wire.string_field req "file" with Some f -> f | None -> "<editor>"
in
eval t ~code ~origin ~pause:(Wire.pos_field req "pause")
(* [:step t] instruments every defn sent for the stepper. *)
let step =
match Wire.field req "step" with
| Some { Form.v = Form.Sym "nil"; _ } | None -> false
| Some _ -> true
in
eval t ~code ~origin ~pause:(Wire.pos_field req "pause") ~step
| None -> error "eval needs :code")
| Some "eval-expr" ->
(match Wire.string_field req "code" with

12
lib/prelude.ml
View File

@ -240,6 +240,18 @@ let source = {flan|
(defn pause [] ()
(restart-case (error (Pause {}))
(continue [] (do))))
;; The stepper's stop, which C-c C-s puts before each form of a defn's body
;; (Ast.instrument_step). It is (pause) with an answer: next goes on stepping
;; and continue runs the rest of the call, and the instrumented body keeps
;; that answer in a local of its own. Like Pause it is not under Error.
;; Named so a program's own step or Step is not what the instrumented body
;; calls.
(defstruct StepPoint [])
(defn step-point [] bool
(restart-case (error (StepPoint {}))
(next [] :report "stop at the next form" true)
(continue [] :report "run the rest of this call" false)))
;; A seeded PRNG in Flan rather than libc's, because a grid hash is only a
;; regression test if the sequence is byte-identical on native and wasm32

20
lib/session.ml
View File

@ -787,7 +787,7 @@ let rerun t = t.live <- SM.empty
file an [(import ...)] in them is resolved against, the session's own when
absent: a file loaded from another directory names its packages from
there. *)
let eval ?(origin = "<eval>") ?base ?forms ?pause ?(running = true) t src : change =
let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = true) t src : change =
let forms =
match forms with Some f -> f | None -> Reader.read_all ~file:origin src
in
@ -877,6 +877,15 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(running = true) t src : chan
fail loc "nothing to pause at line %d, column %d of the form sent"
line col)
in
(* [step]: every defn sent stops before each form of its body — see
[Ast.instrument_step]. After [qualify_decl] for the reason [pause] is. *)
let incoming =
if not step then incoming
else
match Ast.instrument_step incoming with
| Some ds -> ds
| None -> fail loc "there is no defn in the form sent to step through"
in
(* A method declares a name of its own — that is what makes evaluating one
twice a replacement and evaluating a new one an append, through the same
kept/added logic every other declaration goes through. But no function is
@ -1504,6 +1513,15 @@ let shown_names (fn : Tast.fn) : string option array =
Array.init n (fun i ->
if i < Array.length fn.Tast.snames then fn.Tast.snames.(i) else None)
in
(* A name the compiler gave a local of its own, such as the stepper's
[flan~step], is hidden like an unnamed slot: [~] cannot be typed. *)
let raw =
Array.map
(function
| Some n when String.starts_with ~prefix:"flan~" n -> None
| x -> x)
raw
in
let stripped = Array.map (Option.map strip_rebind) raw in
let count name =
Array.fold_left

130
test/test_dev.ml
View File

@ -8759,6 +8759,136 @@ let () =
hook_block ~llvm:false;
hook_block ~llvm:true;
(* ── The stepper ─────────────────────────────────────────────────
[dev-pause.flan] calls [step] every 5ms. Sent with [:step t], a call
stops before each form of its body: first the (set ...), then, after
[next], the [ticks] it answers. [continue] runs the rest of the call,
and the next call steps again. A plain evaluation takes it out. Under
both backends, each with its own daemon. *)
let stepper ~llvm =
let what = if llvm then "llvm " else "x86 " in
let ssock = tmp (what ^ "step.sock") and sout = tmp (what ^ "step.out") in
(try Sys.remove ssock with Sys_error _ -> ());
let sfd = Unix.openfile sout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let spid =
Unix.create_process flan
(Array.append
[| flan; "dev"; "programs/dev-pause.flan"; "-s"; ssock |]
(if llvm then [| "--llvm" |] else [||]))
Unix.stdin sfd Unix.stderr
in
Unix.close sfd;
if not (listening ~pid:spid ssock) then
fail "%sstepper daemon %s" what !listen_why
else begin
let c = connect ssock in
let ask = request c in
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
let body = "(defn step [] i64 (set ticks (+ ticks 1)) ticks)" in
let col sub =
let n = String.length sub in
let rec find i =
if String.equal (String.sub body i n) sub then i + 1 else find (i + 1)
in
find 0
in
(* Where the stepped frame is: the frame of [step], whose location is
the step point's, which is the form about to run. *)
let at () =
match Wire.field (ask "(:op \"backtrace\")") "frames" with
| Some { Form.v = Form.List l; _ } ->
List.find_map
(fun (f : Form.t) ->
match f.Form.v with
| Form.List ({ Form.v = Form.Str "step"; _ }
:: { Form.v = Form.Str loc; _ } :: _) -> Some loc
| _ -> None)
l
| _ -> None
in
let stops_at sub =
let want = Printf.sprintf ":1:%d" (col sub) in
await (fun () ->
stopped (ask "(:op \"describe\")")
&& (match at () with Some l -> contains_sub l want | None -> false))
in
let r =
ask
(Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/step.flan\" :step t)"
(Wire.quote body))
in
if status r <> "ok" then
fail "%sinstrumenting for the stepper: %s" what
(Option.value ~default:"" (Wire.string_field r "message"))
else begin
if Wire.field r "step" = None then
fail "%san instrumented defn did not echo :step" what;
if not (stops_at "(set ticks") then
fail "%sthe stepper did not stop before the first form (at %s)" what
(Option.value ~default:"<none>" (at ()))
else begin
(match Wire.string_field (ask "(:op \"describe\")") "condition" with
| Some "StepPoint" -> ()
| c -> fail "%sa step stopped on %s" what (Option.value ~default:"<none>" c));
(* The stepper's own local is not one of the frame's. *)
let fr = ask "(:op \"locals\" :frame 1)" in
(match Wire.string_field fr "frame" with
| Some "step" ->
(match Wire.field fr "locals" with
| Some { Form.v = Form.List []; _ } | None -> ()
| _ -> fail "%sthe stepper's flag is listed as a local" what)
| f -> fail "%sframe 1 at a step is %s" what (Option.value ~default:"<none>" f));
let r = ask "(:op \"restart\" :name \"next\")" in
if status r <> "ok" then
fail "%snext at a step: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
if not (stops_at "ticks)") then
fail "%snext did not stop before the second form (at %s)" what
(Option.value ~default:"<none>" (at ()));
let r = ask "(:op \"restart\" :name \"continue\")" in
if status r <> "ok" then
fail "%scontinue at a step: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
(* The next call, 5ms on, steps again from the top. *)
if not (stops_at "(set ticks") then
fail "%sthe next call did not step again" what;
let r =
ask
(Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/step.flan\")"
(Wire.quote body))
in
if status r <> "ok" then
fail "%sinstalling the plain defn: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
ignore (ask "(:op \"restart\" :name \"continue\")");
if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then
fail "%sthe program did not resume from the last step" what;
let deadline = Unix.gettimeofday () +. 0.5 in
let rec run_on () =
if Unix.gettimeofday () > deadline then ()
else if stopped (ask "(:op \"describe\")") then
fail "%sthe plain defn still steps" what
else begin
ignore (Unix.select [] [] [] 0.01);
run_on ()
end
in
run_on ()
end
end;
(try Unix.close c with Unix.Unix_error _ -> ())
end;
(try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] spid) with Unix.Unix_error _ -> ());
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ]
in
stepper ~llvm:false;
stepper ~llvm:true;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ sock; out; bsock; bout ];
Test_support.report ~label:"dev" ()