From 0167fcef43d2c6540c1daa411c1a4958f93df9fd Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 10:14:41 +0700 Subject: [PATCH 1/6] A quasiquote inside a quasiquote nests, and a macro that writes a macro defines one the program can call --- TODO.org | 12 +++++--- docs/BUILT.md | 18 ++++++++++-- lib/expand.ml | 50 ++++++++++++++++++++------------ lib/macro.ml | 28 ++++++++++++++++-- test/programs/macro-writing.flan | 44 ++++++++++++++++++++++++++++ test/test_acceptance.ml | 11 +++++++ test/test_flan.ml | 29 ++++++++++++++---- 7 files changed, 161 insertions(+), 31 deletions(-) create mode 100644 test/programs/macro-writing.flan diff --git a/TODO.org b/TODO.org index a76e8535..16a6f44f 100644 --- a/TODO.org +++ b/TODO.org @@ -81,10 +81,14 @@ back after. It counts across every module a compiler process loads — each roun the program's module, and every expansion in a session. Rules out a counter per module, seeded or not. -** NEXT A quasiquote inside a quasiquote is refused -Decided 2026-09-25: nest the way SBCL and Clojure both do. The desugaring counts depth, an unquote belongs to the innermost quasiquote, and =~~x= reaches out two levels — SBCL's =*backquote-depth*= in =src/code/backq.lisp=. The reader stays as it is. -Nothing counts nesting levels — not the reader, deliberately, and not the -desugaring. Only a macro that writes a macro wants one. +** DONE A quasiquote inside a quasiquote nests +CLOSED: [2026-09-25] +=Expand.quote= counts depth the way SBCL's =*backquote-depth*= does: an unquote +belongs to the innermost quasiquote and =~~x= reaches out two levels; deeper +forms come back as data. A macro's answer is desugared again, and a top-level +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. diff --git a/docs/BUILT.md b/docs/BUILT.md index 930c83da..1b159d88 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -3482,8 +3482,22 @@ quasiquoted call to itself; with the quasiquote still standing, the walk would s 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. +Nesting levels are counted by the desugaring and not by the reader, which stays as it was written. A quasiquote +inside a quasiquote raises the depth and an unquote lowers it, SBCL's `*backquote-depth*` in `src/code/backq.lisp`: +an unquote belongs to the innermost quasiquote around it, `~~x` reaches out two levels, and only the unquotes at +depth 1 are evaluated. Everything deeper comes back as the `(quasiquote x)`, `(unquote x)` and +`(unquote-splicing x)` forms it was read as, and is desugared in its turn when the macro that holds it runs. + +That second desugaring is why `Macro.settle` runs `Expand.quasiquote` over whatever a macro answers, before it looks +at a single head: a macro that writes a macro answers a `defmacro` whose body still holds the inner quasiquote, and +the walk must not read a call inside it as a call. And because the macro module is fixed before the walk starts, a +macro that the expansion *defined* is not in it: `Macro.program` expands the whole run again when an expansion leaves +a new `defmacro` at the top level, bounded by the same fuel as `settle`. + +`~~n` pastes the *form* `n` holds into the inner template as an expression the inner macro evaluates. There is no +`,',n`, because `quote` takes a symbol and not a form, so a literal reaches the inner macro as a `Form` constructor — +`(Form.Int {.i 5})` — and not as `5`. A `defmacro` produced by an expansion inside a package is not one of the +package's exported macros, because `Load` collects them from the forms as written. ### A call inside a quasiquote is output, not a dependency diff --git a/lib/expand.ml b/lib/expand.ml index 98bbfe94..c93fb444 100644 --- a/lib/expand.ml +++ b/lib/expand.ml @@ -210,10 +210,8 @@ let call ~loc (fn : Dynload.addr) (args : Form.t list) : Form.t = 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. *) + levels is this file's job, done in [quote] below. A macro that writes a + macro is the only thing that wants a quasiquote inside a quasiquote. *) let sym loc s = Form.make (Form.Sym s) loc let lst loc xs = Form.make (Form.List xs) loc @@ -234,43 +232,59 @@ let splice_of (f : Form.t) = | Form.List [ { Form.v = Form.Sym "unquote-splicing"; _ }; x ] -> Some x | _ -> None -let rec quote (f : Form.t) : Form.t = +(* [depth] is how many quasiquotes enclose [f], counting the one being + desugared as 1 — SBCL's [*backquote-depth*] in src/code/backq.lisp. A + quasiquote inside raises it and an unquote lowers it, so an unquote belongs + to the innermost quasiquote around it and [~~x] reaches out two. Only the + unquotes at depth 1 are evaluated now; the rest are data, rebuilt as the + (unquote x) and (quasiquote x) forms they were read as, for the macro the + output defines to desugar in its turn. *) +let rec quote ?(depth = 1) (f : Form.t) : Form.t = let loc = f.Form.loc in + (* (head x) as a Form, [x] already desugared. *) + let wrapped head x = + node loc "List" "xs" + (lst loc [ sym loc "form-cons"; node loc "Sym" "s" (Form.Str head); + lst loc [ sym loc "form-cons"; x; lst loc [ sym loc "form-nil" ] ] ]).Form.v + 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 + | Some x when depth = 1 -> x + | Some x -> wrapped "unquote" (quote ~depth:(depth - 1) x) | None -> match splice_of f with - | Some _ -> + | Some _ when depth = 1 -> Loc.fail loc "~@x splices into a list or a vector, and there is nothing here for it \ to splice into" + | Some x -> wrapped "unquote-splicing" (quote ~depth:(depth - 1) x) | None -> match f.Form.v with - | Form.List ({ Form.v = Form.Sym "quasiquote"; _ } :: _) -> - Loc.fail loc - "a quasiquote inside a quasiquote is not implemented — build the \ - inner form with form-cons" + | Form.List [ { Form.v = Form.Sym "quasiquote"; _ }; x ] -> + wrapped "quasiquote" (quote ~depth:(depth + 1) x) | Form.Sym s -> node loc "Sym" "s" (Form.Str s) | Form.Kw s -> node loc "Kw" "s" (Form.Str s) | Form.Int i | Form.UInt (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 + | Form.List xs -> node loc "List" "xs" (seq ~depth loc xs).Form.v + | Form.Vec xs -> node loc "Vec" "xs" (seq ~depth loc xs).Form.v + | Form.Map xs -> node loc "Map" "xs" (seq ~depth 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 = + three prelude functions and no fourth. A splice deeper than [depth] 1 is + data like any other item. *) +and seq ~depth 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 ]) + | Some x when depth = 1 -> + lst item.Form.loc [ sym item.Form.loc "form-append"; x; acc ] + | _ -> + lst item.Form.loc [ sym item.Form.loc "form-cons"; quote ~depth item; acc ]) (lst loc [ sym loc "form-nil" ]) (List.rev items) diff --git a/lib/macro.ml b/lib/macro.ml index 4691b651..cd354d59 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -423,6 +423,12 @@ let rec expand_form (l : loaded) (f : Form.t) : Form.t = | _ -> f and settle l first loc (f : Form.t) left = + (* A macro that writes a macro answers a form with a quasiquote still in it — + the inner one, which the outer desugaring kept as data. It is desugared + here, before the walk below looks at heads, for the reason the program's + own forms are desugared before the first walk: a call written inside a + quasiquote is output, not a call. *) + let f = Expand.quasiquote f in match f.Form.v with | Form.List ({ Form.v = Form.Sym m; _ } :: args) when List.mem_assoc m l.fns -> if left <= 0 then @@ -572,10 +578,28 @@ let with_module (l : loaded) (f : unit -> 'a) : 'a = Dynload.release ()) f -let program (forms : Form.t list) : Form.t list = +(* A top-level macro call may answer a [defmacro], and the macro it defines was + not in the module the call ran against. So when an expansion leaves the top + level declaring a macro it did not declare before, the whole run is expanded + again against a module that has it. The forms already expanded have no call + left in them, so a second pass only reaches the calls to the new names. A + macro that defines a macro whose expansion defines another costs one pass + per level, and the fuel is the same bound [settle] uses. *) +let rec program_n left (forms : Form.t list) : Form.t list = match loaded_for forms with | None -> forms - | Some l -> with_module l (fun () -> List.map (expand_form l) forms) + | Some l -> + let before = macros_in forms in + let out = with_module l (fun () -> List.map (expand_form l) forms) in + let fresh = List.filter (fun n -> not (List.mem n before)) (macros_in out) in + if fresh = [] then out + else if left <= 0 then + Loc.fail + (List.find (fun f -> macro_name f = Some (List.hd fresh)) out).Form.loc + "macros defining macros did not settle after %d levels" fuel + else program_n (left - 1) out + +let program (forms : Form.t list) : Form.t list = program_n fuel forms let () = Parse.expander := program diff --git a/test/programs/macro-writing.flan b/test/programs/macro-writing.flan new file mode 100644 index 00000000..e7102fc3 --- /dev/null +++ b/test/programs/macro-writing.flan @@ -0,0 +1,44 @@ +;;;; Macros that write macros: a quasiquote inside a quasiquote. +;;;; +;;;; The outer quasiquote is desugared when the file is read, and the inner one +;;;; is data until the outer macro runs. What that macro answers is a defmacro +;;;; holding the inner quasiquote, which is desugared then, and the macro it +;;;; defines is compiled and called like one written by hand. + +;; The inner ~x belongs to the inner quasiquote, so it is the generated +;; macro's own parameter and nothing the outer macro evaluates. +(defmacro defsquare [name] + `(defmacro ~name [x] + `(* ~x ~x))) + +;; ~~n reaches out two levels: n is evaluated when defadder runs, and what it +;; holds is pasted into the inner template as an expression the generated +;; macro evaluates. A Form constructor is such an expression, so the literal +;; arrives as one. +(defmacro defadder [name n] + `(defmacro ~name [x] + `(+ ~x ~~n))) + +;; ~@ inside the inner template is the inner macro's splice. +(defmacro defsum [name] + `(defmacro ~name [& xs] + `(+ 0 ~@xs))) + +;; Two levels down: a macro that writes a macro that writes a macro. +(defmacro defsquarer [name] + `(defmacro ~name [inner] + `(defmacro ~inner [x] + `(* ~x ~x)))) + +(defsquare sq) +(defadder add5 (Form.Int {.i 5})) +(defsum total) +(defsquarer defsq2) +(defsq2 sq2) + +(defn main [] i32 + (print (sq 7)) (println "") + (print (add5 10)) (println "") + (print (total 1 2 3 4)) (println "") + (print (sq2 9)) (println "") + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index eb357e3b..005fad8d 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -3984,6 +3984,17 @@ level "1" outputs ~dev:true "a macro's parameter list, dev" "programs/macro-params.flan" macro_params_out; + (* A quasiquote inside a quasiquote: macros whose expansion is a defmacro, + and the macros they define called from main. Two levels deep at the + end, which is two re-passes of the expander. *) + let macro_writing_out = "49\n15\n10\n81\n" in + outputs "a macro that writes a macro" "programs/macro-writing.flan" + macro_writing_out; + outputs ~opt:"-O0" "a macro that writes a macro, -O0" + "programs/macro-writing.flan" macro_writing_out; + outputs ~dev:true "a macro that writes a macro, dev" + "programs/macro-writing.flan" macro_writing_out; + (* A gensym drawn in one round's module and one drawn in the module the program is expanded with are different names. 200 is the two colliding. *) outputs "gensym counts across macro modules" diff --git a/test/test_flan.ml b/test/test_flan.ml index d39a06df..257db810 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -664,11 +664,30 @@ let () = 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"; + (* Levels are counted here, SBCL's way. The inner quasiquote is data, an + unquote belongs to the innermost quasiquote around it, and only the + unquotes at depth 1 are evaluated -- everything deeper comes back as the + (unquote x) it was read as, for the macro the output defines to desugar. *) + let q s = "(Form.Sym {.s \"" ^ s ^ "\"})" in + let wrap h x = "(Form.List {.xs (form-cons " ^ q h ^ " (form-cons " ^ x ^ " (form-nil)))})" in + let list1 x = "(Form.List {.xs (form-cons " ^ x ^ " (form-nil))})" in + desugars "a quasiquote inside a quasiquote is data" "``(b)" + (wrap "quasiquote" (list1 (q "b"))); + desugars "an unquote at depth 2 is data" "``~x" + (wrap "quasiquote" (wrap "unquote" (q "x"))); + desugars "~~x reaches the outer quasiquote" "``~~x" + (wrap "quasiquote" (wrap "unquote" "x")); + desugars "a splice at depth 2 is one item of data" "``(~@xs)" + (wrap "quasiquote" (list1 (wrap "unquote-splicing" (q "xs")))); + desugars "~@~xs splices at the inner level what the outer evaluates" "``(~@~xs)" + (wrap "quasiquote" (list1 (wrap "unquote-splicing" "xs"))); + (* Three deep: ~~x under three quasiquotes is still data, one level short. *) + desugars "~~x under three quasiquotes is data" "```~~x" + (wrap "quasiquote" (wrap "quasiquote" (wrap "unquote" (wrap "unquote" (q "x"))))); + (* ~ holds one form, so a splice directly inside one at the evaluating level + has nothing to splice into. *) + parse_rejects "~~@x" "(defn f [] Form ``~~@xs)" + ~needle:"nothing here for it to splice into"; (* 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)" From 7abe760288a60c9d42942d4cd7cd1dccb2bab845 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 10:28:32 +0700 Subject: [PATCH 2/6] cond and until are prelude macros, and a macro module holds only the macros its forms reach --- TODO.org | 13 ++++--- docs/BUILT.md | 22 +++++++++++ emacs/flan-mode.el | 6 ++- emacs/test-flan-mode.el | 3 ++ lib/macro.ml | 51 +++++++++++++++++++++++++ lib/parse.ml | 27 ++------------ lib/prelude.ml | 83 +++++++++++++++++++++++++++++++++++++++-- test/test_flan.ml | 21 ++++++++++- 8 files changed, 192 insertions(+), 34 deletions(-) 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" From e9e151e1a478c6e28e4a906890f926bc44e6f7d2 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 10:33:22 +0700 Subject: [PATCH 3/6] A match over an enum names its members as keywords and is refused when it misses one --- TODO.org | 10 +++-- lib/ast.ml | 1 + lib/check.ml | 83 ++++++++++++++++++++++++++++------- lib/load.ml | 2 +- lib/parse.ml | 14 ++---- test/programs/match-enum.flan | 36 +++++++++++++++ test/test_acceptance.ml | 12 +++++ test/test_flan.ml | 43 ++++++++++++------ 8 files changed, 156 insertions(+), 45 deletions(-) create mode 100644 test/programs/match-enum.flan diff --git a/TODO.org b/TODO.org index 7d72ce13..24edcfed 100644 --- a/TODO.org +++ b/TODO.org @@ -291,9 +291,13 @@ keyword resolves against the expected type and against nothing else, so two enum could always share a member spelling. What the prefix buys is the call site read on its own. -** TODO match over enums -Fully desugarable and wanted, blocked only on =Ast.pattern= needing a keyword -case. +** DONE match over enums +CLOSED: [2026-09-25] +=Ast.Pkw= is the keyword pattern; =Check.check_match= resolves it against the +scrutinee's enum and lowers the match to one temporary and a chain of =if (= t +:member)=, the last arm untested. Exhaustiveness is the data type's rule: refused, +not defaulted. Rules out a new IR node for it, and a keyword arm over an Option or +a data type. ** DONE defdata is the tagged sum, defunion is C's untagged one CLOSED: [2026-09-17] diff --git a/lib/ast.ml b/lib/ast.ml index 41708a09..459bd53d 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -204,6 +204,7 @@ and arm = { pat : pattern; body : expr list; aloc : Loc.t } and pattern = | Pctor of string * string list (* (Some e) (Rect w h) None *) + | Pkw of string (* :north — an enum member *) | Pwild (* _ :else *) (* ── Declarations ──────────────────────────────────────────────────── *) diff --git a/lib/check.ml b/lib/check.ml index 64e43869..892caf11 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -5639,17 +5639,11 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = | Types.Option t -> `Option t | Types.Named n when Hashtbl.mem ctx.env.datas n -> `Data (Hashtbl.find ctx.env.datas n) - (* An enum is the one scrutinee that is not a milestone away: it is an i32 - at run time and its members are all known, so the arms would be a chain - of [=] with an exhaustiveness check over [env.enums] — a desugaring, not - a new IR node. What blocks it is upstream of here: a keyword has no case - in [Ast.pattern], and [lib/load.ml] matches that type exhaustively, so - the variant cannot be added. Said as itself rather than folded into the - milestone answer below, because the milestone is not the reason. *) - | Types.Enum n -> - fail loc - "match over the enum %s is not implemented — use cond with \ - (= k :member)" n + (* An enum is an i32 at run time and its members are all known, so the + arms are a chain of [=] over a temporary, built at the foot of this + function — a desugaring, not a new IR node. The exhaustiveness check is + the one a data type gets. *) + | Types.Enum n -> `Enum (n, Hashtbl.find ctx.env.enums n) (* An untagged union has nothing for the arms to be alternatives over. This is not a milestone and not a missing lowering: [match] reads a tag and decides, and the absence of a tag is the whole definition of this @@ -5661,7 +5655,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = so there is nothing to match on. Read the member you mean with \ (.member u), or use a defdata" n | other -> - fail loc "match works on an Option or a data type, not on %s" + fail loc "match works on an Option, a data type or an enum, not on %s" (Types.to_string other) in (* Which case each arm names, and the type of each name it binds. This is the @@ -5678,6 +5672,33 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = | `Option _, Ast.Pctor (c, _) -> fail a.Ast.aloc "%s is not a case of Option — the cases are Some and None" c + | `Enum (n, members), Ast.Pkw k -> + if not (List.mem_assoc k members) then begin + let all = + String.concat " " (List.map (fun (m, _) -> ":" ^ m) members) + in + match member_near_miss members k with + | Some (m, _) -> + fail a.Ast.aloc "%s has no member :%s — did you mean :%s? It has %s" + n k m all + | None -> fail a.Ast.aloc "%s has no member :%s — it has %s" n k all + end; + Some k, [] + | `Enum (n, members), Ast.Pctor (c, _) -> + fail a.Ast.aloc + "this match is over the enum %s, and %s is not one of its members. An \ + arm names a member as a keyword: %s" n c + (String.concat " " (List.map (fun (m, _) -> ":" ^ m) members)) + | `Option _, Ast.Pkw k -> + fail a.Ast.aloc + ":%s is an enum member, and this match is over an Option, whose arms \ + are (Some x) and None" k + | `Data u, Ast.Pkw k -> + fail a.Ast.aloc + ":%s is an enum member, and this match is over the data type %s, \ + whose arms name its cases: %s" k u.Tast.dname + (String.concat ", " + (List.map (fun (v : Tast.variant) -> v.Tast.vname) u.Tast.cases)) | `Data u, Ast.Pctor (c, names) -> (* A pattern names the case bare: the scrutinee's type already says which data type, so [(Node l r)] is unambiguous even where two data types @@ -5727,7 +5748,8 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = | None -> saw_wild := true | Some c -> if Hashtbl.mem seen c then - fail a.Ast.aloc "this match has two %s arms" c; + fail a.Ast.aloc "this match has two %s arms" + (match subject with `Enum _ -> ":" ^ c | _ -> c); Hashtbl.add seen c ()); branch ctx (fun () -> (* What each name in this arm is, in words, for the one refusal @@ -5780,21 +5802,50 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = if Hashtbl.mem seen c.Tast.vname then None else Some (u.Tast.dname ^ "." ^ c.Tast.vname)) u.Tast.cases + | `Enum (_, members) -> + List.filter_map + (fun (m, _) -> if Hashtbl.mem seen m then None else Some (":" ^ m)) + members in if not !saw_wild && missing <> [] then (* The data type's declaration, because that is where the case list this match failed to cover actually lives, and because adding a case there is what makes a match non-exhaustive in the first place. *) Loc.failk "check/non-exhaustive-match" loc - ~notes:(match subject with `Data u -> declared_note ctx.env u.Tast.dname - | _ -> []) + ~notes:(match subject with + | `Data u -> declared_note ctx.env u.Tast.dname + | `Enum (n, _) -> declared_note ctx.env n + | `Option _ -> []) "this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \ the rest" (String.concat ", " missing) (if List.length missing = 1 then "has" else "have") (if List.length missing = 1 then "it" else "them"); let ty = match !want with Some t -> t | None -> Types.Never in - mk loc ty (Tast.Match (s, arms)) + match subject with + | `Option _ | `Data _ -> mk loc ty (Tast.Match (s, arms)) + | `Enum (_, members) -> + (* The scrutinee once, into a temporary, and then an [if] per arm in the + order written. A [_] arm ends the chain, and so does the last arm of a + match with none: it is exhaustive by the check above, so the last + member's test is the only one left and cannot fail on a value the enum + declares. *) + let slot = fresh_slot ctx s.Tast.ty in + let local = mk loc s.Tast.ty (Tast.Local slot) in + let body (a : Tast.arm) = + match a.Tast.abody with [ b ] -> b | bs -> mk loc ty (Tast.Do bs) + in + let rec chain = function + | [] -> unit_at loc + | ({ Tast.acase = None; _ } as a) :: _ -> body a + | [ a ] -> body a + | ({ Tast.acase = Some m; _ } as a) :: rest -> + let v = mk loc s.Tast.ty (Tast.Int (List.assoc m members, Types.I32)) in + mk loc ty + (Tast.If (mk loc Types.Bool (Tast.Prim (Tast.Eq, [ local; v ])), + body a, chain rest)) + in + mk loc ty (Tast.Let ([ (slot, s) ], [ chain arms ])) (* ── Places ────────────────────────────────────────────────────────── *) diff --git a/lib/load.ml b/lib/load.ml index a3f28a9b..17d9b0c8 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -263,7 +263,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = let bound = match a.Ast.pat with | Ast.Pctor (_, ns) -> ns @ bound - | Ast.Pwild -> bound + | Ast.Pkw _ | Ast.Pwild -> bound in { a with Ast.body = List.map (rename_expr owned alias bound) a.Ast.body }) arms) diff --git a/lib/parse.ml b/lib/parse.ml index 3402fa32..3458841b 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -1187,17 +1187,9 @@ and pattern (f : Form.t) : Ast.pattern = | Sym "_" -> Ast.Pwild | Kw "else" -> Ast.Pwild | Sym ctor -> Ast.Pctor (ctor, []) - (* An enum member, which is the one other thing [match] could plausibly be - over: an enum is an i32 at run time, so the arms would be a chain of [=] - and the members are all known, which is exhaustiveness [cond] cannot give. - What stops it is not the lowering, it is that a keyword pattern needs a - case in [Ast.pattern] — and [lib/load.ml] matches that type exhaustively, - so the variant cannot be added from here. Refused by name rather than - spelled as a constructor it is not. *) - | Kw member -> - fail f - ":%s is not implemented as a pattern — use cond with (= k :%s)" - member member + (* An enum member. Which enum is the scrutinee's type, so [Check] resolves + it, as it resolves a keyword anywhere an enum is expected. *) + | Kw member -> Ast.Pkw member | List ({ v = Sym ctor; _ } :: binds) -> List.iter no_pattern binds; Ast.Pctor (ctor, List.map sym binds) diff --git a/test/programs/match-enum.flan b/test/programs/match-enum.flan new file mode 100644 index 00000000..01123a06 --- /dev/null +++ b/test/programs/match-enum.flan @@ -0,0 +1,36 @@ +;;;; match over an enum: the arms name members as keywords, a _ arm is the +;;;; rest, and a match that names neither every member nor _ is refused. + +(defenum Dir [north east south west]) + +(defn turn [d Dir] Dir + (match d + :north :east + :east :south + :south :west + :west :north)) + +(defn name [d Dir] string + (match d + :north "north" + :south "south" + _ "sideways")) + +(defn calls [] i32 + (print "(called) ") + 0) + +;; The scrutinee is evaluated once, however many arms test it. +(defn once [] Dir + (calls) + :west) + +(defn main [] i32 + (println (name :north)) + (println (name (turn :north))) + (println (name (turn (turn :north)))) + (println (name (once))) + (match (turn :west) + :north (println "back to north") + _ (println "somewhere else")) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 005fad8d..66c2d732 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -420,6 +420,18 @@ let () = chain_out; outputs ~x86:true "chained comparisons, --x86" "programs/chain.flan" chain_out; + (* match over an enum lowers to a chain of [=] over one temporary, so + "(called) " printed once is the scrutinee evaluated once. *) + let match_enum_out = + "north\nsideways\nsouth\n(called) sideways\nback to north\n" + in + outputs "match over an enum" "programs/match-enum.flan" match_enum_out; + outputs ~opt:"-O0" "match over an enum, -O0" "programs/match-enum.flan" + match_enum_out; + outputs ~x86:true "match over an enum, --x86" "programs/match-enum.flan" + match_enum_out; + outputs ~dev:true "match over an enum, dev" "programs/match-enum.flan" + match_enum_out; (* The count is [length] so that [len] is left to programs, and this is the claim that it really is one: a local holding a count, a parameter, and a defn the program calls by its bare name, all of diff --git a/test/test_flan.ml b/test/test_flan.ml index 4772008a..1121dbc2 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -4091,22 +4091,37 @@ let () = (* ── match over an enum ────────────────────────────────────────── *) - (* Not shipped, and refused twice over because there are two ways to write it - and they fail in different files. Both now say the same thing, which is the - point: the lowering is not what is missing — a keyword has no case in - [Ast.pattern], and [lib/load.ml] matches that type exhaustively. *) - rejects_check "match over an enum, members written as keywords" - "(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k :lo 1 :hi 2))" - ~needle:"is not implemented as a pattern"; + (* The arms name members as keywords, and the lowering is a chain of [=] + over one temporary, so the exhaustiveness rule is the data type's: + refused, not defaulted. *) + let k = "(defenum K [lo 0 hi 1 mid 2])\n" in + accepts "match over an enum, every member named" + (k ^ "(defn f [k K] i32 (match k :lo 1 :hi 2 :mid 3))"); + accepts "match over an enum, with _ for the rest" + (k ^ "(defn f [k K] i32 (match k :lo 1 _ 2))"); + accepts "match over an enum, :else for the rest" + (k ^ "(defn f [k K] i32 (match k :lo 1 :else 2))"); + rejects_check "match over an enum that misses a member" + (k ^ "(defn f [k K] i32 (match k :lo 1 :hi 2))") + ~needle:"this match is not exhaustive — :mid has no arm"; + rejects_check "a member the enum does not have" + (k ^ "(defn f [k K] i32 (match k :low 1 _ 2))") + ~needle:"K has no member :low — did you mean :lo?"; + rejects_check "a member named twice" + (k ^ "(defn f [k K] i32 (match k :lo 1 :lo 2 _ 3))") + ~needle:"this match has two :lo arms"; rejects_check "match over an enum, members written as names" - "(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k lo 1 hi 2))" - ~needle:"match over the enum K is not implemented"; - (* The old message blamed milestone 2, which was never the reason, and the - milestone has since arrived: match now works over a declared data type as - well, so the message names both subjects and no milestone. *) - rejects_check "match over something that is neither" + (k ^ "(defn f [k K] i32 (match k lo 1 _ 2))") + ~needle:"lo is not one of its members. An arm names a member as a keyword: :lo :hi :mid"; + rejects_check "a keyword arm over an Option" + "(defn f [o (Option i32)] i32 (match o :lo 1 _ 2))" + ~needle:"whose arms are (Some x) and None"; + rejects_check "arms of different types" + (k ^ "(defn f [k K] i32 (match k :lo 1 _ \"x\"))") + ~needle:"expected i32, found string"; + rejects_check "match over something that is none of them" "(defn f [n i32] i32 (match n _ 2))" - ~needle:"match works on an Option or a data type, not on i32"; + ~needle:"match works on an Option, a data type or an enum, not on i32"; (* A destructuring pattern in an arm's binds is a name position like any other. *) rejects_check "a pattern inside a match arm's binds" From 60ef7b2e06ecdcfec69c70b5ff6caa27783bdc7c Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 10:39:42 +0700 Subject: [PATCH 4/6] A recur from an arm of a match over an enum is in tail position, and a session's blind spot for macros an expansion defines is recorded --- TODO.org | 6 ++++++ lib/macro.ml | 8 ++++---- test/programs/match-enum.flan | 8 ++++++++ test/test_acceptance.ml | 2 +- 4 files changed, 19 insertions(+), 5 deletions(-) diff --git a/TODO.org b/TODO.org index 24edcfed..28d1e7ab 100644 --- a/TODO.org +++ b/TODO.org @@ -90,6 +90,12 @@ 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 A session does not remember a macro that an expansion defined +=Session.own_macros= reads =defmacro= heads off the forms as sent, so after +=(defsquare sq)= is evaluated the session's next form cannot call =sq=. A build +sees the whole file and can. The fix is collecting from the expanded forms, +which =Load.program= does not hand back. + ** 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 diff --git a/lib/macro.ml b/lib/macro.ml index ef998045..3a850ece 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -601,10 +601,10 @@ let loaded_for (forms : Form.t list) : loaded option = 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 - 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. *) + (* A file that calls no macro costs one scan and no module. Few do, since + cond is a macro; for a file with no macros of its own the module is the + prelude's alone, one cached .so shared by every such file, so the usual + cost is a stat and a dlopen. *) if all = [] || not (List.exists (names_macro all) forms) then None else begin let extra = rounds ~prelude mine in diff --git a/test/programs/match-enum.flan b/test/programs/match-enum.flan index 01123a06..a7ba148a 100644 --- a/test/programs/match-enum.flan +++ b/test/programs/match-enum.flan @@ -25,7 +25,15 @@ (calls) :west) +;; recur from inside an arm: the arm is the loop's tail. +(defn steps-to-west [from Dir] i32 + (loop [d from n 0] + (match d + :west n + _ (recur (turn d) (+ n 1))))) + (defn main [] i32 + (print (steps-to-west :north)) (println "") (println (name :north)) (println (name (turn :north))) (println (name (turn (turn :north)))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 66c2d732..3e773f43 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -423,7 +423,7 @@ let () = (* match over an enum lowers to a chain of [=] over one temporary, so "(called) " printed once is the scrutinee evaluated once. *) let match_enum_out = - "north\nsideways\nsouth\n(called) sideways\nback to north\n" + "3\nnorth\nsideways\nsouth\n(called) sideways\nback to north\n" in outputs "match over an enum" "programs/match-enum.flan" match_enum_out; outputs ~opt:"-O0" "match over an enum, -O0" "programs/match-enum.flan" From 08545c757f09f64c00d5525f38ddf2093901ec7c Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 10:48:40 +0700 Subject: [PATCH 5/6] cond is a special form again because the prelude relies on it, and until is a prelude macro because only programs use it --- TODO.org | 10 ++---- docs/BUILT.md | 26 ++++----------- emacs/flan-mode.el | 6 ++-- emacs/test-flan-mode.el | 3 +- lib/macro.ml | 59 +++------------------------------- lib/parse.ml | 20 +++++++++--- lib/prelude.ml | 70 +++-------------------------------------- test/test_flan.ml | 19 ++--------- 8 files changed, 41 insertions(+), 172 deletions(-) diff --git a/TODO.org b/TODO.org index 28d1e7ab..8966ac8c 100644 --- a/TODO.org +++ b/TODO.org @@ -96,14 +96,10 @@ not exported from a package. docs/BUILT.md, "Quasiquote runs before the walk". sees the whole file and can. The fix is collecting from the expanded forms, which =Load.program= does not hand back. -** DONE until and cond are prelude macros; when and dotimes stay special forms +** DONE A form the prelude relies on is built in; a form only programs use is a macro 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". +=cond=, =when= and =dotimes= are special forms in parse.ml; =inc=, =++=, =into=, +=unless=, =until= and =comment= are prelude macros. ** 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 a1203dd6..02f33781 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -3592,27 +3592,13 @@ 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 +### The line between a special form and a macro -`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. +A form the prelude itself relies on is built into the parser: `cond`, `when` and `dotimes`. A form only programs use +is a prelude macro: `inc`, `++`, `into`, `unless`, `until` and `comment`. The reason is `Macro.reduce`: a prelude +function that calls a macro is left out of the module that runs macros, so a form the prelude's own functions use +cannot be a macro without taking those functions away from every macro body. `until` peels an optional leading label +and answers `(while :label (not test) body ...)`. ## `break` and `continue`, and the rule that replaced a blanket refusal diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 3e61f239..d7f25caf 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -146,9 +146,9 @@ of \=`, ~ and ~@, and the sigils are not symbols for a keyword rule to reach. recognises only in order to refuse them, and drawing those as keywords would 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.") +`until' is a macro in the prelude and not a head of `Parse.form'. It stays +here because it is control flow a reader takes for `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 a203fa3d..0c7ea074 100644 --- a/emacs/test-flan-mode.el +++ b/emacs/test-flan-mode.el @@ -405,9 +405,8 @@ ("(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 is a prelude macro, drawn as the control flow it is. ("(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" diff --git a/lib/macro.ml b/lib/macro.ml index 3a850ece..cd354d59 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -549,62 +549,11 @@ 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 - (* A file that calls no macro costs one scan and no module. Few do, since - cond is a macro; for a file with no macros of its own the module is the - prelude's alone, one cached .so shared by every such file, so the usual - cost is a stat and a dlopen. *) + (* The common case by a wide margin, and the reason a build that uses no + macro pays nothing: a file that calls none costs one scan and no + compiler. Without it every build in the suite would link a macro module + for the prelude's macros and pay a clang driver to answer nothing. *) if all = [] || not (List.exists (names_macro all) forms) then None else begin let extra = rounds ~prelude mine in diff --git a/lib/parse.ml b/lib/parse.ml index 3458841b..f675e709 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -361,10 +361,9 @@ 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. [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. *) + (* Sugar, desugared here. [cond], [when] and [dotimes] are special forms + because the prelude relies on them; a form only programs use, such as + [until] or [unless], is a prelude macro. *) (* 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 @@ -377,6 +376,8 @@ 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 @@ -1075,6 +1076,17 @@ 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 d046b44b..f0632c7b 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -2185,64 +2185,8 @@ let source = {flan| `(unless-takes-a-test) `(if (not ~(at args 0)) (do ~@(form-rest args 1))))) -;; ── cond and until ──────────────────────────────────────────────────── +;; ── 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] @@ -2394,14 +2338,10 @@ let source = {flan| `(into-transform-is-map-or-filter-of-one-function ~t) (let [head (at items 0) f (at items 1)] - ;; 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))))))))) + (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)))))))) ;; 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 1121dbc2..0e1eab04 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -783,6 +783,7 @@ 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)"; @@ -1285,24 +1286,10 @@ 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"; + (* until is a prelude macro, and its refusal is a compile-error call in the + expansion. *) 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" From de26d6e625930b4451f01529350583b5959fd7e6 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 11:24:27 +0700 Subject: [PATCH 6/6] ~~@xs splices an unquote per element, a session can call a macro an expansion defined, and an enum member cannot be named else --- TODO.org | 9 ++------- lib/expand.ml | 29 +++++++++++++++++++++++++---- lib/macro.ml | 6 ++++++ lib/parse.ml | 27 ++++++++++++++++++++++++--- lib/prelude.ml | 8 ++++++++ lib/session.ml | 29 ++++++++++++++++++++++++----- test/programs/macro-writing.flan | 15 +++++++++++++++ test/test_acceptance.ml | 2 +- test/test_flan.ml | 23 ++++++++++++++++++++--- test/test_session.ml | 20 ++++++++++++++++++++ 10 files changed, 145 insertions(+), 23 deletions(-) diff --git a/TODO.org b/TODO.org index f5269f09..40ebfa21 100644 --- a/TODO.org +++ b/TODO.org @@ -86,16 +86,11 @@ CLOSED: [2026-09-25] =Expand.quote= counts depth the way SBCL's =*backquote-depth*= does: an unquote belongs to the innermost quasiquote and =~~x= reaches out two levels; deeper forms come back as data. A macro's answer is desugared again, and a top-level -expansion that defines a macro re-runs the expander. =~~@x= is refused. There is +expansion that defines a macro re-runs the expander, in a build and in a session. +=~~@x= splices an unquote per element, SBCL's =unquote*=. 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 A session does not remember a macro that an expansion defined -=Session.own_macros= reads =defmacro= heads off the forms as sent, so after -=(defsquare sq)= is evaluated the session's next form cannot call =sq=. A build -sees the whole file and can. The fix is collecting from the expanded forms, -which =Load.program= does not hand back. - ** DONE A form the prelude relies on is built in; a form only programs use is a macro CLOSED: [2026-09-25] =cond=, =when= and =dotimes= are special forms in parse.ml; =inc=, =++=, =into=, diff --git a/lib/expand.ml b/lib/expand.ml index 455aa1cd..e1319623 100644 --- a/lib/expand.ml +++ b/lib/expand.ml @@ -302,14 +302,35 @@ let rec quote ?(depth = 1) (f : Form.t) : Form.t = and seq ~depth loc items = List.fold_left (fun acc (item : Form.t) -> - match splice_of item with - | Some x when depth = 1 -> - lst item.Form.loc [ sym item.Form.loc "form-append"; x; acc ] - | _ -> + match spliced ~depth 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 ~depth item; acc ]) (lst loc [ sym loc "form-nil" ]) (List.rev items) +(* The slice an item splices in, when it splices at all. At depth 1 that is + ~@x. Deeper, an unquote whose own argument splices at the level below — + [~~@xs] — splices too: one (unquote x) per element, which is SBCL's + [unquote*] in src/code/backq.lisp, so the inner template receives ~a ~b ~c. + [~@~@xs] is the same with (unquote-splicing x). *) +and spliced ~depth (item : Form.t) : Form.t option = + let loc = item.Form.loc in + match splice_of item with + | Some x when depth = 1 -> Some x + | _ when depth = 1 -> None + | _ -> + let wrap head x = + match spliced ~depth:(depth - 1) x with + | Some e -> + Some (lst loc [ sym loc "form-wrap-each"; Form.make (Form.Str head) loc; e ]) + | None -> None + in + match unquote_of item, splice_of item with + | Some x, _ -> wrap "unquote" x + | _, Some x -> wrap "unquote-splicing" x + | None, None -> None + (* 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. *) diff --git a/lib/macro.ml b/lib/macro.ml index cd354d59..ae2577e7 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -592,6 +592,12 @@ let rec program_n left (forms : Form.t list) : Form.t list = let before = macros_in forms in let out = with_module l (fun () -> List.map (expand_form l) forms) in let fresh = List.filter (fun n -> not (List.mem n before)) (macros_in out) in + Parse.expansion_macros := + !Parse.expansion_macros + @ List.filter + (fun f -> match macro_name f with + | Some n -> List.mem n fresh | None -> false) + out; if fresh = [] then out else if left <= 0 then Loc.fail diff --git a/lib/parse.ml b/lib/parse.ml index 4c8b1025..519103b1 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -1619,10 +1619,24 @@ let rec decl (f : Form.t) : Ast.decl = (* Each member becomes its name, its value, whether that value was written, and where the name is. The last two exist only so the refusals here and below can be made; neither reaches the AST. *) + (* :else is match's catch-all, so a member spelled else could be + written everywhere but in a match arm, where it would mean every + member. Refused here rather than quietly shadowed there. *) + let member_ok (mf : Form.t) = + no_sigil mf; + match mf.v with + | Form.Sym "else" -> + Loc.failk "parse/enum-member-else" mf.loc + "%s cannot have a member named else: :else is the catch-all arm \ + of a match, so a match could never name this member. Rename \ + it, for example to otherwise" + ename + | _ -> () + in let rec members next = function | [] -> [] | ({ v = Form.Sym m; loc } as mf) :: { v = Form.Int k; _ } :: rest -> - no_sigil mf; + member_ok mf; (* The [let] is load-bearing rather than tidiness. OCaml leaves the evaluation order of [::]'s two operands unspecified and in practice takes the tail first, so an inlined [fits ... k] would @@ -1639,14 +1653,14 @@ let rec decl (f : Form.t) : Ast.decl = number written; refused in the spelling it was written in. *) | ({ v = Form.Sym m; _ } as mf) :: { v = Form.UInt (_, text); loc = vloc } :: _ -> - no_sigil mf; + member_ok mf; Loc.failk "parse/enum-value-out-of-range" vloc "the member %s of %s is %s, which does not fit i32 — an enum's \ members run from -2147483648 to 2147483647. Give %s a value in \ that range, or use a defconst" m ename text m | ({ v = Form.Sym m; loc } as mf) :: rest -> - no_sigil mf; + member_ok mf; let next = fits m loc ~explicit:false next in (m, next, false, loc) :: members (Int64.add next 1L) rest | bad :: _ -> @@ -1900,6 +1914,13 @@ let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs) whole of an evaluation. Empty is the ordinary case and costs nothing. *) let imported_macros : Form.t list ref = ref [] +(* Every [defmacro] an expansion produced at the top level, already desugared, + appended by [Macro.program]. A build needs nothing from it — the expander + re-runs over the whole file itself — but a session learns its macros from + the forms it was sent, and [(defsq sq)] sends no [defmacro]. The session + empties it before an evaluation and reads it after. *) +let expansion_macros : Form.t list ref = ref [] + (* What those macros are allowed to *call*, and it is the same list the importing program gets: the package's declarations, qualified under the alias, as [Load] already built them. diff --git a/lib/prelude.ml b/lib/prelude.ml index ef6aed24..7187b1d5 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -2120,6 +2120,14 @@ let source = {flan| (set i (+ i 1))) (slice v))) +;; (head x) for every x, which is what ~~@xs splices into an inner template: +;; one unquote per element, as SBCL's unquote* builds (src/code/backq.lisp). +(defn form-wrap-each [head string xs [Form]] [Form] + (let [v (vec-new Form)] + (dotimes [i (length xs)] + (push v (Form.List {.xs (form-pair (Form.Sym {.s head}) (at xs i))}))) + (slice v))) + ;; The elements of a vector form, which is what a [ ] pattern in a macro's ;; parameter list unwraps. The other arm is unreachable from a generated ;; binding -- lib/expand.ml's check_call refuses a non-vector argument at the diff --git a/lib/session.ml b/lib/session.ml index 00a4c241..634ff648 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -111,15 +111,33 @@ let own_macros (forms : Form.t list) : Form.t list = | _ -> None) forms +(* The macros [load] defined by expanding [forms], beside the ones written in + them: [(defsq sq)] defines [sq] without a [defmacro] in sight, and the next + evaluation has to be able to call it. Only those expanded from these forms' + own file — [Load.program] also parses the packages they import, and a macro + a package's expansion defined belongs to the package. Written first, so an + expansion's newer body wins as a [defmacro]'s does. *) +let with_expansion_macros (forms : Form.t list) (load : unit -> 'a) : 'a * Form.t list = + Parse.expansion_macros := []; + let r = load () in + let files = List.map (fun (f : Form.t) -> f.Form.loc.Loc.file) forms in + let defined = + List.filter + (fun (f : Form.t) -> List.mem (Loc.call_site f.Form.loc).Loc.file files) + !Parse.expansion_macros + in + Parse.expansion_macros := []; + (r, Load.macro_union (own_macros forms) defined) + let create ?(debug = false) ?(x86 = false) ~file () = let forms = Reader.read_file file in - let l = Load.program ~file forms in + let l, mine = with_expansion_macros forms (fun () -> Load.program ~file forms) in let p, env = Check.program_with_env l.Load.decls in ({ file; decls = l.Load.decls; program = p; env; host = p; pkgs = l.Load.pkgs; (* The file's own first, so that if the file being edited is itself a package the program imports, the bare name wins for a form typed into that buffer. [macro_union] keeps the left. *) - macros = Load.macro_union (own_macros forms) l.Load.macros; + macros = Load.macro_union mine l.Load.macros; thunks = 0; debug; x86 }, l) (* What a macro may call, for the same reason [macros] is held: an evaluation @@ -594,7 +612,9 @@ let eval ?(origin = "") ?pause t src : change = the duplicate-name pass would reject it. *) let macros = ref t.macros in let incoming = - let l = Load.program ~file:t.file forms in + let l, mine = + with_expansion_macros forms (fun () -> Load.program ~file:t.file forms) + in (* An evaluated import *adds* to the session's set, so a macro brought in by C-c C-k is there for the C-c C-c after it. A union and not an assignment: [Load.program] answers the macros of the imports it was @@ -632,8 +652,7 @@ let eval ?(origin = "") ?pause t src : change = name. [Macro.program] dedupes the same way on the same rule, because while this parse runs the old copy is still ambient. *) macros := - Load.macro_union (own_macros forms) - (Load.macro_union l.Load.macros t.macros); + Load.macro_union mine (Load.macro_union l.Load.macros t.macros); let ds = l.Load.decls in match package_of t origin with | None -> ds diff --git a/test/programs/macro-writing.flan b/test/programs/macro-writing.flan index e7102fc3..83888893 100644 --- a/test/programs/macro-writing.flan +++ b/test/programs/macro-writing.flan @@ -30,7 +30,20 @@ `(defmacro ~inner [x] `(* ~x ~x)))) +;; ~~@xs: each form the outer macro was handed becomes one ~x in the inner +;; template, in a list and in a vector. +(defmacro defmany [name & xs] + `(defmacro ~name [] + `(+ 0 ~~@xs))) + +(defmacro deflet [name & xs] + `(defmacro ~name [body] + `(let [~~@xs] ~body))) + (defsquare sq) +(defmany six (Form.Int {.i 1}) (Form.Int {.i 2}) (Form.Int {.i 3})) +(deflet with-ab (Form.Sym {.s "a"}) (Form.Int {.i 4}) + (Form.Sym {.s "b"}) (Form.Int {.i 5})) (defadder add5 (Form.Int {.i 5})) (defsum total) (defsquarer defsq2) @@ -41,4 +54,6 @@ (print (add5 10)) (println "") (print (total 1 2 3 4)) (println "") (print (sq2 9)) (println "") + (print (six)) (println "") + (print (with-ab (* a b))) (println "") 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index f1d85516..4ea28b2d 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -4126,7 +4126,7 @@ level "1" (* A quasiquote inside a quasiquote: macros whose expansion is a defmacro, and the macros they define called from main. Two levels deep at the end, which is two re-passes of the expander. *) - let macro_writing_out = "49\n15\n10\n81\n" in + let macro_writing_out = "49\n15\n10\n81\n6\n20\n" in outputs "a macro that writes a macro" "programs/macro-writing.flan" macro_writing_out; outputs ~opt:"-O0" "a macro that writes a macro, -O0" diff --git a/test/test_flan.ml b/test/test_flan.ml index e18b2406..1f20889f 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -684,9 +684,15 @@ let () = (* Three deep: ~~x under three quasiquotes is still data, one level short. *) desugars "~~x under three quasiquotes is data" "```~~x" (wrap "quasiquote" (wrap "quasiquote" (wrap "unquote" (wrap "unquote" (q "x"))))); - (* ~ holds one form, so a splice directly inside one at the evaluating level - has nothing to splice into. *) - parse_rejects "~~@x" "(defn f [] Form ``~~@xs)" + (* ~~@xs inside a bracket splices one (unquote x) per element, SBCL's + unquote*, in a list and in a vector alike. *) + let each = "(form-append (form-wrap-each \"unquote\" xs) (form-nil))" in + desugars "~~@xs in a list splices an unquote per element" "``(~~@xs)" + (wrap "quasiquote" ("(Form.List {.xs " ^ each ^ "})")); + desugars "~~@xs in a vector splices an unquote per element" "``[~~@xs]" + (wrap "quasiquote" ("(Form.Vec {.xs " ^ each ^ "})")); + (* Outside a bracket there is still nothing for it to splice into. *) + parse_rejects "~~@x outside a bracket" "(defn f [] Form ``~~@xs)" ~needle:"nothing here for it to splice into"; (* 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. *) @@ -779,6 +785,12 @@ let () = ~needle:"an enum member is a name, optionally followed by an integer"; parse_rejects "a defenum with no member vector" "(defenum E)" ~needle:"defenum is (defenum Name [member value? ...])"; + (* :else is match's catch-all, so a member named else could never be + matched. *) + parse_rejects "an enum member named else" "(defenum E [foo else])" + ~needle:"E cannot have a member named else: :else is the catch-all arm"; + parse_rejects "an enum member named else, with a value" "(defenum E [else 3])" + ~needle:"cannot have a member named else"; (* ── Malformed syntax is caught with a location ────────────────── *) parse_rejects "odd let bindings" "(let [a])"; @@ -4089,6 +4101,11 @@ let () = (k ^ "(defn f [k K] i32 (match k :lo 1 _ 2))"); accepts "match over an enum, :else for the rest" (k ^ "(defn f [k K] i32 (match k :lo 1 :else 2))"); + (* A data type's case is matched by a symbol, not a keyword, so a case + named else does not collide with :else and is not refused. *) + accepts "a data case named else is matched by name" + "(defdata D [(else) (foo [x i32])])\n\ + (defn f [d D] i32 (match d else 1 (foo x) x))"; rejects_check "match over an enum that misses a member" (k ^ "(defn f [k K] i32 (match k :lo 1 :hi 2))") ~needle:"this match is not exhaustive — :mid has no arm"; diff --git a/test/test_session.ml b/test/test_session.ml index 78a3936d..869f444e 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -730,6 +730,26 @@ let () = | exception Loc.Error { Loc.dmsg = m; _ } -> fail "an edited defmacro: %s" m); + (* A macro that an expansion defined joins the session too. [(defsq sq6)] + sends no [defmacro], so reading the forms as sent would miss it and the + next evaluation would call [sq6] as a function taking a Form. *) + (match Session.eval ~origin:"programs/pkg-macro.flan" tm + "(defmacro defsq [name] `(defmacro ~name [x] `(* ~x ~x)))" + with + | _ -> () + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "evaluating a macro-writing defmacro: %s" m); + (match Session.eval ~origin:"programs/pkg-macro.flan" tm "(defsq sq6)" with + | _ -> () + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "evaluating a call to a macro-writing macro: %s" m); + (match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(sq6 6)" with + | c -> + if not (has c.Session.ir "6, 6") then + fail "a macro defined by an expansion did not expand to its body" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a macro defined by an expansion, called in the session: %s" m); + (* A mistake in a body the macro spliced, reported where it was written. Same machinery as a build — [Macro.expand_form] and [Expand.call] — and the point of asking it here is that the editor is where it is read: C-c