Joseph Ferano
2d8d9cd5a8
"Is there a way to do dotimes or a loop in reverse?" — the answer was a hand-written let plus set. Now it is (dotimes [i 9 -1 -1]). Three arities: [i n], [i start stop], [i start stop step]. The stop is exclusive in all of them, so [i 0 n] is [i n] — one rule, not two — and a negative step counts down, testing with > instead of <. A literal step of 0 is refused where it is written. One that is only a value cannot be, so the condition asks the sign first and 0 falls out of it as a loop that runs no times: terminating and deterministic, and free, because a literal step still emits the single comparison it always did. Each bound is evaluated once, left to right, before the counter exists: the start into the counter, the stop into the hidden slot it always had, the step into one of its own unless it is a literal. Still a special form, still a Let and a While with the step in the latch, so neither backend learned anything — the new program prints the same thing under --x86 and at -O0. load.ml's Form-level walk had to learn more than one bound for the same reason parse.ml did; it is part of this feature and not a bug that was sitting there, because before this a three-bound dotimes was a parse error long before that walk could reach it.
494 lines
26 KiB
OCaml
494 lines
26 KiB
OCaml
(** The AST: syntax with special forms recognised, before typing.
|
|
|
|
Sugar is gone by this point. [when], [unless], [cond] and [and]/[or] are
|
|
desugared into [If] and [Do]; they are compiler special forms until macros
|
|
arrive at milestone 5, so there is nothing to preserve for a macroexpander
|
|
to see yet.
|
|
|
|
Types here are *surface* type expressions, not resolved types. [Ptr] and
|
|
[Option] are still just names; the checker resolves them. *)
|
|
|
|
(* ── Type expressions ──────────────────────────────────────────────── *)
|
|
|
|
type texpr = { t : texpr_kind; tloc : Loc.t }
|
|
|
|
and texpr_kind =
|
|
| Tname of string (* i32 bool Cursor string *)
|
|
| Tslice of texpr (* [u8] ptr+len *)
|
|
| Tarray of len * texpr (* [4 f32] [rows [cols u32]] *)
|
|
| Tmap of texpr * texpr (* (Map string i32) *)
|
|
| Tapp of string * texpr list (* (Ptr Cursor) (Option f64) *)
|
|
| Tfn of texpr list * texpr (* (Fn [a a] bool) *)
|
|
|
|
(* An array length is an integer or a compile-time constant's name. *)
|
|
and len =
|
|
| Lint of int64
|
|
| Lname of string
|
|
|
|
(* ── Expressions ───────────────────────────────────────────────────── *)
|
|
|
|
type expr = { e : expr_kind; loc : Loc.t }
|
|
|
|
and expr_kind =
|
|
| Int of int64
|
|
| Float of float
|
|
| Byte of int
|
|
| Str of string
|
|
| Kw of string (* :space — coerced at typed call sites *)
|
|
| Quote of string (* 'skip-form — restart names *)
|
|
| Var of string
|
|
| Do of expr list
|
|
| Let of binding list * expr list
|
|
| If of expr * expr * expr option
|
|
(* The [string option] is a loop label: [(while :outer c ...)]. A keyword in
|
|
that position is unambiguous because a loop condition is never one. *)
|
|
| While of string option * expr * expr list
|
|
(* [(loop [x 0 acc 1] body ...)] and [(recur v ...)]. A loop answers with the
|
|
value of its body; a [recur] rebinds every one of the loop's names at once
|
|
and jumps back to the top. It is not a tail call and there is no tail-call
|
|
elimination anywhere in this compiler — the checker refuses a [recur] that
|
|
is not in the loop body's tail position, so what would be a stack overflow
|
|
under silent TCO is a compile error here. Each name takes a plain symbol:
|
|
a destructuring pattern would turn one name into several and [recur]'s
|
|
argument count could no longer be read off the binding vector. *)
|
|
| Loop of (string * expr) list * expr list
|
|
| Recur of expr list
|
|
| Return of expr option
|
|
(* Leaving a loop, and starting its next iteration. The [string option] is
|
|
the label of the loop meant, and [None] means the innermost. Neither is a
|
|
goto: the checker resolves the name against the loops this form is
|
|
lexically inside, so control can only leave a loop it is already in —
|
|
Odin's restriction, and what keeps it safe. *)
|
|
| Break of string option
|
|
| Continue of string option
|
|
| Set of place * expr
|
|
| Field of expr * string (* (.pos c) — auto-derefs one level *)
|
|
| Call of expr * expr list
|
|
| Match of expr * arm list
|
|
| Struct of string * (string * expr) list (* (Cursor {.src s}) *)
|
|
(* {.src s .pos 0} with no type written in front of it. The fields alone do
|
|
not name a type, so this node carries no name and is only checkable where
|
|
the checker already has an expectation to read one off — a defn's return
|
|
position, a typed argument, a field of an enclosing literal, a typed
|
|
place. [Check] refuses it everywhere else. The parser cannot make this
|
|
decision: it has no symbol table and no expectation, which is why the
|
|
refusal that used to live in [Parse.expr] moved. *)
|
|
| Bare of (string * expr) list (* {.src s} *)
|
|
(* {:a 1 :b s} — a dyn map literal. Braces whose first form is not a
|
|
[.field] symbol are this; the struct spelling keeps the dot. Keys are
|
|
ordinary expressions, keywords being the common case. *)
|
|
(* The [string option] is a shape tag, and the parser never writes one: a
|
|
tagged map is what a (defclass ...) constructor builds, and
|
|
[Classes.expand] is the only thing that writes that constructor. The tag
|
|
is the class's name; the instance carries it in its object header, not as
|
|
an entry, so a tagged literal and an untagged one with the same pairs
|
|
differ in exactly one word and in nothing a [get] can see. *)
|
|
| MapLit of string option * (expr * expr) list
|
|
| Arr of expr list (* [0xE6B800FF ...] — a fixed array value *)
|
|
(* (array 4 rl/Vector2) — a zeroed fixed array, given its count and its
|
|
element type. [n T] is the ordinary *type* syntax and already works
|
|
everywhere a type is expected; a [let] binding is the one position with no
|
|
type slot, so there [4 rl/Vector2] reads as a two-element [Arr] literal and
|
|
fails on an unknown name. This is that position's answer, and it says what
|
|
it does rather than looking like a vector of two things. *)
|
|
| ArrayOf of texpr (* the whole array type, built by Parse *)
|
|
(* (array-fill [r c] v) and (array-gen [r c] f) — a fixed array of any rank
|
|
as an *expression*, which is what [ArrayOf] and [dotimes] between them
|
|
could not be: [ArrayOf] produces the zeroed value only, and [dotimes] is
|
|
Unit and can only mutate a place that already exists. These produce the
|
|
whole value, so they compose where a bracket literal does.
|
|
|
|
The dimensions are in brackets and are [len]s, not expressions, for the
|
|
reason the brackets are read at all: in expression position [[rows cols]]
|
|
is an array *literal* of two names, and where those names are defconsts
|
|
it would quietly type-check as one. So the form is recognised in [Parse]
|
|
and the brackets are read with the same [len] the [n T] type spelling
|
|
uses — an integer or a compile-time constant's name, and nothing else.
|
|
|
|
Two forms rather than one with a dispatch on the third element's type: an
|
|
array *of function values* is a thing one may want, and a single form
|
|
would have to decide whether [(array-fill [4] f)] meant four copies of
|
|
[f] or four calls of it. Spelled apart, neither reading is ever in doubt.
|
|
|
|
[ArrayGen]'s expression is a function value taking one index per
|
|
dimension; [ArrayFill]'s is the element value itself, evaluated once. *)
|
|
| ArrayFill of len list * expr
|
|
| ArrayGen of len list * expr
|
|
(* These bind names or alter control flow, so none of them can be a call. *)
|
|
| Fn of string list * expr list (* (fn [x y] ...) — non-escaping *)
|
|
(* (dotimes :o [i n] ...), (dotimes [i start stop] ...) and
|
|
(dotimes [i start stop step] ...). The bounds are a record rather than
|
|
three positional fields because the one-bound form is the common one and
|
|
"which of these is the stop" should not be a counting exercise at every
|
|
site that walks them. *)
|
|
| Dotimes of string option * string * bounds * expr list
|
|
| Defer of expr list (* runs on scope exit *)
|
|
| Unwrap of unwrap * expr (* (some x) / (try x) *)
|
|
(* (handler-bind [(Type [c] body ...) ...] body ...) — spec-conditions.md.
|
|
A clause binds a name for the condition, so this cannot be a call. *)
|
|
| HandlerBind of hclause list * expr list
|
|
(* (handler-case BODY [(Type [c] body ...) ...]) — the other half of
|
|
spec-conditions.md's pair. Where a handler-bind clause runs at the signal
|
|
with the stack below it intact, a handler-case clause runs *here*, after
|
|
that stack has gone, and its value is the value of the whole form. The
|
|
clauses share [hclause] with handler-bind because the syntax is the same
|
|
one; what differs is entirely where the body runs. *)
|
|
| HandlerCase of expr * hclause list
|
|
| Signal of sigkind * expr (* (signal c) / (error c) *)
|
|
(* (restart-case body (name [p T] body ...) ...) and
|
|
(invoke-restart 'name arg ...). Both alter control flow, so neither can be
|
|
a call, and a clause binds its parameters — §3. *)
|
|
| RestartCase of expr * rclause list
|
|
| InvokeRestart of string * expr list
|
|
|
|
(* A [dotimes]'s counting. [dstop] is always written; the other two have
|
|
defaults — 0 and 1 — and are [None] when the source left them out, which is
|
|
what lets the one-bound form desugar to exactly what it always did. *)
|
|
and bounds = { dstart : expr option; dstop : expr; dstep : expr option }
|
|
|
|
(* Two ways to signal, because they are two different things — §1 and §2.
|
|
[signal] returns Unit whatever it finds; [error] has type Never and, with
|
|
nothing transferring, the program stops. *)
|
|
and sigkind = Ssignal | Serror
|
|
|
|
and hclause = { hty : texpr; hname : string; hbody : expr list; hloc : Loc.t }
|
|
(* [rparams] are §3's inline annotations, the same name/type pairs a [defn]
|
|
takes. They are bound in the clause body and filled in by whatever invoked
|
|
the restart, which is why their count and types are checked at run time
|
|
(§3): a restart is found by name on a dynamic stack. *)
|
|
and rclause =
|
|
{ rname : string; rparams : field list; rbody : expr list; rloc : Loc.t }
|
|
|
|
(* Inline name/type pairs, as in [defn], [let] and [defstruct]. Here because a
|
|
restart clause's parameters are one, and a clause is part of an expression. *)
|
|
and field = { fname : string; fty : texpr; floc : Loc.t }
|
|
|
|
(* One slot of a [defn]'s parameter vector, before it is known whether the slot
|
|
is a name or a type. [(defn f [x y] ...)] is two dyn parameters if [y] is
|
|
not a type and one parameter [x : y] if it is, and the parser cannot tell:
|
|
the type names are not all known until macros have run and every file has
|
|
been loaded. So the vector is carried undecided and paired in [Check], where
|
|
the set is complete. See the argument in Parse beside the [defn] case. *)
|
|
and pitem =
|
|
(* A bare symbol: either a parameter's name or a type's. *)
|
|
| Pname of string * Loc.t
|
|
(* Anything that cannot be a parameter name — [(Ptr T)], [[T]], [[n T]], [()]
|
|
— and so is a type whatever the environment says. *)
|
|
| Ptype of texpr
|
|
|
|
(* Two unwrap operators, because they are two different things — plan.org. *)
|
|
and unwrap = Usome | Utry
|
|
|
|
and binding = { bname : string; bty : texpr option; bval : expr; bloc : Loc.t }
|
|
|
|
(* The fixed list of assignable forms — spec-memory.md. Not setf. *)
|
|
and place =
|
|
| Pvar of string
|
|
| Pfield of expr * string (* (set (.hp e) v) *)
|
|
| Pindex of expr * expr list (* (set (at grid r c) v) *)
|
|
| Pderef of expr (* (set (deref p) v) *)
|
|
|
|
and arm = { pat : pattern; body : expr list; aloc : Loc.t }
|
|
|
|
and pattern =
|
|
| Pctor of string * string list (* (Some e) (Rect w h) None *)
|
|
| Pwild (* _ :else *)
|
|
|
|
(* ── Declarations ──────────────────────────────────────────────────── *)
|
|
|
|
(* One [where] predicate: [(ordered? $t)] is [{ pname = "ordered?"; pvar = "t" }].
|
|
A predicate is a *compile-time question about a type*, not a type class: it
|
|
carries no implementation and selects no instance, it only tells the
|
|
abstract pass which builtin operators the variable may be used with, and
|
|
makes each instantiation check the concrete type answers yes. *)
|
|
type pred = { pname : string; pvar : string; ploc : Loc.t }
|
|
|
|
type fn = {
|
|
name : string;
|
|
params : field list;
|
|
(* [Some items] means the parameter vector has not been paired yet: it was
|
|
written by a [defn], where a slot with no type means [dyn], and [Check]
|
|
fills [params] from it before anything reads them. [None] is every other
|
|
way a signature is built — [declare], the shim, the C importer — where
|
|
every parameter's type was written out and the pairing was never in
|
|
doubt. Nothing downstream of [Check.pair_params] sees [Some]. *)
|
|
praw : pitem list option;
|
|
ret : texpr option; (* None means (); only declare omits it *)
|
|
(* The [{:where ...}] map at the head of the body, already unpacked. Empty
|
|
for every function that has none, which is every function that is not
|
|
generic and most that are. *)
|
|
fwhere : pred list;
|
|
fbody : expr list;
|
|
nloc : Loc.t;
|
|
}
|
|
|
|
type decl = { d : decl_kind; dloc : Loc.t }
|
|
|
|
and decl_kind =
|
|
| Package of string
|
|
| Import of string * string (* alias, path *)
|
|
| Defalias of string * texpr
|
|
| Defstruct of string * field list
|
|
| Defdata of string * variant list
|
|
(* C's union: the members overlay one another at offset zero, the size is
|
|
the largest of them and the alignment the strictest. It carries the same
|
|
[field list] a struct does, because that is what it is — the difference
|
|
is entirely in the layout, and saying it with a second field type would
|
|
only mean every walk had two shapes to handle for one idea. *)
|
|
| Defunion of string * field list
|
|
| Defn of fn
|
|
(* No body, so no [defn]: a foreign function, and the string is the C symbol
|
|
it is actually called by (plan.org, Types — [declare] is kept only where
|
|
there is no body). *)
|
|
| Declare of fn * string
|
|
(* The same, but written in the C library's own terms — structs by value,
|
|
strings as strings. [Shim] generates the C that flattens it and rewrites
|
|
this into a [Declare] plus an ordinary [Defn], so nothing downstream sees
|
|
one. Two forms and not one because [(declare f [p string] ...)] already
|
|
means "the symbol takes ptr+len", which is the opposite of what this
|
|
means. *)
|
|
| DeclareC of fn * string
|
|
(* Inline name/value pairs, as everywhere else. The members are what a
|
|
keyword at a call site resolves against. *)
|
|
| Defenum of string * (string * int64) list
|
|
(* value is optional: ZII. `uninit` opts out and is recorded as Uninit.
|
|
One constructor for the two defining forms that declare a mutable
|
|
global, told apart by the [reinit]: [defonce] is [Once] — its
|
|
initialiser runs only if the global is not already initialised, so the
|
|
value survives a daemon re-run — and [def] is [Every], Common Lisp's
|
|
defparameter: the initialiser runs on every re-run, so an edited one
|
|
takes effect on the next C-c C-c + re-run. They share everything else —
|
|
the spellings, the collision rules, the lowering — which is why the
|
|
difference is a field and not a second constructor. *)
|
|
| Defvar of string * texpr option * init * reinit
|
|
| Defconst of string * texpr option * expr
|
|
(* ── The dyn side's classes and generic functions ──────────────────
|
|
None of these four reaches [Check]. [Classes.expand] turns the whole set
|
|
into ordinary [Defn]s before pass one collects anything, the way [Shim]
|
|
already turns a [DeclareC] into a [Declare] plus a [Defn]: a class is a
|
|
constructor, and a generic function is one function whose body is a
|
|
dispatch over the methods written for it.
|
|
|
|
They are declarations here rather than a macro because the expansion
|
|
needs the *whole* declaration list in hand — a method may be written
|
|
anywhere in the file, or arrive at a reload long after the generic did,
|
|
and a macro sees one form. *)
|
|
|
|
(* (defclass point [x y]) — the slot names, in constructor order. *)
|
|
| Defclass of string * (string * Loc.t) list
|
|
(* (defgeneric area [self] dyn) — CLOS's class dispatch: the dispatch value
|
|
is the shape tag of the first argument. The parameter vector and the
|
|
return slot are a [defn]'s, and there is no body. *)
|
|
| Defgeneric of fn
|
|
(* (defmulti describe [x] dyn (get x :kind)) — Clojure's: the body IS the
|
|
dispatch function, computing the value the methods are keyed by. Exactly
|
|
a [defn]'s shape, which is what it is. *)
|
|
| Defmulti of fn
|
|
(* (defmethod area point [p] body ...) — one method of a generic. [mgen] is
|
|
the generic's name, [mkey] the dispatch value it answers for, and [mfn]
|
|
carries the parameter vector and the body. There is no return slot: the
|
|
generic states the return type once, for all of its methods. *)
|
|
| Defmethod of methd
|
|
|
|
(* A dispatch value, written at a [defmethod]. Only literals: the value is
|
|
compared at run time and the *name* the method is declared under is built
|
|
from it at compile time, so it has to be something both passes can read. *)
|
|
and dispatch =
|
|
(* [point] — a class's name, standing for the keyword its instances carry.
|
|
Refused unless a [defclass] of that name is in scope, which is the one
|
|
compile-time check a shape tag makes possible. *)
|
|
| Dclass of string
|
|
| Dkw of string (* :circle *)
|
|
| Dstr of string (* "circle" *)
|
|
| Dint of int64
|
|
| Dbool of bool
|
|
(* [:else] — the method that answers when no other does. The spelling is
|
|
[match]'s, not Clojure's [:default], because this language already has
|
|
one word for "none of the above" and two would be one too many. *)
|
|
| Delse
|
|
|
|
and methd = { mgen : string; mkey : dispatch; mfn : fn; mkloc : Loc.t }
|
|
|
|
and variant = { vname : string; vfields : field list; vloc : Loc.t }
|
|
|
|
(* [Ambiguous] is the three-element [(defonce x foo)] and [(defonce x (f y))]:
|
|
forms whose third element parses as a type *and* as an expression, so which
|
|
one it is cannot be decided until names exist. The [texpr] beside it in
|
|
[Defvar] is the type reading and this is the value reading; [Check.collect]
|
|
picks, type first — a known type name or a built-in type constructor is
|
|
[Zeroed], anything else is [Init] of this expression at [dyn]. Everything
|
|
whose shape settles it is settled in [Parse] and never becomes one of
|
|
these. *)
|
|
and init = Zeroed | Uninit | Init of expr | Ambiguous of expr
|
|
|
|
(* What a daemon re-run does to the global: [Once] is [defonce] — initialise
|
|
if not already initialised, keep the value otherwise — and [Every] is
|
|
[def], which runs its initialiser on every re-run. *)
|
|
and reinit = Once | Every
|
|
|
|
(* Every top-level name a declaration introduces, whatever kind it is. There is
|
|
one top-level namespace, so this is both the set [Load] renames on an import
|
|
and the set [Check] refuses to see twice — one definition, so the two cannot
|
|
drift apart. *)
|
|
(* How a dispatch value reads back, in a message and in the name below. The
|
|
keyword keeps its colon and the string its quotes, so that a method written
|
|
for :circle and one written for "circle" — two different values — do not
|
|
read as the same thing in a duplicate-method refusal. *)
|
|
let dispatch_text = function
|
|
| Dclass n -> n
|
|
| Dkw k -> ":" ^ k
|
|
| Dstr s -> "\"" ^ s ^ "\""
|
|
| Dint i -> Int64.to_string i
|
|
| Dbool b -> if b then "true" else "false"
|
|
| Delse -> ":else"
|
|
|
|
(* The top-level name a [defmethod] declares. No function is ever emitted
|
|
under it — a method's body is inlined into its generic's dispatch, so the
|
|
only function the pass writes is the generic itself — but a declaration
|
|
still needs a name of its own, for the reason every declaration does: a
|
|
session replaces a declaration it has already seen by name, and appends one
|
|
it has not. Redefining a method has to replace, and adding one has to
|
|
append, and the pair (generic, dispatch value) is what tells those two
|
|
apart. The [@] is what keeps the name out of a program's reach: no symbol a
|
|
reader accepts contains one. *)
|
|
let method_name (m : methd) = m.mgen ^ "@" ^ dispatch_text m.mkey
|
|
|
|
let declared_name (d : decl) =
|
|
match d.d with
|
|
| Defenum (n, _) | Defalias (n, _) | Defstruct (n, _) | Defdata (n, _)
|
|
| Defunion (n, _) | Defvar (n, _, _, _) | Defconst (n, _, _)
|
|
| Defclass (n, _) -> Some n
|
|
| Declare (fn, _) | DeclareC (fn, _) | Defn fn
|
|
| Defgeneric fn | Defmulti fn -> Some fn.name
|
|
| Defmethod m -> Some (method_name m)
|
|
| Package _ | Import _ -> None
|
|
|
|
(* ── Instrumenting a form with (pause) ─────────────────────────────── *)
|
|
|
|
(* [C-u C-c C-c] marks a form so the program stops when it runs — docs/DISCUSS.md
|
|
§9. The mark travels beside the source as a position and is applied *here*,
|
|
to the AST, rather than being spliced into the text the editor sends: text
|
|
would shift every line and column after the insertion, and the error
|
|
overlays, the layout, the break loop's frame locations and DWARF all read
|
|
those. Applied after parsing, every location is already attached and none of
|
|
them moves.
|
|
|
|
Nothing in the compiler knows about this. [(pause)] is an ordinary prelude
|
|
function — [error] under a [restart-case] — so an instrumented body is a
|
|
body that calls one more function, and the break loop it lands in is the one
|
|
an unhandled condition already builds. *)
|
|
|
|
(* Rebuild [e] with [f] applied to each expression written directly inside it.
|
|
Exhaustive on purpose: a constructor left out would be a form the mark
|
|
silently cannot be set inside, which is the kind of hole nobody finds
|
|
except by trying it on the one function they wanted to stop in. *)
|
|
let map_children f (e : expr) : expr =
|
|
let ex = f in
|
|
let bind (b : binding) = { b with bval = ex b.bval } in
|
|
let arm (a : arm) = { a with body = List.map ex a.body } in
|
|
let hcl (h : hclause) = { h with hbody = List.map ex h.hbody } in
|
|
let rcl (r : rclause) = { r with rbody = List.map ex r.rbody } in
|
|
let place = function
|
|
| Pvar n -> Pvar n
|
|
| Pfield (x, n) -> Pfield (ex x, n)
|
|
| Pindex (x, is) -> Pindex (ex x, List.map ex is)
|
|
| Pderef x -> Pderef (ex x)
|
|
in
|
|
let kind =
|
|
match e.e with
|
|
| Int _ | Float _ | Byte _ | Str _ | Kw _ | Quote _ | Var _ | ArrayOf _
|
|
| Break _ | Continue _ -> e.e
|
|
| Do es -> Do (List.map ex es)
|
|
| Let (bs, es) -> Let (List.map bind bs, List.map ex es)
|
|
| If (c, a, b) -> If (ex c, ex a, Option.map ex b)
|
|
| While (l, c, es) -> While (l, ex c, List.map ex es)
|
|
| Loop (bs, es) -> Loop (List.map (fun (n, v) -> (n, ex v)) bs, List.map ex es)
|
|
| Recur es -> Recur (List.map ex es)
|
|
| Return x -> Return (Option.map ex x)
|
|
| Set (p, v) -> Set (place p, ex v)
|
|
| Field (x, n) -> Field (ex x, n)
|
|
| Call (fn, args) -> Call (ex fn, List.map ex args)
|
|
| Match (s, arms) -> Match (ex s, List.map arm arms)
|
|
| Struct (n, fs) -> Struct (n, List.map (fun (n, v) -> (n, ex v)) fs)
|
|
| Bare fs -> Bare (List.map (fun (n, v) -> (n, ex v)) fs)
|
|
| MapLit (tag, kvs) -> MapLit (tag, List.map (fun (k, v) -> (ex k, ex v)) kvs)
|
|
| Arr es -> Arr (List.map ex es)
|
|
(* Not leaves: the fill value and the generator are ordinary
|
|
subexpressions. The dimensions are [len]s and hold none. *)
|
|
| ArrayFill (ds, v) -> ArrayFill (ds, ex v)
|
|
| ArrayGen (ds, f) -> ArrayGen (ds, ex f)
|
|
| Fn (ps, es) -> Fn (ps, List.map ex es)
|
|
| Dotimes (l, n, b, es) ->
|
|
Dotimes (l, n,
|
|
{ dstart = Option.map ex b.dstart;
|
|
dstop = ex b.dstop;
|
|
dstep = Option.map ex b.dstep },
|
|
List.map ex es)
|
|
| Defer es -> Defer (List.map ex es)
|
|
| Unwrap (u, x) -> Unwrap (u, ex x)
|
|
| HandlerBind (cs, es) -> HandlerBind (List.map hcl cs, List.map ex es)
|
|
| HandlerCase (b, cs) -> HandlerCase (ex b, List.map hcl cs)
|
|
| Signal (k, x) -> Signal (k, ex x)
|
|
| RestartCase (b, cs) -> RestartCase (ex b, List.map rcl cs)
|
|
| InvokeRestart (n, args) -> InvokeRestart (n, List.map ex args)
|
|
in
|
|
{ e with e = kind }
|
|
|
|
let pause_call loc = { e = Call ({ e = Var "pause"; loc }, []); loc }
|
|
|
|
(* [mark_pause ~line ~col ds] is [ds] with a [(pause)] put in front of whatever
|
|
starts at that position, or [None] when nothing does.
|
|
|
|
[None] rather than "leave it alone": installing an unmarked body and
|
|
answering "ok" would report a breakpoint that is not there, which is the
|
|
failure the session refuses everywhere else.
|
|
|
|
Pre-order, and it stops at the first hit. Desugaring gives several nested
|
|
nodes the same location — [(when c a)] becomes an [If] whose else-less
|
|
branch is a [Do] at the [when]'s own position — so the outermost of those is
|
|
the one the editor pointed at.
|
|
|
|
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 at (l : Loc.t) = l.Loc.line = line && l.Loc.col = col in
|
|
let hit = ref false in
|
|
let rec walk (e : expr) =
|
|
if !hit then e
|
|
else if at e.loc then begin
|
|
hit := true;
|
|
(* 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 ] }
|
|
end
|
|
else map_children walk e
|
|
in
|
|
let body es = List.map walk es in
|
|
let decl (d : decl) =
|
|
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 } }
|
|
| 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
|
|
— the [at d.dloc] case above — is deliberately not offered for either:
|
|
a method is not a function of its own by the time it runs, so there is
|
|
no entry to stop at, only the forms inside it. *)
|
|
| Defmethod m ->
|
|
{ d with d = Defmethod { m with mfn = { m.mfn with fbody = body m.mfn.fbody } } }
|
|
| Defmulti f -> { d with d = Defmulti { f with fbody = body f.fbody } }
|
|
| Defvar (n, t, Init e, k) -> { d with d = Defvar (n, t, Init (walk e), k) }
|
|
(* The value reading of an undecided [defonce] is walked too: if it is the
|
|
one that wins it is an initialiser like any other, and if the type
|
|
reading wins the expression is dropped whole and the mark with it. *)
|
|
| Defvar (n, t, Ambiguous e, k) ->
|
|
{ d with d = Defvar (n, t, Ambiguous (walk e), k) }
|
|
| Defconst (n, t, e) -> { d with d = Defconst (n, t, walk e) }
|
|
| _ -> d
|
|
in
|
|
let ds = List.map decl ds in
|
|
if !hit then Some ds else None
|