coollang/lib/parser.ml

(* 재귀 하강 파서. grammar.ebnf의 프로덕션 하나에 함수 하나로 대응한다.
   LL(1)이므로 선읽기는 항상 한 토큰이고 backtracking은 없다.

   문법과 얽히는 두 자리:
   - NEWLINE 흡수는 문법에 { NEWLINE }으로 적힌 자리에서만 한다.
     파서가 임의로 건너뛰지 않는다.
   - struct 리터럴은 if/match/scope 머리에서 금지된다 (no_struct). *)

open Ast

type error = { pos : Token.pos; msg : string }

exception Error of error

type state = { toks : Token.t array; mutable i : int; mutable no_struct : bool }

let cur st = st.toks.(st.i)
let kind st = (cur st).Token.kind
let pos st = (cur st).Token.pos
let adv st = if st.i < Array.length st.toks - 1 then st.i <- st.i + 1
let err st msg = raise (Error { pos = pos st; msg })

let err_expect st what =
  err st
    (Printf.sprintf "%s이(가) 필요합니다 — %s 발견" what (Token.show_kind (kind st)))

let accept st k =
  if kind st = k then (
    adv st;
    true)
  else false

let expect st k what = if not (accept st k) then err_expect st what

let skip_nl st =
  while kind st = Token.Newline do
    adv st
  done

(* 목록을 닫을 때 줄바꿈이 보이면 후행 콤마 누락이다. 일반 메시지보다
   원인을 직접 말해준다. *)
let expect_close st k what =
  if kind st = Token.Newline then err st "다중 줄 목록에는 후행 콤마가 필요합니다"
  else expect st k what

let ident st what =
  match kind st with
  | Token.Ident n ->
      adv st;
      n
  | _ -> err_expect st what

let with_struct_ok st f =
  let saved = st.no_struct in
  st.no_struct <- false;
  let r = f () in
  st.no_struct <- saved;
  r

(* ------------------------------------------------------------------ *)
(* effect 절                                                           *)
(* ------------------------------------------------------------------ *)

let parse_eff_name st =
  let cap = ident st "capability 이름" in
  expect st Token.Dot ".";
  let meth = ident st "메서드 이름" in
  { cap; meth }

let parse_eff_set st =
  expect st Token.LBrace "{";
  skip_nl st;
  let rec loop acc =
    if kind st = Token.RBrace then List.rev acc
    else
      let n = parse_eff_name st in
      skip_nl st;
      if accept st Token.Comma then (
        skip_nl st;
        loop (n :: acc))
      else (
        skip_nl st;
        List.rev (n :: acc))
  in
  let names = loop [] in
  expect st Token.RBrace "}";
  Eff_set names

let parse_eff_atom st =
  match kind st with
  | Token.LBrace -> parse_eff_set st
  | Token.Ident n ->
      adv st;
      Eff_var n
  | _ -> err_expect st "effect 변수 또는 { ... } 집합"

(* 결과 위치: 합집합 허용 *)
let parse_eff_result st =
  expect st Token.Kw_effects "effects";
  let rec loop acc =
    let a = parse_eff_atom st in
    if accept st Token.Pipe then loop (a :: acc) else List.rev (a :: acc)
  in
  loop []

(* 파라미터 위치: 합집합이 문법에 없다 *)
let parse_eff_param st =
  expect st Token.Kw_effects "effects";
  let a = parse_eff_atom st in
  if kind st = Token.Pipe then
    err st "파라미터 위치의 effects 절에는 합집합을 쓸 수 없습니다 (변수 단독 또는 리터럴 집합만 가능)";
  a

(* ------------------------------------------------------------------ *)
(* 타입                                                                *)
(* ------------------------------------------------------------------ *)

