diff --git a/lib/recognize.ml b/lib/recognize.ml new file mode 100644 index 0000000..7fecd9c --- /dev/null +++ b/lib/recognize.ml @@ -0,0 +1,113 @@ +(* 문법 파일이 직접 읽는 인식기. + + 손으로 쓴 파서(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 -> "" + | 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 = "" 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) diff --git a/test/test_coollang.ml b/test/test_coollang.ml index bca5956..f1c34e9 100644 --- a/test/test_coollang.ml +++ b/test/test_coollang.ml @@ -1375,3 +1375,54 @@ let () = print_endline " 현재 코드가 만드는 블록:"; print_endline block end + +(* ------------------------------------------------------------------ *) +(* 문법과 파서의 대조 *) +(* *) +(* 문법 파일에서 직접 읽는 인식기와 손으로 쓴 파서에 같은 토큰 열을 주고 *) +(* 판정이 같은지 본다. 갈리면 둘 중 하나가 틀린 것이고 빌드가 깨진다. *) +(* 이것이 설명서와 구현이 어긋나지 않게 하는 유일한 장치다 — *) +(* "문서를 잘 관리하자"는 이미 실패했다. *) +(* ------------------------------------------------------------------ *) + +let () = + let read f = + let ic = open_in_bin f in + let n = in_channel_length ic in + let s = really_input_string ic n in + close_in ic; + s + in + let g = + match 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 files = + List.concat_map + (fun dir -> + try + Sys.readdir dir |> Array.to_list + |> List.filter (fun f -> Filename.check_suffix f ".cool") + |> List.sort compare + |> List.map (Filename.concat dir) + with Sys_error _ -> []) + [ "../samples"; "../samples/modules"; "../samples/run"; "../samples/app"; "../std" ] + in + check "대조할 파일이 있다" (List.length files > 15); + List.iter + (fun f -> + match Lexer.lex_result (read f) with + | Error _ -> () + | Ok toks -> + let hand = Result.is_ok (Parser.parse_result toks) in + let spec = Result.is_ok (Recognize.check ~tokens g toks) in + if hand <> spec then + Printf.printf " (%s: 파서 %s / 문법 %s)\n" f + (if hand then "받음" else "거부") + (if spec then "받음" else "거부"); + check (Filename.basename f ^ ": 문법과 파서의 판정이 같다") (hand = spec)) + files diff --git a/tools/ebnf_tool.ml b/tools/ebnf_tool.ml index b04a2d3..126da80 100644 --- a/tools/ebnf_tool.ml +++ b/tools/ebnf_tool.ml @@ -6,7 +6,52 @@ let read file = 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 () = + 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 ();