A quasiquote nests as SBCL's does, a match takes an enum, and until is a prelude macro

This commit is contained in:
Joseph Ferano 2026-09-25 11:27:14 +07:00
commit 9e26275f9b
17 changed files with 504 additions and 100 deletions

View File

@ -81,16 +81,20 @@ 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 the program's module, and every expansion in a session. Rules out a counter per
module, seeded or not. module, seeded or not.
** NEXT A quasiquote inside a quasiquote is refused ** DONE A quasiquote inside a quasiquote nests
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. CLOSED: [2026-09-25]
Nothing counts nesting levels — not the reader, deliberately, and not the =Expand.quote= counts depth the way SBCL's =*backquote-depth*= does: an unquote
desugaring. Only a macro that writes a macro wants one. 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, 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 until, cond, when and dotimes are still special forms in parse.ml ** DONE A form the prelude relies on is built in; a form only programs use is a macro
=until= and =cond= are free to move to the prelude whenever somebody wants them. CLOSED: [2026-09-25]
=when= and =dotimes= are not: the prelude uses them 29 and 12 times, so moving =cond=, =when= and =dotimes= are special forms in parse.ml; =inc=, =++=, =into=,
either makes the prelude depend on the macro the macro module has to compile the =unless=, =until= and =comment= are prelude macros.
prelude to get. =cond= also has a =(cond a)= refusal a macro cannot produce.
** DONE Macros are imported from a package ** DONE Macros are imported from a package
The old refusal claimed collecting a package's macros needed a second import The old refusal claimed collecting a package's macros needed a second import
@ -305,9 +309,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 could always share a member spelling. What the prefix buys is the call site read
on its own. on its own.
** TODO match over enums ** DONE match over enums
Fully desugarable and wanted, blocked only on =Ast.pattern= needing a keyword CLOSED: [2026-09-25]
case. =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 ** DONE defdata is the tagged sum, defunion is C's untagged one
CLOSED: [2026-09-17] CLOSED: [2026-09-17]

View File

@ -3628,8 +3628,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 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. 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 Nesting levels are counted by the desugaring and not by the reader, which stays as it was written. A quasiquote
desugaring. A quasiquote inside a quasiquote is refused by name. Only a macro that writes a macro wants one. 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 ### A call inside a quasiquote is output, not a dependency
@ -3724,6 +3738,14 @@ 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 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. `sand.flan` and `web/examples/control.flan`, and both compile unchanged.
### The line between a special form and a macro
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 ## `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 Declined once deliberately; TODO.org, "break and continue, with loop labels", records what was settled then and still

View File

