(* interface artifact와 그 해시.

   hash 입력 = 모듈 exported surface 전체의 의미적 정규형이다 (문서 P7).
   함수 시그니처(effect 포함), 타입 정의 본문(struct 필드, enum variant),
   타입의 affinity, 상수의 타입과 값, capability 선언, 그리고 reexport된
   선언을 완전히 해소한 정의 본문.

   원칙: downstream 검사 결과에 영향을 줄 수 있는 모든 것을 포함한다.
   의심스러우면 넣는다 — 과잉 포함의 비용은 재검사지만 누락의 비용은
   잘못된 캐시라는 비대칭이 있다.

   함수 본문은 들어가지 않는다. 본문 한 줄 수정이 해시를 흔들면 incremental
   전제가 무너진다. *)

open Ast

type t = { items : item list; (* 본문을 벗긴 exported surface *) hash : string }

let strip_body (d : fn_decl) = { d with fn_body = None }

let is_exported = function
  | I_fn { pub; _ } -> pub
  | I_struct { pub; _ } -> pub
  | I_enum { pub; _ } -> pub
  | I_capability { pub; _ } -> pub
  | I_const { pub; _ } -> pub
  | I_reexport _ -> true
  (* 테스트는 표면이 아니다. 테스트를 고쳤다고 downstream이 재검사되면
     안 된다 — 함수 본문과 같은 이유다 *)
  | I_test _ -> false
  | I_import _ -> false

let strip = function
  | I_fn { pub; decl } -> I_fn { pub; decl = strip_body decl }
  | it -> it

let item_name = function
  | I_fn { decl; _ } -> decl.fn_name
  | I_struct { name; _ } -> name
  | I_enum { name; _ } -> name
  | I_capability { name; _ } -> name
  | I_const { name; _ } -> name
  | I_reexport { name; _ } -> name
  | I_test { name; _ } -> name
  | I_import { alias; _ } -> alias

(* reexport는 이름이 아니라 해소된 정의 본문이 hash에 들어간다.
   A의 enum에 variant가 추가되면 B의 소스가 그대로여도 B의 hash가 변하고,
   C의 exhaustive match가 재검사된다. *)
let surface (m : modul) : item list =
  let is_definition = function
    | I_reexport _ | I_import _ -> false
    | _ -> true
  in
  let find name =
    List.find_opt (fun it -> is_definition it && item_name it = name) m.items
  in
  List.concat_map
    (fun it ->
      match it with
      | I_reexport { name; _ } -> (
          match find name with Some d -> [ strip d ] | None -> [])
      | it when is_exported it && is_definition it -> [ strip it ]
      | _ -> [])
    m.items

(* 정규형: 항목을 이름순으로 정렬해 선언 순서가 해시에 새지 않게 한다.
   소스에서 함수 둘의 위치를 바꾸는 것은 downstream에 아무 영향이 없다. *)
let render (items : item list) : string =
  items |> List.map show_item |> List.sort compare |> String.concat "\n"

let of_module (m : modul) : t =
  let items = surface m in
  { items; hash = Digest.to_hex (Digest.string (render items)) }

(* ------------------------------------------------------------------ *)
(* 소비 측 한정                                                        *)
(* ------------------------------------------------------------------ *)

(* 가져온 모듈의 exported surface를 소비 측 이름 공간으로 옮긴다.
   `import "shapes" as Shapes`라면 Shape는 "Shapes.Shape"가 된다.

   왜 소비 시점인가 — 별칭은 가져오는 쪽의 선택이므로 정의한 모듈의
   interface hash에 새어서는 안 된다. of_module은 한정하지 않은 표면을
   해시하고, 한정은 여기서만 한다.

   v0의 한계 두 가지, 의도적으로 남긴다:
   - 가져온 모듈이 다시 다른 모듈의 타입을 참조하면(전이 참조) 불투명해진다.
   - effect atom의 capability 이름은 한정하지 않는다. 즉 effect 이름은 v0에서
     전역이다. 모듈별 identity는 v1 과제다. *)

let builtin_ty_names =
  [ "Int"; "Bool"; "String"; "Unit"; "List"; "Option"; "Result"; "TaskScope" ]

let opaque pos = T_named { modl = None; name = "«외부»"; args = []; pos }

let rec q_ty alias defined gen (t : ty) : ty =
  match t with
  | T_named { modl = Some _; pos; _ } -> opaque pos
  | T_named { modl = None; name; args; pos } ->
      let args = List.map (q_targ alias defined gen) args in
      if List.mem name gen || List.mem name builtin_ty_names then
        T_named { modl = None; name; args; pos }
      else if List.mem name defined then
        T_named { modl = None; name = alias ^ "." ^ name; args; pos }
      else opaque pos
  | T_fn { affine; params; eff; ret; pos } ->
      T_fn
        {
          affine;
          params =
            List.map
              (fun (p : fn_param_ty) ->
                { p with pt_ty = q_ty alias defined gen p.pt_ty })
              params;
          eff;
          ret = Option.map (q_ty alias defined gen) ret;
          pos;
        }

and q_targ alias defined gen = function
  | TA_ty t -> TA_ty (q_ty alias defined gen t)
  | TA_eff e -> TA_eff e

let q_fn alias defined (d : fn_decl) : fn_decl =
  let gen = List.map (fun g -> g.gp_name) d.fn_gen in
  {
    d with
    fn_params =
      List.map
        (fun p -> { p with p_ty = q_ty alias defined gen p.p_ty })
        d.fn_params;
    fn_ret = Option.map (q_ty alias defined gen) d.fn_ret;
    fn_body = None;
  }

let defined_names (items : item list) =
  List.filter_map
    (function
      | I_struct { name; _ } | I_enum { name; _ } | I_capability { name; _ } ->
          Some name
      | _ -> None)
    items

let qualify (alias : string) (items : item list) : item list =
  let defined = defined_names items in
  let p n = alias ^ "." ^ n in
  List.map
    (fun it ->
      match it with
      | I_fn { pub; decl } ->
          I_fn
            {
              pub;
              decl = { (q_fn alias defined decl) with fn_name = p decl.fn_name };
            }
      | I_struct { pub; copyable; name; gen; fields; pos } ->
          let g = List.map (fun x -> x.gp_name) gen in
          I_struct
            {
              pub;
              copyable;
              name = p name;
              gen;
              fields =
                List.map
                  (fun f -> { f with f_ty = q_ty alias defined g f.f_ty })
                  fields;
              pos;
            }
      | I_enum { pub; name; gen; variants; pos } ->
          let g = List.map (fun x -> x.gp_name) gen in
          I_enum
            {
              pub;
              name = p name;
              gen;
              variants =
                List.map
                  (fun v ->
                    {
                      v with
                      v_name = p v.v_name;
                      v_args = List.map (q_ty alias defined g) v.v_args;
                    })
                  variants;
              pos;
            }
      | I_capability { pub; name; methods; pos } ->
          I_capability
            {
              pub;
              name = p name;
              methods = List.map (q_fn alias defined) methods;
              pos;
            }
      | I_const { pub; name; ty; value; pos } ->
          I_const
            { pub; name = p name; ty = q_ty alias defined [] ty; value; pos }
      | it -> it)
    items