Joseph Ferano
0e7f53a510
Two things that look like plumbing and are the frontend half of expansion.
A quasiquote becomes calls to the prelude's three form-building functions and
nothing else: form-nil, form-cons for an item, form-append for a splice. It is
pure, it needs nothing loaded, and it runs over every form on the way into
Parse.program and Parse.decl, which is what lets the prelude's own macros parse
in a process that has not built a macro module yet.
Running it *before* the expander's walk is not an ordering preference. A cond
macro's body contains a quasiquoted (cond ...) for its own tail; with the
quasiquote still standing, the walk would see that head and expand it then and
there, against the wrong arguments. Desugared first, that subform is a
(Form.Sym {.s "cond"}) and there is no head left to mistake. So the walk needs
no idea that quoting exists, which is the whole reason this runs first.
Nesting levels are not counted -- not by the reader, which was written that way
deliberately, and not here. A quasiquote inside a quasiquote is refused by
name. Only a macro that writes a macro wants one, nothing in the corpus does,
and CL's level arithmetic costs more than the use case is worth so far.
A defmacro is now an Ast.Defn: (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 is [Form] -> Form, compiled by the same backend as
everything else, and the only thing that makes it a macro is that the expander
calls it at compile time. One parameter, the slice of forms at the call site,
so variadics come free in a language with no &rest; two parameters is a
misunderstanding rather than an arity error and says so.
Parse.expander is the hook the walk arrives through, because expanding a macro
means compiling and dlopening it, so the expander sits above Check and Build
and Parse sits below them. Nothing fills it in yet.
The quasiquote refusal stays as a backstop: it now means a form reached the
parser without coming through program or decl. gensym's refusal is gone -- it
is an ordinary prelude function returning a Form, and a macro body calls it
like any other.
950 lines
43 KiB
OCaml
950 lines
43 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)
|
|
| _ -> ()
|
|
|
|
(* Primitive type names are lowercase but concrete; every other lowercase name
|
|
in type position is a type variable (plan.org, Types). *)
|
|
let primitives =
|
|
[ "i8"; "i16"; "i32"; "i64"; "u8"; "u16"; "u32"; "u64";
|
|
"f32"; "f64"; "bool"; "string"; "Unit"; "Never" ]
|
|
|
|
let is_primitive s = List.mem s primitives
|
|
|
|
module Names = Set.Make (String)
|
|
|
|
(* Type constructors the language provides. User types are collected by a
|
|
pre-pass over the file's declarations — see [program]. *)
|
|
let builtin_types =
|
|
Names.of_list (primitives @ [ "Ptr"; "Option"; "Result"; "Vec"; "Map";
|
|
"Handle"; "Fn" ])
|
|
|
|
(* ── Type expressions ──────────────────────────────────────────────── *)
|
|
|
|
let rec texpr (f : Form.t) : Ast.texpr =
|
|
let mk t = { Ast.t; tloc = f.loc } in
|
|
match f.v with
|
|
| 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"
|
|
| Map [ k; v ] -> mk (Ast.Tmap (texpr k, texpr v))
|
|
| Map _ -> fail f "a map type is {K V}"
|
|
| 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)
|
|
|
|
(* ── 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 "unless" ->
|
|
(match args with
|
|
| c :: body when body <> [] ->
|
|
let neg = { Ast.e = Ast.Call ({ Ast.e = Ast.Var "not"; loc = head.loc },
|
|
[ expr c ]); loc = f.loc } in
|
|
mk (Ast.If (neg, { Ast.e = Ast.Do (body_of body); loc = f.loc }, None))
|
|
| _ -> fail f "unless is (unless 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 ─────────────────────────────────────────────────────── *)
|
|
| Sym "while" ->
|
|
(match args with
|
|
| c :: body -> mk (Ast.While (expr c, body_of body))
|
|
| [] -> fail f "while is (while test body ...)")
|
|
|
|
| Sym "until" ->
|
|
(match args with
|
|
| 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 (neg, body_of body))
|
|
| [] -> fail f "until is (until test body ...)")
|
|
|
|
(* ── 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)")
|
|
|
|
| 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 args with
|
|
| { v = Vec [ n; count ]; _ } :: body ->
|
|
no_pattern n;
|
|
mk (Ast.Dotimes (sym n, expr count, body_of body))
|
|
| _ -> fail f "dotimes is (dotimes [name count] body ...)")
|
|
|
|
| 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" | "loop" | "recur"
|
|
(* plan.org's loop story is settled as imperative while/for with these
|
|
two and [return]. Neither exists, and both *alter control flow* —
|
|
the first thing the house rule says must be recognised explicitly.
|
|
Falling through to Call answered "unknown function break", which
|
|
reads as a typo rather than as a missing feature. *)
|
|
| "break" | "continue"
|
|
| "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
|
|
|
|
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 types (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 ...]) ...])")
|
|
|
|
| List ({ v = Sym "defn"; _ } :: args) ->
|
|
(match args with
|
|
| n :: { v = Vec ps; _ } :: rest ->
|
|
let ret, body =
|
|
match rest with
|
|
(* An omitted return type means Unit. A leading form that is a type
|
|
and is not the whole body is the return type. *)
|
|
| [] -> None, []
|
|
| first :: more when more <> [] && is_type_form types first ->
|
|
Some (texpr first), body_of more
|
|
| _ -> None, body_of rest
|
|
in
|
|
mk (Ast.Defn { Ast.name = sym n; params = fields f ps; ret;
|
|
fbody = body; nloc = n.loc })
|
|
| _ -> fail f "defn is (defn name [param Type ...] ReturnType? body ...)")
|
|
|
|
| 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; 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); 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; 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)
|
|
|
|
(* Is this form the function's return type, or the first form of its body?
|
|
|
|
Shape alone cannot tell: [(Option f64)] and [(Some 1)] are identical
|
|
s-expressions, one a type application and one a constructor call. Capitalised
|
|
heads are not a good enough signal — [(defn f [] (Some 1) (bar))] would eat
|
|
the body's first form as a return type, silently.
|
|
|
|
So the decision uses the set of names that are actually types, which the
|
|
pre-pass in [program] collects from the file's own declarations. That makes
|
|
it exact rather than heuristic, because types are only ever introduced by
|
|
defstruct, defunion and defalias — all syntactically obvious. *)
|
|
(* A name a package brought in — [rl/Vector2]. It cannot be in [types]: the set
|
|
comes from this file's own declarations, and an import is not resolved until
|
|
after parsing, so a package's structs are unknown here by construction.
|
|
|
|
The signal is the alias plus the capital. An alias is syntactically obvious,
|
|
collected by the same pre-pass; and a bare capitalised symbol is never a
|
|
*value* in this language — a struct or union constructor is [(Name {...})],
|
|
a List, and an enum member is a keyword. So [alias/Name] in a type position
|
|
is a type, and the case the comment above warns about — a body form eaten as
|
|
a return type — cannot arise, because there is no body form of that shape.
|
|
|
|
A lowercase qualified name stays an expression, which is what [rl/get-color]
|
|
in [(defn f [] rl/get-color)] has to be. *)
|
|
and qualified_type types s =
|
|
match String.index_opt s '/' with
|
|
| None -> false
|
|
| Some i ->
|
|
let alias = String.sub s 0 i and name = String.sub s (i + 1) (String.length s - i - 1) in
|
|
Names.mem ("import " ^ alias) types
|
|
&& name <> ""
|
|
&& name.[0] >= 'A' && name.[0] <= 'Z'
|
|
|
|
and is_type_form types (f : Form.t) =
|
|
match f.v with
|
|
| Sym s ->
|
|
Names.mem s types || Names.mem ("enum " ^ s) types
|
|
|| Names.mem ("prelude " ^ s) types || qualified_type types s
|
|
| Vec _ -> true (* [T] and [n T] are only types *)
|
|
| Map _ -> true (* {K V} in this position *)
|
|
| List ({ v = Sym n; _ } :: _) ->
|
|
Names.mem n types || qualified_type types n
|
|
| _ -> false
|
|
|
|
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 ...])"
|
|
|
|
(* Names introduced as types by a list of forms. Collected before anything is
|
|
parsed, so a type declared at the bottom of a file is still known to a
|
|
function at the top — top-level names are order-independent. *)
|
|
let types_in (base : Names.t) (forms : Form.t list) : Names.t =
|
|
List.fold_left
|
|
(fun acc (f : Form.t) ->
|
|
match f.v with
|
|
| List [ { v = Sym ("defstruct" | "defunion" | "defalias"); _ };
|
|
{ v = Sym n; _ }; _ ] -> Names.add n acc
|
|
(* The aliases too, under a key no symbol can collide with, so that
|
|
[qualified_type] can tell [rl/Vector2] from a name with a slash in
|
|
it that nothing imported. *)
|
|
| List [ { v = Sym "import"; _ }; { v = Sym a; _ }; { v = Str _; _ } ] ->
|
|
Names.add ("import " ^ a) acc
|
|
(* An enum is a type too, but under its own key rather than beside the
|
|
structs, because [(Key n)] is now a *value* — the integer-to-enum
|
|
conversion — and putting Key in [types] would make [is_type_form]
|
|
read that as a type application and eat it as a return type. So an
|
|
enum name counts only as a bare symbol, which is the one position it
|
|
can appear in as a type, and never as a list head. *)
|
|
| List [ { v = Sym "defenum"; _ }; { v = Sym n; _ }; _ ] ->
|
|
Names.add ("enum " ^ n) acc
|
|
| _ -> acc)
|
|
base forms
|
|
|
|
(* The prelude's types are every file's types. [Check.program] prepends the
|
|
prelude to every program, so StorageExhausted, FileError and Form are as
|
|
available as i32 is — but [types_in] reads one file's own declarations, and
|
|
the prelude is a different list of forms, so nothing here knew that.
|
|
|
|
It read as a gap that could not matter, because a bare capitalised name is
|
|
the only type position this set is consulted for and the prelude's structs
|
|
were only ever *taken* as parameters, never *returned*. Macros are where it
|
|
bites: a macro is (defn m [args [Form]] Form ...), and [Form] as the return
|
|
type was parsed as the first form of the body and reported as an unknown
|
|
name — the parser deciding a declared type was a value. [[Form]] worked,
|
|
because a Vec in that position is a type whatever is in it, which is exactly
|
|
the kind of half-working that hides this.
|
|
|
|
They go in under their own key, for the reason the enums do one comment up.
|
|
Added plainly, [is_type_form]'s list-head arm would read [(Rune {.code 65})]
|
|
as a type application and eat it as a return type — silently, in every file
|
|
in the language, which is the exact failure the comment above
|
|
[is_type_form] warns about. No prelude type takes arguments, so a bare
|
|
symbol is the only type position any of them can occupy, and the bare-symbol
|
|
arm is the only one that asks.
|
|
|
|
Read once: the prelude is a constant string and this set is a constant of
|
|
it. *)
|
|
let prelude_types =
|
|
lazy
|
|
(List.fold_left
|
|
(fun acc (f : Form.t) ->
|
|
match f.v with
|
|
| Form.List [ { v = Form.Sym ("defstruct" | "defunion" | "defalias"); _ };
|
|
{ v = Form.Sym n; _ }; _ ] ->
|
|
Names.add ("prelude " ^ n) acc
|
|
| Form.List [ { v = Form.Sym "defenum"; _ }; { v = Form.Sym n; _ }; _ ] ->
|
|
Names.add ("enum " ^ n) acc
|
|
| _ -> acc)
|
|
builtin_types (Prelude.forms ()))
|
|
|
|
let declared_types (forms : Form.t list) : Names.t =
|
|
types_in (Lazy.force prelude_types) forms
|
|
|
|
(* 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)
|
|
|
|
let program (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
|
|
let types = declared_types forms in
|
|
temps := 0;
|
|
List.map (decl types) forms
|
|
|
|
(* Single-declaration entry point, for tests and the REPL. Sees the builtin and
|
|
prelude types plus whatever this one form declares. *)
|
|
let decl (f : Form.t) : Ast.decl =
|
|
temps := 0;
|
|
match !expander [ Expand.quasiquote f ] with
|
|
| [ f ] -> decl (declared_types [ f ]) 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)
|