coollang/lib/ir.ml

(* 얇은 typed IR.

   왜 AST를 직접 해석하지 않는가 — 표면 문법이 실행 의미에 닿지 않는다는 것을
   구조로 강제하기 위해서다. v1이 백엔드를 무엇으로 바꾸든 소비하는 것은 이
   IR이고, 문법을 고쳐도 여기가 그대로면 실행 의미는 그대로다.

   얇다는 것의 뜻: 새 개념을 만들지 않는다. 검사 단계가 이미 답한 질문을
   다시 묻지 않는다 — 여기 도달한 프로그램은 타입, effect, capability,
   ownership 검사를 모두 통과했다. 그래서 IR에는 타입 검사가 없다.

   낮추기에서 사라지는 것:
   - E_try: Result에 대한 match로 펼친다. `?`는 설탕이다
   - E_inst: 타입 인자는 실행에 영향이 없다 (단형화 없음, 값 표현이 같다)
   - 한정 이름: "Alias.f" 하나의 이름으로 평탄화된다 (검사 단계와 같은 규칙) *)

type pos = Token.pos

(* 이름은 낮추기 시점에 분류된다. 실행 중에 "이게 지역인가 전역인가"를
   다시 묻지 않는다. *)
(* 전역 이름은 정규화된다: "<모듈 경로>#<이름>". 별칭은 가져오는 쪽의 선택이라
   실행 의미에 들어와서는 안 된다 — 같은 함수가 부르는 자리마다 다른 이름이 되면
   IR은 더 이상 v1의 번역 대상이 아니다. *)
type ref_kind =
  | R_local of string
  | R_global of string (* "<경로>#<이름>" *)
  | R_ctor of string * string (* enum 이름, 정규화된 variant 이름 *)
  | R_builtin of string (* 본문 없는 선언 = 런타임이 구현한다 *)

type pat =
  | IP_wild
  | IP_lit of Ast.lit
  | IP_bind of string
  | IP_ctor of string * pat list (* variant 이름 *)

type t =
  | I_unit
  | I_lit of Ast.lit
  | I_ref of ref_kind * pos
  | I_list of t list
  | I_make of string * (string * t) list (* struct 생성 *)
  | I_closure of closure
  | I_if of { cond : t; then_ : t; else_ : t }
  | I_match of { scrutinee : t; arms : (pat * t) list; pos : pos }
  | I_scope of { name : string; body : t; pos : pos }
  | I_seq of stmt list * t (* 블록: 문 나열 + 꼬리 값 *)
  | I_call of { callee : t; args : t list; pos : pos }
  | I_field of { obj : t; name : string; pos : pos }
  | I_crash of t * pos
  | I_unary of Ast.unop * t * pos
  | I_binary of Ast.binop * t * t * pos

and stmt =
  | S_let of pat * t * pos
  | S_assign of { place : t; value : t; pos : pos }
  | S_return of t * pos
  | S_do of t

and closure = { c_params : string list; c_body : t; c_pos : pos }

type fn = { fn_name : string; fn_params : string list; fn_body : t }

type program = {
  fns : (string, fn) Hashtbl.t;
  (* 테스트. (모듈 경로, 이름, 위치, 본문) *)
  mutable tests : (string * string * pos * t) list;
  (* variant 이름 -> (enum 이름, 인자 개수) *)
  ctors : (string, string * int) Hashtbl.t;
  caps : (string, string list) Hashtbl.t; (* capability -> 메서드 이름 *)
  consts : (string, t) Hashtbl.t;
}

(* ------------------------------------------------------------------ *)
(* 낮추기                                                              *)
(* ------------------------------------------------------------------ *)

let qual modl name = match modl with Some a -> a ^ "." ^ name | None -> name

(* 지역 이름 스택. 검사 단계가 아니라 분류만 한다 — 여기서 못 찾은 이름은
   전역이거나 생성자이거나 런타임 제공이다. *)
