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

Merge branch 'println' into dev-loop

Browse Source 
nth removed, and the REPL's structural walk lifted into a println that
shares it. The example of the narrowing-index rule used nth, which no
longer exists.
This commit is contained in:
Joseph Ferano 2026-09-12 05:00:19 +07:00
commit 2474397d30
18 changed files with 575 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
MY-NOTES.org Normal file
View File

@ -0,0 +1,4 @@
* Additional things
** Why do we have prints dedicted per type? That's terrible, what do we need to have proper (println) work for everything?
** The current std is suffering from the same problem, functions should be generic? Why is it like this?
** Why do we have =at= and =nth= if they're the same? Pick one, maybe =at=. For all STD functions make sure we don't have redundancy, even if it matches clojure or lisp

2
NEXT.md
View File

@ -620,7 +620,7 @@ Most of these are edges the language keeps and you should know about. Two — th
both found by review after milestone 4 — were bugs that reached LLVM or ran wrong, and are **fixed**; each says so. They
stay written down because each one is now a rule the checker enforces, and a later change could quietly drop it.
- **An index converts from a narrower integer and never from a wider one.** `(nth colors current-color)` with a `u32`
- **An index converts from a narrower integer and never from a wider one.** `(at colors current-color)` with a `u32`
index works — anything above 2³¹ truncates to a negative `i32` and the unsigned bounds check rejects it. An `i64` index
is refused with the reason: 2³²+5 truncates to 5 and would read the wrong element with no trap at all.
- **There is one top-level namespace, and `check.ml` now enforces it.** The environment's tables are per-kind — structs,

2
calc-me.flan
View File

@ -120,6 +120,6 @@
(defn main [args [string]] i32
(if (< (len args) 2)
(do (print-line "usage: calc-me \"1 + 2 * 3\"") 1)
(match (evaluate (bytes (nth args 1)))
(match (evaluate (bytes (at args 1)))
(Some v) (do (print-f64 v) (print-line "") 0)
None (do (print-line "calc-me: cannot parse") 1))))

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

55
lib/check.ml
View File

@ -1128,7 +1128,7 @@ and named_call ctx ~want loc name args =
| other -> fail loc "len takes an array, a slice or a string, found %s"
(Types.to_string other));
prim Tast.Len index_ty [ a ]
| "at" | "nth" ->
| "at" ->
(match args with
| target :: idx when idx <> [] ->
let target = check ctx target in
@ -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

14
plan.org
View File

@ -104,7 +104,7 @@ world.
is type-directed: ~(defvar enemies (Map string Enemy) (map-new))~. ~get~
returns ~(Option V)~; ~put~ is the `Unit`-returning upsert. See
spec-memory.md for the deferred move-aware operations.
- Operations: ~get~, ~put~, ~remove~, ~push~, ~pop~, ~nth~, ~len~, ~update~.
- Operations: ~get~, ~put~, ~remove~, ~push~, ~pop~, ~at~, ~len~, ~update~.
Copying is explicit: ~(clone m)~, and owning containers move rather than copy on
assignment. No ~!~ convention — nothing is immutable, so it
would carry no information. No ~assoc~; it only existed as the copy-returning form.
@ -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

61
runtime/flan_rt.c
View File

@ -191,6 +191,67 @@ 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;
/* The guard reserves 9 bytes, and all 9 are spoken for: 4 for the longest
* single escape (\xNN), 3 for the ellipsis, 1 for the closing quote, 1
* spare. So the loop never writes a partial escape and the three writes
* after it never need a bound of their own. Swept over every length to 1300
* against \x01, '"', '\\' and 'a': the worst output is 1021 of 1024. If the
* escape table ever grows a longer form, this 9 grows with it. */
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.

8
sand.flan
View File

@ -82,7 +82,7 @@
(>= c 0) (< c (- cols 1))
(empty-at? r c)
(< (rand-f32) 0.5))
(set (at grid r c) (nth colors current-color))
(set (at grid r c) (at colors current-color))
(set (at velocity r c) 1.0)))))))
(defn move-grain [from-row i32 from-col i32
@ -198,7 +198,7 @@
rl/white)
(rl/draw-texture brush 20 50 rl/white)
(rl/draw-texture-v brush (rl/Vector2 {:x 44.0 :y 50.0})
(rl/get-color (nth colors current-color)))
(rl/get-color (at colors current-color)))
(rl/draw-texture-ex brush (rl/Vector2 {:x 72.0 :y 46.0}) 0.0 2.0 rl/white)))
;; The mirrored one beside them, scaled up so the flip is visible rather
;; than eight pixels wide. If the two badges look the same, either the flip
@ -449,7 +449,7 @@
;; and does not.
(defn draw-world-cursor []
(let [p (rl/get-screen-to-world-2d (rl/get-mouse-position) view)
tint (rl/get-color (nth colors current-color))
tint (rl/get-color (at colors current-color))
x (.x p)
y (.y p)
r (f32 (* brush-size cell-size))]
@ -528,7 +528,7 @@
sh (- (rl/get-screen-height) 40)]
(dotimes [i (len colors)]
(let [cx (- sw (* (- (len colors) (+ i 1)) 46))
c (rl/get-color (nth colors i))]
c (rl/get-color (at colors i))]
(rl/draw-circle cx sh (f32 16.0) c)
(when (= i current-color)
(rl/draw-circle-lines cx sh (f32 22.0) rl/white))))

