Joseph Ferano
8e47356592
The delimiter is what disambiguates: (.x v) is a call and therefore an
access, {.x 1.0} is a brace form and therefore a construction. The colon
kept two jobs -- field label and enum member -- and this leaves it with
one, keys, which is what a map literal will want.
The old spelling is refused rather than quietly accepted, and the refusal
names the new one. Two accepted spellings is how two spellings become
permanent, and this repo rejects what it does not support and says why.
:keys keeps its colon. It names no field -- it is an instruction to the
compiler that happens to sit in the same brace -- so leaving it alone is
what lets the dot mean exactly one thing.
render.ml prints the dot too, or a struct the daemon shows would not be
Flan anyone could paste back.
210 lines
9.3 KiB
OCaml
210 lines
9.3 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;
|
|
}
|
|
|
|
type ctx = {
|
|
structs : Tast.structure list;
|
|
enums : (string * (string * int64) list) list;
|
|
emit : emitter;
|
|
(* 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 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. *)
|
|
| Types.Ptr _ -> [ lit "<ptr>" ]
|
|
(* 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>" ]
|
|
| 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")) ]
|
|
| 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 " " ])
|
|
@ [ 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)
|