diff --git a/lib/load.ml b/lib/load.ml index e95b073..44a6357 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -926,12 +926,17 @@ let rec import ~seen ~open_ ~loc alias dir = let nested_macros = List.fold_left (fun acc r -> macro_union acc r.macros) [] nested in + (* Beside the macros, what those macros may call — see the note over + [Parse.imported_decls]. The same set the package's own files are checked + against, so a macro of a package this one imports is compiled against + exactly what its author could see. *) + let nested_decls = List.concat_map (fun r -> r.decls) nested in (* The package's own files, parsed with what it imported in front of them and nothing else. A parent's macros are deliberately not here: this package did not import that parent, and a name it never asked for is not one it should be able to call. *) let ds = - Parse.with_imported nested_macros + Parse.with_imported ~decls:nested_decls nested_macros (fun () -> List.concat_map (fun (_, forms) -> Parse.program forms) sources) in (* [main] is the importer's, always. A package that called its own would @@ -1280,7 +1285,8 @@ let program ?(parse = Parse.program) ~file (forms : Form.t list) : t = (imports_of forms) in let decls = - Parse.with_imported (macro_union imported.macros !Parse.imported_macros) + Parse.with_imported ~decls:(imported.decls @ !Parse.imported_decls) + (macro_union imported.macros !Parse.imported_macros) (fun () -> parse forms) in let t = diff --git a/lib/macro.ml b/lib/macro.ml index 26de4f2..1653a20 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -82,11 +82,23 @@ let self = | Some s when s <> "" -> s | _ -> Build.stamp_of Sys.executable_name) -let key (extra : Form.t list) = +(* [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))) + ^ 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 @@ -163,9 +175,88 @@ let reduce (forms : Form.t list) : Form.t list = | _ -> 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 extra ^ ".so") + Filename.concat (Build.cachedir ()) + ("flan-macros-" ^ key ~support extra ^ ".so") in if not (Sys.file_exists out) then begin building := true; @@ -177,8 +268,13 @@ let compile (names : string list) (extra : Form.t list) : loaded = (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 - go in here. *) - let p = Check.program (Parse.program extra) in + 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 @@ -189,6 +285,45 @@ let compile (names : string list) (extra : Form.t list) : loaded = { 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 + match Dynload.dl_sym l.handle "flan_macro_dir" with + | exception _ -> () + | buf -> + 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 @@ -212,6 +347,7 @@ let rec expand_form (l : loaded) (f : Form.t) : Form.t = 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 @@ -230,6 +366,7 @@ and settle l first loc (f : Form.t) left = 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 @@ -416,6 +553,10 @@ let expand_step (f : Form.t) : Form.t * string option = 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 ) diff --git a/lib/parse.ml b/lib/parse.ml index b1007c8..2d519db 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -1188,10 +1188,40 @@ let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs) whole of an evaluation. Empty is the ordinary case and costs nothing. *) let imported_macros : Form.t list ref = ref [] -let with_imported (ms : Form.t list) (f : unit -> 'a) : 'a = +(* What those macros are allowed to *call*, and it is the same list the + importing program gets: the package's declarations, qualified under the + alias, as [Load] already built them. + + A macro module is compiled from the prelude plus the [defmacro]s, so until + now the header's rule held without anything enforcing it — a macro body + could call prelude functions and other macros and nothing else. A package + macro that called one of its own package's functions was renamed to + [alias/fn] by [Load.rename_form], reached the checker with nothing of that + name declared, and was refused as a call into an imported package. + + That refusal was the machinery missing a piece rather than a rule. The + rename says the intent plainly: what a package's macro answers with, and + what its body calls, is spelled the way the importer spells it. So the + declarations travel beside the macros and go into the module with them. + [Macro.compile] prunes them to what the macros actually reach, so a package + whose macros are pure quasiquote — raylib's five [with-*] — pays nothing and + links nothing new. + + An [Ast.decl list] and not forms, because [Load] has already done the + qualifying over the Ast and a second renamer over [Form] would be that work + written twice, in the file where the two copies could disagree silently. *) +let imported_decls : Ast.decl list ref = ref [] + +let with_imported ?(decls = []) (ms : Form.t list) (f : unit -> 'a) : 'a = let saved = !imported_macros in + let saved_decls = !imported_decls in imported_macros := ms; - Fun.protect ~finally:(fun () -> imported_macros := saved) f + imported_decls := decls; + Fun.protect + ~finally:(fun () -> + imported_macros := saved; + imported_decls := saved_decls) + f (* Two entry points and not one function with a flag, and the reason is the daemon. [Loc.Errors] is a second exception, and the handlers in the session diff --git a/lib/prelude.ml b/lib/prelude.ml index 95b5759..4bef62e 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -1794,6 +1794,41 @@ let source = {flan| (let [n (i64 0)] (if (= (file-stat-raw path (addr n)) 1) (Some n) None))) +;; ── Reading a file while a macro runs ───────────────────────────────── +;; +;; The one thing a macro needed that it could not write for itself. A macro is +;; compiled and dlopened into the compiler, so `slurp` was always callable from +;; one; what was missing is that a macro has no idea where its call site is, +;; and so no way to resolve a path the way `(embed "assets/x.edn")` resolves +;; one — relative to the directory of the source file the form is written in. +;; +;; This is that rule, and it is the *same* rule: the compiler pokes the call +;; site's directory into the runtime before every expansion (runtime/flan_rt.c, +;; "Reading a file while a macro runs", and lib/macro.ml's expand_form), and a +;; relative path is joined to it. An absolute path is taken as written. +;; +;; **None rather than a condition**, which is the whole reason this is not +;; `slurp`. A condition signalled inside an expansion is signalled *in the +;; compiler*, through the macro module's own copy of the runtime, and that is +;; the failure `Build.macro_module`'s hidden-visibility note measured: it takes +;; the process down instead of parking it. Absence arriving as an answer is +;; what lets a type provider say "there is no file at that path" as a refusal +;; with a location, which is the sentence its author wanted anyway. +;; +;; **Outside a macro it is still a read**, with the path relative to the +;; process rather than to any source file — nothing else knows better, and +;; every program links this runtime. It is not a file API and `slurp` is; this +;; exists so a macro can look at data at compile time. +(declare macro-slurp-raw [path string out-len (Ptr i64)] (Ptr u8) + "flan_macro_slurp") + +(defn macro-slurp [path string] (Option [u8]) + (let [n (i64 0) + p (macro-slurp-raw path (addr n))] + (if (< n 0) + None + (Some (slice-from-ptr p (i32 n)))))) + ;; ── Form: what a macro takes and what it answers ────────────────────── ;; ;; The reader's output, mirrored on the Flan side, because a macro is a diff --git a/lib/session.ml b/lib/session.ml index 230158c..a119ffe 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -122,6 +122,32 @@ let create ?(debug = false) ?(x86 = false) ~file () = macros = Load.macro_union (own_macros forms) l.Load.macros; thunks = 0; debug; x86 }, l) +(* What a macro may call, for the same reason [macros] is held: an evaluation + parses one form with no import in sight, and a package macro whose body + calls its own package's functions has to find them. [Load.program] hands + this to [Parse.with_imported] from the import it just read; a session has to + answer it from what it already holds. + + Filtered out of [decls] by ownership rather than kept as a second list, + because [decls] is the one thing every redefinition already maintains and a + parallel copy would be a second thing to remember to update. A package's + names are qualified in there — that is what "post-Load: flat, one namespace" + means — so the prefix is the whole test. + + The buffer's own declarations are deliberately not here. A macro module is + built from the prelude with no part of the file in it (see [Macro.reduce]'s + header, and the cycle it is about), and a session's [decls] is the file. *) +let package_decls t = + List.filter + (fun (d : Ast.decl) -> + match Ast.declared_name d with + | Some n -> + List.exists + (fun (p : Load.pkg) -> String.starts_with ~prefix:(p.Load.alias ^ "/") n) + t.pkgs + | None -> false) + t.decls + (* Which package a file being edited belongs to, if any. A form typed into vendor/agent/agent.flan declares [poll], but the running @@ -480,7 +506,7 @@ let restore t h = let eval ?(origin = "") ?pause t src : change = let forms = Reader.read_all ~file:origin src in - Parse.with_imported t.macros @@ fun () -> + Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () -> (* Through [Load] like any other source, so an evaluated (import ...) means what it means in a file. Its expansion is what gets spliced, which is also why the accumulated list is the post-Load one: re-evaluating a file that @@ -1296,7 +1322,7 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = untouched: a cold macro module costs its ~300ms before that clock starts, and the non-termination refusals raise [Loc.Error] out of this call, which the daemon already answers as an error rather than a silence. *) - let parsed = Parse.with_imported t.macros (fun () -> Parse.expr form) in + let parsed = Parse.with_imported ~decls:(package_decls t) t.macros (fun () -> Parse.expr form) in (* Wrapped before the checker, so the call is checked like any other and a prelude that stopped offering [pause] would be an ordinary unknown name rather than a thunk that silently did not stop. The [Do] takes the @@ -1440,7 +1466,7 @@ let macroexpand ?(origin = "") ~(all : bool) t (src : string) : expansion let before = Expand.quasiquote form in (* And the session's macros in front of it, as [eval] and [eval_expr] both put them: [Macro.program] reads [Parse.imported_macros] directly. *) - Parse.with_imported t.macros @@ fun () -> + Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () -> let after, name = if all then Macro.expand_all before else Macro.expand_step before in diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 53b4bfc..6f24396 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -2957,6 +2957,88 @@ const uint8_t *flan_getenv(const uint8_t *name, int64_t n, int64_t *len) { return (const uint8_t *)v; } +/* ── Reading a file while a macro runs ───────────────────────────────── + * + * A macro is compiled and dlopened into the compiler, so it is ordinary native + * code and could always have called `slurp`. What it could not do is resolve a + * path the way the rest of the language resolves one. (embed "assets/x.edn") + * is relative to the directory of the *source file the form is written in* — + * lib/check.ml's embed_path, and Odin's rule before it — because anything else + * makes a package's assets depend on where flan happened to be invoked from. + * A macro has no idea where its call site is: a Form carries no location, on + * purpose (see the prelude's Form, and Expand.unmarshal). + * + * So the compiler tells it, here. lib/macro.ml dlsym's the two symbols below + * and pokes the call site's directory into them before every expansion; a + * macro-time read joins that to a relative path and opens the result. The + * channel is C data and not a Flan global because Build.macro_module emits the + * module with hidden visibility — only the flan.macro.* thunks stay exported — + * and "the C goes on resolving the way it always did" is the other half of + * that same comment. + * + * It is empty in a process that is not expanding anything, which is every + * process but the compiler: the module links this file, so a *program* holding + * these symbols simply has a relative path mean what it means to the shell. + * + * `slurp` is deliberately not what the prelude wraps around this. slurp + * signals a FileError, and a condition raised inside an expansion is raised in + * the compiler, through the macro module's own copy of the runtime — which is + * the failure Build.macro_module's ~hidden comment measured. Absence answers + * here as a length of -1, on getenv's pattern, so a data file that is not + * there becomes something the macro can refuse *about* rather than a trap. */ + +char flan_macro_dir[FLAN_PATH_MAX] = { 0 }; +int64_t flan_macro_dir_n = 0; + +/* The bytes are the caller's to read and nobody's to free: an expansion is + * bounded by the size of the program being compiled, which is exactly the + * budget lib/dynload.ml's `owned` note already spends on a macro's own + * allocations. Leaking is the same decision as there, for the same reason — + * the returned slice is read after the call returns, and there is no `drop`. */ +const uint8_t *flan_macro_slurp(const uint8_t *path, int64_t n, int64_t *len) { + static const char empty[1] = { 0 }; + char rel[FLAN_PATH_MAX]; + char full[FLAN_PATH_MAX]; + FILE *f; + long size; + uint8_t *buf; + size_t got; + *len = -1; + if (!flan_path_cstr(path, n, rel)) return (const uint8_t *)empty; + /* An absolute path is taken as written, and a relative one is joined to the + * call site's directory — embed_path's two cases, in the same order. A dir + * that was never poked leaves a relative path relative to the process, which + * is the only thing it can mean when nothing knows better. */ + if (rel[0] == '/' || flan_macro_dir_n <= 0) { + memcpy(full, rel, (size_t)n + 1); + } else { + if (flan_macro_dir_n + 1 + n >= FLAN_PATH_MAX) return (const uint8_t *)empty; + memcpy(full, flan_macro_dir, (size_t)flan_macro_dir_n); + full[flan_macro_dir_n] = '/'; + memcpy(full + flan_macro_dir_n + 1, rel, (size_t)n + 1); + } + f = fopen(full, "rb"); + if (!f) return (const uint8_t *)empty; + /* A directory opens on Linux and fails at the read, which is the trap + * check.ml's read_embed_file records: guarding only the open turns + * (macro-slurp "somedir") into a crash rather than an answer. Both ends are + * guarded here and both answer absent. */ + if (fseek(f, 0, SEEK_END) != 0) { fclose(f); return (const uint8_t *)empty; } + size = ftell(f); + if (size < 0 || fseek(f, 0, SEEK_SET) != 0) { + fclose(f); + return (const uint8_t *)empty; + } + buf = (uint8_t *)malloc((size_t)size + 1); + if (!buf) { fclose(f); return (const uint8_t *)empty; } + got = fread(buf, 1, (size_t)size, f); + fclose(f); + if (got != (size_t)size) { free(buf); return (const uint8_t *)empty; } + buf[size] = 0; + *len = (int64_t)size; + return buf; +} + /* ── The rest of the file surface ────────────────────────────────────── * * Four more POSIX-shaped calls under the same rules as flan_file_size,