(** 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 [settle] typed in
     sand-sim/sim.flan means [sim/settle] 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