coollang/lib/resolve.ml

(* 이름 해소.
   이 단계가 답하는 질문은 하나다 — 이 모듈 하나만 보고 무엇을 결정할 수 있는가.

   결정할 수 있는 것(= 오류로 보고): 중복 정의, 중복 파라미터, 선언되지 않은
   effect 변수, 같은 블록의 재바인딩, 불변 바인딩에 대한 대입, 모듈에 없는
   reexport 대상, 지역 바인딩이 아닌 scope 이름, variant 인자 개수.

   결정할 수 없는 것(= 외부 참조로 기록): 다른 모듈에서 오는 이름. 모듈 로딩이
   아직 없으므로 오류가 아니다. 이 목록이 곧 모듈의 의존 표면이고,
   interface hash가 소비할 입력이다. *)

open Ast

type error = { pos : Token.pos; msg : string }
type info = { externals : (string * Token.pos) list }
type item_kind = K_fn | K_type | K_const | K_import

type state = {
  items : (string, item_kind) Hashtbl.t;
  ctors : (string, string * int) Hashtbl.t; (* variant -> (enum, 인자 개수) *)
  mutable ty_params : string list;
  mutable eff_params : string list;
  mutable scopes : (string * bool) list list; (* 이름 -> 가변 여부 *)
  mutable errors : error list;
  mutable ext : (string * Token.pos) list;
}

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

let builtin_values = [ "unit"; "Ok"; "Err"; "Some"; "None" ]
let error st pos msg = st.errors <- { pos; msg } :: st.errors

let external_ref st name pos =
  if not (List.mem_assoc name st.ext) then st.ext <- (name, pos) :: st.ext

let push st = st.scopes <- [] :: st.scopes
let pop st = match st.scopes with _ :: r -> st.scopes <- r | [] -> ()

let lookup_local st name =
  let rec go = function
    | [] -> None
    | scope :: rest -> (
        match List.assoc_opt name scope with
        | Some m -> Some m
        | None -> go rest)
  in
  go st.scopes

let bind st pos name mut_ =
  (match st.scopes with
  | scope :: _ when List.mem_assoc name scope ->
      error st pos (Printf.sprintf "같은 블록에서 %s을(를) 다시 묶을 수 없습니다" name)
  | _ -> ());
  match st.scopes with
  | scope :: rest -> st.scopes <- ((name, mut_) :: scope) :: rest
  | [] -> st.scopes <- [ [ (name, mut_) ] ]

(* ------------------------------------------------------------------ *)
(* effect와 타입                                                        *)
(* ------------------------------------------------------------------ *)

let resolve_eff_atom st = function
  | Eff_var v, pos ->
      if not (List.mem v st.eff_params) then
        error st pos
          (Printf.sprintf "선언되지 않은 effect 변수 %s (시그니처에 [%s: effects]로 선언해야 합니다)"
             v v)
  | Eff_set names, pos ->
      List.iter
        (fun { cap; _ } ->
          if
            (not (List.mem cap builtin_types))
            && (not (List.mem cap st.ty_params))
            && Hashtbl.find_opt st.items cap <> Some K_type
          then external_ref st cap pos)
        names

let rec resolve_ty st = function
  | T_named { name; args; pos } ->
      if
        (not (List.mem name st.ty_params))
        && (not (List.mem name builtin_types))
        &&
        match Hashtbl.find_opt st.items name with
        | Some K_type | Some K_import -> false
        | _ -> true
      then external_ref st name pos;
      List.iter (resolve_targ st pos) args
  | T_fn { params; eff; ret; pos; _ } ->
      List.iter (resolve_ty st) params;
      (match eff with None -> () | Some a -> resolve_eff_atom st (a, pos));
      Option.iter (resolve_ty st) ret

and resolve_targ st pos = function
  | TA_ty t -> resolve_ty st t
  | TA_eff a -> resolve_eff_atom st (a, pos)

let resolve_eff_result st pos atoms =
  List.iter (fun a -> resolve_eff_atom st (a, pos)) atoms

(* ------------------------------------------------------------------ *)
(* 패턴                                                                *)
(* ------------------------------------------------------------------ *)

let rec resolve_pattern st seen = function
  | P_wild _ | P_lit _ -> ()
  | P_bind (n, pos) -> (
      (* 알려진 variant면 인자 없는 생성자다. 아니면 바인딩이다.
         이 판정이 이름 해소의 일이다 — 구문만으로는 갈리지 않는다. *)
      match Hashtbl.find_opt st.ctors n with
      | Some (_, 0) -> ()
      | Some (enum, arity) ->
          error st pos (Printf.sprintf "%s.%s는 인자 %d개가 필요합니다" enum n arity)
      | None ->
          if List.mem n !seen then
            error st pos (Printf.sprintf "패턴에 %s이(가) 두 번 나옵니다" n)
          else (
            seen := n :: !seen;
            bind st pos n false))
  | P_ctor { name; args; pos } ->
      (match Hashtbl.find_opt st.ctors name with
      | Some (enum, arity) when arity <> List.length args ->
          error st pos
            (Printf.sprintf "%s.%s는 인자 %d개가 필요합니다 (%d개 주어짐)" enum name arity
               (List.length args))
      | Some _ -> ()
      | None -> external_ref st name pos);
      List.iter (resolve_pattern st seen) args