type modinfo = {
  m_path : string; (* 정규 경로 *)
  m_ast : Ast.modul;
  m_deps : (string * string) list; (* 별칭 -> 정규 경로 *)
}

(* 본문 없는 선언은 런타임이 구현한다. 그 이름은 모듈 파일 이름에서 온다:
   std/list.cool의 each는 "list.each"다. 가져오는 쪽의 별칭과 무관하다. *)
let builtin_name path name =
  Filename.remove_extension (Filename.basename path) ^ "." ^ name

type lctx = {
  prog : program;
  mods : (string, modinfo) Hashtbl.t;
  cur : modinfo;
  mutable locals : string list list;
}

let lpush c = c.locals <- [] :: c.locals
let lpop c = match c.locals with _ :: r -> c.locals <- r | [] -> ()

let lbind c n =
  match c.locals with
  | s :: r -> c.locals <- (n :: s) :: r
  | [] -> c.locals <- [ [ n ] ]

let is_local c n = List.exists (fun s -> List.mem n s) c.locals
let builtin_ctors = [ "Ok"; "Err"; "Some"; "None" ]

(* 한 모듈 안에서 이름 하나를 분류한다. 지역이 아니면 그 모듈의 정의를 본다. *)
let in_module c (mi : modinfo) name =
  let key = mi.m_path ^ "#" ^ name in
  if Hashtbl.mem c.prog.ctors key then
    match Hashtbl.find_opt c.prog.ctors key with
    | Some (enum, _) -> Some (R_ctor (enum, key))
    | None -> None
  else if Hashtbl.mem c.prog.consts key then Some (R_global key)
  else
    let decl =
      List.find_map
        (function
          | Ast.I_fn { decl; _ } when decl.fn_name = name -> Some decl
          | _ -> None)
        mi.m_ast.items
    in
    match decl with
    | Some d when d.fn_body <> None -> Some (R_global key)
    | Some _ -> Some (R_builtin (builtin_name mi.m_path name))
    | None -> None

let classify c name =
  if is_local c name then R_local name
  else if List.mem name builtin_ctors then
    R_ctor ((if name = "Ok" || name = "Err" then "Result" else "Option"), name)
  else
    match in_module c c.cur name with
    | Some k -> k
    | None -> (
        (* 한정 이름 "A.f": A가 이 모듈의 import면 그 모듈에서 찾는다. *)
        match String.index_opt name '.' with
        | None -> R_builtin name
        | Some i -> (
            let a = String.sub name 0 i in
            let f = String.sub name (i + 1) (String.length name - i - 1) in
            match List.assoc_opt a c.cur.m_deps with
            | None -> R_builtin name
            | Some path -> (
                match Hashtbl.find_opt c.mods path with
                | None -> R_builtin name
                | Some mi -> (
                    match in_module c mi f with
                    | Some k -> k
                    | None -> R_builtin (builtin_name path f)))))

(* 패턴의 생성자도 정규 이름으로 접는다. 값 쪽과 같은 키를 써야 match가
   성립한다 — 두 곳이 다른 규칙을 쓰면 조용히 안 맞는다. *)
let ctor_key c modl name : string option =
  if List.mem name builtin_ctors then Some name
  else
    let path =
      match modl with
      | None -> Some c.cur.m_path
      | Some a -> List.assoc_opt a c.cur.m_deps
    in
    match path with
    | None -> None
    | Some p ->
        let k = p ^ "#" ^ name in
        if Hashtbl.mem c.prog.ctors k then Some k else None

let rec lower_pat c (p : Ast.pattern) : pat =
  match p with
  | Ast.P_wild _ -> IP_wild
  | Ast.P_lit (l, _) -> IP_lit l
  | Ast.P_bind (n, _) -> (
      (* 인자 없는 생성자는 이름만 쓴다. 바인딩과 구별은 여기서 끝난다. *)
      match ctor_key c None n with
      | Some k -> IP_ctor (k, [])
      | None ->
          lbind c n;
          IP_bind n)
  | Ast.P_ctor { modl; name; args; _ } ->
      let k =
        match ctor_key c modl name with Some k -> k | None -> qual modl name
      in
      IP_ctor (k, List.map (lower_pat c) args)

