diff --git a/lib/ebnf_gen.ml b/lib/ebnf_gen.ml new file mode 100644 index 0000000..f344530 --- /dev/null +++ b/lib/ebnf_gen.ml @@ -0,0 +1,148 @@ +(* 문법에서 문장을 만든다. + + 대조는 두 방향이 있다. 저장소의 .cool 파일로 하는 대조는 "사람이 쓴 코드" + 만 훑으므로, 문법이 약속했는데 파서가 못 읽는 구석은 아무도 안 밟으면 + 드러나지 않는다. 여기서는 문법이 허용하는 문장을 직접 만들어 파서에 + 먹인다 — 파서가 거부하면 둘 중 하나가 틀린 것이다. + + 텍스트가 아니라 토큰 열을 만든다. 렉서의 줄바꿈 삽입 규칙을 거치면 + 문법이 허용해도 렉서가 만들 수 없는 문장이 생기는데, 그건 파서의 잘못이 + 아니다. 검사하려는 것은 문법과 파서 사이지 렉서가 아니다. *) + +(* 최소 유도 길이. 깊이가 차면 가장 짧게 끝나는 가지를 고른다 — + 이게 없으면 재귀 문법에서 생성이 끝나지 않는다. *) +let min_len (g : Ebnf.t) (tokens : string list) : (string, int) Hashtbl.t = + let tbl = Hashtbl.create 128 in + let inf = 1_000_000 in + List.iter (fun (r : Ebnf.rule) -> Hashtbl.replace tbl r.name inf) g; + let get n = + if List.mem n tokens || not (List.exists (fun (r : Ebnf.rule) -> r.name = n) g) + then 1 + else match Hashtbl.find_opt tbl n with Some v -> v | None -> 1 + in + let cap a b = if a >= inf || b >= inf then inf else a + b in + let rec cost = function + | Ebnf.Term _ -> 1 + | Ebnf.Ref n -> get n + | Ebnf.RefArg (n, x) -> get (Ebnf.mangle n x) + | Ebnf.Seq xs -> List.fold_left (fun a x -> cap a (cost x)) 0 xs + | Ebnf.Alt xs -> List.fold_left (fun a x -> min a (cost x)) inf xs + | Ebnf.Opt _ | Ebnf.Rep _ -> 0 + | Ebnf.Except (x, _) -> cost x + in + let changed = ref true in + while !changed do + changed := false; + List.iter + (fun (r : Ebnf.rule) -> + let c = cost r.body in + if c < Hashtbl.find tbl r.name then ( + Hashtbl.replace tbl r.name c; + changed := true)) + g + done; + tbl + +type gen = { + rules : (string, Ebnf.rule) Hashtbl.t; + costs : (string, int) Hashtbl.t; + tokens : string list; + mutable out : Token.kind list; + (* 깊이로 제한한다. 총 확장 횟수로 세면 선언 머리에서 다 써 버려 정작 + 식과 문에는 도달하지 못한다 — 재미있는 구석이 전부 그 안에 있는데. *) + mutable depth : int; + max_depth : int; + (* 어느 프로덕션을 밟았는가. 퍼저가 무엇을 시험하는지 모르면 통과했다는 + 말에 값이 없다 — 안 밟은 규칙은 시험되지 않은 규칙이다. *) + visited : (string, unit) Hashtbl.t; +} + +let sample_token (n : string) : Token.kind = + match n with + | "ident" -> Token.Ident "x" + | "int_lit" -> Token.Int "1" + | "string_lit" -> Token.Str "s" + | "NEWLINE" -> Token.Newline + | _ -> Token.Ident "x" + +(* 단말 철자에서 토큰으로. 모든 토큰을 훑어 show_kind가 같은 것을 찾는다 — + 철자 표를 따로 두면 그것도 어긋난다 *) +let token_of_term (s : string) : Token.kind option = + List.find_opt (fun k -> Token.show_kind k = s) Token.all_kinds + +let emit g k = g.out <- k :: g.out + +let rec cost_of g = function + | Ebnf.Term _ -> 1 + | Ebnf.Ref n -> ( + if List.mem n g.tokens then 1 + else match Hashtbl.find_opt g.costs n with Some v -> v | None -> 1) + | Ebnf.RefArg (n, x) -> cost_of g (Ebnf.Ref (Ebnf.mangle n x)) + | Ebnf.Seq xs -> List.fold_left (fun a x -> a + cost_of g x) 0 xs + | Ebnf.Alt xs -> List.fold_left (fun a x -> min a (cost_of g x)) 1_000_000 xs + | Ebnf.Opt _ | Ebnf.Rep _ -> 0 + | Ebnf.Except (x, _) -> cost_of g x + +let deep g = g.depth >= g.max_depth + +let rec gen_expr g (e : Ebnf.expr) = + match e with + | Ebnf.Term s -> ( + match token_of_term s with Some k -> emit g k | None -> emit g (Token.Ident "x")) + | Ebnf.Ref n -> + if List.mem n g.tokens then emit g (sample_token n) + else ( + match Hashtbl.find_opt g.rules n with + | Some r -> + Hashtbl.replace g.visited n (); + g.depth <- g.depth + 1; + gen_expr g r.Ebnf.body; + g.depth <- g.depth - 1 + | None -> emit g (sample_token n)) + | Ebnf.RefArg (n, x) -> gen_expr g (Ebnf.Ref (Ebnf.mangle n x)) + | Ebnf.Seq xs -> List.iter (gen_expr g) xs + | Ebnf.Alt xs -> + let pick = + if deep g then begin + (* 깊이가 차면 가장 짧게 끝나는 가지. 같은 값이 여럿이면 무작위로 + 고른다 — 늘 첫 번째를 고르면 뒤쪽 가지가 영영 안 밟힌다 *) + let best = List.fold_left (fun a x -> min a (cost_of g x)) 1_000_000 xs in + let cands = List.filter (fun x -> cost_of g x = best) xs in + match cands with + | [] -> None + | _ -> Some (List.nth cands (Random.int (List.length cands))) + end + else Some (List.nth xs (Random.int (List.length xs))) + in + Option.iter (gen_expr g) pick + | Ebnf.Opt x -> if (not (deep g)) && Random.bool () then gen_expr g x + | Ebnf.Rep x -> + if not (deep g) then + (* 얕을수록 더 돌린다. 최상위 { item }이 0번이면 빈 파일이 된다 *) + let n = if g.depth <= 1 then 1 + Random.int 3 else Random.int 3 in + for _ = 1 to n do + gen_expr g x + done + | Ebnf.Except (x, _) -> gen_expr g x + +(* start에서 시작하는 문장 하나. 토큰 열을 돌려준다 (Eof 포함) *) +let sentence ?(tokens = []) ?(start = "module") ?(max_depth = 14) ?visited + (g : Ebnf.t) : Token.t list = + 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 = + { + rules; + costs = min_len g' tokens; + tokens; + out = []; + depth = 0; + max_depth; + visited = (match visited with Some v -> v | None -> Hashtbl.create 8); + } + in + gen_expr st (Ebnf.Ref start); + let pos = Token.{ line = 1; col = 1 } in + List.rev_map (fun k -> Token.{ kind = k; pos }) st.out + |> fun xs -> List.rev (Token.{ kind = Token.Eof; pos } :: List.rev xs) diff --git a/lib/parser.ml b/lib/parser.ml index 6481dfa..aee2b2f 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -564,16 +564,11 @@ and parse_stmt st = 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 + if accept st Token.Eq then + (* 대입 왼쪽에 무엇이 올 수 있는지는 구문이 아니라 이름 해소가 + 판정한다. 구문으로 가르면 ident 하나로 대입과 식이 갈리지 않아 + 문법이 LL(1)이 아니게 된다 (grammar.ebnf의 expr_stmt). *) + S_assign { place = e; value = parse_expr st; pos = p } else S_expr e (* ------------------------------------------------------------------ *) diff --git a/lib/resolve.ml b/lib/resolve.ml index 3695d7d..d486875 100644 --- a/lib/resolve.ml +++ b/lib/resolve.ml @@ -261,7 +261,8 @@ and resolve_stmt st = function | _ -> None in match root place with - | None -> () + | None -> + error st pos "대입 왼쪽에는 변수나 필드만 올 수 있습니다" | Some n -> ( match lookup_local st n with | Some true -> () diff --git a/test/test_coollang.ml b/test/test_coollang.ml index f1c34e9..aaf6662 100644 --- a/test/test_coollang.ml +++ b/test/test_coollang.ml @@ -327,8 +327,9 @@ let () = (parse_err "fn f(\n a: Int\n)" = Some "다중 줄 목록에는 후행 콤마가 필요합니다"); check "if 머리의 struct 리터럴" (parse_err "fn f() {\n if H { a: 1 } {\n b\n }\n}" <> None); - check "대입 왼쪽 검사" - (parse_err "fn f() {\n g() = 1\n}" = Some "대입 왼쪽에는 변수나 필드만 올 수 있습니다"); + (* 대입 왼쪽 제약은 파서가 아니라 이름 해소가 본다. 구문으로 가르면 + ident 하나로 대입과 식이 갈리지 않아 문법이 LL(1)이 아니게 된다 *) + check "대입 왼쪽은 파서가 보지 않는다" (parse_err "fn f() {\n g() = 1\n}" = None); check "한 줄에 문 두 개" (parse_err "fn f() {\n a b\n}" = Some "문 끝에 줄바꿈이 필요합니다") (* --- 괄호 안에서는 struct 리터럴이 다시 허용된다 --- *) @@ -392,6 +393,8 @@ let has_err src frag = let () = check "중복 정의" (has_err "fn f()\nfn f()" "두 번 정의"); + (* 파서에서 옮겨온 검사. 구문으로 가르면 문법이 LL(1)이 아니게 된다 *) + check "대입 왼쪽" (has_err "fn f() {\n g() = 1\n}" "대입 왼쪽에는 변수나 필드만"); check "중복 파라미터" (has_err "fn f(a: Int, a: Int)" "파라미터 a"); check "중복 제네릭" (has_err "fn f[a, a]()" "제네릭 파라미터 a"); check "선언되지 않은 effect 변수" (has_err "fn f() effects e" "선언되지 않은 effect 변수 e"); @@ -1426,3 +1429,51 @@ let () = (if spec then "받음" else "거부"); check (Filename.basename f ^ ": 문법과 파서의 판정이 같다") (hand = spec)) files + +(* 문법이 약속한 것을 파서가 실제로 읽는가. + 저장소의 .cool 파일만으로는 사람이 쓴 코드만 훑는다 — 아무도 안 밟은 + 구석은 드러나지 않는다. 문법에서 문장을 만들어 파서에 먹인다. + 커버리지를 같이 재는 이유: 안 밟은 규칙은 시험되지 않은 규칙이다. *) +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 + match Ebnf.parse_result (read "../docs/grammar.ebnf") with + | Error _ -> () + | Ok g -> + let tokens = + [ "ident"; "int_lit"; "string_lit"; "NEWLINE"; "char"; "digit"; "letter" ] + in + let visited = Hashtbl.create 128 in + let bad = ref 0 in + let shown = ref 0 in + for i = 1 to 2500 do + Random.init i; + let toks = Ebnf_gen.sentence ~tokens ~visited ~max_depth:18 g in + match Parser.parse_result toks with + | Ok _ -> () + | Error e -> + incr bad; + if !shown < 3 then begin + incr shown; + Printf.printf " (씨앗 %d: 문법은 만들었는데 파서가 거부 — %s)\n" i e.msg + end + done; + check "문법이 만든 문장을 파서가 전부 받는다" (!bad = 0); + let lexical = + [ "ident"; "int_lit"; "string_lit"; "str_char"; "escape"; "bool_lit"; "literal" ] + in + let all = + Ebnf.expand g + |> List.map (fun (r : 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 + if unvisited <> [] then + Printf.printf " (밟지 않은 프로덕션: %s)\n" (String.concat " " unvisited); + check "생성이 모든 프로덕션을 밟는다" (unvisited = []) diff --git a/tools/ebnf_tool.ml b/tools/ebnf_tool.ml index 126da80..c2ccac7 100644 --- a/tools/ebnf_tool.ml +++ b/tools/ebnf_tool.ml @@ -48,7 +48,73 @@ let compare_files 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);