JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

println, the structural printer, shared with the REPL

Browse Source 
session.ml already had this: a compile-time walk over a Tast type that
emits the calls to print a value of it, handling every concrete type the
language has. It was dev-build-only and went to flan_dev_emit, and
prelude.ml justified the per-type print-* functions by saying a real
println had to wait for milestone 5 and generics. It did not. plan.org
specifies println as compiler-provided and per concrete type, which is
not overloading: there is nothing to dispatch on at run time and no
user-supplied printer to choose between, so no type variables appear.

The walk moves to render.ml, parameterised on an emitter and a slot
allocator. The emitter is five functions rather than five extern names
because the two sides are not both extern calls -- the REPL's are, and
stdout's compose a conversion with a write. The slot allocator differs
too: the REPL builds a thunk's frame, println takes slots from the
enclosing function being checked, once per call site.

Two runtime shims, both only reachable from the walk. flan_u64_to_bytes,
because routing u64 through the signed printer makes 0xFFFF...F read as
-1, which is the one way println could disagree with the REPL about a
value both can hold. flan_escape_bytes, so a string nested in a printed
structure is quoted and escaped -- same table as flan_dev_emit_str, noted
in both, because the REPL and println must not disagree about what a
struct looks like.

A string at top level prints raw and nested prints quoted. Not a conflict:
(println "hello") has to print hello, and a struct's string field has to
be distinguishable from the punctuation around it. The split is top-level
vs nested, so it lives in check.ml and not in the walk.

Found on the way: a field of an Option had no gep in emit.ml, so the
walk's Option arm had never run -- the REPL would have failed on one too.
Option is { i8, T } with no declared name, so its layout is now spelled
out. Nothing in the surface language reaches a field of an Option; the
printer does, to read the tag without unwrapping a None.

The print-* functions stay. They print without a newline, which println
cannot express -- slices.flan's show prints elements separated by spaces
-- and they are raw where print is structural.

println.flan covers every arm at -O0 and -O2: the u64, the raw/quoted
split, both Option arms, the depth and span caps, and the slice arm's
loop twice over plus once inside a dotimes, which is where per-call-site
slot allocation would show if it were per-iteration.
This commit is contained in:
Joseph Ferano 2026-09-12 04:55:42 +07:00
parent 5ea0bcae84
commit 93231e8c9e
11 changed files with 525 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
emacs/flan-mode.el
View File

@ -47,7 +47,7 @@
(defconst flan--special
'("let" "if" "do" "while" "until" "dotimes" "loop" "match" "set" "return"
"defer" "some" "none" "try" "zeroed" "uninit" "slice" "at" "len" "addr"
"bytes" "cast" "true" "false" "nil")
"bytes" "cast" "true" "false" "nil" "print" "println")
"Forms with meaning to the checker.")
(defvar flan-font-lock-keywords

53
lib/check.ml
View File

@ -1214,6 +1214,59 @@ and named_call ctx ~want loc name args =
| "write-stdout" ->
arity loc name 1 args;
prim Tast.WriteStdout Types.Unit [ byte_slice ctx (List.hd args) ]
(* (println x) and (print x): the structural printer, selected on the type
the argument checked to. plan.org, Milestone 5 — "compiler-provided,
per concrete type". That is not overloading and needs no type variables:
there is no dispatch at run time and no user-supplied printer to pick
between. The walk itself is render.ml, shared with the REPL, which is what
stops the two from drifting apart.
[min]/[max]/[zeroed] above dispatch on the resolved argument type the same
way. The slots the slice arm needs come out of the frame of whatever
function this call is written in, via [fresh_slot] — allocated once per
call site, at check time, not once per iteration of a loop around it.
A string prints raw here and quoted inside a structure. Those are not in
conflict: (println "hello") has to print hello or it is useless, and
(println b) where b has a string field has to quote it or the field
cannot be told from the punctuation. The split is exactly top level vs
nested, which is why it lives here and not in the walk. *)
| "print" | "println" ->
arity loc name 1 args;
let a = check ctx (List.hd args) in
let bslice = Types.Slice (Types.Int Types.U8) in
let write x = mk loc Types.Unit (Tast.Prim (Tast.WriteStdout, [ x ])) in
let conv pr x = mk loc bslice (Tast.Prim (pr, [ x ])) in
let emitter : Render.emitter =
{ Render.ebytes = write;
estr = (fun x -> write (conv Tast.EscapeBytes x));
ei64 = (fun x -> write (conv Tast.I64ToBytes x));
eu64 = (fun x -> write (conv Tast.U64ToBytes x));
ef64 = (fun x -> write (conv Tast.F64ToBytes x)) }
in
let rc =
{ Render.structs =
Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.structs [];
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) ctx.env.enums [];
emit = emitter;
alloc = (fun ty -> fresh_slot ctx ty) }
in
let parts =
match a.Tast.ty with
| Types.String | Types.Slice (Types.Int Types.U8) ->
[ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ]
| _ -> Render.render rc 0 a
in
let nl =
if String.equal name "println" then
[ write
(mk loc bslice
(Tast.Prim (Tast.Bytes, [ mk loc Types.String (Tast.Str "\n") ])))
]
else []
in
expect loc ~want (mk loc Types.Unit (Tast.Do (parts @ nl)))
| "exit" ->
arity loc name 1 args;
prim Tast.Exit Types.Never [ check ctx ~want:index_ty (List.hd args) ]

