flan/lib/macro.ml
Joseph Ferano a2004ae7a6 One macro call, several declarations, and a refusal that carries a sentence
A type provider produces a struct and a reader over it, and a struct per
nesting level in the data. Expansion is form-for-form, so one call could only
ever become one declaration — which was enough while every macro expanded to an
expression. A top-level (do ...) is now its items, spliced in place, after
expansion and before the declaration walk. Nobody writes one in a file, and the
single-declaration entry point says so by name for anyone who tries.

And (compile-error "...") is what a macro expands to when it has to refuse. The
prelude's `unless` records the gap: a macro has no error facility, so a
malformed call answers a name nothing defines and the report is the right place
with the wrong sentence. A name carries a name. A type provider's refusals are
all sentence — the third element of this vector is a string where the first two
were integers, at line 3 column 9 of a file the compiler is not reading — and
no symbol an expansion could invent holds that. Loc.from_macro already stamps
the call site onto the expansion, so the location is the form the author wrote.

A builtin because it has to fail while checking: a declared function would
compile, link and run, and the compile it was meant to stop would have
succeeded.
2026-09-19 05:43:51 +07:00

585 lines
29 KiB
OCaml

(** Running a macro: the half of expansion that has to compile something.
[Expand] is the image format, the quasiquote desugaring and the marshaller,
and it depends on nothing above [Form]. This file is the part that cannot:
expanding a macro means compiling it and dlopening it, so it needs [Check],
[Build] and [Emit], and it therefore sits above the parser it feeds. The
join is [Parse.expander], filled in at the bottom of this file. *)
(* ── Which names are macros ────────────────────────────────────────
A [defmacro] is an [Ast.Defn] by the time [Parse] is finished with it, so
the word only survives in the form and collecting them is a scan of the top
level. It is the prelude's macros, the file's own, and an imported
package's.
The third of those does not arrive by scanning anything here. [Load] is the
one thing that knows what a package is called from outside, and it now hands
its answer over in [Parse.imported_macros] — qualified under the alias and
desugared — so this file's only new job is to put that set in the same pot
as the other two. See the header of [Load.import]. *)
let macro_name (f : Form.t) =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym "defmacro"; _ }
:: { Form.v = Form.Sym n; _ } :: _) -> Some n
| _ -> None
let macros_in forms = List.filter_map macro_name forms
(* Does this form call one of these macros? A head position only, which is what
a call is, and it is why the quasiquote desugaring has to have run first: a
quasiquoted (cond ...) is a (Form.Sym {.s "cond"}) by now, and the name is a
string in an argument rather than a head anything could mistake. *)
let rec names_macro (known : string list) (f : Form.t) =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym n; _ } :: rest) ->
List.mem n known || List.exists (names_macro known) rest
| Form.List xs | Form.Vec xs | Form.Map xs ->
List.exists (names_macro known) xs
| _ -> false
(* ── The module ────────────────────────────────────────────────────
The prelude plus the file's defmacros, and not the file's own functions.
Compiling those 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.
Cached on disk under the object cache, keyed by a digest of exactly what
goes into it. Every `flan build` is a fresh process, so without this the
clang driver would be paid once per build of the same program instead of
once per change to it. *)
type loaded = {
handle : Dynload.handle;
fns : (string * Dynload.addr) list;
}
(* This compiler's own identity, and it belongs in the key for a reason the
other caches do not have. A [.o] under the object cache is decided entirely
by the C text and the C compiler that made it, so its key is total without
naming flan at all. A macro module is not: it is *this* binary's codegen,
dlopen'd back into *this* binary and called across a marshalled boundary.
Change [Emit] or the runtime ABI and the .so on disk is wrong while the
prelude text that keyed it has not moved — a stale macro expander, which
fails as a crash inside [Expand.call] rather than as a compile error.
It never showed because the cache sat under dune's per-run [TMPDIR] and so
was empty on every run. Now that the cache outlives the run, the key has to
carry what the directory used to hide.
The stamp of the running binary is the identity, except in the one place
where that binary is not a stable thing: a [flan dev] merged build lives at
/tmp/flan-dev-<pid>/program, so its size-and-mtime is new on every start and
keying on it would rebuild a macro module per session — measured at ~350ms
of every dev start, which is most of what this cache exists to save. So
[Dev.start_merged] passes its own stamp across the exec, and the merged
binary uses the stamp of the compiler that built it, which is the one this
key is actually about. *)
let self =
lazy
(match Sys.getenv_opt "FLAN_COMPILER_STAMP" with
| Some s when s <> "" -> s
| _ -> Build.stamp_of Sys.executable_name)
(* [support] is in the key for the same reason the prelude's text is: it is
compiled into the module, so a package whose functions changed while its
macros did not is a stale [.so] that the extras alone would not notice.
[Marshal] and not a printer, because [Ast] has no printer and one written
for a cache key would be a second rendering of the tree to keep in step with
the first. The declarations are plain data — variants, strings, floats and
locations, no closures and no abstract blocks — so the image is structural,
and it moves when a location does. That direction is the safe one: a
cosmetic edit above a package's functions costs a rebuild of the module, and
nothing costs a stale one. *)
let key ?(support = []) (extra : Form.t list) =
Digest.to_hex
(Digest.string
(Lazy.force self ^ "\000" ^ Prelude.source ^ "\000"
^ String.concat "\000" (List.map Form.to_string extra)
^ "\000"
^ (if support = [] then "" else Marshal.to_string support [])))
(* True while a macro module is being built. [Build.macro_module] goes through
[Check.program], which parses the prelude, which calls back into
[Parse.program] — and that would re-enter this and recurse forever. Nothing
is lost by refusing to expand there: a macro compiled in round n calls only
macros compiled in rounds before it, and those calls were already expanded
before the build was entered. *)
let building = ref false
(* ── The bootstrap, and what a prelude macro may not call ───────────
[Check.program] prepends the prelude to every program, this one included, so
the module that expands the prelude's macros is compiled *from* the prelude.
A prelude function that calls a macro therefore cannot be compiled into it:
the call is a name nothing defines yet. That is a cycle and not an ordering
mistake — no amount of moving the prepend around removes it.
It is broken at one level, which is the restriction already recorded and
kept: a macro module is built from the prelude with every [defn] that
depends on a macro *removed*. Directly or transitively, because a function
calling a dropped one is as unbuildable as the dropped one itself.
Only [defn]s are dropped. A [defstruct], [defdata], [defalias], [defenum]
or [defvar] stays whatever it names: the functions that survive still
mention those types, and a reduced prelude missing them would not check.
There used to be a sharper reason — [Parse.prelude_types] memoised the
prelude's type names for the parser's return-type guess, and a reduced
answer cached during a bootstrap build would have been wrong for every
compile after it. That set is gone with the guess: a defn states its return
type, so nothing in the parser asks what the prelude declares.
A [defmacro] that lands in the dropped set is the violation of the rule, and
it is refused here by name rather than reaching clang as an unknown symbol. *)
let head_name (f : Form.t) =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym h; _ } :: { Form.v = Form.Sym n; _ } :: _) ->
Some (h, n)
| _ -> None
let reduce (forms : Form.t list) : Form.t list =
let macros = macros_in forms in
(* Fixpoint: a form is out once it names something already out. Bounded by
the number of forms, since the set only grows. *)
let out = ref macros in
let changed = ref true in
while !changed do
changed := false;
List.iter
(fun f ->
match head_name f with
| Some (("defn" | "defmacro"), n) when not (List.mem n !out) ->
if names_macro !out f then begin out := n :: !out; changed := true end
| _ -> ())
forms
done;
(* The macros themselves are in [out] by construction; a macro that is there
for any *other* reason called one, which is the thing that cannot work. *)
List.iter
(fun f ->
match head_name f with
| Some ("defmacro", n) when names_macro macros f ->
Loc.fail f.Form.loc
"the prelude macro %s calls a macro, and a prelude macro may not: \
the module that expands it is compiled from the prelude, so the \
call would have to be expanded by a module that does not exist \
yet. Call a function instead"
n
| _ -> ())
forms;
List.filter
(fun f ->
match head_name f with
| Some ("defn", n) -> not (List.mem n !out)
| _ -> true)
forms
(* ── What a package's macro may call ────────────────────────────────
The header above says a macro body may call prelude functions and other
macros and nothing else, and for a macro written in a *package* that was the
machinery missing a piece rather than a rule. [Load.qualify_macro] renames
the body so a call to the package's own [next] reads [edn/next] — it says
the intent plainly — and the module was then compiled without anything of
that name in it, so the call arrived at the checker as "the call edn/next
into an imported package".
So [Parse.imported_decls] carries the package's declarations beside its
macros, already qualified, and they go into the module. Trimmed to what the
macros actually reach, for two reasons that are both about programs whose
macros want none of this: raylib's five [with-*] are pure quasiquote, so
nothing of raylib is reachable and the module is the one it always was — and
raylib's declarations are [declare]s against a library this link has no
argument for, so a module that took the whole package would fail to link
for every program that draws anything.
Reachability over names and not over [Reach]'s checked program, because the
trim has to happen *before* [Check]: an [Ast.Declare] that survived into the
module would be emitted whether or not the checker was ever asked about it.
A type is reached the same way a function is — [Load.uses] walks signatures
and bodies alike — which is what keeps [edn/Cursor] in when [edn/next] is. *)
let support (roots : string list) (ds : Ast.decl list) : Ast.decl list =
if ds = [] then []
else begin
let want = Hashtbl.create 64 in
List.iter (fun n -> Hashtbl.replace want n ()) roots;
(* Fixpoint over the declarations, since a kept one names more. Bounded by
their number: the set only grows and a pass that adds nothing stops. *)
let changed = ref true in
while !changed do
changed := false;
List.iter
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n when Hashtbl.mem want n ->
List.iter
(fun (u, _) ->
if not (Hashtbl.mem want u) then begin
Hashtbl.replace want u ();
changed := true
end)
(Load.uses [ d ])
| _ -> ())
ds
done;
List.filter
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n -> Hashtbl.mem want n
| None -> false)
ds
end
(* The names a macro's text mentions, which is the root set above. Every symbol
in the body, because a macro body reaches a package's names as calls, as
types in a [let]'s initialiser and as data-type cases — and over-rooting only
ever keeps a declaration that would have compiled anyway. *)
let roots_of (extra : Form.t list) =
List.fold_left (fun acc f -> Load.form_syms f acc) [] extra
let compile (names : string list) (extra : Form.t list) : loaded =
(* The macros themselves are in [imported_decls] too — a [defmacro] is an
[Ast.Defn] by the time [Parse] is finished with it, and [Load] qualifies
and carries it like any other declaration. They arrive here a second time
in [extra], which is where their *current* text is, so the copy in the
support set is dropped rather than reaching the checker as a name defined
twice. Current matters: a session that has just re-evaluated a macro holds
the new body in [macros] and the old one in [decls]. *)
let support =
List.filter
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n -> not (List.mem n names)
| None -> true)
(support (roots_of extra) !Parse.imported_decls)
in
let out =
Filename.concat (Build.cachedir ())
("flan-macros-" ^ key ~support extra ^ ".so")
in
if not (Sys.file_exists out) then begin
building := true;
Prelude.bootstrap := reduce;
Fun.protect
~finally:(fun () ->
building := false;
Prelude.bootstrap := (fun fs -> fs))
(fun () ->
(* [Check.program] prepends the prelude itself — reduced, for the one
build that cannot have all of it — so only the file's own defmacros
and the package declarations they reach go in here.
The support comes first: it holds the types a macro's signature
names, and a declaration order that mentioned [edn/Cursor] before
declaring it would be refused for a reason that is this line's and
not the author's. *)
let p = Check.program (support @ Parse.program extra) in
(* Written beside the final name and renamed, so a second process
reading the cache never sees a half-written object. *)
let tmp = out ^ "." ^ string_of_int (Unix.getpid ()) in
ignore (Build.macro_module ~macros:names p ~out:tmp);
(try Sys.rename tmp out with Sys_error _ -> ()))
end;
let handle = Dynload.dl_open out in
{ handle;
fns = List.map (fun n -> (n, Dynload.dl_sym handle ("flan.macro." ^ n))) names }
(* ── Where the call site is ────────────────────────────────────────
The one thing a macro cannot find out for itself and the one it needs to
read a data file: a Form carries no location — deliberately, see
[Expand.unmarshal] — so a macro handed [(defedn T "assets/x.edn")] knows the
path and not what it is relative to. [(embed "assets/x.edn")] resolves
against the directory of the source file the form is written in, and a macro
reading a file has to resolve it the same way or a package's data would
depend on where flan was invoked from.
So it is poked in before the call, into the two C symbols the module's own
[flan_rt.c] declares for it. C data and not a Flan global because
[Build.macro_module] emits with hidden visibility and only the
[flan.macro.*] thunks stay exported — the same comment's other half is that
the C goes on resolving the way it always did, which is what makes these two
findable.
Set per call rather than once per module: one expansion walks the prelude's
forms, the file's own and a package's, and a macro called from a package's
source resolves against *that* file's directory. [Filename.dirname] is
[embed_path]'s own move, and an empty answer — a bare filename with no
directory in it — leaves the length at zero, which the runtime reads as "no
better idea than the process's own directory". *)
let dir_of (l : loaded) (loc : Loc.t) =
let dir = Filename.dirname loc.Loc.file in
let dir = if String.equal dir "." then "" else dir in
(* Not guarded. The symbol is in the module this just built, so its absence
means [runtime/flan_rt.c] and this file have come apart — and the shape
that failure would take if it were swallowed is a relative path resolving
against the compiler's working directory, which reads some *other* file
and says nothing. A missing symbol raises out of [dl_sym] instead. *)
let buf = Dynload.dl_sym l.handle "flan_macro_dir" in
let n = Dynload.dl_sym l.handle "flan_macro_dir_n" in
(* 4096 is FLAN_PATH_MAX, and a path at or over it is left unset rather than
truncated: half a directory is a path that resolves to the wrong file,
where none at all resolves to none. *)
if String.length dir > 0 && String.length dir < 4096 then begin
Dynload.poke_bytes buf 0 dir;
Dynload.poke_i64 n 0 (Int64.of_int (String.length dir))
end
else Dynload.poke_i64 n 0 0L
(* ── The walk ──────────────────────────────────────────────────────
Bottom up: a macro's arguments are expanded before it is called, so nothing
a macro is handed contains a call to another macro. Then what it answers is
expanded again, because a macro that expands into a call to itself — which
is what a recursive [cond] is — has to keep going.
That re-expansion is what needs a bound. [(defmacro loop [args] `(loop))]
settles at nothing, and the honest answer to a macro that will not settle is
to say which one it was, at the call site, rather than to run out of
memory. *)
let fuel = 200
let rec expand_form (l : loaded) (f : Form.t) : Form.t =
let loc = f.Form.loc in
match f.Form.v with
| Form.List ({ Form.v = Form.Sym n; _ } :: args) when List.mem_assoc n l.fns ->
let args = List.map (expand_form l) args in
(* The call site, tagged with the macro it is a call to. [Expand.unmarshal]
stamps this onto every node the macro answers with, so from here down
every form it produced knows where it came from and an error on one of
them can say so. *)
let from = Loc.from_macro n loc in
dir_of l loc;
settle l n loc (Expand.call ~loc:from (List.assoc n l.fns) args) fuel
| Form.List xs -> Form.make (Form.List (List.map (expand_form l) xs)) loc
| Form.Vec xs -> Form.make (Form.Vec (List.map (expand_form l) xs)) loc
| Form.Map xs -> Form.make (Form.Map (List.map (expand_form l) xs)) loc
| _ -> f
and settle l first loc (f : Form.t) left =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym m; _ } :: args) when List.mem_assoc m l.fns ->
if left <= 0 then
Loc.fail loc
"expanding %s did not settle after %d rounds — a macro that expands \
into a call to a macro has to get smaller each time, and this one is \
not"
first fuel
else begin
let args = List.map (expand_form l) args in
let from = Loc.from_macro m loc in
dir_of l loc;
settle l first loc (Expand.call ~loc:from (List.assoc m l.fns) args)
(left - 1)
end
(* Settled at the head. The rest of it may still hold macro calls — a cond
expands to an if whose else-branch is another cond — so the ordinary walk
finishes the job. *)
| _ -> expand_form l f
(* ── The rounds ────────────────────────────────────────────────────
A macro's body may call a macro, so one sweep is not enough: a macro with an
unexpanded call in its body cannot be compiled at all, because that call is
a name nothing defines.
So the module is built in rounds. Round 0 takes every macro whose body names
no macro that is still waiting. Round 1 expands what is left against round
0's module and takes whatever became clean. A round that takes nothing while
macros remain is a cycle, and it is named rather than looped on.
The prelude's own macros are in every round by construction — they are in
every module this builds — so a prelude macro may not call a macro. It would
fail to compile with an unknown name rather than with a reason, which is
worth fixing the day the prelude wants one. *)
let rounds ~(prelude : string list) (pending : (string * Form.t) list)
: (string * Form.t) list =
let rec go ~taken ~pending =
if pending = [] then taken
else
let waiting = List.map fst pending in
let now, blocked =
List.partition (fun (_, f) -> not (names_macro waiting f)) pending
in
if now = [] then
Loc.fail (snd (List.hd pending)).Form.loc
"these macros call each other and none can be compiled first: %s. A \
defmacro has to be compiled before the call it expands, so a ring \
has no order to be compiled in — one of them has to call a function \
instead"
(String.concat ", " waiting)
else
let taken = taken @ now in
(* Nothing is waiting on this round, so there is nothing to expand it
against and no module to build here. The common case is this one:
every macro in the file is clean and round 0 is the only round. *)
if blocked = [] then taken
else begin
let l = compile (prelude @ List.map fst taken) (List.map snd taken) in
let blocked = List.map (fun (n, f) -> (n, expand_form l f)) blocked in
Dynload.dl_close l.handle;
Dynload.release ();
go ~taken ~pending:blocked
end
in
go ~taken:[] ~pending
(* ── The whole pass ────────────────────────────────────────────────── *)
(* Read once. The prelude is a constant string, and asking whether a file uses
a macro would otherwise re-read the whole of it on every parse. *)
let prelude_macros = lazy (macros_in (Prelude.forms ()))
(* The module the forms below will be expanded against, or [None] when there is
nothing to expand them with.
Split out of [program] rather than copied into the editor's path, because
everything in it is a decision with a paragraph attached — which names are
ambient, which shadow which, and the shortcut that keeps a macro-free build
free of a clang driver. Two copies of that would drift, and the second copy
is the one a reader would not know to distrust. [program] below is the whole
of what used to be here; [expand_step] and [expand_all] are the editor's. *)
let loaded_for (forms : Form.t list) : loaded option =
if !building then None
else
let prelude = Lazy.force prelude_macros in
(* The prelude's own macros are dropped from [mine], and the reason is that
these forms may *be* the prelude: [Check.program] prepends it, so a
prelude macro handed back as [extra] would be declared twice and refused
as a redefinition. They are already in [prelude], which is where the
module gets them from. *)
let mine =
List.filter_map
(fun f ->
match macro_name f with
| Some n when not (List.mem n prelude) -> Some (n, f)
| _ -> None)
forms
in
(* An import's macros, and they go in beside [mine] rather than beside
[prelude]: a package macro may call another macro of its own package, so
it is exactly as much a candidate for the rounds below as one written
here.
This used to say that an import's names carry a slash, so nothing
ambient could collide with a name written here. That stopped being true
when a session started holding the buffer's own [defmacro]s — see
[Session.eval] — and it stopped being true on the most ordinary action
there is: [C-c C-c] over a [defmacro] the session already knows sends a
form declaring a name the ambient set also has. Two forms declaring one
name reach [Check.program] as a duplicate declaration, refused with a
sentence nobody would connect to this.
So the merge dedupes, and the direction is the one [Load.macro_union]
already uses a level up: a name declared in the forms being parsed
shadows the ambient copy. That is also what makes an *edited* macro
expand with its new body rather than with the session's stale one. *)
let imported =
List.filter_map
(fun f -> Option.map (fun n -> (n, f)) (macro_name f))
!Parse.imported_macros
in
let imported =
List.filter (fun (n, _) -> not (List.mem_assoc n mine)) imported
in
let mine = imported @ mine in
let all = prelude @ List.map fst mine in
(* The common case by a wide margin, and the reason a build that uses no
macro pays nothing: a file that calls none costs one scan and no
compiler. Without it every build in the suite would link a macro module
for the prelude's macros and pay a clang driver to answer nothing. *)
if all = [] || not (List.exists (names_macro all) forms) then None
else begin
let extra = rounds ~prelude mine in
Some (compile all (List.map snd extra))
end
(* Closing the handle and freeing the marshaller's scratch, on the way out of
an expansion however it ends.
[Fun.protect] and not two statements after the call, which is what this was
while a build was the only caller: a build that raised was a compile that
failed and a process about to exit, so a leaked handle and a few unfreed
argument buffers cost nothing anybody could measure. The daemon is not that
process. A macro that does not settle raises out of here, the editor is told
and stays connected, and the next [C-c C-m] does it again — so the one thing
[Dynload.owned] must not become is a list that only ever grows over a
session's lifetime. *)
let with_module (l : loaded) (f : unit -> 'a) : 'a =
Fun.protect
~finally:(fun () ->
Dynload.dl_close l.handle;
Dynload.release ())
f
let program (forms : Form.t list) : Form.t list =
match loaded_for forms with
| None -> forms
| Some l -> with_module l (fun () -> List.map (expand_form l) forms)
let () = Parse.expander := program
(* ── What the editor asks ──────────────────────────────────────────
[C-c C-m]. Two questions and not one, because a macro that quasiquotes a
call to another macro makes the difference real: [mac/quad] answers
[(mac/twice (mac/twice n))], and the fixpoint of that says nothing about
which macro produced what.
Both answer the name at the head when it is a macro, so the editor can say
*which* macro it just ran rather than only that something changed. That name
is the one thing the printed text cannot carry: [Loc.from_macro] is
outermost-wins, so every node of a full expansion is stamped with the macro
the author wrote and the intermediate names are gone by the time it settles.
One step is outermost-only, and that is a deliberate difference from
[expand_form], which expands a call's arguments *before* calling it. So
[(mac/twice (mac/twice 1))] one-stepped here is [(+ (mac/twice 1)
(mac/twice 1))], where the compiler's own first move is [(mac/twice (+ 1
1))]. Different intermediates, the same fixpoint. One step is a view of what
this macro did; all the way is the answer the compiler acts on. *)
let head_macro (l : loaded) (f : Form.t) : string option =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym n; _ } :: _) when List.mem_assoc n l.fns ->
Some n
| _ -> None
(** One round of the outermost call, or the form unchanged when its head does
not name a macro. Nothing here needs the fuel [settle] carries: one call is
one call, and what it answers is not looked at again. *)
let expand_step (f : Form.t) : Form.t * string option =
match loaded_for [ f ] with
| None -> (f, None)
| Some l ->
with_module l (fun () ->
match f.Form.v with
| Form.List ({ Form.v = Form.Sym n; _ } :: args)
when List.mem_assoc n l.fns ->
(* [C-c C-m] over a type provider reads the data file, which is the
whole of what makes the live loop live: edit the .edn, expand
again, see the struct that file now implies. *)
dir_of l f.Form.loc;
( Expand.call ~loc:(Loc.from_macro n f.Form.loc) (List.assoc n l.fns)
args,
Some n )
| _ -> (f, None))
(** To the fixpoint, through exactly the walk a build goes through — so the
text this answers is the text the checker is about to be handed, and the
refusals are the build's own. A macro that does not settle raises
[Loc.Error] out of [settle] at the bound, and a ring was refused a level up
in [rounds] before anything was compiled at all. *)
let expand_all (f : Form.t) : Form.t * string option =
match loaded_for [ f ] with
| None -> (f, None)
| Some l ->
with_module l (fun () ->
(* The name is read off the *input*, so it has to be taken before the
walk replaces it. Bound rather than written as a tuple: OCaml does
not promise the order a tuple's components are evaluated in, and
[Dev.serve] already carries a comment about the one place that bit.
Here it would be silent — the wrong macro named, never an error. *)
let name = head_macro l f in
(expand_form l f, name))