(* ------------------------------------------------------------------ *)
(* 식                                                                  *)
(* ------------------------------------------------------------------ *)

let rec resolve_expr st = function
  | E_lit _ -> ()
  | E_ident (n, pos) ->
      if lookup_local st n = None then
        if Hashtbl.mem st.items n then ()
        else if List.mem n builtin_values then ()
        else if Hashtbl.mem st.ctors n then ()
        else if List.mem n builtin_types then ()
          (* 타입 이름은 그 타입에 딸린 함수의 이름공간이다: String.len *)
        else external_ref st n pos
  | E_list (xs, _) -> List.iter (resolve_expr st) xs
  | E_struct { name; fields; pos } ->
      resolve_ty st (T_named { name; args = []; pos });
      List.iter (fun (_, e) -> resolve_expr st e) fields
  | E_closure c ->
      push st;
      List.iter
        (fun (n, t) ->
          Option.iter (resolve_ty st) t;
          bind st c.cl_pos n false)
        c.cl_params;
      (match c.cl_eff with
      | None -> ()
      | Some a -> resolve_eff_atom st (a, c.cl_pos));
      Option.iter (resolve_ty st) c.cl_ret;
      resolve_block st c.cl_body;
      pop st
  | E_if { cond; then_; else_; _ } ->
      resolve_expr st cond;
      resolve_block_scoped st then_;
      Option.iter (resolve_expr st) else_
  | E_match { scrutinee; arms; _ } ->
      resolve_expr st scrutinee;
      List.iter
        (fun a ->
          push st;
          let seen = ref [] in
          resolve_pattern st seen a.arm_pat;
          resolve_expr st a.arm_body;
          pop st)
        arms
  | E_scope { name; parent; body; pos } ->
      (* 부모는 이미 가진 TaskScope여야 한다. TaskScope는 use 값이라 모듈
         수준에 있을 수 없으므로 반드시 지역 바인딩(파라미터 포함)이다.
         자식 scope 이름은 블록 안에서만 산다. *)
      if lookup_local st parent = None then
        error st pos
          (Printf.sprintf
             "부모 scope %s이(가) 지역 바인딩이 아닙니다 (TaskScope는 use 값이라 파라미터나 상위 블록에서 \
              와야 합니다)"
             parent);
      push st;
      bind st pos name false;
      resolve_block st body;
      pop st
  | E_block b -> resolve_block_scoped st b
  | E_call { callee; args; _ } ->
      resolve_expr st callee;
      List.iter (resolve_expr st) args
  | E_field { obj; _ } -> resolve_expr st obj
  | E_inst { callee; args; pos } ->
      resolve_expr st callee;
      List.iter (resolve_targ st pos) args
  | E_try { inner; _ } -> resolve_expr st inner
  | E_unary { operand; _ } -> resolve_expr st operand
  | E_binary { lhs; rhs; _ } ->
      resolve_expr st lhs;
      resolve_expr st rhs

and resolve_block_scoped st b =
  push st;
  resolve_block st b;
  pop st

and resolve_block st b = List.iter (resolve_stmt st) b.stmts

and resolve_stmt st = function
  | S_let { mut_; pat; ty; value; pos } ->
      resolve_expr st value;
      Option.iter (resolve_ty st) ty;
      let seen = ref [] in
      (* let의 패턴 바인딩은 가변 여부를 let에서 받는다 *)
      let rec bind_pat = function
        | P_bind (n, p) when not (Hashtbl.mem st.ctors n) ->
            if List.mem n !seen then
              error st p (Printf.sprintf "패턴에 %s이(가) 두 번 나옵니다" n)
            else (
              seen := n :: !seen;
              bind st p n mut_)
        | P_ctor { args; _ } -> List.iter bind_pat args
        | p -> resolve_pattern st seen p
      in
      bind_pat pat;
      ignore pos
  | S_return { value; _ } -> Option.iter (resolve_expr st) value
  | S_assign { place; value; pos } -> (
      resolve_expr st value;
      resolve_expr st place;
      let rec root = function
        | E_ident (n, _) -> Some n
        | E_field { obj; _ } -> root obj
        | _ -> None
      in
      match root place with
      | None -> ()
      | Some n -> (
          match lookup_local st n with
          | Some true -> ()
          | Some false ->
              error st pos
                (Printf.sprintf "%s은(는) 불변 바인딩이라 대입할 수 없습니다 (mut이 필요합니다)" n)
          | None -> ()))
  | S_expr e -> resolve_expr st e

