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

Merge: unannotated means dyn, and the typed world pays nothing

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-19 06:52:39 +07:00
commit f885e1abfa
24 changed files with 1876 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
bin/main.ml
View File

@ -195,9 +195,17 @@ let llvm_flag = "--llvm"
assembler is worth measuring rather than asserting. *)
let no_annotate_flag = "--no-annotate"
(* "This program carries no collector", and the way it is kept is a refusal
rather than a different lowering: every dyn left in the program is named,
with its location, and nothing downstream is told the flag was given. See
[Check.no_gc], which is a pass between checking and emission and answers
unit — an annotated program's output is byte for byte what it is without
the flag, and that is the property the flag is worth having for. *)
let no_gc_flag = "--no-gc"
let flags =
[ no_checks_flag; dev_flag; debug_flag; sanitize_flag; two_process_flag;
x86_flag; llvm_flag; no_annotate_flag ]
x86_flag; llvm_flag; no_annotate_flag; no_gc_flag ]
(* Which backend a command got, from the two flags and the default it would
have taken. One function because there is one rule, and the only thing that
@ -616,8 +624,12 @@ let () =
with_errors path (fun () ->
let l = load path in
let pnames = if debug then param_names l else [] in
Flan.Check.program_all l.decls
|> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize
let p = Flan.Check.program_all l.decls in
(* Between checking and emission, and it hands the very same program
on: the flag is a question asked of what was checked, never a
parameter of what is emitted. *)
if List.mem no_gc_flag args then Flan.Check.no_gc p;
Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize p
|> print_string))
files
| _ :: "build" :: path :: rest ->
@ -654,12 +666,17 @@ let () =
prerr_endline
"usage: flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
[--no-bounds-checks] \
[--dev] [--debug] [--sanitize] [--target=wasm32-wasi|web|js]";
[--dev] [--debug] [--sanitize] [--no-gc] [--target=wasm32-wasi|web|js]";
exit 2
in
with_errors path (fun () ->
let l = load path in
let p = Flan.Check.program_all l.decls in
(* Before reachability rather than after: a dyn in a function nothing
calls is still a dyn somebody wrote, and a refusal that depended on
what [main] happened to reach would come and go as the program was
edited elsewhere. *)
if List.mem no_gc_flag rest then Flan.Check.no_gc p;
(* The link follows the program, not the import list: a package nothing
reachable calls into contributes no C and no linker argument, and its
functions are not emitted either. That is what lets one file import

138
docs/handoffs/HANDOFF-dyn-m1.md Normal file
View File

@ -0,0 +1,138 @@
# dyn, milestone 1 — what was decided and what is left
The compiler half of dynamic-by-default. The runtime half is a sibling's, built
in parallel against `runtime/flan_dyn.h`, which is the fixed ABI and the thing
the two copies are diffed against.
## Two decisions that differ from the brief
**The return slot stays mandatory; `dyn` is written out in it.** The brief
expected `ret = None` to grow a third state meaning "unannotated", and listed
mechanical fallout in `load.ml`, `shim.ml` and `cimport.ml`. That fallout does
not exist, because the change was not made. The reason is in `parse.ml` beside
the `defn` case: an optional return slot has *no* syntactic resolution, since a
capitalised head in a list is both a type application and a struct literal —
`(defn f [] (Rune {.code 65}) (bar))` is the misparse that removed the old
optional slot, and it would come straight back. A parameter vector has no such
case, because every slot in it is a name or a type and never an expression. So
`ret = None` still means Unit and only `declare` and the shim produce it. One
token in the return position buys a decision the file paid for twice in one day.
**The parameter rule is resolved in `Check`, not in `parse.ml`.** The brief
asked for "a known type name is a type, anything else is another dyn param",
written where `parse.ml` argues its other misparse-closing decisions. That
lookup is exactly the one `parse.ml:904` records being removed for being wrong
twice in one day, and at parse time the set of type names is incomplete *by
construction* — macros generate definitions, packages are loaded later, C
headers are imported later. `cimport.ml` decides it: `named env n = tname n`
passes C type names through verbatim, so POSIX's `stat` and `timespec` are
lowercase Flan type names writable in parameter position, and no syntactic rule
("capitalised is a type") can be made sound.
So the vector is carried undecided as `Ast.pitem`s and paired in
`Check.pair_params`, after every file is loaded, every macro expanded and every
header imported. The argument is written at `parse.ml`'s `defn` case as asked.
## The residual the parent owns
The set of type names is complete at a point in time and **not across time**.
`(defn f [x y] ...)` is two dyn parameters until somebody writes
`(defstruct y ...)` — or imports a header that declares one — and then it is one
parameter of type `y`, with no edit to `f`. The signature changes underneath it,
and arity changes with it.
`Session.compatible` is where that is felt: it compares with `Types.equal` over
parameters and return, so a redefinition that changes dyn-ness is refused like
any other signature change (this falls out; it is pinned in `test_session.ml`).
But the *first* definition after such an edit is the one that changes, and
nothing warns.
## What the feature costs, and what was taken back
A parameter slot with no type used to be a syntax error. It is now a `dyn`
parameter, so **a mistyped type silently becomes an extra parameter** — the
arity changes with no diagnostic, which is the failure class `parse.ml` calls
the worst available. Two rules take most of it back, in `dyn_param_or_typo`:
- a name within one edit of a type's name gets the resolver's own "did you
mean", and
- an unknown **capitalised** name is reported as an unknown type. Not one
parameter in the corpus is capitalised, while `Form`, `Cursor` and `Vector2`
appear in these vectors constantly.
What is left uncovered is a lowercase name resembling no type: `(defn f [x
widget] ())` is two dyn parameters and nothing in the text says otherwise. That
is the feature working as specified.
**Sharp edge of the near-miss rule.** `near_miss` treats any two single-char
names as one edit apart, and it compares against every struct name in scope. So
a `(defstruct D ...)` anywhere in the program makes `(defn f [a d] ...)` a
refusal rather than two dyn parameters. The message is actionable — write the
type, or rename — but it is a refusal a user will meet without having done
anything wrong.
## Open ABI point for the integrator
**A rooted slot holding 0 is not a value, and the collector must skip it.**
This is written into `runtime/flan_dyn.h` beside the root functions, and it is
the one thing in that header decided by one side alone. Roots are pushed in the
function's entry block, before the code that fills them has run and possibly for
a branch that never runs, so the compiler zeroes every root slot and must mean
something by it — and 0 is the only pattern it can write without knowing the
encoding.
If the real runtime NaN-boxes and integer zero is the zero word, this is wrong
and the two sides need a different sentinel. Do not fix it on one side.
## Not in milestone 1, each refused by name with a location
- a typed container boxing into dyn (`(Vec i64)` → dyn): "not yet"; the
heterogeneous container is the runtime's own from `(vec-new dyn)`
- a dyn in a condition's payload, or in a field of one: milestone 2 — a payload
crosses a handler boundary and must stay rooted across the transfer
- a dyn crossing to C through `declare`/`declare-c`: it is one word and would
have passed as an integer with nothing on the other side able to ask what it
means. This one was **not** in the brief and is the dangerous one, because the
general "cannot cross to C" arm would have caught it with advice (`pass (Ptr
T)`) that is wrong for dyn.
- integer widths other than i64 and floats other than f64 unboxing from dyn:
the ABI carries one of each, and a `need_i64` plus a truncation would put an
implicit narrowing at the one boundary where the value's type was already
uncertain
- the x86 dev backend, and the JS dialect, refuse dyn entirely
## Roots: what is and is not verified
Every dyn slot and every dyn-producing runtime call is rooted, pushed in the
entry block and popped at every `ret` — which is the funnel all five exits pass
through, the transfer landing block included. Pushes and pops balance **by
construction**: `dyn_roots` counts before emission, the slots are minted from
that count, and `dyn_tmp` only hands them out.
**The stub verifies none of this.** `flan_dyn_stub.c` mallocs and never frees,
so a program with entirely wrong root discipline passes every test that runs
against it. What is checked instead is the IR, and that check earned its keep —
it found a real hole. A defer appears twice in the typed IR, spliced into `body`
for the normal path and again in `fdefers` for the path a transfer leaves
through, so a dyn temporary inside one is emitted twice; `dyn_roots` counted
only the body's, and the second copy went into slots the collector had never
been told about.
Nothing failed, which is the point. `dyn_tmp` falls back to a plain unrooted
slot rather than unbalancing the stack, so the pushes and the pops still
matched, the program ran and printed the right answer, and four dyn values were
simply invisible. Under a stub that never collects there is no symptom at all.
The assertion that caught it is in `test_acceptance.ml`: a rooted slot is
spelled `%dr` and the fallback `%dx`, and no dyn program in the corpus may emit
the latter. When the real collector lands, that is the check to extend rather
than replace — it is the only one that can see a missing root before there is a
collector to lose one by.
Cost: a rooted alloca has its address escape through `flan_dyn_root_push`, so
mem2reg cannot promote it. Every dyn local and every dyn temporary is a real
stack slot with a real store, at every optimisation level. That is inherent to a
precise collector with an address-registration ABI rather than stack maps.
A function with no dyn emits nothing — no push, no pop, not a `pop(0)` — which
is what makes `--no-gc` byte-identity hold.

20
lib/ast.ml
View File

@ -106,6 +106,19 @@ and rclause =
restart clause's parameters are one, and a clause is part of an expression. *)
and field = { fname : string; fty : texpr; floc : Loc.t }
(* One slot of a [defn]'s parameter vector, before it is known whether the slot
is a name or a type. [(defn f [x y] ...)] is two dyn parameters if [y] is
not a type and one parameter [x : y] if it is, and the parser cannot tell:
the type names are not all known until macros have run and every file has
been loaded. So the vector is carried undecided and paired in [Check], where
the set is complete. See the argument in Parse beside the [defn] case. *)
and pitem =
(* A bare symbol: either a parameter's name or a type's. *)
| Pname of string * Loc.t
(* Anything that cannot be a parameter name — [(Ptr T)], [[T]], [[n T]], [()]
— and so is a type whatever the environment says. *)
| Ptype of texpr
(* Two unwrap operators, because they are two different things — plan.org. *)
and unwrap = Usome | Utry
@ -136,6 +149,13 @@ type pred = { pname : string; pvar : string; ploc : Loc.t }
type fn = {
name : string;
params : field list;
(* [Some items] means the parameter vector has not been paired yet: it was
written by a [defn], where a slot with no type means [dyn], and [Check]
fills [params] from it before anything reads them. [None] is every other
way a signature is built — [declare], the shim, the C importer — where
every parameter's type was written out and the pairing was never in
doubt. Nothing downstream of [Check.pair_params] sees [Some]. *)
praw : pitem list option;
ret : texpr option; (* None means (); only declare omits it *)
(* The [{:where ...}] map at the head of the body, already unpacked. Empty
for every function that has none, which is every function that is not

557
lib/check.ml
View File

@ -707,6 +707,14 @@ and resolve_name env ~seen loc n =
match n with
| "bool" -> Types.Bool
| "string" -> Types.String
(* Lowercase and concrete, which the rule three screens down says is a
type variable. It is spelled this way because it is a primitive and
every other primitive is lowercase — [dyn] beside [i64] and [bool]
reads as one of them, [Dyn] beside [Vec] and [Option] reads as a
container over something. The type-variable rule is reached by a
[when] guard below and this arm is before it, so the spelling costs
nothing but the note. *)
| "dyn" -> Types.Dyn
| "Unit" -> Types.Unit
| "Never" -> Types.Never
(* A builtin opaque type, the way [string] is a builtin ptr+len. There is
@ -752,6 +760,127 @@ and array_len env loc = function
fail loc "%s is not a compile-time integer constant, so it cannot be \
an array length" n)
(* ── Pairing a defn's parameter vector ──────────────────────────────────
[(defn f [x y] ...)] is one parameter [x] of type [y] if [y] names a type,
and two parameters of type [dyn] if it does not. Parse could not tell — the
long argument is beside its [defn] case — so it handed over the slots
undecided and this is where they are paired, with every type name in hand:
every file loaded, every macro expanded, every C header imported.
The walk is left to right and takes two slots or one. A name followed by
something that is a type takes two and is annotated; a name followed by
another name that is not a type, or by nothing, takes one and is [dyn]. That
is the whole rule, and it reads the way the vector reads.
A name that *is* a type name is refused rather than paired. [(defn f [i64 x]
...)] has no good reading: taken as written it is a parameter called [i64],
which shadows nothing but confuses everything, and the likelier intent is a
pair written backwards. Refusing here costs a rename in the one program that
meant it and closes the one place where this rule could still hand somebody
a signature they did not write. *)
let is_type_name env n =
Types.ikind_of_name n <> None
|| Types.fkind_of_name n <> None
|| List.mem n [ "bool"; "string"; "dyn"; "Unit"; "Never"; "Allocator" ]
|| Hashtbl.mem env.aliases n
|| Hashtbl.mem env.structs n
|| Hashtbl.mem env.datas n
|| Hashtbl.mem env.unions n
|| Hashtbl.mem env.enums n
(* A type variable: [$t] in a signature is generics' binding site, and a
slot holding one is a type however few of them there are. *)
|| (n <> "" && n.[0] = '$')
(* Before a bare symbol is allowed to become an unannotated parameter, the two
ways it is more likely to be a type that went wrong.
This is the cost dynamic-by-default puts on the parameter vector, and it is
worth naming plainly: a slot with no type used to be a syntax error, and now
it is a [dyn] parameter. So [(defn f [x f65] ())] — a typo for [f64] — no
longer reads as a mistyped type. It reads as two parameters, one of them
called [f65], and the function silently takes an argument nobody meant to
give it. An arity that changes because of a typo, with no diagnostic, is the
failure class Parse's [defn] comment calls the worst available, and the
feature reintroduces it in a new place.
Two rules take most of it back. A name within one edit of a type's name is
the typo it looks like, and is refused with the same "did you mean" the
resolver gives — the near-miss table is already there and is exactly the
right question. And a capitalised name is a type by the convention the whole
corpus keeps: not one parameter in the language is capitalised, while [Form],
[Cursor], [Vector2] and the rest appear in these vectors constantly. So an
unknown capitalised name is an unknown *type*, reported as one, rather than
a parameter nobody would have spelled that way.
What is left uncovered is a lowercase name that resembles no type: [(defn f
[x widget] ())] is two dyn parameters and there is no evidence in the text
that it was meant to be one. That case is the feature working as specified,
and it is the residual the parent owns. *)
let dyn_param_or_typo env n loc =
match near_miss env n with
| Some m ->
Loc.failk "check/unknown-type" loc
"unknown type %s — did you mean %s? A parameter with no type is dyn, so \
this would otherwise be read as a second parameter called %s"
n m n
| None ->
if n <> "" && n.[0] = Char.uppercase_ascii n.[0]
&& n.[0] <> Char.lowercase_ascii n.[0]
then
Loc.failk "check/unknown-type" loc
"unknown type %s. A capitalised name in a parameter vector is a type — \
a parameter with no type is dyn, and parameters are lowercase"
n
let pair_params env (items : Ast.pitem list) : Ast.field list =
let dyn loc = { Ast.t = Ast.Tname "dyn"; tloc = loc } in
let rec go = function
| [] -> []
| Ast.Ptype t :: _ ->
Loc.failk "check/parameter-name-expected" t.Ast.tloc
"a parameter's name was expected here, and this is a type. \
Parameters are [name Type ...], and a name with no type is dyn"
| Ast.Pname (n, loc) :: rest when is_type_name env n ->
ignore rest;
Loc.failk "check/parameter-named-type" loc
"%s names a type, so it cannot also be this parameter's name. If the \
pair was written backwards it is [name %s]; otherwise rename the \
parameter" n n
| Ast.Pname (n, loc) :: Ast.Ptype t :: rest ->
{ Ast.fname = n; fty = t; floc = loc } :: go rest
| Ast.Pname (n, loc) :: Ast.Pname (t, tloc) :: rest when is_type_name env t ->
{ Ast.fname = n; fty = { Ast.t = Ast.Tname t; tloc }; floc = loc } :: go rest
(* The slot after this one is not a type, so this one is a parameter with
no type written — unless the slot after it only *looks* unlike a type
because it was mistyped, which is what the check is for. The next slot
is the one interrogated, not this one: this one is a name either way. *)
| Ast.Pname (n, loc) :: (Ast.Pname (t, tloc) :: _ as rest) ->
dyn_param_or_typo env t tloc;
{ Ast.fname = n; fty = dyn loc; floc = loc } :: go rest
| Ast.Pname (n, loc) :: rest ->
{ Ast.fname = n; fty = dyn loc; floc = loc } :: go rest
in
go items
(* Every [defn] in the program, with its parameter vector paired. Run as a pass
of its own, after the type names are registered and before any signature is
resolved, so that nothing downstream ever sees an unpaired one. *)
let pair_decls env (decls : Ast.decl list) : Ast.decl list =
let fn (f : Ast.fn) =
match f.Ast.praw with
| None -> f
| Some items -> { f with Ast.params = pair_params env items; praw = None }
in
List.map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) }
| Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn f, c) }
| Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn f, c) }
| _ -> d)
decls
(* ── Generics: the four operations monomorphisation needs ───────────────
Naming a variable, binding one from an argument, substituting the binding
back in, and spelling the result as a symbol. Everything else about the
@ -1235,10 +1364,131 @@ let type_id name =
let restart_sig tys =
"(" ^ String.concat " " (List.map Types.to_string tys) ^ ")"
(* ── The dyn boundary ───────────────────────────────────────────────────
Typed to dyn is implicit and dyn to typed is not. That asymmetry is the
whole of the design and it is worth saying why it is not arbitrary.
Boxing loses nothing: the value goes in and the runtime records what it was.
It can happen anywhere a dyn is wanted without a reader being surprised,
because nothing about the program's meaning turns on it. Unboxing can fail,
at run time, on a value the compiler cannot inspect -- so it happens only
where somebody *wrote a type*: a typed parameter, a typed binding, a typed
field. Those are the places a reader already understands as a claim about
what a value is, and a claim that can be wrong is exactly what a trap is
for. Nowhere else does the compiler decide a dyn is an i64 on its own.
Both directions go through [expect], because [expect] is already the one
place a wanted type meets a produced one. Every site that annotates -- and
only those sites -- calls it with [~want].
Milestone 1 boxes the scalars and refuses everything else by name. A typed
container crossing into dyn is the interesting refusal: [(Vec i64)] has a
representation the dyn runtime does not know how to walk, and heterogeneity
at milestone 1 is served by the runtime's own vector behind
[flan_dyn_vec_new] instead. That is a "not yet" and says so. *)
let dyn_i64 = Types.Int Types.I64
let dyn_f64 = Types.Float Types.F64
(* Widening to the one width the ABI carries. runtime/flan_dyn.h boxes integers
as [i64] and floats as [f64] and offers no other width, which is the
language's "dyn integers are i64" written where it is enforced. The cast is
explicit in the tree rather than left to the backend: a [Cast] is what the
language's own conversions emit, and a widening one loses nothing. *)
let widen loc (want : Types.t) (e : Tast.expr) =
if Types.equal want e.Tast.ty then e
else mk loc want (Tast.Prim (Tast.Cast want, [ e ]))
let unboxable t =
match t with
| Types.Int Types.I64 | Types.Float Types.F64 | Types.Bool -> true
| _ -> false
(* The sentence a refusal at this boundary gives. It names the type and says
which direction failed, because "expected dyn, found (Vec i64)" would read
as a type error the programmer could fix by writing something else, and
there is nothing else to write -- the feature is not there yet. *)
let no_dyn_yet loc ~into t extra =
Loc.failk "check/dyn-not-yet" loc
"%s does not cross into %s yet%s"
(Types.to_string t) (if into then "dyn" else "a written type") extra
let box loc (e : Tast.expr) : Tast.expr =
let dyn sym args = rt loc Types.Dyn sym args in
match e.Tast.ty with
| Types.Dyn -> e
| Types.Int _ -> dyn "flan_dyn_from_i64" [ widen loc dyn_i64 e ]
| Types.Float _ -> dyn "flan_dyn_from_f64" [ widen loc dyn_f64 e ]
(* The ABI takes an [int32_t], because a C signature that says [_Bool] is a
width argument nobody wants to have. *)
| Types.Bool -> dyn "flan_dyn_from_bool" [ widen loc (Types.Int Types.I32) e ]
(* A string is ptr+len and arrives as two arguments, the way every other
(ptr, len) entry point in the runtime takes one. The runtime copies: the
bytes may be a literal or a slice of a buffer the program goes on to
write. *)
| Types.String -> dyn "flan_dyn_from_bytes" [ e ]
(* Unit does not box. A value of the zero-sized type carries nothing for a
dyn word to hold, and [nil] -- which is what an [if] with no else answers
in dyn context -- is a different thing with a different constructor. The
two get confused if unit is allowed to become one. *)
| Types.Unit ->
Loc.failk "check/dyn-unit" loc
"() does not box into dyn — a value of the zero-sized type carries \
nothing a dyn could hold. The absent dyn value is nil, which is what an \
if with no else branch answers here"
| Types.Never -> e
| Types.Vec _ | Types.Map _ | Types.Slice _ | Types.Array _ ->
no_dyn_yet loc ~into:true e.Tast.ty
". The dyn container at this milestone is the runtime's own, from \
(vec-new dyn); a typed container has a representation the dyn runtime \
cannot walk"
| Types.Named _ | Types.Enum _ | Types.Option _ | Types.Ptr _
| Types.Alloc | Types.Fn _ | Types.Var _ ->
no_dyn_yet loc ~into:true e.Tast.ty ""
let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr =
let need sym ty = rt loc ty sym [ e ] in
match want with
| Types.Int Types.I64 -> need "flan_dyn_need_i64" dyn_i64
| Types.Float Types.F64 -> need "flan_dyn_need_f64" dyn_f64
| Types.Bool ->
(* The ABI answers an [int32_t]; [bool] is an [i1]. The narrowing is the
language's own cast and cannot fail — the runtime already decided the
value was a bool, so what comes back is 0 or 1. *)
widen loc Types.Bool (need "flan_dyn_need_bool" (Types.Int Types.I32))
(* Every other width is refused rather than served by a need_i64 and a
truncation. This language has no implicit narrowing anywhere, and putting
one at the boundary where a value's type was *already* uncertain is the
worst place in the program to start: the annotation would read as a check
and would be a silent discard of the high bits. The ABI grows a per-width
entry point when there is a reason to; until then the spelling that works
is an i64 and an explicit conversion after it. *)
| Types.Int _ | Types.Float _ ->
no_dyn_yet loc ~into:false want
(Printf.sprintf
" — the dyn runtime carries integers as i64 and floats as f64, so \
take it as %s and convert"
(if Types.is_numeric want && (match want with Types.Float _ -> true | _ -> false)
then "f64" else "i64"))
| _ -> no_dyn_yet loc ~into:false want ""
let expect loc ~want (got : Tast.expr) =
match want with
| None -> got
| Some w ->
(* The boundary, and the only implicit conversion in the language. It runs
before [fits] rather than instead of it: what comes back is an ordinary
expression of the wanted type, and if the coercion did not produce one
the usual message is still the one that reports it. *)
let got =
match w, got.Tast.ty with
| Types.Dyn, Types.Dyn -> got
| Types.Dyn, _ -> box loc got
| _, Types.Dyn when Types.fits ~expected:w ~actual:Types.Dyn -> got
| _, Types.Dyn -> unbox loc w got
| _ -> got
in
if Types.fits ~expected:w ~actual:got.Tast.ty then got
else
fail loc "expected %s, found %s" (Types.to_string w)
@ -1569,6 +1819,12 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
match e.Ast.e with
| Ast.Int n -> int_literal loc ~want n
| Ast.Byte b -> int_literal loc ~want ~default:Types.U8 (Int64.of_int b)
(* The float literal's own dyn case, for the reason the integer's has one:
the ABI carries one width and the literal is built at it. f64 is already
what an unconstrained float literal defaults to, so this only has to stop
the "expected dyn, found the float literal" arm below from firing. *)
| Ast.Float x when want = Some Types.Dyn ->
box loc (mk loc dyn_f64 (Tast.Float (x, Types.F64)))
| Ast.Float x ->
let k =
match want with
@ -1716,12 +1972,38 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
let name =
match c.Tast.ty with
| Types.Named n -> n
(* Its own arm ahead of the general one, because "a condition is a
struct, not dyn" would read as a rule about shape when the answer is a
milestone. A condition crosses a handler boundary as a pointer to a
frame that is still alive, and a dyn payload has to stay rooted across
that transfer — which is the collector's question, not this one's, and
it is milestone 2's. *)
| Types.Dyn ->
no_dyn_yet c.Tast.loc ~into:false Types.Dyn
" — a condition crosses a handler boundary and a dyn payload has to \
stay rooted across the transfer, which is milestone 2"
| t ->
fail c.Tast.loc
"a condition is a struct, not %s — matching is by type and there is \
no condition hierarchy"
(Types.to_string t)
in
(* And the same refusal for a condition that merely *holds* one. The
payload is what crosses, so a dyn field is the dyn payload the note
above is about, whatever the struct around it is called. *)
(match Hashtbl.find_opt ctx.env.structs name with
| Some (s : Tast.structure) ->
List.iter
(fun (f : Tast.field) ->
if f.Tast.fty = Types.Dyn then
no_dyn_yet c.Tast.loc ~into:false Types.Dyn
(Printf.sprintf
" — the field %s of the condition %s is one, and a payload \
has to stay rooted across a handler transfer, which is \
milestone 2"
f.Tast.fname name))
s.Tast.fields
| None -> ());
(* §1 and §2. [signal] is Unit whatever it finds; [error] is Never,
because the only way past it is a handler that transfers — one that
returns normally has not answered it, and the program stops. *)
@ -1803,6 +2085,16 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
and int_literal loc ~want ?(default = Types.I32) n =
match want with
| Some (Types.Int k) -> mk loc (Types.Int k) (Tast.Int (in_range loc k n, k))
(* A literal in dyn position takes i64 and not the i32 an unconstrained one
defaults to. This is where "dyn integers are i64" stops being a statement
about the ABI and becomes one about the language: [(defvar x dyn 5)] holds
an i64 five, and the defaulting question a wider set of boxes would raise
never arises because there is only the one box. Handled here rather than
left to [expect] so the literal is *built* at the right width — the range
check below is the one that matters, and 3000000000 is a dyn integer even
though it is not an i32. *)
| Some Types.Dyn ->
box loc (mk loc dyn_i64 (Tast.Int (in_range loc Types.I64 n, Types.I64)))
(* An untyped integer constant is usable where a float is wanted, as in
Odin. A float literal is never usable where an integer is wanted. *)
| Some (Types.Float k) ->
@ -3091,7 +3383,13 @@ and fold_left_prim ctx ~want loc name p ok what args =
let x, y, rest =
match args with x :: y :: rest -> x, y, rest | _ -> assert false
in
let a, b = binary ctx name loc ~want:(numeric_want want) [ x; y ] in
let a, b = binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) [ x; y ] in
(* One dyn operand makes the whole fold dyn, whichever side it is on. The
typed side is boxed by [dyn_fold]; a literal was already built at dyn by
[binary], so [(+ x 1)] over a dyn x folds an i64 one. *)
if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
dyn_fold ctx ~want loc name [ a; b ] rest
else begin
unconstrained ctx.env loc name ~needs:"numeric?" a.Tast.ty;
(* Past [unconstrained] a variable here is one the [where] clause admitted,
so the concrete predicate below has nothing to say about it — it is
@ -3107,6 +3405,37 @@ and fold_left_prim ctx ~want loc name p ok what args =
rest
in
expect loc ~want acc
end
(* The dyn lowering of a fold: one call per operator application, left to
right, each taking and answering a dyn word. The typed side of a mixed pair
is boxed on the way in — [box] is the identity on something already dyn, so
this needs no case analysis of its own. *)
and dyn_fold ctx ~want loc name first rest =
let sym =
match name with
| "+" -> "flan_dyn_add" | "-" -> "flan_dyn_sub"
| "*" -> "flan_dyn_mul" | "/" -> "flan_dyn_div"
| "%" -> "flan_dyn_rem"
| _ ->
(* Bitwise and shift operators land here if they ever admit a dyn
operand. They do not: the runtime carries no bitwise entry points,
and an integer operation on a value that might be a float is not
something to guess at. *)
no_dyn_yet loc ~into:false Types.Dyn
(Printf.sprintf " — %s has no dyn form" name)
in
let apply acc b = rt loc Types.Dyn sym [ acc; box loc b ] in
let acc =
match first with
| [ a; b ] -> apply (box loc a) b
| _ -> assert false
in
let acc =
List.fold_left (fun acc arg -> apply acc (check ctx ~want:Types.Dyn arg))
acc rest
in
expect loc ~want acc
(* ── Allocation failure, spec-memory.md ────────────────────────────────
No allocating operation returns an error and none can fail silently. When
@ -3390,18 +3719,51 @@ and named_call ctx ~want loc name args =
nobody writes on purpose. *)
| "%" ->
arity loc name 2 args;
let a, b = binary ctx name loc ~want:(numeric_want want) args in
let a, b = binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) args in
if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
dyn_fold ctx ~want loc name [ a; b ] []
else begin
unconstrained ctx.env loc name ~needs:"numeric?" a.Tast.ty;
if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then
fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty);
prim Tast.Rem a.Tast.ty [ a; b ]
end
| "=" | "!=" | "<" | "<=" | ">" | ">=" ->
let p = match name with
| "=" -> Tast.Eq | "!=" -> Tast.Ne | "<" -> Tast.Lt
| "<=" -> Tast.Le | ">" -> Tast.Gt | _ -> Tast.Ge
in
arity loc name 2 args;
let a, b = binary ctx name loc ~want:None args in
let a, b = binary ctx ~dyn_ok:true name loc ~want:None args in
(* A comparison with a dyn operand answers a *bool*, not a dyn, even though
the runtime's own entry point answers a dyn holding one. The reason is
where the result goes: a comparison is overwhelmingly the test of an
[if] or a [while], and those want an i1. So the need_bool is applied
here, once, and a program that really wants the comparison as a dyn
value boxes it again on the way into wherever it is going — which [box]
does for free at that boundary.
[=] and [!=] are the pair that never traps: the runtime compares
structurally and answers false for values of unrelated types, because
two things being unalike is the answer to "are these equal", not an
error. The orderings do trap, and rightly — there is no true answer to
whether a string is less than a vector. *)
if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then begin
let sym =
match name with
| "=" | "!=" -> "flan_dyn_eq"
| "<" -> "flan_dyn_lt" | "<=" -> "flan_dyn_le"
| ">" -> "flan_dyn_gt" | _ -> "flan_dyn_ge"
in
let cmp = unbox loc Types.Bool (rt loc Types.Dyn sym [ box loc a; box loc b ]) in
(* [!=] has no entry point of its own: there is one structural equality
and the negation is an [i1] flip the backend folds away. *)
let r =
if String.equal name "!=" then mk loc Types.Bool (Tast.Prim (Tast.Not, [ cmp ]))
else cmp
in
expect loc ~want r
end else begin
(* [=] and [!=] admit one type [<] does not: a handle, which is a pair of
numbers in one word and where "the same entity" is the question the
type exists to answer. Ordering handles would order a slot index, which
@ -3419,6 +3781,7 @@ and named_call ctx ~want loc name args =
"%s compares machine numbers; %s has no built-in comparison \
(plan.org, Types)" name (Types.to_string a.Tast.ty);
prim p Types.Bool [ a; b ]
end
| "not" ->
arity loc name 1 args;
prim Tast.Not Types.Bool [ check ctx ~want:Types.Bool (List.hd args) ]
@ -3717,6 +4080,25 @@ and named_call ctx ~want loc name args =
out. *)
| "vec-new" ->
let elem, args = vec_new_elem ctx ~want loc args in
(* [(vec-new dyn)] is not a [(Vec dyn)]. At milestone 1 the heterogeneous
container is the dyn runtime's own object, and its type is [dyn] like
everything else the runtime hands back — which is what lets [push], [at]
and [len] on it go through the dyn operations rather than through a
type-erased Vec over eight-byte elements.
The two could be made to coincide later, and the reason not to now is
the collector: a Flan Vec's storage comes from an allocator the program
named, and the words in it would be roots the collector has to find
inside a block it does not own. The runtime's own vector is storage the
collector already knows about. *)
if elem = Types.Dyn then begin
if args <> [] then
fail loc
"(vec-new dyn) takes no allocator — the dyn container's storage is \
the dyn runtime's, which is what lets the collector find the values \
inside it";
expect loc ~want (rt loc Types.Dyn "flan_dyn_vec_new" [])
end else begin
let a = allocator_arg ctx loc args in
let v = fresh_slot ctx (Types.Vec elem) in
let attempt =
@ -3734,12 +4116,23 @@ and named_call ctx ~want loc name args =
region_check ctx.env loc
(mk loc (Types.Vec elem) (Tast.Local v))
(mk loc (Types.Vec elem) (Tast.Local v)) ])))
end
(* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *)
| "push" ->
arity loc name 2 args;
(match args with
| [ target; x ] ->
let target = check ctx target in
(* A push into a dyn container is a call and nothing else: no allocation
guard, no restart, no region check. The dyn runtime owns the storage
and answers a failure to grow it on its own terms — the guard and the
retry restart exist for an allocator the *program* named, and here
there is none to name. *)
if target.Tast.ty = Types.Dyn then
expect loc ~want
(rt loc Types.Unit "flan_dyn_push"
[ target; check ctx ~want:Types.Dyn x ])
else begin
let elem = vec_elem loc "push" target.Tast.ty in
let x = check ctx ~want:elem x in
(* The element is bound before the loop so that a [retry] re-attempts
@ -3762,6 +4155,7 @@ and named_call ctx ~want loc name args =
(with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_vec" target
[ size_of loc elem ] elem)) ])))
end
| _ -> assert false)
| "reserve" ->
arity loc name 2 args;
@ -4485,6 +4879,14 @@ and named_call ctx ~want loc name args =
| Types.Map _ ->
let n = rt loc (Types.Int Types.I64) "flan_map_len" [ a; here loc ] in
expect loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
(* A dyn length is an i32 like every other length here, not a dyn holding
one. [len] is what an index loop compares against, and handing back a
boxed number would make [(< i (len xs))] a dyn comparison and a pair of
allocations per iteration. The runtime answers a dyn; it is unboxed at
once and narrowed the way the Vec's i64 above is. *)
| Types.Dyn ->
let n = unbox loc (Types.Int Types.I64) (rt loc Types.Dyn "flan_dyn_len" [ a ]) in
expect loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
| other ->
fail loc
"len takes an array, a slice, a string, a Vec or a Map, found %s"
@ -4497,6 +4899,19 @@ and named_call ctx ~want loc name args =
| Types.Vec _ ->
let p, elem = vec_at ctx loc target idx in
expect loc ~want (mk loc elem (Tast.Deref p))
(* One index, because a dyn container is one dimension: the nested
[(at grid r c)] spelling walks a type the compiler can see through,
and here it cannot. [(at (at g r) c)] is the spelling that works and
is what the refusal names. *)
| Types.Dyn ->
(match idx with
| [ i ] ->
expect loc ~want
(rt loc Types.Dyn "flan_dyn_at" [ target; check ctx ~want:Types.Dyn i ])
| _ ->
fail loc
"(at ...) over a dyn takes one index — the compiler cannot see \
the shape of a dyn container, so write (at (at x i) j)")
| _ ->
let idx, ty = indexed ctx target idx in
prim Tast.At ty (target :: idx))
@ -5127,7 +5542,7 @@ and numeric_want want =
widening, so one side has to decide it. Check the side that carries the most
information first: a non-literal over a literal, and a float literal over an
integer one, since an integer constant converts to a float and not back. *)
and binary ctx name loc ~want args =
and binary ctx ?(dyn_ok = false) name loc ~want args =
match args with
| [ x; y ] ->
let y_decides =
@ -5136,11 +5551,46 @@ and binary ctx name loc ~want args =
| (Ast.Int _ | Ast.Byte _), Ast.Float _ -> true
| _ -> false)
in
(* A form that cannot be checked without being told what is wanted. A
literal takes its width from the expectation, and a keyword has no
meaning at all without one — [:lo] resolves against the enum the site
expects and there is no keyword type to fall back on. Everything else
checks on its own terms. *)
let needs_want (f : Ast.expr) =
is_literal f || (match f.Ast.e with Ast.Kw _ -> true | _ -> false)
in
if y_decides then begin
let b = check ctx ?want y in
let a = check ctx ~want:b.Tast.ty x in
a, b
end else begin
end
(* [dyn_ok] is set by the operators that have a dyn lowering, and it exists
to stop the second operand being coerced to the first's type before
anybody has asked whether the pair is a dyn one.
Without it [(+ n x)] over an [i64] n and a dyn x threads [i64] into the
second check, [expect] does what an annotation site asked for and
unboxes, and the result is a *machine* add of a value the runtime was
never asked about: the program traps on a float instead of promoting,
and nothing in the source says why. The mirror image [(+ x n)] boxed
correctly, so the bug was visible only in one operand order.
Both sides are checked on their own terms here and the caller decides.
That is safe exactly when neither operand needs an expectation, which is
what [needs_want] settles — a literal still gets the first operand's
type, so [(+ x 1)] over a dyn x goes on building an i64 one. *)
else if dyn_ok && not (needs_want y) then begin
let a = check ctx ?want x in
let b = check ctx y in
(* Nothing dyn about this pair after all, so it is put back the way the
typed path built it. Re-checking only when the types actually differ
keeps the common case to one check of each operand. *)
if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn
|| Types.equal a.Tast.ty b.Tast.ty
then a, b
else a, check ctx ~want:a.Tast.ty y
end
else begin
let a = check ctx ?want x in
let b = check ctx ~want:a.Tast.ty y in
a, b
@ -5539,6 +5989,13 @@ let collect env (decls : Ast.decl list) =
Hashtbl.replace env.locs n d.Ast.dloc
| _ -> ())
decls;
(* Every type name is registered by here — structs, data types and unions by
the names-first pass, aliases with them, enums by the pass just above — so
this is the first point at which a [defn]'s parameter vector can be paired.
It is done before the signature loop below rather than inside it, because a
signature may name a type declared further down and pairing must not depend
on the order the file was written in. *)
let decls = pair_decls env decls in
List.iter
(fun (d : Ast.decl) ->
let loc = d.Ast.dloc in
@ -5575,6 +6032,19 @@ let collect env (decls : Ast.decl list) =
| Types.Int _ | Types.Float _ | Types.Bool | Types.Ptr _
| Types.Enum _ | Types.Unit -> ()
| Types.String | Types.Slice _ when what = "a parameter" -> ()
(* Its own arm, because the general advice below is wrong for it and
dangerously so. A dyn is one machine word and would cross without
complaint — [(Ptr dyn)] is not the fix and there is nothing for a
shim to read: what the C side would receive is a word whose
meaning only the dyn runtime knows, and C has no way to ask.
Refused by name rather than let through as an integer. *)
| Types.Dyn ->
fail loc
"%s of %s is dyn, which does not cross to C. A dyn is one word \
and would pass as an integer, but what the word means is the \
dyn runtime's and there is nothing on the C side that can ask \
— take the value at a written type and pass that"
what fn.Ast.name
| _ ->
fail loc
"%s of %s is %s, which cannot cross to C directly — pass \
@ -5742,7 +6212,13 @@ let collect env (decls : Ast.decl list) =
if progressed && left <> [] then settle ()
in
settle ();
List.iter (fun c -> ignore (infer c)) !pending
List.iter (fun c -> ignore (infer c)) !pending;
(* The paired declarations, handed back so that pass two checks the bodies of
the same functions whose signatures this pass registered. Pairing needs the
type names, which only this pass has; every pass after it needs the result,
and a [defn] still carrying an unpaired vector would check as a function of
no parameters at all. *)
decls
(* A type that contains itself by value has no finite size. [(Ptr T)] and a
slice are indirections and break the cycle; a fixed array does not, because
@ -6460,7 +6936,7 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
time it runs every signature is sound, so a body that fails to check
cannot make the next body fail — which is what makes a declaration a
resync point that needs no resynchronising. *)
collect env decls;
let decls = collect env decls in
check_finite env;
check_union_members env;
let s = Loc.sink ~on:keep_going in
@ -6604,3 +7080,70 @@ let expression env (e : Ast.expr) :
let t = check ctx e in
(t, Array.of_list (List.rev ctx.slot_tys),
Array.of_list (List.rev ctx.slot_names))
(* ── --no-gc ────────────────────────────────────────────────────────────
The flag that says this program is to be compiled with no collector in it,
and the way to keep that promise is to refuse every dyn rather than to emit
a different program. A dyn value is a value the runtime allocates and the
collector owns; there is no smaller version of it to fall back to, and
quietly leaking instead would be a memory model nobody asked for.
So this is a pass and not a flag. It runs between [Check] and [Emit], it
answers unit or it refuses, and nothing downstream of it is told the flag
exists — which is what makes a fully annotated program's output byte for
byte identical with the flag and without it. Emit has no [no_gc] field to
branch on, and that is deliberate: a field would be one more thing that
could change a comment, a name or an ordering, and the identity is worth
more than the branch would ever buy.
Every site is named, the way the global cycle refusal names the whole ring
rather than one member of it. A reader who has to annotate their program
wants the list, not the first one and then another compile. *)
let dyn_sites (p : Tast.program) : Loc.diag list =
let found = ref [] in
let add loc what = found := (loc, what) :: !found in
List.iter
(fun (g : Tast.global) ->
if g.Tast.gty = Types.Dyn then
add g.Tast.ginit.Tast.loc (Printf.sprintf "the global %s" g.Tast.gname))
p.Tast.globals;
List.iter
(fun (fn : Tast.fn) ->
List.iteri
(fun i t ->
if t = Types.Dyn then
add fn.Tast.floc
(Printf.sprintf "parameter %d of %s" (i + 1) fn.Tast.name))
fn.Tast.params;
if fn.Tast.ret = Types.Dyn then
add fn.Tast.floc (Printf.sprintf "the return type of %s" fn.Tast.name);
(* The body's own dyn values, which are the ones a signature does not
show: a let bound to a boxed literal, a (vec-new dyn) deep inside an
expression. Reported at the node, because that is the character to
change. *)
List.iter
(Tast.walk
(fun (e : Tast.expr) ->
match e.Tast.e with
| Tast.Prim (Tast.Rt sym, _)
when e.Tast.ty = Types.Dyn
&& String.length sym > 8
&& String.sub sym 0 8 = "flan_dyn" ->
add e.Tast.loc (Printf.sprintf "this value in %s" fn.Tast.name)
| _ -> ()))
fn.Tast.body)
p.Tast.fns;
List.rev_map
(fun (loc, what) ->
Loc.diag ~kind:"check/no-gc" loc
(Printf.sprintf
"%s is dyn, and --no-gc says this program carries no collector. A \
dyn value is one the runtime allocates and the collector owns, so \
there is nothing smaller to compile it to — write the type"
what))
!found
let no_gc (p : Tast.program) =
match dyn_sites p with [] -> () | ds -> raise (Loc.Errors ds)

2
lib/cimport.ml
View File

@ -813,7 +813,7 @@ let of_dump ~env ~taken ~bound_syms ~config (d : dump) : imported =
decls :=
{ Ast.d =
Ast.DeclareC
({ Ast.name = flan; params; ret; fwhere = []; fbody = []; nloc = f.cloc },
({ Ast.name = flan; params; praw = None; ret; fwhere = []; fbody = []; nloc = f.cloc },
f.csym);
dloc = f.cloc }
:: !decls)

257
lib/emit.ml
View File

@ -125,6 +125,13 @@ let rec ll (t : Types.t) =
and a copy in the IR are the right number of bytes. *)
| Types.Map _ -> "%map"
| Types.Option e -> Printf.sprintf "{ i8, %s }" (ll e)
(* One word, and [i64] rather than a pointer type: runtime/flan_dyn.h says
[typedef uint64_t flan_dyn], and the IR agreeing with that typedef is the
whole of what keeps the two sides linkable. Nothing here ever loads
through it — a dyn word is only ever passed to a flan_dyn_* call — so the
integer spelling costs no casts and keeps the emitter honest about not
knowing whether the bits are a pointer. *)
| Types.Dyn -> "i64"
| Types.Var _ ->
(* The checker rejects it by name — nothing reaches here. *)
failwith ("no layout for " ^ Types.to_string t)
@ -318,6 +325,7 @@ let rec lay m (t : Types.t) : int * int =
match Hashtbl.find_opt m.unions n with
| Some u -> union_lay m u
| None -> failwith ("no layout for struct " ^ n))
| Types.Dyn -> 8, 8
| Types.Var _ -> failwith ("no layout for " ^ Types.to_string t)
(* Size, alignment, and the offset of every member. *)
@ -543,6 +551,13 @@ let rec dty m d (t : Types.t) : int =
"!DIDerivedType(tag: DW_TAG_pointer_type, name: \"%s\", \
baseType: null, size: 64)"
(Types.to_string t))
(* An unsigned word, which is what the typedef says it is. Telling lldb
it is a pointer would be a guess about the encoding the compiler has
deliberately not made, and telling it nothing would leave [p x] on a
dyn local with no answer at all. A raw word is the true and useful
reading: it prints, and the person reading it can hand it to the
runtime's own printer. *)
| Types.Dyn -> basic "dyn" 64 "DW_ATE_unsigned"
| Types.Var _ ->
failwith ("no debug type for " ^ Types.to_string t)
in
@ -585,6 +600,30 @@ type f = {
what makes the pop happen on the transfer path as well as the normal one.
[None] in a release build, where there is no frame at all. *)
mutable frame : string option;
(* How many dyn roots this function pushed at entry, and so how many one
[flan_dyn_root_pop] at each exit takes off. Zero for every function with
no dyn in it, which is every function in every program written so far —
and zero means *nothing is emitted at all*, neither push nor pop nor a
pop of zero. That is what keeps a fully annotated program's IR byte for
byte what it was before dyn existed, which is the thing [--no-gc]
promises and is tested for.
It is a count and not a saved depth because the ABI offers
[flan_dyn_root_pop(n)] and no way to read the stack's height; it can be a
count, rather than needing one, because the number is a static property of
the function that [dyn_roots] works out before a line of the body is
emitted. That matters: [ret] runs *during* emission, and a count
accumulated as roots were discovered would be short at every early
return. *)
mutable droots : int;
(* The root slots' addresses, in push order: the dyn slots first and then one
per dyn-producing runtime call, minted by [dyn_tmp] as the body is
emitted. Both kinds are entry-block allocas, so the addresses are good for
the function's whole extent — which is why rooting is per function here
and not per scope. A slot that is not live any more holds a value the
collector keeps one cycle longer than it must, and that is the safe
direction to be wrong in. *)
mutable droot_ns : string list;
(* Where a dev build records each slot's address, so that a stopped frame's
locals can be read. [None] in a release build and in a function with no
named slot at all. Only *named* slots are recorded: a slot the compiler
@ -651,10 +690,76 @@ let label f name =
this frame, so a pop written only on the normal path leaves a dead frame on
the stack after every handled error, and the next backtrace is a lie. Same
lesson [emit_with_alloc] learned about the context allocator. *)
(* How many dyn roots a function will push, worked out before any of it is
emitted. One per dyn slot — a parameter or a local of that type — and one per
runtime call that answers a dyn, because the word a call hands back is live
from the moment it exists and the next allocation may be the one that
collects it.
Rooting every dyn-producing call, rather than only the ones whose value
outlives a call, is conservative and is the only thing available: this file
has no liveness and no lexical scope, both of which the checker resolved
away into flat slot indices long before anything got here. The cost is real
and is the cost of a precise collector with an address-registration ABI
rather than stack maps — a rooted alloca has its address escape through
[flan_dyn_root_push], so mem2reg cannot promote it, and every dyn value
becomes a stack slot with a store at every optimisation level.
A count rather than a running tally for the reason [droots] gives: [ret] is
reached while the body is still being emitted. *)
let dyn_roots (fn : Tast.fn) =
let slots =
Array.fold_left
(fun acc t -> if t = Types.Dyn then acc + 1 else acc) 0 fn.Tast.slots
in
let temps = ref 0 in
let count (e : Tast.expr) =
match e.Tast.e with
| Tast.Prim (Tast.Rt _, _) when e.Tast.ty = Types.Dyn -> incr temps
| _ -> ()
in
List.iter (Tast.walk count) fn.Tast.body;
(* And the transfer path's copy of the defers, which is a second list of the
same expressions and is emitted as well — so it mints a second set of
temporaries, and counting only [body] left every one of them in a slot the
collector never heard of. The fallback in [dyn_tmp] meant that was silent:
the pushes and the pops still balanced, and four dyn values in a defer
reached on a handled condition were simply invisible. Found by emitting
one and counting [%dx] in the IR, which is the only thing that can see it
while the runtime is a stub that never collects. *)
List.iter (Tast.walk count) fn.Tast.fdefers;
slots + !temps
(* The next pre-made root slot for a dyn temporary. They are all minted, zeroed
and pushed in the entry block before a line of the body is emitted, and this
only hands them out — which is what makes the pushes and the pops balance by
construction rather than by the body being walked the same way twice.
[dyn_roots] counts the same nodes the emission visits, so the supply runs
out only if those two disagree. If it ever does, the fallback is an ordinary
unrooted slot: one temporary the collector cannot see is a bug to find,
where a root stack that pops more than it pushed is memory corruption. *)
let dyn_tmp f =
match f.droot_ns with
| n :: rest -> f.droot_ns <- rest; n
| [] ->
let name = Printf.sprintf "%%dx%d" f.n in
f.n <- f.n + 1;
Buffer.add_string f.allocas (Printf.sprintf " %s = alloca i64\n" name);
name
let ret f v =
(match f.frame with
| Some prev -> ins f "store ptr %s, ptr @flan_frame_head" prev
| None -> ());
(* The pop, on every path out, for exactly the reason the shadow stack's is
here: a condition handled further out unwinds through the landing block,
and a pop written only on the normal path would leave this function's
roots on the stack after every handled error. The [unreachable]
terminators emit none, and are right not to — each of them dies inside C
and the process does not come back. *)
if f.droots > 0 then
ins f "call void @flan_dyn_root_pop(i64 %d)" f.droots;
term f "ret %s %s" (ll f.ret) v
(* The store that says "this slot is bound now". Emitted at each binding of a
@ -2247,6 +2352,18 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
let t = fresh f in
ins f "%s = call %s @%s(%s)" t (ll e.Tast.ty) sym args';
if signals then guard f;
(* A dyn word is spilled into a rooted slot the instant it exists. It is
an SSA value otherwise, and an SSA value is invisible to a collector
that finds its roots by address — the next allocation could be the one
that frees what this is holding. [dyn_roots] counted this call, so the
slot below is one the entry block has already pushed.
The value carries on being used as a register: the store is what the
collector reads, and reading it back would only make the IR longer. *)
if e.Tast.ty = Types.Dyn then begin
let slot = dyn_tmp f in
ins f "store i64 %s, ptr %s" t slot
end;
t
end
| Tast.SizeOf t, [] -> Printf.sprintf "%d" (fst (lay f.md t))
@ -2328,6 +2445,17 @@ and cast f ~guard (x : Tast.expr) target =
runtime answers a pointer or NULL and the Option is built in the
checker, so the null test is one integer compare on the address. *)
| Types.Ptr _, Types.Int Types.I64 -> "ptrtoint"
(* Not written in the surface language either — this language has no
conversion between bool and a number, and deliberately. The dyn
boundary needs both halves: runtime/flan_dyn.h takes and answers a
bool as an [int32_t], because a C signature saying [_Bool] is a width
question nobody wants, and [bool] is an [i1] here.
The truncation is safe in the one direction it runs: what comes back
from [flan_dyn_need_bool] is 0 or 1, because the runtime has already
decided the value was a bool, so the discarded bits are zero. *)
| Types.Bool, Types.Int _ -> "zext"
| Types.Int _, Types.Bool -> "trunc"
| _ -> failwith "unsupported cast"
in
if op = "bitcast" then v
@ -2405,6 +2533,7 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
pads = []; loops = []; unwind = "unwind"; unwound = false;
defers = fn.Tast.fdefers;
frame = None; slotv = None; snames = fn.Tast.snames;
droots = 0; droot_ns = [];
dsub;
dline = (if fn.Tast.floc.Loc.line = 0 then 1 else fn.Tast.floc.Loc.line);
dloc = "";
@ -2423,6 +2552,54 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
Buffer.add_string f.allocas
(Printf.sprintf " store %s %%p%d, ptr %s\n" (ll ty) i f.slots.(i)))
fn.Tast.params;
(* The dyn roots, and this is not gated on [m.dev]: the shadow stack below is
a debugging convenience and a release build does without it, while a
collector that cannot find its roots is a collector that frees live
values. Every build pays this, and only a function that has a dyn in it
pays anything — [dyn_roots] is zero otherwise and not a line is emitted,
which is what makes an annotated program's IR identical with and without
--no-gc.
The dyn *slots* are already allocas from the loop above, so they are
pushed where they are; the temporaries need slots of their own, and they
are minted here, in order, so that [dyn_tmp] only has to hand them out.
Zeroed because the push happens at entry and the call that fills one may
be inside a branch that never runs — runtime/flan_dyn.h says a rooted slot
holding 0 is not a value. *)
let nroots = dyn_roots fn in
if nroots > 0 then begin
let nparams = List.length fn.Tast.params in
let pushed = ref [] in
Array.iteri
(fun i t ->
if t = Types.Dyn then begin
(* A parameter's slot was filled from [%pN] a few lines above and
must not be zeroed over the top of it. Every other slot holds
whatever the stack held until its binding runs, and the binding
may be inside a branch that does not. *)
if i >= nparams then
Buffer.add_string f.allocas
(Printf.sprintf " store i64 0, ptr %s\n" f.slots.(i));
pushed := f.slots.(i) :: !pushed
end)
fn.Tast.slots;
let ntemps = nroots - List.length !pushed in
let temps =
List.init ntemps (fun i ->
let name = Printf.sprintf "%%dr%d" i in
Buffer.add_string f.allocas (Printf.sprintf " %s = alloca i64\n" name);
Buffer.add_string f.allocas
(Printf.sprintf " store i64 0, ptr %s\n" name);
name)
in
List.iter
(fun n ->
Buffer.add_string f.allocas
(Printf.sprintf " call void @flan_dyn_root_push(ptr %s)\n" n))
(List.rev !pushed @ temps);
f.droots <- nroots;
f.droot_ns <- temps
end;
(* The shadow stack's push, in the entry block, and the pop is at every
[ret] (see [ret]). plan.org has had *Frames: shadow stack* in the dev
column since the beginning; this is it, and it is dev-only, so a shipped
@ -2818,6 +2995,36 @@ declare i64 @flan_alloc_fail_align()
declare i64 @flan_alloc_fail_id()
declare i64 @flan_alloc_budget(ptr)
declare void @flan_alloc_set_budget(ptr, i64)
; The dynamic runtime, runtime/flan_dyn.h. A flan_dyn is one machine word and
; is spelled i64 here because the typedef says uint64_t; nothing in this file
; ever looks inside one, so every operation on a dyn value is one of these.
declare i64 @flan_dyn_nil()
declare i64 @flan_dyn_from_i64(i64)
declare i64 @flan_dyn_from_f64(double)
declare i64 @flan_dyn_from_bool(i32)
declare i64 @flan_dyn_from_bytes(ptr, i64)
declare i64 @flan_dyn_vec_new()
declare i64 @flan_dyn_add(i64, i64)
declare i64 @flan_dyn_sub(i64, i64)
declare i64 @flan_dyn_mul(i64, i64)
declare i64 @flan_dyn_div(i64, i64)
declare i64 @flan_dyn_rem(i64, i64)
declare i64 @flan_dyn_lt(i64, i64)
declare i64 @flan_dyn_le(i64, i64)
declare i64 @flan_dyn_gt(i64, i64)
declare i64 @flan_dyn_ge(i64, i64)
declare i64 @flan_dyn_eq(i64, i64)
declare i64 @flan_dyn_len(i64)
declare i64 @flan_dyn_at(i64, i64)
declare void @flan_dyn_set_at(i64, i64, i64)
declare void @flan_dyn_push(i64, i64)
declare void @flan_dyn_print(i64)
declare i64 @flan_dyn_need_i64(i64)
declare double @flan_dyn_need_f64(i64)
declare i32 @flan_dyn_need_bool(i64)
declare void @flan_dyn_root_push(ptr)
declare void @flan_dyn_root_pop(i64)
declare void @flan_gc_init()
declare void @flan_dev_reg_enable()
declare void @flan_dev_reg_note_vec(ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_map(ptr, i64, i64, ptr, i64)
@ -2879,14 +3086,53 @@ declare i64 @flan_file_fail_reason()
declare i8 @flan_slurp_into(ptr, ptr, i64, i64, ptr, i64)
|}
(* Whether the program has a dyn in it anywhere, which is the one question
[main] asks before calling [flan_gc_init]. Asked of the whole program rather
than assumed, so that a program with no dyn emits no call and its [main] is
byte for byte the [main] it was before any of this existed.
Every shape a dyn can take is one of these: a global of that type, a
signature that mentions it, a slot that holds one, or an expression that
produces one. *)
let uses_dyn (p : Tast.program) =
let found = ref false in
let note t = if t = Types.Dyn then found := true in
List.iter (fun (g : Tast.global) -> note g.Tast.gty) p.Tast.globals;
List.iter
(fun (fn : Tast.fn) ->
List.iter note fn.Tast.params;
note fn.Tast.ret;
Array.iter note fn.Tast.slots;
List.iter (Tast.walk (fun (e : Tast.expr) -> note e.Tast.ty)) fn.Tast.body)
p.Tast.fns;
!found
(* C's main, adapting to whichever of the four shapes Flan's main has: argv and
the i32 status are each optional (plan.org, Milestone-2 primitives). *)
let emit_main m ?(startup = false) (fn : Tast.fn) =
let emit_main m ?(startup = false) ?(gc = false) ?(dyn_globals = []) (fn : Tast.fn) =
let b = Buffer.create 256 in
Buffer.add_string b
(Printf.sprintf "\ndefine i32 @main(i32 %%argc, ptr %%argv)%s {\nentry:\n"
(attrs m));
Buffer.add_string b " call void @flan_rt_init(i32 %argc, ptr %argv)\n";
(* Immediately after the host runtime and before anything that could box: a
dyn global's initialiser runs in the startup function below, and the very
first thing it does is allocate. *)
if gc then Buffer.add_string b " call void @flan_gc_init()\n";
(* The dyn globals, rooted here and never popped, which is the whole of what
a global's extent means. They go on the stack *before* the startup
function runs, because that function is what fills them and its first
allocation may be the one that collects — and before any of it pushes a
root of its own, because every pop in the program takes the top of the
stack and these are the ones that must never be at the top.
Zero is what a global holds until its initialiser has run: BSS gives that
for free, and runtime/flan_dyn.h says a rooted slot holding 0 is not a
value. *)
List.iter
(fun g -> Buffer.add_string b
(Printf.sprintf " call void @flan_dyn_root_push(ptr %s)\n" (gname g)))
dyn_globals;
(* The program's own end of the transfer channel. Nothing can be transferring
when [main] returns: a restart is found by name on the restart stack, and
an [invoke-restart] that finds none fails at the invoke site rather than
@ -3191,7 +3437,14 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
p.Tast.fns;
let startup = emit_startup m ~hidden p.Tast.globals in
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns with
| Some fn -> emit_main m ~startup fn
| Some fn ->
emit_main m ~startup ~gc:(uses_dyn p)
~dyn_globals:
(List.filter_map
(fun (g : Tast.global) ->
if g.Tast.gty = Types.Dyn then Some g.Tast.gname else None)
p.Tast.globals)
fn
(* A program with no [main] is linked into a C host that brings its own
entry point, and then nothing calls the startup function — which is why
the constant image is a constant image on both backends and not a

10
lib/js.ml
View File

@ -235,6 +235,16 @@ let rec refuse_ty loc (t : Types.t) =
"(Map K V) is not in the JS dialect yet — Odin's open-addressed map is a \
type-erased runtime over raw bytes and the JS answer is a Map keyed by \
a structural key, which is its own lane"
(* The irony is not lost: JavaScript is the one target where a dyn value
needs no boxing at all, because every value there is already one. What is
missing is not the representation but the lowering — dyn ops are calls
into runtime/flan_dyn.h, and this dialect has no such runtime. It is a
lane, not a difficulty. *)
| Types.Dyn ->
at loc
"dyn is not in the JS dialect yet — every JavaScript value is already \
dynamic, so this is a matter of lowering the dyn operations onto the \
host's own, and that work has not been done"
| Types.Var n ->
at loc "a type variable (%s) reached the backend, which cannot happen" n

43
lib/load.ml
View File

@ -302,6 +302,20 @@ and rename_place owned alias bound (p : Ast.place) : Ast.place =
let rename_field owned alias (f : Ast.field) : Ast.field =
{ f with Ast.fty = rename_texpr owned alias f.Ast.fty }
(* An unpaired parameter vector, qualified. The slots are still undecided here
— [Check] is what pairs them — so a bare symbol might be a parameter's name
or a type's, and this cannot tell. It does not have to: [owned] holds the
package's *declared* names, a parameter's name is not one of them, and a
parameter named after a type of the same package is refused outright when
the vector is paired. So qualifying every owned name and leaving every other
alone is right for both readings, and stays right because that refusal is
what keeps the two sets apart. *)
let rename_pitem owned alias (p : Ast.pitem) : Ast.pitem =
match p with
| Ast.Pname (n, loc) when List.mem n owned -> Ast.Pname (qualify alias n, loc)
| Ast.Pname _ -> p
| Ast.Ptype t -> Ast.Ptype (rename_texpr owned alias t)
let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
let loc = d.Ast.dloc in
let k =
@ -346,11 +360,26 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
| other -> other))
| Ast.Defn fn ->
let params = List.map (rename_field owned alias) fn.Ast.params in
let bound = List.map (fun (p : Ast.field) -> p.Ast.fname) fn.Ast.params in
let praw = Option.map (List.map (rename_pitem owned alias)) fn.Ast.praw in
(* The names a body may shadow. With the vector still unpaired, every
bare symbol in it is a candidate — an owned one is a type and is
dropped, because it is a name the body should go on qualifying, and
what is left is the parameter names and at worst a type of some other
package, which no body of this one refers to as a value. *)
let bound =
match praw with
| Some items ->
List.filter_map
(function
| Ast.Pname (n, _) when not (List.mem n owned) -> Some n
| _ -> None)
items
| None -> List.map (fun (p : Ast.field) -> p.Ast.fname) fn.Ast.params
in
Ast.Defn
{ fn with
Ast.name = qualify alias fn.Ast.name;
params;
params; praw;
ret = Option.map (rename_texpr owned alias) fn.Ast.ret;
fbody = List.map (rename_expr owned alias bound) fn.Ast.fbody }
| Ast.Package _ -> Ast.Package alias
@ -634,6 +663,16 @@ let decl_uses acc (d : Ast.decl) =
let field (f : Ast.field) = texpr_uses acc f.Ast.fty in
let fn (f : Ast.fn) =
List.iter field f.Ast.params;
(* An unpaired vector names types too, and a bare symbol in it may be one.
Every such symbol is recorded as a use: a parameter's name recorded here
resolves to nothing and costs nothing, where a type's name left out
would drop a real dependency and the import would not be loaded. Over-
recording is the safe direction for a dependency set. *)
Option.iter
(List.iter (function
| Ast.Pname (n, loc) -> acc := (n, loc) :: !acc
| Ast.Ptype t -> texpr_uses acc t))
f.Ast.praw;
Option.iter (texpr_uses acc) f.Ast.ret;
List.iter (expr_uses acc) f.Ast.fbody
in

75
lib/parse.ml
View File

@ -111,6 +111,29 @@ let rec fields (f : Form.t) (items : Form.t list) : Ast.field list =
Loc.fail odd.loc "field %s has no type — these come in name/type pairs"
(Form.to_string odd)
(* A [defn]'s parameter vector, left undecided — the long argument is beside
the [defn] case. A bare symbol could be either half of a pair and is carried
as one; everything else is a type by its shape alone, and is resolved now so
that a malformed type is still reported at the character that is wrong.
[fields] applies [no_pattern] to the name half of each pair, and this cannot:
which half a slot is has not been decided. A map is the one shape that can be
settled here anyway — braces are not a type in any position ([texpr] refuses
them), so a map in this vector is a destructuring pattern and nothing else,
and it gets the sentence that says so rather than a complaint about map type
syntax. A bracket cannot be settled the same way, because [[a b]] is a
pattern in a name slot and a slice type in a type slot; one written in a name
slot comes back from [Check] as "a parameter's name was expected here", which
is true and is as close as this can get. *)
and pitems (items : Form.t list) : Ast.pitem list =
List.map
(fun (it : Form.t) ->
match it.v with
| Sym s -> Ast.Pname (s, it.loc)
| Map _ -> no_pattern it; assert false
| _ -> Ast.Ptype (texpr it))
items
(* ── The constraint map at the head of a defn body ──────────────────────
[(defn sort [s [$t]] () {:where (ordered? $t)} body ...)]. Clojure's
[{:pre [...] :post [...]}] is the precedent and the reason it is a map
@ -914,7 +937,47 @@ let rec decl (f : Form.t) : Ast.decl =
Mandatory removes the guess: nothing is consulted, [()] is what a function
that returns nothing writes, and a mistyped type is a mistyped type --
[(defn f [] f65 0.0)] reaches the resolver's near-miss check and comes back
as *did you mean f64*, where it used to come back as an unknown name. *)
as *did you mean f64*, where it used to come back as an unknown name.
The return slot stays mandatory now that parameters may be left
unannotated, and it is worth saying why the two do not move together.
Dynamic-by-default means a *parameter* with no type is [dyn]; the return
type could have been given the same rule, and was not, because the
ambiguity there has no syntactic resolution at all. [(defn f [] (Rune
{.code 65}) (bar))] is the case above: a capitalised head in a list is a
type application and also a struct literal -- see [Struct] in [expr] --
and no rule separates them, so an optional return slot is a coin toss
between a type and the first form of a body. A parameter vector has no
such case: every slot in it is a name or a type and never an expression.
So [dyn] is written out in the return position, which costs one token and
keeps a decision this file paid for twice in one day.
── The parameter vector ──────────────────────────────────────────────
[(defn f [x y])] is one parameter [x] of type [y], or two parameters [x]
and [y] of type [dyn], and which one it is depends on whether [y] names a
type. That is the lookup this comment's first half says was removed for
being brittle, and it is being asked for again -- so it is not done here.
The vector is carried undecided, as [Ast.pitem]s, and paired in [Check],
where the set of type names is complete.
The move is not cosmetic. What the old rule got wrong was consulting a set
that was not finished being built: it ran per-file, at parse time, before
macros had generated their definitions, and macros generating definitions
is exactly what widened the failure. By the time [Check] pairs the vector,
every file is loaded, every macro has expanded and every C header has been
imported, so the set is not a guess about what might be a type -- it is
the types. That is strictly more than the parser could ever know, and it
is the whole of the argument for the placement.
What deferring does not buy is immunity. The set is complete at a point in
time and not across time: [(defn f [x y] ...)] is two dyn parameters until
somebody writes [(defstruct y ...)] or imports a header that declares one,
and then it is one parameter of type [y], with no edit to [f]. The
signature changes under it. That residual is real, it is the dictated
rule's and not this file's, and [Session.compatible] is where it is felt --
a redefinition that changes a signature is refused there, and this is a
way for a signature to change with nothing redefined. *)
| List ({ v = Sym "defn"; _ } :: args) ->
(match args with
| n :: { v = Vec ps; _ } :: ret :: body ->
@ -930,7 +993,7 @@ let rec decl (f : Form.t) : Ast.decl =
function that returns nothing writes ()" msg
in
let fwhere, body = constraints body in
mk (Ast.Defn { Ast.name = sym n; params = fields f ps;
mk (Ast.Defn { Ast.name = sym n; params = []; praw = Some (pitems ps);
ret = Some rty; fwhere; fbody = body_of body;
nloc = n.loc })
| _ ->
@ -961,10 +1024,10 @@ let rec decl (f : Form.t) : Ast.decl =
| { v = Str csym; _ } :: rest ->
(match List.rev rest with
| [ n; { v = Form.Vec ps; _ } ] ->
mk (mkd { Ast.name = sym n; params = fields f ps;
mk (mkd { Ast.name = sym n; params = fields f ps; praw = None;
ret = None; fwhere = []; fbody = []; nloc = n.loc } csym)
| [ n; { v = Form.Vec ps; _ }; r ] ->
mk (mkd { Ast.name = sym n; params = fields f ps;
mk (mkd { Ast.name = sym n; params = fields f ps; praw = None;
ret = Some (texpr r); fwhere = []; fbody = [];
nloc = n.loc } csym)
| _ -> fail f "%s" usage)
@ -1140,6 +1203,10 @@ let rec decl (f : Form.t) : Ast.decl =
params = [ { Ast.fname = sym p;
fty = { Ast.t = Ast.Tslice form_t; tloc = p.loc };
floc = p.loc } ];
(* Written out, not deferred: a macro takes [[Form]] and
returns a [Form], and neither half of that is the user's to
leave off. *)
praw = None;
ret = Some form_t; fwhere = []; fbody = body_of body;
nloc = n.loc })
| _ :: { v = Form.Vec ps; _ } :: body when body <> [] ->

13
lib/render.ml
View File

@ -352,5 +352,18 @@ let rec render c depth (e : Tast.expr) : Tast.expr list =
(Tast.While
(cond, lit " " :: render c (depth + 1) elem, [ step ]));
lit "]" ])) ]
(* The one type this walk does not walk. Every other arm is here because a
Flan value carries no header and only the compiler knows what it is; a
dyn value is the exact opposite — the runtime knows and the compiler
does not — so the printing belongs on the side that can see the tag, and
the walk hands the whole value over.
The cost is that it writes to stdout itself rather than through
[c.emit], so a dyn printed at the REPL arrives on the program's output
and not in the REPL's buffer. Fixing that means an emit-shaped dyn
printer in the runtime — a second entry point taking the sink — and it
is not milestone 1's. *)
| Types.Dyn ->
[ unit_ (Tast.Prim (Tast.Rt "flan_dyn_print", [ e ])) ]
| t ->
fail loc "no printer for %s" (Types.to_string t)

20
lib/types.ml
View File

@ -47,6 +47,17 @@ type t =
| Option of t (* (Option T) *)
| Fn of t list * t (* (Fn [T ...] R) *)
| Var of string (* a type variable — milestone 5 *)
(* [dyn]: one machine word whose contents the runtime knows and this module
does not. It is a written type — [(defvar x dyn 5)] boxes the 5 — and it
is also what an unannotated [defn] parameter means, which is why it is a
case here and not a Named type the prelude declares: the checker has to
recognise it to choose the boxing and the dyn op lowering, and a name in a
table cannot be matched on.
Nothing about the representation is stated here on purpose. The word is
opaque to the compiler — runtime/flan_dyn.h owns which bits are a tag —
so that milestone 2 can change the encoding without touching Emit. *)
| Dyn
let signed = function
| I8 | I16 | I32 | I64 -> true
@ -72,7 +83,7 @@ let fkind_of_name = function
is spelled [()] in source, and [Parse.texpr] refuses the word. *)
let primitive_names =
[ "i8"; "i16"; "i32"; "i64"; "u8"; "u16"; "u32"; "u64";
"f32"; "f64"; "bool"; "string"; "Unit"; "Never"; "Allocator" ]
"f32"; "f64"; "bool"; "string"; "dyn"; "Unit"; "Never"; "Allocator" ]
let ikind_name k =
(if signed k then "i" else "u") ^ string_of_int (bits k)
@ -86,7 +97,11 @@ let rec equal a b =
match a, b with
| Int x, Int y -> x = y
| Float x, Float y -> x = y
| Bool, Bool | String, String | Unit, Unit | Never, Never -> true
(* [Dyn] is equal to itself and to nothing else. Two dyn values may hold
different things at run time, which is the point of the type and is not
this function's question: this is identity of *static* types, and there is
one dyn type the way there is one string type. *)
| Bool, Bool | String, String | Unit, Unit | Never, Never | Dyn, Dyn -> true
| Named x, Named y | Enum x, Enum y -> String.equal x y
| Slice x, Slice y -> equal x y
| Array (n, x), Array (m, y) -> Int64.equal n m && equal x y
@ -121,6 +136,7 @@ let rec to_string = function
Printf.sprintf "(Fn [%s] %s)"
(String.concat " " (List.map to_string ps)) (to_string r)
| Var n -> n
| Dyn -> "dyn"
let is_numeric = function Int _ | Float _ -> true | _ -> false

