293 lines
14 KiB
OCaml
293 lines
14 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 (* {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}) *)
|
|
| 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 *)
|
|
(* 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 of string option * string * expr * expr list (* (dotimes :o [i n] ...) *)
|
|
| 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
|
|
| 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
|
|
|
|
(* 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 }
|
|
|
|
(* 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;
|
|
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
|
|
| Defunion of string * variant 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. *)
|
|
| Defvar of string * texpr option * init
|
|
| Defconst of string * texpr option * expr
|
|
|
|
and variant = { vname : string; vfields : field list; vloc : Loc.t }
|
|
|
|
and init = Zeroed | Uninit | Init of expr
|
|
|
|
(* 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. *)
|
|
let declared_name (d : decl) =
|
|
match d.d with
|
|
| Defenum (n, _) | Defalias (n, _) | Defstruct (n, _) | Defunion (n, _)
|
|
| Defvar (n, _, _) | Defconst (n, _, _) -> Some n
|
|
| Declare (fn, _) | DeclareC (fn, _) | Defn fn -> Some fn.name
|
|
| 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)
|
|
| Arr es -> Arr (List.map ex es)
|
|
| Fn (ps, es) -> Fn (ps, List.map ex es)
|
|
| Dotimes (l, n, c, es) -> Dotimes (l, n, ex c, 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)
|
|
| 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 } }
|
|
| Defvar (n, t, Init e) -> { d with d = Defvar (n, t, Init (walk e)) }
|
|
| 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
|