diff --git a/NEXT.md b/NEXT.md index dec1df5..20725ad 100644 --- a/NEXT.md +++ b/NEXT.md @@ -1382,6 +1382,82 @@ over quoted pieces, with `~@` splicing. Written once, in the expander, over `For The four files this touches — `build.ml`, `check.ml`, `emit.ml`, `load.ml` — were owned by other lanes when the front half landed, which is the only reason the expander is not here too. +### Handoff: the boundary is built and verified-by-compilation, the expander is not written + +A lane stopped here mid-flight. What exists, exactly: + +- **`lib/dynload_stubs.c` and `lib/dynload.ml` — the compiler's own dlopen.** This was the one unvalidated +assumption under the whole design and it is now machinery. OCaml has no dlopen for ELF (`Dynlink` loads OCaml, +not shared objects), and `lib/dune` had no `foreign_stubs`, so "point the reload primitive at the compiler's own +process" was not the small step it reads as. It is `dlopen`/`dlsym`/`dlclose`, a four-argument call into a macro +thunk, `calloc`/`free`, and a peek/poke family — OCaml cannot address raw memory, so a `Form` image is written +into it one field at a time from C. `(c_library_flags (-ldl))` is in `lib/dune`. +- **`Emit.macro_thunk`, and `Emit.program ?macros`.** One thunk per macro: +`void @"flan.macro.NAME"(ptr %args, i64 %n, ptr %out, ptr %xfer)`. It builds the `%slice` from `(args, n)`, +calls the macro, stores the result through `%out`. **Nothing aggregate crosses to C.** This is the correction +that matters and it is not obvious from the diff: the unions lane verified a union's *memory* layout against +clang, which is a different claim from LLVM's calling convention for an aggregate passed or returned **by value** +in hand-written IR. Memory is the only agreement that exists, so the boundary is pointers and scalars only. +- **`Build.macro_module`.** A whole program into a self-contained `.so`: the runtime linked in, no undefined Flan +symbols, `-fPIC` on every object including the `.ll`. Self-contained is what keeps `-rdynamic` off the compiler's +own link. It goes through clang rather than `llc` + `ld -shared` — unlike `Build.shared` — because there are C +objects and a libc to find, which is exactly the part of the driver the dev path skips. Cost is the driver's +~50ms, unmeasured here, paid once per process for the whole macro set. +- **`defunion Form` and the list-building surface, in `prelude.ml`.** Written, and the compiler builds; **not yet +checked against a program, so its layout is unverified.** That is the first thing to do. + +Two gates were checked before any of this and both pass, which saves re-deriving them: + +- **`check_finite` does not recurse through `Types.Slice`**, only through `Named`, `Array` and `Option`. So a +union case holding `[Form]` is accepted and `Form` needs no `(Ptr Form)` indirection. +- **The default allocator needs no init.** `flan_ctx_alloc = &flan_heap` is statically initialised in +`flan_rt.c`, so a module with no `main` can allocate. `flan_rt_init` is only argv. + +**The layout the two sides have to agree on.** `Form` mirrors `Form.value`, **not** `Form.t` — there is no `loc` +field, deliberately. A macro cannot invent a source location, so the unmarshaller stamps the *call site's* +`Loc.t` onto every node of what a macro returns; that is the structural answer to "keep the call site's location +attached to what a macro produces", and it is what the queued structured-error work reads. The cases are +`Sym Kw Int Float Str Byte List Vec Map` and **case order is tag order**, so the list is a layout contract with +the marshaller and may not be reordered. The widest cases are `string` and `[Form]`, both `%slice` = 16 bytes +align 8, so the expected shape is `{ i32 tag, [2 x i64] payload }`: **24 bytes, align 8, payload at offset 8**. +Those three numbers are the whole agreement and **they are asserted nowhere yet** — the next commit should put +them through the same `ptrtoint` layout oracle the unions lane used, not hardcode them on faith. + +**What is not written at all:** `lib/expand.ml`. No marshaller, no unmarshaller, no macro collection, no +quasiquote, no fixpoint, no cycle detection. `parse.ml` still refuses `defmacro`, `when`/`unless`/`until`/`cond`/ +`dotimes` are still special forms, and the exit criterion is untouched. + +**What the next person should do first**, in this order, committing each: + +1. Write a program that names `Form` and check its layout through the oracle — 24/8/8. `Vec` is also a case name +and `(Vec T)` is also a type application; if the struct-literal arm and the type arm collide, rename the case and +say so, because that is a layout-contract change. +2. Prove the boundary: one Flan file, `(defn id [args [Form]] Form (at args 0))`, through `Build.macro_module`, +`Dynload.dl_open`, `dl_sym "flan.macro.id"`, a hand-laid `Form` in, the same one back. That is the commit that +makes everything above real rather than plausible. +3. Only then the expander. + +Four decisions this lane made that the design in this section did not settle, each of which the next person may +overturn cheaply: + +- **A macro takes one parameter, the slice of argument forms** — `[Form] -> Form` read as a single function type, +not as "one declared parameter per argument". It needs no reader or parser change (`[args]` already passes the +existing shape check) and it gives variadics for free, which `when` and `unless` both need since there is no +`&rest`. +- **The thunk ABI above**, rather than letting `%"Form"` cross to C. +- **`gensym`'s counter lives in the loaded module**, not in the compiler process as this section sketches. The +name is `~g`; `~` is a delimiter now, so no symbol the reader produces can contain one and a gensym cannot +collide. A module is dlopened once per compiler process, so the counter is process-wide in practice; a second +module would restart it, and the fix that day is to seed it from the module's index. +- **The macro module is the prelude plus the program's `defmacro`s, and not the program's own functions.** +Compiling the user's `defn`s into it would mean compiling a program that has not been expanded yet, which is the +chicken-and-egg the pre-pass exists to avoid. The cost is that a macro body may call prelude functions and other +macros and nothing else. Worth revisiting; not worth revisiting first. + +Left deliberately undone and named so nobody hunts for it: `&rest` sugar, an error carrying the expansion it came +from (only the call-site location is preserved, which is the part that does not make the later work harder), and +the other four special forms. + ### What would tell you it works `when`, `unless`, `until`, `cond` and `dotimes` are special forms in `parse.ml` today, and plan.org milestone 5 says diff --git a/lib/build.ml b/lib/build.ml index 209106e..e208eae 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -827,3 +827,60 @@ let shared ?(opts = default) ~ir ~out () : timing = (try Sys.remove obj with Sys_error _ -> ()) end; { llc_ms; link_ms } + +(* ── The macro path: a whole program into a shared object ───────────── *) + +(* A macro module is not a redefinition, and the difference is the whole + design. [shared] above builds a module full of [declare]s and [external]s + for a host that is already running Flan; here the host is the *compiler*, + an OCaml executable with no Flan symbols in it at all. So this module is + self-contained: the runtime is linked in, every function it calls is + defined, and nothing is left for the loader to find. That is also what + keeps [-rdynamic] off the compiler's own link. + + It goes through clang rather than through llc + ld, unlike [shared]: there + are C objects to link and a libc to find, which is exactly the part of the + driver the dev path skips because it does not need it. The cost is the + driver's ~50ms, paid once per process for the whole macro set. *) +let macro_module ?(opts = default) ?(csrcs = []) ?(lflags = []) ~macros + (p : Tast.program) ~out = + if wasm_target opts then + failwith + "macros are native only — running one means dlopening it into the \ + compiler, and wasm has no dlopen"; + let dir = workdir () in + let ll = Filename.concat dir (Filename.basename out ^ ".ll") in + write ll (Emit.program ~checks:opts.checks ~macros p); + (* -fPIC on every object, the .ll included. Without it the link fails with a + relocation against a symbol that cannot be used in a shared object — at + link time, not at codegen, which is the same trap [shared] meets and + answers with -relocation-model=pic. *) + let tflags = target_flags opts @ [ "-fPIC" ] in + let cc src name = compile_c ~opts ~tflags ~src ~name () in + let objs = + cc Runtime_src.source "flan_rt.c" + :: [ cc Runtime_src.dev_source "flan_dev.c" ] + @ (match p.Tast.cshim with + | [] -> [] + | parts -> + [ cc (String.concat "" (List.map snd parts)) "flan_shim.c" ]) + @ List.map (fun c -> cc (read_file c) (Filename.basename c)) + (select_csrcs opts csrcs) + in + let cmd = + String.concat " " + ([ Filename.quote (compiler opts); opts.opt; "-Wno-override-module"; + "-shared"; "-fPIC" ] + @ tflags + @ [ Filename.quote ll ] + @ List.map Filename.quote objs + @ select_lflags opts lflags + @ [ "-lm"; "-o"; Filename.quote out ]) + in + let code = Sys.command cmd in + if code <> 0 then + failwith + (Printf.sprintf "building the macro module failed (exit %d); the IR is \ + at %s" code ll); + if not opts.keep then (try Sys.remove ll with Sys_error _ -> ()); + out diff --git a/lib/dune b/lib/dune index db83290..9fc6fb4 100644 --- a/lib/dune +++ b/lib/dune @@ -1,6 +1,13 @@ (library (name flan) - (libraries unix)) + (libraries unix) + ; Running a macro means dlopening it into the compiler, and OCaml has no + ; dlopen for ELF -- Dynlink loads OCaml. These are the stubs for it, and the + ; only C the compiler itself is built from. See lib/dynload_stubs.c. + (foreign_stubs + (language c) + (names dynload_stubs)) + (c_library_flags (-ldl))) ; The host shim is Flan's, not the user's, so the compiler carries it rather ; than looking for it in an install directory. Generated from the real .c files diff --git a/lib/dynload.ml b/lib/dynload.ml new file mode 100644 index 0000000..39410ba --- /dev/null +++ b/lib/dynload.ml @@ -0,0 +1,48 @@ +(** The compiler's own dlopen, and raw memory to lay a [Form] out in. + + Every function here is a stub in [dynload_stubs.c]; the comment at the top + of that file is the design. Addresses are [nativeint] because that is the + only OCaml type that is exactly a machine word and carries no tag bit. *) + +type handle = nativeint +type addr = nativeint + +external dl_open : string -> handle = "flan_dl_open" +external dl_sym : handle -> string -> addr = "flan_dl_sym" +external dl_close : handle -> unit = "flan_dl_close" + +(** [call fn args n out] runs one macro: [args] is an array of [n] [Form]s, + [out] is room for the one it answers. *) +external call : addr -> addr -> int64 -> addr -> unit = "flan_macro_call" + +external alloc : int -> addr = "flan_mem_alloc" +external free : addr -> unit = "flan_mem_free" + +external poke_i32 : addr -> int -> int32 -> unit = "flan_poke_i32" +external poke_i64 : addr -> int -> int64 -> unit = "flan_poke_i64" +external poke_f64 : addr -> int -> float -> unit = "flan_poke_f64" +external poke_ptr : addr -> int -> addr -> unit = "flan_poke_ptr" +external poke_bytes : addr -> int -> string -> unit = "flan_poke_bytes" + +external peek_i32 : addr -> int -> int32 = "flan_peek_i32" +external peek_i64 : addr -> int -> int64 = "flan_peek_i64" +external peek_f64 : addr -> int -> float = "flan_peek_f64" +external peek_ptr : addr -> int -> addr = "flan_peek_ptr" +external peek_bytes : addr -> int -> int -> string = "flan_peek_bytes" + +(* Every allocation a macro call makes on this side, kept so the whole lot can + be released at once. A macro's *own* allocations are the macro process's -- + which is this process -- and are leaked on purpose: a returned Form points + into them, and the compiler reads it after the call returns. An expansion is + bounded by the size of the program being compiled, so leaking it costs what + holding the program costs. *) +let owned : addr list ref = ref [] + +let take n = + let p = alloc n in + owned := p :: !owned; + p + +let release () = + List.iter free !owned; + owned := [] diff --git a/lib/dynload_stubs.c b/lib/dynload_stubs.c new file mode 100644 index 0000000..a86d7eb --- /dev/null +++ b/lib/dynload_stubs.c @@ -0,0 +1,148 @@ +/* Loading a compiled macro into the compiler's own process. + * + * NEXT.md's expander design: there is no interpreter, so running a macro means + * compiling it and dlopening it. The reload primitive does exactly this + * already, but its host is a running Flan program written in C; here the host + * is the OCaml compiler, which has no dlopen of its own -- Dynlink loads + * OCaml, not ELF. So the boundary needs stubs, and this is all of them. + * + * Two rules shape what is here: + * + * - Nothing but pointers and scalars crosses. A Flan `string`/slice is + * {ptr,len} and a `Form` is {i32, [2 x i64]}, and LLVM's calling + * convention for an aggregate passed or returned *by value* in hand-written + * IR is not promised to be clang's C ABI for the equivalent struct. The + * unions lane verified memory layout, so memory is the agreement we have: + * every macro is reached through a thunk taking (ptr,i64,ptr,ptr) and + * writing its result through the out pointer. + * + * - The macro module is self-contained: it links the runtime in and has no + * undefined Flan symbols, so the OCaml executable needs no -rdynamic and + * nothing in it has to be exported. + * + * The peek/poke family is how the marshaller writes a Form image into memory + * the macro can read. OCaml cannot address raw memory, so the bytes are laid + * out from here one field at a time. + */ + +#include +#include +#include +#include + +#include +#include +#include +#include + +CAMLprim value flan_dl_open(value path) { + CAMLparam1(path); + void *h = dlopen(String_val(path), RTLD_NOW | RTLD_LOCAL); + if (!h) caml_failwith(dlerror()); + CAMLreturn(caml_copy_nativeint((intnat)h)); +} + +CAMLprim value flan_dl_sym(value handle, value name) { + CAMLparam2(handle, name); + void *p = dlsym((void *)Nativeint_val(handle), String_val(name)); + if (!p) caml_failwith(dlerror()); + CAMLreturn(caml_copy_nativeint((intnat)p)); +} + +CAMLprim value flan_dl_close(value handle) { + dlclose((void *)Nativeint_val(handle)); + return Val_unit; +} + +/* The one call shape a macro is reached through. See the thunk Emit writes. */ +typedef void (*flan_macro_fn)(void *args, int64_t n, void *out, void *xfer); + +CAMLprim value flan_macro_call(value fn, value args, value n, value out) { + CAMLparam4(fn, args, n, out); + /* The transfer channel every Flan signature carries (spec-conditions.md, + section 6). A macro that signals a condition with nothing above it to + handle it aborts inside the compiler, which is loud rather than silent; + the channel still has to be a real, zeroed slot. */ + int64_t xfer[4] = { 0, 0, 0, 0 }; + ((flan_macro_fn)Nativeint_val(fn))((void *)Nativeint_val(args), + Int64_val(n), + (void *)Nativeint_val(out), xfer); + CAMLreturn(Val_unit); +} + +CAMLprim value flan_mem_alloc(value n) { + CAMLparam1(n); + /* Zeroed, because ZII is the language's rule and an unwritten Form field + must read as the zero of its type rather than as whatever malloc had. */ + void *p = calloc((size_t)Long_val(n), 1); + if (!p) caml_failwith("out of memory laying out a macro's arguments"); + CAMLreturn(caml_copy_nativeint((intnat)p)); +} + +CAMLprim value flan_mem_free(value p) { + free((void *)Nativeint_val(p)); + return Val_unit; +} + +CAMLprim value flan_poke_i32(value p, value off, value x) { + int32_t v = (int32_t)Int32_val(x); + memcpy((char *)Nativeint_val(p) + Long_val(off), &v, 4); + return Val_unit; +} + +CAMLprim value flan_poke_i64(value p, value off, value x) { + int64_t v = Int64_val(x); + memcpy((char *)Nativeint_val(p) + Long_val(off), &v, 8); + return Val_unit; +} + +CAMLprim value flan_poke_f64(value p, value off, value x) { + double v = Double_val(x); + memcpy((char *)Nativeint_val(p) + Long_val(off), &v, 8); + return Val_unit; +} + +CAMLprim value flan_poke_ptr(value p, value off, value q) { + void *v = (void *)Nativeint_val(q); + memcpy((char *)Nativeint_val(p) + Long_val(off), &v, sizeof v); + return Val_unit; +} + +CAMLprim value flan_poke_bytes(value p, value off, value s) { + memcpy((char *)Nativeint_val(p) + Long_val(off), String_val(s), + caml_string_length(s)); + return Val_unit; +} + +CAMLprim value flan_peek_i32(value p, value off) { + int32_t v; + memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), 4); + return caml_copy_int32(v); +} + +CAMLprim value flan_peek_i64(value p, value off) { + int64_t v; + memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), 8); + return caml_copy_int64(v); +} + +CAMLprim value flan_peek_f64(value p, value off) { + double v; + memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), 8); + return caml_copy_double(v); +} + +CAMLprim value flan_peek_ptr(value p, value off) { + void *v; + memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), sizeof v); + return caml_copy_nativeint((intnat)v); +} + +CAMLprim value flan_peek_bytes(value p, value off, value n) { + CAMLparam3(p, off, n); + CAMLlocal1(s); + s = caml_alloc_string((mlsize_t)Long_val(n)); + memcpy((char *)Bytes_val(s), (char *)Nativeint_val(p) + Long_val(off), + (size_t)Long_val(n)); + CAMLreturn(s); +} diff --git a/lib/emit.ml b/lib/emit.ml index 5693c29..579998a 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -2431,10 +2431,48 @@ let finish m = ^ (if m.sanitize then "\nattributes #0 = { sanitize_address }\n" else "") ^ (match m.dbg with None -> "" | Some d -> dmodule d) +(* ── The macro boundary ────────────────────────────────────────────── *) + +(* One thunk per macro, and the only shape the compiler reaches a macro + through. A macro is [(defn name [args [Form]] Form)], so its own signature + takes a [%slice] by value and returns a [%"Form"] by value — and LLVM's + convention for an aggregate passed or returned by value in hand-written IR + is not promised to be clang's C ABI for the equivalent struct. The unions + lane verified the *memory* layout of a union against clang, which is a + different claim, so memory is the agreement that actually exists. + + So nothing but pointers and scalars crosses: + + void @"flan.macro.NAME"(ptr %args, i64 %n, ptr %out, ptr %xfer) + + The thunk builds the slice from (args, n) on this side of the boundary, + calls the macro, and stores the result through %out. Every aggregate stays + LLVM-to-LLVM, and the compiler's side is a four-pointer C call. *) +let macro_thunk m (fn : Tast.fn) = + let name = fn.Tast.name in + let ret = ll fn.Tast.ret in + Buffer.add_string m.out + (Printf.sprintf + "define void @%s(ptr %%args, i64 %%n, ptr %%out, ptr %%xfer) {\n\ + entry:\n\ + \ %%s0 = insertvalue %%slice zeroinitializer, ptr %%args, 0\n\ + \ %%s1 = insertvalue %%slice %%s0, i64 %%n, 1\n\ + \ %%r = call %s %s(%%slice %%s1, ptr %%xfer)\n\ + \ store %s %%r, ptr %%out\n\ + \ ret void\n\ + }\n\n" + (quoted ("flan.macro." ^ name)) + ret (fname name) ret) + (* [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. *) + [slice], a release build is told to drop them. + + [macros] names the functions that also get a thunk. It is a list of names + and not a flag because a macro module carries the whole prelude with it — + only the handful of functions that were written [defmacro] are reachable + from outside. *) let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = []) - ?(sanitize = false) (p : Tast.program) : string = + ?(sanitize = false) ?(macros = []) (p : Tast.program) : string = let m = new_module ~checks ~dev ~known:(fun _ -> true) ~debug ~sanitize 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 @@ -2459,6 +2497,12 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = []) (match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns with | Some fn -> emit_main m fn | None -> ()); + List.iter + (fun n -> + match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = n) p.Tast.fns with + | Some fn -> macro_thunk m fn + | None -> failwith ("no such macro: " ^ n)) + macros; finish m (* A list of top-level forms, compiled into their own module against a host diff --git a/lib/prelude.ml b/lib/prelude.ml index f6d32c0..c2470ce 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -822,6 +822,97 @@ let source = {flan| ;; said). (defconst file-unsupported i32 4) +;; ── Form: what a macro takes and what it answers ────────────────────── +;; +;; The reader's output, mirrored on the Flan side, because a macro is a +;; function [Form] -> Form and there is no interpreter: running one means +;; compiling it and dlopening it into the compiler. So the compiler and the +;; loaded macro have to agree on the *layout* of a Form, not merely on its +;; shape. lib/form.ml is the other half of this declaration and the two are +;; edited together. +;; +;; It mirrors Form.value and not Form.t: there is no `loc` field. A macro +;; cannot invent a source location and should not carry one, so the compiler +;; stamps the *call site's* location onto every node of what a macro returns. +;; That is the structural version of "keep the source location of the call +;; site attached to what a macro produces", and it is what the queued +;; structured-error work will read. +;; +;; Case order is the tag order (BUILT.md, unions), so this list is a layout +;; contract with lib/expand.ml's marshaller and may not be reordered. +(defunion Form + [(Sym [s string]) + (Kw [s string]) + (Int [i i64]) + (Float [x f64]) + (Str [s string]) + (Byte [b i32]) + (List [xs [Form]]) + (Vec [xs [Form]]) + (Map [xs [Form]])]) + +;; The list-building surface quasiquote desugars into. Three functions and no +;; more: `form-nil` starts one, `form-cons` puts a form on the front, and +;; `form-append` is what ~@ splices with. Everything else — a vector literal, +;; a length, an index — is already the language's. +;; +;; Each allocates a fresh (Vec Form) and hands back a borrow of it that +;; outlives the call. That is a leak, on purpose: a macro runs inside the +;; compiler, its result is read after it returns, and the whole expansion is +;; bounded by the size of the program being compiled. `drop` is what would +;; change this, and it does not exist. +(defn form-nil [] [Form] + (let [v (vec-new Form)] + (as-slice v))) + +(defn form-cons [x Form rest [Form]] [Form] + (let [v (vec-new Form)] + (push v x) + (dotimes [i (len rest)] + (push v (at rest i))) + (as-slice v))) + +(defn form-append [a [Form] b [Form]] [Form] + (let [v (vec-new Form)] + (dotimes [i (len a)] + (push v (at a i))) + (dotimes [i (len b)] + (push v (at b i))) + (as-slice v))) + +;; The rest of a macro's arguments, which is what a variadic body is: a macro +;; takes one parameter, the slice of the forms at its call site. +(defn form-rest [xs [Form] from i32] [Form] + (let [v (vec-new Form) + i from] + (while (< i (len xs)) + (push v (at xs i)) + (set i (+ i 1))) + (as-slice v))) + +;; A name no reader can produce. `~` is a delimiter now (it opens an unquote), +;; so no symbol coming out of read_all can contain one, and a gensym therefore +;; cannot collide with a name someone wrote. Non-hygienic expansion with an +;; explicit gensym is the settled decision (plan.org, open decision 2); this is +;; the escape hatch that makes it liveable. +;; +;; The counter lives in the loaded module rather than in the compiler, which is +;; the one place this departs from NEXT.md's sketch. A module is dlopened once +;; per compiler process and every macro in a program shares it, so the counter +;; is process-wide in practice; a second module would restart it, and the day +;; there is one, the fix is to seed this from the module's index. +(defvar gensym-n i64 0) + +(defn gensym [] Form + (set gensym-n (+ gensym-n 1)) + (let [v (vec-new u8)] + (push v 126) ; ~ + (push v 103) ; g + (let [d (i64->bytes gensym-n)] + (dotimes [i (len d)] + (push v (at d i)))) + (Form.Sym {.s (string (as-slice v))}))) + |flan} let file = ""