17
lib/x86.ml
View File

@ -475,6 +475,23 @@ let is_agg (t : Types.t) =
| Types.Unit | Types.Never -> false
| Types.String | Types.Slice _ | Types.Array _ | Types.Map _ | Types.Vec _
| Types.Option _ | Types.Named _ -> true
(* Refused by name rather than classified. A dyn word is one machine word and
would classify trivially — it is not the representation that is missing,
it is every operation on it, which is a call into runtime/flan_dyn.h that
this backend does not emit. Saying "a dyn value" here rather than letting
it through to fail at the first [+] means the reader is told the one true
thing about their program instead of something about an opcode.
The sentence naming [--llvm] is not written here on purpose: both callers
add it, and each says it differently for a good reason — Session because
the daemon takes this backend by default and the reader chose a program
rather than a code generator, and main.ml only when [--x86] was not typed
out. Repeating it here would say it twice to the one reader and to the
wrong one. *)
| Types.Dyn ->
unsupported
"a dyn value. Every operation on one is a call into the dynamic runtime, \
and this backend emits none of them"
| Types.Var v -> unsupported "type variable %s" v
let is_void (t : Types.t) = match t with Types.Unit | Types.Never -> true | _ -> false

BIN
mix Executable file
View File

Binary file not shown.

BIN
raylib-imported Executable file
View File

