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

The reload primitive, and the cells that make it mean something

Browse Source 
Two things, and either alone is useless, so they are one commit.

Emit.redefinition compiles one function into its own module against a host
that is already running. What it does *not* define is the design: a global is
external, so state survives a reload and sand's grid is not reset by editing
the code; every other function is a declare, so a redefined settle calls the
host's move-grain rather than a frozen copy; there is no main. Build.shared
puts that text through llc + ld -shared. ld, not clang, because a shared object
is allowed undefined symbols and that is the whole mechanism - and because the
driver is 50ms of a 20ms job. Measured here: llc 16ms, ld 3ms, dlopen 0.04ms.

Loading a body is not installing it, though. A call bound at link time cannot
notice a new one, so a dev build routes every Flan-to-Flan call through a cell
- a mutable global holding the address of the function that is current - and a
module publishes itself with one store. The cell load is emitted after the
arguments, so a redefinition between two calls cannot land inside one.

Three details that are not free choices. flan_reload_install is a named
function rather than an ELF constructor, because the agent has to choose when
the store happens and a constructor would do it during dlopen, mid-frame, on
whatever thread called it. A redefinition's own body is hidden, because default
visibility in a shared object is interposable and that applies to taking the
address too: plain @"flan.bump" inside the module resolves to the host's copy,
so the installer would publish the function it was replacing and the reload
would silently do nothing. And -rdynamic is what exports the cells at all, so
it and cells are one flag: Build.opts.dev, flan build --dev, the first time
opts means something semantic rather than an optimisation level.

The test is one process, because two runs would prove nothing about a swap,
and two .so paths, because dlopen caches by path and would hand back the first
handle. Every call in it goes through outer, compiled once into the host and
never rebuilt, so a changed answer can only mean its call site followed. v2
recurses through its own cell, which is the interposition case; it would print
the old body's text if it did not. helper differs between the fixtures purely
as a tripwire for a module that grew its own copy.

LLVM cannot fold the indirection - the cell is an external mutable global - and
a --dev calc-me keeps 46 indirect calls at -O2. values, machine and
sand-headless now run as dev builds in the acceptance table too; the sand hash
is the one result that would notice a call reaching the wrong function.
This commit is contained in:
Joseph Ferano 2026-09-10 21:27:11 +07:00
parent f83ca7de6f
commit bb90f6e65e
10 changed files with 657 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

168
NEXT.md
View File

