Joseph Ferano
f78c935b95
NEXT.md described a packaging system with no visibility, no nesting and a link that ignored the program, and explained sand's two files by it. All four are now wrong. The Packages section says what the rules are; a new section says how the link is decided and why the pruning has to take the functions as well as the flags; and the sand section keeps the part that still stands — the headless test needs no window on any target, which is a reason for two entry points and never was a reason for two files. The comments in load.ml and session.ml that used sim.flan to explain package qualification now use vendor/agent, which is the package left with a defn in it.
564 lines
24 KiB
OCaml
564 lines
24 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 }
|
|
|
|
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. Only
|
|
the bodies are rewritten. *)
|
|
| Ast.RestartCase (body, clauses) ->
|
|
Ast.RestartCase
|
|
(go body,
|
|
List.map
|
|
(fun (c : Ast.rclause) -> { c with Ast.rbody = gos c.Ast.rbody })
|
|
clauses)
|
|
| Ast.InvokeRestart _ -> e.Ast.e
|
|
(* 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)
|
|
| 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 _
|
|
| Ast.InvokeRestart _ -> ()
|
|
| 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) -> 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
|
|
| Ast.Declare (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
|
|
|
|
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
|
|
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 here =
|
|
{ decls; csrcs; lflags;
|
|
pkgs = [ { alias; dir; owns = owned; pcsrcs = csrcs; plflags = lflags } ] }
|
|
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.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
|