1224 lines
57 KiB
OCaml
1224 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.Defunion (n, _) ->
|
|
fail loc "%s is a union, and an imported union 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 union 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.Defunion (_, 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
|