Joseph Ferano
1898a3157d
Load.program takes forms: it reads the import forms, resolves them with the one resolver it always had, and parses the file with the packages' macros in front of it. The refusal said this needed a second import resolver at the Form level. It did not notice that the file being compiled is parsed before Load runs too, so no shape of the feature could have left import resolution where it was. Names arrive qualified, as a defn's do. (mac/twice 4) is a call and (twice 4) is an unknown name. Stopped mid-task: dune test was never run and the acceptance wiring is unfinished. HANDOFF-macros.md has what is left.
1063 lines
49 KiB
OCaml
1063 lines
49 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"
|
|
|
|
| Sym "defmacro" ->
|
|
fail f "defmacro is a top-level declaration, not an expression"
|
|
|
|
(* 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)
|