Joseph Ferano
6bc4726ddd
Parse.expr never ran the expander, so a macro call typed as a bare expression was an unknown name -- a package's and the prelude's alike, which is what said the gap was older than importable macros. It is the wrap Parse.decl already had, applied to the other entry point, with Parse.with_imported in front of it in Session.eval_expr because the one expression an editor sends carries no import. The decision that was waiting: an expression that expands to a declaration is refused by name, in the head dispatch rather than in a walk over what the expander answered, so a nested one and a hand-typed one get the same sentence. A quasiquoted declaration is still a value. The spin refusal fires on this path; the ring cannot reach it, because a ring is refused while its own package is parsed. Expansion happens before the thunk is built, so the 5s three-way wait is untouched.
1107 lines
52 KiB
OCaml
1107 lines
52 KiB
OCaml
(** Forms → AST. Recognises special forms, desugars sugar, reports malformed
|
|
syntax with the location of the offending form.
|
|
|
|
Everything not recognised here is a call, which is how a Lisp should work:
|
|
[at], [len], [push], [abort] and the rest are ordinary functions resolved
|
|
by the checker, not syntax. *)
|
|
|
|
open Form
|
|
|
|
let fail (f : Form.t) fmt = Loc.fail f.loc fmt
|
|
|
|
let sym (f : Form.t) =
|
|
match f.v with
|
|
| Sym s -> s
|
|
| _ -> fail f "expected a name, found %s" (Form.to_string f)
|
|
|
|
(* Names for the temporaries a destructuring binding needs — the value is bound
|
|
once and every name in the pattern reads *that*, so a pattern over a call
|
|
calls it once. [~] is a delimiter in the reader, so no symbol anyone can
|
|
write contains one: these cannot collide with a source name and a source
|
|
name cannot shadow one. Reset per program so the names, and therefore the
|
|
slot numbering downstream, are the same every run. *)
|
|
let temps = ref 0
|
|
|
|
let fresh_temp () = incr temps; Printf.sprintf "destructure~%d" !temps
|
|
|
|
(* Destructuring binds in [let] and nowhere else. Every other binding position —
|
|
a [defn] parameter, a [defstruct] field, an [fn] parameter, a [dotimes]
|
|
counter, a [match] arm's binds — takes a plain name, and a pattern written
|
|
there is refused here rather than falling out of [sym] as "expected a name".
|
|
|
|
A parameter is the one worth saying why about: it is a name/type pair, and a
|
|
pattern has no name to pair the type with, so supporting it means a pattern
|
|
inside [Ast.field] — a record [Load] and [Shim] both build and read, and
|
|
neither is this file's to change. *)
|
|
let no_pattern (f : Form.t) =
|
|
match f.v with
|
|
| Map _ | Vec _ ->
|
|
fail f
|
|
"%s is a destructuring pattern, and a pattern binds only in let — this \
|
|
position takes a plain name. Take the value under a name and \
|
|
destructure it in the body"
|
|
(Form.to_string f)
|
|
| _ -> ()
|
|
|
|
(* ── Type expressions ──────────────────────────────────────────────── *)
|
|
|
|
let rec texpr (f : Form.t) : Ast.texpr =
|
|
let mk t = { Ast.t; tloc = f.loc } in
|
|
match f.v with
|
|
(* Unit is spelled [()], ML's spelling. It is the honest name, and it cannot
|
|
collide with anything: an empty call is not a valid expression, so [()] has
|
|
no reading in value position to be confused with. Internally it stays
|
|
[Tname "Unit"] -- the resolver, the shim and the emitter all speak that
|
|
name, and diagnostics still print it. *)
|
|
| List [] -> mk (Ast.Tname "Unit")
|
|
(* One spelling. Two accepted spellings is how two spellings become
|
|
permanent, and the refusal names the new one -- the same rule the
|
|
colon-to-dot change followed. [Tname "Unit"] still exists below this
|
|
point: it is what [()] parses to, and what the resolver, the shim and the
|
|
emitter go on speaking. *)
|
|
| Sym "Unit" -> fail f "unit is written (), not Unit"
|
|
| Sym s -> mk (Ast.Tname s)
|
|
| Vec [ elem ] -> mk (Ast.Tslice (texpr elem))
|
|
| Vec [ n; elem ] -> mk (Ast.Tarray (len n, texpr elem))
|
|
| Vec _ ->
|
|
fail f "a type in brackets is [T] for a slice or [n T] for a fixed array"
|
|
(* Braces are not a type. [{K V}] used to spell [(Map K V)] and the two
|
|
resolved to the same thing; the brace spelling is withdrawn, and the
|
|
refusal names the surviving one rather than letting the form fall through
|
|
to "expected a type".
|
|
|
|
Two reasons, and the second is the one that decided it. The brace's value
|
|
meaning and its type meaning do not correspond the way the bracket's do:
|
|
[[1 2 3]] is a value whose type is [[3 i32]], but [{.x 1 .y 0}] is a
|
|
value whose type is a *name*, and a map value is built by [map-new] with
|
|
no braces anywhere. And dropping it reserves [{}] in type position for
|
|
anonymous struct types, [{.x f32 .y f32}], which is a likelier thing to
|
|
want than a second spelling of a type that already has one.
|
|
|
|
It also settles the one syntax question generics had: a defn's constraint
|
|
map, [{:where (ordered? $t)}], sits immediately after the return type,
|
|
and with braces gone from type position there is nothing for it to be
|
|
confused with. *)
|
|
| Map _ ->
|
|
fail f "a map type is written (Map K V), not in braces — braces in type \
|
|
position are not a type"
|
|
| List ({ v = Sym "Fn"; _ } :: rest) ->
|
|
(match rest with
|
|
| [ { v = Vec params; _ }; ret ] ->
|
|
mk (Ast.Tfn (List.map texpr params, texpr ret))
|
|
| _ -> fail f "a function type is (Fn [T ...] R)")
|
|
| List ({ v = Sym name; _ } :: args) when args <> [] ->
|
|
mk (Ast.Tapp (name, List.map texpr args))
|
|
| _ -> fail f "expected a type, found %s" (Form.to_string f)
|
|
|
|
and len (f : Form.t) : Ast.len =
|
|
match f.v with
|
|
| Int n -> Ast.Lint n
|
|
| Sym s -> Ast.Lname s
|
|
| _ -> fail f "an array length is an integer or a constant's name"
|
|
|
|
(* Inline name/type pairs: [x i32 y f32] — as in let, defstruct and defn. *)
|
|
let rec fields (f : Form.t) (items : Form.t list) : Ast.field list =
|
|
match items with
|
|
| [] -> []
|
|
| name :: ty :: rest ->
|
|
no_pattern name;
|
|
{ Ast.fname = sym name; fty = texpr ty; floc = name.loc } :: fields f rest
|
|
| [ odd ] ->
|
|
Loc.fail odd.loc "field %s has no type — these come in name/type pairs"
|
|
(Form.to_string odd)
|
|
|
|
(* ── The constraint map at the head of a defn body ──────────────────────
|
|
[(defn sort! [s [$t]] () {:where (ordered? $t)} body ...)]. Clojure's
|
|
[{:pre [...] :post [...]}] is the precedent and the reason it is a map
|
|
rather than a bare keyword: it leaves room for further keys without new
|
|
syntax.
|
|
|
|
**The one syntax question it had, and how it stopped being one.** [{K V}]
|
|
used to be a legal *return type* spelling for [(Map K V)], which put two
|
|
braces in a row meaning different things — [(defn f [xs [$t]] {string i32}
|
|
{:where ...} body)]. The brace spelling has since been withdrawn from type
|
|
position entirely ([texpr] above), so the slot after the return type can be
|
|
nothing but this. A bare [{}] in *expression* position is already refused
|
|
([expr] below), so there is nothing for it to be confused with on the other
|
|
side either.
|
|
|
|
The leading keyword is still required and still checked, because it is what
|
|
tells a constraint map from a struct literal's field list, [{.x 1}], which
|
|
is what braces mean in the position a body starts in. *)
|
|
let constraints (body : Form.t list) : Ast.pred list * Form.t list =
|
|
match body with
|
|
| ({ Form.v = Form.Map (({ Form.v = Form.Kw _; _ } :: _ as kvs)); _ } as m)
|
|
:: rest ->
|
|
let pred (p : Form.t) =
|
|
match p.Form.v with
|
|
(* [$t] at a predicate, not bare [t]: the clause talks about the
|
|
variable the signature *bound*, and writing it the way the signature
|
|
wrote it is the one spelling that cannot be read as a concrete type
|
|
that happens to share the name. *)
|
|
| Form.List [ { Form.v = Form.Sym name; _ };
|
|
{ Form.v = Form.Sym v; loc = vloc } ]
|
|
when String.length v > 1 && v.[0] = '$' ->
|
|
ignore vloc;
|
|
{ Ast.pname = name; pvar = String.sub v 1 (String.length v - 1);
|
|
ploc = p.Form.loc }
|
|
| _ ->
|
|
Loc.fail p.Form.loc
|
|
"a where predicate is (name? $t), one predicate about one type \
|
|
variable — found %s" (Form.to_string p)
|
|
in
|
|
let rec keys = function
|
|
| [] -> []
|
|
| { Form.v = Form.Kw "where"; _ } :: v :: rest ->
|
|
(match v.Form.v with
|
|
(* A vector, because two predicates on one variable is the ordinary
|
|
case — [{:where [(ordered? $t) (copyable? $t)]}] is what a
|
|
comparing generic that also reads its parameter twice needs. One
|
|
predicate on its own is accepted unwrapped, which is the same
|
|
sugar [:pre] does not have and is worth the line it costs. *)
|
|
| Form.Vec ps -> List.map pred ps
|
|
| _ -> [ pred v ])
|
|
@ keys rest
|
|
| { Form.v = Form.Kw k; loc } :: _ :: rest ->
|
|
Loc.fail loc
|
|
"%s is not a key a defn's constraint map takes; :where is the only \
|
|
one" (":" ^ k)
|
|
|> fun () -> keys rest
|
|
| odd :: _ ->
|
|
Loc.fail odd.Form.loc
|
|
"a constraint map is keyword/value pairs — found %s"
|
|
(Form.to_string odd)
|
|
in
|
|
if List.length kvs mod 2 <> 0 then
|
|
Loc.fail m.Form.loc "a constraint map is keyword/value pairs, and this \
|
|
one has an odd number of forms";
|
|
(keys kvs, rest)
|
|
| _ -> ([], body)
|
|
|
|
(* ── Expressions ───────────────────────────────────────────────────── *)
|
|
|
|
let rec expr (f : Form.t) : Ast.expr =
|
|
let mk e = { Ast.e; loc = f.loc } in
|
|
match f.v with
|
|
| Int i -> mk (Ast.Int i)
|
|
| Float x -> mk (Ast.Float x)
|
|
| Byte b -> mk (Ast.Byte b)
|
|
| Str s -> mk (Ast.Str s)
|
|
| Kw k -> mk (Ast.Kw k)
|
|
| Sym s -> mk (Ast.Var s)
|
|
(* In value position brackets are a fixed-array literal; in type position
|
|
they are a slice or array type. Position disambiguates, as with {}. *)
|
|
| Vec items -> mk (Ast.Arr (List.map expr items))
|
|
| Map _ -> fail f "a bare map is not an expression; write (Type {.field v})"
|
|
| List [] -> fail f "() is not an expression"
|
|
| List (head :: args) -> form f mk head args
|
|
|
|
and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
|
|
match head.v with
|
|
(* ── quote ─────────────────────────────────────────────────────── *)
|
|
| Sym "quote" ->
|
|
(match args with
|
|
| [ { v = Sym s; _ } ] -> mk (Ast.Quote s)
|
|
| _ -> fail f "quote takes one symbol")
|
|
|
|
(* ── sequencing and binding ────────────────────────────────────── *)
|
|
| Sym "do" -> mk (Ast.Do (List.map expr args))
|
|
|
|
| Sym "let" ->
|
|
(match args with
|
|
| { v = Vec bs; _ } :: body -> mk (Ast.Let (bindings f bs, body_of body))
|
|
| _ -> fail f "let is (let [name value ...] body ...)")
|
|
|
|
(* ── conditionals ──────────────────────────────────────────────── *)
|
|
| Sym "if" ->
|
|
(match args with
|
|
| [ c; t ] -> mk (Ast.If (expr c, expr t, None))
|
|
| [ 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. *)
|
|
| Sym "when" ->
|
|
(match args with
|
|
| c :: body when body <> [] ->
|
|
mk (Ast.If (expr c, { Ast.e = Ast.Do (body_of body); loc = f.loc }, None))
|
|
| _ -> fail f "when is (when test body ...)")
|
|
|
|
| Sym "cond" -> cond f args
|
|
|
|
(* Short-circuiting, so they cannot be ordinary calls. *)
|
|
| Sym "and" -> shortcircuit f args ~is_and:true
|
|
| Sym "or" -> shortcircuit f args ~is_and:false
|
|
|
|
(* ── loops ─────────────────────────────────────────────────────── *)
|
|
(* An optional label comes first: [(while :outer (< i n) ...)]. A keyword in
|
|
the head position is unambiguous because a loop condition is never one and
|
|
a [dotimes] binding vector is never one either, so [label] peels it off
|
|
whatever follows the form's name. *)
|
|
| Sym "while" ->
|
|
(match label args with
|
|
| lbl, c :: body -> mk (Ast.While (lbl, expr c, body_of 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
|
|
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
|
|
Odin's labelled break has. Bare, each means the innermost loop. *)
|
|
| Sym "break" ->
|
|
(match label args with
|
|
| lbl, [] -> mk (Ast.Break lbl)
|
|
| _ -> fail f "break is (break) or (break :label)")
|
|
|
|
| Sym "continue" ->
|
|
(match label args with
|
|
| lbl, [] -> mk (Ast.Continue lbl)
|
|
| _ -> fail f "continue is (continue) or (continue :label)")
|
|
|
|
(* ── control ───────────────────────────────────────────────────── *)
|
|
| Sym "return" ->
|
|
(match args with
|
|
| [] -> mk (Ast.Return None)
|
|
| [ v ] -> mk (Ast.Return (Some (expr v)))
|
|
| _ -> fail f "return takes at most one value")
|
|
|
|
| Sym "set" ->
|
|
(match args with
|
|
| [ target; value ] -> mk (Ast.Set (place target, expr value))
|
|
| _ -> fail f "set is (set place value)")
|
|
|
|
(* ── (array 4 rl/Vector2) ───────────────────────────────────────────
|
|
A zeroed fixed array, told its count and its element type. The type
|
|
spelling [4 rl/Vector2] is unchanged and still works everywhere a type is
|
|
expected; what it cannot do is appear in a [let] binding, which has no
|
|
type slot, because there the brackets are an array *literal* of two
|
|
elements and the second of them is a name nothing declares. So the count
|
|
and the type arrive as plain arguments and Parse assembles the type
|
|
itself. [(zeroed)] keeps its own job — the empty value of whatever the
|
|
destination wants — and this is the one that is told. *)
|
|
| Sym "array" ->
|
|
(match args with
|
|
| [ n; t ] ->
|
|
mk (Ast.ArrayOf { Ast.t = Ast.Tarray (len n, texpr t); tloc = f.loc })
|
|
| _ ->
|
|
fail f
|
|
"array is (array COUNT TYPE), as in (array 4 rl/Vector2) — a zeroed \
|
|
fixed array of COUNT of them")
|
|
|
|
| Sym "match" ->
|
|
(match args with
|
|
| scrutinee :: rest -> mk (Ast.Match (expr scrutinee, arms f rest))
|
|
| [] -> fail f "match is (match value pattern body ...)")
|
|
|
|
(* ── binding and control: never a call ─────────────────────────── *)
|
|
(* A form that binds a name or alters control flow cannot fall through to
|
|
Call — it would parse cleanly and mean the wrong thing, silently. *)
|
|
| Sym "fn" ->
|
|
(match args with
|
|
| { v = Vec ps; _ } :: body when body <> [] ->
|
|
List.iter no_pattern ps;
|
|
mk (Ast.Fn (List.map sym ps, body_of body))
|
|
| _ -> fail f "fn is (fn [param ...] body ...)")
|
|
|
|
| Sym "dotimes" ->
|
|
(match label args with
|
|
| lbl, ({ v = Vec [ n; count ]; _ } :: body) ->
|
|
no_pattern n;
|
|
mk (Ast.Dotimes (lbl, sym n, expr count, body_of body))
|
|
| _ -> fail f "dotimes is (dotimes [name count] body ...)")
|
|
|
|
(* [(loop [x 0 acc 1] body ...)]. No label: [break] and [continue] may not
|
|
leave a loop — a loop answers with the value of its body, and a jump out
|
|
of one has no value to give — so there is nothing here for a label to
|
|
name. A leading keyword is caught here rather than left to [bindings],
|
|
which would complain that [:outer] has no value. *)
|
|
| Sym "loop" ->
|
|
(match args with
|
|
| { v = Kw k; _ } :: _ ->
|
|
fail f
|
|
":%s — loop takes no label. break and continue may not leave a loop, \
|
|
because a loop answers with the value of its body; there is nothing \
|
|
for a label to name" k
|
|
| { v = Vec bs; _ } :: body -> mk (Ast.Loop (loop_bindings f bs, body_of body))
|
|
| _ -> fail f "loop is (loop [name value ...] body ...)")
|
|
|
|
(* Rebind and jump to the top. Its arguments are checked against the loop's
|
|
names in order, so the count is the binding vector's count. *)
|
|
| Sym "recur" -> mk (Ast.Recur (List.map expr args))
|
|
|
|
| Sym "defer" ->
|
|
(match args with
|
|
| [] -> fail f "defer is (defer body ...)"
|
|
| body -> mk (Ast.Defer (body_of body)))
|
|
|
|
| Sym "some" ->
|
|
(match args with
|
|
| [ v ] -> mk (Ast.Unwrap (Ast.Usome, expr v))
|
|
| _ -> fail f "some is (some option-value)")
|
|
|
|
| Sym "try" ->
|
|
(match args with
|
|
| [ v ] -> mk (Ast.Unwrap (Ast.Utry, expr v))
|
|
| _ -> fail f "try is (try result-value)")
|
|
|
|
(* (signal c) : Unit, always. When every applicable handler returns normally
|
|
the signalling function simply carries on, and with no handler at all it is
|
|
a no-op — spec-conditions.md §1 and §2. *)
|
|
(* And (error c) : Never — §2's diverging variant. Same lookup, but a
|
|
handler that returns normally does not answer it: with nothing
|
|
transferring the program stops. *)
|
|
| Sym (("signal" | "error") as how) ->
|
|
let kind = if how = "signal" then Ast.Ssignal else Ast.Serror in
|
|
(match args with
|
|
| [ c ] -> mk (Ast.Signal (kind, expr c))
|
|
| _ -> fail f "%s is (%s condition)" how how)
|
|
|
|
(* (handler-bind [(Type [c] body ...) ...] body ...)
|
|
|
|
A clause names a condition type, binds the condition, and runs for effect;
|
|
matching is by type, since there is no condition hierarchy. *)
|
|
| Sym "handler-bind" ->
|
|
let clauses, body =
|
|
match args with
|
|
| { v = Vec clauses; _ } :: body when body <> [] -> (clauses, body)
|
|
| _ ->
|
|
fail f "handler-bind is (handler-bind [(Type [name] body ...) ...] body ...)"
|
|
in
|
|
let clause (c : Form.t) =
|
|
match c.Form.v with
|
|
| Form.List (ty :: { v = Form.Vec [ { v = Form.Sym n; _ } ]; _ } :: cbody)
|
|
when cbody <> [] ->
|
|
{ Ast.hty = texpr ty; hname = n; hbody = List.map expr cbody;
|
|
hloc = c.Form.loc }
|
|
| _ ->
|
|
fail c "a handler-bind clause is (Type [name] body ...)"
|
|
in
|
|
mk (Ast.HandlerBind (List.map clause clauses, body_of body))
|
|
|
|
(* (restart-case BODY (name [p T ...] BODY-1) ...) — spec-conditions.md §3.
|
|
The body and every clause have the same type, which is the form's. A
|
|
clause's parameters are inline name/type pairs, like any other binding
|
|
form; what fills them in is the [invoke-restart] that chose the clause. *)
|
|
| Sym "restart-case" ->
|
|
let body, clauses =
|
|
match args with
|
|
| body :: clauses when clauses <> [] -> (body, clauses)
|
|
| _ ->
|
|
fail f "restart-case is (restart-case body (name [p T] body ...) ...)"
|
|
in
|
|
let clause (c : Form.t) =
|
|
match c.Form.v with
|
|
| Form.List ({ v = Form.Sym n; _ } :: { v = Form.Vec ps; _ } :: cbody)
|
|
when cbody <> [] ->
|
|
{ Ast.rname = n; rparams = fields c ps;
|
|
rbody = List.map expr cbody; rloc = c.Form.loc }
|
|
| _ -> fail c "a restart-case clause is (name [p T] body ...)"
|
|
in
|
|
mk (Ast.RestartCase (expr body, List.map clause clauses))
|
|
|
|
(* (invoke-restart 'name arg ...) : Never. The name is a quoted symbol — that
|
|
is what the reader's quote is for — and it is resolved on the restart
|
|
stack at run time, since restarts are dynamically scoped. The arguments
|
|
fill in the clause's parameters, and how many there are and what they are
|
|
is settled at run time too, against the frame the name found (§3). *)
|
|
| Sym "invoke-restart" ->
|
|
(match args with
|
|
| { v = Form.List [ { v = Form.Sym "quote"; _ }; { v = Form.Sym n; _ } ]; _ }
|
|
:: rest ->
|
|
mk (Ast.InvokeRestart (n, List.map expr rest))
|
|
| _ ->
|
|
fail f
|
|
"invoke-restart takes a quoted restart name and then its arguments, \
|
|
as in (invoke-restart 'use-value 42)")
|
|
|
|
(* ── macros ────────────────────────────────────────────────────── *)
|
|
(* The reader now produces these three, so they arrive here as ordinary heads
|
|
and would fall through to Call — coming back from the checker as "unknown
|
|
name quasiquote", which says nothing about what is actually missing. *)
|
|
(* [Expand.quasiquote] runs over every form on the way into [program] and
|
|
[decl], so a quasiquote is gone before this file looks at it and this arm
|
|
cannot be reached by anything that came through either. It is kept as the
|
|
backstop for the path that did not: a form built by hand and handed
|
|
straight to [expr]. *)
|
|
| Sym "quasiquote" ->
|
|
fail f "a quasiquote reached the parser undesugared, which means this form \
|
|
did not come through Parse.program or Parse.decl"
|
|
|
|
(* Not a milestone, a mistake: these two mean nothing anywhere else, and the
|
|
reader cannot tell, because it does not track where it is. *)
|
|
| Sym "unquote" ->
|
|
fail f "~x means nothing outside a quasiquote"
|
|
| Sym "unquote-splicing" ->
|
|
fail f "~@x means nothing outside a quasiquote, and splices only into a \
|
|
list or a vector"
|
|
|
|
(* A declaration is not an expression, and this arm says so for all of them
|
|
rather than for [defmacro] alone. It used to be that one, because it was
|
|
the only head anyone typed by mistake; now that [Parse.expr] expands, a
|
|
macro can *produce* one, and the head this dispatches on is the only place
|
|
that sees it — the walk recurses, so a [defn] nested inside what a macro
|
|
answered is caught with the same message as one typed at the top.
|
|
|
|
A quasiquoted declaration is deliberately not caught: after desugaring,
|
|
the name in ``(defn ...)`` is a string inside a [Form.Sym] argument and not
|
|
a head, which is the same property that makes a quasiquoted macro call
|
|
output rather than a dependency. Building a declaration as a value is what
|
|
a macro is for. *)
|
|
| Sym ("defmacro" | "defn" | "defvar" | "defconst" | "defstruct" | "defunion"
|
|
| "defenum" | "defalias" | "import" as name) ->
|
|
fail f
|
|
"%s is a top-level declaration, not an expression. A macro may answer \
|
|
with one only where a declaration is expected, so this cannot come back \
|
|
from evaluating an expression" name
|
|
|
|
(* Recognised, deliberately unimplemented. Rejected rather than left to fall
|
|
through to Call, where they would parse and mean nothing. *)
|
|
| Sym ("handler-case"
|
|
(* Named in the spec and not written yet, so each says so rather than
|
|
falling through to Call and coming back as an unknown name:
|
|
[find-restart] and [compute-restarts] are §4's two ways to look at
|
|
the restart stack without committing to one. *)
|
|
| "find-restart" | "compute-restarts"
|
|
| "errdefer"
|
|
| "await" as name) ->
|
|
fail f "%s is not implemented yet (see the build sequence in plan.org)" name
|
|
|
|
(* ── field access: (.pos c) ────────────────────────────────────── *)
|
|
| Sym s when String.length s > 1 && s.[0] = '.' ->
|
|
let field = String.sub s 1 (String.length s - 1) in
|
|
(match args with
|
|
| [ target ] -> mk (Ast.Field (expr target, field))
|
|
| _ -> fail f "field access is (.%s value)" field)
|
|
|
|
(* ── struct literal: (Cursor {.src s .pos 0}) ───────────────────── *)
|
|
| Sym name when args <> [] && is_map (List.hd args) ->
|
|
(match args with
|
|
| [ { v = Map kvs; _ } ] -> mk (Ast.Struct (name, struct_fields f kvs))
|
|
| _ -> fail f "a struct literal is (%s {.field value ...})" name)
|
|
|
|
(* ── anything else is a call ────────────────────────────────────── *)
|
|
| _ -> mk (Ast.Call (expr head, List.map expr args))
|
|
|
|
and is_map (f : Form.t) = match f.v with Map _ -> true | _ -> false
|
|
|
|
and body_of (items : Form.t list) : Ast.expr list = List.map expr items
|
|
|
|
(* A loop label, or a [break]'s target: a leading keyword, peeled off. Nothing
|
|
else in any of these positions is a keyword — a loop condition is not, a
|
|
[dotimes] binding vector is not, and [break] takes nothing else at all — so
|
|
one function serves all four forms and no form has to say which arguments it
|
|
has counted. *)
|
|
and label (items : Form.t list) : string option * Form.t list =
|
|
match items with
|
|
| { v = Kw k; _ } :: rest -> (Some k, rest)
|
|
| _ -> (None, items)
|
|
|
|
(* A loop's binding vector. Pairs like [let]'s, but plain names only: a
|
|
destructuring pattern expands to several bindings from one form, and then
|
|
[recur]'s argument count would no longer match what is written here. *)
|
|
and loop_bindings f (items : Form.t list) : (string * Ast.expr) list =
|
|
let rec go = function
|
|
| [] -> []
|
|
| name :: value :: rest ->
|
|
no_pattern name;
|
|
(sym name, expr value) :: go rest
|
|
| [ odd ] ->
|
|
Loc.fail odd.loc
|
|
"binding %s has no value — loop takes name/value pairs"
|
|
(Form.to_string odd)
|
|
in
|
|
let bs = go items in
|
|
List.iter
|
|
(fun (n, _) ->
|
|
if List.length (List.filter (fun (m, _) -> m = n) bs) > 1 then
|
|
fail f "%s is bound twice in this loop" n)
|
|
bs;
|
|
bs
|
|
|
|
and bindings f (items : Form.t list) : Ast.binding list =
|
|
(* [name value ...] and [name Type value ...] both read; a type is a form
|
|
that is not a value position — disambiguated by pair vs triple is
|
|
ambiguous, so let requires (let [name value]) and types are inferred.
|
|
Annotated locals are not needed by any acceptance program. *)
|
|
let rec go = function
|
|
| [] -> []
|
|
| pat :: value :: rest ->
|
|
let bs = destructure pat (expr value) in
|
|
no_duplicates pat bs;
|
|
bs @ go rest
|
|
| [ odd ] ->
|
|
Loc.fail odd.loc "binding %s has no value — let takes name/value pairs"
|
|
(Form.to_string odd)
|
|
in
|
|
if items = [] then Loc.fail f.loc "let needs at least one binding" else go items
|
|
|
|
(* ── Destructuring ─────────────────────────────────────────────────── *)
|
|
|
|
(* The temporary every pattern binds its value to before anything reads it, so
|
|
that the value is evaluated once however many names come out of it. Returning
|
|
the reference as well as the binding is what makes the two impossible to
|
|
separate by accident. *)
|
|
and temp (p : Form.t) (v : Ast.expr) : Ast.expr * Ast.binding =
|
|
let t = fresh_temp () in
|
|
({ Ast.e = Ast.Var t; loc = p.loc },
|
|
{ Ast.bname = t; bty = None; bval = v; bloc = p.loc })
|
|
|
|
(* Clojure's destructuring, desugared here into the bindings and field accesses
|
|
the language already has. [Ast.binding] carries a name and nothing else, and
|
|
deliberately so: nothing downstream — not [Load]'s renaming, not [Check], not
|
|
any backend — learns that a pattern exists. The same reason [dotimes] is a
|
|
[Let] plus a [While].
|
|
|
|
The one thing this cannot decide is whether an array pattern's arity matches
|
|
the value's, because that is a type and there are none here. [destructure~nth]
|
|
carries the question to [Check], which answers it and emits an ordinary [at].
|
|
|
|
A binding is a pattern only when it is written in brackets or braces; a bare
|
|
name is what it always was. *)
|
|
and destructure (p : Form.t) (v : Ast.expr) : Ast.binding list =
|
|
match p.v with
|
|
| Sym name -> [ { Ast.bname = name; bty = None; bval = v; bloc = p.loc } ]
|
|
(* The value goes into a temporary first, so it is evaluated once however
|
|
many names the pattern binds, and so that [(let [{:keys [p]} p] ...)]
|
|
reads the old [p] rather than the one it is in the middle of rebinding. *)
|
|
| Map items -> let t, bind = temp p v in bind :: dmap p t items
|
|
| Vec items -> let t, bind = temp p v in bind :: dvec p t items
|
|
| _ ->
|
|
fail p
|
|
"expected a name or a destructuring pattern, found %s — a pattern is \
|
|
{:keys [x y]} over a struct or [a b] over a fixed array"
|
|
(Form.to_string p)
|
|
|
|
(* {:keys [x y]} and {inner .field}, over a struct. Clojure's map destructuring
|
|
with Flan's structs standing in for its maps: [:keys] is the common case and
|
|
the pair form is what nests, since a [:keys] entry is a name and never a
|
|
pattern. Everything else Clojure puts in this position — [:as], [:or],
|
|
[:strs], [:syms] — is refused by name where it is written.
|
|
|
|
[:keys] keeps its colon while [.field] takes the dot, and the split is the
|
|
point rather than an inconsistency: [.field] names a field of the struct,
|
|
[:keys] names no field at all — it is an instruction to the compiler that
|
|
happens to sit in the same brace. Keeping them apart leaves the dot meaning
|
|
exactly one thing, "this names a field", which is the whole reason the
|
|
colon was given up here. *)
|
|
and dmap (p : Form.t) (t : Ast.expr) (items : Form.t list) : Ast.binding list =
|
|
let ex loc e : Ast.expr = { Ast.e; loc } in
|
|
let field loc name = ex loc (Ast.Field (t, name)) in
|
|
let rec go = function
|
|
| [] -> []
|
|
| { v = Kw "keys"; _ } :: names :: rest ->
|
|
let ns =
|
|
match names.v with
|
|
| Vec ns -> ns
|
|
| _ ->
|
|
Loc.fail names.loc
|
|
":keys takes a bracketed list of field names, found %s"
|
|
(Form.to_string names)
|
|
in
|
|
let rec each = function
|
|
| [] -> []
|
|
| (n : Form.t) :: more ->
|
|
let name =
|
|
match n.v with
|
|
| Sym s -> s
|
|
| _ ->
|
|
Loc.fail n.loc
|
|
":keys binds field names, and %s is not one — a nested pattern \
|
|
is written {%s .field}"
|
|
(Form.to_string n) (Form.to_string n)
|
|
in
|
|
{ Ast.bname = name; bty = None; bval = field n.loc name; bloc = n.loc }
|
|
:: each more
|
|
in
|
|
each ns @ go rest
|
|
| ({ v = Kw k; _ } as bad) :: _ :: rest ->
|
|
ignore rest;
|
|
Loc.fail bad.loc
|
|
":%s is not implemented in a destructuring pattern — a struct pattern \
|
|
is {:keys [x y]} or {name .field}, and nothing else" k
|
|
| pat :: ({ v = Sym s; _ } as fform) :: rest
|
|
when String.length s > 1 && s.[0] = '.' ->
|
|
destructure pat (field fform.loc (String.sub s 1 (String.length s - 1)))
|
|
@ go rest
|
|
| pat :: ({ v = Kw fld; _ } as bad) :: _ ->
|
|
ignore pat;
|
|
Loc.fail bad.loc
|
|
"a field label is written .%s, not :%s — the colon is for keys, and a \
|
|
struct pattern binds {name .%s}" fld fld fld
|
|
| pat :: other :: _ ->
|
|
Loc.fail other.loc
|
|
"expected .field after %s, found %s — a struct pattern binds \
|
|
{name .field}" (Form.to_string pat) (Form.to_string other)
|
|
| [ odd ] ->
|
|
Loc.fail odd.loc "%s has no .field — a struct pattern comes in pairs"
|
|
(Form.to_string odd)
|
|
in
|
|
if items = [] then
|
|
fail p "an empty struct pattern {} binds nothing — write the names it should bind"
|
|
else go items
|
|
|
|
(* [a b] and [a b & rest], over a fixed array. Not over a slice: see [Check]. *)
|
|
and dvec (p : Form.t) (t : Ast.expr) (items : Form.t list) : Ast.binding list =
|
|
let ex loc e : Ast.expr = { Ast.e; loc } in
|
|
let var loc n = ex loc (Ast.Var n) in
|
|
let rec split acc = function
|
|
| [] -> (List.rev acc, None)
|
|
| ({ v = Sym "&"; _ } as amp) :: rest ->
|
|
(match rest with
|
|
| [ r ] -> (List.rev acc, Some r)
|
|
| [] -> Loc.fail amp.loc "& needs a name after it, as in [a b & rest]"
|
|
| _ :: extra :: _ ->
|
|
Loc.fail extra.loc
|
|
"& takes one name and it is the last thing in the pattern")
|
|
| x :: rest -> split (x :: acc) rest
|
|
in
|
|
let elems, rest = split [] items in
|
|
let n = List.length elems in
|
|
(match elems, rest with
|
|
| [], None ->
|
|
fail p "an empty array pattern [] binds nothing — write the names it should bind"
|
|
| [], Some r ->
|
|
Loc.fail r.loc
|
|
"[& %s] binds the whole value — write %s on its own instead of a pattern"
|
|
(Form.to_string r) (Form.to_string r)
|
|
| _ -> ());
|
|
(* With a [& rest] the pattern says "at least this many"; without one it says
|
|
"exactly this many". [Check] is where the array's length is known, so the
|
|
count and which of the two it means travel there as arguments. *)
|
|
let exact = if rest = None then 1L else 0L in
|
|
let nth i =
|
|
ex p.loc
|
|
(Ast.Call (var p.loc "destructure~nth",
|
|
[ t;
|
|
ex p.loc (Ast.Int (Int64.of_int i));
|
|
ex p.loc (Ast.Int (Int64.of_int n));
|
|
ex p.loc (Ast.Int exact) ]))
|
|
in
|
|
let rec each i = function
|
|
| [] -> []
|
|
| e :: more -> destructure e (nth i) @ each (i + 1) more
|
|
in
|
|
let rest_binding =
|
|
match rest with
|
|
| None -> []
|
|
| Some r ->
|
|
(* An ordinary (slice t n (len t)): the tail of the temporary, which is a
|
|
local and outlives the body that reads it. Nothing new. *)
|
|
let name =
|
|
match r.v with
|
|
| Sym s -> s
|
|
| _ ->
|
|
Loc.fail r.loc
|
|
"& binds one name for the tail, and %s is not one — the tail is a \
|
|
slice, so it cannot be destructured further" (Form.to_string r)
|
|
in
|
|
[ { Ast.bname = name; bty = None; bloc = r.loc;
|
|
bval =
|
|
ex r.loc
|
|
(Ast.Call (var r.loc "slice",
|
|
[ t;
|
|
ex r.loc (Ast.Int (Int64.of_int n));
|
|
ex r.loc (Ast.Call (var r.loc "len", [ t ])) ])) } ]
|
|
in
|
|
each 0 elems @ rest_binding
|
|
|
|
(* One pattern binding the same name twice is a mistake, not a shadowing: the
|
|
second would win and the first would bind nothing. Across a let's bindings it
|
|
*is* shadowing and stays legal, so this looks at one pattern at a time. *)
|
|
and no_duplicates (p : Form.t) (bs : Ast.binding list) =
|
|
let rec go seen = function
|
|
| [] -> ()
|
|
| (b : Ast.binding) :: rest ->
|
|
if String.contains b.Ast.bname '~' then go seen rest
|
|
else if List.mem b.Ast.bname seen then
|
|
Loc.fail b.Ast.bloc "this pattern binds %s twice" b.Ast.bname
|
|
else go (b.Ast.bname :: seen) rest
|
|
in
|
|
ignore p; go [] bs
|
|
|
|
(* A field label is a dot, never a colon. The delimiter is what disambiguates:
|
|
[(.x v)] is a call and therefore an access, [{.x 1.0}] is a brace form and
|
|
therefore a construction. The colon is left for keys — map keys and enum
|
|
members — so the two never share a spelling. *)
|
|
and struct_fields f (items : Form.t list) : (string * Ast.expr) list =
|
|
let rec go = function
|
|
| [] -> []
|
|
| { v = Sym s; _ } :: value :: rest
|
|
when String.length s > 1 && s.[0] = '.' ->
|
|
(String.sub s 1 (String.length s - 1), expr value) :: go rest
|
|
| ({ v = Kw k; _ } as bad) :: _ :: _ ->
|
|
Loc.fail bad.loc
|
|
"a field label is written .%s, not :%s — the colon is for keys, and a \
|
|
struct value is (Type {.%s value ...})" k k k
|
|
| other :: _ :: _ ->
|
|
Loc.fail other.loc "expected .field, found %s" (Form.to_string other)
|
|
| [ odd ] -> Loc.fail odd.loc "field %s has no value" (Form.to_string odd)
|
|
in
|
|
ignore f; go items
|
|
|
|
and cond f (args : Form.t list) : Ast.expr =
|
|
let rec go = function
|
|
| [] -> { Ast.e = Ast.Do []; loc = f.loc } (* no clause matched: Unit *)
|
|
| { v = Kw "else"; _ } :: body :: _ -> expr body
|
|
| test :: body :: rest ->
|
|
{ Ast.e = Ast.If (expr test, expr body, Some (go rest)); loc = f.loc }
|
|
| [ odd ] -> Loc.fail odd.loc "cond clause %s has no body"
|
|
(Form.to_string odd)
|
|
in
|
|
if args = [] then Loc.fail f.loc "cond needs at least one clause" else go args
|
|
|
|
and shortcircuit f (args : Form.t list) ~is_and : Ast.expr =
|
|
let mk e = { Ast.e; loc = f.loc } in
|
|
let rec go = function
|
|
| [] -> mk (Ast.Var (if is_and then "true" else "false"))
|
|
| [ last ] -> expr last
|
|
| x :: rest ->
|
|
if is_and then mk (Ast.If (expr x, go rest, Some (mk (Ast.Var "false"))))
|
|
else mk (Ast.If (expr x, mk (Ast.Var "true"), Some (go rest)))
|
|
in
|
|
go args
|
|
|
|
and place (f : Form.t) : Ast.place =
|
|
match f.v with
|
|
| Sym s -> Ast.Pvar s
|
|
| List ({ v = Sym s; _ } :: args)
|
|
when String.length s > 1 && s.[0] = '.' ->
|
|
let field = String.sub s 1 (String.length s - 1) in
|
|
(match args with
|
|
| [ target ] -> Ast.Pfield (expr target, field)
|
|
| _ -> fail f "field place is (.%s value)" field)
|
|
| List ({ v = Sym "at"; _ } :: target :: idx) when idx <> [] ->
|
|
Ast.Pindex (expr target, List.map expr idx)
|
|
(* Not a place. spec-memory.md gives a map an upsert of its own — [put]
|
|
either inserts or replaces — so there is no store into a lookup, and an
|
|
entry that is absent has no location to store into. Refused here rather
|
|
than parsed into a place form the language does not have. *)
|
|
| List ({ v = Sym "get"; _ } :: _) ->
|
|
fail f "(get m k) is not a place — a map is written with (put m k v)"
|
|
| List [ { v = Sym "deref"; _ }; p ] -> Ast.Pderef (expr p)
|
|
| _ ->
|
|
fail f
|
|
"%s is not assignable. set takes a name, (.field x), (at a i ...), \
|
|
or (deref p)"
|
|
(Form.to_string f)
|
|
|
|
and arms f (items : Form.t list) : Ast.arm list =
|
|
let rec go = function
|
|
| [] -> []
|
|
| p :: body :: rest ->
|
|
{ Ast.pat = pattern p; body = [ expr body ]; aloc = p.loc } :: go rest
|
|
| [ odd ] ->
|
|
Loc.fail odd.loc "match arm %s has no body" (Form.to_string odd)
|
|
in
|
|
if items = [] then Loc.fail f.loc "match needs at least one arm" else go items
|
|
|
|
and pattern (f : Form.t) : Ast.pattern =
|
|
match f.v with
|
|
| 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 — match is over an Option here, \
|
|
and an enum member cannot be one until Ast.pattern can hold a keyword. \
|
|
Use cond with (= k :%s)" member member
|
|
| List ({ v = Sym ctor; _ } :: binds) ->
|
|
List.iter no_pattern binds;
|
|
Ast.Pctor (ctor, List.map sym binds)
|
|
| _ -> fail f "expected a pattern, found %s" (Form.to_string f)
|
|
|
|
(* ── Declarations ──────────────────────────────────────────────────── *)
|
|
|
|
let rec decl (f : Form.t) : Ast.decl =
|
|
let mk d = { Ast.d; dloc = f.loc } in
|
|
match f.v with
|
|
| List ({ v = Sym "package"; _ } :: args) ->
|
|
(match args with
|
|
| [ n ] -> mk (Ast.Package (sym n))
|
|
| _ -> fail f "package is (package name)")
|
|
|
|
| List ({ v = Sym "import"; _ } :: args) ->
|
|
(match args with
|
|
| [ alias; { v = Str path; _ } ] -> mk (Ast.Import (sym alias, path))
|
|
| _ -> fail f "import is (import alias \"collection:path\")")
|
|
|
|
| List ({ v = Sym "defalias"; _ } :: args) ->
|
|
(match args with
|
|
| [ n; t ] -> mk (Ast.Defalias (sym n, texpr t))
|
|
| _ -> fail f "defalias is (defalias Name Type)")
|
|
|
|
| List ({ v = Sym "defstruct"; _ } :: args) ->
|
|
(match args with
|
|
| [ n; { v = Vec fs; _ } ] -> mk (Ast.Defstruct (sym n, fields f fs))
|
|
| _ -> fail f "defstruct is (defstruct Name [field Type ...])")
|
|
|
|
| List ({ v = Sym "defunion"; _ } :: args) ->
|
|
(match args with
|
|
| [ n; { v = Vec vs; _ } ] -> mk (Ast.Defunion (sym n, List.map variant vs))
|
|
| _ -> fail f "defunion is (defunion Name [(Case [field Type ...]) ...])")
|
|
|
|
(* The slot after the parameters is unconditionally the return type. It used
|
|
to be optional, and the parser decided return-type-versus-body by looking
|
|
the symbol up in a set of the file's type names -- sound only because one
|
|
top-level namespace means a name cannot be both a type and a value, and
|
|
brittle because the set had to be complete. It was wrong twice in one day,
|
|
the second time parsing [(defn f [] (Rune {.code 65}) (bar))] as a
|
|
function *returning* a Rune with a one-form body, silently, in every file
|
|
in the language. A silent misparse is the worst failure class available,
|
|
and macros now generate definitions, which widens it.
|
|
|
|
Mandatory removes the guess: nothing is consulted, [()] is what a function
|
|
that returns nothing writes, and a mistyped type is a mistyped type --
|
|
[(defn f [] f65 0.0)] reaches the resolver's near-miss check and comes back
|
|
as *did you mean f64*, where it used to come back as an unknown name. *)
|
|
| List ({ v = Sym "defn"; _ } :: args) ->
|
|
(match args with
|
|
| n :: { v = Vec ps; _ } :: ret :: body ->
|
|
(* The slot's own failure, because the thing found there is almost
|
|
always the old spelling: a body whose first form was a call, written
|
|
when the slot could be left out. [texpr]'s "expected a type" alone
|
|
would be true and unhelpful. *)
|
|
let rty =
|
|
try texpr ret with
|
|
| Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
|
|
Loc.fail loc
|
|
"%s. This is the return type, which every defn states -- a \
|
|
function that returns nothing writes ()" msg
|
|
in
|
|
let fwhere, body = constraints body in
|
|
mk (Ast.Defn { Ast.name = sym n; params = fields f ps;
|
|
ret = Some rty; fwhere; fbody = body_of body;
|
|
nloc = n.loc })
|
|
| _ ->
|
|
fail f
|
|
"defn is (defn name [param Type ...] ReturnType body ...). The return \
|
|
type is not optional; a function that returns nothing writes ()")
|
|
|
|
| List ({ v = Sym ("declare" | "declare-c" as which); _ } :: args) ->
|
|
(* (declare name [param Type ...] ReturnType? "c_symbol"). The C symbol is
|
|
last and is always written: a foreign name is not derivable from a Flan
|
|
one, and guessing it would fail at link time rather than here.
|
|
|
|
[declare-c] is the same shape and a different claim about the symbol.
|
|
[declare]'s signature IS the C signature, already flattened by whoever
|
|
wrote the C; [declare-c]'s is the *library's* — structs by value — and
|
|
[Shim] generates the flattening. The two cannot be one form, because
|
|
(declare f [p string] ...) already means the symbol takes ptr+len and
|
|
(declare-c f [p string] ...) means it takes a NUL-terminated char *. *)
|
|
let mkd fn csym =
|
|
if String.equal which "declare-c" then Ast.DeclareC (fn, csym)
|
|
else Ast.Declare (fn, csym)
|
|
in
|
|
let usage =
|
|
Printf.sprintf
|
|
"%s is (%s name [param Type ...] ReturnType? \"c_symbol\")" which which
|
|
in
|
|
(match List.rev args with
|
|
| { v = Str csym; _ } :: rest ->
|
|
(match List.rev rest with
|
|
| [ n; { v = Form.Vec ps; _ } ] ->
|
|
mk (mkd { Ast.name = sym n; params = fields f ps;
|
|
ret = None; fwhere = []; fbody = []; nloc = n.loc } csym)
|
|
| [ n; { v = Form.Vec ps; _ }; r ] ->
|
|
mk (mkd { Ast.name = sym n; params = fields f ps;
|
|
ret = Some (texpr r); fwhere = []; fbody = [];
|
|
nloc = n.loc } csym)
|
|
| _ -> fail f "%s" usage)
|
|
| _ -> fail f "%s" usage)
|
|
|
|
| List ({ v = Sym "defenum"; _ } :: args) ->
|
|
(match args with
|
|
| [ n; { v = Form.Vec ms; _ } ] ->
|
|
let rec pairs = function
|
|
| [] -> []
|
|
| { v = Form.Sym m; _ } :: { v = Form.Int k; _ } :: rest ->
|
|
(m, k) :: pairs rest
|
|
| bad :: _ ->
|
|
fail bad "an enum member is a name followed by an integer, found %s"
|
|
(Form.to_string bad)
|
|
in
|
|
mk (Ast.Defenum (sym n, pairs ms))
|
|
| _ -> fail f "defenum is (defenum Name [member value ...])")
|
|
|
|
| List ({ v = Sym "defvar"; _ } :: args) ->
|
|
(match args with
|
|
| [ n; t ] -> mk (Ast.Defvar (sym n, Some (texpr t), Ast.Zeroed))
|
|
| [ n; t; { v = Sym "uninit"; _ } ] ->
|
|
mk (Ast.Defvar (sym n, Some (texpr t), Ast.Uninit))
|
|
| [ n; t; v ] -> mk (Ast.Defvar (sym n, Some (texpr t), Ast.Init (expr v)))
|
|
| _ -> fail f "defvar is (defvar name Type value?)")
|
|
|
|
| List ({ v = Sym "defconst"; _ } :: args) ->
|
|
(match args with
|
|
| [ n; v ] -> mk (Ast.Defconst (sym n, None, expr v))
|
|
| [ n; t; v ] -> mk (Ast.Defconst (sym n, Some (texpr t), expr v))
|
|
| _ -> fail f "defconst is (defconst name Type? value)")
|
|
|
|
(* A macro is an ordinary function, and this is where it becomes one:
|
|
[(defmacro m [args] body)] is [(defn m [args [Form]] Form body)]. There is
|
|
no [Ast.Defmacro] and there is not going to be one -- a macro has the type
|
|
[[Form] -> Form], it is compiled by the same backend as everything else,
|
|
and the only thing that makes it a macro is that [Expand] calls it at
|
|
compile time instead of the program calling it at run time.
|
|
|
|
One parameter, the slice of the argument forms, rather than one declared
|
|
parameter per argument. It needs no reader or parser change and it gives
|
|
variadics for free, which is what [unless] and [when] need in a language
|
|
with no &rest.
|
|
|
|
The shape rules stay exactly as they were, because they were enforced
|
|
before the feature existed on purpose: getting the shape wrong and getting
|
|
the whole feature are different mistakes. *)
|
|
| List ({ v = Sym "defmacro"; _ } :: args) ->
|
|
(match args with
|
|
| n :: { v = Form.Vec [ p ]; _ } :: body when body <> [] ->
|
|
let form_t = { Ast.t = Ast.Tname "Form"; tloc = f.loc } in
|
|
mk (Ast.Defn
|
|
{ Ast.name = sym n;
|
|
params = [ { Ast.fname = sym p;
|
|
fty = { Ast.t = Ast.Tslice form_t; tloc = p.loc };
|
|
floc = p.loc } ];
|
|
ret = Some form_t; fwhere = []; fbody = body_of body;
|
|
nloc = n.loc })
|
|
| _ :: { v = Form.Vec ps; _ } :: body when body <> [] ->
|
|
List.iter (fun (p : Form.t) -> ignore (sym p)) ps;
|
|
fail f
|
|
"a macro takes one parameter, the forms at its call site, and this \
|
|
one names %d. There is no &rest and no arity: (defmacro m [args] \
|
|
...) and (len args) is how many were written"
|
|
(List.length ps)
|
|
| _ ->
|
|
fail f "defmacro is (defmacro name [param ...] body ...)")
|
|
|
|
| List ({ v = Sym s; _ } :: _) -> fail f "unknown top-level form (%s ...)" s
|
|
| _ -> fail f "expected a top-level declaration, found %s" (Form.to_string f)
|
|
|
|
and variant (f : Form.t) : Ast.variant =
|
|
match f.v with
|
|
| Sym n -> { Ast.vname = n; vfields = []; vloc = f.loc }
|
|
| List [ { v = Sym n; _ }; { v = Vec fs; _ } ] ->
|
|
{ Ast.vname = n; vfields = fields f fs; vloc = f.loc }
|
|
| List [ { v = Sym n; _ } ] -> { Ast.vname = n; vfields = []; vloc = f.loc }
|
|
| _ -> fail f "a union case is Name or (Name [field Type ...])"
|
|
|
|
(* Macro expansion, which runs over [Form] and therefore before anything in
|
|
this file. It cannot be called directly: expanding a macro means compiling
|
|
it and dlopening it, so the expander sits above [Check] and [Build] and this
|
|
module sits below them. [Macro] fills this in, and lib/dune passes -linkall
|
|
so that it always has -- an executable that links the library gets the
|
|
installation whether or not it names the module.
|
|
|
|
The default is the identity because [Macro] is what knows which names are
|
|
macros; with nothing installed, a call to one arrives at the checker as an
|
|
unknown name, which is wrong but not silent. *)
|
|
let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs)
|
|
|
|
(* The defmacros an import brought in: already qualified under the alias the
|
|
package was imported as, and already quasiquote-desugared, so they are in
|
|
exactly the shape [Macro] hands its own round-0 set.
|
|
|
|
A ref, for the same reason [expander] is one — [Load] sits below [Macro] and
|
|
above this file, so there is no call it could make instead — and set rather
|
|
than passed because the parse that needs them is not always the parse that
|
|
resolved them: [Session.eval] parses one [defn] for C-c C-c, long after the
|
|
import that supplied the macro it calls. [Load.program] sets it around the
|
|
parse it drives and restores it afterwards; the session sets it around the
|
|
whole of an evaluation. Empty is the ordinary case and costs nothing. *)
|
|
let imported_macros : Form.t list ref = ref []
|
|
|
|
let with_imported (ms : Form.t list) (f : unit -> 'a) : 'a =
|
|
let saved = !imported_macros in
|
|
imported_macros := ms;
|
|
Fun.protect ~finally:(fun () -> imported_macros := saved) f
|
|
|
|
(* Two entry points and not one function with a flag, and the reason is the
|
|
daemon. [Loc.Errors] is a second exception, and the handlers in the session
|
|
and in the daemon name only [Loc.Error] — so a list reaching them would be
|
|
an unhandled exception and a dead session, which is the one thing the whole
|
|
dev loop exists to prevent. A flag on the function the session already calls
|
|
would put that one label away from happening. A separate name cannot: the
|
|
session's call site has to be edited by someone for its behaviour to change.
|
|
|
|
[keep_going] asks for every bad declaration in the file rather than the
|
|
first. The resync point is a top-level form, and it is the only honest one
|
|
here: the reader already found where each declaration ends, so skipping a
|
|
bad one costs nothing and cannot lose its place. Inside a declaration there
|
|
is no such landmark, so one bad [defn] is one error. *)
|
|
let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list =
|
|
(* Quasiquote first and always, because it is pure and needs nothing loaded:
|
|
it is what turns a macro body into ordinary code, and the prelude's own
|
|
macros have to parse in a process that has not built a macro module yet.
|
|
Then expansion, which may need one. *)
|
|
let forms = !expander (List.map Expand.quasiquote forms) in
|
|
temps := 0;
|
|
let s = Loc.sink ~on:keep_going in
|
|
let decls = List.filter_map (fun f -> Loc.caught s (fun () -> decl f)) forms in
|
|
Loc.finish s;
|
|
decls
|
|
|
|
(** One file, stopping at the first declaration it cannot parse. Raises
|
|
[Loc.Error], never [Loc.Errors]. *)
|
|
let program (forms : Form.t list) : Ast.decl list =
|
|
parse_forms ~keep_going:false forms
|
|
|
|
(** One file, reporting every declaration it cannot parse. Raises [Loc.Errors]
|
|
when there was more than nothing wrong, so only a caller prepared for a
|
|
list should be calling it. *)
|
|
let program_all (forms : Form.t list) : Ast.decl list =
|
|
parse_forms ~keep_going:true forms
|
|
|
|
(* Single-declaration entry point, for tests and the REPL. *)
|
|
let decl (f : Form.t) : Ast.decl =
|
|
temps := 0;
|
|
match !expander [ Expand.quasiquote f ] with
|
|
| [ f ] -> decl f
|
|
| fs ->
|
|
(* One declaration in, one out. A macro at the top level would break that,
|
|
and there is no top-level macro call: [decl] dispatches on the head and
|
|
a macro name is not one of the heads it knows. *)
|
|
Loc.fail f.loc "expanding this declaration produced %d of them"
|
|
(List.length fs)
|
|
|
|
(* Single-expression entry point: C-x C-e, and the tests that parse one
|
|
expression. It expands, which [Parse.expr] above does not and never did —
|
|
so a bare [(unless c a b)] typed at the REPL was an unknown name, the
|
|
prelude's macros included. That is the whole of the change here: the wrap is
|
|
the one [decl] has, applied to the other entry point.
|
|
|
|
[Expand.quasiquote] first for [parse_forms]'s reason — it is pure, it needs
|
|
nothing loaded, and the arm in [form] that refuses an undesugared quasiquote
|
|
is the backstop for the path that skips this, not for this one.
|
|
|
|
What an expression that expands to a declaration does is decided in [form]:
|
|
[defn] and its siblings are refused by name, wherever in the expansion they
|
|
appear. Nothing here has to look for them.
|
|
|
|
[temps] is deliberately not reset. [decl] resets it because a declaration is
|
|
a fresh top level; an expression is evaluated into a session that has been
|
|
handing out temporaries all along, and restarting the counter would hand out
|
|
a name the frame beside it is already using. *)
|
|
let expr (f : Form.t) : Ast.expr =
|
|
match !expander [ Expand.quasiquote f ] with
|
|
| [ f ] -> expr f
|
|
| fs ->
|
|
(* One expression in, one out. [Macro.program] is a [List.map], so it
|
|
cannot answer with anything else — this is here because the invariant is
|
|
worth stating where it is relied on, not because it has been seen. *)
|
|
Loc.fail f.loc "expanding this expression produced %d forms, and an \
|
|
expression is one" (List.length fs)
|