280 lines
12 KiB
OCaml
280 lines
12 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.
|
|
|
|
That is not a module system yet. There is no visibility, no cycle
|
|
detection, and a package cannot import another one — milestone 4 needs one
|
|
package, imported once, and the rest can wait for a use that exercises it.
|
|
|
|
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 *)
|
|
}
|
|
|
|
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
|
|
|
|
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
|
|
match split_path path with
|
|
| None, rel ->
|
|
let d = Filename.concat here rel in
|
|
if Sys.file_exists d && Sys.is_directory d then d
|
|
else fail loc "no package directory at %s" 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 Sys.file_exists d && Sys.is_directory 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)
|
|
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.Pkey (m, k) -> Ast.Pkey (go m, go k)
|
|
| 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
|
|
| Ast.Import _ ->
|
|
fail loc "an imported package may not import another one yet (milestone 4)"
|
|
| 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 }
|
|
|
|
(* 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
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Defenum (n, _) | Ast.Defalias (n, _) | Ast.Defstruct (n, _)
|
|
| Ast.Defunion (n, _) | Ast.Defvar (n, _, _) | Ast.Defconst (n, _, _) ->
|
|
Some n
|
|
| Ast.Declare (fn, _) | Ast.Defn fn -> Some fn.Ast.name
|
|
| Ast.Package _ | Ast.Import _ -> None)
|
|
ds
|
|
|
|
let import ~loc alias dir =
|
|
let files = 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
|
|
let owned = owned_names ds in
|
|
let decls = List.map (qualify_decl owned alias) ds in
|
|
let lflags =
|
|
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
|
|
in
|
|
{ decls; csrcs = entries dir ".c"; lflags }
|
|
|
|
(* ── The one entry point ───────────────────────────────────────────── *)
|
|
|
|
let program ~file (decls : Ast.decl list) : 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 ~loc:d.Ast.dloc alias dir in
|
|
{ decls = acc.decls @ p.decls;
|
|
csrcs = acc.csrcs @ p.csrcs;
|
|
lflags = acc.lflags @ p.lflags }
|
|
| _ -> { acc with decls = acc.decls @ [ d ] })
|
|
{ decls = []; csrcs = []; lflags = [] }
|
|
decls
|