Printers for every shape a value can have
C-x C-e rendered the scalars and refused the rest, which made it a calculator
rather than a REPL. The renderer is now a compile-time walk over the type,
emitting a piece at a time: structs, nested structs, fixed arrays, slices,
options, enums by name, and pointers as their shape. A raylib Color comes back
through the FFI as (rl/Color {:r 17 :g 34 :b 51 :a 68}).
Piecewise emission is what makes composites possible at all - a struct is its
fields with punctuation between them, and concatenating that in generated IR
would need an allocator the language does not have.
u64 now renders, in C, with %llu. It used to refuse because i64->bytes is
signed and it would otherwise come back as -1, but refusing a whole struct
because one field is a u64 is much worse than adding a runtime entry point.
Strings are quoted and escaped in C for the same reason: unescaped content does
not round-trip and reads as a framing bug rather than as the value it is.
An enum renders as :name, recovered from the checker's table as a chain of
comparisons, since members are erased to i32 before the backend sees them; a
value outside the declared members falls through to its number, which is what
you would want to see. A pointer is rendered and never followed - it is the
only thing that could make the walk cycle, and dereferencing one a REPL was
handed is not a safe thing to do on someone's behalf.
Three bounds, easy to conflate. depth and span bound the walk, so sand's
[100 [100 u32]] grid does not unroll into ten thousand render sites. The output
is bounded once in the runtime, since a slice renders through a loop the
compiler cannot bound, and one place enforcing it means no renderer carries a
budget.
emit.ml's cast now treats an enum as the i32 it is. Nothing in the surface
language produces that - a keyword resolves against its enum and never widens -
but the renderer needs an enum's number when it falls outside the members.
This commit is contained in:
parent
44e199186e
commit
20fedd4ad8
45
NEXT.md
45
NEXT.md
@ -737,11 +737,46 @@ socket. The read is safe without a handshake because `flan_dev_result` bumps a
|
||||
generation counter last; the daemon waits for it to move rather than assuming
|
||||
the program has reached a frame boundary.
|
||||
|
||||
What renders: the integers, the floats, `bool`, `string`, `[u8]`, `Unit`, and
|
||||
an enum (as its number — enum members are erased to `i32` before the backend
|
||||
sees them). What refuses, by name: everything else, and **`u64` specifically**,
|
||||
because `i64->bytes` is signed and anything past 2⁶³ would come back negative.
|
||||
Refusing beats a number that is quietly wrong.
|
||||
The renderer is a **compile-time walk over the type**, emitting a piece at a
|
||||
time through `flan_dev_emit`. Piecewise because a struct is its fields with
|
||||
punctuation between them, and concatenating that in generated IR would need an
|
||||
allocator the language does not have.
|
||||
|
||||
```
|
||||
big 18446744073709551615
|
||||
col :blue
|
||||
(.pos b) (V {:x 1.5 :y 0})
|
||||
b (Blob {:id 7 :name "sandy \"quoted\"" :pos (V {:x 1.5 :y 0}) :tags [ 0 42 0]})
|
||||
(slice (.tags b) 0 3) [ 0 42 0]
|
||||
(rl/get-color 0x11223344) (rl/Color {:r 17 :g 34 :b 51 :a 68})
|
||||
sim/grid [ [ 0 0 0 0 0 0 0 0 ...] [ 0 ... ] ...]
|
||||
```
|
||||
|
||||
Details that are decisions rather than formatting:
|
||||
|
||||
- **`u64` renders in C**, with `%llu`. The language's own `i64->bytes` is
|
||||
signed, so it used to refuse rather than come back as `-1` — but refusing a
|
||||
whole struct because one field is a `u64` is much worse, so the runtime got
|
||||
an entry point instead.
|
||||
- **Strings are quoted and escaped**, also in C. Unescaped content does not
|
||||
round-trip and reads as a framing bug rather than as the value it is.
|
||||
- **An enum renders as `:name`**, recovered from the checker's table as a chain
|
||||
of comparisons, because members are erased to `i32` before the backend sees
|
||||
them. A value outside the declared members falls through to its number, which
|
||||
is exactly what you would want to see.
|
||||
- **A pointer is never followed** — `<ptr>`. It is the only thing that could
|
||||
make the walk cycle, and dereferencing one a REPL was handed is not a safe
|
||||
thing to do on someone's behalf.
|
||||
- **Three separate bounds**, easy to conflate. `depth` (4) and `span` (8) bound
|
||||
the *walk*, so `[100 [100 u32]]` does not become ten thousand render sites in
|
||||
one module. The *output* is bounded once in the runtime — `emit` truncates at
|
||||
4K and `end` appends `...` — because a slice renders through a loop the
|
||||
compiler cannot bound, and one place enforcing it means no renderer carries a
|
||||
budget.
|
||||
- A slice is the one case needing a runtime loop, and the slice goes into a
|
||||
slot first so the expression it came from is not evaluated once per element.
|
||||
|
||||
What still refuses by name: `Map`, `Fn`, a type variable.
|
||||
|
||||
A caveat inherited from the language, not introduced here: `3.0` renders as
|
||||
`3`, indistinguishable from the integer. `flan run calc-me.flan "1.5 * 2.0"`
|
||||
|
||||
10
lib/emit.ml
10
lib/emit.ml
@ -742,7 +742,15 @@ and shim_out f name (x : Tast.expr) =
|
||||
|
||||
and cast f (x : Tast.expr) target =
|
||||
let v = value f x in
|
||||
let src = x.Tast.ty in
|
||||
(* An enum is an i32 at run time and its own type only in the checker, so a
|
||||
cast involving one is a cast on that i32. Nothing in the surface language
|
||||
produces this — a keyword resolves against the enum and never widens — but
|
||||
the REPL's renderer needs an enum's number when it falls outside the
|
||||
declared members. *)
|
||||
let concrete (t : Types.t) =
|
||||
match t with Types.Enum _ -> Types.Int Types.I32 | t -> t
|
||||
in
|
||||
let src = concrete x.Tast.ty and target = concrete target in
|
||||
if Types.equal src target then v
|
||||
else
|
||||
let op =
|
||||
|
||||
249
lib/session.ml
249
lib/session.ml
@ -349,51 +349,204 @@ let eval ?(origin = "<eval>") t src : change =
|
||||
expression is wrapped in a function that has nowhere to be called from, and
|
||||
the module says "run this once". The agent does, at a frame boundary.
|
||||
|
||||
Getting the value back does not marshal anything. The compiler knows the
|
||||
expression's type, so the thunk renders it to bytes here, at compile time,
|
||||
and hands them to the runtime — which is the only thing that *can* work,
|
||||
since a Flan value carries no header and nothing at run time could tell what
|
||||
it is. That is the layout decision's bill, paid here.
|
||||
Getting the value back does not marshal anything. 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*, in the thunk. That is the layout decision's
|
||||
bill, paid here — and it is why the renderer is a compile-time walk over the
|
||||
type rather than a function in the runtime.
|
||||
|
||||
The rendering goes to [flan_dev_result], not to stdout: stdout belongs to
|
||||
the program, it is in the hot path for anything that prints, and a dev-only
|
||||
feature must not put a branch in it. *)
|
||||
The rendering goes to [flan_dev_emit], a piece at a time, not to stdout.
|
||||
Piecewise because a struct is its fields with punctuation between them and
|
||||
concatenating that in generated IR would need an allocator the language does
|
||||
not have; not stdout because stdout belongs to the program, is in the hot
|
||||
path for anything that prints, and a dev-only feature must not put a branch
|
||||
in it. *)
|
||||
|
||||
let result_sym = "flan/dev-result"
|
||||
type emitter = { ename : string; ety : Types.t }
|
||||
|
||||
let result_extern : Tast.extern =
|
||||
{ Tast.ename = result_sym; esym = "flan_dev_result";
|
||||
eparams = [ Types.Slice (Types.Int Types.U8) ]; eret = Types.Unit }
|
||||
let emit_bytes = { ename = "flan/dev-emit"; ety = Types.Slice (Types.Int Types.U8) }
|
||||
let emit_str = { ename = "flan/dev-emit-str"; ety = Types.Slice (Types.Int Types.U8) }
|
||||
let emit_i64 = { ename = "flan/dev-emit-i64"; ety = Types.Int Types.I64 }
|
||||
let emit_u64 = { ename = "flan/dev-emit-u64"; ety = Types.Int Types.U64 }
|
||||
let emit_f64 = { ename = "flan/dev-emit-f64"; ety = Types.Float Types.F64 }
|
||||
|
||||
(* The scalars, and nothing else yet. A struct, an (Option T) or a slice of
|
||||
structs needs a printer derived per type, which is real work; refusing by
|
||||
name is the house rule, and a wrong rendering would be the silent kind. *)
|
||||
let render (e : Tast.expr) : Tast.expr =
|
||||
let externs : Tast.extern list =
|
||||
let one e sym = { Tast.ename = e.ename; esym = sym; eparams = [ e.ety ];
|
||||
eret = Types.Unit } in
|
||||
[ one emit_bytes "flan_dev_emit";
|
||||
one emit_str "flan_dev_emit_str";
|
||||
one emit_i64 "flan_dev_emit_i64";
|
||||
one emit_u64 "flan_dev_emit_u64";
|
||||
one emit_f64 "flan_dev_emit_f64";
|
||||
{ Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin";
|
||||
eparams = []; eret = Types.Unit };
|
||||
{ Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end";
|
||||
eparams = []; eret = Types.Unit } ]
|
||||
|
||||
(* 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
|
||||
|
||||
type ctx = {
|
||||
structs : Tast.structure list;
|
||||
enums : (string * (string * int64) list) list;
|
||||
(* Slots a rendered loop needs. The thunk's frame grows as the walk finds
|
||||
slices in it. *)
|
||||
mutable slots : Types.t list; (* reversed *)
|
||||
mutable nslots : int;
|
||||
}
|
||||
|
||||
let slot c ty =
|
||||
let i = c.nslots in
|
||||
c.nslots <- i + 1;
|
||||
c.slots <- ty :: c.slots;
|
||||
i
|
||||
|
||||
let rec render c depth (e : Tast.expr) : Tast.expr list =
|
||||
let loc = e.Tast.loc in
|
||||
let bytes = Types.Slice (Types.Int Types.U8) in
|
||||
let unit_ e = { Tast.e; ty = Types.Unit; loc } in
|
||||
let call em x = unit_ (Tast.Call (em.ename, [ x ])) in
|
||||
let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in
|
||||
let prim p x = { Tast.e = Tast.Prim (p, [ x ]); ty = bytes; loc } in
|
||||
let str s = { Tast.e = Tast.Str s; ty = Types.String; loc } in
|
||||
match e.Tast.ty with
|
||||
| Types.Int Types.U64 ->
|
||||
(* i64->bytes is signed, so anything above 2^63 would render negative.
|
||||
Refusing beats a number that is quietly wrong. *)
|
||||
fail loc "no printer for u64 yet — its rendering would be signed"
|
||||
| Types.Int _ -> prim Tast.I64ToBytes (cast (Types.Int Types.I64) e)
|
||||
| Types.Enum _ ->
|
||||
(* An enum is an i32 at run time and its members are not carried into the
|
||||
backend, so this is the number and not the name. *)
|
||||
prim Tast.I64ToBytes (cast (Types.Int Types.I64) e)
|
||||
| Types.Float _ -> prim Tast.F64ToBytes (cast (Types.Float Types.F64) e)
|
||||
| Types.Bool ->
|
||||
{ Tast.e = Tast.If (e, prim Tast.Bytes (str "true"), prim Tast.Bytes (str "false"));
|
||||
ty = bytes; loc }
|
||||
| Types.String -> prim Tast.Bytes e
|
||||
| Types.Slice (Types.Int Types.U8) -> e
|
||||
| Types.Unit -> prim Tast.Bytes (str "()")
|
||||
| t ->
|
||||
fail loc "no printer for %s yet — only the scalars, bool and strings render"
|
||||
(Types.to_string t)
|
||||
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 = call emit_bytes (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 -> [ call emit_u64 e ]
|
||||
| Types.Int _ -> [ call emit_i64 (cast (Types.Int Types.I64) e) ]
|
||||
| Types.Float _ -> [ call emit_f64 (cast (Types.Float Types.F64) e) ]
|
||||
| Types.Bool ->
|
||||
[ unit_ (Tast.If (e, lit "true", lit "false")) ]
|
||||
| Types.Unit -> [ lit "()" ]
|
||||
| Types.String ->
|
||||
[ call emit_str
|
||||
{ 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) -> [ call emit_str 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 = call emit_i64 (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>" ]
|
||||
| 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 = slot c e.Tast.ty and iv = slot c (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)
|
||||
|
||||
let eval_expr ?(origin = "<eval>") t src : change =
|
||||
let form =
|
||||
@ -402,16 +555,22 @@ let eval_expr ?(origin = "<eval>") t src : change =
|
||||
| [] -> fail Loc.unknown "nothing to evaluate"
|
||||
| _ :: f :: _ -> fail f.Form.loc "one expression at a time"
|
||||
in
|
||||
let checked, slots = Check.expression t.env (Parse.expr form) in
|
||||
let checked, base = Check.expression t.env (Parse.expr form) in
|
||||
let c =
|
||||
{ structs = t.program.Tast.structs;
|
||||
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
|
||||
slots = []; nslots = Array.length base }
|
||||
in
|
||||
let loc = checked.Tast.loc in
|
||||
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
|
||||
let body =
|
||||
[ { Tast.e = Tast.Call (result_sym, [ render checked ]);
|
||||
ty = Types.Unit; loc = checked.Tast.loc } ]
|
||||
(nullary "flan/dev-begin" :: render c 0 checked) @ [ nullary "flan/dev-end" ]
|
||||
in
|
||||
t.thunks <- t.thunks + 1;
|
||||
let name = Printf.sprintf "eval/%d" t.thunks in
|
||||
let thunk : Tast.fn =
|
||||
{ Tast.name; params = []; slots; ret = Types.Unit; body;
|
||||
floc = checked.Tast.loc }
|
||||
{ Tast.name; params = []; ret = Types.Unit; body; floc = loc;
|
||||
slots = Array.append base (Array.of_list (List.rev c.slots)) }
|
||||
in
|
||||
(* Built against the program but never spliced into it: an evaluation is not
|
||||
a declaration, and adding one would leave the session carrying an eval/N
|
||||
@ -419,7 +578,7 @@ let eval_expr ?(origin = "<eval>") t src : change =
|
||||
let program =
|
||||
{ t.program with
|
||||
Tast.fns = t.program.Tast.fns @ [ thunk ];
|
||||
externs = t.program.Tast.externs @ [ result_extern ] }
|
||||
externs = t.program.Tast.externs @ externs }
|
||||
in
|
||||
let ir =
|
||||
Emit.redefinition ~dev:true ~known:(known t) ~call:name program ~fns:[ name ]
|
||||
|
||||
@ -12,8 +12,8 @@
|
||||
*
|
||||
* flan_dev_cell(name) the cell a new function lives in
|
||||
* flan_dev_global(name, size, init) the storage a new global lives in
|
||||
* flan_dev_result(bytes, len) where an evaluated expression's rendering
|
||||
* goes, for the daemon to read back
|
||||
* flan_dev_emit(...) where an evaluated expression's rendering
|
||||
* goes, piece by piece, to be read back
|
||||
*
|
||||
* Both are idempotent: the second module to mention a name gets what the first
|
||||
* one got. That is the whole point. Two modules that each define their own
|
||||
@ -106,10 +106,20 @@ void *flan_dev_global(const char *name, uint64_t size, const void *init) {
|
||||
|
||||
/* ── The value of an evaluated expression ──────────────────────────── */
|
||||
|
||||
/* C-x C-e compiles a thunk that renders one expression and calls this with the
|
||||
* text. It is not written to stdout: stdout belongs to the program, it is in
|
||||
* the hot path for anything that prints, and a dev-only feature must not put a
|
||||
* branch in it. The daemon reads this back over the agent's socket instead.
|
||||
/* C-x C-e compiles a thunk that renders one expression and emits it here, a
|
||||
* piece at a time. It is not written to stdout: stdout belongs to the program,
|
||||
* it is in the hot path for anything that prints, and a dev-only feature must
|
||||
* not put a branch in it. The daemon reads this back over the agent's socket.
|
||||
*
|
||||
* Emitting piece by piece rather than returning one string is what makes a
|
||||
* composite renderer possible at all — a struct is its fields with punctuation
|
||||
* between them, and concatenating that in the generated IR would mean an
|
||||
* allocator the language does not have.
|
||||
*
|
||||
* The output bound lives here and nowhere else. A slice of a million elements
|
||||
* renders with a loop the compiler cannot bound, so [emit] truncates and
|
||||
* [end] says so with an ellipsis. One place enforcing it means no renderer has
|
||||
* to carry a budget.
|
||||
*
|
||||
* [generation] is what makes the read safe without a handshake. The thunk runs
|
||||
* on the game thread at a frame boundary, whenever that happens to be; the
|
||||
@ -118,13 +128,86 @@ void *flan_dev_global(const char *name, uint64_t size, const void *init) {
|
||||
#define RESULT_MAX 4096
|
||||
static char result[RESULT_MAX];
|
||||
static size_t result_len;
|
||||
static int result_full;
|
||||
static uint64_t generation;
|
||||
|
||||
void flan_dev_result(const uint8_t *bytes, int64_t len) {
|
||||
void flan_dev_result_begin(void) {
|
||||
result_len = 0;
|
||||
result_full = 0;
|
||||
}
|
||||
|
||||
void flan_dev_emit(const uint8_t *bytes, int64_t len) {
|
||||
size_t n = len < 0 ? 0 : (size_t)len;
|
||||
if (n > RESULT_MAX) n = RESULT_MAX;
|
||||
memcpy(result, bytes, n);
|
||||
result_len = n;
|
||||
if (result_len + n > RESULT_MAX) {
|
||||
n = RESULT_MAX - result_len;
|
||||
result_full = 1;
|
||||
}
|
||||
memcpy(result + result_len, bytes, n);
|
||||
result_len += n;
|
||||
}
|
||||
|
||||
static void emit_cstr(const char *s) {
|
||||
flan_dev_emit((const uint8_t *)s, (int64_t)strlen(s));
|
||||
}
|
||||
|
||||
/* Rendered in C so that u64 is not a lie: the language's own i64->bytes is
|
||||
* signed, and anything past 2^63 would come back negative. */
|
||||
void flan_dev_emit_u64(uint64_t x) {
|
||||
char buf[32];
|
||||
snprintf(buf, sizeof buf, "%llu", (unsigned long long)x);
|
||||
emit_cstr(buf);
|
||||
}
|
||||
|
||||
void flan_dev_emit_i64(int64_t x) {
|
||||
char buf[32];
|
||||
snprintf(buf, sizeof buf, "%lld", (long long)x);
|
||||
emit_cstr(buf);
|
||||
}
|
||||
|
||||
void flan_dev_emit_f64(double x) {
|
||||
char buf[64];
|
||||
snprintf(buf, sizeof buf, "%g", x);
|
||||
emit_cstr(buf);
|
||||
}
|
||||
|
||||
/* Quoted and escaped, in C, because doing it in the generated IR would be a
|
||||
* loop per string and the language has no allocator to build the result in.
|
||||
* A string whose content is not escaped does not round-trip and reads as a
|
||||
* framing bug rather than as the value it is. */
|
||||
void flan_dev_emit_str(const uint8_t *bytes, int64_t len) {
|
||||
size_t n = len < 0 ? 0 : (size_t)len;
|
||||
emit_cstr("\"");
|
||||
for (size_t i = 0; i < n; i++) {
|
||||
unsigned char c = bytes[i];
|
||||
switch (c) {
|
||||
case '"': emit_cstr("\\\""); break;
|
||||
case '\\': emit_cstr("\\\\"); break;
|
||||
case '\n': emit_cstr("\\n"); break;
|
||||
case '\t': emit_cstr("\\t"); break;
|
||||
case '\r': emit_cstr("\\r"); break;
|
||||
default:
|
||||
if (c < 0x20) {
|
||||
char buf[8];
|
||||
snprintf(buf, sizeof buf, "\\x%02x", c);
|
||||
emit_cstr(buf);
|
||||
} else {
|
||||
flan_dev_emit(&c, 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
emit_cstr("\"");
|
||||
}
|
||||
|
||||
void flan_dev_result_end(void) {
|
||||
if (result_full) {
|
||||
/* Room is made for it rather than assumed: the buffer is full by
|
||||
* definition when this fires. */
|
||||
const char *ell = "...";
|
||||
size_t k = strlen(ell);
|
||||
if (result_len > RESULT_MAX - k) result_len = RESULT_MAX - k;
|
||||
memcpy(result + result_len, ell, k);
|
||||
result_len += k;
|
||||
}
|
||||
/* Last, so a reader that sees the new generation sees the whole value. */
|
||||
__atomic_store_n(&generation, generation + 1, __ATOMIC_RELEASE);
|
||||
}
|
||||
|
||||
@ -7,8 +7,6 @@
|
||||
(import agent "vendor:agent")
|
||||
|
||||
(defvar ticks i64)
|
||||
(defconst step-by i64 3)
|
||||
|
||||
(defn step [] i64
|
||||
(set ticks (+ ticks 1))
|
||||
ticks)
|
||||
|
||||
38
test/programs/printers.flan
Normal file
38
test/programs/printers.flan
Normal file
@ -0,0 +1,38 @@
|
||||
;;;; The fixture C-x C-e is tested against: one value of every shape the
|
||||
;;;; renderer knows, held in globals so an expression has something real to
|
||||
;;;; read out of a running process.
|
||||
;;;;
|
||||
;;;; It keeps running rather than counting reloads, because a thunk only runs
|
||||
;;;; when the program next reaches a frame boundary. (agent/wait 5) is both the
|
||||
;;;; poll and the pacing — 5ms of nothing, which is what a frame is when there
|
||||
;;;; is no frame.
|
||||
(import agent "vendor:agent")
|
||||
|
||||
(defstruct V [x f32 y f32])
|
||||
(defstruct Blob [id i32 name string pos V tags [3 i32]])
|
||||
(defenum Colour [red 0 green 1 blue 2])
|
||||
|
||||
(defvar ticks i64)
|
||||
(defvar big u64)
|
||||
(defvar b Blob)
|
||||
(defvar arr [4 i32])
|
||||
(defvar col Colour)
|
||||
|
||||
;;; Read by nothing on purpose: it is here to be *evaluated*, so that C-x C-e
|
||||
;;; is tested against a constant living in the program's memory and not only
|
||||
;;; against arithmetic the compiler could have done itself.
|
||||
(defconst step-by i64 3)
|
||||
|
||||
(defn main [] i32
|
||||
(agent/start "/tmp/flan-printers-fallback.sock")
|
||||
(set big 0xFFFFFFFFFFFFFFFF)
|
||||
(set (.id b) 7)
|
||||
(set (.name b) "sandy \"quoted\"")
|
||||
(set (.x (.pos b)) 1.5)
|
||||
(set (at (.tags b) 1) 42)
|
||||
(set (at arr 2) 9)
|
||||
(set col :blue)
|
||||
(dotimes [i 4000]
|
||||
(agent/wait 5)
|
||||
(set ticks (+ ticks 1)))
|
||||
0)
|
||||
@ -60,7 +60,7 @@ let () =
|
||||
let flan = "../bin/main.exe" in
|
||||
let pid =
|
||||
Unix.create_process flan
|
||||
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
|
||||
[| flan; "dev"; "programs/printers.flan"; "-s"; sock |]
|
||||
Unix.stdin fd Unix.stderr
|
||||
in
|
||||
Unix.close fd;
|
||||
@ -82,9 +82,26 @@ let () =
|
||||
in
|
||||
value "arithmetic" "(+ 1 2)" "3";
|
||||
value "a comparison" "(< 1 2)" "true";
|
||||
value "a string" "\"hi\"" "hi";
|
||||
(* A defconst: its value is in the program's rodata and this reads it. *)
|
||||
(* Quoted and escaped, in the runtime: a string whose content is not
|
||||
escaped does not round-trip and reads as a framing bug. *)
|
||||
value "a string" "\"hi\"" "\"hi\"";
|
||||
value "an escaped string" "(.name b)" "\"sandy \\\"quoted\\\"\"";
|
||||
(* A defconst: its value is in the program's memory and this reads it. *)
|
||||
value "a constant" "step-by" "3";
|
||||
(* Rendered in C, because the language's own i64->bytes is signed and
|
||||
this would otherwise come back as -1. *)
|
||||
value "u64 at its maximum" "big" "18446744073709551615";
|
||||
(* A struct, nested, with a fixed array inside it. *)
|
||||
value "a struct" "(.pos b)" "(V {:x 1.5 :y 0})";
|
||||
value "a nested struct" "b"
|
||||
"(Blob {:id 7 :name \"sandy \\\"quoted\\\"\" :pos (V {:x 1.5 :y 0}) :tags [ 0 42 0]})";
|
||||
value "a fixed array" "arr" "[ 0 0 9 0]";
|
||||
(* A slice's length is not known until it runs, so this one renders
|
||||
through a loop rather than by unrolling. *)
|
||||
value "a slice" "(slice (.tags b) 0 3)" "[ 0 42 0]";
|
||||
(* An enum's members are erased to i32 before the backend sees them, so
|
||||
the name is recovered from the checker's table. *)
|
||||
value "an enum" "col" ":blue";
|
||||
|
||||
(* The one that proves it ran inside the process: the program increments
|
||||
[ticks] every frame, so two evaluations of it must disagree. A copy
|
||||
@ -101,9 +118,6 @@ let () =
|
||||
program advancing" a b
|
||||
| _ -> fail "ticks did not evaluate");
|
||||
|
||||
(* Types with no printer derived yet refuse by name rather than render
|
||||
something plausible and wrong. u64 is its own case: i64->bytes is
|
||||
signed, so anything past 2^63 would come back negative. *)
|
||||
let refuses name code reason =
|
||||
let r = evals code in
|
||||
match field r "message" with
|
||||
@ -114,7 +128,6 @@ let () =
|
||||
| Some m -> fail "%s said %S, wanted it to mention %S" name m reason
|
||||
| None -> fail "%s was accepted" name
|
||||
in
|
||||
refuses "u64" "rand-state" "no printer for u64";
|
||||
refuses "a declaration" "(defvar nope i64)" "";
|
||||
refuses "an unknown name" "no-such-name" "unknown name";
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user