fuzz: 문법에서 문장을 만들어 파서에 먹인다 — 갈림 하나를 잡았다

저장소의 .cool 파일로만 대조하면 사람이 쓴 코드만 훑는다. 문법이 약속했는데
파서가 못 읽는 구석은 아무도 안 밟으면 드러나지 않는다.

lib/ebnf_gen.ml이 문법에서 문장을 만든다. 텍스트가 아니라 토큰 열을 만드는
이유는, 렉서의 줄바꿈 삽입을 거치면 문법이 허용해도 렉서가 만들 수 없는
문장이 생기는데 그건 파서의 잘못이 아니기 때문이다. 검사하려는 것은 문법과
파서 사이지 렉서가 아니다.

커버리지를 같이 잰다. 안 밟은 규칙은 시험되지 않은 규칙이므로, 통과했다는
말에 값이 없다. 현재 프로덕션 95개 전부를 밟고 거부 0건이다.

이 퍼저가 잡은 갈림 하나: 대입 왼쪽 제약. 문법은 expr_stmt = expr, ["=" expr]
로 적었는데 파서는 파싱 중에 "변수나 필드만"을 강제하고 있었다. 구문으로
가르면 ident 하나로 대입과 식이 갈리지 않아 LL(1)이 깨지므로, 제약을 이름
해소로 옮겼다. 파서는 이제 순수하게 구문만 본다.

만드는 과정에서 퍼저 자체의 함정도 하나 지났다. 처음엔 연료를 총 확장
횟수로 셌더니 선언 머리에서 다 써 버려 식과 문에 도달하지 못했고, 커버리지를
재기 전까지는 "3000개 통과"가 아무 뜻도 아니었다.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_019ZVDeU6KLuUVL3gs18Hm3E

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)

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
+      if accept st Token.Eq then
-        let rec is_place = function
+        (* 대입 왼쪽에 무엇이 올 수 있는지는 구문이 아니라 이름 해소가
-          | E_ident _ -> true
+           판정한다. 구문으로 가르면 ident 하나로 대입과 식이 갈리지 않아
-          | E_field { obj; _ } -> is_place obj
+           문법이 LL(1)이 아니게 된다 (grammar.ebnf의 expr_stmt). *)
-          | _ -> false
+        S_assign { place = e; value = parse_expr st; pos = p }
-        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
 
 (* ------------------------------------------------------------------ *)

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 -> ()

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 = [])

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);