Joseph Ferano
6cc94e00d6
The name freed up by the rename now means what C means by it: the members overlay one storage, the size is the largest of them, the alignment the strictest, and nothing anywhere records which one was written. It serves two things that wanted it. Binding a C header means holding the union the library holds and reading whichever member the library's own tag says is live -- a tag Flan cannot see, because the rule relating them is prose in a manual. Overlaying an f32 on a u32 to look at its bits is the other, and it is the same read. So that read is defined rather than refused. This is the one place in the checker where bytes win over safety on purpose, and the alternative was not a safer language, it was no feature: type punning *is* reading the member that was not written. The promise is the one C's implementations make and C's standard does not -- the layout is the target's, the bytes are the bytes, a read is a reinterpretation of them -- and what is not promised is anything about bytes nobody wrote, where a member wider than the one last stored reads a tail that is indeterminate exactly as a struct's padding is. ZII narrows that to almost nothing: a union starts all-bytes-zero unless uninit says otherwise. uninit on one is allowed, unlike on a defdata. The refusal there was never about garbage; it is that a tag steers, and a tag no case names falls past every comparison in a match into a block LLVM may treat as unreachable. An untagged union steers nothing. Which is also why three things are refused, each for a reason that does not expire with a milestone. No move-only member: nothing knows which member is live, so nothing can tear one down, and unlike the struct and defdata refusals this is not waiting on recursive teardown -- there is no fact for teardown to read. No bool at any depth: an i1 loaded from a byte that is neither 0 nor 1 is a value the optimiser may assume cannot exist, and a union is the only type that can produce one. No defdata at any depth, for the reason uninit gives, arriving the other way round. An Option member is fine and the walk says why: its match is a tag test and a branch, not a chain with an unreachable tail. Two members in one literal, a match on a union, a union map key and a member written into a global initialiser are each refused by name. A union is a field list whose every offset is zero, so it travels as a Tast.structure and the checker, the emitter and the x86 backend each grow one table rather than one shape. A value is a zeroed temporary and a store -- Set over Pfield, which every backend already has -- so there is no new IR node and no layout rule spelled out a second time per backend. The LLVM type is the blob clang gives a union, the DWARF is DW_TAG_union_type with every member at zero, and the printer names the type and does not walk it: it cannot know which member is live, and one of them may be a pointer. cimport can now check what it could not. A C record holding a union member was not recorded at all, so the defstruct beside it went unchecked rather than checked wrongly; a named union member resolves to a defunion now and the whole record is compared field by field. The defunion itself is compared against the header's union as a set and not in order -- every member is at offset zero, so a permuted one is the same type and reporting it would be a finding that is not one -- while a member the header has and Flan lacks is reported, because that is what changes the size. A defunion against a C struct, or a defstruct against a C union, is reported in both directions. An anonymous union member is still skipped, and the comment now says that the gap is on the Flan side: there is nothing to declare.
384 lines
18 KiB
OCaml
384 lines
18 KiB
OCaml
(** The structural printer: a compile-time walk over a [Tast] type that emits
|
|
the calls which print a value of it.
|
|
|
|
It lives apart from its two callers because there are two, and they differ
|
|
in exactly one thing: where the pieces go. The REPL sends them to
|
|
[flan_dev_emit] ([session.ml]); [println] sends them to stdout
|
|
([check.ml]). Everything else — which arm a type takes, how an enum
|
|
recovers its member names, the depth and span caps — has to be the same in
|
|
both, and the way to make it the same is to have one copy.
|
|
|
|
Why the walk is at compile time at all: a Flan value carries no header, so
|
|
nothing at run time could say what it is. The compiler knows the type and
|
|
renders it there. And why it emits piecewise rather than building a string:
|
|
a struct is its fields with punctuation between them, and concatenating
|
|
that would need an allocator the language does not have.
|
|
|
|
The emitter is five functions rather than five names because the two sides
|
|
are not both extern calls. The REPL's are ([flan_dev_emit_i64] takes an
|
|
i64); stdout's compose a conversion with a write — [(write-stdout
|
|
(i64->bytes x))] — and a name alone cannot say that. *)
|
|
|
|
(* Each takes a value of the type its field is named for and returns a Unit
|
|
expression that prints it. [estr] is handed a [u8] slice and is expected to
|
|
quote and escape it: it is the *nested* string case, the one inside a struct
|
|
or an array, where an unquoted run of bytes could not be told from the
|
|
punctuation around it. A caller that wants a string printed raw does not go
|
|
through the walk at all. *)
|
|
type emitter = {
|
|
ebytes : Tast.expr -> Tast.expr; (* [u8], verbatim: punctuation and literals *)
|
|
estr : Tast.expr -> Tast.expr; (* [u8], quoted and escaped *)
|
|
ei64 : Tast.expr -> Tast.expr;
|
|
eu64 : Tast.expr -> Tast.expr;
|
|
ef64 : Tast.expr -> Tast.expr;
|
|
}
|
|
|
|
(* What a walk is allowed to do with a pointer, and it is exactly two
|
|
questions. Both are asked of the allocation registry (runtime/flan_dev.c),
|
|
which is the only thing in the program that can answer either: a Flan value
|
|
carries no header, so the *type* at the far end is known here and statically
|
|
— (Ptr Enemy) says Enemy — while whether the storage is still there is not
|
|
knowable at compile time at all.
|
|
|
|
A record of functions rather than two names, for the reason the emitter is
|
|
one: only the REPL's side has these. [println] passes [None] and keeps
|
|
printing [<ptr>], which is what spec-memory.md says it prints and what the
|
|
acceptance table reads back. Following a pointer in a printed line would
|
|
also cost every release build the two calls, and a release build has no
|
|
registry to call. *)
|
|
type pointers = {
|
|
live : Tast.expr -> Tast.expr; (* a (Ptr a) -> bool: may it be read *)
|
|
(* Emits what the registry remembers about a dead address, and emits nothing
|
|
at all for one it never saw — a stack local is not in it by design, and
|
|
inventing a sentence about one would be worse than the silence [<ptr>]
|
|
already is. *)
|
|
epitaph : Tast.expr -> Tast.expr; (* a (Ptr a) -> unit *)
|
|
}
|
|
|
|
type ctx = {
|
|
structs : Tast.structure list;
|
|
(* The declared data types. [Types.Named] covers a struct and a data type
|
|
alike, so
|
|
which list the name is in is what says which this is — the same
|
|
arrangement the checker and the emitter use. *)
|
|
datas : Tast.data list;
|
|
(* The untagged unions, which this prints by name and does not walk. See the
|
|
arm below for why. *)
|
|
unions : Tast.structure list;
|
|
enums : (string * (string * int64) list) list;
|
|
emit : emitter;
|
|
(* [None] in a build with no registry to ask, which is every release build
|
|
and every [println]. See [pointers]. *)
|
|
ptrs : pointers option;
|
|
(* A slot in the *caller's* frame. Only the slice arm needs one, and it needs
|
|
two: the slice itself, so the expression it came from is evaluated once
|
|
rather than once per element, and the loop counter. Who owns the frame
|
|
differs — the REPL's is a thunk it is building, [println]'s is the user
|
|
function being checked — so allocating one is the caller's to do. *)
|
|
alloc : Types.t -> int;
|
|
}
|
|
|
|
(* Two separate limits, easily conflated. [depth] and [span] bound the *walk*,
|
|
so a big fixed array or a self-containing struct cannot turn one expression
|
|
into a module with ten thousand render sites in it. How much text actually
|
|
comes out is bounded in the runtime instead, once, for every renderer. *)
|
|
let max_depth = 4
|
|
let max_span = 8
|
|
|
|
let fail = Loc.fail
|
|
|
|
let rec render c depth (e : Tast.expr) : Tast.expr list =
|
|
let loc = e.Tast.loc in
|
|
let unit_ e = { Tast.e; ty = Types.Unit; loc } in
|
|
let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in
|
|
let bytes_of s =
|
|
{ Tast.e = Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str s; ty = Types.String; loc } ]);
|
|
ty = Types.Slice (Types.Int Types.U8); loc }
|
|
in
|
|
let lit s = c.emit.ebytes (bytes_of s) in
|
|
let int64 n = { Tast.e = Tast.Int (n, Types.I64); ty = Types.Int Types.I64; loc } in
|
|
let i32 n =
|
|
{ Tast.e = Tast.Int (Int64.of_int n, Types.I32); ty = Types.Int Types.I32; loc }
|
|
in
|
|
let do_ xs = unit_ (Tast.Do xs) in
|
|
if depth > max_depth then [ lit "..." ]
|
|
else
|
|
match e.Tast.ty with
|
|
| Types.Int Types.U64 -> [ c.emit.eu64 e ]
|
|
| Types.Int _ -> [ c.emit.ei64 (cast (Types.Int Types.I64) e) ]
|
|
| Types.Float _ -> [ c.emit.ef64 (cast (Types.Float Types.F64) e) ]
|
|
| Types.Bool ->
|
|
[ unit_ (Tast.If (e, lit "true", lit "false")) ]
|
|
(* Evaluated *and then* reported. A Unit expression is almost always a call
|
|
made for its effect — (println "x") is the REPL's most ordinary
|
|
input — so emitting the literal without running it would make the prompt
|
|
answer () while nothing happened. *)
|
|
| Types.Unit -> [ e; lit "()" ]
|
|
| Types.String ->
|
|
[ c.emit.estr
|
|
{ Tast.e = Tast.Prim (Tast.Bytes, [ e ]);
|
|
ty = Types.Slice (Types.Int Types.U8); loc } ]
|
|
(* Bytes are almost always text, and escaping makes the case where they are
|
|
not readable rather than a mess. *)
|
|
| Types.Slice (Types.Int Types.U8) -> [ c.emit.estr e ]
|
|
(* An enum's members are erased to i32 before the backend sees them, so the
|
|
name has to be recovered here, from the checker's table, as a chain of
|
|
comparisons. Falling through to the number is not a failure: a value
|
|
outside the declared members is exactly what you would want to see. *)
|
|
| Types.Enum n ->
|
|
let members = try List.assoc n c.enums with Not_found -> [] in
|
|
let number = c.emit.ei64 (cast (Types.Int Types.I64) e) in
|
|
List.fold_left
|
|
(fun otherwise (name, v) ->
|
|
let is =
|
|
{ Tast.e =
|
|
Tast.Prim (Tast.Eq,
|
|
[ cast (Types.Int Types.I64) e; int64 v ]);
|
|
ty = Types.Bool; loc }
|
|
in
|
|
unit_ (Tast.If (is, lit (":" ^ name), otherwise)))
|
|
number members
|
|
|> fun x -> [ x ]
|
|
(* A pointer with nobody to ask is rendered as its shape and never
|
|
followed: it is the only thing that could make this walk cycle, and
|
|
dereferencing one a REPL was handed is not a safe thing to do on
|
|
someone's behalf.
|
|
|
|
The registry is the somebody to ask, and it changes only the second half
|
|
of that sentence. The type at the far end was never the difficulty —
|
|
(Ptr Enemy) says Enemy, here, at compile time. What was missing is
|
|
*permission*, and an allocation registry is exactly a record of which
|
|
addresses it is still true to read. So a live pointer is followed and
|
|
its pointee rendered by the same walk as anything else, one level
|
|
deeper, which the depth cap bounds the way it bounds a self-containing
|
|
struct. A dead one names what died instead of showing bytes that are no
|
|
longer what they say, which is the whole difference between an
|
|
inspector and a hex dump.
|
|
|
|
An address the registry never saw is neither: it prints [<ptr>]. That
|
|
is a stack local, a global, or a pointer from C, and the shadow stack
|
|
and the static type table already answer for the first two by name. *)
|
|
| Types.Ptr t ->
|
|
(match c.ptrs with
|
|
| None -> [ lit "<ptr>" ]
|
|
| Some pt ->
|
|
(* Into a slot first, the slice arm's rule and for its reason: this
|
|
arm names the pointer three times — asked about, followed, and
|
|
mourned — and the expression it came from may be a call. An
|
|
[inspect] with a path reaches a leaf through [flan_vec_at], which
|
|
is a bounds check and a transfer guard; three of those to render
|
|
one pointer would be the walk paying for its own shape. *)
|
|
let pv = c.alloc e.Tast.ty in
|
|
let p () = { Tast.e = Tast.Local pv; ty = e.Tast.ty; loc } in
|
|
let inner =
|
|
do_ ([ lit "<ptr " ]
|
|
@ render c (depth + 1) { Tast.e = Tast.Deref (p ()); ty = t; loc }
|
|
@ [ lit ">" ])
|
|
in
|
|
let gone = do_ [ lit "<ptr"; pt.epitaph (p ()); lit ">" ] in
|
|
[ unit_
|
|
(Tast.Let ([ (pv, e) ],
|
|
[ unit_ (Tast.If (pt.live (p ()), inner, gone)) ])) ])
|
|
(* Opaque on purpose, and for the same reason: its contents are the
|
|
runtime's, its address is not stable across runs, and printing either
|
|
would make an acceptance test's output depend on the heap. *)
|
|
| Types.Alloc -> [ lit "<allocator>" ]
|
|
(* Printing a Vec structurally would be a walk over storage this function
|
|
does not own, and the walk is what [as-slice] is for: (print (as-slice
|
|
v)) prints the elements and says at the call site that it borrowed. *)
|
|
| Types.Vec _ -> [ lit "<vec>" ]
|
|
(* Opaque for the reason a Vec is: the slots are storage this function does
|
|
not own, and a walk over them would print the dead ones too — there is
|
|
no way to say "dead" inside a rendered element. (pool-handle p i) and
|
|
(resolve p h) are how a program looks, and they say it. *)
|
|
| Types.Pool _ -> [ lit "<pool>" ]
|
|
(* Its identity, which is what spec-memory.md says a handle prints —
|
|
"Ptr and Handle print their address or identity rather than recursively
|
|
dereferencing". Shown as index:generation rather than as the packed
|
|
number, because those are the two things a reader is trying to tell
|
|
apart when two handles disagree. *)
|
|
| Types.Handle _ ->
|
|
let h = cast (Types.Int Types.U64) e in
|
|
let u64 v = { Tast.e = v; ty = Types.Int Types.U64; loc } in
|
|
let idx =
|
|
u64 (Tast.Prim (Tast.BitAnd,
|
|
[ h; u64 (Tast.Int (0xFFFFFFFFL, Types.U64)) ]))
|
|
in
|
|
let gen =
|
|
u64 (Tast.Prim (Tast.Shr, [ h; u64 (Tast.Int (32L, Types.U64)) ]))
|
|
in
|
|
[ do_ [ lit "<handle "; c.emit.eu64 idx; lit ":"; c.emit.eu64 gen;
|
|
lit ">" ] ]
|
|
(* A function value is a code address, and printing the address would make
|
|
an inspection depend on where the image loaded. The signature is what a
|
|
reader can act on, so that is what is shown — and the inspector reaches
|
|
every local of a stopped frame, so a frame holding one has to render
|
|
rather than refuse. *)
|
|
| Types.Fn _ as ft -> [ lit ("<" ^ Types.to_string ft ^ ">") ]
|
|
| Types.Option t ->
|
|
let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I8; loc } in
|
|
let some = { Tast.e = Tast.Field (e, 1); ty = t; loc } in
|
|
let is_some =
|
|
{ Tast.e =
|
|
Tast.Prim (Tast.Ne,
|
|
[ tag; { Tast.e = Tast.Int (0L, Types.I8);
|
|
ty = Types.Int Types.I8; loc } ]);
|
|
ty = Types.Bool; loc }
|
|
in
|
|
[ unit_
|
|
(Tast.If (is_some,
|
|
do_ ((lit "(some " :: render c (depth + 1) some) @ [ lit ")" ]),
|
|
lit "none")) ]
|
|
(* A data type, printed as the source would write it: the case is recovered
|
|
from the tag by a chain of comparisons, exactly as an enum's member name
|
|
is, and only the case in hand has its fields read. Reading the others
|
|
would be reading a payload that is not there. *)
|
|
| Types.Named n
|
|
when List.exists (fun (u : Tast.data) -> String.equal u.Tast.dname n)
|
|
c.datas ->
|
|
let u =
|
|
List.find (fun (u : Tast.data) -> String.equal u.Tast.dname n) c.datas
|
|
in
|
|
let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I32; loc } in
|
|
let one i (v : Tast.variant) otherwise =
|
|
let is =
|
|
{ Tast.e =
|
|
Tast.Prim (Tast.Eq,
|
|
[ tag; { Tast.e = Tast.Int (Int64.of_int i, Types.I32);
|
|
ty = Types.Int Types.I32; loc } ]);
|
|
ty = Types.Bool; loc }
|
|
in
|
|
let full = n ^ "." ^ v.Tast.vname in
|
|
let body =
|
|
if v.Tast.vfields = [] then lit full
|
|
else
|
|
let shown = List.filteri (fun i _ -> i < max_span) v.Tast.vfields in
|
|
let parts =
|
|
List.concat
|
|
(List.mapi
|
|
(fun i (f : Tast.field) ->
|
|
let fv =
|
|
{ Tast.e = Tast.CaseField (e, v.Tast.vname, i);
|
|
ty = f.Tast.fty; loc }
|
|
in
|
|
(if i = 0 then [] else [ lit " " ])
|
|
@ [ lit ("." ^ f.Tast.fname ^ " ") ]
|
|
@ render c (depth + 1) fv)
|
|
shown)
|
|
in
|
|
do_ ((lit ("(" ^ full ^ " {") :: parts)
|
|
@ (if List.length v.Tast.vfields > max_span then [ lit " ..." ]
|
|
else [])
|
|
@ [ lit "})" ])
|
|
in
|
|
unit_ (Tast.If (is, body, otherwise))
|
|
in
|
|
(* The fallback is a tag no case names, which only a scribbled-over data type
|
|
could hold. Showing the number is more use than showing a case it is
|
|
not. *)
|
|
let base =
|
|
do_ [ lit ("<" ^ n ^ " tag ");
|
|
c.emit.ei64 (cast (Types.Int Types.I64) tag); lit ">" ]
|
|
in
|
|
[ List.fold_left (fun acc x -> x acc) base
|
|
(List.rev (List.mapi one u.Tast.cases)) ]
|
|
(* A union, named and not walked, and this is the one value in the language
|
|
the printer refuses to show the contents of.
|
|
|
|
Not squeamishness about indeterminate bytes — a printer that showed a
|
|
number nobody stored would be fine, and every member of a union is a
|
|
legal read by this language's own rule. It is that one of those members
|
|
may be a [string] or a [Ptr], and rendering it would dereference
|
|
whatever bytes happen to be in the union's storage. A tagged data type
|
|
is safe to print because its tag says which case is live; there is no
|
|
such fact here, so the printer would be following a pointer it invented.
|
|
Showing four members of which three are made up is also not obviously
|
|
better than showing none.
|
|
|
|
So: the type, and nothing else. What the value means is the caller's
|
|
knowledge, and [(.member u)] prints whichever member that is. *)
|
|
| Types.Named n
|
|
when List.exists (fun (u : Tast.structure) -> String.equal u.Tast.sname n)
|
|
c.unions ->
|
|
[ lit ("<" ^ n ^ " union>") ]
|
|
| Types.Named n ->
|
|
(match
|
|
List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n)
|
|
c.structs
|
|
with
|
|
| None -> [ lit ("<" ^ n ^ ">") ]
|
|
| Some st ->
|
|
let fields = st.Tast.fields in
|
|
let shown = List.filteri (fun i _ -> i < max_span) fields in
|
|
let parts =
|
|
List.concat
|
|
(List.mapi
|
|
(fun i (f : Tast.field) ->
|
|
let v = { Tast.e = Tast.Field (e, i); ty = f.Tast.fty; loc } in
|
|
(if i = 0 then [] else [ lit " " ])
|
|
(* A dot, matching the source spelling a struct literal
|
|
is written in. This printed form is a wire format --
|
|
emacs/flan-inspect.el parses it back to build the field
|
|
list -- so the two moved together; see that file's
|
|
[flan-inspect--read-struct]. *)
|
|
@ [ lit ("." ^ f.Tast.fname ^ " ") ]
|
|
@ render c (depth + 1) v)
|
|
shown)
|
|
in
|
|
[ do_ ((lit ("(" ^ n ^ " {") :: parts)
|
|
@ (if List.length fields > max_span then [ lit " ..." ] else [])
|
|
@ [ lit "})" ]) ])
|
|
(* A fixed array's length is in its type, so it unrolls — capped, because
|
|
sand's grid is [100 [100 u32]] and unrolling that is ten thousand render
|
|
sites in one module. *)
|
|
| Types.Array (n, t) ->
|
|
let shown = min (Int64.to_int n) max_span in
|
|
let parts =
|
|
List.concat
|
|
(List.init shown (fun i ->
|
|
let v =
|
|
{ Tast.e = Tast.Prim (Tast.At, [ e; i32 i ]); ty = t; loc }
|
|
in
|
|
lit " " :: render c (depth + 1) v))
|
|
in
|
|
[ do_ ((lit "[" :: parts)
|
|
@ (if Int64.to_int n > shown then [ lit " ..." ] else [])
|
|
@ [ lit "]" ]) ]
|
|
(* A slice's length is not known until it runs, so this is the one case
|
|
that needs a loop. The slice goes into a slot first: the expression it
|
|
came from must not be evaluated once per element. *)
|
|
| Types.Slice t ->
|
|
let sv = c.alloc e.Tast.ty and iv = c.alloc (Types.Int Types.I32) in
|
|
let local i ty = { Tast.e = Tast.Local i; ty; loc } in
|
|
let len =
|
|
{ Tast.e = Tast.Prim (Tast.Len, [ local sv e.Tast.ty ]);
|
|
ty = Types.Int Types.I32; loc }
|
|
in
|
|
let cond =
|
|
{ Tast.e = Tast.Prim (Tast.Lt, [ local iv (Types.Int Types.I32); len ]);
|
|
ty = Types.Bool; loc }
|
|
in
|
|
let elem =
|
|
{ Tast.e =
|
|
Tast.Prim (Tast.At, [ local sv e.Tast.ty; local iv (Types.Int Types.I32) ]);
|
|
ty = t; loc }
|
|
in
|
|
let step =
|
|
unit_
|
|
(Tast.Set
|
|
(Tast.Plocal iv,
|
|
{ Tast.e =
|
|
Tast.Prim (Tast.Add, [ local iv (Types.Int Types.I32); i32 1 ]);
|
|
ty = Types.Int Types.I32; loc }))
|
|
in
|
|
[ unit_
|
|
(Tast.Let
|
|
([ (sv, e); (iv, i32 0) ],
|
|
[ lit "[";
|
|
unit_
|
|
(Tast.While
|
|
(cond, lit " " :: render c (depth + 1) elem, [ step ]));
|
|
lit "]" ])) ]
|
|
| t ->
|
|
fail loc "no printer for %s" (Types.to_string t)
|