diff --git a/lib/dune b/lib/dune index 9fc6fb4..f5e7bca 100644 --- a/lib/dune +++ b/lib/dune @@ -1,6 +1,13 @@ (library (name flan) (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. 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 6ceaccb..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. *) diff --git a/lib/prelude.ml b/lib/prelude.ml index c2470ce..b88f4cd 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -913,6 +913,29 @@ let source = {flan| (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/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/test_acceptance.ml b/test/test_acceptance.ml index 1bb4438..c19d2f3 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1699,6 +1699,44 @@ ERR@7 unexpected token: not the kind the caller was reading (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; diff --git a/test/test_flan.ml b/test/test_flan.ml index 9fc5449..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"; _ }, [ _ ]); _ }, [ _ ]) -> ()