let rec lower c (e : Ast.expr) : t =
  match e with
  | Ast.E_crash { msg; pos } -> I_crash (lower c msg, pos)
  | Ast.E_lit (l, _) -> I_lit l
  | Ast.E_ident (n, pos) -> I_ref (classify c n, pos)
  | Ast.E_list (xs, _) -> I_list (List.map (lower c) xs)
  | Ast.E_struct { name; fields; _ } ->
      I_make (name, List.map (fun (n, e) -> (n, lower c e)) fields)
  | Ast.E_closure cl ->
      lpush c;
      List.iter (fun (p : Ast.cl_param) -> lbind c p.cp_name) cl.cl_params;
      let body = lower_block c cl.cl_body in
      lpop c;
      I_closure
        {
          c_params = List.map (fun (p : Ast.cl_param) -> p.cp_name) cl.cl_params;
          c_body = body;
          c_pos = cl.cl_pos;
        }
  | Ast.E_if { cond; then_; else_; _ } ->
      let cond = lower c cond in
      lpush c;
      let t = lower_block c then_ in
      lpop c;
      let e =
        match else_ with
        | None -> I_unit
        | Some e ->
            lpush c;
            let v = lower c e in
            lpop c;
            v
      in
      I_if { cond; then_ = t; else_ = e }
  | Ast.E_match { scrutinee; arms; pos } ->
      let s = lower c scrutinee in
      let arms =
        List.map
          (fun (a : Ast.arm) ->
            lpush c;
            let p = lower_pat c a.arm_pat in
            let b = lower c a.arm_body in
            lpop c;
            (p, b))
          arms
      in
      I_match { scrutinee = s; arms; pos }
  | Ast.E_scope { name; body; pos; _ } ->
      lpush c;
      lbind c name;
      let b = lower_block c body in
      lpop c;
      I_scope { name; body = b; pos }
  | Ast.E_block b ->
      lpush c;
      let v = lower_block c b in
      lpop c;
      v
  | Ast.E_call { callee; args; pos } ->
      I_call { callee = lower c callee; args = List.map (lower c) args; pos }
  | Ast.E_field { obj; name; pos } -> (
      (* Alias.f / String.concat 처럼 이름공간 접근은 하나의 이름으로 접는다.
         값의 필드 접근과 구별되는 지점은 obj가 지역 이름이 아닌 것뿐이다. *)
      match obj with
      | Ast.E_ident (o, _) when not (is_local c o) ->
          I_ref (classify c (o ^ "." ^ name), pos)
      | _ -> I_field { obj = lower c obj; name; pos })
  | Ast.E_inst { callee; _ } -> lower c callee
  | Ast.E_try { inner; pos } ->
      (* `?`는 설탕이다: Ok(v) => v, Err(e) => return Err(e) *)
      I_match
        {
          scrutinee = lower c inner;
          arms =
            [
              (IP_ctor ("Ok", [ IP_bind "?v" ]), I_ref (R_local "?v", pos));
              ( IP_ctor ("Err", [ IP_bind "?e" ]),
                I_seq
                  ( [
                      S_return
                        ( I_call
                            {
                              callee = I_ref (R_ctor ("Result", "Err"), pos);
                              args = [ I_ref (R_local "?e", pos) ];
                              pos;
                            },
                          pos );
                    ],
                    I_unit ) );
            ];
          pos;
        }
  | Ast.E_unary { op; operand; pos } -> I_unary (op, lower c operand, pos)
  | Ast.E_binary { op; lhs; rhs; pos } ->
      I_binary (op, lower c lhs, lower c rhs, pos)

and lower_block c (b : Ast.block) : t =
  let rec go = function
    | [] -> I_unit
    | [ Ast.S_expr e ] -> lower c e
    | s :: rest -> (
        let s = lower_stmt c s in
        let tail = go rest in
        match tail with
        | I_seq (ss, t) -> I_seq (s :: ss, t)
        | t -> I_seq ([ s ], t))
  in
  go b.stmts