let rec parse_ty st =
  match kind st with
  | Token.Kw_affine ->
      let p = pos st in
      adv st;
      expect st Token.Kw_fn "fn";
      parse_fn_ty st true p
  | Token.Kw_fn ->
      let p = pos st in
      adv st;
      parse_fn_ty st false p
  | Token.Ident n ->
      let p = pos st in
      adv st;
      let modl, n =
        if kind st = Token.Dot then (
          adv st;
          (Some n, ident st "타입 이름"))
        else (None, n)
      in
      let args = if kind st = Token.LBracket then parse_targs st else [] in
      T_named { modl; name = n; args; pos = p }
  | _ -> err_expect st "타입"

and parse_fn_ty st affine p =
  expect st Token.LParen "(";
  let params =
    if kind st = Token.RParen then []
    else
      let rec loop acc =
        let t = parse_ty st in
        if accept st Token.Comma then
          if kind st = Token.RParen then List.rev (t :: acc) else loop (t :: acc)
        else List.rev (t :: acc)
      in
      loop []
  in
  expect_close st Token.RParen ")";
  let eff =
    if kind st = Token.Kw_effects then Some (parse_eff_param st) else None
  in
  let ret = if accept st Token.Arrow then Some (parse_ty st) else None in
  T_fn { affine; params; eff; ret; pos = p }

and parse_targs st =
  expect st Token.LBracket "[";
  let rec loop acc =
    let a =
      if kind st = Token.LBrace then TA_eff (parse_eff_set st)
      else TA_ty (parse_ty st)
    in
    if accept st Token.Comma then
      if kind st = Token.RBracket then List.rev (a :: acc) else loop (a :: acc)
    else List.rev (a :: acc)
  in
  let args = loop [] in
  expect_close st Token.RBracket "]";
  args

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

let rec parse_pattern st =
  let p = pos st in
  match kind st with
  | Token.Underscore ->
      adv st;
      P_wild p
  | Token.Int s ->
      adv st;
      P_lit (L_int s, p)
  | Token.Str s ->
      adv st;
      P_lit (L_str s, p)
  | Token.Kw_true ->
      adv st;
      P_lit (L_bool true, p)
  | Token.Kw_false ->
      adv st;
      P_lit (L_bool false, p)
  | Token.Ident n -> (
      adv st;
      let modl, n =
        if kind st = Token.Dot then (
          adv st;
          (Some n, ident st "생성자 이름"))
        else (None, n)
      in
      if kind st = Token.LParen then (
        adv st;
        let rec loop acc =
          let x = parse_pattern st in
          if accept st Token.Comma then
            if kind st = Token.RParen then List.rev (x :: acc)
            else loop (x :: acc)
          else List.rev (x :: acc)
        in
        let args = if kind st = Token.RParen then [] else loop [] in
        expect_close st Token.RParen ")";
        P_ctor { modl; name = n; args; pos = p })
      else
        match modl with
        | Some _ -> P_ctor { modl; name = n; args = []; pos = p }
        | None -> P_bind (n, p))
  | _ -> err_expect st "패턴"

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

let rec parse_expr st = parse_or st

and parse_or st =
  let lhs = ref (parse_and st) in
  while kind st = Token.PipePipe do
    let p = pos st in
    adv st;
    lhs := E_binary { op = B_or; lhs = !lhs; rhs = parse_and st; pos = p }
  done;
  !lhs

and parse_and st =
  let lhs = ref (parse_cmp st) in
  while kind st = Token.AmpAmp do
    let p = pos st in
    adv st;
    lhs := E_binary { op = B_and; lhs = !lhs; rhs = parse_cmp st; pos = p }
  done;
  !lhs

and parse_cmp st =
  let lhs = parse_add st in
  let op =
    match kind st with
    | Token.EqEq -> Some B_eq
    | Token.BangEq -> Some B_ne
    | Token.Lt -> Some B_lt
    | Token.Le -> Some B_le
    | Token.Gt -> Some B_gt
    | Token.Ge -> Some B_ge
    | _ -> None
  in
  match op with
  | None -> lhs
  | Some op ->
      let p = pos st in
      adv st;
      E_binary { op; lhs; rhs = parse_add st; pos = p }

