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

(* 이름은 낮추기 시점에 분류된다. 실행 중에 "이게 지역인가 전역인가"를
   다시 묻지 않는다. *)
type ref_kind =
  | R_local of string
  | R_global of string (* 이 프로그램의 함수 *)
  | R_ctor of string * string (* enum 이름, variant 이름 *)
  | R_builtin of string (* String.concat 등 런타임 제공 *)

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_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;
  (* 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 lctx = { prog : program; 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 builtins =
  [
    "String.concat";
    "String.len";
    "Int.show";
    "Bool.show";
    "List.len";
    "List.each";
    "List.map";
    "print";
  ]

let classify c name =
  if is_local c name then R_local name
  else
    match Hashtbl.find_opt c.prog.ctors name with
    | Some (enum, _) -> R_ctor (enum, name)
    | None ->
        if Hashtbl.mem c.prog.fns name || Hashtbl.mem c.prog.consts name then
          R_global name
        else R_builtin name

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, _) ->
      (* 인자 없는 생성자는 이름만 쓴다. 바인딩과 구별은 여기서 끝난다. *)
      if Hashtbl.mem c.prog.ctors n then IP_ctor (n, [])
      else (
        lbind c n;
        IP_bind n)
  | Ast.P_ctor { modl; name; args; _ } ->
      IP_ctor (qual modl name, List.map (lower_pat c) args)

let rec lower c (e : Ast.expr) : t =
  match e with
  | 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 (n, _) -> lbind c n) cl.cl_params;
      let body = lower_block c cl.cl_body in
      lpop c;
      I_closure
        {
          c_params = List.map fst 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)

let of_module ?(imports : Ast.item list = []) (m : Ast.modul) : program =
  let prog =
    {
      fns = Hashtbl.create 32;
      ctors = Hashtbl.create 32;
      caps = Hashtbl.create 8;
      consts = Hashtbl.create 8;
    }
  in
  let items = imports @ m.items in
  (* 1차: 이름부터. 낮추기가 이름을 분류하려면 전체가 먼저 보여야 한다. *)
  List.iter
    (fun (it : Ast.item) ->
      match it with
      | Ast.I_enum { name; variants; _ } ->
          List.iter
            (fun (v : Ast.variant) ->
              Hashtbl.replace prog.ctors 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_fn { decl; _ } when decl.fn_body <> None ->
          Hashtbl.replace prog.fns decl.fn_name
            { fn_name = decl.fn_name; fn_params = []; fn_body = I_unit }
      | Ast.I_const { name; _ } -> Hashtbl.replace prog.consts name I_unit
      | _ -> ())
    items;
  (* builtin 생성자도 IR이 알아야 한다 *)
  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차: 본문 *)
  let c = { prog; locals = [] } 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 decl.fn_name
                {
                  fn_name = 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 name (lower c value)
      | _ -> ())
    items;
  prog