JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
TODO.org
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
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, 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
=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 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=,
=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
@ -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
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]

26
docs/BUILT.md
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
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
@ -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
`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
Declined once deliberately; TODO.org, "break and continue, with loop labels", records what was settled then and still

6
emacs/flan-mode.el
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.
`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.
`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

2
emacs/test-flan-mode.el
View File

@ -454,6 +454,8 @@
font-lock-keyword-face "handler-case")
;; Special forms the old list had never heard of.
("(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"
font-lock-keyword-face "handler-bind")

1
lib/ast.ml
View File

@ -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 ──────────────────────────────────────────────────── *)

83
lib/check.ml
View File

@ -5760,17 +5760,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
@ -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 \
(.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
@ -5799,6 +5793,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
@ -5848,7 +5869,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
@ -5901,21 +5923,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 ────────────────────────────────────────────────────────── *)

71
lib/expand.ml
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
(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
@ -256,46 +254,83 @@ 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
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 item; 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. *)

2
lib/load.ml
View File

@ -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)

34
lib/macro.ml
View File

@ -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,34 @@ 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
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

54
lib/parse.ml
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)))
| _ -> 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)]
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
@ -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 ...)")
| 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
@ -1229,17 +1222,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 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
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
@ -1654,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 :: _ ->
@ -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. *)
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.

23
lib/prelude.ml
View File

@ -2141,6 +2141,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
@ -2206,6 +2214,21 @@ let source = {flan|
`(unless-takes-a-test)
`(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 (whatever you like)) is nothing at all, and the "whatever you like"

29
lib/session.ml
View File

@ -234,15 +234,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;
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. *)
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
@ -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
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

59
test/programs/macro-writing.flan Normal file
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)

44
test/programs/match-enum.flan Normal file
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)

23
test/test_acceptance.ml
View File

@ -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 =
"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 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
@ -4121,6 +4133,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\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
program is expanded with are different names. 200 is the two colliding. *)
outputs "gensym counts across macro modules"

95
test/test_flan.ml
View File

@ -664,11 +664,36 @@ 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")))));
(* ~~@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. *)
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";
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])";
@ -1267,6 +1298,12 @@ 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))";
(* 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"
"(defn f [x] i32 (let [y x] (if (and y true) 0 1)))";
accepts "dyn or accepts a non-bool dyn operand"
@ -4054,22 +4091,42 @@ 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))");
(* 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"
"(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"

20
test/test_session.ml
View File

@ -930,6 +930,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