and parse_add st =
  let lhs = ref (parse_mul st) in
  let rec go () =
    let op =
      match kind st with
      | Token.Plus -> Some B_add
      | Token.Minus -> Some B_sub
      | _ -> None
    in
    match op with
    | None -> ()
    | Some op ->
        let p = pos st in
        adv st;
        lhs := E_binary { op; lhs = !lhs; rhs = parse_mul st; pos = p };
        go ()
  in
  go ();
  !lhs

and parse_mul st =
  let lhs = ref (parse_unary st) in
  let rec go () =
    let op =
      match kind st with
      | Token.Star -> Some B_mul
      | Token.Slash -> Some B_div
      | Token.Percent -> Some B_rem
      | _ -> None
    in
    match op with
    | None -> ()
    | Some op ->
        let p = pos st in
        adv st;
        lhs := E_binary { op; lhs = !lhs; rhs = parse_unary st; pos = p };
        go ()
  in
  go ();
  !lhs

and parse_unary st =
  let p = pos st in
  match kind st with
  | Token.Bang ->
      adv st;
      E_unary { op = U_not; operand = parse_unary st; pos = p }
  | Token.Minus ->
      adv st;
      E_unary { op = U_neg; operand = parse_unary st; pos = p }
  | _ -> parse_postfix st

and parse_postfix st =
  let e = ref (parse_primary st) in
  let rec go () =
    let p = pos st in
    match kind st with
    | Token.LParen ->
        adv st;
        let args =
          if kind st = Token.RParen then []
          else
            with_struct_ok st (fun () ->
                let rec loop acc =
                  let a = parse_expr st in
                  if accept st Token.Comma then
                    if kind st = Token.RParen then List.rev (a :: acc)
                    else loop (a :: acc)
                  else List.rev (a :: acc)
                in
                loop [])
        in
        expect_close st Token.RParen ")";
        e := E_call { callee = !e; args; pos = p };
        go ()
    | Token.Dot ->
        adv st;
        let n = ident st "필드 또는 메서드 이름" in
        e := E_field { obj = !e; name = n; pos = p };
        go ()
    | Token.LBracket ->
        let args = with_struct_ok st (fun () -> parse_targs st) in
        e := E_inst { callee = !e; args; pos = p };
        go ()
    | Token.Question ->
        adv st;
        e := E_try { inner = !e; pos = p };
        go ()
    | _ -> ()
  in
  go ();
  !e

and parse_primary st =
  let p = pos st in
  match kind st with
  | Token.Int s ->
      adv st;
      E_lit (L_int s, p)
  | Token.Str s ->
      adv st;
      E_lit (L_str s, p)
  | Token.Kw_true ->
      adv st;
      E_lit (L_bool true, p)
  | Token.Kw_false ->
      adv st;
      E_lit (L_bool false, p)
  | Token.LParen ->
      adv st;
      let e = with_struct_ok st (fun () -> parse_expr st) in
      expect_close st Token.RParen ")";
      e
  | Token.LBracket ->
      adv st;
      let xs =
        if kind st = Token.RBracket then []
        else
          with_struct_ok st (fun () ->
              let rec loop acc =
                let x = parse_expr st in
                if accept st Token.Comma then
                  if kind st = Token.RBracket then List.rev (x :: acc)
                  else loop (x :: acc)
                else List.rev (x :: acc)
              in
              loop [])
      in
      expect_close st Token.RBracket "]";
      E_list (xs, p)
  | Token.Kw_fn -> parse_closure st
  | Token.Kw_if -> parse_if st
  | Token.Kw_match -> parse_match st
  | Token.Kw_scope ->
      adv st;
      let name = ident st "새 scope 이름" in
      expect st Token.Eq "= (자식 scope의 부모를 명시해야 합니다)";
      let parent = ident st "부모 scope 이름" in
      let body = parse_block st in
      E_scope { name; parent; body; pos = p }
  | Token.Ident n ->
      adv st;
      if (not st.no_struct) && kind st = Token.LBrace then
        let fields = parse_struct_lit_fields st in
        E_struct { name = n; fields; pos = p }
      else E_ident (n, p)
  | _ -> err_expect st "식"