and lower_stmt c (s : Ast.stmt) : stmt =
  match s with
  | Ast.S_let { pat; value; pos; _ } ->
      let v = lower c value in
      (* 값을 먼저 낮춘다 — 바인딩은 그 뒤에야 보인다 *)
      S_let (lower_pat c pat, v, pos)
  | Ast.S_return { value; pos } ->
      S_return ((match value with Some e -> lower c e | None -> I_unit), pos)
  | Ast.S_assign { place; value; pos } ->
      S_assign { place = lower c place; value = lower c value; pos }
  | Ast.S_expr e -> S_do (lower c e)

(* 모듈 그래프 전체를 하나의 IR 프로그램으로 낮춘다.

   모듈 하나씩 낮추고 싶은 유혹이 있지만, 그러면 별칭이 실행 의미에 남는다.
   같은 함수가 A에서는 Shapes.double, B에서는 Geo.double이 되어 IR이 더 이상
   프로그램의 정규형이 아니게 된다. 정규 경로로 한 번 접는다. *)
let of_program (mods : modinfo list) : program =
  let prog =
    {
      fns = Hashtbl.create 64;
      tests = [];
      ctors = Hashtbl.create 64;
      caps = Hashtbl.create 16;
      consts = Hashtbl.create 16;
    }
  in
  let index = Hashtbl.create 16 in
  List.iter (fun mi -> Hashtbl.replace index mi.m_path mi) mods;
  (* 1차: 이름부터. 낮추기가 이름을 분류하려면 그래프 전체가 먼저 보여야 한다. *)
  List.iter
    (fun mi ->
      let key n = mi.m_path ^ "#" ^ n in
      List.iter
        (fun (it : Ast.item) ->
          match it with
          | Ast.I_enum { name; variants; _ } ->
              List.iter
                (fun (v : Ast.variant) ->
                  Hashtbl.replace prog.ctors (key v.v_name)
                    (name, List.length v.v_args))
                variants
          | Ast.I_capability { name; methods; _ } ->
              Hashtbl.replace prog.caps name
                (List.map (fun (d : Ast.fn_decl) -> d.fn_name) methods)
          | Ast.I_const { name; _ } ->
              Hashtbl.replace prog.consts (key name) I_unit
          | _ -> ())
        mi.m_ast.items)
    mods;
  List.iter
    (fun (v, e, n) -> Hashtbl.replace prog.ctors v (e, n))
    [
      ("Ok", "Result", 1);
      ("Err", "Result", 1);
      ("Some", "Option", 1);
      ("None", "Option", 0);
    ];
  (* 2차: 본문 *)
  List.iter
    (fun mi ->
      let c = { prog; mods = index; cur = mi; locals = [] } in
      let key n = mi.m_path ^ "#" ^ n in
      List.iter
        (fun (it : Ast.item) ->
          match it with
          | Ast.I_fn { decl; _ } -> (
              match decl.fn_body with
              | None -> ()
              | Some body ->
                  c.locals <- [];
                  lpush c;
                  List.iter
                    (fun (p : Ast.param) -> lbind c p.p_name)
                    decl.fn_params;
                  let b = lower_block c body in
                  lpop c;
                  Hashtbl.replace prog.fns (key decl.fn_name)
                    {
                      fn_name = key decl.fn_name;
                      fn_params =
                        List.map
                          (fun (p : Ast.param) -> p.p_name)
                          decl.fn_params;
                      fn_body = b;
                    })
          | Ast.I_const { name; value; _ } ->
              c.locals <- [];
              Hashtbl.replace prog.consts (key name) (lower c value)
          | Ast.I_test { name; body; pos } ->
              c.locals <- [];
              lpush c;
              let b = lower_block c body in
              lpop c;
              prog.tests <- (mi.m_path, name, pos, b) :: prog.tests
          | _ -> ())
        mi.m_ast.items)
    mods;
  prog