@ -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. of \=`, ~ and ~@, and the sigils are not symbols for a keyword rule to reach.
`find-restart', `compute-restarts', `errdefer' and `await' the parser `find-restart', `compute-restarts', `errdefer' and `await' the parser
recognises only in order to refuse them, and drawing those as keywords would 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.
`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 (defconst flan--builtins
'(;; arithmetic, comparison, bits '(;; arithmetic, comparison, bits

View File

@ -454,6 +454,8 @@
font-lock-keyword-face "handler-case") font-lock-keyword-face "handler-case")
;; Special forms the old list had never heard of. ;; Special forms the old list had never heard of.
("(cond (= a 1) 2)" "cond" font-lock-keyword-face "cond") ("(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") ("(and a b)" "and" font-lock-keyword-face "and")
("(handler-bind [(E [c] 1)] (go))" "handler-bind" ("(handler-bind [(E [c] 1)] (go))" "handler-bind"
font-lock-keyword-face "handler-bind") font-lock-keyword-face "handler-bind")

View File

@ -204,6 +204,7 @@ and arm = { pat : pattern; body : expr list; aloc : Loc.t }
and pattern = and pattern =
| Pctor of string * string list (* (Some e) (Rect w h) None *) | Pctor of string * string list (* (Some e) (Rect w h) None *)
| Pkw of string (* :north — an enum member *)
| Pwild (* _ :else *) | Pwild (* _ :else *)
(* ── Declarations ──────────────────────────────────────────────────── *) (* ── Declarations ──────────────────────────────────────────────────── *)

View File

@ -5760,17 +5760,11 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
| Types.Option t -> `Option t | Types.Option t -> `Option t
| Types.Named n when Hashtbl.mem ctx.env.datas n -> | Types.Named n when Hashtbl.mem ctx.env.datas n ->
`Data (Hashtbl.find 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 (* An enum is an i32 at run time and its members are all known, so the
at run time and its members are all known, so the arms would be a chain arms are a chain of [=] over a temporary, built at the foot of this
of [=] with an exhaustiveness check over [env.enums] — a desugaring, not function — a desugaring, not a new IR node. The exhaustiveness check is
a new IR node. What blocks it is upstream of here: a keyword has no case the one a data type gets. *)
in [Ast.pattern], and [lib/load.ml] matches that type exhaustively, so | Types.Enum n -> `Enum (n, Hashtbl.find ctx.env.enums n)
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 untagged union has nothing for the arms to be alternatives over. (* 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 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 and decides, and the absence of a tag is the whole definition of this
@ -5782,7 +5776,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
so there is nothing to match on. Read the member you mean with \ so there is nothing to match on. Read the member you mean with \
(.member u), or use a defdata" n (.member u), or use a defdata" n
| other -> | 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) (Types.to_string other)
in in
(* Which case each arm names, and the type of each name it binds. This is the (* Which case each arm names, and the type of each name it binds. This is the
@ -5799,6 +5793,33 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
| `Option _, Ast.Pctor (c, _) -> | `Option _, Ast.Pctor (c, _) ->
fail a.Ast.aloc fail a.Ast.aloc
"%s is not a case of Option — the cases are Some and None" c "%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) -> | `Data u, Ast.Pctor (c, names) ->
(* A pattern names the case bare: the scrutinee's type already says which (* 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 data type, so [(Node l r)] is unambiguous even where two data types
@ -5848,7 +5869,8 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
| None -> saw_wild := true | None -> saw_wild := true
| Some c -> | Some c ->
if Hashtbl.mem seen c then 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 ()); Hashtbl.add seen c ());
branch ctx (fun () -> branch ctx (fun () ->
(* What each name in this arm is, in words, for the one refusal (* What each name in this arm is, in words, for the one refusal
@ -5901,21 +5923,50 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
if Hashtbl.mem seen c.Tast.vname then None if Hashtbl.mem seen c.Tast.vname then None
else Some (u.Tast.dname ^ "." ^ c.Tast.vname)) else Some (u.Tast.dname ^ "." ^ c.Tast.vname))
u.Tast.cases u.Tast.cases
| `Enum (_, members) ->
List.filter_map
(fun (m, _) -> if Hashtbl.mem seen m then None else Some (":" ^ m))
members
in in
if not !saw_wild && missing <> [] then if not !saw_wild && missing <> [] then
(* The data type's declaration, because that is where the case list this match (* 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 failed to cover actually lives, and because adding a case there is what
makes a match non-exhaustive in the first place. *) makes a match non-exhaustive in the first place. *)
Loc.failk "check/non-exhaustive-match" loc 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 \ "this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \
the rest" the rest"
(String.concat ", " missing) (String.concat ", " missing)
(if List.length missing = 1 then "has" else "have") (if List.length missing = 1 then "has" else "have")
(if List.length missing = 1 then "it" else "them"); (if List.length missing = 1 then "it" else "them");
let ty = match !want with Some t -> t | None -> Types.Never in 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 ────────────────────────────────────────────────────────── *) (* ── Places ────────────────────────────────────────────────────────── *)

View File

@ -232,10 +232,8 @@ let call ~loc (fn : Dynload.addr) (args : Form.t list) : Form.t =
The reader stays dumb and produces (quasiquote x), (unquote x) and The reader stays dumb and produces (quasiquote x), (unquote x) and
(unquote-splicing x) with no idea whether one is inside another. Counting (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 levels is this file's job, done in [quote] below. A macro that writes a
is refused by name. A macro that writes a macro is the only thing that wants macro is the only thing that wants a quasiquote inside a quasiquote. *)
one, nothing in the corpus does, and CL's level arithmetic has a real cost
that no use case has asked for. *)
let sym loc s = Form.make (Form.Sym s) loc let sym loc s = Form.make (Form.Sym s) loc
let lst loc xs = Form.make (Form.List xs) loc let lst loc xs = Form.make (Form.List xs) loc
@ -256,46 +254,83 @@ let splice_of (f : Form.t) =
| Form.List [ { Form.v = Form.Sym "unquote-splicing"; _ }; x ] -> Some x | Form.List [ { Form.v = Form.Sym "unquote-splicing"; _ }; x ] -> Some x
| _ -> None | _ -> 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 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 match unquote_of f with
(* The escape: whatever the program wrote, evaluated. It is already a Form, (* The escape: whatever the program wrote, evaluated. It is already a Form,
because a Form is what a macro body deals in. *) 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 -> | None ->
match splice_of f with match splice_of f with
| Some _ -> | Some _ when depth = 1 ->
Loc.fail loc Loc.fail loc
"~@x splices into a list or a vector, and there is nothing here for it \ "~@x splices into a list or a vector, and there is nothing here for it \
to splice into" to splice into"
| Some x -> wrapped "unquote-splicing" (quote ~depth:(depth - 1) x)
| None -> | None ->
match f.Form.v with match f.Form.v with
| Form.List ({ Form.v = Form.Sym "quasiquote"; _ } :: _) -> | Form.List [ { Form.v = Form.Sym "quasiquote"; _ }; x ] ->
Loc.fail loc wrapped "quasiquote" (quote ~depth:(depth + 1) x)
"a quasiquote inside a quasiquote is not implemented — build the \
inner form with form-cons"
| Form.Sym s -> node loc "Sym" "s" (Form.Str s) | Form.Sym s -> node loc "Sym" "s" (Form.Str s)
| Form.Kw s -> node loc "Kw" "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.Int i | Form.UInt (i, _) -> node loc "Int" "i" (Form.Int i)
| Form.Float x -> node loc "Float" "x" (Form.Float x) | Form.Float x -> node loc "Float" "x" (Form.Float x)
| Form.Str s -> node loc "Str" "s" (Form.Str s) | Form.Str s -> node loc "Str" "s" (Form.Str s)
| Form.Byte b -> node loc "Byte" "b" (Form.Int (Int64.of_int b)) | 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.List xs -> node loc "List" "xs" (seq ~depth loc xs).Form.v
| Form.Vec xs -> node loc "Vec" "xs" (seq 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 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, (* 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 so each item is consed onto what follows it and a splice is an append — the
three prelude functions and no fourth. *) three prelude functions and no fourth. A splice deeper than [depth] 1 is
and seq loc items = data like any other item. *)
and seq ~depth loc items =
List.fold_left List.fold_left
(fun acc (item : Form.t) -> (fun acc (item : Form.t) ->
match splice_of item with match spliced ~depth item with
| Some x -> lst item.Form.loc [ sym item.Form.loc "form-append"; x; acc ] | 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 ]) | None ->
lst item.Form.loc [ sym item.Form.loc "form-cons"; quote ~depth item; acc ])
(lst loc [ sym loc "form-nil" ]) (lst loc [ sym loc "form-nil" ])
(List.rev items) (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 (* 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 nothing but Form, which is what lets [Parse] run it on the way in rather
than needing the whole expander wired up first. *) than needing the whole expander wired up first. *)

View File

@ -263,7 +263,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
let bound = let bound =
match a.Ast.pat with match a.Ast.pat with
| Ast.Pctor (_, ns) -> ns @ bound | Ast.Pctor (_, ns) -> ns @ bound
| Ast.Pwild -> bound | Ast.Pkw _ | Ast.Pwild -> bound
in in
{ a with Ast.body = List.map (rename_expr owned alias bound) { a with Ast.body = List.map (rename_expr owned alias bound)
a.Ast.body }) arms) a.Ast.body }) arms)

View File

@ -423,6 +423,12 @@ let rec expand_form (l : loaded) (f : Form.t) : Form.t =
| _ -> f | _ -> f
and settle l first loc (f : Form.t) left = 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 match f.Form.v with
| Form.List ({ Form.v = Form.Sym m; _ } :: args) when List.mem_assoc m l.fns -> | Form.List ({ Form.v = Form.Sym m; _ } :: args) when List.mem_assoc m l.fns ->
if left <= 0 then if left <= 0 then
@ -572,10 +578,34 @@ let with_module (l : loaded) (f : unit -> 'a) : 'a =
Dynload.release ()) Dynload.release ())
f 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 match loaded_for forms with
| None -> forms | 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
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
(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 let () = Parse.expander := program

View File

@ -378,7 +378,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))) | [ 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)") | _ -> 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], [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)] (* 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)] 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 is a guard whose consequent has not been written yet, which is a state a
@ -408,15 +410,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 ...)") 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 (* 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 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 control can only leave a loop it is already in — the same restriction
@ -1229,17 +1222,9 @@ and pattern (f : Form.t) : Ast.pattern =
| Sym "_" -> Ast.Pwild | Sym "_" -> Ast.Pwild
| Kw "else" -> Ast.Pwild | Kw "else" -> Ast.Pwild
| Sym ctor -> Ast.Pctor (ctor, []) | Sym ctor -> Ast.Pctor (ctor, [])
(* An enum member, which is the one other thing [match] could plausibly be (* An enum member. Which enum is the scrutinee's type, so [Check] resolves
over: an enum is an i32 at run time, so the arms would be a chain of [=] it, as it resolves a keyword anywhere an enum is expected. *)
and the members are all known, which is exhaustiveness [cond] cannot give. | Kw member -> Ast.Pkw member
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
| List ({ v = Sym ctor; _ } :: binds) -> | List ({ v = Sym ctor; _ } :: binds) ->
List.iter no_pattern binds; List.iter no_pattern binds;
Ast.Pctor (ctor, List.map dname binds) Ast.Pctor (ctor, List.map dname binds)
@ -1634,10 +1619,24 @@ let rec decl (f : Form.t) : Ast.decl =
(* Each member becomes its name, its value, whether that value was (* Each member becomes its name, its value, whether that value was
written, and where the name is. The last two exist only so the written, and where the name is. The last two exist only so the
refusals here and below can be made; neither reaches the AST. *) 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 let rec members next = function
| [] -> [] | [] -> []
| ({ v = Form.Sym m; loc } as mf) :: { v = Form.Int k; _ } :: rest -> | ({ 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 (* The [let] is load-bearing rather than tidiness. OCaml leaves the
evaluation order of [::]'s two operands unspecified and in evaluation order of [::]'s two operands unspecified and in
practice takes the tail first, so an inlined [fits ... k] would practice takes the tail first, so an inlined [fits ... k] would
@ -1654,14 +1653,14 @@ let rec decl (f : Form.t) : Ast.decl =
number written; refused in the spelling it was written in. *) number written; refused in the spelling it was written in. *)
| ({ v = Form.Sym m; _ } as mf) :: { v = Form.UInt (_, text); loc = vloc } | ({ 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 Loc.failk "parse/enum-value-out-of-range" vloc
"the member %s of %s is %s, which does not fit i32 — an enum's \ "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 \ members run from -2147483648 to 2147483647. Give %s a value in \
that range, or use a defconst" that range, or use a defconst"
m ename text m m ename text m
| ({ v = Form.Sym m; loc } as mf) :: rest -> | ({ v = Form.Sym m; loc } as mf) :: rest ->
no_sigil mf; member_ok mf;
let next = fits m loc ~explicit:false next in let next = fits m loc ~explicit:false next in
(m, next, false, loc) :: members (Int64.add next 1L) rest (m, next, false, loc) :: members (Int64.add next 1L) rest
| bad :: _ -> | bad :: _ ->
@ -1915,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. *) whole of an evaluation. Empty is the ordinary case and costs nothing. *)
let imported_macros : Form.t list ref = ref [] 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 (* What those macros are allowed to *call*, and it is the same list the
importing program gets: the package's declarations, qualified under the importing program gets: the package's declarations, qualified under the
alias, as [Load] already built them. alias, as [Load] already built them.

View File

@ -2141,6 +2141,14 @@ let source = {flan|
(set i (+ i 1))) (set i (+ i 1)))
(slice v))) (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 ;; 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 ;; 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 ;; binding -- lib/expand.ml's check_call refuses a non-vector argument at the
@ -2206,6 +2214,21 @@ let source = {flan|
`(unless-takes-a-test) `(unless-takes-a-test)
`(if (not ~(at args 0)) (do ~@(form-rest args 1))))) `(if (not ~(at args 0)) (do ~@(form-rest args 1)))))
;; ── until ─────────────────────────────────────────────────────────────
;;
;; (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 ───────────────────────────────────────────────────────────
;; ;;
;; (comment (whatever you like)) is nothing at all, and the "whatever you like" ;; (comment (whatever you like)) is nothing at all, and the "whatever you like"

View File

@ -234,15 +234,33 @@ let own_macros (forms : Form.t list) : Form.t list =
| _ -> None) | _ -> None)
forms 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 create ?(debug = false) ?(x86 = false) ~file () =
let forms = Reader.read_file file in 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 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; ({ 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 (* 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 package the program imports, the bare name wins for a form typed into
that buffer. [macro_union] keeps the left. *) 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; thunks = 0; debug; x86;
built = record_built env p p.Tast.fns SM.empty; live = SM.empty }, l) built = record_built env p p.Tast.fns SM.empty; live = SM.empty }, l)
@ -664,7 +682,9 @@ let eval ?(origin = "<eval>") ?pause ?(running = true) t src : change =
the duplicate-name pass would reject it. *) the duplicate-name pass would reject it. *)
let macros = ref t.macros in let macros = ref t.macros in
let incoming = 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 (* 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 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 assignment: [Load.program] answers the macros of the imports it was
@ -702,8 +722,7 @@ let eval ?(origin = "<eval>") ?pause ?(running = true) t src : change =
name. [Macro.program] dedupes the same way on the same rule, because name. [Macro.program] dedupes the same way on the same rule, because
while this parse runs the old copy is still ambient. *) while this parse runs the old copy is still ambient. *)
macros := macros :=
Load.macro_union (own_macros forms) Load.macro_union mine (Load.macro_union l.Load.macros t.macros);
(Load.macro_union l.Load.macros t.macros);
let ds = l.Load.decls in let ds = l.Load.decls in
match package_of t origin with match package_of t origin with
| None -> ds | None -> ds

View File

@ -0,0 +1,59 @@
;;;; 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))))
;; ~~@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)
(defsq2 sq2)
(defn main [] i32
(print (sq 7)) (println "")
(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)

View File

@ -0,0 +1,44 @@
;;;; 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)
;; 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))))
(println (name (once)))
(match (turn :west)
:north (println "back to north")
_ (println "somewhere else"))
0)

View File

@ -420,6 +420,18 @@ let () =
chain_out; chain_out;
outputs ~x86:true "chained comparisons, --x86" "programs/chain.flan" outputs ~x86:true "chained comparisons, --x86" "programs/chain.flan"
chain_out; 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 =
"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"
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 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 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 parameter, and a defn the program calls by its bare name, all of
@ -4121,6 +4133,17 @@ level "1"
outputs ~dev:true "a macro's parameter list, dev" outputs ~dev:true "a macro's parameter list, dev"
"programs/macro-params.flan" macro_params_out; "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\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"
"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 (* 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. *) program is expanded with are different names. 200 is the two colliding. *)
outputs "gensym counts across macro modules" outputs "gensym counts across macro modules"

View File

@ -664,11 +664,36 @@ let () =
commonest thing a macro builds and Form.Vec is not Form.List. *) commonest thing a macro builds and Form.Vec is not Form.List. *)
desugars "a quasiquoted vector stays a vector" "`[~x 1]" desugars "a quasiquoted vector stays a vector" "`[~x 1]"
"(Form.Vec {.xs (form-cons x (form-cons (Form.Int {.i 1}) (form-nil)))})"; "(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, (* Levels are counted here, SBCL's way. The inner quasiquote is data, an
which is why the inner one is refused by name rather than given a meaning unquote belongs to the innermost quasiquote around it, and only the
nobody chose. *) unquotes at depth 1 are evaluated -- everything deeper comes back as the
parse_rejects "a quasiquote inside a quasiquote" "(defn f [] Form `(a `(b)))" (unquote x) it was read as, for the macro the output defines to desugar. *)
~needle:"quasiquote inside a quasiquote"; 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")))));
(* ~~@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 (* 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. *) the reader cannot catch it because it does not track where it is. *)
parse_rejects "unquote outside a quasiquote" "(defn f [] () ~x)" parse_rejects "unquote outside a quasiquote" "(defn f [] () ~x)"
@ -760,6 +785,12 @@ let () =
~needle:"an enum member is a name, optionally followed by an integer"; ~needle:"an enum member is a name, optionally followed by an integer";
parse_rejects "a defenum with no member vector" "(defenum E)" parse_rejects "a defenum with no member vector" "(defenum E)"
~needle:"defenum is (defenum Name [member value? ...])"; ~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 ────────────────── *) (* ── Malformed syntax is caught with a location ────────────────── *)
parse_rejects "odd let bindings" "(let [a])"; parse_rejects "odd let bindings" "(let [a])";
@ -1267,6 +1298,12 @@ let () =
"(defn f [x] () (when x 0))"; "(defn f [x] () (when x 0))";
accepts "dyn cond accepts a non-bool dyn condition" accepts "dyn cond accepts a non-bool dyn condition"
"(defn f [x] dyn (cond x 1 :else 2))"; "(defn f [x] dyn (cond x 1 :else 2))";
(* 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 "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" accepts "dyn and accepts a non-bool dyn operand"
"(defn f [x] i32 (let [y x] (if (and y true) 0 1)))"; "(defn f [x] i32 (let [y x] (if (and y true) 0 1)))";
accepts "dyn or accepts a non-bool dyn operand" accepts "dyn or accepts a non-bool dyn operand"
@ -4054,22 +4091,42 @@ let () =
(* ── match over an enum ────────────────────────────────────────── *) (* ── match over an enum ────────────────────────────────────────── *)
(* Not shipped, and refused twice over because there are two ways to write it (* The arms name members as keywords, and the lowering is a chain of [=]
and they fail in different files. Both now say the same thing, which is the over one temporary, so the exhaustiveness rule is the data type's:
point: the lowering is not what is missing — a keyword has no case in refused, not defaulted. *)
[Ast.pattern], and [lib/load.ml] matches that type exhaustively. *) let k = "(defenum K [lo 0 hi 1 mid 2])\n" in
rejects_check "match over an enum, members written as keywords" accepts "match over an enum, every member named"
"(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k :lo 1 :hi 2))" (k ^ "(defn f [k K] i32 (match k :lo 1 :hi 2 :mid 3))");
~needle:"is not implemented as a pattern"; 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))");
(* 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";
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" 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))" (k ^ "(defn f [k K] i32 (match k lo 1 _ 2))")
~needle:"match over the enum K is not implemented"; ~needle:"lo is not one of its members. An arm names a member as a keyword: :lo :hi :mid";
(* The old message blamed milestone 2, which was never the reason, and the rejects_check "a keyword arm over an Option"
milestone has since arrived: match now works over a declared data type as "(defn f [o (Option i32)] i32 (match o :lo 1 _ 2))"
well, so the message names both subjects and no milestone. *) ~needle:"whose arms are (Some x) and None";
rejects_check "match over something that is neither" 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))" "(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 (* A destructuring pattern in an arm's binds is a name position like any
other. *) other. *)
rejects_check "a pattern inside a match arm's binds" rejects_check "a pattern inside a match arm's binds"

View File

@ -930,6 +930,26 @@ let () =
| exception Loc.Error { Loc.dmsg = m; _ } -> | exception Loc.Error { Loc.dmsg = m; _ } ->
fail "an edited defmacro: %s" 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. (* 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 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 the point of asking it here is that the editor is where it is read: C-c