coollang/lib/session.ml

(* 모듈 로딩, interface 캐시, 그리고 고정점 invalidation.

   여기가 v0가 존재하는 이유다. 검사 자체보다 "무엇을 다시 검사해야 하는가"를
   좁게 유지하는 것이 아키텍처의 주장이고, 그 주장은 측정으로만 증명된다.

   전파는 고정점 규칙이다 (문서 P8):
     1. 변경된 모듈 자체를 재검사
     2. 재검사 전후의 interface hash를 비교
     3. 달라졌을 때만 그 모듈의 dependents를 큐에 추가
     4. 큐가 빌 때까지 반복
   순서가 중요하다. dependents를 먼저 재검사하면 "본문만 수정 시 downstream
   0건"이 성립하지 않는다 — hash 비교가 dependents 재검사보다 앞서야 한다. *)

type error = { file : string; line : int; col : int; message : string }

let string_of_error { file; line; col; message } =
  Printf.sprintf "%s:%d:%d: %s" file line col message

type entry = {
  path : string;
  ast : Ast.modul;
  imports : (string * string) list; (* 별칭 -> 해소된 경로 *)
  iface : Iface.t;
  errors : error list;
}

type t = {
  root : string;
  modules : (string, entry) Hashtbl.t;
  (* 통계: 무엇이 몇 번 재검사됐는지. 측정이 목적이므로 처음부터 센다. *)
  mutable checked : string list;
}

let create ?(root = ".") () =
  { root; modules = Hashtbl.create 16; checked = [] }

(* 패키지 경로와 지역 모듈 경로를 구분한다. 첫 세그먼트에 점이 있으면
   패키지 참조다 (cool.dev/std/list). v0에는 패키지 해소가 없으므로 그런
   import는 불투명하게 남는다 — 없다고 말하지 않는다. *)
let is_package path =
  match String.index_opt path '/' with
  | Some i -> String.contains (String.sub path 0 i) '.'
  | None -> String.contains path '.'

let resolve_import st path = Filename.concat st.root (path ^ ".cool")

let read_file file =
  let ic = open_in_bin file in
  let n = in_channel_length ic in
  let s = really_input_string ic n in
  close_in ic;
  s

let err_of file (pos : Token.pos) msg =
  { file; line = pos.line; col = pos.col; message = msg }

let parse_file file =
  match Lexer.lex_result (read_file file) with
  | Error e -> Error (err_of file e.pos e.msg)
  | Ok toks -> (
      match Parser.parse_result toks with
      | Error e -> Error (err_of file e.pos e.msg)
      | Ok m -> Ok m)

let imports_of (m : Ast.modul) =
  List.filter_map
    (function
      | Ast.I_import { path; alias; _ } -> Some (alias, path) | _ -> None)
    m.items

(* 한 모듈을 검사한다. 의존 모듈의 interface는 이미 로드되어 있어야 한다. *)
let check_module st path : entry =
  st.checked <- path :: st.checked;
  match parse_file path with
  | Error e ->
      {
        path;
        ast = { items = [] };
        imports = [];
        iface = { items = []; hash = "" };
        errors = [ e ];
      }
  | Ok ast ->
      let imports =
        List.filter_map
          (fun (a, p) ->
            if is_package p then None else Some (a, resolve_import st p))
          (imports_of ast)
      in
      (* 의존 모듈의 exported surface를 소비 측 별칭으로 한정해 합친다.
         여기서부터 검사기는 "이 모듈 + 아는 외부 표면"만 본다. *)
      let dep_surface =
        List.concat_map
          (fun (alias, p) ->
            match Hashtbl.find_opt st.modules p with
            | Some e -> Iface.qualify alias e.iface.Iface.items
            | None -> [])
          imports
      in
      let iface = Iface.of_module ast in
      let _, rerrors = Resolve.resolve ast in
      let errors =
        List.map (fun (e : Resolve.error) -> err_of path e.pos e.msg) rerrors
      in
      let errors =
        if errors <> [] then errors
        else
          List.map
            (fun (e : Typecheck.error) -> err_of path e.pos e.msg)
            (Typecheck.check ~imports:dep_surface ast)
          @ List.map
              (fun (e : Move.error) -> err_of path e.pos e.msg)
              (Move.check ~imports:dep_surface ast)
      in
      let errors =
        List.sort (fun a b -> compare (a.line, a.col) (b.line, b.col)) errors
      in
      { path; ast; imports; iface; errors }

(* 의존 순서대로 로드한다. 순환은 오류다. *)
let rec load st ?(visiting = []) path : unit =
  if Hashtbl.mem st.modules path then ()
  else if List.mem path visiting then ()
  else if not (Sys.file_exists path) then
    Hashtbl.replace st.modules path
      {
        path;
        ast = { items = [] };
        imports = [];
        iface = { items = []; hash = "" };
        errors =
          [ { file = path; line = 0; col = 0; message = "모듈을 찾을 수 없습니다" } ];
      }
  else begin
    (match parse_file path with
    | Error _ -> ()
    | Ok ast ->
        List.iter
          (fun (_, p) ->
            if not (is_package p) then
              load st ~visiting:(path :: visiting) (resolve_import st p))
          (imports_of ast));
    Hashtbl.replace st.modules path (check_module st path)
  end

let dependents st path =
  Hashtbl.fold
    (fun p e acc ->
      if List.exists (fun (_, d) -> d = path) e.imports then p :: acc else acc)
    st.modules []

(* 고정점 전파. 반환값은 실제로 재검사한 모듈 목록이다. *)
let recheck st (changed : string list) : string list =
  st.checked <- [];
  let queue = ref changed in
  let seen = Hashtbl.create 8 in
  while !queue <> [] do
    let path = List.hd !queue in
    queue := List.tl !queue;
    if not (Hashtbl.mem seen path) then begin
      Hashtbl.replace seen path ();
      let before =
        match Hashtbl.find_opt st.modules path with
        | Some e -> e.iface.Iface.hash
        | None -> ""
      in
      let entry = check_module st path in
      Hashtbl.replace st.modules path entry;
      (* hash 비교가 dependents 재검사보다 앞선다 *)
      if entry.iface.Iface.hash <> before then
        queue := !queue @ dependents st path
    end
  done;
  List.rev st.checked

let errors st =
  Hashtbl.fold (fun _ e acc -> e.errors @ acc) st.modules []
  |> List.sort (fun a b ->
      compare (a.file, a.line, a.col) (b.file, b.line, b.col))

let find st path = Hashtbl.find_opt st.modules path

(* ------------------------------------------------------------------ *)
(* 실행                                                                *)
(* ------------------------------------------------------------------ *)

(* main이 선언한 파라미터의 타입 이름을 뽑는다. 런타임은 이 목록만 보고
   권한을 만든다 — 선언하지 않은 capability는 프로그램에 존재하지 않는다. *)
let main_params (m : Ast.modul) =
  let rec ty_name (t : Ast.ty) =
    match t with
    | Ast.T_named { modl; name; _ } -> (
        match modl with Some a -> a ^ "." ^ name | None -> name)
    | Ast.T_fn _ -> "<fn>"
  in
  List.concat_map
    (function
      | Ast.I_fn { decl; _ } when decl.fn_name = "main" ->
          List.map
            (fun (p : Ast.param) -> (p.p_name, ty_name p.p_ty))
            decl.fn_params
      | _ -> [])
    m.items

let run st path : (string, error) result =
  load st path;
  let errs = errors st in
  if errs <> [] then Error (List.hd errs)
  else
    match find st path with
    | None ->
        Error { file = path; line = 0; col = 0; message = "모듈을 찾을 수 없습니다" }
    | Some e -> (
        let dep_surface =
          List.concat_map
            (fun (alias, p) ->
              match Hashtbl.find_opt st.modules p with
              | Some d -> Iface.qualify alias d.iface.Iface.items
              | None -> [])
            e.imports
        in
        let prog = Ir.of_module ~imports:dep_surface e.ast in
        match Interp.run prog (main_params e.ast) with
        | Ok out -> Ok out
        | Error (pos, msg) -> Error (err_of path pos msg))