Joseph Ferano
1fb208a991
Reading the header produced declarations and nothing else, so the gap the whole thing exists to close — that nothing verifies a declaration against the library — was closed by a command somebody could run rather than by a property the build had. Now `import` runs both comparisons whenever a header resolves. Build-stopping, not a note. The package named the header, so the header is the package's own claim about what it binds; a defstruct that disagrees lays fields out in the wrong order and reads as five plausible numbers rather than as a link error. 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. Both messages point at the line in raylib.flan, not at the header. Verified by breaking it on purpose: a permuted Texture2D stops the build naming the field that moved, and `f64` where raylib says `float` stops it naming the parameter — which is the hazard BUILT.md calls out by name and says only a test can catch. A set-but-wrong FLAN_RAYLIB_H used to be indistinguishable from not opting in: the line was skipped and nothing was said. Unset still means off and silent; a path that is not there is now an error naming it. That is the difference between an opt-in and a trap. test/headers/sample.h is one function per decision the importer makes. The raylib case needs raylib installed, at the right version, with a variable set, so it would skip everywhere and cover nothing; this one does not move. It also found a bug, fixed next. Reach still prunes with 256 extra declarations in play: a wasm32-wasi build of a program that imports raylib and calls none of it links without libraylib, which is the case Reach.link exists for.
845 lines
37 KiB
OCaml
845 lines
37 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;
|
|
}
|
|
|
|
(* [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 fail loc fmt = Printf.ksprintf (fun m -> raise (Loc.Error (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 (c, body) -> Ast.While (go c, gos body)
|
|
| 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.Fn (ps, body) ->
|
|
Ast.Fn (ps, List.map (rename_expr owned alias (ps @ bound)) body)
|
|
| Ast.Dotimes (i, n, body) ->
|
|
Ast.Dotimes (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 }
|
|
|
|
(* ── 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.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.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 — 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)
|
|
|
|
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. It is also what
|
|
terminates a cycle, and there is nothing else to do about one: a directory
|
|
is entered before it is read, so a package that imports itself — directly or
|
|
round a ring — meets its own entry and contributes nothing the second time.
|
|
The namespace is flat, so mutually dependent packages then simply work. *)
|
|
let rec import ~seen ~loc alias dir =
|
|
let dir' = real dir in
|
|
match Hashtbl.find_opt seen dir' with
|
|
| Some previous when String.equal previous alias ->
|
|
(* Already in, under the same name. Importing it again is a no-op, which
|
|
is what lets two packages both depend on a third. *)
|
|
{ decls = []; csrcs = []; lflags = []; pkgs = [] }
|
|
| 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 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;
|
|
let ds =
|
|
List.concat_map (fun f -> Parse.program (Reader.read_file f)) files
|
|
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;
|
|
(* 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]. *)
|
|
let nested =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Import (a, path) ->
|
|
(* 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 d.Ast.dloc path in
|
|
Some (import ~seen ~loc:d.Ast.dloc a sub)
|
|
| _ -> None)
|
|
ds
|
|
in
|
|
(* 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 known_enums =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Defenum (n, _) -> Some n
|
|
| _ -> 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 r, dump, env =
|
|
Cimport.header ~loc ~header:h ~flags ~known_structs ~known_enums
|
|
~taken ~bound_syms
|
|
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 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);
|
|
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
|
|
in
|
|
let here =
|
|
{ decls; csrcs; lflags;
|
|
pkgs = [ { alias; dir; owns = owned; pcsrcs = csrcs; plflags = lflags;
|
|
phidden } ] }
|
|
in
|
|
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 })
|
|
here nested
|
|
|
|
(* 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. *)
|
|
let hidden_of (t : t) =
|
|
List.concat_map (fun (p : pkg) -> p.phidden) t.pkgs
|
|
@ List.filter_map
|
|
(fun (p : pkg) ->
|
|
let ds =
|
|
List.concat_map (fun f -> Parse.program (Reader.read_file f))
|
|
(if is_package_file p.dir then [ p.dir ] else entries p.dir ".flan")
|
|
in
|
|
if List.exists (fun d -> Ast.declared_name d = Some "main") ds then
|
|
Some (qualify p.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 p.alias "main") p.dir)
|
|
else None)
|
|
t.pkgs
|
|
|
|
(* ── The one entry point ───────────────────────────────────────────── *)
|
|
|
|
let program ~file (decls : Ast.decl list) : t =
|
|
let seen = Hashtbl.create 8 in
|
|
let t =
|
|
List.fold_left
|
|
(fun acc (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Import (alias, path) ->
|
|
let dir = resolve_dir ~file d.Ast.dloc path in
|
|
let p = import ~seen ~loc:d.Ast.dloc alias dir in
|
|
{ decls = acc.decls @ p.decls;
|
|
csrcs = acc.csrcs @ p.csrcs;
|
|
lflags = acc.lflags @ p.lflags;
|
|
pkgs = acc.pkgs @ p.pkgs }
|
|
| _ -> { acc with decls = acc.decls @ [ d ] })
|
|
{ decls = []; csrcs = []; lflags = []; pkgs = [] }
|
|
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
|