Binary file not shown.

326
runtime/flan_dyn_stub.c Normal file
View File

@ -0,0 +1,326 @@
/* flan_dyn_stub — a standing-in implementation of the flan_dyn.h ABI.
*
* THE MERGE REPLACES THIS FILE WITH runtime/flan_dyn.c. It exists so that the
* compiler side of dynamic-by-default can be built and run against the fixed
* ABI before the real runtime lands; the real one is being written in parallel
* against the same header, and flan_dyn.h is the contract the two are diffed
* against.
*
* What it is not: it mallocs and never frees, it collects nothing, and
* flan_dyn_root_push / flan_dyn_root_pop record their arguments and do nothing
* with them. That last point matters for anyone reading a passing test here —
* root emission is *not* exercised by this file. A program with entirely wrong
* root discipline passes every test that runs against this stub. The check
* that does bite is the one over the emitted IR, counting pushes against pops
* per function; see the acceptance tests.
*
* The representation is the simplest thing that satisfies the header's rule
* that the word is opaque: every value is a pointer to a heap cell, including
* the small ones. The real runtime will not do this.
*/
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
/* The compiler carries this file as one string with flan_dyn.h pasted in front
* of it (lib/dune), and in that form there is no header on disk to find. The
* probe keeps the file compilable both ways: standalone against the real
* header, and concatenated, where the declarations are already above. The
* header's own include guard makes the two agree. */
#if defined(__has_include)
# if __has_include("flan_dyn.h")
# include "flan_dyn.h"
# endif
#endif
/* flan_rt.c's own [rt_trap] is static, so this mirrors it rather than calling
* it: print the sentence, offer the name to the dev daemon's hook, and leave
* with flan_rt's exit code so that a dyn trap is indistinguishable from any
* other trap to whoever is watching. The hook is flan_rt.c's global, and a
* program links both files. */
extern void (*flan_trap_hook)(const uint8_t *name, int64_t namelen);
static _Noreturn void dyn_trap(const char *name, const char *sentence) {
fflush(stdout);
fprintf(stderr, "%s\n", sentence);
fflush(stderr);
if (flan_trap_hook != NULL)
flan_trap_hook((const uint8_t *)name, (int64_t)strlen(name));
_exit(134);
}
enum tag { T_NIL, T_I64, T_F64, T_BOOL, T_STR, T_VEC };
typedef struct cell {
enum tag tag;
union {
int64_t i;
double f;
int32_t b;
struct { uint8_t *ptr; int64_t len; } s;
struct { struct cell **items; int64_t len, cap; } v;
} u;
} cell;
static cell *alloc(enum tag t) {
cell *c = calloc(1, sizeof *c);
if (c == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
c->tag = t;
return c;
}
static cell *as(flan_dyn d) { return (cell *)(uintptr_t)d; }
static flan_dyn word(cell *c) { return (flan_dyn)(uintptr_t)c; }
/* ── Construction ──────────────────────────────────────────────────── */
flan_dyn flan_dyn_nil(void) { return word(alloc(T_NIL)); }
flan_dyn flan_dyn_from_i64(int64_t v) {
cell *c = alloc(T_I64); c->u.i = v; return word(c);
}
flan_dyn flan_dyn_from_f64(double v) {
cell *c = alloc(T_F64); c->u.f = v; return word(c);
}
flan_dyn flan_dyn_from_bool(int32_t v) {
cell *c = alloc(T_BOOL); c->u.b = (v != 0); return word(c);
}
flan_dyn flan_dyn_from_bytes(const uint8_t *ptr, int64_t len) {
cell *c = alloc(T_STR);
c->u.s.ptr = malloc((size_t)len + 1);
if (c->u.s.ptr == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
if (len > 0) memcpy(c->u.s.ptr, ptr, (size_t)len);
c->u.s.ptr[len] = 0;
c->u.s.len = len;
return word(c);
}
flan_dyn flan_dyn_vec_new(void) {
cell *c = alloc(T_VEC);
c->u.v.cap = 8;
c->u.v.items = calloc((size_t)c->u.v.cap, sizeof(cell *));
if (c->u.v.items == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
return word(c);
}
/* ── Arithmetic ────────────────────────────────────────────────────── */
/* Two numbers promote to f64 when either is one, which is the rule a reader
* expects of a dynamic language and is not the rule the typed language uses.
* The typed language has no implicit widening at all; here there is no
* annotation to have been written, so refusing would leave (+ 1 2.5) with no
* spelling that works. */
static int numeric(cell *c) { return c->tag == T_I64 || c->tag == T_F64; }
static double as_f(cell *c) { return c->tag == T_I64 ? (double)c->u.i : c->u.f; }
static flan_dyn arith(flan_dyn a, flan_dyn b, char op) {
cell *x = as(a), *y = as(b);
if (!numeric(x) || !numeric(y)) dyn_trap("DynArithType", "this arithmetic needs two numbers, and one of the two values is not one");
if (x->tag == T_I64 && y->tag == T_I64) {
int64_t p = x->u.i, q = y->u.i, r = 0;
switch (op) {
case '+': r = p + q; break;
case '-': r = p - q; break;
case '*': r = p * q; break;
case '/': if (q == 0) dyn_trap("DivideByZero", "division by zero"); r = p / q; break;
case '%': if (q == 0) dyn_trap("DivideByZero", "division by zero"); r = p % q; break;
}
return flan_dyn_from_i64(r);
}
{
double p = as_f(x), q = as_f(y), r = 0;
switch (op) {
case '+': r = p + q; break;
case '-': r = p - q; break;
case '*': r = p * q; break;
case '/': r = p / q; break;
/* fmod without math.h, to keep the stub's link line as short as the
* real runtime's is meant to be. */
case '%': r = p - q * (double)(int64_t)(p / q); break;
}
return flan_dyn_from_f64(r);
}
}
flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b) { return arith(a, b, '+'); }
flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith(a, b, '-'); }
flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith(a, b, '*'); }
flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith(a, b, '/'); }
flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith(a, b, '%'); }
/* ── Ordering and equality ─────────────────────────────────────────── */
static int cmp(flan_dyn a, flan_dyn b) {
cell *x = as(a), *y = as(b);
if (x->tag == T_STR && y->tag == T_STR) {
int64_t n = x->u.s.len < y->u.s.len ? x->u.s.len : y->u.s.len;
int r = memcmp(x->u.s.ptr, y->u.s.ptr, (size_t)n);
if (r != 0) return r < 0 ? -1 : 1;
return x->u.s.len == y->u.s.len ? 0 : (x->u.s.len < y->u.s.len ? -1 : 1);
}
if (!numeric(x) || !numeric(y)) dyn_trap("DynCompareType", "these two values have no ordering between them");
if (x->tag == T_I64 && y->tag == T_I64)
return x->u.i == y->u.i ? 0 : (x->u.i < y->u.i ? -1 : 1);
{
double p = as_f(x), q = as_f(y);
return p == q ? 0 : (p < q ? -1 : 1);
}
}
flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) < 0); }
flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) <= 0); }
flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) > 0); }
flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) >= 0); }
/* Structural, and never traps — the header's one exception. */
static int eq(cell *x, cell *y) {
if (numeric(x) && numeric(y)) {
if (x->tag == T_I64 && y->tag == T_I64) return x->u.i == y->u.i;
return as_f(x) == as_f(y);
}
if (x->tag != y->tag) return 0;
switch (x->tag) {
case T_NIL: return 1;
case T_BOOL: return x->u.b == y->u.b;
case T_STR: return x->u.s.len == y->u.s.len
&& memcmp(x->u.s.ptr, y->u.s.ptr, (size_t)x->u.s.len) == 0;
case T_VEC: {
if (x->u.v.len != y->u.v.len) return 0;
for (int64_t i = 0; i < x->u.v.len; i++)
if (!eq(x->u.v.items[i], y->u.v.items[i])) return 0;
return 1;
}
default: return 0;
}
}
flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) {
return flan_dyn_from_bool(eq(as(a), as(b)));
}
/* ── Containers ────────────────────────────────────────────────────── */
static cell *need_vec(flan_dyn v) {
cell *c = as(v);
if (c->tag != T_VEC) dyn_trap("DynNotAVec", "this value is not a vector, so it has no elements");
return c;
}
static int64_t need_index(flan_dyn i) {
cell *c = as(i);
if (c->tag != T_I64) dyn_trap("DynIndexType", "an index must be an integer");
return c->u.i;
}
flan_dyn flan_dyn_len(flan_dyn v) {
cell *c = as(v);
if (c->tag == T_STR) return flan_dyn_from_i64(c->u.s.len);
return flan_dyn_from_i64(need_vec(v)->u.v.len);
}
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) {
cell *c = need_vec(v);
int64_t k = need_index(i);
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
return word(c->u.v.items[k]);
}
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) {
cell *c = need_vec(v);
int64_t k = need_index(i);
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
c->u.v.items[k] = as(x);
}
void flan_dyn_push(flan_dyn v, flan_dyn x) {
cell *c = need_vec(v);
if (c->u.v.len == c->u.v.cap) {
int64_t cap = c->u.v.cap * 2;
cell **items = realloc(c->u.v.items, (size_t)cap * sizeof(cell *));
if (items == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
c->u.v.items = items;
c->u.v.cap = cap;
}
c->u.v.items[c->u.v.len++] = as(x);
}
static void print_cell(cell *c) {
switch (c->tag) {
case T_NIL: fputs("nil", stdout); break;
case T_I64: printf("%lld", (long long)c->u.i); break;
/* %g, so that a whole-numbered f64 does not print as an i64 would and
* the two remain distinguishable in a test's expected output. */
case T_F64: printf("%g", c->u.f); break;
case T_BOOL: fputs(c->u.b ? "true" : "false", stdout); break;
case T_STR: printf("%.*s", (int)c->u.s.len, (const char *)c->u.s.ptr); break;
case T_VEC:
fputc('[', stdout);
for (int64_t i = 0; i < c->u.v.len; i++) {
if (i > 0) fputc(' ', stdout);
print_cell(c->u.v.items[i]);
}
fputc(']', stdout);
break;
}
}
void flan_dyn_print(flan_dyn v) { print_cell(as(v)); }
/* ── Extraction ────────────────────────────────────────────────────── */
int64_t flan_dyn_need_i64(flan_dyn v) {
cell *c = as(v);
if (c->tag != T_I64) dyn_trap("DynExpectedI64", "this value was required to be an i64 and is not");
return c->u.i;
}
double flan_dyn_need_f64(flan_dyn v) {
cell *c = as(v);
/* An i64 satisfies an f64 slot, because a dyn integer literal is an i64 by
* the header's rule and (defvar x f64 (f 1)) would otherwise be unwritable
* for any f returning dyn. The reverse is not true: f64 to i64 loses. */
if (c->tag == T_I64) return (double)c->u.i;
if (c->tag != T_F64) dyn_trap("DynExpectedF64", "this value was required to be an f64 and is not");
return c->u.f;
}
int32_t flan_dyn_need_bool(flan_dyn v) {
cell *c = as(v);
if (c->tag != T_BOOL) dyn_trap("DynExpectedBool", "this value was required to be a bool and is not");
return c->u.b;
}
/* ── Roots ─────────────────────────────────────────────────────────────
*
* Recorded and otherwise ignored. The shadow stack is kept, and its depth
* checked against the pops, only so that a badly unbalanced emission fails
* loudly here rather than silently: an over-pop is a compiler bug worth
* dying on even in a stub that collects nothing. Under-pushing is invisible,
* and stays invisible until the real collector lands. */
static flan_dyn **roots = NULL;
static int64_t roots_len = 0, roots_cap = 0;
void flan_dyn_root_push(flan_dyn *slot) {
if (roots_len == roots_cap) {
int64_t cap = roots_cap == 0 ? 64 : roots_cap * 2;
flan_dyn **r = realloc(roots, (size_t)cap * sizeof(flan_dyn *));
if (r == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
roots = r;
roots_cap = cap;
}
roots[roots_len++] = slot;
}
void flan_dyn_root_pop(int64_t n) {
if (n < 0 || n > roots_len) dyn_trap("DynRootUnderflow", "the dyn root stack was popped further than it was pushed - a compiler bug");
roots_len -= n;
}
void flan_gc_init(void) { /* nothing to initialise: this stub never collects */ }

10
spike/x86/survey.sh
View File

@ -78,6 +78,15 @@ out=$(mktemp -d); trap 'rm -rf "$out"' EXIT
# truncations are both empty.
forever="dev-loop dev-watch dev-chatty"
# The dyn programs, which this backend refuses by name and is meant to: every
# operation on a dyn value is a call into the dynamic runtime and x86.ml emits
# none of them. They are listed rather than left to be counted as refusals
# because a REFUSED here means "a node this backend has stopped lowering",
# which is a regression, and this is the opposite -- a lane that has not
# started. Take a name off this list when the backend grows the lowering, and
# the survey will say whether it works.
llvmonly="dyn-basic dyn-vec dyn-global dyn-boundary dyn-defer"
TIMEOUT=${TIMEOUT:-20}
# Extra flags, given to *both* sides. SURVEY_FLAGS=--dev is the one that has a
@ -101,6 +110,7 @@ for src in "$corpus"/test/programs/*.flan "$corpus"/spike/x86/*.flan \
[ $want = 1 ] || continue
fi
case " $forever " in *" $name "*) skip+=("$name:runs-forever"); continue;; esac
case " $llvmonly " in *" $name "*) skip+=("$name:dyn-is-llvm-only"); continue;; esac
# LLVM first. A program that does not compile at all, or has no main, is not
# this backend's business -- the frontend refused it either way.

15
test/programs/dyn-basic.flan Normal file
View File

@ -0,0 +1,15 @@
;;;; An unannotated defn, called at two different types.
;;;;
;;;; [(defn add [x y] dyn (+ x y))] states no type for either parameter, so both
;;;; are dyn, and the + in the body is the dyn one: a call into the runtime that
;;;; decides on what the two words actually hold. The same function serves the
;;;; integer call and the float call, which is the whole of what the feature
;;;; buys and is not something the typed language could express at all.
(defn add [x y] dyn (+ x y))
(defn main [] ()
(print (add 2 3))
(print "\n")
(print (add 1.5 2.25))
(print "\n"))

42
test/programs/dyn-boundary.flan Normal file
View File

@ -0,0 +1,42 @@
;;;; The boundary in both directions, and the trap when a claim is wrong.
;;;;
;;;; Typed to dyn is implicit: take-dyn is called with an i64 and the boxing is
;;;; written nowhere. Dyn to typed is not: take-i64's parameter says i64, and
;;;; that annotation is the whole of why the unboxing is allowed to happen —
;;;; and the whole of why it may fail, which the last line of main proves by
;;;; handing it a float.
;;;;
;;;; A let carries no type in this language, so the annotation sites a dyn can
;;;; be unboxed at are the ones that do: a parameter, a return type, and a
;;;; global's declared type. All three are here.
(defvar seven i64 7)
(defvar boxed dyn 21)
;; The other direction at a global: a dyn initialiser meeting a written type.
(defvar unboxed i64 boxed)
(defn take-dyn [d dyn] dyn
(+ d 100))
(defn take-i64 [n i64] i64
(* n 2))
(defn identity-dyn [d] dyn d)
;; A dyn value answered at a written return type, which is the third site.
(defn as-i64 [d] i64 d)
(defn main [] ()
;; Typed in: the i64 is boxed at the call with nothing written.
(print (take-dyn seven))
(print "\n")
;; Dyn out: the parameter is typed, so the word is unboxed at the call.
(print (take-i64 boxed))
(print "\n")
(print unboxed)
(print "\n")
(print (as-i64 (identity-dyn 5)))
(print "\n")
;; And the claim that is wrong. The runtime owns the message.
(print (take-i64 (identity-dyn 1.5)))
(print "\n"))

28
test/programs/dyn-defer.flan Normal file
View File

@ -0,0 +1,28 @@
;;;; A dyn value produced inside a defer, on a function a transfer leaves
;;;; through rather than returns from.
;;;;
;;;; This is here for the root count and not for the arithmetic. A defer appears
;;;; twice in the typed IR — spliced into the body for the normal path, and
;;;; again in fdefers for the path a handled condition unwinds along — so the
;;;; emitter produces two copies of every dyn temporary inside one. Counting
;;;; only the body left the second copy's temporaries in slots the collector had
;;;; never been told about: the pushes and the pops still balanced, so nothing
;;;; failed, and the values were simply invisible.
;;;;
;;;; Nothing the stub does can show that, because it never collects. What shows
;;;; it is the emitted IR — a fallback slot is spelled %dx and a rooted one %dr,
;;;; and the fix is the absence of the former.
(defstruct Boom [n i64])
(defn inner [x] dyn
(defer (print (+ x 1000)) (print "\n"))
(restart-case
(error (Boom {.n 1}))
(give [] 0))
(+ x 1))
(defn main [] ()
(handler-bind [(Boom [b] (invoke-restart 'give))]
(print (inner 5))
(print "\n")))

21
test/programs/dyn-global.flan Normal file
View File

@ -0,0 +1,21 @@
;;;; A dyn global, which is the case that needs the startup function.
;;;;
;;;; A dyn value is made by a call into the runtime, and a call is not a
;;;; constant, so the initialiser cannot be a constant image the way a typed
;;;; global's is. It runs in flan..init-globals, which main calls after
;;;; flan_gc_init and before anything the programmer wrote — the same machinery
;;;; the computed globals already use, which is the point: a dyn global is a
;;;; computed global and needed no new mechanism.
(defvar counter dyn 0)
(defvar label dyn "start")
(defn bump [] ()
(set counter (+ counter 1)))
(defn main [] ()
(print counter) (print " ") (print label) (print "\n")
(bump)
(bump)
(set label "done")
(print counter) (print " ") (print label) (print "\n"))

24
test/programs/dyn-vec.flan Normal file
View File

@ -0,0 +1,24 @@
;;;; A container holding four different types at once.
;;;;
;;;; (vec-new dyn) is not a (Vec dyn) — it is the dyn runtime's own vector, and
;;;; its type is dyn like everything else the runtime hands back. That is what
;;;; lets push, at and len on it be the dyn operations rather than a
;;;; type-erased Vec over eight-byte elements, and it is why no allocator is
;;;; named: the storage is the collector's to walk.
(defn main [] ()
(let [xs (vec-new dyn)]
(push xs 1)
(push xs 2.5)
(push xs "three")
(push xs true)
(print (len xs))
(print "\n")
(print xs)
(print "\n")
;; Read back out one at a time, to show that at answers a dyn and that the
;; four of them are still four different things.
(dotimes [i (len xs)]
(print (at xs i))
(print " "))
(print "\n")))

169
test/test_acceptance.ml
View File

@ -2967,6 +2967,175 @@ level "1"
outputs ~opt:"-O0" "unions, -O0" "programs/unions.flan" unions_out;
outputs ~dev:true "unions, dev" "programs/unions.flan" unions_out;
(* ── dyn, milestone 1 ────────────────────────────────────────────
Four programs, and between them every claim the feature makes that can
be run rather than argued.
[dyn-basic] is the one the feature exists for: a defn that annotates
nothing, called at two types, answering correctly to both. Nothing the
typed language can express does that.
[dyn-vec] is the heterogeneous container, which is where a dynamic
language stops being a convenience and starts being a different data
model — four types in one vector, read back out one at a time.
[dyn-global] is the case that needed the startup function: a call is not
a constant, so a dyn global is a computed global, and it turned out to
need no new machinery at all.
[dyn-boundary] is the one with a trap in it, and it is asserted on its
exit status and its message: the boundary is only interesting because it
can fail, and a test that only showed it working would be testing the
easy half. It is at -O2 and -O0 like the rest, because the unboxing is a
call whose result feeds a machine instruction and that is exactly the
shape the optimiser could launder away.
They are LLVM-only, and the [@x86] survey skips them by name — see
[llvmonly] in spike/x86/survey.sh. Not compiled by the dev backend, so
not run as dev builds either. *)
let dyn_basic_out = "5\n3.75\n" in
outputs "dyn: an unannotated defn at two types"
"programs/dyn-basic.flan" dyn_basic_out;
outputs ~opt:"-O0" "dyn: an unannotated defn at two types, -O0"
"programs/dyn-basic.flan" dyn_basic_out;
let dyn_vec_out = "4\n[1 2.5 three true]\n1 2.5 three true \n" in
outputs "dyn: a heterogeneous vector"
"programs/dyn-vec.flan" dyn_vec_out;
outputs ~opt:"-O0" "dyn: a heterogeneous vector, -O0"
"programs/dyn-vec.flan" dyn_vec_out;
let dyn_global_out = "0 start\n2 done\n" in
outputs "dyn: a global" "programs/dyn-global.flan" dyn_global_out;
outputs ~opt:"-O0" "dyn: a global, -O0"
"programs/dyn-global.flan" dyn_global_out;
(* The boundary, both directions, and then the claim that is wrong. The
first four lines are the conversions; the trap is the fifth, and the
runtime owns its wording — the compiler could only have said that two
dyns did not agree, which is what they are for. *)
let dyn_boundary ?opt () =
let exe = compile ?opt "programs/dyn-boundary.flan" in
let code, text = run exe None in
let want = "107\n42\n21\n5\n" in
let name =
"dyn: the boundary both ways, and the trap"
^ (match opt with Some o -> ", " ^ o | None -> "")
in
if code <> 134
|| not (contains text want)
|| not (contains text "required to be an i64")
then begin
incr failures;
Printf.printf
"FAIL %s\n got: %S (exit %d)\n wanted: %S then a trap \
(exit 134)\n"
name text code want
end;
(try Sys.remove exe with Sys_error _ -> ())
in
dyn_boundary ();
dyn_boundary ~opt:"-O0" ();
(* The root count, which is the one part of this feature no run can check:
the stub never collects, so a program whose roots are entirely wrong
passes every test above. What can be checked is the IR, and this is the
assertion that found a real hole — a defer appears twice in the typed IR,
spliced into the body for the normal path and again in [fdefers] for the
path a transfer leaves through, so a dyn temporary inside one is emitted
twice. Counting only the body left the second copy unrooted, silently:
the pushes and the pops balanced because [dyn_tmp] falls back to a plain
slot rather than unbalancing them, and four dyn values were invisible.
[%dr] is a rooted slot and [%dx] is the fallback, so the claim is that
the emitted IR contains none of the latter. It is worth stating as a
property of the whole corpus and not only of this file: any dyn program
that mints one has a temporary the collector cannot see. *)
let no_fallback_slots path =
let l = Load.program ~file:path (Reader.read_file path) in
let ir = Emit.program (Check.program_all l.Load.decls) in
if contains ir "%dx" then begin
incr failures;
Printf.printf
"FAIL %s emits an unrooted dyn temporary (%%dx) — dyn_roots counted \
fewer than the emission minted\n"
path
end
in
List.iter no_fallback_slots
[ "programs/dyn-basic.flan"; "programs/dyn-vec.flan";
"programs/dyn-global.flan"; "programs/dyn-boundary.flan";
"programs/dyn-defer.flan" ];
(* And that the defer program still runs and still runs its defer: the
count being right is not much use if the transfer path broke getting
there. 1005 is the defer, 6 is the value the restart produced. *)
outputs "dyn: a defer on the transfer path" "programs/dyn-defer.flan"
"1005\n6\n";
outputs ~opt:"-O0" "dyn: a defer on the transfer path, -O0"
"programs/dyn-defer.flan" "1005\n6\n";
(* ── --no-gc ─────────────────────────────────────────────────────
The flag is a pass between checking and emission that answers unit or
refuses, and these are its two halves.
Every dyn is named. Not the first one and then another compile: a reader
who has to annotate their program wants the list, which is why the pass
collects and raises [Loc.Errors] the way the global cycle refusal does.
Asserted on the count as well as on the text, because "it refused" would
pass just as well if it named one site and stopped. *)
let no_gc_sites path least =
let l = Load.program ~file:path (Reader.read_file path) in
let p = Check.program_all l.Load.decls in
match Check.no_gc p with
| () ->
incr failures;
Printf.printf "FAIL --no-gc on %s: it was accepted\n" path
| exception Loc.Errors ds ->
if List.length ds < least then begin
incr failures;
Printf.printf
"FAIL --no-gc on %s: named %d sites, wanted at least %d\n"
path (List.length ds) least
end;
List.iter
(fun (d : Loc.diag) ->
if not (contains d.Loc.dmsg "carries no collector") then begin
incr failures;
Printf.printf "FAIL --no-gc on %s: said %S\n" path d.Loc.dmsg
end)
ds
in
(* The vec file reports nine: a vec-new, four boxed pushes, a len, an at
and the dotimes bound. The floor is under that rather than equal to it
so an added line does not fail the test, and well over one so that a
pass which named the first site and stopped would. *)
no_gc_sites "programs/dyn-vec.flan" 8;
(* The global file reports nine too, and the point of it is the mix: two
[the global ...] sites and two [the return type of ...] ones, which a
walk over function bodies alone would never have found. *)
no_gc_sites "programs/dyn-global.flan" 6;
(* The other half, and the reason the flag is a pass and not a parameter of
[Emit]: a program with nothing to refuse compiles to the same bytes with
the flag and without it. If [--no-gc] were ever plumbed into the emitter
— a field, a mode, a comment that mentioned it — this is what would
start failing, and it would fail on something incidental rather than on
anything to do with dyn. *)
let identical path =
let l = Load.program ~file:path (Reader.read_file path) in
let p = Check.program_all l.Load.decls in
let a = Emit.program p in
Check.no_gc p;
let b = Emit.program p in
if a <> b then begin
incr failures;
Printf.printf
"FAIL --no-gc changed the IR of %s (%d bytes vs %d)\n"
path (String.length a) (String.length b)
end
in
identical "programs/algorithms.flan";
identical "programs/conditions.flan";
identical "programs/unions.flan";
(* The refusals, each by name. The first is the diagnostics bug NEXT.md
listed and this lane fixed: a case name written as if it were a struct
reported "unknown struct A", because nothing in the environment could

78
test/test_flan.ml
View File

@ -399,9 +399,15 @@ let () =
| Arr [ _; _; _ ] -> () | _ -> check "array literal" false);
(* ── Types: brackets mean different things by position ─────────── *)
(* Read out of [praw], not [params]: a defn's parameter vector is carried
undecided until Check pairs it, so the parser no longer fills [params] at
all. Every type spelled here is one the parser still resolves on sight —
brackets and lists are types by their shape whatever the environment says
— so [Ptype] is the shape under test and a [Pname] here would mean the
spelling stopped being recognised as a type. *)
let ty src =
match parse_decl (Printf.sprintf "(defn f [x %s] ())" src) with
| { d = Defn { params = [ { fty; _ } ]; _ }; _ } -> fty.t
| { d = Defn { praw = Some [ Pname ("x", _); Ptype t ]; _ }; _ } -> t.t
| _ -> failwith "bad type test"
in
(match ty "[u8]" with Tslice _ -> () | _ -> check "[T] is a slice" false);
@ -421,7 +427,7 @@ let () =
(* ── Declarations ──────────────────────────────────────────────── *)
(match (parse_decl "(defn f [x i32] bool x)").d with
| Defn { ret = Some _; params = [ _ ]; fbody = [ _ ]; _ } -> ()
| Defn { ret = Some _; praw = Some [ _; _ ]; fbody = [ _ ]; _ } -> ()
| _ -> check "defn with return type" false);
(* () is the unit return type, and the body is what follows it. *)
(match (parse_decl "(defn f [x i32] () (g x))").d with
@ -840,13 +846,73 @@ let () =
rejects_check "a mistyped struct"
"(defstruct Cursor [x i32]) (defn f [c Curser] ())"
~needle:"did you mean Cursor?";
(* Nothing close: the type-variable rule still applies, and still names the
milestone. *)
rejects_check "a real type variable" "(defn f [x t] ())"
(* [(defn f [x t] ())] used to be one parameter of an unimplemented generic
type and is now two parameters of type dyn — a lowercase name resembling
no type is a parameter, which is the whole of dynamic-by-default. The
milestone-5 reading is still reachable, by writing the type variable with
the sigil the signature binds it with. *)
(match checked "(defn f [x t] ())" with
| p ->
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "f") p.Tast.fns with
| Some { Tast.params = [ Types.Dyn; Types.Dyn ]; _ } -> ()
| _ -> check "an unannotated pair is two dyn parameters" false)
| exception _ -> check "an unannotated pair is two dyn parameters" false);
(* A bare lowercase name is still an unimplemented type variable everywhere a
type is the only thing a slot can hold. A defn's parameter vector stopped
being such a place — a slot there may be a parameter instead — so the rule
is exercised where it still decides, at a field. *)
rejects_check "a real type variable" "(defstruct Holder [x elem])"
~needle:"milestone 5";
rejects_check "an unknown concrete type" "(defn f [x Widget] ())"
~needle:"unknown type Widget";
(* ── dyn, and what it does not do yet ──────────────────────────── *)
(* The pairing rule's own refusal. A name that is also a type's has no good
reading — taken as written it is a parameter called [i64] — and the
likelier intent is a pair the wrong way round, which the message names. *)
rejects_check "a parameter named after a type" "(defn f [i64 x] ())"
~needle:"cannot also be this parameter's name";
(* The three "not yet" refusals, each by name and each for its own reason.
A typed container does not box: [(Vec i64)] has a representation the dyn
runtime cannot walk, and the heterogeneous container at this milestone is
the runtime's own from [(vec-new dyn)]. *)
rejects_check "a typed container boxed into dyn"
"(defn take [d dyn] i32 1)\n\
(defn main [] i32 (take [1 2 3]))"
~needle:"does not cross into dyn yet";
(* A condition crosses a handler boundary as a pointer to a live frame, and
a dyn payload has to stay rooted across that transfer — the collector's
question, and milestone 2's. *)
rejects_check "a dyn in a condition's payload"
"(defstruct Boom [what dyn])\n\
(defn main [] () (signal (Boom {.what 1})))"
~needle:"milestone 2";
(* And the C boundary, which is the one that would otherwise pass silently:
a dyn is one word and would cross as an integer, and nothing on the other
side can ask what the word means. *)
rejects_check "a dyn crossing to C"
"(declare c-take [d dyn] () \"c_take\")"
~needle:"does not cross to C";
(* The x86 backend refuses dyn by name, and the sentence has to be good: the
dev daemon takes that backend by default, so this is the first thing a
user of dyn sees. Neither half of the message names [--llvm] — Session and
main.ml each add that, differently and for their own reasons — so what is
pinned here is the half this file owns. *)
(match
X86.program ~checks:true
(Check.program_all
(program "(defn add [x y] dyn (+ x y))\n\
(defn main [] () (print (add 1 2)))"))
with
| _ -> check "the x86 backend refuses dyn" false
| exception X86.Unsupported m ->
check "the x86 backend refuses dyn by name"
(contains m "a dyn value" && contains m "dynamic runtime"));
(* ── Static bounds ─────────────────────────────────────────────── *)
(* A literal index into a fixed array is known now, so it is an error now
rather than a trap later; everything else is the emitted bounds check's
@ -1327,7 +1393,7 @@ let () =
defn's body that just answers one says nothing about them. *)
rejects_check "an fn with nothing to say what it takes"
"(defn f [] () (fn [x] x))" ~needle:"nothing here says what this fn";
rejects_check "type variables are milestone 5" "(defn f [x a] ())"
rejects_check "type variables are milestone 5" "(defn f [] a 0)"
~needle:"milestone 5";
(* The other half: a name in value position now *works*, and the arity is
checked against the function it names. *)

14
test/test_session.ml
View File

@ -51,6 +51,20 @@ let () =
refuses "a changed arity"
"(defn outer [a i64 b i64] i64 (bump))"
"changes signature";
(* Dyn-ness is part of a signature like anything else, and this falls out of
[compatible] rather than being added to it: the comparison is
[Types.equal] over the parameters and the return, and dyn is equal to
itself and to nothing else. Pinned anyway, because it is the one place the
word "signature" covers a change the source does not spell out — the
return type here went from [i64] to [dyn] by being written differently,
and a parameter can change the same way by a *type* being declared
elsewhere in the program. *)
refuses "a return type that became dyn"
"(defn outer [] dyn (bump))"
"changes signature";
refuses "a parameter that became dyn"
"(defn outer [x] i64 (bump))"
"changes signature";
(* The storage exists and has a shape: reusing it reads at the wrong offsets,
and replacing it discards the state the reload exists to preserve. *)
refuses "a retyped global"