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;
  std : string option; (* 표준 라이브러리 디렉터리 *)
  modules : (string, entry) Hashtbl.t;
  (* 통계: 무엇이 몇 번 재검사됐는지. 측정이 목적이므로 처음부터 센다. *)
  mutable checked : string list;
}

(* 표준 라이브러리를 찾는다. COOL_STD가 있으면 그것, 없으면 위로 올라가며
   std/list.cool을 찾는다. 못 찾으면 없는 것이고, 그때 std 이름들은 외부
   참조로 남는다 — 없다고 말하지 않는다. *)
let find_std root =
  match Sys.getenv_opt "COOL_STD" with
  | Some d when Sys.file_exists d -> Some d
  | _ ->
      let rec up dir n =
        if n = 0 then None
        else
          let cand = Filename.concat dir "std" in
          if Sys.file_exists (Filename.concat cand "list.cool") then Some cand
          else
            let parent = Filename.dirname dir in
            if parent = dir then None else up parent (n - 1)
      in
      up
        (if Filename.is_relative root then Filename.concat (Sys.getcwd ()) root
         else root)
        8

let create ?(root = ".") ?std () =
  {
    root;
    std = (match std with Some _ -> std | None -> find_std 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 std_prefix = "cool.dev/std/"

let starts_with p s =
  String.length s >= String.length p && String.sub s 0 (String.length p) = p

(* 경로를 파일로 바꾼다. 바꿀 수 없으면 None — v0에는 패키지 해소가 없으므로
   표준 라이브러리 밖의 패키지는 불투명하게 남는다. *)
let resolve_import st path : string option =
  if starts_with std_prefix path then
    let name =
      String.sub path (String.length std_prefix)
        (String.length path - String.length std_prefix)
    in
    match st.std with
    | Some d -> Some (Filename.concat d (name ^ ".cool"))
    | None -> None
  else if is_package path then None
  else Some (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) ->
            match resolve_import st p with
            | Some f -> Some (a, f)
            | None -> None)
          (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) ->
            match resolve_import st p with
            | Some f -> load st ~visiting:(path :: visiting) f
            | None -> ())
          (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 -> (
        (* IR은 그래프 전체를 받는다. 별칭이 실행 의미에 남지 않도록. *)
        let mods =
          Hashtbl.fold
            (fun p (d : entry) acc ->
              { Ir.m_path = p; m_ast = d.ast; m_deps = d.imports } :: acc)
            st.modules []
        in
        let prog = Ir.of_program mods in
        match Interp.run prog path (main_params e.ast) with
        | Ok out -> Ok out
        | Error (pos, msg) -> Error (err_of path pos msg))