diff --git a/TODO.org b/TODO.org index 16a6f44f..7d72ce13 100644 --- a/TODO.org +++ b/TODO.org @@ -90,11 +90,14 @@ expansion that defines a macro re-runs the expander. =~~@x= is refused. There is no =,',x=, since =quote= takes a symbol, and a macro defined by an expansion is not exported from a package. docs/BUILT.md, "Quasiquote runs before the walk". -** TODO until, cond, when and dotimes are still special forms in parse.ml -=until= and =cond= are free to move to the prelude whenever somebody wants them. -=when= and =dotimes= are not: the prelude uses them 29 and 12 times, so moving -either makes the prelude depend on the macro the macro module has to compile the -prelude to get. =cond= also has a =(cond a)= refusal a macro cannot produce. +** DONE until and cond are prelude macros; when and dotimes stay special forms +CLOSED: [2026-09-25] +=cond= builds its chain through the prelude function =cond-chain= and refuses +through =compile-error=; =until= keeps its label. Prelude functions that call +=cond= drop out of the macro module, so =into-wrap= is written with =if=. The +macro module now holds only the macros the forms reach. =when= and =dotimes= stay: +the prelude's form-building functions use them. docs/BUILT.md, "cond and until +followed". ** DONE Macros are imported from a package The old refusal claimed collecting a package's macros needed a second import diff --git a/docs/BUILT.md b/docs/BUILT.md index 1b159d88..a1203dd6 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -3592,6 +3592,28 @@ reason `-linkall` is not optional. Say plainly what that coverage is not: nothin 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. +### `cond` and `until` followed, and `when` and `dotimes` stay + +`cond` and `until` are prelude macros now. `until` peels an optional leading label and answers +`(while :label (not test) body ...)`; `cond` hands its clauses to the prelude function `cond-chain`, which builds the +same nested `if` the parser used to, with `(do)` as the innermost else. A function and not a self-call, because +`(cond)` is refused while the empty tail of a longer `cond` is not, and a recursive expansion sees both as `(cond)`. +Their refusals are `compile-error` calls: the caret is the whole call rather than the bad clause, since a node the +macro builds takes the call's location. + +`cond` was not free to move, whatever the old note said: six prelude functions used it. A prelude function that calls +a macro is dropped from the build of the macro module (`Macro.reduce`), which is harmless for `sign-f32`, the rune +decoders and `format-f64` — no macro calls them — and fatal for `into-wrap`, which the `into` macro calls. So +`into-wrap` and `cond-chain` are written with `if`. `when` and `dotimes` stay special forms: the prelude uses them in +dozens of functions, the form-building functions among them, and every one would drop out of the module that runs +macros. + +Moving `cond` also made nearly every file and package need a macro module, and that exposed the rule that a macro +body may call no function of its own file. `vendor/edn` parses its own files calling `cond` and never `defedn`, yet +`defedn`'s body calls the package's `refuse`, so compiling every macro the package declares failed. `Macro.loaded_for` +now compiles only the macros the forms reach: a name anywhere outside a `defmacro` (a quasiquoted call arrives as a +string, and counts), a head called inside a `defmacro` body, and whatever the reached macros' bodies name in turn. + ## `break` and `continue`, and the rule that replaced a blanket refusal Declined once deliberately; TODO.org, "break and continue, with loop labels", records what was settled then and still diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 3a78cbfa..3e61f239 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -144,7 +144,11 @@ and `unquote-splicing' are never written as words — the reader makes them out of \=`, ~ and ~@, and the sigils are not symbols for a keyword rule to reach. `find-restart', `compute-restarts', `errdefer' and `await' the parser recognises only in order to refuse them, and drawing those as keywords would -advertise four forms that cannot be used.") +advertise four forms that cannot be used. + +`cond' and `until' are macros in the prelude and not heads of `Parse.form'. +They stay here because they are control flow a reader takes for `if' and +`while', which is what this face says.") (defconst flan--builtins '(;; arithmetic, comparison, bits diff --git a/emacs/test-flan-mode.el b/emacs/test-flan-mode.el index d150748b..a203fa3d 100644 --- a/emacs/test-flan-mode.el +++ b/emacs/test-flan-mode.el @@ -405,7 +405,10 @@ ("(handler-case (go) [(E [c] 1)])" "handler-case" font-lock-keyword-face "handler-case") ;; Special forms the old list had never heard of. + ;; cond and until are prelude macros, drawn as the control + ;; flow they are. ("(cond (= a 1) 2)" "cond" font-lock-keyword-face "cond") + ("(until (> i 3) (go))" "until" font-lock-keyword-face "until") ("(and a b)" "and" font-lock-keyword-face "and") ("(handler-bind [(E [c] 1)] (go))" "handler-bind" font-lock-keyword-face "handler-bind") diff --git a/lib/macro.ml b/lib/macro.ml index cd354d59..ef998045 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -549,6 +549,57 @@ let loaded_for (forms : Form.t list) : loaded option = List.filter (fun (n, _) -> not (List.mem_assoc n mine)) imported in let mine = imported @ mine in + (* Only the macros these forms can reach. A macro body may call prelude + functions and other macros and nothing else, so a file or package whose + macro calls one of its own functions cannot have that macro compiled — + and it need not be, when nothing here calls it. That is the common case + for a package parsing its own files: they call [cond], a prelude macro, + and never the macros the package exports. + + Reached means named anywhere: as a symbol, or as the string a + quasiquoted name desugars to, since a macro that answers a call to + another needs that one in the module too. Over-reaching only compiles a + macro that would have been compiled anyway. *) + let mine = + let rec atoms (f : Form.t) acc = + match f.Form.v with + | Form.Sym n | Form.Str n -> n :: acc + | Form.List xs | Form.Vec xs | Form.Map xs -> + List.fold_left (fun a x -> atoms x a) acc xs + | _ -> acc + in + (* The heads a form calls. A macro body that calls another macro for + real is expanded by the same walk as everything else, whether or not + the macro it belongs to is ever called, so what it calls is reached. *) + let rec heads (f : Form.t) acc = + match f.Form.v with + | Form.List ({ Form.v = Form.Sym h; _ } :: rest) -> + List.fold_left (fun a x -> heads x a) (h :: acc) rest + | Form.List xs | Form.Vec xs | Form.Map xs -> + List.fold_left (fun a x -> heads x a) acc xs + | _ -> acc + in + let want = Hashtbl.create 16 in + List.iter + (fun f -> + let names = if macro_name f = None then atoms f [] else heads f [] in + List.iter (fun n -> Hashtbl.replace want n ()) names) + forms; + let changed = ref true in + let taken = Hashtbl.create 16 in + while !changed do + changed := false; + List.iter + (fun (n, f) -> + if Hashtbl.mem want n && not (Hashtbl.mem taken n) then begin + Hashtbl.replace taken n (); + changed := true; + List.iter (fun a -> Hashtbl.replace want a ()) (atoms f []) + end) + mine + done; + List.filter (fun (n, _) -> Hashtbl.mem taken n) mine + in let all = prelude @ List.map fst mine in (* The common case by a wide margin, and the reason a build that uses no macro pays nothing: a file that calls none costs one scan and no diff --git a/lib/parse.ml b/lib/parse.ml index 48129474..3402fa32 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -361,7 +361,10 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | [ c; t; e ] -> mk (Ast.If (expr c, expr t, Some (expr e))) | _ -> fail f "if is (if test then) or (if test then else)") - (* Sugar, desugared here: special forms until macros land at milestone 5. *) + (* Sugar, desugared here. [cond] and [until] are prelude macros; [when] and + [dotimes] stay special forms because the prelude uses them in the + functions the macro module is built from, and a function calling a macro + cannot be compiled into that module. *) (* An empty body is allowed, and becomes the same [Ast.Do []] that [(do)] already means. There was never a reason for the restriction: [(when test)] is a guard whose consequent has not been written yet, which is a state a @@ -374,8 +377,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 "cond" -> cond f args - (* Short-circuiting, so they cannot be ordinary calls. *) | Sym "and" -> shortcircuit f args ~is_and:true | Sym "or" -> shortcircuit f args ~is_and:false @@ -391,15 +392,6 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | _, [] -> fail f "while is (while test body ...), or (while :label test body ...)") - | Sym "until" -> - (match label args with - | lbl, c :: body -> - let neg = { Ast.e = Ast.Call ({ Ast.e = Ast.Var "not"; loc = head.loc }, - [ expr c ]); loc = f.loc } in - mk (Ast.While (lbl, neg, body_of body)) - | _, [] -> - fail f "until is (until test body ...), or (until :label test body ...)") - (* Break and continue. Not a goto: the label names one of the loops this form is lexically inside, and the checker resolves it against exactly those, so control can only leave a loop it is already in — the same restriction @@ -1083,17 +1075,6 @@ and struct_fields f (items : Form.t list) : (string * Ast.expr) list = in ignore f; go items -and cond f (args : Form.t list) : Ast.expr = - let rec go = function - | [] -> { Ast.e = Ast.Do []; loc = f.loc } (* no clause matched: Unit *) - | { v = Kw "else"; _ } :: body :: _ -> expr body - | test :: body :: rest -> - { Ast.e = Ast.If (expr test, expr body, Some (go rest)); loc = f.loc } - | [ odd ] -> Loc.fail odd.loc "cond clause %s has no body" - (Form.to_string odd) - in - if args = [] then Loc.fail f.loc "cond needs at least one clause" else go args - (* Every test here is an [if]'s condition, so a dyn operand is truthy-tested (check.ml's check_truthy) exactly the way a bare [if]'s is, for both [and] and [or]. The *answer* is the operand that decided the form, which diff --git a/lib/prelude.ml b/lib/prelude.ml index 29dbfe74..d046b44b 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -2185,6 +2185,77 @@ let source = {flan| `(unless-takes-a-test) `(if (not ~(at args 0)) (do ~@(form-rest args 1))))) +;; ── cond and until ──────────────────────────────────────────────────── +;; +;; (cond a 1 b 2 :else 3) is (if a 1 (if b 2 3)). With no :else the innermost +;; else is (do), so a cond that matches nothing answers (). A test of :else +;; ends the chain and anything written after its body is not read. +;; +;; The chain is built by a function and not by the macro calling itself, +;; because (cond) with no clauses is refused while the empty tail of a longer +;; cond is not, and a recursive expansion cannot tell the two apart. The +;; function uses if and never cond: `cond` expands through it, so it is +;; compiled into the module that expands macros, which a function calling a +;; macro cannot be. +;; +;; A prelude function that does call cond is dropped from that module, and so +;; cannot be called from a macro body: sign-f32, the rune decoders and encoders, +;; and format-f64 (which calls clamp). None is a thing a macro reaches for. +(defn cond-no-body [c Form] Form + (let [v (vec-new u8)] + (match c + (Form.Sym s) + (do (append (addr v) (bytes-view "cond clause ")) + (append (addr v) (bytes-view s)) + (append (addr v) (bytes-view " has no body"))) + (Form.Kw k) + (do (append (addr v) (bytes-view "cond clause :")) + (append (addr v) (bytes-view k)) + (append (addr v) (bytes-view " has no body"))) + _ (append (addr v) (bytes-view "the last cond clause has no body"))) + (append (addr v) + (bytes-view ": every test is followed by the value it chooses")) + `(compile-error ~(Form.Str {.s (string (slice v))})))) + +(defn cond-chain [cs [Form]] Form + (let [n (length cs) + end n + acc `(do) + i 0] + (while (< i n) + (if (= (+ i 1) n) + (return (cond-no-body (at cs i))) + (if (match (at cs i) + (Form.Kw k) (bytes=? (bytes-view k) (bytes-view "else")) + _ false) + (do (set end i) + (set acc (at cs (+ i 1))) + (break)) + (set i (+ i 2))))) + (let [j end] + (while (> j 0) + (set j (- j 2)) + (set acc `(if ~(at cs j) ~(at cs (+ j 1)) ~acc))) + acc))) + +(defmacro cond [& args] + (if (= (length args) 0) + `(compile-error "cond needs at least one clause: (cond test body ...)") + (cond-chain args))) + +;; (until test body ...) is (while (not test) body ...), and a label written +;; first stays first: (until :outer test body ...). +(defmacro until [& args] + (let [labelled (and (> (length args) 0) + (match (at args 0) (Form.Kw k) true _ false)) + from (if labelled 1 0)] + (if (>= from (length args)) + `(compile-error + "until is (until test body ...), or (until :label test body ...)") + (if labelled + `(while ~(at args 0) (not ~(at args 1)) ~@(form-rest args 2)) + `(while (not ~(at args 0)) ~@(form-rest args 1)))))) + ;; ── comment ─────────────────────────────────────────────────────────── ;; ;; (comment (whatever you like)) is nothing at all, and the "whatever you like" @@ -2323,10 +2394,14 @@ let source = {flan| `(into-transform-is-map-or-filter-of-one-function ~t) (let [head (at items 0) f (at items 1)] - (cond - (form-sym? head "map") (recur (- k 1) `(let [~x (~f ~x)] ~body)) - (form-sym? head "filter") (recur (- k 1) `(when (~f ~x) ~body)) - :else `(into-transform-is-map-or-filter ~t)))))))) + ;; if and not cond: cond is a macro, and the `into` macro calls + ;; this function, so it has to be compiled into the module that + ;; expands macros — which a function calling a macro cannot be. + (if (form-sym? head "map") + (recur (- k 1) `(let [~x (~f ~x)] ~body)) + (if (form-sym? head "filter") + (recur (- k 1) `(when (~f ~x) ~body)) + `(into-transform-is-map-or-filter ~t))))))))) ;; The items of a list form, and the empty slice for anything else — a ;; non-list transform falls into the arity complaint above rather than needing diff --git a/test/test_flan.ml b/test/test_flan.ml index 257db810..4772008a 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -783,7 +783,6 @@ let () = (* ── Malformed syntax is caught with a location ────────────────── *) parse_rejects "odd let bindings" "(let [a])"; parse_rejects "odd field pairs" "(defstruct S [a])"; - parse_rejects "cond without body" "(cond a)"; parse_rejects "unknown top form" "(nope x)"; parse_rejects "break takes only a label" "(defn f [] () (break 1))" ~needle:"break is (break) or (break :label)"; @@ -1286,6 +1285,26 @@ let () = "(defn f [x] () (when x 0))"; accepts "dyn cond accepts a non-bool dyn condition" "(defn f [x] dyn (cond x 1 :else 2))"; + (* cond and until are prelude macros, and their refusals are compile-error + calls in the expansion: the caret is on the call and the sentence is the + macro's. *) + rejects_check "cond with no clauses" "(defn f [] () (cond))" + ~needle:"cond needs at least one clause"; + rejects_check "a cond test with no body" "(defn f [a bool] () (cond a))" + ~needle:"cond clause a has no body"; + rejects_check "a cond test that is not a name, with no body" + "(defn f [a bool] () (cond a 1 (= 1 2)))" + ~needle:"the last cond clause has no body"; + rejects_check "a cond :else with no body" "(defn f [a bool] () (cond a 1 :else))" + ~needle:"cond clause :else has no body"; + rejects_check "until with no test" "(defn f [] () (until :outer))" + ~needle:"until is (until test body ...)"; + accepts "anything after cond's :else body is not read" + "(defn f [a bool] i32 (cond a 1 :else 2 junk))"; + accepts "a cond that matches nothing answers ()" + "(defn f [a bool] () (cond a (println \"a\")))"; + accepts "until keeps its label for break" + "(defn f [] () (let [i 0] (until :outer (> i 3) (set i (+ i 1)) (break :outer))))"; accepts "dyn and accepts a non-bool dyn operand" "(defn f [x] i32 (let [y x] (if (and y true) 0 1)))"; accepts "dyn or accepts a non-bool dyn operand"