669 lines
35 KiB
OCaml
669 lines
35 KiB
OCaml
(** The typed IR: what the checker produces and what every backend consumes.
|
||
|
||
Every backend shares this — the LLVM emitter and the hand-written x86-64
|
||
one, each of them under dev redefinition and under the release AOT build
|
||
(plan.org, Compilation) — so everything a backend would otherwise have to
|
||
re-derive is resolved here and nowhere else:
|
||
|
||
- names are gone. A local is a slot index into the frame, a global is a
|
||
name, and a call names its callee directly. No environment lookup.
|
||
- field access is an index, not a string, and any auto-deref the source
|
||
relied on is an explicit [Deref] node.
|
||
- literals have a machine type. There is no untyped 1 past this point.
|
||
- a struct literal lists every field in declaration order, with the omitted
|
||
ones filled in as [Zero] — ZII is settled here rather than at runtime.
|
||
- sugar is already gone from the AST; what is left is the small set below. *)
|
||
|
||
type prim =
|
||
(* arithmetic and comparison, per machine type — the operands carry their own
|
||
kind at runtime, so one constructor covers every width *)
|
||
| Add | Sub | Mul | Div | Rem
|
||
| Eq | Ne | Lt | Le | Gt | Ge
|
||
| Not
|
||
(* bitwise, integers only. [Shr] is arithmetic on a signed type and logical
|
||
on an unsigned one, which is what the operand's own kind already says. *)
|
||
| BitAnd | BitOr | BitXor | Shl | Shr
|
||
(* One operand each, and the answer has the operand's type. [Clz] and [Ctz]
|
||
answer the width for zero. [Rotl] and [Rotr] take the count modulo the
|
||
width, so no count is out of range. *)
|
||
| BitNot | Popcount | Clz | Ctz | Rotl | Rotr
|
||
(* containers: fixed arrays and slices only at milestone 2 *)
|
||
| Len | At | Slice
|
||
(* (slice-from p n): a [T] made out of a (Ptr T) and a length the caller
|
||
supplies. It builds the same two words [Slice] builds and allocates
|
||
nothing — the storage stays whoever's it was, which in practice is C's.
|
||
The one thing the compiler cannot check is whether n is the truth; see
|
||
check.ml's "slice-from" case for what it can. *)
|
||
| SliceFrom
|
||
(* the milestone-2 host primitives, plan.org. The four conversions are
|
||
*text*: bytes->f64 parses "12.5", f64->bytes renders it — that is what
|
||
calc-me's tokenizer and the prelude's printers each need. *)
|
||
| Bytes | BytesToF64 | BytesToI64 | F64ToBytes | I64ToBytes
|
||
(* (string b): the other direction of [Bytes], and the same non-instruction.
|
||
See check.ml's "str" case for why it is unchecked. *)
|
||
| StrOfBytes
|
||
(* No surface name: the structural printer is the only thing that builds
|
||
these. U64ToBytes because u64 is not i64 with a flag, EscapeBytes for a
|
||
string nested inside a printed structure. *)
|
||
| U64ToBytes | EscapeBytes
|
||
| WriteStdout | Exit | Argv
|
||
(* A call into the runtime's C, named by symbol. The argument and result
|
||
LLVM types come off the expression nodes themselves, so one constructor
|
||
covers every entry point the allocator and container runtime has and the
|
||
backend grows one arm rather than one per operation — which matters
|
||
because spec-memory.md's runtime is type-erased and therefore *is* a list
|
||
of C entry points. A string or slice argument crosses as ptr+len, the
|
||
same rule as every other shim here. No transfer guard follows one: a
|
||
transfer cannot cross a C frame. *)
|
||
| Rt of string
|
||
(* spec-memory.md, "Alignment": a property of the type, computed at the call
|
||
site, passed as a parameter to the type-erased allocator — all three, and
|
||
they are not alternatives. The checker builds these at the site where the
|
||
concrete element type is known and the backend fills in the number from
|
||
the same layout calculator DWARF uses. *)
|
||
| SizeOf of Types.t
|
||
| AlignOf of Types.t
|
||
(* The address of any expression, not only of a place: the element a [push]
|
||
copies may be a computed value, and the runtime takes it by pointer
|
||
because it is type-erased. The backend already spills a non-place to a
|
||
temporary for exactly this. *)
|
||
| AddrOf
|
||
| Cast of Types.t
|
||
|
||
type expr = { e : expr_kind; ty : Types.t; loc : Loc.t }
|
||
|
||
and expr_kind =
|
||
| Int of int64 * Types.ikind
|
||
| Float of float * Types.fkind
|
||
| Bool of bool
|
||
| Str of string
|
||
| Unit
|
||
| Zero of Types.t (* ZII: all-bytes-zero of this type *)
|
||
| Uninit of Types.t (* the explicit opt-out *)
|
||
(* [(filled b)]: every byte of this type set to [b]. [Zero] with a byte the
|
||
program chooses, and a separate node rather than a byte on [Zero] because
|
||
that byte is an *expression* — a memset's operand, not a literal — and
|
||
every reader of [Zero] treats it as a leaf with nothing under it.
|
||
|
||
[(dead-beef PATTERN)]: the pattern's four bytes repeating, ascending
|
||
through the storage, so a hex dump reads the pattern left to right —
|
||
DEADBEEF by default, and whatever u32 was written otherwise. The operand
|
||
is always present by the time it reaches here: [(dead-beef)] is checked
|
||
into [(dead-beef 0xDEADBEEF)], so a backend has one shape to lower and
|
||
the default cannot acquire a code path of its own. A size that is not a
|
||
multiple of four ends on a prefix of the pattern — DE, DE AD, DE AD BE
|
||
for the default — which both backends produce identically.
|
||
|
||
The operand is an expression and not an [int32] for the same reason
|
||
[Fill]'s byte is: it may be computed. A literal one is folded by each
|
||
backend into the immediate it always was; anything else is evaluated and
|
||
byte-reversed at run time. *)
|
||
| Fill of Types.t * expr
|
||
| DeadBeef of Types.t * expr
|
||
| Local of int (* slot index into the frame *)
|
||
| Global of string
|
||
| Prim of prim * expr list
|
||
| Call of string * expr list (* a call naming its callee *)
|
||
(* The address of a function the compiler emitted, by symbol. Which symbol
|
||
table, and whether the surface language can see it, is [fnref]'s job.
|
||
|
||
Two unrelated consumers, and the difference between them is the whole
|
||
reason [fnref] has three cases rather than two. The compiler's own uses —
|
||
the Map's hash and equality pair (Odin's [Map_Info] is two contextless
|
||
[proc] fields reached exactly this way) and a handler-bind clause's
|
||
symbol — want the *symbol*, always, and carry the Flan type [Alloc]. A
|
||
function *value* someone wrote wants the body that is current, which in a
|
||
dev build is not the symbol but whatever the indirection cell holds, and
|
||
carries the Flan type [Fn]. *)
|
||
| FnAddr of fnref
|
||
(* A function value with an environment: the lifted body, and one of two
|
||
things, told apart by the second expression's type.
|
||
|
||
- A pointer: the address of a slot of this frame holding the copies, filled
|
||
by the [Let] around this node. A value that never outlives its frame.
|
||
- The environment struct itself — a [Make] of the struct the checker
|
||
synthesised, every field a read of a local. The backend allocates the
|
||
environment from the collector ([flan_dyn_env_new], with the struct's
|
||
descriptor), stores the copies into it, and pairs its address with the
|
||
code. A value that may outlive its frame: spec-memory.md's case 3.
|
||
|
||
[Check.place_closures] decides which, once the whole program is checked.
|
||
|
||
Its own node rather than a field on [FnAddr] because the two answer
|
||
different questions: [FnAddr] is an address, and is asked for by three
|
||
unrelated readers that want a bare symbol ([Alloc]-typed, see [fnref]),
|
||
while this is a *value* of type [Fn] and can never be anything else. *)
|
||
| Closure of fnref * expr
|
||
(* A (CFn ...) value where a (Fn ...) is wanted. The one coercion between
|
||
the two function types, and it goes this way only: there is nowhere for
|
||
an environment to go in the other direction.
|
||
|
||
The pair it builds is {thunk, the address}: the *thunk's* code, one per
|
||
signature, with the original bare address stored where an environment
|
||
would be. The thunk reads it back out and calls it. So a value reached
|
||
through this is reached by a body that really does take an environment,
|
||
which is what keeps every indirect call exactly typed — including on
|
||
wasm32, where [call_indirect] checks the signature and an argument the
|
||
callee did not declare is a trap rather than a register nobody reads.
|
||
|
||
The string is the thunk's name, minted and memoised by the checker: the
|
||
backends emit the pair and derive nothing. What it costs is one hop per
|
||
call, paid by a *name* handed to an [Fn]-typed parameter and by nothing
|
||
else — a literal, capturing or not, is compiled to take an environment
|
||
and needs no thunk. A signature that wants the address alone writes
|
||
[CFn] and pays nothing at all, which is what the type is for. *)
|
||
| Thicken of string * expr
|
||
(* A call through a function value: the callee is an expression of type
|
||
[Fn], not a name. Its own node rather than a [Call] with an expression in
|
||
the name slot, because everything that walks this IR treats [Call]'s
|
||
string as a *link-time* edge — [Reach] roots the callee, [Dev] finds the
|
||
cell to redefine, [Emit] may load that cell — and none of those are
|
||
questions an indirect call can answer. Keeping them apart means each of
|
||
those readers keeps working on the direct case unchanged and says
|
||
explicitly what it does with the indirect one. *)
|
||
| CallPtr of expr * expr list
|
||
| Do of expr list
|
||
| Let of (int * expr) list * expr list
|
||
| If of expr * expr * expr
|
||
(* condition, body, and the *latch*: forms that run after the body and before
|
||
the condition is tested again. [dotimes] folds its increment in there
|
||
rather than onto the end of the body, because a [continue] branches to the
|
||
latch and a step written in the body would be skipped — the loop would
|
||
never advance and would hang. A [while] has an empty latch. *)
|
||
| While of expr * expr list * expr list
|
||
| Return of expr option
|
||
(* Leaving a loop, and jumping to its latch. The int is how many loops out
|
||
the target is, innermost first: 0 is the loop this is directly inside.
|
||
A *relative* depth rather than a name or an id because it is exactly what
|
||
each backend already has — [emit] keeps one entry per [While] it is inside
|
||
and indexes it. The invariant that makes it sound: the checker mints these
|
||
only from its own loop stack, and both stacks are pushed once per [While].
|
||
A [While] the checker *invents* (alloc_guard, the file-failure retry) is
|
||
built directly and never contains one of these, so the entry it pushes in
|
||
[emit] matches nothing and is harmless — keep it that way.
|
||
|
||
[check_loop]'s [While] is the one exception and the exception proves the
|
||
rule: it *is* pushed on [ctx.loops], so the [Break 0] that leaves it and
|
||
every [Continue] a [recur] mints are counted against the same stack [emit]
|
||
indexes. Invented is not the property that matters; being on the stack
|
||
is. *)
|
||
| Break of int
|
||
| Continue of int
|
||
| Set of place * expr
|
||
| Field of expr * int (* target is already a struct value *)
|
||
| Addr of place
|
||
| Deref of expr
|
||
| Make of string * expr list (* struct literal, every field, in order *)
|
||
(* A data type value: the data type's name, the case's name, and every
|
||
field of that case in declaration order with the omitted ones filled in
|
||
as [Zero] — the
|
||
same ZII rule [Make] carries, and settled here for the same reason. It is
|
||
its own node rather than a [Make] over a synthesised struct because the
|
||
value's *type* is the data type and its payload is a byte blob the case is
|
||
reinterpreted into; a backend that saw only [Make] would have to rederive
|
||
which of the two it was looking at. *)
|
||
| MakeCase of string * string * expr list
|
||
(* One field of one case of a data type value, by index. The case name is on the
|
||
node because the payload is untyped bytes: [Field]'s index alone cannot
|
||
say which case struct the blob is being read as. [match] is the only thing
|
||
that proves the case, so this is only ever built under an arm that
|
||
checked the tag — and by [Render], which reads a field only after the same
|
||
comparison. One node, so the payload layout is known in exactly one place
|
||
in each backend rather than once per reader. *)
|
||
| CaseField of expr * string * int
|
||
| Arr of expr list (* fixed-array literal *)
|
||
| Some_ of expr
|
||
| None_
|
||
| Match of expr * arm list
|
||
(* (some x): unwrap Some, else early-return None from the enclosing function.
|
||
An early return, not an expression that can fail — hence its own node. *)
|
||
| UnwrapSome of expr
|
||
(* Conditions, spec-conditions.md. [Signal] walks the handler stack and
|
||
returns Unit whatever it finds — with nothing matching it is a no-op, so
|
||
nothing here alters control flow. [HandlerBind] pushes one frame per
|
||
clause, runs its body, and pops them; each clause was lifted into its own
|
||
function by the checker, so what is left is the frame and the call. *)
|
||
| Signal of sigkind * condesc * expr (* how, what, the condition *)
|
||
| Handled of hframe list * expr list
|
||
(* The transfer, spec-conditions.md §3–§6. [RestartCase] pushes one frame per
|
||
clause, runs its body, and pops them; if a transfer arrives naming one of
|
||
*its* frames it runs that clause instead, and the whole form yields either
|
||
way. [InvokeRestart] looks the name up on the restart stack, writes the
|
||
frame it found into the transfer channel and leaves — it has type Never,
|
||
so nothing follows it.
|
||
|
||
[InvokeRestart]'s arguments are already evaluated: the checker binds each
|
||
to a slot and wraps the node in a [Let], so what is left here is a list of
|
||
locals to copy into the frame. Two reasons, and both matter. An argument
|
||
that transfers on its own must be guarded before this one aims the
|
||
channel; and a call written in an argument has to be on the walk [Reach]
|
||
and [Load] already do, which a list hanging off a node they treat as a
|
||
leaf would not be. [rsig] is the argument types as written, and [rsig_id]
|
||
their hash — §3's run-time check, since the name is resolved on a stack
|
||
nothing static can see.
|
||
|
||
Not every one of these was written as a [restart-case]. A [handler-case]
|
||
is a [Handled] whose clause invokes a restart, wrapped in one of these to
|
||
catch it — see [Check.check_handler_case] — so the unwinding handler
|
||
reaches a backend as this node and needs nothing of its own. A clause
|
||
whose name begins with [handler-case/] is one the checker made up for
|
||
that. *)
|
||
| RestartCase of rclause list * expr
|
||
(* (with-allocator A BODY...) — spec-memory.md. It rebinds the current
|
||
allocator for its dynamic extent and releases nothing. Its own node
|
||
because the restore has to happen on the *transfer* path too: a body that
|
||
errors, or a restart taken from inside it, must not leave the context
|
||
allocator pointing at a region the handler knows nothing about. *)
|
||
| WithAlloc of expr * expr list
|
||
(* name id, name, arguments, their spelling, its hash, where *)
|
||
| InvokeRestart of int * string * expr list * string * int * Loc.t
|
||
|
||
(* [Serror] is §2's diverging variant: the same lookup, type Never, and with
|
||
nothing transferring the program stops rather than carrying on. *)
|
||
(* Which symbol table the address comes out of. [Flanfn] is a function this
|
||
compiler emitted and is therefore name-mangled and reachability-tracked;
|
||
[Rtfn] is a C entry point in flan_rt.c, spelled as written. The two are
|
||
interchangeable at the call site because a Flan function's emitted signature
|
||
is its parameters followed by the transfer channel, and the runtime's
|
||
matching typedef spells that last pointer out. *)
|
||
(* [Flanfn] is a function this compiler emitted, named by its mangled symbol,
|
||
and always the symbol itself. [Rtfn] is a C entry point in flan_rt.c, spelled
|
||
as written. [Fnval] is also a Flan function this compiler emitted, but as a
|
||
*value* someone asked for by writing its name — and it is a separate case
|
||
because a dev build must answer it with the current body rather than with the
|
||
original symbol, which means a load from the indirection cell. The first two
|
||
must never take that path: a lifted handler clause and a hash pair have no
|
||
cell to load from. The three are interchangeable at a call site, because a
|
||
Flan function's emitted signature is its parameters followed by the transfer
|
||
channel and the runtime's matching typedef spells that last pointer out. *)
|
||
and fnref = Flanfn of string | Rtfn of string | Fnval of string
|
||
|
||
and sigkind = Ssignal | Serror
|
||
|
||
(* What a signal site says about its condition, which the backends write out
|
||
as a constant the runtime's [flan_condesc] reads: the type's name, the type
|
||
ids from its own to its root ([Check.condition_chain]), and how a handler
|
||
for a parent is told what it caught. *)
|
||
and condesc =
|
||
{ cname : string; cchain : int list;
|
||
(* The type's own fields are Error's, so the condition is its own view:
|
||
a handler for a parent reads its [name] and [message] directly. *)
|
||
cself : bool;
|
||
(* The lifted function that prints the condition, with its values, into
|
||
the runtime's message sink — what a handler for a parent reads as the
|
||
message. [None] when nothing can catch it through a parent. *)
|
||
crender : string option }
|
||
|
||
and place =
|
||
| Plocal of int
|
||
| Pglobal of string
|
||
| Pfield of expr * int
|
||
| Pindex of expr * expr list
|
||
| Pderef of expr
|
||
|
||
(* A pushed handler: which condition type it matches, the lifted function that
|
||
runs when one is signalled, and the environment that function is handed.
|
||
|
||
[henv] is the address of the establishing frame's copies of whatever the
|
||
clause captured, or [None] when it captured nothing. It is sound for the
|
||
same reason the frame itself is: a handler frame is popped by the body that
|
||
pushed it, so it can never be reached from outside the extent of the
|
||
function whose stack both it and the environment live on. There is no
|
||
escaping case here to defer. *)
|
||
and hframe = { htype : int; hfn : string; henv : expr option }
|
||
|
||
(* A restart clause. [rname_id] is what [invoke-restart] matches by name; the
|
||
body is a branch in the function that wrote it, because unlike a handler a
|
||
clause runs at the restart-case, which is where it was written.
|
||
|
||
[rparams] are the slots §3's parameters are bound to, in order, with their
|
||
types; the invoker stores into a buffer this frame owns and the clause loads
|
||
them from it. [rsig] is how those types are spelled and [rsig_id] its hash:
|
||
what the two ends compare, since neither can see the other.
|
||
|
||
[rloc], [rreport] and [rhidden] are for a break loop and nothing else: where
|
||
the clause is written, the sentence it shows beside its name ([""] when it
|
||
wrote none), and whether it is one the checker made up — a [handler-case]'s
|
||
own landing, which no one at a break loop could mean to take. *)
|
||
and rclause =
|
||
{ rname_id : int; rname : string; rparams : (int * Types.t) list;
|
||
rsig : string; rsig_id : int; rbody : expr list;
|
||
rloc : Loc.t; rreport : string; rhidden : bool }
|
||
|
||
(* [binds] are the slots the pattern's fields are bound to, in field order. *)
|
||
and arm = { acase : string option; binds : int list; abody : expr list }
|
||
|
||
type field = { fname : string; fty : Types.t }
|
||
|
||
type structure = { sname : string; fields : field list }
|
||
|
||
type variant = { vname : string; vfields : field list }
|
||
|
||
type data = { dname : string; cases : variant list }
|
||
|
||
type fn = {
|
||
name : string;
|
||
params : Types.t list; (* bound to slots 0 .. n-1, in order *)
|
||
slots : Types.t array; (* the frame: one entry per slot *)
|
||
(* What the source called each slot, parallel to [slots]. [None] is a slot
|
||
the compiler made up and no one wrote a name for -- [dotimes]'s hidden
|
||
bound, the pair (min) and (max) evaluate their operands into, the slot a
|
||
tail expression goes through. Names are otherwise gone from this IR (see
|
||
the header); this is the one exception, and it exists so a debug build can
|
||
emit a [!DILocalVariable] that says [lo] where the source said [lo]. A
|
||
backend is free to ignore it entirely -- nothing is *resolved* through it,
|
||
and a slot is still only ever referred to by index. *)
|
||
snames : string option array;
|
||
(* The slots an [as] bound (decision 136): named, and read-only, so
|
||
evaluating in a stopped frame may read them and may not assign them,
|
||
as the program itself may not. *)
|
||
as_slots : int list;
|
||
ret : Types.t;
|
||
body : expr list;
|
||
(* The defers again, innermost first. [body] already has them spliced onto
|
||
the normal exit path; this is the same list for the *transfer* exit path,
|
||
which leaves through a landing block the backend builds and no form in
|
||
[body] can reach. spec-conditions.md §5: they run, and errdefer does not.
|
||
|
||
Not quite the same list: each one here is wrapped in a test of the
|
||
counter [Check.register_defer] stores into, because a transfer can start
|
||
above a defer the text has not reached — in the initialiser of the very
|
||
[let] whose body it is written in, which is [slurp]'s shape — and a
|
||
cleanup over a binding nothing wrote is not cleanup. The normal paths
|
||
need no test: falling off the end is below every defer, and a [return]
|
||
carries only the ones above it. A backend runs this list as it stands. *)
|
||
fdefers : expr list;
|
||
(* Set on a function the checker made up rather than one anyone wrote: a
|
||
handler-bind clause, lifted out of the function named here. It is reached
|
||
by address from that function's body and from nowhere else, so it needs no
|
||
cell and no registry slot, and a redefinition of the parent carries its
|
||
own copy. *)
|
||
fparent : string option;
|
||
(* The slot the environment parameter is stored into, on a function that
|
||
was lifted out of something and captures one of its locals. Every
|
||
emitted signature takes the environment (see Emit's [env_param]) and
|
||
almost every function ignores it; this is the one that does not, and it
|
||
says where the pointer goes rather than fixing an index by convention,
|
||
because the slot is minted by [fresh_slot] like any other and a rule of
|
||
the form "the slot after the parameters" would be a second thing to keep
|
||
in step with the allocation order.
|
||
|
||
[None] on everything anyone wrote. A capturing body reads its copies out
|
||
of this pointer once, at entry, into named slots of its own — so the
|
||
copy the value was made with is the copy the body sees. *)
|
||
fenv : int option;
|
||
floc : Loc.t;
|
||
}
|
||
|
||
(* [gfolded] is the difference between a constant whose value the *checker*
|
||
consumed — an array length, decided before any type resolves — and one that
|
||
is only ever read at run time. The first is in the program's shape and can
|
||
never be reloaded; the second is just bytes in memory and can. Nothing else
|
||
can tell them apart afterwards, so it is recorded here. *)
|
||
type global = {
|
||
gname : string;
|
||
gty : Types.t;
|
||
ginit : expr;
|
||
gconst : bool;
|
||
gfolded : bool;
|
||
(* [def] rather than [defonce]: the initialiser runs on every daemon
|
||
re-run instead of once behind a flag. [Emit.startup_plan] is the
|
||
consumer of that. [Session.eval] is the other reader, for the half of
|
||
[defparameter] that is not about re-runs at all — evaluating one
|
||
assigns, so a re-evaluated [def] stores its new value at the next frame
|
||
boundary as well. *)
|
||
grerun : bool;
|
||
}
|
||
|
||
(* A foreign function: no body, and [esym] is the symbol the linker sees. The
|
||
aggregate calling convention is not modelled here — a C shim flattens every
|
||
struct that crosses the boundary, so clang classifies it per target and
|
||
nothing in the backend has to know x86-64 from arm64 from wasm32. *)
|
||
type extern = {
|
||
ename : string; (* the Flan name, e.g. rl/init-window *)
|
||
esym : string; (* the C symbol *)
|
||
(* Where the [declare] was written. Carried so a refusal over a foreign
|
||
signature can point at it rather than at <unknown>, which is what the
|
||
dyn boundary check had to do before this field existed. *)
|
||
eloc : Loc.t;
|
||
eparams : Types.t list;
|
||
eret : Types.t;
|
||
}
|
||
|
||
type program = {
|
||
structs : structure list;
|
||
datas : data list;
|
||
(* The untagged unions, carried as [structure] values: a union's members are
|
||
a field list whose every offset is zero, so the record a struct uses says
|
||
all of it. Which list a name came out of is what a backend reads to know
|
||
whether to accumulate the offsets or not. *)
|
||
unions : structure list;
|
||
globals : global list; (* in declaration order *)
|
||
externs : extern list;
|
||
fns : fn list;
|
||
(* The C the program's own (declare-c ...) forms generated, if any: one
|
||
translation unit, compiled into the build like a package's hand-written
|
||
.c file. It is on the program rather than beside it so that every driver
|
||
— the CLI, the REPL, the acceptance table — carries it without knowing
|
||
it exists. See [Shim]. *)
|
||
(* The generated FFI shim, in parts keyed by the declaration each serves,
|
||
with "" for the shared preamble. Parts rather than one string so that
|
||
[Reach.link] can drop a wrapper whose binding nothing reachable calls. *)
|
||
cshim : (string * string) list;
|
||
}
|
||
|
||
(* ── Walking an expression ─────────────────────────────────────────── *)
|
||
|
||
(* Every node of an expression, outermost first, the ones hanging off a [place]
|
||
included. One traversal in the IR's own file rather than one per reader:
|
||
three passes ask structural questions of a body — what names it refers to
|
||
([Reach]), whether a global's initialiser can transfer, and which globals it
|
||
reads ([Check]) — and each of them that spelled the traversal out again was
|
||
a place a new constructor could be forgotten in. What differs between those
|
||
readers is the question, which is [f]. The shape of the IR is not theirs to
|
||
restate.
|
||
|
||
A lifted clause's body is not in here: it is a function of its own, and this
|
||
walks one expression. A reader that wants it follows [hfn], the way [Reach]
|
||
does. *)
|
||
(* The name [(watch ...)] asks the table under, and the test a backend uses to
|
||
recognise the [If] the checker wraps a watch's rendering in. The checker
|
||
does not know whether the build is a dev one; a backend does, and outside a
|
||
dev build it lowers the whole [If] to its else branch, which is unit — so a
|
||
release build keeps only the value's own evaluation, bound before the [If],
|
||
and makes no call into the runtime at all. *)
|
||
let watch_begin = "flan_dev_watch_begin_n"
|
||
|
||
let is_watch_guard (c : expr) =
|
||
match c.e with
|
||
| Prim (Ne, [ { e = Prim (Rt s, _); _ }; _ ]) -> String.equal s watch_begin
|
||
| _ -> false
|
||
|
||
(* The value positions of an expression: the forms whose value is the
|
||
expression's value — a block's last form, both arms of an [if], every
|
||
arm of a [match] and of a [restart-case]. Everything that asks "what does
|
||
this expression answer with" walks these, so a form that carries a value
|
||
through from one of its parts is added here once. [map_tails ~ty] rebuilds
|
||
the expression with each value position replaced by [f] of it and every
|
||
form on the way given [ty]; a position that never arrives (its type
|
||
Never) is left alone unless [all]. A form [stop] answers yes for is taken
|
||
as a value position whole, not looked into. *)
|
||
let rec map_tails ?(all = false) ?(stop = fun _ -> false) ?ty (f : expr -> expr)
|
||
(e : expr) : expr =
|
||
let go = map_tails ~all ~stop ?ty f in
|
||
let last es =
|
||
match List.rev es with
|
||
| x :: rest -> List.rev (go x :: rest)
|
||
| [] -> es
|
||
in
|
||
let retype k =
|
||
let t = match ty with Some t -> t | None -> e.ty in
|
||
{ e with e = k; ty = (if e.ty = Types.Never then e.ty else t) }
|
||
in
|
||
if stop e then f e else
|
||
match e.e with
|
||
| Do es -> retype (Do (last es))
|
||
| Let (bs, es) -> retype (Let (bs, last es))
|
||
| WithAlloc (a, es) -> retype (WithAlloc (a, last es))
|
||
| Handled (hs, es) -> retype (Handled (hs, last es))
|
||
| If (c, a, b) -> retype (If (c, go a, go b))
|
||
| Match (sc, arms) ->
|
||
retype (Match (sc, List.map (fun a -> { a with abody = last a.abody }) arms))
|
||
| RestartCase (cs, body) ->
|
||
retype
|
||
(RestartCase (List.map (fun c -> { c with rbody = last c.rbody }) cs, go body))
|
||
| _ -> if e.ty = Types.Never && not all then e else f e
|
||
|
||
let iter_tails ?stop (f : expr -> unit) (e : expr) =
|
||
ignore (map_tails ~all:true ?stop (fun x -> f x; x) e)
|
||
|
||
let rec walk (f : expr -> unit) (e : expr) =
|
||
f e;
|
||
let go = walk f in
|
||
let gos = List.iter go in
|
||
match e.e with
|
||
| Int _ | Float _ | Bool _ | Str _ | Unit | Zero _ | Uninit _ | Local _
|
||
| Global _ | None_ | FnAddr _ | Break _ | Continue _ -> ()
|
||
(* Both carry an operand, and it must be walked: a call written inside a
|
||
fill's byte or a dead-beef's pattern is a call, and [Reach] roots what it
|
||
finds here. A leaf row would drop it silently — the match would still
|
||
compile. *)
|
||
| Fill (_, b) | DeadBeef (_, b) -> go b
|
||
| Prim (_, es) | Call (_, es) | Do es | Make (_, es) | MakeCase (_, _, es)
|
||
| Arr es | InvokeRestart (_, _, es, _, _, _) -> gos es
|
||
| CallPtr (c, es) -> go c; gos es
|
||
| Let (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body
|
||
| If (a, b, c) -> go a; go b; go c
|
||
| While (c, body, latch) -> go c; gos body; gos latch
|
||
| Return v -> Option.iter go v
|
||
| Set (p, v) -> walk_place f p; go v
|
||
| Addr p -> walk_place f p
|
||
| Field (t, _) | Deref t | CaseField (t, _, _) | Some_ t | UnwrapSome t
|
||
| Signal (_, _, t) | Closure (_, t) | Thicken (_, t) -> go t
|
||
| Match (sc, arms) -> go sc; List.iter (fun a -> gos a.abody) arms
|
||
| Handled (hs, body) ->
|
||
List.iter (fun h -> Option.iter go h.henv) hs; gos body
|
||
| RestartCase (cs, body) -> List.iter (fun c -> gos c.rbody) cs; go body
|
||
| WithAlloc (a, body) -> go a; gos body
|
||
|
||
and walk_place f (p : place) =
|
||
match p with
|
||
| Plocal _ | Pglobal _ -> ()
|
||
| Pfield (t, _) | Pderef t -> walk f t
|
||
| Pindex (t, idx) -> walk f t; List.iter (walk f) idx
|
||
|
||
(* [e] with every read, store and address of a local slot [f] answers for
|
||
replaced: a read of slot [i] by [Deref p], its place by [Pderef p], where
|
||
[f i loc] is [Some p], a pointer to where the value really lives. The one
|
||
caller is evaluating in a stopped frame, whose locals are the other frame's
|
||
slots reached by address. Slots [f] answers [None] for are left alone, and
|
||
so is every binder: only the slots [f] names are replaced, and none of them
|
||
is bound inside [e]. *)
|
||
let rec rewrite_locals (f : int -> Loc.t -> expr option) (e : expr) : expr =
|
||
let go = rewrite_locals f in
|
||
let gos = List.map go in
|
||
let kind =
|
||
match e.e with
|
||
| Local i ->
|
||
(match f i e.loc with Some p -> Deref p | None -> e.e)
|
||
| Int _ | Float _ | Bool _ | Str _ | Unit | Zero _ | Uninit _ | Global _
|
||
| None_ | FnAddr _ | Break _ | Continue _ -> e.e
|
||
| Fill (t, b) -> Fill (t, go b)
|
||
| DeadBeef (t, b) -> DeadBeef (t, go b)
|
||
| Prim (p, es) -> Prim (p, gos es)
|
||
| Call (n, es) -> Call (n, gos es)
|
||
| Do es -> Do (gos es)
|
||
| Make (n, es) -> Make (n, gos es)
|
||
| MakeCase (d, c, es) -> MakeCase (d, c, gos es)
|
||
| Arr es -> Arr (gos es)
|
||
| InvokeRestart (a, b, es, c, d, l) -> InvokeRestart (a, b, gos es, c, d, l)
|
||
| CallPtr (c, es) -> CallPtr (go c, gos es)
|
||
| Let (bs, body) -> Let (List.map (fun (s, v) -> (s, go v)) bs, gos body)
|
||
| If (a, b, c) -> If (go a, go b, go c)
|
||
| While (c, body, latch) -> While (go c, gos body, gos latch)
|
||
| Return v -> Return (Option.map go v)
|
||
| Set (p, v) -> Set (rewrite_place f e.loc p, go v)
|
||
| Addr p -> Addr (rewrite_place f e.loc p)
|
||
| Field (t, i) -> Field (go t, i)
|
||
| Deref t -> Deref (go t)
|
||
| CaseField (t, c, i) -> CaseField (go t, c, i)
|
||
| Some_ t -> Some_ (go t)
|
||
| UnwrapSome t -> UnwrapSome (go t)
|
||
| Signal (k, d, t) -> Signal (k, d, go t)
|
||
| Closure (r, t) -> Closure (r, go t)
|
||
| Thicken (n, t) -> Thicken (n, go t)
|
||
| Match (sc, arms) ->
|
||
Match (go sc, List.map (fun a -> { a with abody = gos a.abody }) arms)
|
||
| Handled (hs, body) ->
|
||
Handled
|
||
(List.map (fun h -> { h with henv = Option.map go h.henv }) hs, gos body)
|
||
| RestartCase (cs, body) ->
|
||
RestartCase (List.map (fun c -> { c with rbody = gos c.rbody }) cs, go body)
|
||
| WithAlloc (a, body) -> WithAlloc (go a, gos body)
|
||
in
|
||
{ e with e = kind }
|
||
|
||
and rewrite_place f loc (p : place) : place =
|
||
match p with
|
||
| Plocal i -> (match f i loc with Some ptr -> Pderef ptr | None -> p)
|
||
| Pglobal _ -> p
|
||
| Pfield (t, i) -> Pfield (rewrite_locals f t, i)
|
||
| Pderef t -> Pderef (rewrite_locals f t)
|
||
| Pindex (t, idx) -> Pindex (rewrite_locals f t, List.map (rewrite_locals f) idx)
|
||
|
||
(* ── What the object image can hold ─────────────────────────────────── *)
|
||
|
||
(* Whether an initialiser is a value a linker can write into the program's
|
||
image: a literal, a zero, an aggregate of those. It is [Emit.const]'s
|
||
accepted set asked as a question rather than answered as a string, and the
|
||
two have to stay the same set — [const] spells the value, this decides who
|
||
is allowed to ask it to.
|
||
|
||
Everything else is *computed*, which used to be the end of the road and is
|
||
now a fork: [Check] lifts a computed initialiser into a function of its own
|
||
and the program calls it at startup. So this is no longer "what a global may
|
||
be", only "what needs no code" — which is why a [MakeCase] is false here
|
||
rather than an error. A data type case written into the image would need a
|
||
byte-level encoder that could not encode a string field at all; written as a
|
||
store at startup it needs nothing. *)
|
||
(* The pattern [(dead-beef)] means, and the name the builtin is spelled after.
|
||
It lives here rather than in a backend because it is a fact about the
|
||
language — what the bare form of a builtin means — and because the checker
|
||
is what writes it in: a [DeadBeef] node always carries its pattern, so no
|
||
emitter has a default of its own to keep in step with this one. *)
|
||
let dead_beef_default = 0xDEADBEEFl
|
||
|
||
let rec const_init (e : expr) =
|
||
match e.e with
|
||
| Int _ | Float _ | Bool _ | Str _ | Unit | Zero _ | Uninit _ | None_ -> true
|
||
| Make (_, es) | Arr es -> List.for_all const_init es
|
||
| Some_ v -> const_init v
|
||
| _ -> false
|
||
|
||
(* The declared position of a case, which is its tag, and the case itself. Tags
|
||
are declaration order from zero, so an all-bytes-zero data type is the first
|
||
case with a zeroed payload — the same rule that makes an [Option]'s zero a
|
||
[None], and the reason case order is part of a data type's contract. *)
|
||
let case_index (u : data) name =
|
||
let rec go i = function
|
||
| [] -> None
|
||
| (c : variant) :: rest ->
|
||
if String.equal c.vname name then Some (i, c) else go (i + 1) rest
|
||
in
|
||
go 0 u.cases
|
||
|
||
let vfield_index (c : variant) name =
|
||
let rec go i = function
|
||
| [] -> None
|
||
| (f : field) :: rest ->
|
||
if String.equal f.fname name then Some i else go (i + 1) rest
|
||
in
|
||
go 0 c.vfields
|
||
|
||
let field_index (s : structure) name =
|
||
let rec go i = function
|
||
| [] -> None
|
||
| f :: rest -> if String.equal f.fname name then Some i else go (i + 1) rest
|
||
in
|
||
go 0 s.fields
|