and parse_struct_lit_fields st =
  expect st Token.LBrace "{";
  skip_nl st;
  let rec loop acc =
    if kind st = Token.RBrace then List.rev acc
    else begin
      let n = ident st "필드 이름" in
      expect st Token.Colon ":";
      let v = with_struct_ok st (fun () -> parse_expr st) in
      skip_nl st;
      if accept st Token.Comma then (
        skip_nl st;
        loop ((n, v) :: acc))
      else (
        skip_nl st;
        List.rev ((n, v) :: acc))
    end
  in
  let fields = loop [] in
  expect st Token.RBrace "}";
  fields

and parse_closure st =
  let p = pos st in
  expect st Token.Kw_fn "fn";
  expect st Token.LParen "(";
  let params =
    if kind st = Token.RParen then []
    else
      let rec loop acc =
        let n = ident st "파라미터 이름" in
        let t = if accept st Token.Colon then Some (parse_ty st) else None in
        if accept st Token.Comma then
          if kind st = Token.RParen then List.rev ((n, t) :: acc)
          else loop ((n, t) :: acc)
        else List.rev ((n, t) :: acc)
      in
      loop []
  in
  expect_close st Token.RParen ")";
  let eff =
    if kind st = Token.Kw_effects then Some (parse_eff_param st) else None
  in
  let ret = if accept st Token.Arrow then Some (parse_ty st) else None in
  let body = parse_block st in
  E_closure
    {
      cl_params = params;
      cl_eff = eff;
      cl_ret = ret;
      cl_body = body;
      cl_pos = p;
    }

and parse_if st =
  let p = pos st in
  expect st Token.Kw_if "if";
  let saved = st.no_struct in
  st.no_struct <- true;
  let cond = parse_expr st in
  st.no_struct <- saved;
  let then_ = parse_block st in
  let else_ =
    if accept st Token.Kw_else then
      if kind st = Token.Kw_if then Some (parse_if st)
      else Some (E_block (parse_block st))
    else None
  in
  E_if { cond; then_; else_; pos = p }

and parse_match st =
  let p = pos st in
  expect st Token.Kw_match "match";
  let saved = st.no_struct in
  st.no_struct <- true;
  let scrutinee = parse_expr st in
  st.no_struct <- saved;
  expect st Token.LBrace "{";
  skip_nl st;
  let rec loop acc =
    if kind st = Token.RBrace then List.rev acc
    else begin
      let ap = pos st in
      let pat = parse_pattern st in
      if kind st = Token.Kw_if then
        err st "match 가드는 v0에 없습니다 (분기 본문에서 if를 쓰십시오)";
      expect st Token.FatArrow "=>";
      let body =
        with_struct_ok st (fun () ->
            if kind st = Token.LBrace then E_block (parse_block st)
            else parse_expr st)
      in
      skip_nl st;
      if accept st Token.Comma then (
        skip_nl st;
        loop ({ arm_pat = pat; arm_body = body; arm_pos = ap } :: acc))
      else (
        skip_nl st;
        List.rev ({ arm_pat = pat; arm_body = body; arm_pos = ap } :: acc))
    end
  in
  let arms = loop [] in
  expect st Token.RBrace "}";
  E_match { scrutinee; arms; pos = p }

(* ------------------------------------------------------------------ *)
(* 문과 블록                                                           *)
(* ------------------------------------------------------------------ *)

and parse_block st =
  let p = pos st in
  expect st Token.LBrace "{";
  let saved = st.no_struct in
  st.no_struct <- false;
  skip_nl st;
  let rec loop acc =
    if kind st = Token.RBrace then List.rev acc
    else begin
      let s = parse_stmt st in
      if kind st = Token.Newline then (
        skip_nl st;
        loop (s :: acc))
      else if kind st = Token.RBrace then List.rev (s :: acc)
      else err st "문 끝에 줄바꿈이 필요합니다"
    end
  in
  let stmts = loop [] in
  expect st Token.RBrace "}";
  st.no_struct <- saved;
  { stmts; block_pos = p }