@ -1,5 +1,10 @@
# Where this is
**Dev loop steps 1 and 2 are done** — see *The reload primitive* below.
A function can be recompiled and installed into a running process, and call
sites compiled before it existed follow it. That is `C-c C-c` on a `defn`,
without an editor attached to it yet.
Milestone 4 is done: **sand.flan builds, links raylib and runs**, and its
simulation has a headless acceptance case that runs on the `dune test` path at
`-O0` and `-O2`. Milestones 2 and 3 are behind it (`calc-me.flan` compiles and
@ -29,6 +34,8 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅
| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run` |
| `test/test_flan.ml` | reader, parser and checker |
| `test/test_acceptance.ml` | expression/result pairs + whole programs + the traps |
| `test/test_reload.ml` | **the reload primitive: recompile one function, load it, call it** |
| `test/reload_host.c` | the C host that loads and installs two rebuilds, in one process |
```
$ flan run calc-me.flan "1 + 2 * (3 - 0.5) / 2"
@ -285,6 +292,135 @@ enforces, and a later change could quietly drop it.
first expression. Only the parameter position and `(Option …)` are
unambiguous.
## The reload primitive — dev loop steps 1 and 2, measured
`llc` → `ld -shared` → `dlopen` → call, with no protocol and no daemon.
`dune test` runs it: one function is recompiled into its own object and called
inside a process that is already running, twice, with a changed body the second
time.
| Step | Cost |
|---|---|
| `Emit.redefinition` | below the timer (<0.1ms) |
| `llc -O2 -filetype=obj` | 15–17ms |
| `ld -shared` | 3ms |
| `dlopen` + `dlsym` | **0.04ms** |
**~19ms end to end**, and the load itself is free. plan.org's 16ms was measured
with clang somewhere else; this is the number from this codebase. For contrast,
`clang -shared` on the same IR is 50ms — the driver is again most of the cost,
which is why the dev path skips it. `llc` and `clang` are both 20.1.8 here;
check that before trusting the `.ll`, since the driver absorbs IR the bare
tools reject.
`ld -shared` rather than `clang -shared` for a second reason: a shared object
is allowed undefined symbols, and that *is* the mechanism. What the new module
does **not** define is the whole design:
- **a global is `external`.** This settles the open question below in the only
direction that supports the demo: a redefinition can change a function's
body and can never re-initialise the program's data. Define the global and
the loaded object gets a second copy — sand's `grid` would reset on every
reload, and "edit the code, keep the sand" is the thesis.
- **every other function is a `declare`**, so a redefined `settle` calls the
host's `move-grain` rather than freezing a private copy of it.
- **no `main`.** This module is loaded, not started.
Its string constants still come along; omitting them is an undefined `@.str.N`
at link time, and it is easy to miss because a one-function module usually has
none. `Emit.signature` is now the single place a function's LLVM signature is
spelled, because a `define` here and a `declare` there drift the moment one of
them grows a case for `Unit` or for a slice parameter.
**`-rdynamic` is load-bearing.** A normal executable exports nothing: `nm -D
calc-me | grep 'flan\.'` is empty, so a loaded module's `declare`s would have
nothing to bind to. The test passes it through `lflags`, which keeps it a
property of the dev build rather than of every build. `dlsym` on `"flan.bump"`
works — a dot is legal in an ELF symbol.
Two things about the test are deliberate and are what make it prove anything:
both loads happen in **one process**, since two runs would pass while saying
nothing about an in-process swap; and the versions are **two paths**, since
`dlopen` caches by path and re-opening one would hand back the handle it
already had, so the check would lie. And `helper` is `(* x 2)` in one fixture
and `(* x 3)` in the other: the second body is dead text, since the module
declares `helper` rather than defining it, so the expected 1024 coming back
instead of 1036 is what proves the call landed on the host's copy. With the two
bodies identical nothing at run time would notice a module that grew its own.
String constants are emitted `private unnamed_addr`, so the module's own
`@.str.N` cannot be interposed by the host's — worth knowing, because with
external linkage a redefined function would silently print the *old* text and
nothing would fail at link time. The fixtures each print a literal so that path
is actually exercised.
### Cells — how a call site follows a redefinition
Loading a new body is not installing it. A call bound at link time cannot be
made to notice one, so **a dev build routes every Flan-to-Flan call through a
cell**: a mutable global holding the address of the function that is current.
```
@"flan.cell.bump" = global ptr @"flan.bump" ; the host defines it
%p = load ptr, ptr @"flan.cell.bump" ; every call site
%r = call i64 %p()
```
Redefinition is then one store. A redefinition module declares the cells
`external`, exactly like the globals, and exposes `flan_reload_install()` that
stores its own body into its own cell — cost **below a microsecond**, which is
what makes a frame-boundary swap a non-event.
The cell load is emitted *after* the arguments, so a redefinition landing
between two calls cannot land in the middle of one.
Four things about this that are not free choices:
- **`flan_reload_install` is a named function and not an ELF constructor.** A
constructor runs during `dlopen`, on whatever thread called it, mid-frame.
The agent has to choose when the store happens. Loading and installing are
separate on purpose.
- **A redefinition's own body is `hidden`.** Default visibility in a shared
object is interposable, and that applies to *taking the address* too: plain
`@"flan.bump"` inside the module resolves to the host's copy, so the
installer would publish the very function it was replacing and the reload
would appear to do nothing. There is a test on the linkage, because the
failure is silent.
- **This also fixes the self-call edge**, which the previous version of this
section listed as a sharp edge: a redefined function calling itself goes
through the cell like any other call, so it reaches the new body. v2 of the
fixture recurses on purpose, and would print the old body's text if it did
not.
- **`-rdynamic` is what exports the cells**, so it and cells are one flag:
`Build.opts.dev`, `flan build --dev`. This is the first time `opts` means
something semantic rather than an optimisation level.
LLVM cannot fold the indirection away — the cell is an external mutable global
— and a `--dev` build of calc-me keeps 46 indirect calls at `-O2`. The
acceptance table now runs `values`, `machine` and `sand-headless` as dev builds
as well; the sand hash is the case that matters, since it is the one result
that would notice a call reaching the wrong function.
### Still missing for `C-c C-c`
- **A new `defvar` has nowhere to live.** Editing one works — a redefinition
module declares it `external`, so the storage stays the host's. *Adding* one
needs storage the host never laid out, which needs a runtime registry
(`flan_dev_cell(name)` handing out stable cell addresses, allocating on
first use) and globals reached through cells too. That is the next commit.
- **The agent**, so the install happens at a frame boundary in a real process
rather than in a C test harness. Step 3.
- **A session that holds the checker environment.** `Check.program` builds a
`new_env ()`, prepends the prelude, mutates it through `collect` and throws
it away. A REPL keeps it — and has to check each new form into a scratch copy
and commit only on success, or one typo leaves a half-declared name behind
and every later eval sees it.
- **Layout drift has to be rejected.** Editing a `defstruct` or retyping a
`defvar` changes the shape of memory the running process already laid out.
The house rule below says compare against the declaration the session was
built with and refuse with a reason, rather than load a module that reads a
field at the wrong offset. Nothing does this yet.
## Where build time goes
`flan build calc-me.flan` was ~160ms, and ~95% of it was clang. **The object
@ -329,18 +465,12 @@ project**, so it comes first. Staged so each step is runnable on its own —
the failure mode is building a daemon and a protocol before knowing the reload
primitive works.
1. **The reload primitive, measured.** `llc` + `ld -shared` → `.so` →
`dlopen` → call. No sockets, no protocol. A test that compiles one function,
loads it, calls it, recompiles it changed, and calls it again. plan.org's
16ms was measured with `clang` in isolation and never in this codebase.
It forces the first real change: `emit.ml` needs a mode that compiles one
redefinable function into its own module *against the existing globals*,
rather than as a whole program.
2. **Indirection cells.** Every cross-function call in a dev build goes through
a pointer; redefinition is one atomic store. A fork in `emit.ml` between dev
and release codegen, and the first time `Build.opts` means something
semantic rather than an optimisation level. `test/programs/` gets a case
where a running loop's callee is swapped mid-run.
1. ~~**The reload primitive, measured.**~~ **Done** — `Emit.redefinition`,
`Build.shared`, `test/reload_host.c`, ~19ms. See the section above.
2. ~~**Indirection cells.**~~ **Done** — `Build.opts.dev` / `flan build --dev`,
`flan_reload_install`, and a fixture whose untouched call site follows the
swap. See the section above. Still to do here: a *new* `defvar`, which needs
a runtime cell registry.
3. **The agent, in C.** A socket listener in the game process, `dlopen` off the
game thread with `RTLD_NOW`, and the staged cell publish at a frame
boundary. It lives next to `flan_rt.c` — no OCaml runtime in the game
@ -352,14 +482,16 @@ primitive works.
the protocol is mechanical once 1–3 exist, and the editor client is where
the taste is.
**Two decisions to settle before step 2**, because both change codegen and are
**One decision left to settle before step 2**, because both change codegen and are
painful to retrofit:
- **Do cells cover globals, or only functions?** plan.org says redefining a
`defvar` is not covered (open decision #6, milestone 7). But sand's `grid` is
a global, and "edit the code, keep the sand" is exactly the demo — which
works only if globals *survive* a reload, meaning the new `.so` must not
re-emit them.
- ~~**Do cells cover globals, or only functions?**~~ **Settled by step 1:
functions only.** A redefinition module declares every global `external`, so
globals live in the host and survive a reload — which is what "edit the code,
keep the sand" needs. The consequence to watch is the other half: adding a
`defvar` to a file cannot take effect on reload, and changing one's type is a
silent mismatch against storage the host already laid out. Nothing detects
that yet.
- **What is a redefinition unit — one function, or a file?** A file is much
easier to make correct and is what `load-file` wants anyway; one function is
what `C-c C-c` wants and is where the 16ms number comes from.

24
bin/main.ml
View File

@ -39,6 +39,13 @@ let checked path = Flan.Check.program (load path).decls
decision, not the optimisation level (NEXT.md, Bounds checks). *)
let no_checks_flag = "--no-bounds-checks"
(* A dev build is the one a REPL can attach to: every call goes through a cell
so a redefinition can be installed, and the cells and globals are exported
so a loaded module can reach them (NEXT.md, the dev loop). *)
let dev_flag = "--dev"
let flags = [ no_checks_flag; dev_flag ]
let () =
match Array.to_list Sys.argv with
| _ :: "read" :: files when files <> [] ->
@ -75,29 +82,32 @@ let () =
(Flan.Types.to_string f.ret) (Array.length f.slots))
p.fns))
files
| _ :: "emit" :: args when List.exists (fun a -> a <> no_checks_flag) args ->
| _ :: "emit" :: args when List.exists (fun a -> not (List.mem a flags)) args ->
let checks = not (List.mem no_checks_flag args) in
let files = List.filter (fun a -> a <> no_checks_flag) args in
let dev = List.mem dev_flag args in
let files = List.filter (fun a -> not (List.mem a flags)) args in
List.iter
(fun path ->
with_errors path (fun () ->
checked path |> Flan.Emit.program ~checks |> print_string))
checked path |> Flan.Emit.program ~checks ~dev |> print_string))
files
| _ :: "build" :: path :: rest ->
let checks = not (List.mem no_checks_flag rest) in
let dev = List.mem dev_flag rest in
let out =
match List.filter (fun a -> a <> no_checks_flag) rest with
match List.filter (fun a -> not (List.mem a flags)) rest with
| [ "-o"; o ] -> o
| [] -> Filename.remove_extension (Filename.basename path)
| _ ->
prerr_endline
"usage: flan build <file.flan> [-o out] [--no-bounds-checks]";
"usage: flan build <file.flan> [-o out] [--no-bounds-checks] [--dev]";
exit 2
in
with_errors path (fun () ->
let l = load path in
let p = Flan.Check.program l.decls in
ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks }
ignore (Flan.Build.executable
~opts:{ Flan.Build.default with checks; dev }
~csrcs:l.csrcs ~lflags:l.lflags p ~out))
| _ :: "run" :: path :: args ->
with_errors path (fun () ->
@ -116,6 +126,6 @@ let () =
| _ ->
prerr_endline
"usage: flan (read|parse|check|emit) <file.flan>...\n\
\ flan build <file.flan> [-o out] [--no-bounds-checks]\n\
\ flan build <file.flan> [-o out] [--no-bounds-checks] [--dev]\n\
\ flan run <file.flan> [args...]";
exit 2

75
lib/build.ml
View File

@ -5,8 +5,8 @@
{v flan → typed IR → .ll → clang --target={native,wasm32} v}
Not the dev path — that one never invokes the clang driver, because the
driver *is* the cost (52ms of the measured 68), and goes llc + ld -shared +
dlopen instead for ~16ms. Nothing at milestone 2 needs it yet. *)
driver *is* the cost, and goes llc + ld -shared + dlopen instead. That is
[shared], at the bottom of this file, measured at ~19ms. *)
let clang = try Sys.getenv "FLAN_CLANG" with Not_found -> "clang"
@ -39,13 +39,19 @@ type opts = {
opt : string;
keep : bool; (* leave the .ll behind *)
checks : bool; (* bounds-check [at] and [slice] *)
(* A dev build is the one a REPL can attach to. Two things, and they belong
together because either alone is useless: every cross-function call goes
through a cell so a redefinition can be installed, and [-rdynamic] exports
those cells (and the globals) so a dlopen'd module can reach them. *)
dev : bool;
}
(* Checks are deliberately independent of [opt]: the acceptance table runs the
same programs at -O0 and -O2 to compare the emitted IR against what mem2reg
makes of it, and that comparison is only meaningful if both emit the same
checks. Dropping them is a release decision, not an optimisation one. *)
let default = { target = None; opt = "-O2"; keep = false; checks = true }
let default =
{ target = None; opt = "-O2"; keep = false; checks = true; dev = false }
(* What the compiler itself is, cheaply: its path, size and mtime. A clang
upgrade changes one of those, so the key changes with it — without paying a
@ -113,7 +119,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = [])
(p : Tast.program) ~out =
let dir = workdir () in
let ll = Filename.concat dir (Filename.basename out ^ ".ll") in
write ll (Emit.program ~checks:opts.checks p);
write ll (Emit.program ~checks:opts.checks ~dev:opts.dev p);
let objs =
compile_c ~opts ~src:Runtime_src.source ~name:"flan_rt.c"
:: List.map
@ -124,6 +130,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = [])
let cmd =
String.concat " "
([ Filename.quote clang; opts.opt; "-Wno-override-module" ]
@ (if opts.dev then [ "-rdynamic" ] else [])
@ (match opts.target with None -> [] | Some t -> [ "--target=" ^ t ])
@ [ Filename.quote ll ]
@ List.map Filename.quote objs
@ -135,3 +142,63 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = [])
failwith (Printf.sprintf "%s failed (exit %d); the IR is at %s" clang code ll);
if not opts.keep then (try Sys.remove ll with Sys_error _ -> ());
out
(* ── The dev path: one function into a loadable object ──────────────── *)
(* Step 1 of the dev loop (NEXT.md): [Emit.redefinition] text → a [.so] the
running process can [dlopen]. This never invokes the clang driver — the
driver is most of what a build costs and none of what it does is needed
here, since the input is already IR and the output has no libc to find.
[ld -shared] rather than [clang -shared] for the same reason. A shared
object is allowed undefined symbols, which is the whole mechanism: the
redefined function's calls to other Flan functions, to the globals and to
the runtime are all left for the loader to bind back to the host.
PIC has to be asked for. [llc] defaults to the static relocation model on
this target, and the failure is at link time, not at codegen: "relocation
R_X86_64_32S against ... can not be used when making a shared object". *)
let llc = try Sys.getenv "FLAN_LLC" with Not_found -> "llc"
let linker = try Sys.getenv "FLAN_LD" with Not_found -> "ld"
(* Times in milliseconds, per stage, because a single total does not say
whether the number is worth chasing. *)
type timing = { llc_ms : float; link_ms : float }
let time f =
let t0 = Unix.gettimeofday () in
let x = f () in
(x, (Unix.gettimeofday () -. t0) *. 1000.)
let run what cmd =
let code = Sys.command cmd in
if code <> 0 then failwith (Printf.sprintf "%s failed (exit %d)" what code)
let shared ?(opts = default) ~ir ~out () : timing =
let dir = workdir () in
let base = Filename.remove_extension (Filename.basename out) in
let ll = Filename.concat dir (base ^ ".ll") in
let obj = Filename.concat dir (base ^ ".o") in
write ll ir;
let (), llc_ms =
time (fun () ->
run llc
(String.concat " "
([ Filename.quote llc; opts.opt; "-filetype=obj";
"-relocation-model=pic" ]
@ (match opts.target with None -> [] | Some t -> [ "-mtriple=" ^ t ])
@ [ Filename.quote ll; "-o"; Filename.quote obj ])))
in
let (), link_ms =
time (fun () ->
run linker
(String.concat " "
[ Filename.quote linker; "-shared"; Filename.quote obj; "-o";
Filename.quote out ]))
in
if not opts.keep then begin
(try Sys.remove ll with Sys_error _ -> ());
(try Sys.remove obj with Sys_error _ -> ())
end;
{ llc_ms; link_ms }

141
lib/emit.ml
View File

@ -53,6 +53,13 @@ let fname n = "@" ^ quoted ("flan." ^ n)
let gname n = "@" ^ quoted ("flan." ^ n)
let sname n = "%" ^ quoted n
(* A dev build's redefinable calls go through a cell: a mutable global holding
the address of the function that is current. Redefinition is then one store,
and every existing call site follows it — which is the whole point, since a
call bound at link time cannot be made to notice a new body. Release builds
have no cells and call the symbol directly. *)
let cellname n = "@" ^ quoted ("flan.cell." ^ n)
(* ── Types ─────────────────────────────────────────────────────────── *)
let rec ll (t : Types.t) =
@ -86,6 +93,7 @@ type m = {
symbol directly; there is no thunk. *)
externs : (string, string) Hashtbl.t;
checks : bool; (* emit bounds checks *)
dev : bool; (* call through cells (below) *)
mutable nstr : int;
}
@ -240,7 +248,7 @@ let rec value f (e : Tast.expr) : string =
| Tast.Call (name, args) ->
(match Hashtbl.find_opt f.md.externs name with
| Some sym -> extern_call f e.Tast.ty ("@" ^ sym) args
| None -> call f e.Tast.ty (fname name) args)
| None -> call f e.Tast.ty name args)
| Tast.Do body -> block f body
| Tast.Let (bs, body) ->
List.iter
@ -378,11 +386,21 @@ and block f body =
List.iter (fun e -> last := value f e) body;
!last
and call f ret name args =
and call f ret flan args =
let vs = map_lr (fun (a : Tast.expr) ->
let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in
(* The cell is loaded *after* the arguments, so a redefinition that lands
between two calls still cannot land in the middle of one. *)
let callee =
if not f.md.dev then fname flan
else begin
let p = fresh f in
ins f "%s = load ptr, ptr %s" p (cellname flan);
p
end
in
let t = fresh f in
ins f "%s = call %s %s(%s)" t (ll ret) name (String.concat ", " vs);
ins f "%s = call %s %s(%s)" t (ll ret) callee (String.concat ", " vs);
t
(* A foreign call, where the same rule applies as to the runtime shims: a slice
@ -709,7 +727,24 @@ and cast f (x : Tast.expr) target =
(* ── Functions ─────────────────────────────────────────────────────── *)
let emit_fn m (fn : Tast.fn) =
(* The one place a Flan function's LLVM signature is spelled. A [define] and
the [declare] a redefinition module needs for the same function have to
agree exactly, and the way they stop agreeing is one of them growing a case
for Unit or for a slice parameter that the other never gets. *)
let signature ~named (fn : Tast.fn) =
let params =
List.mapi
(fun i ty -> if named then Printf.sprintf "%s %%p%d" (ll ty) i else ll ty)
fn.Tast.params
in
Printf.sprintf "%s %s(%s)" (ll fn.Tast.ret) (fname fn.Tast.name)
(String.concat ", " params)
(* [hidden] on a redefinition's own body, and this is load-bearing. Default
visibility in a shared object is interposable: [@"flan.bump"] inside the
module would resolve to the *host's* copy, so the installer would publish
the function it was replacing and the reload would appear to do nothing. *)
let emit_fn m ?(hidden = false) (fn : Tast.fn) =
let n = Array.length fn.Tast.slots in
let f = {
md = m;
@ -741,12 +776,9 @@ let emit_fn m (fn : Tast.fn) =
discarded, so the return is the Unit constant rather than that value. *)
if Types.equal fn.Tast.ret Types.Unit then last := "zeroinitializer";
term f "ret %s %s" (ll fn.Tast.ret) !last;
let params =
List.mapi (fun i ty -> Printf.sprintf "%s %%p%d" (ll ty) i) fn.Tast.params
in
Buffer.add_string m.out
(Printf.sprintf "\ndefine %s %s(%s) {\nentry:\n%s%s}\n"
(ll fn.Tast.ret) (fname fn.Tast.name) (String.concat ", " params)
(Printf.sprintf "\ndefine %s%s {\nentry:\n%s%s}\n"
(if hidden then "hidden " else "") (signature ~named:true fn)
(Buffer.contents f.allocas) (Buffer.contents f.b))
(* ── Globals ───────────────────────────────────────────────────────── *)
@ -826,14 +858,16 @@ let emit_main m (fn : Tast.fn) =
Buffer.add_string b ")\n unreachable\n}\n";
Buffer.add_string m.out (Buffer.contents b)
(* [checks] is on by default: a dev build traps on an out-of-bounds [at] or
[slice], a release build is told to drop them. *)
let program ?(checks = true) (p : Tast.program) : string =
(* Everything a module needs before its own definitions: the tables the
emitters look names up in, the struct types, and the foreign [declare]s.
Both entry points below start here, so a redefinition module cannot drift
from the whole-program one in how it names or lays out a type. *)
let new_module ~checks ~dev (p : Tast.program) =
let m = {
out = Buffer.create 8192; strs = Buffer.create 512;
structs = Hashtbl.create 16; globals = Hashtbl.create 16;
externs = Hashtbl.create 32;
checks; nstr = 0;
checks; dev; nstr = 0;
} in
List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s)
p.Tast.structs;
@ -866,9 +900,88 @@ let program ?(checks = true) (p : Tast.program) : string =
e.Tast.eparams))))
p.Tast.externs;
if p.Tast.externs <> [] then Buffer.add_char m.out '\n';
m
let finish m = header ^ Buffer.contents m.strs ^ "\n" ^ Buffer.contents m.out
(* [checks] is on by default: a dev build traps on an out-of-bounds [at] or
[slice], a release build is told to drop them. *)
let program ?(checks = true) ?(dev = false) (p : Tast.program) : string =
let m = new_module ~checks ~dev p in
(* One cell per function, initialised to the function this build compiled.
Nothing has been redefined yet, so a dev build starts out behaving exactly
like a release one — the indirection is the only difference. *)
if dev then begin
List.iter
(fun (fn : Tast.fn) ->
Buffer.add_string m.out
(Printf.sprintf "%s = global ptr %s\n" (cellname fn.Tast.name)
(fname fn.Tast.name)))
p.Tast.fns;
Buffer.add_char m.out '\n'
end;
List.iter (emit_global m) p.Tast.globals;
List.iter (emit_fn m) p.Tast.fns;
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns with
| Some fn -> emit_main m fn
| None -> ());
header ^ Buffer.contents m.strs ^ "\n" ^ Buffer.contents m.out
finish m
(* One function, compiled into its own module against a host that is already
running — the reload primitive (NEXT.md, step 1). The difference from
[program] is entirely in what this module *does not* define:
- a global is [external]. Defining it would give the loaded object a second
copy, and the whole point of reloading into a live process is that the
state survives: sand's grid is a global, and "edit the code, keep the
sand" is the demo. So a redefinition can change a function's body and can
never re-initialise the program's data.
- every other function is a [declare], resolved back to the host at load
time, so a redefined [settle] calls the host's [move-grain] rather than
carrying a private copy of it.
- there is no [main]; this module is loaded, not started.
String literals still have to come along: they are this module's own
constants, and omitting them is an undefined [@.str.N] at link time. *)
let redefinition ?(checks = true) ?(dev = false) (p : Tast.program) ~fn : string =
let target =
match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = fn) p.Tast.fns with
| Some f -> f
| None -> failwith (Printf.sprintf "no such function: %s" fn)
in
let m = new_module ~checks ~dev p in
List.iter
(fun (g : Tast.global) ->
Buffer.add_string m.out
(Printf.sprintf "%s = external %s %s\n" (gname g.Tast.gname)
(if g.Tast.gconst then "constant" else "global") (ll g.Tast.gty)))
p.Tast.globals;
List.iter
(fun (f : Tast.fn) ->
if not (String.equal f.Tast.name fn) then
Buffer.add_string m.out
(Printf.sprintf "declare %s\n" (signature ~named:false f)))
p.Tast.fns;
if dev then begin
(* The cells are the host's, like the globals. Referencing one is how a
redefined function reaches its siblings, and storing into one is how it
replaces itself. *)
List.iter
(fun (f : Tast.fn) ->
Buffer.add_string m.out
(Printf.sprintf "%s = external global ptr\n" (cellname f.Tast.name)))
p.Tast.fns;
Buffer.add_char m.out '\n'
end;
emit_fn m ~hidden:dev target;
if dev then
(* Publishing is a separate, named function rather than a constructor: the
agent has to choose *when* the swap happens — at a frame boundary, on
the game thread — and a loader-run ctor would do it during dlopen, on
whatever thread called it, in the middle of a frame. *)
Buffer.add_string m.out
(Printf.sprintf
"\ndefine void @flan_reload_install() {\nentry:\n \
store ptr %s, ptr %s\n ret void\n}\n"
(fname fn) (cellname fn));
finish m

