937 lines
42 KiB
OCaml
937 lines
42 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 -> 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 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 }
|
|
|
|
(* ── 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.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 — 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. *)
|
|
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 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. *)
|
|
{ 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 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;
|
|
let ds =
|
|
List.concat_map
|
|
(fun f ->
|
|
let forms = Reader.read_file f in
|
|
(* A defmacro in a package is refused by name, and here is the only
|
|
place that can see one: by the time [Parse] is finished, a
|
|
defmacro is an ordinary [Ast.Defn] and the word is gone.
|
|
|
|
It is a real gap and not an oversight. The expander collects
|
|
macros from the prelude and from the file being compiled; to
|
|
collect them from a package it would have to resolve that
|
|
package's own imports first, at the Form level, before this
|
|
function -- which is a second import resolver. The refusal says
|
|
that rather than letting the call arrive at the checker as an
|
|
unknown name. *)
|
|
List.iter
|
|
(fun (form : Form.t) ->
|
|
match form.Form.v with
|
|
| Form.List ({ Form.v = Form.Sym "defmacro"; _ }
|
|
:: { Form.v = Form.Sym n; _ } :: _) ->
|
|
Loc.fail form.Form.loc
|
|
"%s is a macro, and macros are not imported yet. A \
|
|
defmacro has to be compiled before the call it expands, \
|
|
and the expander collects them from the prelude and from \
|
|
the file being compiled -- not from a package, whose own \
|
|
imports would have to be resolved first. Move it into \
|
|
the file that calls it" n
|
|
| _ -> ())
|
|
forms;
|
|
Parse.program forms)
|
|
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 ~open_ ~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 ~config:(binding_config dir)
|
|
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
|
|
(* 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 will read [pkgs]. *)
|
|
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 })
|
|
{ decls = []; csrcs = []; lflags = []; pkgs = [] }
|
|
(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. *)
|
|
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 ~open_:[] ~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
|