Joseph Ferano
ff2c949361
Flan's tagged sum has been spelled defunion since it landed, which was accurate right up until the language wanted C's untagged union as well. Both cannot be called the same thing, and the tagged one is the one with an alternative name that says what it is: a case, its fields, and a tag that steers which case is live is a data type, not a union. So the form is defdata everywhere -- the parser, the AST, the checker, both backends, the prelude's Form, the editor's font-locking and imenu, the docs and every .flan file in the tree. The internal vocabulary moves with it: Tast.union is Tast.data, uname is dname, the tables the checker and the emitter keep are datas. Leaving them would have inverted the words permanently, with surface defunion meaning one thing and env.unions meaning the other, which is exactly the kind of drift the comments in those files exist to prevent. What did not move is case, variant and vfields: a tagged sum still has cases, and it still has one live at a time. defunion is not kept as an alias. An alias would compile the day the untagged form lands and mean the opposite of what it used to -- the same silent misparse that made defn's return type mandatory, and worse, because the reader would have no reason to look. The old spelling is a named refusal instead, parse/defunion-renamed, which says what it is now called and that the name is reserved for something else. It fires on the head alone, so (defunion U [A B]) -- which would otherwise have parsed cleanly as one field A of type B -- is refused with the rest.
1225 lines
57 KiB
OCaml
1225 lines
57 KiB
OCaml
(** Imports: {v (import rl "vendor:raylib") v} resolved into ordinary
|
|
declarations, before the checker ever runs.
|
|
|
|
The directory is the package (plan.org, Modules), so a path is a directory
|
|
and every [.flan] file in it contributes. [vendor:] and [core:] are
|
|
collections — root-directory aliases, as in Odin — and are resolved by
|
|
walking up from the importing file until a directory of that name is found.
|
|
No project file, no manifest: a loose file in a scratch directory is still
|
|
a package of one.
|
|
|
|
Importing is a rename, done here: every top-level name the package declares
|
|
becomes [alias/name], and every use of one of its own names — in a type, in
|
|
a body, in a struct literal — is rewritten to match. Local bindings shadow,
|
|
so a parameter named like a package function stays the parameter. Nothing
|
|
downstream knows a package existed; the checker sees one flat list of
|
|
declarations with names that happen to contain a slash.
|
|
|
|
A package may import a package. The qualification flattens to the *inner*
|
|
alias — raylib imported by a package that is itself imported is still
|
|
[rl/...] — because a directory reached along two routes has to arrive under
|
|
one set of names or the checker sees every declaration twice. Two importers
|
|
of one directory load it once, keyed by its real path; the same directory
|
|
under two different aliases is refused, and so is a cycle.
|
|
|
|
Visibility is one rule so far: [main] is not exported. A package carrying
|
|
one would collide with the importer's, and worse, would keep everything it
|
|
calls reachable (see [Reach]) — which for a raylib front-end is the whole
|
|
library, on the target that cannot link it. Package-private markers for
|
|
anything else are still missing, which is why [rl/get-color-raw] is
|
|
callable.
|
|
|
|
A package may also carry the C it binds to. Every [.c] file in the
|
|
directory is compiled into the build, and a file named [link] lists extra
|
|
linker arguments, one per line. That is where the aggregate calling
|
|
convention lives: a shim written in C means clang classifies [Vector2] and
|
|
[Color] correctly on x86-64, arm64 and wasm32 alike, and [emit.ml] never
|
|
learns the difference. *)
|
|
|
|
type t = {
|
|
decls : Ast.decl list;
|
|
csrcs : string list; (* C sources compiled into the build *)
|
|
lflags : string list; (* extra linker arguments *)
|
|
(* Which alias each package's directory was imported under, and the names it
|
|
owns. A file on disk does not say what it is called from outside — the
|
|
*importer* chooses that — so this is the only place the answer exists, and
|
|
a REPL editing a package's source needs it to know that [poll] typed in
|
|
vendor/agent/agent.flan means [agent/poll] to the running program. *)
|
|
pkgs : pkg list;
|
|
(* Every [defmacro] the imported packages declare, qualified under the alias
|
|
each was imported as and quasiquote-desugared, ready for
|
|
[Parse.imported_macros]. It is carried out of here rather than left behind
|
|
because the parse that needs it outlives the one this drove: a C-c C-c on
|
|
a function that calls [rl/with-drawing] is a fresh [Parse.program] with no
|
|
import form in sight, and [Session] hands this back to it. *)
|
|
macros : Form.t list;
|
|
}
|
|
|
|
(* [pcsrcs] and [plflags] are the package's own, kept per-package rather than
|
|
only in the aggregate above: whether they are handed to the build at all is
|
|
decided after checking, by whether anything reachable calls into the package
|
|
(see [Reach.link]). The aggregate fields remain what a dev build uses, where
|
|
"not called yet" is not "not called". *)
|
|
and pkg = { alias : string; dir : string; owns : string list;
|
|
pcsrcs : string list; plflags : string list;
|
|
(* Names a [headers] file could have supplied and deliberately did
|
|
not, each with the reason — already qualified, so [rl/…]. A
|
|
wholesale header import refuses a great many functions and the
|
|
caller cares about the one they wrote, so the reason is attached
|
|
to the name and raised where it is used rather than printed at
|
|
import. See [Cimport]. *)
|
|
phidden : (string * string) list }
|
|
|
|
let empty = { decls = []; csrcs = []; lflags = []; pkgs = []; macros = [] }
|
|
|
|
let fail loc fmt = Printf.ksprintf (fun m -> Loc.raise_diag (Loc.diag loc m)) fmt
|
|
|
|
(* "vendor:raylib" -> the collection "vendor" and the subpath "raylib". A path
|
|
with no colon is relative to the importing file's own directory. *)
|
|
let split_path path =
|
|
match String.index_opt path ':' with
|
|
| None -> None, path
|
|
| Some i ->
|
|
Some (String.sub path 0 i),
|
|
String.sub path (i + 1) (String.length path - i - 1)
|
|
|
|
(* Walk up from [dir] looking for a subdirectory named [name]. Stops at the
|
|
filesystem root, so a missing collection is an error and never a silent
|
|
search of the whole machine. *)
|
|
let rec find_collection dir name =
|
|
let candidate = Filename.concat dir name in
|
|
if Sys.file_exists candidate && Sys.is_directory candidate then Some candidate
|
|
else
|
|
let parent = Filename.dirname dir in
|
|
if String.equal parent dir then None else find_collection parent name
|
|
|
|
(* A package is a directory, or a single [.flan] file named outright. The file
|
|
form is for the program that is also a library: sand.flan sits beside three
|
|
other loose .flan files, so naming its directory would import all four, and
|
|
moving it into one of its own would be arranging the tree around a
|
|
limitation. A file carries no [.c] and no [link] — those belong to a
|
|
directory, and a package that needs them has one. *)
|
|
let is_package_file path =
|
|
Filename.check_suffix path ".flan" && Sys.file_exists path
|
|
&& not (Sys.is_directory path)
|
|
|
|
let resolve_dir ~file loc path =
|
|
let here =
|
|
let d = Filename.dirname file in
|
|
if Filename.is_relative d then Filename.concat (Sys.getcwd ()) d else d
|
|
in
|
|
let ok d = (Sys.file_exists d && Sys.is_directory d) || is_package_file d in
|
|
match split_path path with
|
|
| None, rel ->
|
|
let d = Filename.concat here rel in
|
|
if ok d then d else fail loc "no package at %s — wanted a directory or a \
|
|
.flan file" d
|
|
| Some collection, rel ->
|
|
(match find_collection here collection with
|
|
| None ->
|
|
fail loc
|
|
"the collection %s: is a directory named %s somewhere above %s, and \
|
|
there is none" collection collection here
|
|
| Some root ->
|
|
let d = Filename.concat root rel in
|
|
if ok d then d else fail loc "the package %s is not at %s" path d)
|
|
|
|
let entries dir suffix =
|
|
Sys.readdir dir
|
|
|> Array.to_list
|
|
|> List.filter (fun f -> Filename.check_suffix f suffix)
|
|
|> List.sort String.compare
|
|
|> List.map (Filename.concat dir)
|
|
|
|
(* ── Qualifying an imported package ────────────────────────────────── *)
|
|
|
|
let qualify alias n = alias ^ "/" ^ n
|
|
|
|
(* The type names the package itself declares. Only these are rewritten: a
|
|
reference to [i32] or to [Ptr] must survive untouched. *)
|
|
let rec rename_texpr owned alias (t : Ast.texpr) : Ast.texpr =
|
|
let k =
|
|
match t.Ast.t with
|
|
| Ast.Tname n when List.mem n owned -> Ast.Tname (qualify alias n)
|
|
| Ast.Tname _ as k -> k
|
|
| Ast.Tslice e -> Ast.Tslice (rename_texpr owned alias e)
|
|
(* The length too: [rows] in [[rows [cols u32]]] is an ordinary
|
|
compile-time constant of the package, not part of the type syntax. *)
|
|
| Ast.Tarray (l, e) ->
|
|
let l =
|
|
match l with
|
|
| Ast.Lname n when List.mem n owned -> Ast.Lname (qualify alias n)
|
|
| l -> l
|
|
in
|
|
Ast.Tarray (l, rename_texpr owned alias e)
|
|
| Ast.Tmap (k, v) ->
|
|
Ast.Tmap (rename_texpr owned alias k, rename_texpr owned alias v)
|
|
| Ast.Tapp (n, args) ->
|
|
Ast.Tapp (n, List.map (rename_texpr owned alias) args)
|
|
| Ast.Tfn (ps, r) ->
|
|
Ast.Tfn (List.map (rename_texpr owned alias) ps, rename_texpr owned alias r)
|
|
in
|
|
{ t with Ast.t = k }
|
|
|
|
(* Bodies too, once a package may define and not only declare. A package-local
|
|
name is qualified wherever it is *used*; a local binding shadows it, which is
|
|
why [bound] is carried down through [let], [fn] and [dotimes]. Everything
|
|
else — field names, keywords, enum members — is not a top-level name and is
|
|
left alone. *)
|
|
let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
|
|
let go = rename_expr owned alias bound in
|
|
let gos = List.map go in
|
|
let name n = if List.mem n owned && not (List.mem n bound) then qualify alias n else n in
|
|
let k =
|
|
match e.Ast.e with
|
|
| Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _
|
|
| Ast.Quote _ -> e.Ast.e
|
|
| Ast.Var n -> Ast.Var (name n)
|
|
| Ast.Do body -> Ast.Do (gos body)
|
|
| Ast.Let (bs, body) ->
|
|
(* Sequential, as [let] itself is: each initialiser sees the bindings
|
|
before it and not its own. *)
|
|
let bound, bs =
|
|
List.fold_left
|
|
(fun (bound, acc) (b : Ast.binding) ->
|
|
let b =
|
|
{ b with
|
|
Ast.bty = Option.map (rename_texpr owned alias) b.Ast.bty;
|
|
bval = rename_expr owned alias bound b.Ast.bval }
|
|
in
|
|
(b.Ast.bname :: bound, b :: acc))
|
|
(bound, []) bs
|
|
in
|
|
Ast.Let (List.rev bs, List.map (rename_expr owned alias bound) body)
|
|
| Ast.If (c, t, e') -> Ast.If (go c, go t, Option.map go e')
|
|
| Ast.While (l, c, body) -> Ast.While (l, go c, gos body)
|
|
(* A loop's names are its own and are never imported; its initial
|
|
values and its body are ordinary expressions. *)
|
|
| Ast.Loop (bs, body) ->
|
|
Ast.Loop (List.map (fun (n, v) -> (n, go v)) bs, gos body)
|
|
| Ast.Recur args -> Ast.Recur (gos args)
|
|
(* A loop label is not a top-level name: it is resolved against the loops
|
|
this form is inside, so an import has nothing to qualify. *)
|
|
| (Ast.Break _ | Ast.Continue _) as k -> k
|
|
| Ast.Return v -> Ast.Return (Option.map go v)
|
|
| Ast.Set (p, v) -> Ast.Set (rename_place owned alias bound p, go v)
|
|
| Ast.Field (t, f) -> Ast.Field (go t, f)
|
|
| Ast.Call (h, args) -> Ast.Call (go h, gos args)
|
|
| Ast.Match (sc, arms) ->
|
|
Ast.Match (go sc,
|
|
List.map (fun (a : Ast.arm) ->
|
|
let bound =
|
|
match a.Ast.pat with
|
|
| Ast.Pctor (_, ns) -> ns @ bound
|
|
| Ast.Pwild -> bound
|
|
in
|
|
{ a with Ast.body = List.map (rename_expr owned alias bound)
|
|
a.Ast.body }) arms)
|
|
| Ast.Struct (n, kvs) ->
|
|
Ast.Struct (name n, List.map (fun (k, v) -> (k, go v)) kvs)
|
|
| Ast.Arr items -> Ast.Arr (gos items)
|
|
| Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t)
|
|
| Ast.Fn (ps, body) ->
|
|
Ast.Fn (ps, List.map (rename_expr owned alias (ps @ bound)) body)
|
|
| Ast.Dotimes (l, i, n, body) ->
|
|
Ast.Dotimes (l, i, go n,
|
|
List.map (rename_expr owned alias (i :: bound)) body)
|
|
| Ast.Defer body -> Ast.Defer (gos body)
|
|
| Ast.Unwrap (u, v) -> Ast.Unwrap (u, go v)
|
|
| Ast.Signal (k, c) -> Ast.Signal (k, go c)
|
|
(* A restart name is not a top-level name — it is looked up on the restart
|
|
stack, not in the environment — so an import does not qualify it. The
|
|
bodies are rewritten, and so are a clause's parameter types, which name
|
|
types like any other annotation; the parameters themselves bind inside
|
|
the clause and shadow a package name there. *)
|
|
| Ast.RestartCase (body, clauses) ->
|
|
Ast.RestartCase
|
|
(go body,
|
|
List.map
|
|
(fun (c : Ast.rclause) ->
|
|
let ps =
|
|
List.map
|
|
(fun (p : Ast.field) ->
|
|
{ p with Ast.fty = rename_texpr owned alias p.Ast.fty })
|
|
c.Ast.rparams
|
|
in
|
|
let bound =
|
|
List.map (fun (p : Ast.field) -> p.Ast.fname) ps @ bound
|
|
in
|
|
{ c with
|
|
Ast.rparams = ps;
|
|
rbody = List.map (rename_expr owned alias bound) c.Ast.rbody })
|
|
clauses)
|
|
| Ast.InvokeRestart (n, args) -> Ast.InvokeRestart (n, gos args)
|
|
(* A clause names a condition *type*, which an import renames like any
|
|
other, and binds a name for the condition inside its own body. *)
|
|
| Ast.HandlerBind (clauses, body) ->
|
|
Ast.HandlerBind
|
|
(List.map
|
|
(fun (c : Ast.hclause) ->
|
|
{ c with
|
|
Ast.hty = rename_texpr owned alias c.Ast.hty;
|
|
hbody =
|
|
List.map (rename_expr owned alias (c.Ast.hname :: bound))
|
|
c.Ast.hbody })
|
|
clauses,
|
|
gos body)
|
|
in
|
|
{ e with Ast.e = k }
|
|
|
|
and rename_place owned alias bound (p : Ast.place) : Ast.place =
|
|
let go = rename_expr owned alias bound in
|
|
match p with
|
|
| Ast.Pvar n ->
|
|
Ast.Pvar (if List.mem n owned && not (List.mem n bound) then qualify alias n else n)
|
|
| Ast.Pfield (t, f) -> Ast.Pfield (go t, f)
|
|
| Ast.Pindex (t, idx) -> Ast.Pindex (go t, List.map go idx)
|
|
| Ast.Pderef t -> Ast.Pderef (go t)
|
|
|
|
let rename_field owned alias (f : Ast.field) : Ast.field =
|
|
{ f with Ast.fty = rename_texpr owned alias f.Ast.fty }
|
|
|
|
let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
|
|
let loc = d.Ast.dloc in
|
|
let k =
|
|
match d.Ast.d with
|
|
| Ast.Declare (fn, csym) ->
|
|
Ast.Declare
|
|
({ fn with
|
|
Ast.name = qualify alias fn.Ast.name;
|
|
params = List.map (rename_field owned alias) fn.Ast.params;
|
|
ret = Option.map (rename_texpr owned alias) fn.Ast.ret },
|
|
csym)
|
|
(* The same as [Declare]: [Shim] has not run yet, so this is still the
|
|
library's own signature and the names in it are the package's. *)
|
|
| Ast.DeclareC (fn, csym) ->
|
|
Ast.DeclareC
|
|
({ fn with
|
|
Ast.name = qualify alias fn.Ast.name;
|
|
params = List.map (rename_field owned alias) fn.Ast.params;
|
|
ret = Option.map (rename_texpr owned alias) fn.Ast.ret },
|
|
csym)
|
|
| Ast.Defenum (n, ms) -> Ast.Defenum (qualify alias n, ms)
|
|
| Ast.Defalias (n, t) ->
|
|
Ast.Defalias (qualify alias n, rename_texpr owned alias t)
|
|
| Ast.Defconst (n, t, v) ->
|
|
Ast.Defconst (qualify alias n,
|
|
Option.map (rename_texpr owned alias) t,
|
|
rename_expr owned alias [] v)
|
|
| Ast.Defstruct (n, fs) ->
|
|
Ast.Defstruct (qualify alias n, List.map (rename_field owned alias) fs)
|
|
| Ast.Defvar (n, t, init) ->
|
|
Ast.Defvar (qualify alias n, Option.map (rename_texpr owned alias) t,
|
|
(match init with
|
|
| Ast.Init v -> Ast.Init (rename_expr owned alias [] v)
|
|
| other -> other))
|
|
| Ast.Defn fn ->
|
|
let params = List.map (rename_field owned alias) fn.Ast.params in
|
|
let bound = List.map (fun (p : Ast.field) -> p.Ast.fname) fn.Ast.params in
|
|
Ast.Defn
|
|
{ fn with
|
|
Ast.name = qualify alias fn.Ast.name;
|
|
params;
|
|
ret = Option.map (rename_texpr owned alias) fn.Ast.ret;
|
|
fbody = List.map (rename_expr owned alias bound) fn.Ast.fbody }
|
|
| Ast.Package _ -> Ast.Package alias
|
|
(* A package's own imports were resolved before this ran and are not in
|
|
the list it is given, so one arriving here is a bug in [import] rather
|
|
than anything a user wrote. *)
|
|
| Ast.Import (a, _) ->
|
|
fail loc "internal: the import of %s was not resolved before qualifying" a
|
|
| Ast.Defdata (n, _) ->
|
|
fail loc "%s is a data type, and an imported data type is not \
|
|
implemented yet \
|
|
(milestone 4)" n
|
|
in
|
|
{ d with Ast.d = k }
|
|
|
|
(* ── Qualifying a package's macros ──────────────────────────────────
|
|
The rename above works over the Ast and a macro cannot go that way. By the
|
|
time [Parse] is finished with a [defmacro] its quasiquote has been desugared
|
|
into [form-cons] and [form-nil] calls, and a quasiquoted [(begin)] is a
|
|
[(Form.Sym {.s "begin"})] whose name is a *string in an argument* rather
|
|
than a name anything would rename. That is not an accident to work around:
|
|
it is the property [Macro]'s walk depends on, the one that makes a
|
|
quasiquoted call output rather than a compile-order dependency (docs/BUILT.md,
|
|
"A call inside a quasiquote is output, not a dependency"). It is also
|
|
exactly what puts the name out of a rename's reach.
|
|
|
|
So a package's macro is renamed here instead, over the text its author
|
|
wrote, where [`(begin)] and [(begin)] are still the same shape and one rule
|
|
covers both: a symbol the package owns becomes [alias/symbol]. The
|
|
quasiquote is desugared afterwards, so the walk still sees what it needs to.
|
|
|
|
The importer's own forms are never at risk of being caught by this. They do
|
|
not appear in the text at all — a call site's arguments reach the macro at
|
|
run time, through [args], as values.
|
|
|
|
[bound] is [rename_expr]'s idea: a local shadows a top-level name. The
|
|
binders tracked are the ones a macro body can hold — its own parameter,
|
|
[let], [loop], [fn] and [dotimes]. A [match] pattern's names and a
|
|
[restart-case] clause's parameters are not tracked, which is a gap and a
|
|
narrow one: it takes a macro body that both destructures a data type and binds a
|
|
name the package also declares at the top level. *)
|
|
|
|
let rec form_syms (f : Form.t) acc =
|
|
match f.Form.v with
|
|
| Form.Sym n -> n :: acc
|
|
| Form.List xs | Form.Vec xs | Form.Map xs ->
|
|
List.fold_left (fun a x -> form_syms x a) acc xs
|
|
| _ -> acc
|
|
|
|
(* A leading keyword is a loop label, which [dotimes] and [while] take and
|
|
which is never a binding. *)
|
|
let peel_label = function
|
|
| ({ Form.v = Form.Kw _; _ } as k) :: rest -> ([ k ], rest)
|
|
| rest -> ([], rest)
|
|
|
|
let rec rename_form owned alias bound (f : Form.t) : Form.t =
|
|
let keep v = { f with Form.v = v } in
|
|
let go b x = rename_form owned alias b x in
|
|
match f.Form.v with
|
|
| Form.Sym n when List.mem n owned && not (List.mem n bound) ->
|
|
keep (Form.Sym (qualify alias n))
|
|
| Form.List (({ Form.v = Form.Sym ("let" | "loop"); _ } as hd)
|
|
:: { Form.v = Form.Vec bs; loc = bloc } :: body) ->
|
|
(* Sequential, as [let] itself is: an initialiser sees the bindings before
|
|
it and not its own. A binding position may be a destructuring pattern,
|
|
so every symbol in it binds — over-binding only ever declines to rename,
|
|
which is the safe direction. *)
|
|
let rec pairs bound acc = function
|
|
| n :: v :: rest -> pairs (form_syms n bound) (go bound v :: n :: acc) rest
|
|
| [ x ] -> (bound, go bound x :: acc)
|
|
| [] -> (bound, acc)
|
|
in
|
|
let bound, bs = pairs bound [] bs in
|
|
keep (Form.List (hd :: Form.make (Form.Vec (List.rev bs)) bloc
|
|
:: List.map (go bound) body))
|
|
| Form.List (({ Form.v = Form.Sym "fn"; _ } as hd)
|
|
:: ({ Form.v = Form.Vec ps; _ } as pv) :: body) ->
|
|
let bound = List.fold_left (fun a p -> form_syms p a) bound ps in
|
|
keep (Form.List (hd :: pv :: List.map (go bound) body))
|
|
| Form.List (({ Form.v = Form.Sym "dotimes"; _ } as hd) :: rest) ->
|
|
(match peel_label rest with
|
|
| lbl, ({ Form.v = Form.Vec [ n; count ]; loc = bloc } :: body) ->
|
|
keep (Form.List
|
|
(hd :: lbl
|
|
@ Form.make (Form.Vec [ n; go bound count ]) bloc
|
|
:: List.map (go (form_syms n bound)) body))
|
|
| _ -> keep (Form.List (hd :: List.map (go bound) rest)))
|
|
| Form.List xs -> keep (Form.List (List.map (go bound) xs))
|
|
| Form.Vec xs -> keep (Form.Vec (List.map (go bound) xs))
|
|
| Form.Map xs -> keep (Form.Map (List.map (go bound) xs))
|
|
| _ -> f
|
|
|
|
(* One [defmacro] form, as an importer has to see it. The name is qualified so
|
|
that nothing a package declares becomes visible unqualified — [mac/twice] is
|
|
a call and [twice] is an unknown name, the same rule every other declaration
|
|
follows — and the body is renamed so that what the macro *answers with*
|
|
names the package's functions and macros the way the importer's file has to
|
|
spell them.
|
|
|
|
Desugared on the way out, because [Macro.program] is handed forms that
|
|
[Parse.parse_forms] has already run [Expand.quasiquote] over and its rounds
|
|
read them with that assumed. An un-desugared one would make a quasiquoted
|
|
call look like a real one, which is the false ring docs/BUILT.md records the
|
|
first cycle test walking into. *)
|
|
let qualify_macro owned alias (f : Form.t) : Form.t option =
|
|
match f.Form.v with
|
|
| Form.List ({ Form.v = Form.Sym "defmacro"; _ } as hd
|
|
:: ({ Form.v = Form.Sym n; _ } as nf)
|
|
:: ({ Form.v = Form.Vec ps; _ } as pv) :: body) ->
|
|
let bound = List.fold_left (fun a p -> form_syms p a) [] ps in
|
|
Some
|
|
(Expand.quasiquote
|
|
{ f with
|
|
Form.v =
|
|
Form.List
|
|
(hd :: { nf with Form.v = Form.Sym (qualify alias n) } :: pv
|
|
:: List.map (rename_form owned alias bound) body) })
|
|
(* Malformed, and not this function's business to say so: the package's own
|
|
parse runs over the same form and [Parse] has the wording. *)
|
|
| _ -> None
|
|
|
|
(* Two packages may be reached along two routes and both arrive here, so the
|
|
set is deduped by name before it goes anywhere near [Macro] — a defmacro
|
|
twice over is a [defn] declared twice, refused by the checker for a reason
|
|
nobody would recognise. *)
|
|
let macro_union (a : Form.t list) (b : Form.t list) =
|
|
let named f =
|
|
match f.Form.v with
|
|
| Form.List (_ :: { Form.v = Form.Sym n; _ } :: _) -> Some n
|
|
| _ -> None
|
|
in
|
|
let have = List.filter_map named a in
|
|
a @ List.filter (fun f -> match named f with
|
|
| Some n -> not (List.mem n have)
|
|
| None -> true) b
|
|
|
|
(* ── Reading an import form ─────────────────────────────────────────
|
|
Which packages a file names, read out of the forms rather than out of the
|
|
parse — and this is the whole of what had to move earlier for a package to
|
|
be allowed a macro.
|
|
|
|
It is not a second import resolver, which is the thing the refusal this
|
|
replaces was right to be wary of. It does not recurse, it resolves no path
|
|
and it decides nothing: it reads one shape and hands the answer to
|
|
[import], which is still the only thing that walks a package graph, still
|
|
the only thing that keeps [seen] and [open_], and still the only thing that
|
|
refuses a cycle. Two resolvers can disagree. A reader and a resolver cannot.
|
|
|
|
A malformed import is skipped rather than complained about. [Parse] runs
|
|
over the same form moments later and already has the wording for it, so
|
|
saying it here would only mean saying it twice, differently.
|
|
|
|
Nothing is lost by reading these before expansion, because there is no
|
|
import an expansion could produce: [Parse.decl] dispatches on the head and a
|
|
macro name is not one of the heads it knows, so a macro call at the top
|
|
level is not a thing. *)
|
|
let imports_of (forms : Form.t list) =
|
|
List.filter_map
|
|
(fun (f : Form.t) ->
|
|
match f.Form.v with
|
|
| Form.List [ { Form.v = Form.Sym "import"; _ };
|
|
{ Form.v = Form.Sym a; _ };
|
|
{ Form.v = Form.Str p; _ } ] -> Some (a, p, f.Form.loc)
|
|
| _ -> None)
|
|
forms
|
|
|
|
(* ── Visibility ────────────────────────────────────────────────────── *)
|
|
|
|
(* The one rule so far: [main] is not a name a package offers.
|
|
|
|
There is a single top-level namespace and an import is a rename into it
|
|
(check.ml), so a package carrying a [main] would collide with the importer's
|
|
the moment anything imported it — a program could never be a package. And
|
|
the collision is the smaller half. [main] is a *root*: [Reach] starts there,
|
|
so an imported one keeps everything it calls alive. A raylib front-end
|
|
imported for its simulation would drag the whole library back in, on the
|
|
target that cannot link it, which is the thing the reachable-link change
|
|
exists to prevent.
|
|
|
|
So the package's [main] is dropped rather than qualified, and [alias/main]
|
|
is not a name. Everything else is still exported; package-private markers
|
|
are a separate gap (NEXT.md, Packages — [rl/get-color-raw] should not be
|
|
callable either). *)
|
|
let exported n = not (String.equal n "main")
|
|
|
|
(* Where a name is *used*, which is what a refusal has to point at. A rename
|
|
does not need this — it rebuilds the tree and the failure is a mismatch
|
|
later — but "you cannot see that name" has to name the line that tried.
|
|
|
|
Only top-level name positions are collected: a field, a keyword, an enum
|
|
member and a restart name are none of them, exactly as in the rename above.
|
|
Local bindings are not tracked, because the names this guards are ones no
|
|
local can be called: a [let] named [sim/main] does not parse. *)
|
|
let rec texpr_uses acc (t : Ast.texpr) =
|
|
match t.Ast.t with
|
|
| Ast.Tname n -> acc := (n, t.Ast.tloc) :: !acc
|
|
| Ast.Tslice e -> texpr_uses acc e
|
|
| Ast.Tarray (l, e) ->
|
|
(match l with Ast.Lname n -> acc := (n, t.Ast.tloc) :: !acc | Ast.Lint _ -> ());
|
|
texpr_uses acc e
|
|
| Ast.Tmap (k, v) -> texpr_uses acc k; texpr_uses acc v
|
|
| Ast.Tapp (_, args) -> List.iter (texpr_uses acc) args
|
|
| Ast.Tfn (ps, r) -> List.iter (texpr_uses acc) ps; texpr_uses acc r
|
|
|
|
let rec expr_uses acc (e : Ast.expr) =
|
|
let go = expr_uses acc in
|
|
let gos = List.iter go in
|
|
match e.Ast.e with
|
|
| Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ | Ast.Quote _ ->
|
|
()
|
|
(* The name is not one an import can supply, but the arguments are ordinary
|
|
expressions and may well use one. *)
|
|
| Ast.InvokeRestart (_, args) -> gos args
|
|
| Ast.Var n -> acc := (n, e.Ast.loc) :: !acc
|
|
| Ast.Do body -> gos body
|
|
| Ast.Let (bs, body) ->
|
|
List.iter
|
|
(fun (b : Ast.binding) ->
|
|
Option.iter (texpr_uses acc) b.Ast.bty; go b.Ast.bval)
|
|
bs;
|
|
gos body
|
|
| Ast.If (c, t, e') -> go c; go t; Option.iter go e'
|
|
| Ast.While (_, c, body) -> go c; gos body
|
|
| Ast.Loop (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body
|
|
| Ast.Recur args -> gos args
|
|
| Ast.Break _ | Ast.Continue _ -> ()
|
|
| Ast.Return v -> Option.iter go v
|
|
| Ast.Set (p, v) -> place_uses acc e.Ast.loc p; go v
|
|
| Ast.Field (t, _) -> go t
|
|
| Ast.Call (h, args) -> go h; gos args
|
|
| Ast.Match (sc, arms) ->
|
|
go sc; List.iter (fun (a : Ast.arm) -> gos a.Ast.body) arms
|
|
| Ast.Struct (n, kvs) ->
|
|
acc := (n, e.Ast.loc) :: !acc;
|
|
List.iter (fun (_, v) -> go v) kvs
|
|
| Ast.Arr items -> gos items
|
|
| Ast.ArrayOf t -> texpr_uses acc t
|
|
| Ast.Fn (_, body) -> gos body
|
|
| Ast.Dotimes (_, _, n, body) -> go n; gos body
|
|
| Ast.Defer body -> gos body
|
|
| Ast.Unwrap (_, v) -> go v
|
|
| Ast.Signal (_, c) -> go c
|
|
| Ast.RestartCase (body, clauses) ->
|
|
go body;
|
|
List.iter
|
|
(fun (c : Ast.rclause) ->
|
|
List.iter (fun (p : Ast.field) -> texpr_uses acc p.Ast.fty) c.Ast.rparams;
|
|
gos c.Ast.rbody)
|
|
clauses
|
|
| Ast.HandlerBind (clauses, body) ->
|
|
List.iter
|
|
(fun (c : Ast.hclause) -> texpr_uses acc c.Ast.hty; gos c.Ast.hbody)
|
|
clauses;
|
|
gos body
|
|
|
|
(* A place carries no location of its own, so it borrows the [set] form's. *)
|
|
and place_uses acc loc (p : Ast.place) =
|
|
match p with
|
|
| Ast.Pvar n -> acc := (n, loc) :: !acc
|
|
| Ast.Pfield (t, _) -> expr_uses acc t
|
|
| Ast.Pindex (t, idx) -> expr_uses acc t; List.iter (expr_uses acc) idx
|
|
| Ast.Pderef t -> expr_uses acc t
|
|
|
|
let decl_uses acc (d : Ast.decl) =
|
|
let field (f : Ast.field) = texpr_uses acc f.Ast.fty in
|
|
let fn (f : Ast.fn) =
|
|
List.iter field f.Ast.params;
|
|
Option.iter (texpr_uses acc) f.Ast.ret;
|
|
List.iter (expr_uses acc) f.Ast.fbody
|
|
in
|
|
match d.Ast.d with
|
|
| Ast.Package _ | Ast.Import _ | Ast.Defenum _ -> ()
|
|
| Ast.Defalias (_, t) -> texpr_uses acc t
|
|
| Ast.Defstruct (_, fs) -> List.iter field fs
|
|
| Ast.Defdata (_, vs) ->
|
|
List.iter (fun (v : Ast.variant) -> List.iter field v.Ast.vfields) vs
|
|
| Ast.Defn f -> fn f
|
|
(* Both declaration forms name types in their signature and nothing else.
|
|
[declare-c] additionally causes a C typedef to be generated for every
|
|
struct it mentions, which is the same dependency by a different route. *)
|
|
| Ast.Declare (f, _) | Ast.DeclareC (f, _) ->
|
|
List.iter field f.Ast.params;
|
|
Option.iter (texpr_uses acc) f.Ast.ret
|
|
| Ast.Defvar (_, t, init) ->
|
|
Option.iter (texpr_uses acc) t;
|
|
(match init with Ast.Init v -> expr_uses acc v | _ -> ())
|
|
| Ast.Defconst (_, t, v) ->
|
|
Option.iter (texpr_uses acc) t; expr_uses acc v
|
|
|
|
let uses (ds : Ast.decl list) =
|
|
let acc = ref [] in
|
|
List.iter (decl_uses acc) ds;
|
|
List.rev !acc
|
|
|
|
(* The refusal, by name and at the line that tried. [hidden] maps a name that
|
|
cannot be seen to the reason it cannot. *)
|
|
let refuse_hidden hidden ds =
|
|
if hidden <> [] then
|
|
List.iter
|
|
(fun (n, loc) ->
|
|
match List.assoc_opt n hidden with
|
|
| None -> ()
|
|
| Some why -> fail loc "%s" why)
|
|
(uses ds)
|
|
|
|
(* Every top-level name the package declares — types and values alike, since a
|
|
use site is rewritten by name and the two never collide in one namespace. *)
|
|
let owned_names (ds : Ast.decl list) =
|
|
List.filter_map Ast.declared_name ds
|
|
|
|
(* The [link] file: extra linker arguments, one per line, blank lines and
|
|
comments ignored. *)
|
|
let link_flags dir =
|
|
let path = Filename.concat dir "link" in
|
|
if not (Sys.file_exists path) then []
|
|
else begin
|
|
let ch = open_in path in
|
|
let rec go acc =
|
|
match input_line ch with
|
|
| line ->
|
|
let line = String.trim line in
|
|
go (if line = "" || line.[0] = '#' then acc else line :: acc)
|
|
| exception End_of_file -> List.rev acc
|
|
in
|
|
let r = go [] in
|
|
close_in ch; r
|
|
end
|
|
|
|
(* The [headers] file: C headers to read signatures out of, one per line, a
|
|
path followed by any clang flags that header needs. Blank lines and
|
|
comments ignored, [${NAME}] expanded from the environment, and a relative
|
|
path taken against the package's own directory.
|
|
|
|
A sidecar rather than a new form, for the same reason [link] is one. The
|
|
thing being named is a property of the *package* and not of any one
|
|
declaration in it, the importing program should not have to know the header
|
|
exists — [(import rl "vendor:raylib")] is unchanged at every call site — and
|
|
a package whose headers move is edited in one place. It also means the
|
|
reader, the parser and the AST are untouched: what comes back is ordinary
|
|
[declare-c] declarations, which is the only thing downstream understands. *)
|
|
let expand_env ~loc ~what line =
|
|
let b = Buffer.create (String.length line) in
|
|
let n = String.length line in
|
|
let i = ref 0 in
|
|
while !i < n do
|
|
if !i + 1 < n && line.[!i] = '$' && line.[!i + 1] = '{' then
|
|
match String.index_from_opt line !i '}' with
|
|
| None -> Buffer.add_char b line.[!i]; incr i
|
|
| Some close ->
|
|
let name = String.sub line (!i + 2) (close - !i - 2) in
|
|
(match Sys.getenv_opt name with
|
|
| Some v -> Buffer.add_string b v
|
|
| None ->
|
|
fail loc
|
|
"%s names ${%s} and %s is not set in the environment" what name name);
|
|
i := close + 1
|
|
else (Buffer.add_char b line.[!i]; incr i)
|
|
done;
|
|
Buffer.contents b
|
|
|
|
let read_lines path =
|
|
if not (Sys.file_exists path) then []
|
|
else begin
|
|
let ch = open_in path in
|
|
let rec go acc =
|
|
match input_line ch with
|
|
| line ->
|
|
let line = String.trim line in
|
|
go (if line = "" || line.[0] = '#' then acc else line :: acc)
|
|
| exception End_of_file -> List.rev acc
|
|
in
|
|
let r = go [] in
|
|
close_in ch; r
|
|
end
|
|
|
|
(* Split on whitespace: the first word is the header, the rest are clang's. *)
|
|
let words line =
|
|
String.split_on_char ' ' line
|
|
|> List.concat_map (String.split_on_char '\t')
|
|
|> List.filter (fun w -> w <> "")
|
|
|
|
(* A line may begin with [?], meaning "read this header if it is there and say
|
|
nothing if it is not".
|
|
|
|
That marker is what lets a package offer the check without requiring it.
|
|
[vendor/raylib] builds today against a shared library alone — docs/BUILT.md's "no
|
|
raylib headers are needed", which is a real property: a build needs
|
|
libraylib linkable and not raylib-devel installed. A required header would
|
|
take that away from everyone in order to give the check to the people who
|
|
have one. Optional, the default build is exactly what it was, and a
|
|
developer with the matching header exports one variable and gets every
|
|
signature checked against it. It is the same shape as [${FLAN_RAYLIB_WEB}]
|
|
in [link], and for the same reason.
|
|
|
|
An unset [${NAME}] on an optional line skips it rather than failing, since
|
|
"not set" is precisely how the line is turned off. On a required line it is
|
|
still an error that names the variable. *)
|
|
let header_specs ~loc dir =
|
|
let path = Filename.concat dir "headers" in
|
|
List.filter_map
|
|
(fun line ->
|
|
let optional = String.length line > 0 && line.[0] = '?' in
|
|
let line =
|
|
if optional then String.trim (String.sub line 1 (String.length line - 1))
|
|
else line
|
|
in
|
|
match
|
|
if optional then
|
|
match expand_env ~loc ~what:path line with
|
|
| v -> Some v
|
|
| exception Loc.Error _ -> None
|
|
else Some (expand_env ~loc ~what:path line)
|
|
with
|
|
| None -> None
|
|
| Some expanded ->
|
|
(match words expanded with
|
|
| [] -> None
|
|
| h :: flags ->
|
|
let h =
|
|
if Filename.is_relative h then Filename.concat dir h else h
|
|
in
|
|
(* An optional line that expanded to nothing at all is the
|
|
line being switched off, which is the whole point of the
|
|
marker. An optional line that expanded to a *path* is somebody
|
|
opting in, and a path that is not there is their typo — told
|
|
about by name, rather than silently behaving as though they had
|
|
not opted in at all. Those two are the difference between an
|
|
opt-in and a trap. *)
|
|
if optional && String.trim expanded = "" then None
|
|
else if not (Sys.file_exists h) then
|
|
fail loc
|
|
"%s names the header %s, and there is no such file" path h
|
|
else Some (h, flags)))
|
|
(read_lines path)
|
|
|
|
(* The binding config, beside [headers] and read for the same package: which
|
|
functions not to generate, and what to call the ones whose kebab name is
|
|
not wanted. Absent is the ordinary case and means neither.
|
|
|
|
It is read here rather than by the importer because it is a property of the
|
|
*package*, like [headers] and [link] — the importer is given a header and a
|
|
config and has no directory to look in. See [Cimport.read_config] for why a
|
|
config exists at all once the generated declarations are committed. *)
|
|
let binding_config dir = Cimport.read_config (Filename.concat dir "bindings")
|
|
|
|
let real dir = try Unix.realpath dir with Unix.Unix_error _ -> dir
|
|
|
|
(* One package, and whatever it imports.
|
|
|
|
A package may import a package. The qualification flattens to the *inner*
|
|
alias: if sand/ imports vendor:raylib as [rl], the names are [rl/...] in the
|
|
finished program and not [sand/rl/...]. That is forced rather than chosen —
|
|
a directory imported along two routes has to arrive with one set of names,
|
|
or the checker sees every declaration twice — and it is what makes the
|
|
dedupe below coherent.
|
|
|
|
[seen] is that dedupe, keyed by the real path, so raylib imported by the
|
|
program and again by a package it imports is loaded once.
|
|
|
|
[open_] is the separate question, and the two must not be confused. It is
|
|
the chain currently being read — the packages entered and not yet finished —
|
|
innermost last. A directory already in [seen] but not in [open_] is the
|
|
second route of a diamond and is the no-op that makes a diamond work; a
|
|
directory found in [open_] is an import that has come back round to a
|
|
package still waiting on it, which is a cycle.
|
|
|
|
Cycles are refused rather than tolerated. An earlier version let [seen]
|
|
swallow them — a directory is entered before it is read, so the second
|
|
arrival contributed nothing and mutually dependent packages appeared to
|
|
work — but "appeared to work" is the problem. Acyclic imports are the thing
|
|
that makes a package order definite, and a definite order is what the macro
|
|
expander needs, since every [defmacro] has to be compiled before anything
|
|
that calls it. A ring has no such order, so it is named and refused here
|
|
rather than resolved arbitrarily by whichever package happened to be read
|
|
first. Odin forbids cycles for the same reason.
|
|
|
|
That order is now being spent rather than merely promised. A package's
|
|
[defmacro] used to be refused by name, on the argument that collecting one
|
|
would need the package's own imports resolved at the Form level before this
|
|
function ran — a second import resolver, and two resolvers can disagree.
|
|
What the refusal did not notice is that the *file being compiled* is parsed
|
|
before this function runs too, so the ordering problem was never specific to
|
|
packages: no shape of this feature can leave import resolution where it was.
|
|
|
|
So it moved, and only the reading of an import form moved with it.
|
|
[imports_of] reads the shape; this function still does every bit of the
|
|
resolving, in the order it already had. Each package's nested imports are
|
|
resolved *before* its own files are parsed, their macros are ambient in
|
|
[Parse.imported_macros] while that parse runs, and the package's own macros
|
|
come back out qualified at the end, where [owned] is complete — after
|
|
[Cimport] has generated the header's declarations, so a macro quasiquoting
|
|
[(BeginDrawing)] names [rl/BeginDrawing] like everything else. *)
|
|
let rec import ~seen ~open_ ~loc alias dir =
|
|
let dir' = real dir in
|
|
(* Checked before [seen], because a cycle's second arrival is also a repeat
|
|
visit and [seen] would otherwise call it a diamond and say nothing. *)
|
|
(match List.find_index (fun (d, _) -> String.equal d dir') open_ with
|
|
| Some i ->
|
|
(* The ring itself, and only the ring: the chain from the entry that is
|
|
being re-entered onwards, closed by naming it again. Anything before
|
|
that entry is the route *to* the cycle and not part of it. *)
|
|
let ring = List.filteri (fun j _ -> j >= i) open_ in
|
|
let names =
|
|
List.map (fun (_, a) -> a) ring @ [ alias ]
|
|
in
|
|
fail loc
|
|
"%s imports itself round a ring: %s. Imports have to be acyclic — a \
|
|
definite package order is what lets a package be compiled before the \
|
|
ones that use it — so one of these imports has to go"
|
|
(snd (List.nth open_ i)) (String.concat " -> " names)
|
|
| None -> ());
|
|
match Hashtbl.find_opt seen dir' with
|
|
| Some (previous, macros) when String.equal previous alias ->
|
|
(* Already in, under the same name, and not still open. Importing it again
|
|
is a no-op, which is what lets two packages both depend on a third.
|
|
|
|
A no-op for declarations only. The macros are handed back every time,
|
|
because they are not a contribution to the finished program — they are
|
|
what a *parse* needs in front of it, and the second importer's parse has
|
|
not happened yet. [macro_union] dedupes them where they land. *)
|
|
{ decls = []; csrcs = []; lflags = []; pkgs = []; macros }
|
|
| Some (previous, _) ->
|
|
fail loc
|
|
"%s is imported as %s here and as %s elsewhere; one directory is one set \
|
|
of names, so the two cannot both be true" dir alias previous
|
|
| None ->
|
|
Hashtbl.replace seen dir' (alias, []);
|
|
let open_ = open_ @ [ (dir', alias) ] in
|
|
let one_file = is_package_file dir in
|
|
let files = if one_file then [ dir ] else entries dir ".flan" in
|
|
if files = [] then fail loc "the package at %s has no .flan file" dir;
|
|
(* Read once. The forms are wanted twice — for the imports below and for
|
|
the macros at the end — and reading a file twice is the kind of second
|
|
opinion this module spends its comments warning about. *)
|
|
let sources = List.map (fun f -> (f, Reader.read_file f)) files in
|
|
(* What this package imports, resolved first and relative to itself. Its
|
|
declarations come back already qualified under their own aliases, so the
|
|
rename below leaves them alone: they are not in [owned].
|
|
|
|
Read out of the forms rather than out of the parse, because the parse is
|
|
what needs the answer: a package's own file may call a macro of a
|
|
package it imports, and that macro has to be collected before the file
|
|
naming it is parsed. *)
|
|
let nested =
|
|
List.concat_map
|
|
(fun (_, forms) ->
|
|
List.map
|
|
(fun (a, path, dloc) ->
|
|
(* Relative to the package itself: for a directory that is the
|
|
directory, for a single file the one it sits in. *)
|
|
let file = if one_file then dir else Filename.concat dir "." in
|
|
let sub = resolve_dir ~file dloc path in
|
|
import ~seen ~open_ ~loc:dloc a sub)
|
|
(imports_of forms))
|
|
sources
|
|
in
|
|
let nested_macros =
|
|
List.fold_left (fun acc r -> macro_union acc r.macros) [] nested
|
|
in
|
|
(* The package's own files, parsed with what it imported in front of them
|
|
and nothing else. A parent's macros are deliberately not here: this
|
|
package did not import that parent, and a name it never asked for is not
|
|
one it should be able to call. *)
|
|
let ds =
|
|
Parse.with_imported nested_macros
|
|
(fun () -> List.concat_map (fun (_, forms) -> Parse.program forms) sources)
|
|
in
|
|
(* [main] is the importer's, always. A package that called its own would
|
|
get the importer's instead — silently, since the name still resolves —
|
|
so it is refused here rather than left to mean something else. *)
|
|
refuse_hidden
|
|
[ ("main",
|
|
Printf.sprintf
|
|
"the package %s calls main, and main belongs to the program that \
|
|
imports it, not to a package" dir) ]
|
|
ds;
|
|
(* Every header the package names, read, and turned into the same
|
|
[declare-c] declarations a human would have written. Done here, before
|
|
anything below looks at what the package declares, so the generated ones
|
|
are owned and qualified exactly like the hand-written ones and nothing
|
|
downstream can tell which is which.
|
|
|
|
A single file is not a package with a directory, so it carries no
|
|
headers, for the same reason it carries no [.c] and no [link]. *)
|
|
let imported =
|
|
if one_file then []
|
|
else
|
|
List.map
|
|
(fun (h, flags) ->
|
|
let taken = Hashtbl.create 64 in
|
|
List.iter
|
|
(fun d ->
|
|
match Ast.declared_name d with
|
|
| Some n -> Hashtbl.replace taken n ()
|
|
| None -> ())
|
|
ds;
|
|
let known_structs =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Defstruct (n, _) -> Some n
|
|
| _ -> None)
|
|
ds
|
|
and enums =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Defenum (n, ms) -> Some (n, ms)
|
|
| _ -> None)
|
|
ds
|
|
and pconsts =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Defconst (n, _, e) -> Some (n, e)
|
|
| _ -> None)
|
|
ds
|
|
(* A C symbol the package already binds by hand is left alone:
|
|
the hand-written line wins, and [Shim] would refuse the
|
|
program outright if one symbol arrived under two Flan names.
|
|
That is what keeps [declare-c] the escape hatch — a signature
|
|
the importer gets wrong, or a nicer face than the header can
|
|
describe, is fixed by writing the line. *)
|
|
and bound_syms =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Declare (_, sym) | Ast.DeclareC (_, sym) -> Some sym
|
|
| _ -> None)
|
|
ds
|
|
in
|
|
let config = binding_config dir in
|
|
let r, dump, env =
|
|
Cimport.header ~loc ~header:h ~flags ~known_structs
|
|
~known_enums:(List.map fst enums) ~taken ~bound_syms ~config
|
|
in
|
|
(* The point of reading the header, and the reason it is not
|
|
enough to generate declarations out of it.
|
|
|
|
Everything the generator produces agrees with itself by
|
|
construction — the typedef and the Flan struct come from one
|
|
[defstruct], the prototype and the wrapper from one
|
|
declaration — so the only thing that can disagree is the
|
|
*library*, and until a header was read nothing here had a
|
|
second opinion to disagree with. Now it does, so it says so.
|
|
|
|
Build-stopping, not a note. The package named this header, so
|
|
the header is the package's own claim about what it binds; a
|
|
[defstruct] that disagrees with it lays fields out in the
|
|
wrong order and reads as five plausible numbers rather than as
|
|
a link error, which is the failure docs/BUILT.md says only a test
|
|
can catch. Continuing past a known-wrong layout to produce a
|
|
program that will read garbage is the shape the house rule
|
|
against swallowing things exists to prevent.
|
|
|
|
A structure the header does not describe at all is not
|
|
checked and not complained about: a package may legitimately
|
|
describe something the header does not name. *)
|
|
let structs =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Defstruct (n, fs) -> Some (n, fs, d.Ast.dloc)
|
|
| _ -> None)
|
|
ds
|
|
in
|
|
List.iter
|
|
(fun (n, why) ->
|
|
let at =
|
|
List.find_map
|
|
(fun (m, _, l) -> if String.equal m n then Some l else None)
|
|
structs
|
|
in
|
|
fail (Option.value ~default:loc at)
|
|
"the defstruct %s disagrees with %s: %s" n h why)
|
|
(Cimport.check_structs ~env
|
|
~structs:(List.map (fun (n, fs, _) -> (n, fs)) structs) dump);
|
|
(* And the hand-written bindings, against the header's own
|
|
signatures. These are the lines the importer deliberately
|
|
leaves alone, which is exactly why they are the ones nothing
|
|
else can check: a wrong declare-c is wrong in the generated
|
|
prototype too, so the two halves agree with each other and
|
|
only the library knows better. *)
|
|
let bound =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.DeclareC (fn, sym) -> Some (fn, sym)
|
|
| _ -> None)
|
|
ds
|
|
in
|
|
List.iter
|
|
(fun (x : Cimport.sig_diff) ->
|
|
let at =
|
|
List.find_map
|
|
(fun ((fn : Ast.fn), sym) ->
|
|
if String.equal sym x.Cimport.dsym then Some fn.Ast.nloc
|
|
else None)
|
|
bound
|
|
in
|
|
fail (Option.value ~default:loc at)
|
|
"the declare-c of %s disagrees with %s: %s"
|
|
x.Cimport.dflan h x.Cimport.dwhy)
|
|
(Cimport.diff_bound ~env ~bound dump);
|
|
(* And the constants, which nothing read until now. A wrong flag
|
|
bit and a wrong enum member are the two errors in this file
|
|
that are completely silent — no link error, no type error,
|
|
just a window that does not open or a key that never fires —
|
|
and they are the class the header read exists to catch. The
|
|
mapping from a Flan name to a C one is declared in `bindings`
|
|
rather than guessed; see [Cimport.check_constants]. *)
|
|
let cloc n =
|
|
(* A member reads [Key/left-shift]; the declaration that can be
|
|
pointed at is the defenum, so the name is cut at the slash. *)
|
|
let n =
|
|
match String.index_opt n '/' with
|
|
| Some i -> String.sub n 0 i
|
|
| None -> n
|
|
in
|
|
List.find_map
|
|
(fun (d : Ast.decl) ->
|
|
match Ast.declared_name d with
|
|
| Some m when String.equal m n -> Some d.Ast.dloc
|
|
| _ -> None)
|
|
ds
|
|
in
|
|
List.iter
|
|
(fun (x : Cimport.const_diff) ->
|
|
(* Both kinds stop a build, and they are worded differently
|
|
because they are different accusations.
|
|
|
|
[cmapping = false] is the library contradicting the
|
|
package: a value that is one number here and another
|
|
there. [cmapping = true] is the package's own `bindings`
|
|
file not covering something — a [defenum] nobody mapped,
|
|
a rule that reaches nothing.
|
|
|
|
The second was gated to `flan generate-c` at first, on the
|
|
argument that stopping a build over a config file is the
|
|
wrong stop. The objection was really to the *wording*: it
|
|
arrived wrapped in "the package disagrees with the
|
|
header", which describes a layout bug and sends the reader
|
|
to the wrong file. Gating it instead meant an unchecked
|
|
enum member — exactly the silent wrongness the header read
|
|
exists to catch — went unreported on every ordinary build,
|
|
and "remember to run generate-c" is the same shape as
|
|
"remember to check the header by eye", which is what this
|
|
replaced. So: still fatal, and the wording names the file
|
|
and both ways out. *)
|
|
let at = Option.value ~default:loc (cloc x.Cimport.cname) in
|
|
if x.Cimport.cmapping then
|
|
fail at "%s" x.Cimport.cwhy
|
|
else
|
|
fail at "the package disagrees with %s: %s" h
|
|
x.Cimport.cwhy)
|
|
(Cimport.check_constants ~config ~enums ~consts:pconsts dump);
|
|
r)
|
|
(header_specs ~loc dir)
|
|
in
|
|
let ds = ds @ List.concat_map (fun r -> r.Cimport.decls) imported in
|
|
let own =
|
|
List.filter (fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Import _ -> false
|
|
| _ -> (match Ast.declared_name d with
|
|
| Some n -> exported n
|
|
| None -> true))
|
|
ds
|
|
in
|
|
let owned = List.filter exported (owned_names ds) in
|
|
let decls = List.map (qualify_decl owned alias) own in
|
|
let lflags = if one_file then [] else link_flags dir in
|
|
let csrcs = if one_file then [] else entries dir ".c" in
|
|
let phidden =
|
|
List.concat_map
|
|
(fun r ->
|
|
List.map
|
|
(fun (n, why) -> (qualify alias n, qualify alias n ^ ": " ^ why))
|
|
r.Cimport.hidden)
|
|
imported
|
|
(* [alias/main] is not a name, and it is recorded here rather than
|
|
recomputed later. [hidden_of] used to answer this by re-parsing the
|
|
package's files, which was affordable while a package could not hold a
|
|
macro; now that it can, that second parse would run with nothing
|
|
ambient and fail on every package whose own functions call its own
|
|
macros. The fact is known right here, so it is carried. *)
|
|
@ (if List.exists (fun d -> Ast.declared_name d = Some "main") ds then
|
|
[ (qualify alias "main",
|
|
Printf.sprintf
|
|
"%s is not a name: %s declares a main, and a main is an entry \
|
|
point rather than something a package offers"
|
|
(qualify alias "main") dir) ]
|
|
else [])
|
|
in
|
|
(* The package's macros, as an importer has to see them, built here because
|
|
here is where [owned] is both complete and still beside the forms the
|
|
author wrote. Its imports' macros travel on with them: a nested
|
|
package's names are flattened into the finished program under their own
|
|
alias, so [q/foo] is callable from the program that imported [p], and a
|
|
macro is no different. *)
|
|
let mine =
|
|
List.concat_map
|
|
(fun (_, forms) -> List.filter_map (qualify_macro owned alias) forms)
|
|
sources
|
|
in
|
|
let macros = macro_union nested_macros mine in
|
|
Hashtbl.replace seen dir' (alias, macros);
|
|
let here =
|
|
{ decls; csrcs; lflags; macros;
|
|
pkgs = [ { alias; dir; owns = owned; pcsrcs = csrcs; plflags = lflags;
|
|
phidden } ] }
|
|
in
|
|
(* Dependencies first. [pkgs] comes back in topological order — a package
|
|
appears after everything it imports — which is what the acyclic rule
|
|
above is worth: the recursion has already finished every nested import
|
|
before this line runs, so concatenating them ahead of [here] is the
|
|
topological sort, and the dedupe in [seen] keeps each package at its
|
|
first, deepest position.
|
|
|
|
Only [pkgs] is ordered. The declaration list is deliberately not, and
|
|
does not need to be: [check.ml] collects every top-level name in one
|
|
pass before it checks any body, so top-level names are order-independent
|
|
by construction and a package may be declared after the one that uses
|
|
it. What will need the order is the macro expander, which cannot work
|
|
that way — a [defmacro] has to be compiled before the call it expands —
|
|
and it is [macros] that reads it. *)
|
|
List.fold_left
|
|
(fun acc p ->
|
|
{ decls = acc.decls @ p.decls;
|
|
csrcs = acc.csrcs @ p.csrcs;
|
|
lflags = acc.lflags @ p.lflags;
|
|
pkgs = acc.pkgs @ p.pkgs;
|
|
macros = macro_union acc.macros p.macros })
|
|
empty
|
|
(nested @ [ here ])
|
|
|
|
(* What an import did *not* bring: the names an importer might reasonably write
|
|
and that are not there, each with the reason it is not. Every entry is
|
|
recorded by [import] as it goes; there is no second look at the package. *)
|
|
let hidden_of (t : t) = List.concat_map (fun (p : pkg) -> p.phidden) t.pkgs
|
|
|
|
(* ── The one entry point ───────────────────────────────────────────── *)
|
|
|
|
(* Forms in rather than declarations, and that is the whole of the phase
|
|
change. The order is still [Reader] -> [Parse] -> [Load] -> [Check]; what
|
|
moved is who calls [Parse], because the file's own parse is the one that
|
|
needs a package's macros and it used to happen before this function was
|
|
reached. Nothing runs out of order: the imports are read, resolved, and only
|
|
then is the file parsed with their macros in front of it.
|
|
|
|
[parse] is a parameter because there are two of them and the difference
|
|
matters to the daemon — [Parse.program] stops at the first bad declaration
|
|
and raises [Loc.Error], [Parse.program_all] reports every one and raises
|
|
[Loc.Errors]. See the note above them.
|
|
|
|
[Parse.imported_macros] is extended rather than replaced, and restored on
|
|
the way out. Extended because [Session.eval] has already set the session's
|
|
own set when it calls this, and an evaluation may add an import without
|
|
losing what the file imported. Restored because a compiler process builds
|
|
more than one program and a macro left ambient is a name that works until
|
|
somebody reorders the tests.
|
|
|
|
What was just resolved comes first, because [macro_union] keeps the left on
|
|
a name collision. The ambient set is a session's, held since the session was
|
|
created; the packages were read off disk a line ago. Editing a macro in a
|
|
package and reloading the file that imports it has to expand the new body,
|
|
and the other order would expand the old one and say nothing. *)
|
|
let program ?(parse = Parse.program) ~file (forms : Form.t list) : t =
|
|
let seen = Hashtbl.create 8 in
|
|
let imported =
|
|
List.fold_left
|
|
(fun acc (alias, path, dloc) ->
|
|
let dir = resolve_dir ~file dloc path in
|
|
let p = import ~seen ~open_:[] ~loc:dloc alias dir in
|
|
{ decls = acc.decls @ p.decls;
|
|
csrcs = acc.csrcs @ p.csrcs;
|
|
lflags = acc.lflags @ p.lflags;
|
|
pkgs = acc.pkgs @ p.pkgs;
|
|
macros = macro_union acc.macros p.macros })
|
|
empty
|
|
(imports_of forms)
|
|
in
|
|
let decls =
|
|
Parse.with_imported (macro_union imported.macros !Parse.imported_macros)
|
|
(fun () -> parse forms)
|
|
in
|
|
let t =
|
|
List.fold_left
|
|
(fun acc (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
(* Resolved above, from the form it was read out of. An [Ast.Import]
|
|
here is the same import arriving a second time and contributes
|
|
nothing; dropping it is what keeps one directory to one visit. *)
|
|
| Ast.Import _ -> acc
|
|
| _ -> { acc with decls = acc.decls @ [ d ] })
|
|
imported decls
|
|
in
|
|
(* Said here rather than left to the checker: [sim/main] would otherwise be
|
|
"unknown name", which is true and unhelpful — the name is missing on
|
|
purpose and the message should say which purpose. *)
|
|
refuse_hidden (hidden_of t) t.decls;
|
|
t
|