diff --git a/.gitignore b/.gitignore index 59fe709..abda8df 100644 --- a/.gitignore +++ b/.gitignore @@ -68,3 +68,4 @@ test/web-files-out.txt # Python bytecode from the tools directory __pycache__/ *.pyc +/forms.so diff --git a/BUILT.md b/BUILT.md index c47e10b..b29fc07 100644 --- a/BUILT.md +++ b/BUILT.md @@ -565,6 +565,10 @@ perceptually instant for expression eval too. Milestone 3 did not need an oracle hand-written, so the table *is* the oracle. Consequences already applied: milestone 2's "interpreted calls per second" criterion is dropped, and the host ABI moved onto the critical path. +It stopped being an absence when macros landed. A macro has to run at compile time and there is nothing to interpret +it with, so the compiler compiles it into a shared object and `dlopen`s it into its own process — see "Macros: the +compiler dlopens the program". The decision's cost and its mechanism are the same thing. + ## The layout, which is the whole backend design ``` @@ -2279,6 +2283,158 @@ there and matching it from a program. `dev.ml`'s inspector still says "union val frame's locals, and `shim.ml`'s "a Flan union has no C layout" is now inaccurate as prose though the refusal it guards is still right: a union has a C layout and still may not cross to C by value, because the shim flattens aggregates. +## Macros: the compiler dlopens the program + +"Why there is no interpreter" above decided that the compiled path is the only backend. A macro is the first thing +that turns that decision into a mechanism rather than an absence: **running a macro at compile time means compiling +it and loading it into the compiler's own process.** There is nothing to interpret it with and there is not going to +be, so `Emit.redefinition` → `Build.shared` → `dlopen`, the reload primitive the dev loop already runs, is pointed at +the compiler instead of at a running program. + +`(defmacro name [args] body ...)` is one function, `[Form] -> Form`. One parameter, the slice of forms written at the +call site, which is where variadics come from in a language with no `&rest`: `(len args)` is how many were written. + +### A defmacro is a defn, and there is no Ast.Defmacro + +`Parse` turns `(defmacro m [args] body)` into `(defn m [args [Form]] Form body)` and nothing below the parser knows +the word exists. The checker checks it like any function, the backend emits it like any function, `Reach.link` drops +it from a program that does not call it like any function. The only thing that makes it a macro is that `Macro` calls +it at compile time instead of the program calling it at run time. + +This is also why there is no macro table. Storage was the question the front half deliberately left open, and the +answer is that there is none: the macro set is recomputed by scanning the top level for the word `defmacro`, which is +the only place it survives, and the compiled artefact is a `.so` keyed by a digest. + +### `Form`, and the three numbers + +A macro's parameter and its result are `Form`, so `Form` has to exist on the Flan side: a `defunion` in `prelude.ml` +mirroring `lib/form.ml`. It mirrors `Form.value` and **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 source location of the call site attached to what a macro +produces", and it is what the queued structured-error work reads. + +Case order is tag order, so the list in the prelude is a layout contract and says so. The widest cases are +`(Str [s string])` and `(List [xs [Form]])`; a string and a slice are both `%slice` = `{ptr, i64}`, 16 bytes at +align 8. So the image is `{ i32 tag, [2 x i64] payload }`: **24 bytes, align 8, payload at offset 8**, and every case +holds its one member at the payload's start, so there is no third offset anywhere in the marshaller. + +Those three numbers are asserted, not assumed. `test_acceptance.ml`'s "Form's image format" asks LLVM for each of them +through the same `ptrtoint`-of-`getelementptr`-through-null oracle the DWARF offsets go through. Alignment needed a +probe the oracle did not have: the offset of field 1 in `{ i8, %"Form" }` *is* `alignof(Form)`, because a struct member +sits at the first offset its own alignment allows. Reading `[2 x i64]` out of the emitted type and concluding 8 would +be asserting the layout against itself, which is the circularity that got a `_Static_assert` rejected for the FFI. + +### Nothing aggregate crosses to C + +The boundary is `void @"flan.macro.NAME"(ptr %args, i64 %n, ptr %out, ptr %xfer)` — one thunk per macro, written by +`Emit.macro_thunk`. The thunk builds the `%slice` from `(args, n)` on the LLVM side, calls the macro, and stores the +result through `%out`. + +The correction that matters here is not obvious from the diff. The unions work verified a union's **memory** layout +against clang; that is a different claim from LLVM's calling convention for an aggregate passed or returned **by +value** in hand-written IR, which is not promised to be clang's C ABI for the equivalent struct. Memory is the +agreement that actually exists, so pointers and scalars are all that cross. `%xfer` is the transfer channel every Flan +signature carries; `flan_macro_call` supplies a zeroed one, because a macro that signals with nothing above it to +handle it aborts inside the compiler, and the channel still has to be a real slot. + +`Build.macro_module` produces 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 +— exactly the part of the driver the dev path skips. + +OCaml has no `dlopen` for ELF (`Dynlink` loads OCaml), so `lib/dynload_stubs.c` is the whole boundary: `dlopen`, +`dlsym`, `dlclose`, the four-argument call, `calloc`/`free`, and a peek/poke family, because OCaml cannot address raw +memory and a `Form` image is written into it one field at a time. + +### Quasiquote runs before the walk, and that is not a preference + +Quasiquote is a desugaring over `Form` and nothing more: it becomes `form-nil`, `form-cons` per item and +`form-append` per splice — the prelude's three form-building functions and no fourth. It is pure, it needs nothing +loaded, and `Parse.program` runs it on the way in, which is what lets the prelude's own macros parse in a process +that has not built a macro module yet. + +Running it **before** the expander's walk is load-bearing. A recursive conditional macro's body contains a +quasiquoted call to itself; with the quasiquote still standing, the walk would see that head and expand it then and +there, against the wrong arguments. Desugared first, that subform is a `(Form.Sym {.s "cond"})` and there is no head +left to mistake — so the walk needs no idea that quoting exists. + +Nesting levels are counted nowhere: not by the reader, which was written that way deliberately, and not by the +desugaring. A quasiquote inside a quasiquote is refused by name. Only a macro that writes a macro wants one. + +### A call inside a quasiquote is output, not a dependency + +This is the distinction that is easy to get wrong, and the first cycle test written for this work got it wrong: it +quasiquoted, and it was not a cycle at all. + +A macro body that **calls** another macro outside a quasiquote needs that macro compiled and loaded first, because +until then the call is a name nothing defines and the body will not compile. That is a compile-order dependency and it +is what makes the pre-pass a fixpoint. A macro body that **quasiquotes** a call to another macro needs nothing: the +call is part of what the macro answers, and the answer is expanded again after it returns. + +So there are two different ways expansion fails to terminate, and they are different failures: + +- **A ring** — two macros whose bodies call each other for real. There is no order to compile them in, so it is + refused, naming both. `test/programs/macro-cycle.flan`. +- **A macro that expands into a call to a macro and does not get smaller.** That is an ordinary loop, not an ordering + problem, so it is bounded at 200 rounds and the failure says which macro ran out, at the call site. + `test/programs/macro-spin.flan`. + +The rounds themselves: round 0 takes every macro whose body names no macro still waiting, round 1 expands the rest +against round 0's module, and a round that takes nothing while macros remain is the ring. The walk is bottom up, so a +macro never sees a call to another macro in what it is handed. + +### Hygiene is an escape hatch, not a system + +Deliberately non-hygienic, Common Lisp's rule and Clojure's, settled in plan.org's open decision 2. A macro that needs +a name of its own calls `gensym`, which is a prelude function the loaded module runs while it runs. The name is +`~g`, and `~` is a delimiter now — it opens an unquote — so no symbol the reader can produce contains one and a +gensym cannot collide with a name someone wrote. The counter lives in the loaded module rather than in the compiler, +which is the one place this departs from the original sketch; a module is dlopened once per compiler process, so it is +process-wide in practice. + +### -linkall, and why the hook could not be installed by hand + +Expanding a macro means compiling it, so `Macro` needs `Check`, `Build` and `Emit` and therefore sits **above** the +parser it feeds. The join is `Parse.expander`, a ref that `Macro` fills in at module initialisation. + +Nothing references `Macro`, so without `-linkall` the linker drops it from every executable that does not name the +module — `bin/main.exe` among them — and a program calling a macro fails with an unknown name. Installing by hand at +every entry point was the alternative and it is not viable: `lib/session.ml` calls `Parse.program` for `C-c C-c` and +`C-c C-k`, and `test_session.ml` drives the session library in-process rather than through the CLI, so the set of +places that would need an install call is open-ended and a missed one is silent. `(library_flags (-linkall))` in +`lib/dune` is the guarantee instead. + +`Macro.building` is the re-entrancy guard. `Build.macro_module` goes through `Check.program`, which parses the +prelude, which calls back into `Parse.program` — and that would re-enter the expander forever. Nothing is lost by +refusing to expand there: a macro compiled in round *n* calls only macros compiled in earlier rounds, and those calls +were already expanded before the build was entered. + +### What it costs + +- A build of a program that **names no macro**: 50ms, unchanged. The pass scans the top level, finds nothing, and no + compiler runs. This is nearly every program, and it is the reason the prelude can grow a `defmacro` without every + build paying a clang driver. +- A program that **calls one**: 310ms the first time, 70ms after. The 240ms is the clang driver; the module is cached + under the object cache and keyed by a digest of the prelude's source plus the file's `defmacro` forms, so it is paid + once per change rather than once per build. Every `flan build` is a fresh process, which is what makes the on-disk + cache rather than a memo the right shape. +- A hello-world's binary carries exactly one symbol out of all of this: `flan.gensym-n`, eight bytes. `Reach.link` + drops `unless`, `form-cons`, `form-nil`, `form-append`, `form-rest` and `gensym`, because nothing reachable calls + them. + +### `unless` is the proof + +plan.org milestone 5 says `when`, `unless`, `until`, `cond` and `dotimes` are special forms only until macros land. +`unless` is the first to stop being one — it is now a `defmacro` in `prelude.ml` and `parse.ml` has nothing to say +about it — and it was chosen because it is the one the prelude itself does not use. That matters: the prelude is +compiled into the macro module, so a prelude macro that the prelude's own functions call would need the expander to +compile the thing the expander needs in order to run. + +Its coverage is `sand.flan`, seven calls, compiled through `Session` in `test_session` — the in-process path, and the +reason `-linkall` is not optional. Say plainly what that coverage is not: nothing in `test/programs` used `unless` +before this landed, so `macro-unless.flan` is a test written after the feature. The corpus written before it is +`sand.flan` and `web/examples/control.flan`, and both compile unchanged. + ## `defer` may be written in a `let` The whole of this project's resource-cleanup answer, and NEXT.md records `drop` and a `with-cleanup` form as both diff --git a/NEXT.md b/NEXT.md index 13ae069..ca0bea9 100644 --- a/NEXT.md +++ b/NEXT.md @@ -40,6 +40,34 @@ read. It belongs with item 2, where the listing is being changed anyway. Read SBCL for what restarts should *mean* and ignore how it moves control: it transfers with `block`/`return-from`, which §6 rules out. +### Landed — macros run, and `unless` is not a special form any more + +The expander is written and the exit criterion plan.org set for milestone 5 is met: a conditional sugar moved out of +`parse.ml` and into `prelude.ml` as a `defmacro`, with the corpus that was written against the special form +unchanged. Running `test/programs/macro-unless.flan` means the compiler built a shared object, `dlopen`ed it into +itself and called a Flan function to find out what `(unless c a b)` means. + +The full explanation is in [`BUILT.md`](BUILT.md), "Macros: the compiler dlopens the program". Four things worth +knowing before touching any of it, because each cost something to find: + +- **A call inside a quasiquote is output, not a compile-order dependency.** A macro body that *calls* another macro + needs it compiled first; a macro body that *quasiquotes* a call to one needs nothing, because the call is part of + what it answers and the answer is expanded again. The first cycle test written for this got that wrong and was not + a cycle at all. The two non-termination failures are therefore different and are refused differently: a ring is + named, a macro that does not settle is bounded. +- **Quasiquote is desugared before the walk**, and that is load-bearing rather than tidy — with the quasiquote still + standing, the walk expands the call inside it against the wrong arguments. +- **`lib/dune` passes `-linkall`.** `lib/macro.ml` installs itself into `Parse.expander` and nothing references it, so + the linker would otherwise drop it from `bin/main.exe`. Installing by hand is not viable: `session.ml` parses for + `C-c C-c`, and `test_session.ml` drives the session library in-process. +- **Two parser bugs fell out of it**, both in the rule that tells a return type from the first form of a body. The + prelude's types were not in the set that rule consults, so `Form` in return position was read as a body form; and + adding them plainly made `(defn f [] (Rune {.code 65}) (bar))` a function returning a `Rune` with a one-form body, + silently, in every file in the language. Both are pinned in test_flan.ml's return-type section. + +Costs: a build that names no macro is unchanged at 50ms; one that calls a macro is 310ms cold and 70ms warm, the +difference being a cached `.so`; and a hello-world carries eight bytes of it, because `Reach.link` drops the rest. + ### Landed — a C header is read, so a binding is checked instead of trusted `lib/cimport.ml`, `lib/cjson.ml`, a `headers` file beside `link`. Full reasoning in `BUILT.md`, "The header is read @@ -566,11 +594,9 @@ run one lane at a time; item 4 is disjoint and runs alongside any of them. namespace before `collect` runs, so a `defunion Form` in `prelude.ml` is an ordinary same-file declaration and needs no import and no `load.ml` change. Verified by declaring one there and matching it from a program. - **Then macros**, which are blocked on exactly this and nothing else: a macro is `[Form] -> Form`, so `Form` has to be - a Flan union whose *layout* the compiler and the `dlopen`ed macro agree on byte for byte. `NEXT.md`'s macro section - has the expander design — a pre-pass fixpoint before `Parse`, `gensym` as a compiler-side counter, quasiquote as a - desugaring over `Form`. The exit criterion is already written: move `when` or `cond` out of `parse.ml` into the - prelude as a `defmacro` with the existing tests unchanged and still green. + **Macros landed on top of this** and needed no `load.ml` change for `Form`, exactly as this said. See + [`BUILT.md`](BUILT.md), "Macros: the compiler dlopens the program", and the short list of what is left of them + below. Macros are what buy `with-drawing` and `with-mode-2d` over raylib's begin/end pairs, the hiccup DSL if a JS backend ever happens, and the removal of special forms from the compiler. @@ -703,8 +729,13 @@ libraries. Four things were settled doing it: needs, since every `defmacro` must be compiled before anything that calls it. `Load.t.pkgs` now comes back in topological order, dependencies first. The *declaration* list is deliberately not -sorted and does not need to be — `check.ml` collects every top-level name before it checks any body — so the order -exists for the expander, which cannot work that way. +sorted and does not need to be — `check.ml` collects every top-level name before it checks any body. + +**The expander did not end up reading that order**, and it is worth saying so rather than leaving the paragraphs above +to imply otherwise. Macros are collected from the prelude and from the file being compiled; a `defmacro` in a package +is refused by name, because reaching one means resolving that package's own imports over `Form`s before `Load` runs. +The order is there and correct and is what package-level macros will read on the day they exist; nothing reads it +today. **Still missing: package visibility.** `rl/get-color-raw` is callable. The blocker is surface syntax, not `load.ml`: `exported` and the refusal machinery already exist and take a second rule in one line, but there is no way for a @@ -1356,66 +1387,50 @@ A package importing a package was on this list and is off it. It loads, a diamon package, the alias clash is refused through a chain as well as inside one file, and a ring is refused by name. What is left of the item is visibility, which is listed above and needs a marker the parser does not have. -## Macros — the reader and the declaration are in, the expander is not +## Macros — landed; what is left of them -The front half landed. What exists: +**The expander works and `unless` is a prelude `defmacro`.** How all of it fits together is in +[`BUILT.md`](BUILT.md), "Macros: the compiler dlopens the program" — the image format, the thunk ABI, why quasiquote +runs before the walk, the two different ways expansion fails to terminate, `-linkall`, and the three cost numbers. +What follows is only the part that is still missing. -- **The reader** reads `` `x ``, `~x` and `~@x` as `(quasiquote x)`, `(unquote x)` and `(unquote-splicing x)`, exactly -as `'x` reads as `(quote x)`. It stays dumb: it does not count nesting levels, does not know whether an unquote is -inside a quasiquote, and attaches no meaning to the three names. Clojure's spelling, not Common Lisp's, because a comma -is whitespace in `is_delimiter` and every binding vector in the corpus relies on that. Backtick and tilde are delimiters -now, so `a~b` is two things. -- **`parse.ml` refuses all four by name.** `quasiquote` and `gensym` say expansion is not wired up; `unquote` and -`unquote-splicing` say they mean nothing outside a quasiquote, which is a mistake rather than a missing feature. -`(defmacro name [params] body ...)` at the top level is checked for shape and *then* refused — a malformed defmacro and -an unimplemented one get different reasons, so the shape rule is enforced before the feature exists. +- **Four special forms left**, and two of them are the hard ones. `until` and `cond` are free to move whenever + somebody wants them. `when` and `dotimes` are not: the prelude itself uses them 29 and 12 times, so moving either + makes the prelude depend on the macro that the macro module has to compile the prelude to get. Breaking that needs + either a prelude that stops using them, or a two-stage prelude where the macro module is built from a subset. The + first is a mechanical edit of `prelude.ml` and is probably the answer. -Nothing is stored. There is deliberately no macro table and no `Ast.Defmacro`, because a table nothing reads is a place -for a design to rot, and the storage shape is the expander author's first decision, not a decision to inherit. + `cond` has its own snag, and it is the reason `unless` went first: `parse.ml` refuses `(cond a)` with "cond clause + has no body", and a macro cannot produce that (see the next item), so moving `cond` changes an existing test. -### How the expander should work +- **A macro has no error facility**, and this is the biggest gap. A macro runs inside the compiler; anything it + signals aborts the compile with no location. So the prelude's `unless` answers `(unless-takes-a-test-and-a-body)` + when it is handed fewer than two forms, and the report is "unknown name unless-takes-a-test-and-a-body" at the call + site — right place, wrong sentence. What a macro wants is a way to say *this is wrong and here is why*, reported at + the call site. The queued structured-error rewrite is where that belongs, and the call site's `Loc.t` is already + stamped onto everything a macro returns, so the location half is done. -**There is no interpreter** (see "Why there is no interpreter" in `BUILT.md`) and there is not going to be one, so running a macro at -compile time means *compiling it and loading it into the compiler*. That machinery already exists and is measured: -`Emit.redefinition` → `Build.shared` → `dlopen` is ~19ms end to end, with the load itself at 0.04ms (see "The reload -primitive"). A macro is that pipeline pointed at the compiler's own process instead of the program's. +- **Macros are not imported.** A `defmacro` in a package is refused by name in `load.ml`. Reaching one would mean + resolving that package's own imports over `Form`s, before `Load` runs — a second import resolver. `programs/pkg-macro.flan`. -The shape it wants: +- **A prelude macro may not call a macro.** The prelude is in every macro module by construction, so there is no + round it could be compiled in after something else. It would fail with an unknown name rather than with a reason, + which is worth fixing the day the prelude wants one. -1. **A macro is a function `[Form] -> Form`.** Its parameters are forms and its result is a form, which means `Form.t` -has to exist on the Flan side — a `defunion` mirroring `lib/form.ml`, in the prelude, plus constructors and accessors. -That is the real work, and it is bigger than the expander itself: the compiler and the compiled macro have to agree on -the *layout* of a `Form`, not merely its shape, so whatever the checker does for unions has to be exact here. Until -unions are values this cannot start — `check.ml` puts union values and `match` on a union at **milestone 6**, so that is -milestone 6 work landing before milestone 5's. -2. **Expansion runs over `Form`, before `Parse`.** Not a pass over `Ast`: there is no `Ast.Defmacro` and `Parse` refuses -`defmacro` outright, so an `Ast`-level pass would have nothing to work with. That refusal is not a dead end, it is the -ordering — the expander runs first and `Parse` never sees a macro call at all. It is also the Clojure ordering, and the -reason a macro expanding to a special form is ordinary rather than a special case. -3. **Order matters and files do not have one.** Top-level names in a package are order-independent everywhere else -(`declared_types`, the constant fixpoint in `check.ml`). Macros cannot be: a macro must be compiled and loaded before a -call to it is expanded. Either collect every `defmacro` in a pre-pass and compile them as one module, or require -definition-before-use for macros specifically and say so in the error. The pre-pass is better and matches how the rest -of the frontend already behaves. -4. **A macro's own body may call macros**, so the pre-pass is a fixpoint, not a single sweep, and a cycle has to be -detected and named rather than looping. -5. **`gensym` is a runtime function of the compiler**, called by the loaded macro while it runs. It needs a counter that -lives in the compiler process and a name that cannot collide with a reader-produced symbol — the usual trick is a -character no symbol may contain, and this reader now has two new ones it could reserve. Hygiene is settled (plan.org, -open decision 2): deliberately non-hygienic, Common Lisp/Clojure style, explicit `gensym`, no `macrolet` until a -concrete use case appears. -6. **Quasiquote itself is a macro-shaped desugaring**, not a compiler feature: `` `(a ~b) `` becomes list-construction -over quoted pieces, with `~@` splicing. Written once, in the expander, over `Form`. +- **A quasiquote inside a quasiquote is refused.** Nothing counts nesting levels — not the reader, deliberately, and + not the desugaring. Only a macro that writes a macro wants one. -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. +- **`gensym`'s counter restarts in a second module.** It lives in the loaded module, and a module is dlopened once per + compiler process, so it is process-wide in practice. The rounds already build more than one module for a program + whose macros call macros, and the fix that day is to seed the counter from the module's index. -### What would tell you it works +- **The macro programs are not in the sanitizer sweep.** `test_sanitize.ml` runs an explicit list, not a glob, so + `macros.flan` and `macro-unless.flan` were not added to it by landing them. `dune build --root . @sanitize` is + clean as it stands; adding the two is a one-line edit in a file this lane did not own. -`when`, `unless`, `until`, `cond` and `dotimes` are special forms in `parse.ml` today, and plan.org milestone 5 says -they are special forms *only until macros land*. Moving one of them out of the compiler and into the prelude as a -`defmacro`, with the existing tests unchanged and still green, is the exit criterion — it proves expansion, quasiquote, -`gensym` and the ordering pre-pass at once, against a test suite written before any of them existed. +- **No `&rest` sugar.** A macro takes one parameter, the slice of forms at its call site, and `(len args)` is the + arity. That is deliberate — it is where variadics come from — but a `when` written against it reads worse than + `parse.ml`'s version did. ## Watch for diff --git a/forms.so b/forms.so deleted file mode 100755 index bf4727d..0000000 Binary files a/forms.so and /dev/null differ 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/check.ml b/lib/check.ml index 9a39427..a593571 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -2073,6 +2073,21 @@ and file_guard ctx loc ~path_slot ~op mk_steps = (Tast.Let ([ (ok, mk loc Types.Bool (Tast.Bool false)) ], [ mk loc Types.Unit (Tast.While (notok (), [ body ])) ])) +(* Is this bare symbol the name of a type? Every table [resolve_name] will look + in, and the union table is one of them: a union is [Named] exactly as a + struct is, so (vec-new Form) is as ordinary as (vec-new Cell). It was left + out when unions landed, which made the prelude's own (vec-new Form) fail + with "nothing here says what (vec-new) is a Vec of" — a message about a + missing annotation for a program that had written one. One list, read by + both callers, so the next kind of type added cannot be added to one of + them. *) +and type_named ctx n = + List.mem n Types.primitive_names + || Hashtbl.mem ctx.env.structs n + || Hashtbl.mem ctx.env.unions n + || Hashtbl.mem ctx.env.enums n + || Hashtbl.mem ctx.env.aliases n + (* The element type for [vec-new]: a leading bare symbol naming a type, or the expectation at the site. A bare symbol shadowed by a local or a global is that binding — an allocator, in practice — and not a type. *) @@ -2082,10 +2097,7 @@ and vec_new_elem ctx ~want loc args = | { Ast.e = Ast.Var n; _ } :: rest when lookup ctx n = None && (not (Hashtbl.mem ctx.env.globals n)) - && (List.mem n Types.primitive_names - || Hashtbl.mem ctx.env.structs n - || Hashtbl.mem ctx.env.enums n - || Hashtbl.mem ctx.env.aliases n) -> + && type_named ctx n -> Some (resolve_name ctx.env ~seen:[] loc n, rest) | _ -> None in @@ -2114,10 +2126,7 @@ and map_new_types ctx ~want loc args = let is_type n = lookup ctx n = None && (not (Hashtbl.mem ctx.env.globals n)) - && (List.mem n Types.primitive_names - || Hashtbl.mem ctx.env.structs n - || Hashtbl.mem ctx.env.enums n - || Hashtbl.mem ctx.env.aliases n) + && type_named ctx n in match args with | { Ast.e = Ast.Var k; _ } :: { Ast.e = Ast.Var v; _ } :: rest diff --git a/lib/dune b/lib/dune index db83290..f5e7bca 100644 --- a/lib/dune +++ b/lib/dune @@ -1,6 +1,20 @@ (library (name flan) - (libraries unix)) + (libraries unix) + ; -linkall because lib/macro.ml installs itself into Parse.expander at module + ; initialisation and nothing references it. Without it the linker drops the + ; module from every executable that does not name it -- bin/main.exe among + ; them -- and a program calling a macro would fail with an unknown name + ; instead of expanding. The alternative was an install call at every entry + ; point, including ones in files this cannot reach. + (library_flags (-linkall)) + ; 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/expand.ml b/lib/expand.ml new file mode 100644 index 0000000..009f61b --- /dev/null +++ b/lib/expand.ml @@ -0,0 +1,233 @@ +(** Macro expansion: the pass between the reader and [Parse]. + + There is no interpreter and there is not going to be one (BUILT.md, "Why + there is no interpreter"), so running a macro at compile time means + compiling it and loading it into this process. Every piece of that is + already built and measured — [Emit.macro_thunk], [Build.macro_module], + [Dynload] — and this file is the two halves nobody had written: the image + format the two sides share, and the walk that finds macro calls and + replaces them. + + Expansion runs over [Form], before [Parse]. Not over [Ast]: [Parse] refuses + [defmacro] outright and there is no [Ast.Defmacro], so an Ast-level pass + would have nothing to work with. That refusal is the ordering. It is also + Clojure's ordering, and it is why a macro expanding to a special form is + ordinary here rather than a special case. *) + +(* ── The image format ────────────────────────────────────────────── + A Form is { i32 tag, [2 x i64] payload }: 24 bytes, align 8, payload at + offset 8. Those three numbers are the whole agreement between this file and + the compiled macro, and they are not taken on trust — test_acceptance.ml's + "Form's image format" asks LLVM for each of them through the same ptrtoint + oracle the DWARF offsets go through. Change the prelude's defunion and that + test says which number moved. + + The tag is the case's position in the prelude's (defunion Form ...), which + is why that list is a layout contract and says so. *) + +let form_size = 24 +let payload = 8 + +(* A string and a slice are both %slice = { ptr, i64 }: two words at the start + of the payload. Every case of Form holds one member, so there is no third + offset anywhere below. *) +let ptr_off = payload +let len_off = payload + 8 + +type tag = + | TSym | TKw | TInt | TFloat | TStr | TByte | TList | TVec | TMap + +let tag_int = function + | TSym -> 0l | TKw -> 1l | TInt -> 2l | TFloat -> 3l | TStr -> 4l + | TByte -> 5l | TList -> 6l | TVec -> 7l | TMap -> 8l + +let tag_of_int = function + | 0l -> TSym | 1l -> TKw | 2l -> TInt | 3l -> TFloat | 4l -> TStr + | 5l -> TByte | 6l -> TList | 7l -> TVec | 8l -> TMap + | n -> + failwith + (Printf.sprintf + "a macro returned a Form with tag %ld, and Form has nine cases. The \ + prelude's (defunion Form ...) and lib/expand.ml's tag list are one \ + contract and have come apart" + n) + +(* ── Writing a Form into memory a macro can read ─────────────────── + OCaml cannot address raw memory, so this goes through the poke family in + dynload_stubs.c, one field at a time. Everything allocated here is owned by + [Dynload] and released together after the call. *) + +let rec marshal (f : Form.t) : Dynload.addr = + let p = Dynload.take form_size in + write p f; + p + +(* Into an existing 24 bytes, which is what an argument array needs: the macro + takes a [Form] slice, and a slice is contiguous elements and not an array of + pointers. *) +and write p (f : Form.t) = + let tag t = Dynload.poke_i32 p 0 (tag_int t) in + let str t s = + tag t; + let n = String.length s in + (* A zero-length string still gets a pointer, because a slice with a null + base is not the same value as one with a live base and a zero length -- + the difference shows the day something concatenates onto it. *) + let b = Dynload.take (max n 1) in + if n > 0 then Dynload.poke_bytes b 0 s; + Dynload.poke_ptr p ptr_off b; + Dynload.poke_i64 p len_off (Int64.of_int n) + in + let seq t xs = + tag t; + let n = List.length xs in + let b = Dynload.take (max (n * form_size) 1) in + List.iteri (fun i x -> write (Nativeint.add b (Nativeint.of_int (i * form_size))) x) xs; + Dynload.poke_ptr p ptr_off b; + Dynload.poke_i64 p len_off (Int64.of_int n) + in + match f.Form.v with + | Form.Sym s -> str TSym s + | Form.Kw s -> str TKw s + | Form.Str s -> str TStr s + | Form.Int i -> tag TInt; Dynload.poke_i64 p payload i + | Form.Float x -> tag TFloat; Dynload.poke_f64 p payload x + | Form.Byte b -> tag TByte; Dynload.poke_i32 p payload (Int32.of_int b) + | Form.List xs -> seq TList xs + | Form.Vec xs -> seq TVec xs + | Form.Map xs -> seq TMap xs + +(* ── Reading one back ────────────────────────────────────────────── + [loc] is the call site's, stamped onto every node. A macro cannot invent a + source location and the image has no room for one: Form on the Flan side + mirrors [Form.value], not [Form.t]. So an error inside an expansion points + at the call that produced it, which is the part of "the error carries the + expansion" that can be had now without the structured-error rewrite. *) + +let rec unmarshal ~loc (p : Dynload.addr) : Form.t = + let str () = + let b = Dynload.peek_ptr p ptr_off in + let n = Int64.to_int (Dynload.peek_i64 p len_off) in + if n = 0 then "" else Dynload.peek_bytes b 0 n + in + let seq () = + let b = Dynload.peek_ptr p ptr_off in + let n = Int64.to_int (Dynload.peek_i64 p len_off) in + List.init n (fun i -> + unmarshal ~loc (Nativeint.add b (Nativeint.of_int (i * form_size)))) + in + let v = + match tag_of_int (Dynload.peek_i32 p 0) with + | TSym -> Form.Sym (str ()) + | TKw -> Form.Kw (str ()) + | TStr -> Form.Str (str ()) + | TInt -> Form.Int (Dynload.peek_i64 p payload) + | TFloat -> Form.Float (Dynload.peek_f64 p payload) + | TByte -> Form.Byte (Int32.to_int (Dynload.peek_i32 p payload) land 0xff) + | TList -> Form.List (seq ()) + | TVec -> Form.Vec (seq ()) + | TMap -> Form.Map (seq ()) + in + Form.make v loc + +(* ── One call ────────────────────────────────────────────────────── + The arguments are one contiguous run of Forms, not an array of pointers, + because the macro's parameter is [[Form]] and a Flan slice is { ptr, len } + over elements. *) + +let call ~loc (fn : Dynload.addr) (args : Form.t list) : Form.t = + let n = List.length args in + let a = Dynload.take (max (n * form_size) 1) in + List.iteri + (fun i x -> write (Nativeint.add a (Nativeint.of_int (i * form_size))) x) + args; + let out = Dynload.take form_size in + Dynload.call fn a (Int64.of_int n) out; + unmarshal ~loc out + +(* ── Quasiquote ──────────────────────────────────────────────────── + A desugaring over [Form], and nothing more: a quasiquoted (if ~t ~b) becomes + calls to the prelude's form-building surface, which the checker then sees as + ordinary code. There is no quasiquote left in the language after this runs, + which is why the expander's own walk needs no idea that quoting exists: by + the time it looks for macro calls, a [cond] written inside a quasiquote is a + (Form.Sym {.s "cond"}) and there is no head there to mistake for a call the + compiler should make now. + + The reader stays dumb and produces (quasiquote x), (unquote x) and + (unquote-splicing x) with no idea whether one is inside another. Counting + levels is this file's job, and it does not: a quasiquote inside a quasiquote + is refused by name. A macro that writes a macro is the only thing that wants + one, nothing in the corpus does, and CL's level arithmetic has a real cost + that no use case has asked for. *) + +let sym loc s = Form.make (Form.Sym s) loc +let lst loc xs = Form.make (Form.List xs) loc + +(* (Form.Case {.field value}) — a node of the image, written as the Flan + constructor the prelude declares. *) +let node loc case field v = + lst loc [ sym loc ("Form." ^ case); + Form.make (Form.Map [ sym loc ("." ^ field); Form.make v loc ]) loc ] + +let unquote_of (f : Form.t) = + match f.Form.v with + | Form.List [ { Form.v = Form.Sym "unquote"; _ }; x ] -> Some x + | _ -> None + +let splice_of (f : Form.t) = + match f.Form.v with + | Form.List [ { Form.v = Form.Sym "unquote-splicing"; _ }; x ] -> Some x + | _ -> None + +let rec quote (f : Form.t) : Form.t = + let loc = f.Form.loc in + match unquote_of f with + (* The escape: whatever the program wrote, evaluated. It is already a Form, + because a Form is what a macro body deals in. *) + | Some x -> x + | None -> + match splice_of f with + | Some _ -> + Loc.fail loc + "~@x splices into a list or a vector, and there is nothing here for it \ + to splice into" + | None -> + match f.Form.v with + | Form.List ({ Form.v = Form.Sym "quasiquote"; _ } :: _) -> + Loc.fail loc + "a quasiquote inside a quasiquote is not implemented: the reader does \ + not count nesting levels and neither does this, so the inner one has \ + no meaning to give. Build the inner form with form-cons" + | Form.Sym s -> node loc "Sym" "s" (Form.Str s) + | Form.Kw s -> node loc "Kw" "s" (Form.Str s) + | Form.Int i -> node loc "Int" "i" (Form.Int i) + | Form.Float x -> node loc "Float" "x" (Form.Float x) + | Form.Str s -> node loc "Str" "s" (Form.Str s) + | Form.Byte b -> node loc "Byte" "b" (Form.Int (Int64.of_int b)) + | Form.List xs -> node loc "List" "xs" (seq loc xs).Form.v + | Form.Vec xs -> node loc "Vec" "xs" (seq loc xs).Form.v + | Form.Map xs -> node loc "Map" "xs" (seq loc xs).Form.v + +(* The [Form] slice one bracket's worth of items comes to. Built right to left, + so each item is consed onto what follows it and a splice is an append — the + three prelude functions and no fourth. *) +and seq loc items = + List.fold_left + (fun acc (item : Form.t) -> + match splice_of item with + | Some x -> lst item.Form.loc [ sym item.Form.loc "form-append"; x; acc ] + | None -> lst item.Form.loc [ sym item.Form.loc "form-cons"; quote item; acc ]) + (lst loc [ sym loc "form-nil" ]) + (List.rev items) + +(* Every quasiquote in a form, outermost first. Pure, total, and dependent on + nothing but Form, which is what lets [Parse] run it on the way in rather + than needing the whole expander wired up first. *) +let rec quasiquote (f : Form.t) : Form.t = + match f.Form.v with + | Form.List [ { Form.v = Form.Sym "quasiquote"; _ }; x ] -> quote x + | Form.List xs -> Form.make (Form.List (List.map quasiquote xs)) f.Form.loc + | Form.Vec xs -> Form.make (Form.Vec (List.map quasiquote xs)) f.Form.loc + | Form.Map xs -> Form.make (Form.Map (List.map quasiquote xs)) f.Form.loc + | _ -> f diff --git a/lib/load.ml b/lib/load.ml index 17b5e1d..f02584d 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -645,7 +645,36 @@ let rec import ~seen ~open_ ~loc alias dir = let files = if one_file then [ dir ] else entries dir ".flan" in if files = [] then fail loc "the package at %s has no .flan file" dir; let ds = - List.concat_map (fun f -> Parse.program (Reader.read_file f)) files + List.concat_map + (fun f -> + let forms = Reader.read_file f in + (* A defmacro in a package is refused by name, and here is the only + place that can see one: by the time [Parse] is finished, a + defmacro is an ordinary [Ast.Defn] and the word is gone. + + It is a real gap and not an oversight. The expander collects + macros from the prelude and from the file being compiled; to + collect them from a package it would have to resolve that + package's own imports first, at the Form level, before this + function -- which is a second import resolver. The refusal says + that rather than letting the call arrive at the checker as an + unknown name. *) + List.iter + (fun (form : Form.t) -> + match form.Form.v with + | Form.List ({ Form.v = Form.Sym "defmacro"; _ } + :: { Form.v = Form.Sym n; _ } :: _) -> + Loc.fail form.Form.loc + "%s is a macro, and macros are not imported yet. A \ + defmacro has to be compiled before the call it expands, \ + and the expander collects them from the prelude and from \ + the file being compiled -- not from a package, whose own \ + imports would have to be resolved first. Move it into \ + the file that calls it" n + | _ -> ()) + forms; + Parse.program forms) + files in (* [main] is the importer's, always. A package that called its own would get the importer's instead — silently, since the name still resolves — diff --git a/lib/macro.ml b/lib/macro.ml new file mode 100644 index 0000000..2ff0ea9 --- /dev/null +++ b/lib/macro.ml @@ -0,0 +1,205 @@ +(** 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 plus the file's, and not an imported + package's: [Load] learns a package's imports by parsing it, so collecting + from one would mean a second import resolver running over Forms. A defmacro + in an imported package is refused by name instead. *) + +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; +} + +let key (extra : Form.t list) = + Digest.to_hex + (Digest.string + (Prelude.source ^ "\000" + ^ String.concat "\000" (List.map Form.to_string extra))) + +(* 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 + +let compile (names : string list) (extra : Form.t list) : loaded = + let out = + Filename.concat (Build.cachedir ()) ("flan-macros-" ^ key extra ^ ".so") + in + if not (Sys.file_exists out) then begin + building := true; + Fun.protect + ~finally:(fun () -> building := false) + (fun () -> + (* [Check.program] prepends the prelude itself, so only the file's + own defmacros go in here. *) + let p = Check.program (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 } + +(* ── 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 + settle l n loc (Expand.call ~loc (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 + settle l first loc (Expand.call ~loc (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 ())) + +let program (forms : Form.t list) : Form.t list = + if !building then forms + else + let prelude = Lazy.force prelude_macros in + let mine = List.filter_map (fun f -> Option.map (fun n -> (n, f)) (macro_name f)) forms 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 forms + else begin + let extra = rounds ~prelude mine in + let l = compile all (List.map snd extra) in + let out = List.map (expand_form l) forms in + Dynload.dl_close l.handle; + Dynload.release (); + out + end + +let () = Parse.expander := program diff --git a/lib/parse.ml b/lib/parse.ml index a9347c6..33b737b 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -145,14 +145,6 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = mk (Ast.If (expr c, { Ast.e = Ast.Do (body_of body); loc = f.loc }, None)) | _ -> fail f "when is (when test body ...)") - | Sym "unless" -> - (match args with - | c :: body when body <> [] -> - let neg = { Ast.e = Ast.Call ({ Ast.e = Ast.Var "not"; loc = head.loc }, - [ expr c ]); loc = f.loc } in - mk (Ast.If (neg, { Ast.e = Ast.Do (body_of body); loc = f.loc }, None)) - | _ -> fail f "unless is (unless test body ...)") - | Sym "cond" -> cond f args (* Short-circuiting, so they cannot be ordinary calls. *) @@ -296,9 +288,14 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = (* The reader now produces these three, so they arrive here as ordinary heads and would fall through to Call — coming back from the checker as "unknown name quasiquote", which says nothing about what is actually missing. *) + (* [Expand.quasiquote] runs over every form on the way into [program] and + [decl], so a quasiquote is gone before this file looks at it and this arm + cannot be reached by anything that came through either. It is kept as the + backstop for the path that did not: a form built by hand and handed + straight to [expr]. *) | Sym "quasiquote" -> - fail f "`x is read, but not expanded: macro expansion is not wired up yet \ - (NEXT.md says what it needs)" + fail f "a quasiquote reached the parser undesugared, which means this form \ + did not come through Parse.program or Parse.decl" (* Not a milestone, a mistake: these two mean nothing anywhere else, and the reader cannot tell, because it does not track where it is. *) @@ -311,13 +308,6 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | Sym "defmacro" -> fail f "defmacro is a top-level declaration, not an expression" - (* Neither a reader token nor a special form: an ordinary function that a - macro body calls while the macro runs. There is nowhere for it to run - yet, so it says that rather than arriving as an unknown name. *) - | Sym "gensym" -> - fail f "gensym is only meaningful inside a macro body, and macro expansion \ - is not wired up yet (NEXT.md says what it needs)" - (* Recognised, deliberately unimplemented. Rejected rather than left to fall through to Call, where they would parse and mean nothing. *) | Sym ("handler-case" @@ -760,25 +750,38 @@ let rec decl types (f : Form.t) : Ast.decl = | [ n; t; v ] -> mk (Ast.Defconst (sym n, Some (texpr t), expr v)) | _ -> fail f "defconst is (defconst name Type? value)") - (* Checked for shape and then refused, which is deliberate. Getting the shape - wrong and getting the whole feature are two different mistakes, and a - "defmacro is (defmacro ...)" that only ever fired after expansion landed - would be a rule nothing enforced in the meantime. + (* A macro is an ordinary function, and this is where it becomes one: + [(defmacro m [args] body)] is [(defn m [args [Form]] Form body)]. There is + no [Ast.Defmacro] and there is not going to be one -- a macro has the type + [[Form] -> Form], it is compiled by the same backend as everything else, + and the only thing that makes it a macro is that [Expand] calls it at + compile time instead of the program calling it at run time. - The refusal is not about parsing. Expanding a macro means running it, and - there is no interpreter — the compiled path is the only backend. So it - means compiling the macro and dlopening it into the compiler, which is - what Emit.redefinition and Build.shared already do for the dev loop. - NEXT.md writes down how that goes together. *) + One parameter, the slice of the argument forms, rather than one declared + parameter per argument. It needs no reader or parser change and it gives + variadics for free, which is what [unless] and [when] need in a language + with no &rest. + + The shape rules stay exactly as they were, because they were enforced + before the feature existed on purpose: getting the shape wrong and getting + the whole feature are different mistakes. *) | List ({ v = Sym "defmacro"; _ } :: args) -> (match args with - | n :: { v = Form.Vec ps; _ } :: body when body <> [] -> - let name = sym n in + | n :: { v = Form.Vec [ p ]; _ } :: body when body <> [] -> + let form_t = { Ast.t = Ast.Tname "Form"; tloc = f.loc } in + mk (Ast.Defn + { Ast.name = sym n; + params = [ { Ast.fname = sym p; + fty = { Ast.t = Ast.Tslice form_t; tloc = p.loc }; + floc = p.loc } ]; + ret = Some form_t; fbody = body_of body; nloc = n.loc }) + | _ :: { v = Form.Vec ps; _ } :: body when body <> [] -> List.iter (fun (p : Form.t) -> ignore (sym p)) ps; fail f - "defmacro %s parses, but is not expanded: running a macro means \ - compiling it and loading it into the compiler, which is not wired \ - up yet (NEXT.md says what it needs)" name + "a macro takes one parameter, the forms at its call site, and this \ + one names %d. There is no &rest and no arity: (defmacro m [args] \ + ...) and (len args) is how many were written" + (List.length ps) | _ -> fail f "defmacro is (defmacro name [param ...] body ...)") @@ -821,7 +824,8 @@ and qualified_type types s = and is_type_form types (f : Form.t) = match f.v with | Sym s -> - Names.mem s types || Names.mem ("enum " ^ s) types || qualified_type types s + Names.mem s types || Names.mem ("enum " ^ s) types + || Names.mem ("prelude " ^ s) types || qualified_type types s | Vec _ -> true (* [T] and [n T] are only types *) | Map _ -> true (* {K V} in this position *) | List ({ v = Sym n; _ } :: _) -> @@ -836,10 +840,10 @@ and variant (f : Form.t) : Ast.variant = | List [ { v = Sym n; _ } ] -> { Ast.vname = n; vfields = []; vloc = f.loc } | _ -> fail f "a union case is Name or (Name [field Type ...])" -(* Names introduced as types by this file, plus the builtins. Collected before - anything is parsed, so a type declared at the bottom of a file is still known - to a function at the top — top-level names are order-independent. *) -let declared_types (forms : Form.t list) : Names.t = +(* Names introduced as types by a list of forms. Collected before anything is + parsed, so a type declared at the bottom of a file is still known to a + function at the top — top-level names are order-independent. *) +let types_in (base : Names.t) (forms : Form.t list) : Names.t = List.fold_left (fun acc (f : Form.t) -> match f.v with @@ -859,13 +863,79 @@ let declared_types (forms : Form.t list) : Names.t = | List [ { v = Sym "defenum"; _ }; { v = Sym n; _ }; _ ] -> Names.add ("enum " ^ n) acc | _ -> acc) - builtin_types forms + base forms + +(* The prelude's types are every file's types. [Check.program] prepends the + prelude to every program, so StorageExhausted, FileError and Form are as + available as i32 is — but [types_in] reads one file's own declarations, and + the prelude is a different list of forms, so nothing here knew that. + + It read as a gap that could not matter, because a bare capitalised name is + the only type position this set is consulted for and the prelude's structs + were only ever *taken* as parameters, never *returned*. Macros are where it + bites: a macro is (defn m [args [Form]] Form ...), and [Form] as the return + type was parsed as the first form of the body and reported as an unknown + name — the parser deciding a declared type was a value. [[Form]] worked, + because a Vec in that position is a type whatever is in it, which is exactly + the kind of half-working that hides this. + + They go in under their own key, for the reason the enums do one comment up. + Added plainly, [is_type_form]'s list-head arm would read [(Rune {.code 65})] + as a type application and eat it as a return type — silently, in every file + in the language, which is the exact failure the comment above + [is_type_form] warns about. No prelude type takes arguments, so a bare + symbol is the only type position any of them can occupy, and the bare-symbol + arm is the only one that asks. + + Read once: the prelude is a constant string and this set is a constant of + it. *) +let prelude_types = + lazy + (List.fold_left + (fun acc (f : Form.t) -> + match f.v with + | Form.List [ { v = Form.Sym ("defstruct" | "defunion" | "defalias"); _ }; + { v = Form.Sym n; _ }; _ ] -> + Names.add ("prelude " ^ n) acc + | Form.List [ { v = Form.Sym "defenum"; _ }; { v = Form.Sym n; _ }; _ ] -> + Names.add ("enum " ^ n) acc + | _ -> acc) + builtin_types (Prelude.forms ())) + +let declared_types (forms : Form.t list) : Names.t = + types_in (Lazy.force prelude_types) forms + +(* Macro expansion, which runs over [Form] and therefore before anything in + this file. It cannot be called directly: expanding a macro means compiling + it and dlopening it, so the expander sits above [Check] and [Build] and this + module sits below them. [Macro] fills this in, and lib/dune passes -linkall + so that it always has -- an executable that links the library gets the + installation whether or not it names the module. + + The default is the identity because [Macro] is what knows which names are + macros; with nothing installed, a call to one arrives at the checker as an + unknown name, which is wrong but not silent. *) +let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs) let program (forms : Form.t list) : Ast.decl list = + (* Quasiquote first and always, because it is pure and needs nothing loaded: + it is what turns a macro body into ordinary code, and the prelude's own + macros have to parse in a process that has not built a macro module yet. + Then expansion, which may need one. *) + let forms = !expander (List.map Expand.quasiquote forms) in let types = declared_types forms in temps := 0; List.map (decl types) forms -(* Single-declaration entry point, for tests and the REPL. Sees only the - builtin types plus whatever this one form declares. *) -let decl (f : Form.t) : Ast.decl = temps := 0; decl (declared_types [ f ]) f +(* Single-declaration entry point, for tests and the REPL. Sees the builtin and + prelude types plus whatever this one form declares. *) +let decl (f : Form.t) : Ast.decl = + temps := 0; + match !expander [ Expand.quasiquote f ] with + | [ f ] -> decl (declared_types [ f ]) f + | fs -> + (* One declaration in, one out. A macro at the top level would break that, + and there is no top-level macro call: [decl] dispatches on the head and + a macro name is not one of the heads it knows. *) + Loc.fail f.loc "expanding this declaration produced %d of them" + (List.length fs) diff --git a/lib/prelude.ml b/lib/prelude.ml index f6d32c0..b88f4cd 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -822,6 +822,120 @@ 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))}))) + +;; ── The first special form to stop being one ────────────────────────── +;; +;; plan.org milestone 5 says when, unless, until, cond and dotimes are special +;; forms only until macros land. This is the one that moved, and it is here to +;; show that the move is possible and cheap, not because it was the most +;; valuable of the five: it is the one no other part of the prelude uses, so +;; moving it cannot make the prelude depend on the expander that compiles it. +;; +;; The expansion is exactly what parse.ml built by hand until now -- an if over +;; (not test) with the body in a do -- so every test written against the +;; special form is a test of this, unchanged. +;; +;; The one thing the compiler could say and this cannot is a reason. A macro +;; has no error facility: it runs inside the compiler and anything it signals +;; aborts the compile with no location. So a malformed (unless) answers a name +;; nothing defines, and the report is "unknown name unless-takes-a-test-and-a- +;; body" at the call site, which is the right place and the wrong sentence. +;; That is the next thing a macro needs and it is written down in NEXT.md. +(defmacro unless [args] + (if (< (len args) 2) + `(unless-takes-a-test-and-a-body) + `(if (not ~(at args 0)) (do ~@(form-rest args 1))))) + |flan} let file = "" diff --git a/sand.flan b/sand.flan index f20da9f..7aff84f 100644 --- a/sand.flan +++ b/sand.flan @@ -101,7 +101,7 @@ ;; over a mutable scan position, which is what a while loop is. (defn settle [row i32 col i32] (let [vel (+ gravity (at velocity row col)) - some-point (rl/Vector2 {.x 15.0 .y 12}) + some-point (rl/Vector2 {.x 15.0 .y 12}) y (min (- rows 1) (+ row (i32 vel)))] (while (> y row) (when (empty-at? y col) diff --git a/test/dune b/test/dune index 4d7a689..8240929 100644 --- a/test/dune +++ b/test/dune @@ -41,6 +41,8 @@ (glob_files programs/pkgs/ring-a/*) (glob_files programs/pkgs/ring-b/*) (glob_files programs/pkgs/ring-c/*) + ; The package that declares a macro, which a package may not do yet. + (glob_files programs/pkgs/mac/*) ; The synthetic C header the importer's table reads. Committed rather than ; reached for on the machine: the raylib case needs raylib installed, at the ; right version, with a variable set, so it skips everywhere and covers diff --git a/test/programs/macro-cycle.flan b/test/programs/macro-cycle.flan new file mode 100644 index 0000000..73b48b5 --- /dev/null +++ b/test/programs/macro-cycle.flan @@ -0,0 +1,21 @@ +;;;; Two macros whose bodies call each other, and the calls are real ones -- +;;;; outside any quasiquote, so each has to run while the other is being +;;;; compiled. A defmacro has to be compiled before the call it expands, so a +;;;; ring has no order to be compiled in: neither can go first and neither +;;;; becomes compilable by waiting. The pre-pass names them both. +;;;; +;;;; A call inside a quasiquote is a different thing and is not a cycle. It is +;;;; part of what the macro *answers*, expanded again after it returns, and two +;;;; macros can quasiquote each other forever without either needing the other +;;;; to exist first -- see macro-spin.flan, which is bounded rather than +;;;; refused. + +(defmacro ping [args] + (pong args)) + +(defmacro pong [args] + (ping args)) + +(defn main [] i32 + (ping 1) + 0) diff --git a/test/programs/macro-spin.flan b/test/programs/macro-spin.flan new file mode 100644 index 0000000..cf8ed78 --- /dev/null +++ b/test/programs/macro-spin.flan @@ -0,0 +1,11 @@ +;;;; A macro that expands into a call to itself and does not get smaller. The +;;;; expansion of a recursive macro is an ordinary loop and this is the one +;;;; that does not terminate, so it is bounded and the bound says which macro +;;;; ran out rather than the compiler running out of memory. + +(defmacro spin [args] + `(spin ~@args)) + +(defn main [] i32 + (spin) + 0) diff --git a/test/programs/macro-unless.flan b/test/programs/macro-unless.flan new file mode 100644 index 0000000..4e2b95c --- /dev/null +++ b/test/programs/macro-unless.flan @@ -0,0 +1,44 @@ +;;;; unless, which used to be a special form in parse.ml and is a defmacro in +;;;; the prelude now. plan.org milestone 5 says the five conditional sugars are +;;;; special forms only until macros land; this is the first one to stop being +;;;; one, and running this file means the expander compiled a macro into a +;;;; shared object, dlopened it into the compiler, and called it -- before the +;;;; first line below was parsed. +;;;; +;;;; Nothing here is new syntax. Every line of it compiled the same way before +;;;; the move, which is the point: the test for the feature is the corpus that +;;;; was written against the special form. + +(defn classify [n i32] string + (let [out "even"] + (unless (= 0 (% n 2)) + (set out "odd")) + out)) + +(defn main [] i32 + ;; One body form, the common case. + (unless false (println "the test was false")) + (unless true (println "NOT PRINTED")) + + ;; Several, which is what the do in the expansion is for. + (unless false + (print "a") + (print "b") + (println "c")) + + ;; A computed test, so the argument is a form the macro had to put back + ;; rather than a literal it could have ignored. + (let [n 7] + (unless (< n 3) (println "7 is not less than 3"))) + + ;; Inside a function that returns a value, and inside a loop: the expansion + ;; is an if with no else, so it is Unit and it does not decide the body's + ;; value. + (println (classify 4)) + (println (classify 5)) + + (let [seen 0] + (dotimes [i 5] + (unless (= i 2) (set seen (+ seen 1)))) + (print seen) (println "")) + 0) diff --git a/test/programs/macros.flan b/test/programs/macros.flan new file mode 100644 index 0000000..c84cbf2 --- /dev/null +++ b/test/programs/macros.flan @@ -0,0 +1,82 @@ +;;;; Macros: a defmacro in the file, called from the file. +;;;; +;;;; There is no interpreter, so every macro below was compiled into a shared +;;;; object and dlopened into the compiler before this file's first line was +;;;; parsed. What arrives here is the expansion; nothing at run time knows a +;;;; macro was involved. +;;;; +;;;; A macro takes one parameter, the slice of forms written at its call site, +;;;; and answers one form. That is where variadics come from in a language with +;;;; no &rest: (len args) is how many were written. + +;; The simplest one there is: two forms, in order. It proves the call site's +;; arguments arrive as forms and come back as code. +(defmacro both [args] + `(do ~(at args 0) ~(at args 1))) + +;; Splicing, which is the only reason ~@ exists: the body is however many forms +;; were written, and they go where a list is expected. +(defmacro when2 [args] + `(if ~(at args 0) (do ~@(form-rest args 1)))) + +;; Expansion is not hygienic -- Common Lisp's rule and Clojure's, settled in +;; plan.org's open decision 2 -- so a macro that needs a name of its own asks +;; for one. gensym is a prelude function the loaded module runs while it runs, +;; and the name it answers starts with ~, which is a delimiter, so no symbol +;; the reader can produce is able to collide with it. +;; +;; Without this, `twice` would bind `tmp` and the caller's own `tmp` would be +;; shadowed inside it. The two calls below are the difference. +(defmacro twice [args] + (let [v (gensym)] + `(let [~v ~(at args 0)] + (+ ~v ~v)))) + +;; A macro that answers a call to another macro. This costs the pre-pass +;; nothing: `both` is inside the quasiquote, so it is part of what this macro +;; *returns* and is expanded again after it returns, and `announce` can be +;; compiled without `both` existing. +(defmacro announce [args] + `(both (print "-> ") ~(at args 0))) + +;; This is the one that makes the pre-pass a fixpoint rather than a sweep. The +;; call to `id` is not inside a quasiquote, so it runs while *this macro is +;; being compiled* -- which means `id` has to be compiled and dlopened first, +;; and until it is, `id` is a name nothing defines and this body will not +;; compile at all. So round 0 takes `id`, round 1 expands this against it, and +;; the module that finally answers a call holds both. +(defmacro id [args] + (at args 0)) + +(defmacro quiet [args] + (id `(println "a macro that called a macro"))) + +;; And a macro that expands into a call to itself, which is what every +;; conditional macro in every Lisp is. It gets smaller each time and stops at +;; the empty case, so the expander's fuel never comes into it. +(defmacro all-of [args] + (if (= (len args) 0) + `true + `(if ~(at args 0) (all-of ~@(form-rest args 1)) false))) + +(defn main [] i32 + (both (print "a") (println "b")) + + (when2 true (print "c") (println "d")) + (when2 false (println "not printed")) + + ;; 21 + 21. The argument is evaluated once, into the gensym'd binding. + (print (twice 21)) (println "") + + ;; The caller's own `tmp` is untouched by the one the macro bound, because + ;; the macro did not bind `tmp`. + (let [tmp 5] + (print (twice tmp)) (print " ") (print tmp) (println "")) + + (announce (println "announced")) + (quiet) + + (print (all-of)) (println "") + (print (all-of true true true)) (println "") + (print (all-of true false true)) (println "") + 0) diff --git a/test/programs/pkg-macro.flan b/test/programs/pkg-macro.flan new file mode 100644 index 0000000..5dd6cfb --- /dev/null +++ b/test/programs/pkg-macro.flan @@ -0,0 +1,14 @@ +;;;; A macro in an imported package. +;;;; +;;;; The expander collects defmacros from the prelude and from the file being +;;;; compiled. Collecting them from a package would mean resolving that +;;;; package's own imports at the Form level, before Load runs -- a second +;;;; import resolver -- so it does not, and says so. Left alone the call would +;;;; arrive at the checker as an unknown name, which is the failure shape this +;;;; codebase refuses to ship. Never built: the refusal is the test. + +(import mac "pkgs/mac") + +(defn main [] i32 + (print (mac/double 4)) + 0) diff --git a/test/programs/pkgs/mac/mac.flan b/test/programs/pkgs/mac/mac.flan new file mode 100644 index 0000000..9bcd330 --- /dev/null +++ b/test/programs/pkgs/mac/mac.flan @@ -0,0 +1,7 @@ +;;;; A package that declares a macro, which is a thing a package may not do +;;;; yet. The refusal is the test; this is never built. + +(defmacro twice [args] + `(+ ~(at args 0) ~(at args 0))) + +(defn double [n i32] i32 (* n 2)) diff --git a/test/programs/unions.flan b/test/programs/unions.flan index 56ad9fb..070687c 100644 --- a/test/programs/unions.flan +++ b/test/programs/unions.flan @@ -93,4 +93,18 @@ (print (Shape.Dot {.x 1.5 .y -2.5})) (println "") (print (Shape.Tag {.name "printed" .n 9})) (println "") (print (Cell {.id 7 .s (Shape.Rect {.w 1 .h 2})})) (println "") + + ;; A union names an element type the same way a struct does. It reads as + ;; trivia and it was not: the type-name test (vec-new) and (map-new) use to + ;; read a leading bare symbol listed structs, enums, aliases and primitives + ;; and not unions, so (vec-new Shape) was refused for not saying what it + ;; held -- by a program that had said. + (let [vs (vec-new Shape) + ms (map-new string Shape)] + (push vs (Shape.Rect {.w 2 .h 3})) + (push vs Shape.Empty) + (put ms "only" (Shape.Tag {.name "in a map" .n 1})) + (print (i64 (area (at vs 0)))) (println "") + (println (describe (at vs 1))) + (println (match (get ms "only") (Some s) (describe s) None "missing"))) 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index d60033c..37db25f 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1129,6 +1129,12 @@ let () = refusal that says only "there is a cycle" leaves them to find it. The ring is a -> b -> c -> a, and the message closes it by repeating the package it came back to. *) + (* A package may not declare a macro yet, and the reason is the ordering: + collecting one would mean resolving that package's own imports over + Forms, before Load runs. Refused where the defmacro is written rather + than where it is called, because that is where the fix goes. *) + refuses "a macro in an imported package" "programs/pkg-macro.flan" + "macros are not imported yet"; refuses "an import ring" "programs/pkg-cycle.flan" "round a ring: a -> b -> c -> a"; refuses "two mains in one program" "programs/pkg-two-mains.flan" @@ -1696,8 +1702,47 @@ ERR@7 unexpected token: not the kind the caller was reading 32\n0\n-1\nin a cell\nempty\n30\nreassigned\n15\n\ Shape.Empty\n(Shape.Dot {.x 1.5 .y -2.5})\n\ (Shape.Tag {.name \"printed\" .n 9})\n\ - (Cell {.id 7 .s (Shape.Rect {.w 1 .h 2})})\n" + (Cell {.id 7 .s (Shape.Rect {.w 1 .h 2})})\n\ + 6\nempty\nin a map\n" in + (* ── Macros ───────────────────────────────────────────────────── + Running these means the expander compiled a shared object, dlopened it + into this process and called into it, before the program's first line + was parsed. They are acceptance cases and not unit tests for exactly + that reason: there is a clang driver and a loader in the path. + + The three opt levels matter here the way they matter nowhere else in + this file: the expansion happens before anything the optimiser sees, so + all three had better produce the same program. *) + let macros_out = + "ab\ncd\n42\n10 5\n-> announced\na macro that called a macro\n\ + true\ntrue\nfalse\n" + in + outputs "macros" "programs/macros.flan" macros_out; + outputs ~opt:"-O0" "macros, -O0" "programs/macros.flan" macros_out; + outputs ~dev:true "macros, dev" "programs/macros.flan" macros_out; + + (* The exit criterion plan.org set for milestone 5: a special form moved + out of the compiler and into the prelude, with the corpus that was + written against the special form unchanged. *) + let unless_out = + "the test was false\nabc\n7 is not less than 3\neven\nodd\n4\n" + in + outputs "unless, now a prelude macro" "programs/macro-unless.flan" unless_out; + outputs ~opt:"-O0" "unless, now a prelude macro, -O0" + "programs/macro-unless.flan" unless_out; + + (* The two ways expansion does not terminate, and they are different + failures. A ring is a compile-order problem -- each body calls the other + while the other is being compiled -- and there is no order, so it is + refused. A macro that quasiquotes a call to itself is not a ring: that + call is part of what it answers, and the answer is expanded again, so it + is an ordinary loop and it is bounded. *) + refuses "a ring of macros" "programs/macro-cycle.flan" + "none can be compiled first"; + refuses "a macro that does not settle" "programs/macro-spin.flan" + "did not settle after"; + outputs "unions" "programs/unions.flan" unions_out; outputs ~opt:"-O0" "unions, -O0" "programs/unions.flan" unions_out; outputs ~dev:true "unions, dev" "programs/unions.flan" unions_out; @@ -1965,28 +2010,24 @@ ERR@7 unexpected token: not the kind the caller was reading (* LLVM's own answer, for the same struct type text the DWARF describes. The type definitions are lifted straight out of the emitted module, so there is no second spelling of the layout to get wrong. *) - let llvm_members ir sname nfields = - let tydefs = - lines_of ir - |> List.filter (fun l -> - String.length l > 0 && l.[0] = '%' && index_of l " = type " >= 0) - in - let sty = Printf.sprintf "%%\"%s\"" sname in - let b = Buffer.create 512 in - List.iter (fun l -> Buffer.add_string b (l ^ "\n")) tydefs; - for i = 0 to nfields - 1 do - Buffer.add_string b - (Printf.sprintf - "@o%d = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 0, i32 %d) to i64)\n" - i sty i) - done; - Buffer.add_string b - (Printf.sprintf - "@sz = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 1) to i64)\n" - sty); + (* The type definitions lifted straight out of an emitted module, so the + oracle never carries a second spelling of a layout. *) + let tydefs_of ir = + lines_of ir + |> List.filter (fun l -> + String.length l > 0 && l.[0] = '%' && index_of l " = type " >= 0) + |> List.map (fun l -> l ^ "\n") + |> String.concat "" + in + (* Hand LLVM a module of constant-folded ptrtoint expressions and read the + .quad it writes for each. Every layout question below is asked this way: + the answer comes from the backend that lays the type out, not from a + table written beside the code that would have to be wrong in the same + way to agree. *) + let run_oracle src = let ll = Filename.concat scratch "flan-dwarf-oracle.ll" in let asm = Filename.concat scratch "flan-dwarf-oracle.s" in - Out_channel.with_open_bin ll (fun ch -> Out_channel.output_string ch (Buffer.contents b)); + Out_channel.with_open_bin ll (fun ch -> Out_channel.output_string ch src); let llc = try Sys.getenv "FLAN_LLC" with Not_found -> "llc" in let code = Sys.command @@ -2025,6 +2066,40 @@ ERR@7 unexpected token: not the kind the caller was reading Some (List.rev !acc) end in + (* Every member's byte offset and the whole type's size, LLVM's answer. *) + let llvm_members ir sname nfields = + let sty = Printf.sprintf "%%\"%s\"" sname in + let b = Buffer.create 512 in + Buffer.add_string b (tydefs_of ir); + for i = 0 to nfields - 1 do + Buffer.add_string b + (Printf.sprintf + "@o%d = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 0, i32 %d) to i64)\n" + i sty i) + done; + Buffer.add_string b + (Printf.sprintf + "@sz = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 1) to i64)\n" + sty); + run_oracle (Buffer.contents b) + in + (* Alignment, which no getelementptr states directly. Put the type after a + single byte and ask where it lands: a struct member sits at the first + offset its own alignment allows, so the offset of field 1 in + { i8, T } *is* alignof(T). Reading [2 x i64] out of the emitted type and + concluding 8 would be asserting the layout against itself, which is the + circularity BUILT.md already rejected for _Static_assert. *) + let llvm_align ir sname = + let sty = Printf.sprintf "%%\"%s\"" sname in + let b = Buffer.create 512 in + Buffer.add_string b (tydefs_of ir); + Buffer.add_string b (Printf.sprintf "%%alignprobe = type { i8, %s }\n" sty); + Buffer.add_string b + "@al = constant i64 ptrtoint (ptr getelementptr (%alignprobe, ptr null, i32 0, i32 1) to i64)\n"; + match run_oracle (Buffer.contents b) with + | None -> None + | Some qs -> List.assoc_opt "al" qs + in (* The case itself: the DWARF a source text produces must agree with LLVM on every member's offset, and on the struct's size. *) let layout_case name src sname fields = @@ -2104,6 +2179,143 @@ ERR@7 unexpected token: not the kind the caller was reading (defn main [] i32 (let [n (N.A {.x 3})] (match n (A x) x _ 1)))\n") "N" [ "tag"; "payload" ]; + (* -- Form: the one layout two programs have to agree on -------- + Every layout above is checked because a debugger reads it. This one is + checked because the *compiler* reads it. A macro is compiled into a .so + and dlopened into the compiler, and the compiler then writes a Form into + raw memory a field at a time and reads one back the same way; nothing at + run time would notice if the two sides disagreed by a byte. The image + format is three numbers -- 24 bytes, align 8, payload at offset 8 -- and + the marshaller in lib/expand.ml is written to them, so here is where they + stop being an assumption. + + They are not arbitrary. Form's widest cases are (Str [s string]) and + (List [xs [Form]]); a string and a slice are both ptr+len, 16 bytes at + align 8. So the tag is 4 padded to 8, the payload is 16, and the total + is 24. Adding a case with a wider member -- two f64s and a pointer, say + -- moves every one of these numbers, and this is what says so before the + first macro hands back a Form the compiler misreads. *) + let form_src = + "(defn shape [f Form] i32\n\ + \ (match f (Int _n) 1 (Str _s) 2 (List xs) (i32 (len xs)) _ 0))\n\ + (defn main [] i32 (shape (Form.Int {.i 1})))\n" + in + layout_case "DWARF offsets agree with LLVM: Form" form_src + "Form" [ "tag"; "payload" ]; + (* The three numbers by name, so a failure says which one moved rather than + leaving it to be read out of an offset table. *) + (let ir = debug_ir form_src in + let want = + [ ("o0", 0, "the tag is at byte"); ("o1", 8, "the payload is at byte"); + ("sz", 24, "a Form is this many bytes wide:") ] + in + match llvm_members ir "Form" 2 with + | None -> Printf.printf "acceptance: Form's image format - llc unavailable, unchecked\n" + | Some oracle -> + List.iter + (fun (k, expect, what) -> + match List.assoc_opt k oracle with + | Some got when got <> expect -> + incr failures; + Printf.printf + "FAIL Form's image format\n %s %d, the marshaller says %d\n" + what got expect + | Some _ -> () + | None -> + incr failures; + Printf.printf + "FAIL Form's image format\n the oracle gave no %s\n" k) + want; + (match llvm_align ir "Form" with + | Some 8 -> () + | Some got -> + incr failures; + Printf.printf + "FAIL Form's image format\n align %d, the marshaller says 8\n" got + | None -> + incr failures; + print_endline + "FAIL Form's image format\n the oracle gave no alignment")); + + (* -- The macro boundary, executed ------------------------------ + Everything above about Form is a claim about layout. This is the claim + that the two halves actually meet: a Flan function compiled into a .so, + dlopened into this process, handed Forms built by the OCaml side and + asked to hand one back. + + It is here rather than in the unit tests because it shells out to clang + and to llc, which is what the acceptance suite is for. Without a + compiler on the path there is nothing to run, and that says so rather + than passing. + + `keep` is the whole point of the three macros: `id` proves an argument + arrives and comes back, `snd` proves the *slice* arrives and not just + its first element, and `wrap` proves a Form the macro allocated itself + -- through the prelude's form-cons, inside the loaded module, on the + module's own heap -- is readable from here after the call returns. *) + let macro_src = + "(defn id [args [Form]] Form (at args 0))\n\ + (defn snd [args [Form]] Form (at args 1))\n\ + (defn wrap [args [Form]] Form\n\ + \ (Form.List {.xs (form-cons (Form.Sym {.s \"do\"}) args)}))\n" + in + let macro_roundtrip () = + let decls = Parse.program (Reader.read_all ~file:"" macro_src) in + let p = Check.program decls in + let so = Filename.concat scratch "flan-macro-boundary.so" in + let so = Build.macro_module ~macros:[ "id"; "snd"; "wrap" ] p ~out:so in + let h = Dynload.dl_open so in + let fn n = Dynload.dl_sym h ("flan.macro." ^ n) in + let loc = Loc.unknown in + let f v = Form.make v loc in + (* One of every case, so a tag this file and the prelude disagree about + is a failure and not a gap. *) + let every = + [ f (Form.Sym "a-symbol"); f (Form.Kw "kw"); f (Form.Int 42L); + f (Form.Float 1.5); f (Form.Str "with \"quotes\" and \n"); + f (Form.Byte 200); f (Form.Str ""); + f (Form.List [ f (Form.Int 1L); f (Form.Vec [ f (Form.Sym "x") ]) ]); + f (Form.Vec []); f (Form.Map [ f (Form.Sym ".k"); f (Form.Int 9L) ]) ] + in + List.iter + (fun x -> + let got = Expand.call ~loc (fn "id") [ x ] in + if Form.to_string got <> Form.to_string x then begin + incr failures; + Printf.printf + "FAIL a Form through the macro boundary\n sent %s, got back %s\n" + (Form.to_string x) (Form.to_string got) + end) + every; + (* The second argument, which only arrives if the slice's length crossed + as well as its base. A macro reading past its arguments is the bug + this catches. *) + let two = [ f (Form.Sym "first"); f (Form.Int 7L) ] in + let got = Expand.call ~loc (fn "snd") two in + if Form.to_string got <> "7" then begin + incr failures; + Printf.printf "FAIL a macro's second argument\n got %s, wanted 7\n" + (Form.to_string got) + end; + (* A Form the macro built. Nothing about this one was laid out on this + side, so it is the direction the layout agreement has never been + tested in. *) + let got = Expand.call ~loc (fn "wrap") two in + if Form.to_string got <> "(do first 7)" then begin + incr failures; + Printf.printf + "FAIL a Form a macro built\n got %s, wanted (do first 7)\n" + (Form.to_string got) + end; + Dynload.dl_close h; + Dynload.release (); + (try Sys.remove so with Sys_error _ -> ()) + in + (try macro_roundtrip () with + | Failure m -> + incr failures; + Printf.printf "FAIL the macro boundary\n %s\n" m); + (* Permuting the fields must actually move them. Asserting that the two orderings disagree is what makes the two cases above a test: an offset table that ignored declaration order would satisfy both. *) diff --git a/test/test_flan.ml b/test/test_flan.ml index 7767c51..3afb524 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -289,9 +289,11 @@ let () = | If (_, { e = Do [ _; _ ]; _ }, None) -> () | _ -> check "when -> if+do" false); - (match (parse1 "(unless c a)").e with - | If ({ e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, _, None) -> () - | _ -> check "unless -> if(not)" false); + (* unless was here, and is not any more: it is a defmacro in the prelude, + and the parser has nothing to say about it. What it expands to is the + same if-over-(not) this used to assert, and it is asserted where it can + be now -- test/programs/macro-unless.flan, through a compiler that has to + run the macro to get there. *) (match (parse1 "(until c a)").e with | While ({ e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, [ _ ]) -> () @@ -389,12 +391,23 @@ let () = parse_rejects "restart-case" "(restart-case body (r [] 1))"; parse_rejects "loop/recur" "(loop [x 1] (recur x))"; - (* ── Macros: the front half is here, the expander is not ───────── *) - (* Was "unknown top-level form (defmacro ...)" — refused, but not by name and - with no reason, which is the hole the house rule had at the top level. *) - parse_rejects "defmacro declaration" "(defmacro m [x] x)" - ~needle:"not expanded"; - (* Shape and feature are separate mistakes and get separate reasons. *) + (* ── Macros ─────────────────────────────────────────────────────── *) + (* A defmacro is a defn. There is no Ast.Defmacro and there is not going to + be one: a macro is [Form] -> Form, compiled by the same backend as + everything else, and what makes it a macro is that the expander calls it + at compile time rather than the program calling it at run time. *) + (match (parse_decl "(defmacro m [args] (at args 0))").d with + | Defn { name = "m"; params = [ p ]; ret = Some r; _ } -> + (match p.fty.t, r.t with + | Tslice { t = Tname "Form"; _ }, Tname "Form" -> () + | _ -> check "defmacro is [Form] -> Form" false) + | _ -> check "defmacro parses as a defn" false); + + (* One parameter, the forms at the call site. Two is not an arity mistake, it + is a misunderstanding of what a macro takes, and it gets its own reason. *) + parse_rejects "defmacro with two parameters" "(defmacro m [a b] a)" + ~needle:"a macro takes one parameter"; + (* Shape and feature were separate mistakes and stay separate reasons. *) parse_rejects "defmacro with no body" "(defmacro m [x])" ~needle:"defmacro is (defmacro name [param ...] body ...)"; parse_rejects "defmacro with no params" "(defmacro m x)" @@ -404,18 +417,45 @@ let () = parse_rejects "defmacro in expression position" "(defn f [] (defmacro m [] 1))" ~needle:"top-level declaration"; - (* The reader now hands these three to the parser, so each says what is - actually wrong rather than arriving at the checker as an unknown name. *) - parse_rejects "quasiquote in a function" "(defn f [] `(a b))" - ~needle:"not expanded"; + (* Quasiquote is a desugaring over Form, and it has already run by the time + the parser sees anything, so what is written here is what a macro body + actually compiles to: the prelude's three form-building functions and + nothing else. Spelled out rather than described, because the desugaring + *is* the contract with the prelude. *) + let desugars name src want = + match read src with + | [ f ] -> + let got = Form.to_string (Expand.quasiquote f) in + if got <> want then begin + incr failures; + Printf.printf "FAIL %s\n got: %s\n wanted: %s\n" + name got want + end + | _ -> check (name ^ ": one form") false + in + desugars "a quasiquoted list is form-cons over Form nodes" "`(a ~b)" + "(Form.List {.xs (form-cons (Form.Sym {.s \"a\"}) (form-cons b (form-nil)))})"; + desugars "a splice is form-append" "`(a ~@bs)" + "(Form.List {.xs (form-cons (Form.Sym {.s \"a\"}) (form-append bs (form-nil)))})"; + (* A vector keeps its bracket through the desugaring: a binding vector is the + commonest thing a macro builds and Form.Vec is not Form.List. *) + desugars "a quasiquoted vector stays a vector" "`[~x 1]" + "(Form.Vec {.xs (form-cons x (form-cons (Form.Int {.i 1}) (form-nil)))})"; + (* Levels are not counted -- not by the reader, deliberately, and not here, + which is why the inner one is refused by name rather than given a meaning + nobody chose. *) + parse_rejects "a quasiquote inside a quasiquote" "(defn f [] Form `(a `(b)))" + ~needle:"quasiquote inside a quasiquote"; (* Not a missing feature — an unquote outside a quasiquote is a mistake, and the reader cannot catch it because it does not track where it is. *) parse_rejects "unquote outside a quasiquote" "(defn f [] ~x)" ~needle:"means nothing outside a quasiquote"; parse_rejects "splice where a splice makes no sense" "(defn f [] (+ 1 ~@xs))" ~needle:"splices only into a list or a vector"; - parse_rejects "gensym outside a macro" "(defn f [] (gensym))" - ~needle:"only meaningful inside a macro body"; + (* A splice with no bracket around it. The quasiquote is real here, so this + one is the desugaring's refusal and not the parser's. *) + parse_rejects "splice not inside a bracket" "(defn f [] Form `~@xs)" + ~needle:"nothing here for it to splice into"; (* ── Malformed syntax is caught with a location ────────────────── *) parse_rejects "odd let bindings" "(let [a])"; @@ -484,6 +524,21 @@ let () = check "unknown capitalised head is a body form" (ret_and_body "unknown" "(defn f [] (Nope 1) (bar))" = (false, 2)); + (* The prelude's types are every file's types -- Check.program prepends the + prelude to every program -- and until macros needed it, nothing told the + parser so. A macro is (defn m [args [Form]] Form ...) and bare Form in + return position was read as the first form of the body. *) + check "a prelude type is a return type" + (ret_and_body "prelude" "(defn f [] Form (g))" = (true, 1)); + + (* And the other half, which is the whole reason those names go in under + their own key: a prelude type is a bare symbol in type position and never + a list head, so a struct literal of one opening a body stays a body form. + Added plainly this reads as a type application and eats the body, in every + file in the language, and nothing would have said so. *) + check "a prelude struct literal is NOT a return type" + (ret_and_body "preludelit" "(defn f [] (Rune {.code 65}) (bar))" = (false, 2)); + () (* ── Checker: AST → typed IR ───────────────────────────────────────── *)