and parse_stmt st =
  let p = pos st in
  match kind st with
  | Token.Kw_let ->
      adv st;
      let mut_ = accept st Token.Kw_mut in
      let pat = parse_pattern st in
      let ty = if accept st Token.Colon then Some (parse_ty st) else None in
      expect st Token.Eq "=";
      let value = parse_expr st in
      S_let { mut_; pat; ty; value; pos = p }
  | Token.Kw_return ->
      adv st;
      let value =
        if kind st = Token.Newline || kind st = Token.RBrace then None
        else Some (parse_expr st)
      in
      S_return { value; pos = p }
  | _ ->
      let e = parse_expr st in
      if accept st Token.Eq then begin
        let rec is_place = function
          | E_ident _ -> true
          | E_field { obj; _ } -> is_place obj
          | _ -> false
        in
        if not (is_place e) then err st "대입 왼쪽에는 변수나 필드만 올 수 있습니다";
        let value = parse_expr st in
        S_assign { place = e; value; pos = p }
      end
      else S_expr e

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

let parse_gen_params st =
  expect st Token.LBracket "[";
  let rec loop acc =
    let p = pos st in
    let n = ident st "타입 또는 effect 파라미터 이름" in
    let is_eff =
      if accept st Token.Colon then (
        expect st Token.Kw_effects "effects";
        true)
      else false
    in
    let g = { gp_name = n; gp_effect = is_eff; gp_pos = p } in
    if accept st Token.Comma then
      if kind st = Token.RBracket then List.rev (g :: acc) else loop (g :: acc)
    else List.rev (g :: acc)
  in
  let gs = loop [] in
  expect_close st Token.RBracket "]";
  gs

let parse_params st =
  if kind st = Token.RParen then []
  else
    let rec loop acc =
      let p = pos st in
      let own = accept st Token.Kw_own in
      let mut_ = accept st Token.Kw_mut in
      let name = ident st "파라미터 이름" in
      expect st Token.Colon ":";
      let ty = parse_ty st in
      let prm =
        { p_own = own; p_mut = mut_; p_name = name; p_ty = ty; p_pos = p }
      in
      if accept st Token.Comma then
        if kind st = Token.RParen then List.rev (prm :: acc)
        else loop (prm :: acc)
      else List.rev (prm :: acc)
    in
    loop []

(* fn_decl = "fn" ident [gen] "(" [params] ")" {NL}
             [eff_result {NL}] ["->" type {NL}] [block]
   { NEWLINE } 흡수 위치는 문법에 적힌 그대로다. *)
let parse_fn_decl st ~allow_body =
  let p = pos st in
  expect st Token.Kw_fn "fn";
  let name = ident st "함수 이름" in
  let gen = if kind st = Token.LBracket then parse_gen_params st else [] in
  expect st Token.LParen "(";
  let params = parse_params st in
  expect_close st Token.RParen ")";
  skip_nl st;
  let eff =
    if kind st = Token.Kw_effects then (
      let e = parse_eff_result st in
      skip_nl st;
      Some e)
    else None
  in
  let ret =
    if accept st Token.Arrow then (
      let t = parse_ty st in
      skip_nl st;
      Some t)
    else None
  in
  let body =
    if allow_body && kind st = Token.LBrace then Some (parse_block st) else None
  in
  {
    fn_name = name;
    fn_gen = gen;
    fn_params = params;
    fn_eff = eff;
    fn_ret = ret;
    fn_body = body;
    fn_pos = p;
  }

let parse_struct st ~pub ~copyable =
  let p = pos st in
  expect st Token.Kw_struct "struct";
  let name = ident st "타입 이름" in
  let gen = if kind st = Token.LBracket then parse_gen_params st else [] in
  expect st Token.LBrace "{";
  skip_nl st;
  let rec loop acc =
    if kind st = Token.RBrace then List.rev acc
    else begin
      let fp = pos st in
      let n = ident st "필드 이름" in
      expect st Token.Colon ":";
      let t = parse_ty st in
      let f = { f_name = n; f_ty = t; f_pos = fp } in
      skip_nl st;
      if accept st Token.Comma then (
        skip_nl st;
        loop (f :: acc))
      else (
        skip_nl st;
        List.rev (f :: acc))
    end
  in
  let fields = loop [] in
  expect st Token.RBrace "}";
  I_struct { pub; copyable; name; gen; fields; pos = p }

