coollang/lib/recognize.ml

(* 문법 파일이 직접 읽는 인식기.

   손으로 쓴 파서(lib/parser.ml)와 같은 토큰 열을 받아 같은 판정을 내야 한다.
   갈리면 둘 중 하나가 틀린 것이고, 그 순간 테스트가 깨진다. 이것이 설명서와
   구현이 어긋나지 않게 하는 기계적 장치다.

   AST를 만들지 않는다. 받아들이는가만 답한다. 그래서 손 파서의 진단은
   그대로 남는다 — 대조는 판정만 한다.

   문법이 LL(1)임이 이미 검증되었으므로 여기서 선택은 결정적이다.
   다음 토큰이 어느 대안의 FIRST에 있는지만 보면 되고 되돌아가지 않는다. *)

module SS = Set.Make (String)

type error = { pos : Token.pos; expected : string; got : string }

(* 토큰을 문법의 단말 이름으로 옮긴다. 이 대응이 문법과 렉서를 잇는 유일한
   지점이다 — 여기가 틀리면 대조 전체가 무의미하다. *)
let terminal_of (k : Token.kind) =
  match k with
  | Token.Ident _ -> "ident"
  | Token.Int _ -> "int_lit"
  | Token.Str _ -> "string_lit"
  | Token.Newline -> "NEWLINE"
  | Token.Eof -> "<eof>"
  | k -> Token.show_kind k

type state = {
  toks : Token.t array;
  mutable i : int;
  rules : (string, Ebnf.rule) Hashtbl.t;
  a : Ebnf.analysis;
  tokens : SS.t;
  mutable err : error option;
}

exception Fail

let cur st = st.toks.(st.i)
let term st = terminal_of (cur st).Token.kind

let fail st expected =
  (* 가장 멀리 간 실패를 남긴다. 그 자리가 사람이 볼 자리다 *)
  let keep =
    match st.err with
    | None -> true
    | Some e ->
        (e.pos.Token.line, e.pos.Token.col)
        <= ((cur st).Token.pos.Token.line, (cur st).Token.pos.Token.col)
  in
  if keep then
    st.err <- Some { pos = (cur st).Token.pos; expected; got = term st };
  raise Fail

let advance st = if st.i < Array.length st.toks - 1 then st.i <- st.i + 1
let is_tok st n = SS.mem n st.tokens || not (Hashtbl.mem st.rules n)

(* 이 식이 지금 토큰으로 시작할 수 있는가 *)
let starts st e = SS.mem (term st) (Ebnf.first_expr st.a e)

let rec run st (e : Ebnf.expr) =
  match e with
  | Ebnf.Term s -> if term st = s then advance st else fail st ("\"" ^ s ^ "\"")
  | Ebnf.Ref n ->
      if is_tok st n then if term st = n then advance st else fail st n
      else run st (Hashtbl.find st.rules n).Ebnf.body
  | Ebnf.RefArg (n, x) -> run st (Ebnf.Ref (Ebnf.mangle n x))
  | Ebnf.Seq xs -> List.iter (run st) xs
  | Ebnf.Alt xs -> (
      match List.find_opt (starts st) xs with
      | Some x -> run st x
      | None -> (
          (* 비어도 되는 대안이 있으면 그것을 고른다 *)
          match List.find_opt (Ebnf.nullable_expr st.a) xs with
          | Some x -> run st x
          | None ->
              fail st
                (String.concat " 또는 " (SS.elements (Ebnf.first_expr st.a e)))))
  (* 선택과 반복은 최대한 먹는다 (문법 표기 규약의 greedy 규칙) *)
  | Ebnf.Opt x -> if starts st x then run st x
  | Ebnf.Rep x ->
      while starts st x do
        run st x
      done
  | Ebnf.Except (x, _) -> run st x

let check ?(tokens = []) ?(start = "module") (g : Ebnf.t) (toks : Token.t list)
    : (unit, error) result =
  let g = Ebnf.expand g in
  let rules = Hashtbl.create 128 in
  List.iter (fun (r : Ebnf.rule) -> Hashtbl.replace rules r.name r) g;
  let st =
    {
      toks = Array.of_list toks;
      i = 0;
      rules;
      a = Ebnf.analyze ~tokens g;
      tokens = SS.of_list tokens;
      err = None;
    }
  in
  match run st (Ebnf.Ref start) with
  | () ->
      if term st = "<eof>" then Ok ()
      else (
        (match st.err with
        | Some _ -> ()
        | None ->
            st.err <-
              Some
                { pos = (cur st).Token.pos; expected = "파일 끝"; got = term st });
        Error (Option.get st.err))
  | exception Fail -> Error (Option.get st.err)