coollang/tools/ebnf_tool.ml

(* 문법 파일을 읽어 기계가 소비할 수 있는지 확인하는 도구. *)
let read file =
  let ic = open_in_bin file in
  let n = in_channel_length ic in
  let s = really_input_string ic n in
  close_in ic;
  s

(* 문법과 손 파서를 같은 파일에 돌려 판정이 갈리는지 본다 *)
let compare_files files =
  let g =
    match Coollang.Ebnf.parse_result (read "docs/grammar.ebnf") with
    | Ok g -> g
    | Error e -> failwith (Printf.sprintf "문법 %d행: %s" e.line e.msg)
  in
  let tokens =
    [ "ident"; "int_lit"; "string_lit"; "NEWLINE"; "char"; "digit"; "letter" ]
  in
  let bad = ref 0 in
  List.iter
    (fun f ->
      match Coollang.Lexer.lex_result (read f) with
      | Error e ->
          Printf.printf "  렉서 오류 %s:%d:%d %s\n" f e.pos.line e.pos.col e.msg
      | Ok toks -> (
          let hand =
            match Coollang.Parser.parse_result toks with
            | Ok _ -> None
            | Error e -> Some (e.pos, e.msg)
          in
          let spec =
            match Coollang.Recognize.check ~tokens g toks with
            | Ok () -> None
            | Error e ->
                Some (e.pos, Printf.sprintf "%s이(가) 필요한데 %s" e.expected e.got)
          in
          match (hand, spec) with
          | None, None -> ()
          | Some _, Some _ -> ()
          | None, Some (p, m) ->
              incr bad;
              Printf.printf "갈림 %s: 파서는 받고 문법은 거부 (%d:%d %s)\n" f
                p.Coollang.Token.line p.Coollang.Token.col m
          | Some (p, m), None ->
              incr bad;
              Printf.printf "갈림 %s: 문법은 받고 파서는 거부 (%d:%d %s)\n" f
                p.Coollang.Token.line p.Coollang.Token.col m))
    files;
  Printf.printf "\n파일 %d개 중 판정이 갈린 것 %d개\n" (List.length files) !bad;
  if !bad > 0 then exit 1

(* 문법에서 문장을 만들어 손 파서가 받는지 본다 *)
let fuzz n =
  let g =
    match Coollang.Ebnf.parse_result (read "docs/grammar.ebnf") with
    | Ok g -> g
    | Error e -> failwith (Printf.sprintf "문법 %d행: %s" e.line e.msg)
  in
  let tokens =
    [ "ident"; "int_lit"; "string_lit"; "NEWLINE"; "char"; "digit"; "letter" ]
  in
  let bad = ref 0 in
  let visited = Hashtbl.create 128 in
  for i = 1 to n do
    Random.init i;
    let toks = Coollang.Ebnf_gen.sentence ~tokens ~visited ~max_depth:18 g in
    match Coollang.Parser.parse_result toks with
    | Ok _ -> ()
    | Error e ->
        incr bad;
        if !bad <= 5 then begin
          Printf.printf "\n[%d] 문법은 만들었는데 파서가 거부: %s\n  " i e.msg;
          List.iter
            (fun (t : Coollang.Token.t) ->
              match t.kind with
              | Coollang.Token.Eof -> ()
              | Coollang.Token.Newline -> print_string "\\n "
              | k -> Printf.printf "%s " (Coollang.Token.show_kind k))
            toks;
          print_newline ()
        end
  done;
  Printf.printf "\n문장 %d개 중 파서가 거부한 것 %d개\n" n !bad;
  (* 어휘 층은 파서 문법에서 도달할 수 없다 — 분모에서 뺀다 *)
  let lexical =
    [
      "ident";
      "int_lit";
      "string_lit";
      "str_char";
      "escape";
      "bool_lit";
      "literal";
    ]
  in
  let all =
    Coollang.Ebnf.expand g
    |> List.map (fun (r : Coollang.Ebnf.rule) -> r.name)
    |> List.sort_uniq compare
    |> List.filter (fun r -> not (List.mem r lexical))
  in
  let unvisited = List.filter (fun r -> not (Hashtbl.mem visited r)) all in
  Printf.printf "프로덕션 %d개 중 %d개를 밟았다\n" (List.length all)
    (List.length all - List.length unvisited);
  if unvisited <> [] then
    Printf.printf "밟지 않은 것: %s\n" (String.concat " " unvisited);
  if !bad > 0 then exit 1