23
lib/emit.ml
View File

@ -668,12 +668,17 @@ and addr f (e : Tast.expr) : string =
and field_addr f (target : Tast.expr) i =
let base = addr f target in
let sn = match target.Tast.ty with
| Types.Named n -> n
(* An Option is { i8, T } and has no declared name to gep through, so its
layout is spelled out instead. Nothing in the surface language reaches a
field of one -- [match] and [some] are how an Option is opened -- but the
structural printer does, to read the tag without unwrapping a None. *)
let sty = match target.Tast.ty with
| Types.Named n -> sname n
| Types.Option _ as t -> ll t
| t -> failwith ("field of " ^ Types.to_string t)
in
let p = fresh f in
ins f "%s = getelementptr inbounds %s, ptr %s, i32 0, i32 %d" p (sname sn) base i;
ins f "%s = getelementptr inbounds %s, ptr %s, i32 0, i32 %d" p sty base i;
p
(* One index per dimension, so [(at grid row col)] is two geps. Indices are
@ -1207,6 +1212,8 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
| Tast.BytesToI64, [ x ] -> shim_in f "@flan_bytes_to_i64" "i64" x
| Tast.F64ToBytes, [ x ] -> shim_out f "@flan_f64_to_bytes" x
| Tast.I64ToBytes, [ x ] -> shim_out f "@flan_i64_to_bytes" x
| Tast.U64ToBytes, [ x ] -> shim_out f "@flan_u64_to_bytes" x
| Tast.EscapeBytes, [ x ] -> shim_in_out f "@flan_escape_bytes" x
| Tast.WriteStdout, [ x ] ->
let p, n = explode f x in
ins f "call void @flan_write_stdout(ptr %s, i64 %s)" p n;
@ -1244,6 +1251,14 @@ and shim_out f name (x : Tast.expr) =
ins f "call void %s(%s %s, ptr %s)" name (ll x.Tast.ty) v tmp;
load f tmp (Types.Slice (Types.Int Types.U8))
(* Slice in, slice out: [shim_in] returns a scalar and [shim_out] takes one, so
a shim that transforms bytes into bytes is neither. *)
and shim_in_out f name (x : Tast.expr) =
let p, n = explode f x in
let tmp = alloca f (Types.Slice (Types.Int Types.U8)) in
ins f "call void %s(ptr %s, i64 %s, ptr %s)" name p n tmp;
load f tmp (Types.Slice (Types.Int Types.U8))
and cast f (x : Tast.expr) target =
let v = value f x in
(* An enum is an i32 at run time and its own type only in the checker, so a
@ -1509,6 +1524,8 @@ declare double @flan_bytes_to_f64(ptr, i64)
declare i64 @flan_bytes_to_i64(ptr, i64)
declare void @flan_f64_to_bytes(double, ptr)
declare void @flan_i64_to_bytes(i64, ptr)
declare void @flan_u64_to_bytes(i64, ptr)
declare void @flan_escape_bytes(ptr, i64, ptr)
declare void @flan_handler_push(ptr)
declare void @flan_handler_pop(ptr)
declare void @flan_signal(i32, ptr, ptr)

17
lib/prelude.ml
View File

@ -9,9 +9,20 @@
loader yet; at milestone 3 it becomes an ordinary [core:] package and this
module goes away. The acceptance programs may call anything defined here.
No overloading: [print-f64] and [print-str] name the type, because
compile-time overloading before the checker is stable is how a small
language stops being one. A single [println] is milestone 5. *)
[println] is not here and is not a function: it is compiler-provided and
structural, a walk over the concrete type at the call site (check.ml, and
the walk itself in render.ml). That is plan.org's Milestone 5 item, and it
needed none of the rest of milestone 5 -- there is nothing to dispatch on
at run time and no user-supplied printer to choose between, so no type
variables are involved. The earlier note here said a single [println] had
to wait for generics; it did not.
The [print-*] functions stay, and not as compatibility. They print without
a newline and name their type at the call site, which is what a loop that
prints elements separated by spaces wants -- see [show] in
test/programs/slices.flan. [println] cannot express that, and [print] is
structural where these are not: [(print-str s)] is the raw bytes, whereas
[(print s)] is the same walk [println] uses. *)
let source = {flan|
(defn print-bytes [b [u8]]

201
lib/render.ml Normal file
View File

@ -0,0 +1,201 @@
(** 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 — (print-line "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>" ]
| 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)

196
lib/session.ml
View File

@ -398,174 +398,18 @@ let externs : Tast.extern list =
{ 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 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 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 }
(* The REPL's emitter. Each piece is one extern call: the dev runtime already
has a renderer per scalar, and [flan_dev_emit_str] already quotes and
escapes. See render.ml for what the five are and why they are functions. *)
let dev_emitter : Render.emitter =
let call em (x : Tast.expr) : Tast.expr =
{ Tast.e = Tast.Call (em.ename, [ x ]); ty = Types.Unit; loc = x.Tast.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")) ]
(* Evaluated *and then* reported. A Unit expression is almost always a call
made for its effect — (print-line "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 ->
[ 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)
{ Render.ebytes = call emit_bytes;
estr = call emit_str;
ei64 = call emit_i64;
eu64 = call emit_u64;
ef64 = call emit_f64 }
let eval_expr ?(origin = "<eval>") t src : change =
let form =
@ -575,21 +419,31 @@ let eval_expr ?(origin = "<eval>") t src : change =
| _ :: f :: _ -> fail f.Form.loc "one expression at a time"
in
let checked, base = Check.expression t.env (Parse.expr form) in
(* The thunk's frame starts at whatever [Check.expression] needed and grows
as the walk finds slices in it, so the slots the renderer asks for are
appended past [base] and collected here to size the frame below. *)
let extra = ref [] and nslots = ref (Array.length base) in
let c =
{ structs = t.program.Tast.structs;
{ Render.structs = t.program.Tast.structs;
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
slots = []; nslots = Array.length base }
emit = dev_emitter;
alloc = (fun ty ->
let i = !nslots in
incr nslots;
extra := ty :: !extra;
i) }
in
let loc = checked.Tast.loc in
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
let body =
(nullary "flan/dev-begin" :: render c 0 checked) @ [ nullary "flan/dev-end" ]
(nullary "flan/dev-begin" :: Render.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 = []; ret = Types.Unit; body; fdefers = []; fparent = None; floc = loc;
slots = Array.append base (Array.of_list (List.rev c.slots)) }
slots = Array.append base (Array.of_list (List.rev !extra)) }
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

4
lib/tast.ml
View File

@ -28,6 +28,10 @@ type prim =
*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
(* 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
| Cast of Types.t

12
plan.org
View File

@ -381,10 +381,14 @@ wasm32 target cheap, because a primitive is the only thing implemented twice.
| arithmetic, comparison, casts | per machine type |
Printing is *not* a primitive. ~print-str~, ~print-f64~ and friends are Flan
functions over ~write-stdout~. At milestone 5, compiler-provided ~println~ emits
or selects a structural printer for every concrete type, including generic
instantiations. This is intentionally not user-defined overload resolution:
ordinary values remain untagged, while ~any~ and ~Error~ carry the metadata their
functions over ~write-stdout~. ~println~ and ~print~ are compiler-provided: the
checker walks the concrete type at the call site and emits the printer for it
(lib/render.ml, shared with the REPL's ~C-x C-e~). This is intentionally not
user-defined overload resolution — ordinary values remain untagged, and there
is nothing to dispatch on at run time — which is why it did not have to wait
for generics as this line once said it would. Generic instantiations are
concrete types by the time the checker sees them, so they need nothing further;
~any~ and ~Error~ are the remaining case, and they carry the metadata their
dynamic printers need.
*Entry point.* ~(defn main [args [string]] i32)~. Both the parameter and the

57
runtime/flan_rt.c
View File

@ -191,6 +191,63 @@ void flan_i64_to_bytes(int64_t x, flan_slice *out) {
out->len = n < 0 ? 0 : (int64_t)n;
}
/* u64 is not i64 with a flag: 0xFFFFFFFFFFFFFFFF is 18446744073709551615 and
* not -1, and routing it through the signed printer is the only way println
* could disagree with the REPL about a value both can hold. Hence a second
* shim rather than a cast at the call site. */
void flan_u64_to_bytes(uint64_t x, flan_slice *out) {
int n = snprintf(scratch, SCRATCH, "%llu", (unsigned long long)x);
out->ptr = (const uint8_t *)scratch;
out->len = n < 0 ? 0 : (int64_t)n;
}
/* A string *inside* a printed structure, quoted and escaped, so that the run
* of bytes can be told from the punctuation around it — (S {:name "a b"}) has
* two fields if the quotes are missing and one if they are there.
*
* This is the same escape table as flan_dev_emit_str in flan_dev.c, and
* deliberately so: the REPL and println must not disagree about what a struct
* looks like. It cannot be the *same function* because the dev one streams
* into the result buffer and this one has to hand back a slice; if either
* table changes, change both.
*
* Its own buffer, not `scratch`: escaping is the one conversion whose output
* is not a bounded handful of characters. Over-long input is truncated with an
* ellipsis rather than silently cut, because a value that prints as a shorter
* value is the failure nobody notices. */
#define ESCAPE_MAX 1024
static char escaped[ESCAPE_MAX];
void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) {
size_t len = n < 0 ? 0 : (size_t)n;
size_t w = 0;
int cut = 0;
/* 5 is the longest single escape (\xNN is 4, plus room for the close
* quote); leaving it spare means the loop never writes a partial escape. */
escaped[w++] = '"';
for (size_t i = 0; i < len; i++) {
if (w + 5 + 4 >= ESCAPE_MAX) { cut = 1; break; }
unsigned char c = p[i];
switch (c) {
case '"': escaped[w++] = '\\'; escaped[w++] = '"'; break;
case '\\': escaped[w++] = '\\'; escaped[w++] = '\\'; break;
case '\n': escaped[w++] = '\\'; escaped[w++] = 'n'; break;
case '\t': escaped[w++] = '\\'; escaped[w++] = 't'; break;
case '\r': escaped[w++] = '\\'; escaped[w++] = 'r'; break;
default:
if (c < 0x20) {
w += (size_t)snprintf(escaped + w, 5, "\\x%02x", c);
} else {
escaped[w++] = (char)c;
}
}
}
if (cut) { escaped[w++] = '.'; escaped[w++] = '.'; escaped[w++] = '.'; }
escaped[w++] = '"';
out->ptr = (const uint8_t *)escaped;
out->len = (int64_t)w;
}
/* Bounds failures. The emitted code branches here and then falls off the end
* with `unreachable`, so these must not return — the same explicit shape as
* every other non-local exit, which is what keeps wasm32 free of unwinding.

115
test/programs/println.flan Normal file
View File

@ -0,0 +1,115 @@
;;;; println, one row per arm of the structural printer.
;;;;
;;;; The walk in render.ml is shared with the REPL, but until now its only
;;;; coverage was the REPL tests -- and those run a dev build, where the pieces
;;;; go to flan_dev_emit. println is the same walk with the other emitter, in
;;;; an ordinary build, so every arm needs saying again here: the two emitters
;;;; are the one thing the shared module does *not* make identical.
;;;;
;;;; Run at -O0 as well as -O2. The slice arm emits a loop over slots taken
;;;; from the enclosing function's frame, and mem2reg is exactly the pass that
;;;; would launder a slot mistake into working code.
(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])
;; Five deep, so the walk hits max_depth (4) and prints "..." rather than
;; descending forever. A self-containing struct is the case this cap exists
;; for; five nested ones are the same shape without needing a pointer.
(defstruct D5 [n i32])
(defstruct D4 [d D5])
(defstruct D3 [d D4])
(defstruct D2 [d D3])
(defstruct D1 [d D2])
(defvar b Blob)
(defvar col Colour)
(defvar big u64)
(defvar small u64)
(defvar arr [4 i32])
(defvar wide [10 i32])
(defvar deep D1)
(defvar n i32)
(defn nothing [] )
(defn find-it [s [i32] k i32] (Option i32)
(dotimes [i (len s)]
(when (= (at s i) k) (return (Some i))))
None)
(defn main [] i32
;; A string at top level prints raw. Anywhere else it is quoted, which the
;; Blob row below shows -- the two are the same value printed two ways on
;; purpose, and that difference is the thing most likely to be "fixed".
(println "plain string")
(println (bytes "plain bytes"))
(println 42)
(println -7)
(set small 5)
(println small)
;; The u64 row. Through the signed printer this reads -1, which is the one
;; way println could disagree with the REPL about a value both can hold.
(set big 0xFFFFFFFFFFFFFFFF)
(println big)
(println 3.5)
(println -0.25)
(println true)
(println false)
;; Unit is evaluated and *then* reported: a Unit expression is a call made
;; for its effect, so emitting () without running it would be a lie.
(println (nothing))
(set col :green)
(println col)
;; red is 0, which is also the zero value, so this row says the chain of
;; comparisons reaches the *first* member and does not fall through to the
;; number it is erased to.
(set col :red)
(println col)
;; A pointer is its shape and is never followed -- the only thing that could
;; make this walk cycle.
(set n 3)
(println (addr n))
(println (find-it (slice wide 0 10) 0))
(println (find-it (slice wide 0 10) 99))
(set (.id b) 7)
(set (.name b) "sandy \"quoted\"")
(set (.x (.pos b)) 1.5)
(set (.y (.pos b)) -2.0)
(set (at (.tags b) 1) 42)
(println b)
(set (at arr 2) 9)
(println arr)
;; Ten elements against a span cap of eight: eight, then "...".
(set (at wide 9) 1)
(println wide)
;; A slice's length is not known until it runs, so this is the arm that
;; emits a loop rather than unrolling.
(println (slice arr 1 4))
(set (.n (.d (.d (.d (.d deep))))) 5)
(println deep)
;; Two slice printlns in one function, and one inside a loop: the slots the
;; loop needs are allocated per *call site* at check time, not per iteration.
(dotimes [i 2]
(println (slice arr 0 2)))
(println (slice arr 2 4))
;; print is println without the newline.
(print "a")
(print "b")
(println "c")
0)

27
test/test_acceptance.ml
View File

@ -127,6 +127,33 @@ let () =
in
outputs "slice algorithms" "programs/slices.flan" slices_out;
outputs ~opt:"-O0" "slice algorithms, -O0" "programs/slices.flan" slices_out;
(* println, one row per arm of render.ml's walk. The walk is shared with
the REPL, but its only coverage was the REPL tests -- a dev build,
emitting to flan_dev_emit. This is the same walk with the other emitter
in an ordinary build, which is a path nothing else takes.
Three of these rows are load-bearing beyond "it prints something". The
u64 reads 18446744073709551615 and not -1, which is what a second shim
exists for. The Blob's name is quoted and escaped while the two strings
at the top are raw, which is the top-level/nested split and the thing
most likely to be "tidied up" into being wrong. And the Option rows are
an arm that never ran until now: a field of an Option had no gep in
emit.ml, so the REPL would have failed on one too.
At -O0 as well -- the slice arm allocates slots in the enclosing
function's frame and emits a loop, and mem2reg is the pass that would
hide a mistake in either. *)
let println_out =
"plain string\nplain bytes\n42\n-7\n5\n18446744073709551615\n3.5\n\
-0.25\ntrue\nfalse\n()\n:green\n:red\n<ptr>\n(some 0)\nnone\n\
(Blob {:id 7 :name \"sandy \\\"quoted\\\"\" :pos (V {:x 1.5 :y -2}) :tags [ 0 42 0]})\n\
[ 0 0 9 0]\n[ 0 0 0 0 0 0 0 0 ...]\n[ 0 9 0]\n\
(D1 {:d (D2 {:d (D3 {:d (D4 {:d (D5 {:n ...})})})})})\n[ 0 0]\n\
[ 0 0]\n[ 9 0]\nabc\n"
in
outputs "println, every arm" "programs/println.flan" println_out;
outputs ~opt:"-O0" "println, every arm, -O0" "programs/println.flan"
println_out;
(* The byte predicates, parse-i64, and the two number helpers. The refused
parse-i64 cases are every shape strtoll answers 0 for — "", "abc",
"12x", "-", " 1" — so a None there is the whole reason the function is