(* ------------------------------------------------------------------ *)
(* 선언                                                                *)
(* ------------------------------------------------------------------ *)

let resolve_signature st (d : fn_decl) =
  st.ty_params <-
    List.filter_map
      (fun g -> if g.gp_effect then None else Some g.gp_name)
      d.fn_gen;
  st.eff_params <-
    List.filter_map
      (fun g -> if g.gp_effect then Some g.gp_name else None)
      d.fn_gen;
  let seen = Hashtbl.create 8 in
  List.iter
    (fun g ->
      if Hashtbl.mem seen g.gp_name then
        error st g.gp_pos (Printf.sprintf "제네릭 파라미터 %s이(가) 중복입니다" g.gp_name)
      else Hashtbl.add seen g.gp_name ())
    d.fn_gen;
  let pseen = Hashtbl.create 8 in
  List.iter
    (fun p ->
      if Hashtbl.mem pseen p.p_name then
        error st p.p_pos (Printf.sprintf "파라미터 %s이(가) 중복입니다" p.p_name)
      else Hashtbl.add pseen p.p_name ();
      resolve_ty st p.p_ty)
    d.fn_params;
  (match d.fn_eff with
  | None -> ()
  | Some atoms -> resolve_eff_result st d.fn_pos atoms);
  Option.iter (resolve_ty st) d.fn_ret

let resolve_fn st (d : fn_decl) =
  resolve_signature st d;
  match d.fn_body with
  | None -> ()
  | Some body ->
      push st;
      List.iter (fun p -> bind st p.p_pos p.p_name p.p_mut) d.fn_params;
      resolve_block st body;
      pop st

let declare st pos name kind =
  if Hashtbl.mem st.items name then
    error st pos (Printf.sprintf "%s이(가) 이 모듈에 두 번 정의되었습니다" name)
  else Hashtbl.add st.items name kind

let resolve (m : modul) : info * error list =
  let st =
    {
      items = Hashtbl.create 32;
      ctors = Hashtbl.create 32;
      ty_params = [];
      eff_params = [];
      scopes = [];
      errors = [];
      ext = [];
    }
  in
  (* 1차: 모듈 수준 이름을 모은다. 선언 순서에 의존하지 않는다. *)
  List.iter
    (fun it ->
      match it with
      | I_import { alias; pos; _ } -> declare st pos alias K_import
      | I_fn { decl; _ } -> declare st decl.fn_pos decl.fn_name K_fn
      | I_struct { name; pos; _ } -> declare st pos name K_type
      | I_enum { name; variants; pos; _ } ->
          declare st pos name K_type;
          List.iter
            (fun v ->
              if Hashtbl.mem st.ctors v.v_name then
                error st v.v_pos
                  (Printf.sprintf "variant %s이(가) 중복입니다" v.v_name)
              else Hashtbl.add st.ctors v.v_name (name, List.length v.v_args))
            variants
      | I_capability { name; pos; _ } -> declare st pos name K_type
      | I_const { name; pos; _ } -> declare st pos name K_const
      | I_reexport _ -> ())
    m.items;
  (* 2차: 본문을 훑는다. *)
  List.iter
    (fun it ->
      st.ty_params <- [];
      st.eff_params <- [];
      st.scopes <- [];
      match it with
      | I_import _ -> ()
      | I_reexport { name; pos } ->
          if not (Hashtbl.mem st.items name) then
            error st pos
              (Printf.sprintf "%s은(는) 이 모듈에 없습니다 (reexport 대상은 모듈에 있어야 합니다)"
                 name)
      | I_fn { decl; _ } -> resolve_fn st decl
      | I_struct { gen; fields; _ } ->
          st.ty_params <- List.map (fun g -> g.gp_name) gen;
          List.iter (fun f -> resolve_ty st f.f_ty) fields
      | I_enum { gen; variants; _ } ->
          st.ty_params <- List.map (fun g -> g.gp_name) gen;
          List.iter (fun v -> List.iter (resolve_ty st) v.v_args) variants
      | I_capability { methods; _ } ->
          List.iter (fun d -> resolve_signature st d) methods
      | I_const { ty; value; _ } ->
          resolve_ty st ty;
          push st;
          resolve_expr st value;
          pop st)
    m.items;
  let by_pos (_, a) (_, b) =
    compare (a.Token.line, a.Token.col) (b.Token.line, b.Token.col)
  in
  ( { externals = List.sort by_pos (List.rev st.ext) },
    List.sort
      (fun a b ->
        compare
          (a.pos.Token.line, a.pos.Token.col)
          (b.pos.Token.line, b.pos.Token.col))
      (List.rev st.errors) )