8
test/dune
View File

@ -1,6 +1,6 @@
(tests
(names test_flan test_acceptance)
(libraries flan)
(names test_flan test_acceptance test_reload)
(libraries flan unix)
; The acceptance programs are part of the test corpus: if the reader, the
; parser or the checker regresses on them we want to know here, not at the CLI.
(deps
@ -10,4 +10,6 @@
; the FFI case import them and an import reads the directory at build time.
(glob_files %{workspace_root}/sand-sim/*)
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files programs/*.flan)))
(glob_files programs/*.flan)
; The reload primitive's host: a C main that dlopens what Build.shared made.
(file reload_host.c)))

26
test/programs/reload-v2.flan Normal file
View File

@ -0,0 +1,26 @@
;;;; The reload primitive's fixture, v2. Three differences from v1, each one a
;;;; separate thing being checked:
;;;;
;;;; [bump] steps by 10 and adds 1000, so the host's untouched call site in
;;;; [outer] visibly runs the new body rather than the one it was linked to.
;;;;
;;;; [bump] also calls *itself*. Inside a shared object a plain call would be
;;;; interposed by the host's copy — the module would look self-consistent and
;;;; silently run the old body — so the self-call goes through the cell like
;;;; any other. If it did not, the first recursive step would print "v1" and
;;;; the transcript would say so.
;;;;
;;;; [helper] is changed only as a tripwire. The module declares it rather than
;;;; defining it, so this body is dead text and the call has to land on the
;;;; host's [* x 2]; with the two bodies identical nothing at run time would
;;;; notice a module that grew its own copy.
(defvar counter i64)
(defn helper [x i64] i64 (* x 3))
(defn bump [] i64
(print-line "v2")
(set counter (+ counter 10))
(if (> counter 100) (+ (helper counter) 1000) (bump)))
(defn outer [] i64 (bump))

22
test/programs/reload.flan Normal file
View File

@ -0,0 +1,22 @@
;;;; The reload primitive's fixture, v1 (NEXT.md, dev loop step 1 and 2).
;;;;
;;;; There is deliberately no [main]: the host is reload_host.c, which links
;;;; this program and then dlopens two rebuilt copies of [bump].
;;;;
;;;; [counter] is the state that has to survive a reload — a redefinition
;;;; module declares it [external], so the loaded object writes the host's copy
;;;; and not a new one. [outer] is the call site that has to *follow* a reload:
;;;; it is compiled once, into the host, and never rebuilt, so if a redefined
;;;; [bump] runs when the host calls [outer] then the cell is doing its job.
;;;; The string is not decoration either — a redefinition module has to carry
;;;; its own constants, and a one-function module usually has none.
(defvar counter i64)
(defn helper [x i64] i64 (* x 2))
(defn bump [] i64
(print-line "v1")
(set counter (+ counter 1))
(helper counter))
(defn outer [] i64 (bump))

86
test/reload_host.c Normal file
View File

@ -0,0 +1,86 @@
/* reload_host.c — redefinition, exercised in one process.
*
* This is the smallest thing that can prove the dev loop's first two steps:
* a function recompiled into its own object, loaded into a program that is
* already running, *installed* there, and then reached by a call site that
* was compiled before it existed. No socket, no daemon, no frame boundary —
* those are step 3, and the agent that does them lives next to flan_rt.c for
* the same reason this host is C: there is no OCaml in a game process.
*
* It stands in for the entry point of a Flan program, so the .flan fixture it
* links against has no [main] of its own. Three things are being checked, and
* only a single process can check any of them:
*
* - installing a new body makes the host's own [outer] — linked once, never
* rebuilt — call it, which is the whole of C-c C-c;
* - the loaded copy writes the *host's* [counter] and calls the host's
* [helper], because a redefinition module declares both rather than
* defining them;
* - the state carries across two reloads untouched.
*
* The two versions are separate files rather than one path rewritten in
* place: dlopen keys its cache on the path, so re-opening the same name can
* hand back the handle it already has and the test would then "pass" on the
* code it loaded the first time.
*/
#include <dlfcn.h>
#include <stdint.h>
#include <stdio.h>
#include <time.h>
/* The Flan symbols the executable itself defines. Flan names contain
* characters C identifiers cannot, so each one is reached through its asm
* label — the same name Emit spells. */
extern int64_t flan_outer(void) __asm__("flan.outer");
extern int64_t flan_counter __asm__("flan.counter");
void flan_rt_init(int32_t argc, char **argv);
/* What a redefinition module exposes. It is a named function and not an ELF
* constructor on purpose: the agent has to choose when the store happens —
* on the game thread, between frames — and a constructor would do it during
* dlopen, wherever that call happened to be. */
typedef void (*install_fn)(void);
/* The load is timed here rather than from the test process, because this is
* the part that has to fit inside a frame. */
static double now_ms(void) {
struct timespec t;
clock_gettime(CLOCK_MONOTONIC, &t);
return (double)t.tv_sec * 1e3 + (double)t.tv_nsec / 1e6;
}
static int install(const char *path) {
double t0 = now_ms();
void *h = dlopen(path, RTLD_NOW | RTLD_LOCAL);
if (h == NULL) {
fprintf(stderr, "dlopen %s: %s\n", path, dlerror());
return 0;
}
install_fn f = (install_fn)(uintptr_t)dlsym(h, "flan_reload_install");
if (f == NULL) {
fprintf(stderr, "dlsym flan_reload_install in %s: %s\n", path, dlerror());
return 0;
}
double t1 = now_ms();
f();
fprintf(stderr, "dlopen+dlsym %.2fms install %.4fms\n", t1 - t0,
now_ms() - t1);
return 1;
}
int main(int argc, char **argv) {
flan_rt_init(argc, argv);
if (argc != 3) {
fprintf(stderr, "usage: %s <v1.so> <v2.so>\n", argv[0]);
return 2;
}
printf("host %lld\n", (long long)flan_outer());
if (!install(argv[1])) return 1;
printf("v1 %lld\n", (long long)flan_outer());
if (!install(argv[2])) return 1;
printf("v2 %lld\n", (long long)flan_outer());
printf("counter %lld\n", (long long)flan_counter);
return 0;
}

16
test/test_acceptance.ml
View File

@ -23,7 +23,7 @@ let run exe arg =
Sys.remove out;
(code, text)
let compile ?(opt = "-O2") ?(checks = true) path =
let compile ?(opt = "-O2") ?(checks = true) ?(dev = false) path =
let exe =
Filename.concat scratch
("flan-t-" ^ Filename.remove_extension (Filename.basename path))
@ -32,7 +32,7 @@ let compile ?(opt = "-O2") ?(checks = true) path =
brings back the package's C shim and linker arguments as well. *)
let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
let p = Check.program l.Load.decls in
ignore (Build.executable ~opts:{ Build.default with opt; checks }
ignore (Build.executable ~opts:{ Build.default with opt; checks; dev }
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags p ~out:exe);
exe
@ -93,8 +93,8 @@ let () =
surface calc-me does not reach — globals, 2-D arrays, places through a
pointer, casts, match with either arm taken, and the value semantics of
spec-memory.md. *)
let outputs ?opt name path expected =
let exe = compile ?opt path in
let outputs ?opt ?dev name path expected =
let exe = compile ?opt ?dev path in
let code, text = run exe None in
if text <> expected || code <> 0 then begin
incr failures;
@ -136,6 +136,14 @@ let () =
outputs ~opt:"-O0" "value semantics, -O0" "programs/values.flan" values_out;
outputs ~opt:"-O0" "machine surface, -O0" "programs/machine.flan" machine_out;
(* And once more as a dev build. Every call in one goes through a cell, so
this is the same table asserting the indirection changes nothing before
anything has been redefined — the sand hash especially, since it is the
one result that would notice a call reaching the wrong function. *)
outputs ~dev:true "sand, headless, dev" "programs/sand-headless.flan" sand_out;
outputs ~dev:true "value semantics, dev" "programs/values.flan" values_out;
outputs ~dev:true "machine surface, dev" "programs/machine.flan" machine_out;
(* Bounds checks, NEXT.md item 2. A trap has no result — it has a nonzero
exit and a message on stderr — so it needs a case shape the table above
does not have. What is asserted is the *reason*: the location, and which

141
test/test_reload.ml Normal file
View File

@ -0,0 +1,141 @@
(* The reload primitive, measured (NEXT.md, dev loop step 1).
One function is recompiled into its own object and loaded into a process
that is already running. Everything after this — indirection cells, the
agent in the game, the daemon — assumes this works and is fast; nothing in
the codebase had ever done it, and plan.org's 16ms was measured with clang
in isolation somewhere else.
The parts, all of them new here:
Emit.program ~dev a cell per function; every call goes through one
Emit.redefinition one [define], everything else [declare]/[external],
plus [flan_reload_install] to publish it into its cell
Build.shared that IR text through llc + ld -shared, timed
reload_host.c dlopen, install, call — twice, in one process
The host is C rather than OCaml because that is where it has to end up: the
agent of step 3 lives in the game process, next to flan_rt.c, and there is
no OCaml runtime there. *)
open Flan
let failures = ref 0
let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt
let scratch = Filename.get_temp_dir_name ()
let tmp name = Filename.concat scratch ("flan-reload-" ^ name)
let checked path =
Check.program
(Load.program ~file:path (Parse.program (Reader.read_file path))).Load.decls
let ms f =
let t0 = Unix.gettimeofday () in
let x = f () in
(x, (Unix.gettimeofday () -. t0) *. 1000.)
let () =
match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
| 0 ->
let p1 = checked "programs/reload.flan" in
let p2 = checked "programs/reload-v2.flan" in
(* [dev] is the two halves of a reloadable build together: cells, so a
call site can be made to follow a redefinition, and [-rdynamic], so the
cells and globals are visible to a dlopen'd object at all. [-ldl] is the
host's own, for its dlopen. *)
let dev = { Build.default with Build.dev = true } in
let host = tmp "host" in
ignore
(Build.executable ~opts:dev ~csrcs:[ "reload_host.c" ]
~lflags:[ "-ldl" ] p1 ~out:host);
(* Two paths, not one rewritten in place: dlopen caches by path and would
hand back the first handle, so the swap would silently not happen. *)
let so1 = tmp "v1.so" and so2 = tmp "v2.so" in
let ir1, emit_ms = ms (fun () -> Emit.redefinition ~dev:true p1 ~fn:"bump") in
let t1 = Build.shared ~opts:dev ~ir:ir1 ~out:so1 () in
let ir2, emit2_ms = ms (fun () -> Emit.redefinition ~dev:true p2 ~fn:"bump") in
let t2 = Build.shared ~opts:dev ~ir:ir2 ~out:so2 () in
(* A redefinition module must not define what the host already owns:
defining [counter] would give the loaded object a private copy and the
state would reset on every reload, and defining [helper] would freeze a
stale copy of it into the module. *)
let has hay needle =
let n = String.length needle and h = String.length hay in
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
go 0
in
if not (has ir2 "@\"flan.counter\" = external global i64") then
fail "redefinition defines the global instead of declaring it";
if not (has ir2 "declare i64 @\"flan.helper\"(i64)") then
fail "redefinition defines a sibling function instead of declaring it";
if has ir2 "define i64 @\"flan.helper\"" then
fail "redefinition emitted a second body for a function it does not own";
if has ir2 "define i32 @main" then fail "redefinition emitted an entry point";
(* [hidden], or the module's own [@"flan.bump"] is interposed by the host's
and the installer publishes the very function it is replacing. *)
if not (has ir2 "define hidden i64 @\"flan.bump\"") then
fail "redefinition's own body is interposable";
if not (has ir2 "@\"flan.cell.helper\" = external global ptr") then
fail "redefinition defines a cell instead of using the host's";
(* A dev host's calls are indirect; a release host's are not. That is the
only difference between the two, and the whole of C-c C-c rests on it. *)
let host_ir = Emit.program ~dev:true p1 in
if not (has host_ir "@\"flan.cell.bump\" = global ptr @\"flan.bump\"") then
fail "dev build emitted no cell";
if has (Emit.program p1) "flan.cell." then
fail "release build emitted a cell";
let out = tmp "out" in
let cmd =
(* stderr kept apart from stdout: the host times its own dlopen there,
and stdout is what the expected transcript is compared against. *)
Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote host)
(Filename.quote so1) (Filename.quote so2) (Filename.quote out)
(Filename.quote (tmp "err"))
in
let (code, dlopen_ms) = ms (fun () -> Sys.command cmd) in
let text = In_channel.with_open_bin out In_channel.input_all in
let timings =
In_channel.with_open_bin (tmp "err") In_channel.input_all in
(* host: counter 0 -> 1, helper 1 = 2. v1: 1 -> 2, helper 2 = 4.
v2: the changed body, +10 and +1000, over the counter v1 left behind —
so 2 -> 12, helper 12 = 24, 1024. Two things are being read here. The
last line is the state: it is the host's, and two reloads did not touch
it. And 1024 rather than 1036 is the call: v2's own text for [helper]
multiplies by three, so the host's copy is demonstrably the one that
ran. The bare "v1"/"v2" lines come from inside each [bump] and are what
exercise a redefinition module's string constants.
Two things are load-bearing about the shape of this transcript. Every
call is [outer], compiled once into the host and never rebuilt — so a
changed answer can only mean its call site followed the redefinition.
And v2's [bump] recurses until the counter passes 100, through the cell:
2 -> 12 -> ... -> 102, ten "v2" lines, helper 102 = 204, 1204. An
interposed self-call would reach the host's v1 body instead, print "v1"
on the second line of that run, and land nowhere near 1204. *)
let v2s = String.concat "" (List.init 10 (fun _ -> "v2\n")) in
let want =
"v1\nhost 2\nv1\nv1 4\n" ^ v2s ^ "v2 1204\ncounter 102\n"
in
if code <> 0 || text <> want then
fail "reload\n got: %S (exit %d)\n wanted: %S" text code want;
Printf.printf
"reload: emit %.1fms llc %.1fms ld %.1fms (v2: emit %.1fms llc %.1fms ld %.1fms) host run %.1fms\n"
emit_ms t1.Build.llc_ms t1.Build.link_ms emit2_ms t2.Build.llc_ms
t2.Build.link_ms dlopen_ms;
print_string timings;
List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
[ host; so1; so2; out; tmp "err" ];
if !failures = 0 then print_endline "reload: all tests passed"
else begin
Printf.printf "\n%d failure(s)\n" !failures;
exit 1
end
| _ -> print_endline "reload: skipped (no clang or llc on PATH)"