let parse_enum st ~pub =
  let p = pos st in
  expect st Token.Kw_enum "enum";
  let name = ident st "타입 이름" in
  let gen = if kind st = Token.LBracket then parse_gen_params st else [] in
  expect st Token.LBrace "{";
  skip_nl st;
  let rec loop acc =
    if kind st = Token.RBrace then List.rev acc
    else begin
      let vp = pos st in
      let n = ident st "variant 이름" in
      let args =
        if accept st Token.LParen then begin
          let rec go acc =
            let t = parse_ty st in
            if accept st Token.Comma then
              if kind st = Token.RParen then List.rev (t :: acc)
              else go (t :: acc)
            else List.rev (t :: acc)
          in
          let ts = if kind st = Token.RParen then [] else go [] in
          expect_close st Token.RParen ")";
          ts
        end
        else []
      in
      let v = { v_name = n; v_args = args; v_pos = vp } in
      skip_nl st;
      if accept st Token.Comma then (
        skip_nl st;
        loop (v :: acc))
      else (
        skip_nl st;
        List.rev (v :: acc))
    end
  in
  let variants = loop [] in
  expect st Token.RBrace "}";
  I_enum { pub; name; gen; variants; pos = p }

let parse_capability st ~pub =
  let p = pos st in
  expect st Token.Kw_capability "capability";
  let name = ident st "capability 이름" in
  expect st Token.LBrace "{";
  skip_nl st;
  let rec loop acc =
    if kind st = Token.RBrace then List.rev acc
    else
      let m = parse_fn_decl st ~allow_body:false in
      skip_nl st;
      loop (m :: acc)
  in
  let methods = loop [] in
  expect st Token.RBrace "}";
  I_capability { pub; name; methods; pos = p }

let parse_item st =
  let p = pos st in
  match kind st with
  | Token.Kw_import ->
      adv st;
      let path =
        match kind st with
        | Token.Str s ->
            adv st;
            s
        | _ -> err_expect st "모듈 경로 문자열"
      in
      expect st Token.Kw_as "as";
      let alias = ident st "별칭" in
      I_import { path; alias; pos = p }
  | Token.Kw_reexport ->
      adv st;
      let name = ident st "재수출할 이름" in
      I_reexport { name; pos = p }
  | _ -> (
      let pub = accept st Token.Kw_pub in
      match kind st with
      | Token.Kw_fn -> I_fn { pub; decl = parse_fn_decl st ~allow_body:true }
      | Token.Kw_copyable ->
          adv st;
          parse_struct st ~pub ~copyable:true
      | Token.Kw_struct -> parse_struct st ~pub ~copyable:false
      | Token.Kw_enum -> parse_enum st ~pub
      | Token.Kw_capability -> parse_capability st ~pub
      | Token.Kw_const ->
          adv st;
          let name = ident st "상수 이름" in
          expect st Token.Colon ":";
          let ty = parse_ty st in
          expect st Token.Eq "=";
          let value = parse_expr st in
          I_const { pub; name; ty; value; pos = p }
      | _ -> err_expect st "선언 (fn, struct, enum, capability, const)")

let parse_module st =
  skip_nl st;
  let rec loop acc =
    if kind st = Token.Eof then List.rev acc
    else
      let it = parse_item st in
      skip_nl st;
      loop (it :: acc)
  in
  { items = loop [] }

let parse (tokens : Token.t list) : modul =
  let st = { toks = Array.of_list tokens; i = 0; no_struct = false } in
  parse_module st

let parse_result tokens =
  match parse tokens with m -> Ok m | exception Error e -> Error e