2
syntax-sketch.flan
View File

@ -58,7 +58,7 @@
;; this frame (spec-memory.md, non-escaping fn).
(defn largest [xs [a] gt (Fn [a a] bool)] (Option a)
(if (> (len xs) 0)
(Some (reduce (fn [x y] (if (gt x y) x y)) (nth xs 0) xs))
(Some (reduce (fn [x y] (if (gt x y) x y)) (at xs 0) xs))
None))
;; (largest hps >) — `>` at i32 is an ordinary function value

11
test/programs/nth-gone.flan Normal file
View File

@ -0,0 +1,11 @@
;;;; nth was an alias of at, and an asymmetric one: the checker accepted it as
;;;; a read, but parse.ml and place_of_expr both match only [at], so
;;;; (set (nth a i) x) and (addr (nth a i)) were refused while the [at] forms
;;;; worked. Two names documented as identical that disagree about writing are
;;;; worse than one name, so nth is gone and this pins the removal: it must
;;;; fail as an unknown name, not quietly resolve to at again.
(defvar a [4 i32])
(defn main [] i32
(nth a 0))

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

@ -0,0 +1,124 @@
;;;; 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)
(defstruct Long [s string])
(defvar long-one Long)
(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))
;; A nested string longer than the escape buffer. Escaping is the one
;; conversion whose output is not a bounded handful of characters, so it
;; truncates -- with an ellipsis inside the quotes, because a value that
;; prints as a shorter value is the failure nobody notices.
(set (.s long-one) "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
(println long-one)
;; print is println without the newline.
(print "a")
(print "b")
(println "c")
0)

38
test/test_acceptance.ml
View File

@ -127,6 +127,39 @@ 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]\n"
(* The escape buffer is 1024 and the input is 1100 x's, so this is the
truncation: the ellipsis goes *inside* the quotes, and the count is
spelled out rather than pasted so that a change to the buffer or to
the reserve shows up here as a number and not as a wall of x. *)
^ "(Long {:s \"" ^ String.make 1014 'x' ^ "...\"})\n"
^ "abc\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
@ -620,6 +653,11 @@ let () =
"one directory is one set of names";
refuses "two mains in one program" "programs/pkg-two-mains.flan"
"main is defined twice";
(* nth is gone, not renamed: it has to fail as a name nobody defined. If it
were ever re-added as an alias of [at] it would have to be a place too,
and this row is what says so. *)
refuses "nth is not a name" "programs/nth-gone.flan"
"unknown function nth";
(* ── wasm32 (NEXT.md, deferred item 6) ──────────────────────────────
The second target, and the reason sand-headless imports no raylib. What

3
web/index.html
View File

@ -643,8 +643,9 @@ second
<h2 id="arrays">Arrays and slices</h2>
<p><code>at</code> and <code>nth</code> are the same operation and take any number of
<p><code>at</code> indexes a fixed array or a slice, and takes any number of
indices, so <code>(at grid r c)</code> indexes a two-dimensional fixed array directly.
It is a place: <code>(set (at grid r c) v)</code> and <code>(addr (at grid r c))</code> both work.
<code>len</code> works on a fixed array, a slice or a string.
<code>(slice s lo hi)</code> takes a half-open range and never copies.</p>