let () =
  if Array.length Sys.argv > 1 && Sys.argv.(1) = "--dump" then (
    let g =
      match Coollang.Ebnf.parse_result (read "docs/grammar.ebnf") with
      | Ok g -> g
      | Error e -> failwith (string_of_int e.line)
    in
    let tokens =
      [ "ident"; "int_lit"; "string_lit"; "NEWLINE"; "char"; "digit"; "letter" ]
    in
    for i = 1 to 8 do
      Random.init i;
      let toks = Coollang.Ebnf_gen.sentence ~tokens g in
      Printf.printf "[%d] (%d토큰) " i (List.length toks);
      List.iter
        (fun (t : Coollang.Token.t) ->
          match t.kind with
          | Coollang.Token.Eof -> ()
          | Coollang.Token.Newline -> print_string "\\n "
          | k -> Printf.printf "%s " (Coollang.Token.show_kind k))
        toks;
      print_newline ()
    done;
    exit 0);
  if Array.length Sys.argv > 1 && Sys.argv.(1) = "--fuzz" then (
    fuzz (if Array.length Sys.argv > 2 then int_of_string Sys.argv.(2) else 200);
    exit 0);
  if Array.length Sys.argv > 2 && Sys.argv.(1) = "--compare" then (
    compare_files
      (Array.to_list (Array.sub Sys.argv 2 (Array.length Sys.argv - 2)));
    exit 0);
  if Array.length Sys.argv > 1 && Sys.argv.(1) = "--lexical" then (
    print_string (Coollang.Lexical_doc.render ());
    print_newline ();
    exit 0);
  let file =
    if Array.length Sys.argv > 1 then Sys.argv.(1) else "docs/grammar.ebnf"
  in
  match Coollang.Ebnf.parse_result (read file) with
  | Error e -> Printf.printf "%s:%d: %s\n" file e.line e.msg
  | Ok g ->
      Printf.printf "프로덕션 %d개\n" (List.length g);
      Printf.printf "\n정의되지 않은 채 참조된 이름:\n";
      List.iter (fun n -> Printf.printf "  %s\n" n) (Coollang.Ebnf.undefined g);
      Printf.printf "\n어디서도 참조되지 않는 프로덕션 (시작 기호 module 제외):\n";
      List.iter
        (fun n -> Printf.printf "  %s\n" n)
        (Coollang.Ebnf.unreachable g ~start:"module");
      (* 문법이 쓰는 단말 전부. 렉서가 만드는 토큰과 대조하기 위한 것. *)
      let terms = Hashtbl.create 64 in
      let rec walk : Coollang.Ebnf.expr -> unit = function
        | Term s -> Hashtbl.replace terms s ()
        | Ref _ | RefArg _ -> ()
        | Seq xs | Alt xs -> List.iter walk xs
        | Opt e | Rep e -> walk e
        | Except (a, b) ->
            walk a;
            walk b
      in
      List.iter (fun (r : Coollang.Ebnf.rule) -> walk r.body) g;
      let ts =
        Hashtbl.fold (fun k () acc -> k :: acc) terms [] |> List.sort compare
      in
      Printf.printf "\n문법이 쓰는 단말 %d개:\n  %s\n" (List.length ts)
        (String.concat " " ts);
      (* 어휘 절의 이름은 파서 층에서 단말이다 *)
      let tokens =
        [
          "ident"; "int_lit"; "string_lit"; "NEWLINE"; "letter"; "digit"; "char";
        ]
      in
      let g = Coollang.Ebnf.expand g in
      let a = Coollang.Ebnf.analyze ~tokens g in
      Printf.printf "\n비어도 되는(nullable) 프로덕션:\n  %s\n"
        (String.concat " "
           (List.filter_map
              (fun (r : Coollang.Ebnf.rule) ->
                if Coollang.Ebnf.nullable a r.name then Some r.name else None)
              g));
      Printf.printf "\nFIRST 표본:\n";
      List.iter
        (fun n ->
          Printf.printf "  %-14s %s\n" n
            (String.concat " "
               (Coollang.Ebnf.SS.elements (Coollang.Ebnf.first a n))))
        [ "decl"; "stmt"; "primary"; "type"; "pattern"; "item" ];
      let cs = Coollang.Ebnf.conflicts ~tokens ~greedy:[ "NEWLINE" ] g in
      let real =
        List.filter (fun (c : Coollang.Ebnf.conflict) -> not c.c_greedy) cs
      in
      let soft =
        List.filter (fun (c : Coollang.Ebnf.conflict) -> c.c_greedy) cs
      in
      Printf.printf "\n== LL(1) 충돌: 진짜 %d건, greedy로 해소 %d건 ==\n"
        (List.length real) (List.length soft);
      List.iter
        (fun (c : Coollang.Ebnf.conflict) ->
          Printf.printf "\n%s (%s:%d) [%s]\n  겹치는 토큰: %s\n  %s\n" c.c_rule file
            c.c_line c.c_kind
            (String.concat " " c.c_tokens)
            c.c_detail)
        real;
      if soft <> [] then begin
        Printf.printf "\n-- greedy로 해소되는 것 --\n";
        List.iter
          (fun (c : Coollang.Ebnf.conflict) ->
            Printf.printf "  %s:%d %s [%s]\n" file c.c_line c.c_rule
              (String.concat " " c.c_tokens))
          soft
      end