diff --git a/bin/main.ml b/bin/main.ml index 2cc659f..893577d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -3,6 +3,7 @@ let usage = 사용법: coolc check ... 타입/effect/capability 검사 (import를 따라 모듈 그래프 전체) + coolc test [필터] 모듈 그래프의 test 블록 실행 coolc iface interface 표면과 해시 출력 coolc run [인자...] typed IR 인터프리터로 실행 coolc tokens 토큰 덤프 (렉서 디버깅) @@ -76,6 +77,35 @@ let () = match List.tl argv with | "check" :: files -> check_graph files | [ "iface"; file ] -> dump_iface file + | "test" :: file :: rest -> ( + let filter = match rest with f :: _ -> f | [] -> "" in + let st = Coollang.Session.create ~root:(Filename.dirname file) () in + match Coollang.Session.test ~filter st file with + | Error errors -> + List.iter + (fun e -> prerr_endline (Coollang.Session.string_of_error e)) + errors; + 1 + | Ok results -> + let failed = + List.filter + (fun (r : Coollang.Interp.test_result) -> r.t_failure <> None) + results + in + List.iter + (fun (r : Coollang.Interp.test_result) -> + match r.t_failure with + | None -> () + | Some (p, msg) -> + Printf.printf "FAIL %s:%d %s\n %s\n" r.t_module + r.t_pos.line r.t_name msg; + ignore p) + results; + Printf.printf "%s 테스트 %d개 중 %d개 통과\n" + (if failed = [] then "ok " else "실패") + (List.length results) + (List.length results - List.length failed); + if failed = [] then 0 else 1) | "run" :: file :: args -> ( let st = Coollang.Session.create ~root:(Filename.dirname file) () in match Coollang.Session.run ~args st file with diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index 0222e88..1372735 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -55,7 +55,7 @@ * "pub" | "fn" | "struct" | "enum" | "capability" | "const" | * "import" | "as" | "reexport" | "let" | "mut" | "own" | "affine" | * "copyable" | "effects" | "return" | "if" | "else" | "match" | - * "scope" | "true" | "false" + * "scope" | "panic" | "test" | "true" | "false" (* 생성 끝 *) * * 다중 줄 목록(파라미터, 인자, 필드, variant, 리스트 리터럴)은 후행 콤마가 @@ -98,11 +98,20 @@ brace_rest = [ NEWLINE ] , (* ------------------------------------------------------------------ *) module = [ NEWLINE ] , { item } ; -item = ( import | reexport | decl ) , [ NEWLINE ] ; +item = ( import | reexport | test_decl | decl ) , [ NEWLINE ] ; import = "import" , string_lit , "as" , ident ; reexport = "reexport" , ident ; +(* 테스트는 프로그램의 일부이고 같은 검사를 받는다. pub이 없다 — 밖에서 + * 부르는 것이 아니다. 이름이 필수인 이유는 실패했을 때 무엇이 깨졌는지 + * 말해야 하기 때문이다. + * 파라미터가 없으므로 capability를 받을 수 없고, capability를 만드는 문법도 + * 없다. 따라서 테스트는 effect-free임이 증명된다 — 관례가 아니라 검사다. + * 그 결과 순서에 의존하지 않고, 병렬로 돌려도 같고, 캐시할 수 있다. + * interface hash에는 들어가지 않는다 (함수 본문과 같은 이유) *) +test_decl = "test" , string_lit , block ; + decl = [ "pub" ] , ( fn_decl | struct_decl | enum_decl | capability_decl | const_decl ) ; @@ -235,8 +244,26 @@ primary = literal | match_expr | scope_expr | "(" , expr , ")" + | panic_expr | name_or_struct ; +(* panic은 복구 불가능한 실패다. 되돌아올 수 없으므로 타입이 Never이고, + * Never는 어떤 타입 자리에도 놓일 수 있다 — 그래야 match 팔에서 쓸 수 있다. + * + * effect가 아니다. 경계 검사 하나 넣었다고 {Panic}이 호출자 전부로 + * 전염되면 effect 절은 신호가 아니라 잡음이 된다. 발산이 effect가 아닌 + * 것과 같은 이유다 — 무한 루프도 추적하지 않는다. + * + * 언어 수준 recover가 없다. 붙잡는 것이 있으면 그것은 예외이고, 예외는 + * 시그니처에 안 적히므로 철학 1과 충돌한다. 런타임은 격리 경계를 가질 수 + * 있다 (테스트 러너가 첫 사례). + * + * 되감기를 하지 않는다. panic 시 자원 해제 여부는 자원 모델과 함께 + * 결정한다 — 지금은 열어둔다. + * + * 키워드인 이유: prelude가 없어서 함수로 두면 쓸 때마다 import해야 한다 *) +panic_expr = "panic" , "(" , expr , ")" ; + (* ident 하나로는 이름인지 struct 리터럴인지 갈리지 않는다. "{"를 보고 * 갈리므로 왼쪽으로 인수분해해 적는다 — 파서가 실제로 하는 일이다 *) name_or_struct = ident , [ struct_body ] ; diff --git a/docs/thesis.md b/docs/thesis.md index 0b353eb..627ee9c 100644 --- a/docs/thesis.md +++ b/docs/thesis.md @@ -338,6 +338,40 @@ L2 빠른 테스트 / L3 fuzzing / L4 formal proof → 요청 시, 분리 실행 invalidation 범위를 넓히는가? / unrelated code 의미를 바꾸는가? / 기존 개념의 중복 표현인가? → 강한 이유 없으면 거절 +■ 복구 불가능한 실패 — panic +panic(message) -> Never. 키워드다 (prelude가 없어 함수로 두면 매번 import). +- effect가 아니다. 경계 검사 하나에 {Panic}이 호출자 전부로 전염되면 + effect 절은 신호가 아니라 잡음이 된다. 발산이 effect가 아닌 것과 같은 + 이유다 — 무한 루프도 추적하지 않는다. +- Never는 어떤 타입 자리에도 놓인다. 그래야 match 팔에서 쓸 수 있고, + 그게 없으면 panic은 식 자리에서 못 쓴다. +- 언어 수준 recover가 없다. 붙잡는 것이 있으면 그것은 예외이고, 예외는 + 시그니처에 안 적히므로 철학 1과 충돌한다. + 런타임은 격리 경계를 가질 수 있다 — 테스트 러너가 첫 사례이고, 서버가 + 두 번째가 될 것이다. 죽은 것을 되살리는 게 아니라 죽었음을 관찰한다. +- 되감기를 하지 않는다. ※ panic 시 자원 해제 여부는 자원 모델과 함께 + 결정한다 — 지금은 열어둔다. +- 0으로 나누기, assert 실패, 미래의 범위·오버플로가 전부 이 하나로 모인다. +※ panic은 프로그램의 버그를 말한다. 예상되는 실패는 Result다. 호출자가 + 대처할 수 있는 것을 panic으로 처리하면 오용이다. + +■ 내장 테스트 +test "이름" { ... }. 파라미터가 없으므로 capability를 받을 수 없고, +capability를 만드는 문법도 없다. 따라서 effect-free임이 증명된다 — +관례가 아니라 검사다. 그 결과: +- 파일도 시계도 못 건드린다. 같은 입력이면 같은 결과다 +- 순서에 의존하지 않고 병렬로 돌려도 같다 → 결과를 캐시할 수 있다 + (인터페이스 해시가 안 변하면 재검사하지 않는 것과 같은 논리) +- 자원을 가질 수 없다 (획득에 effect가 필요하므로). 그래서 "테스트가 + 죽으면 자원은?"이라는 질문이 애초에 생기지 않는다 +interface hash에 들어가지 않는다 — 테스트를 고쳤다고 downstream이 +재검사되면 안 된다. +컴파일 타임 메타프로그래밍 없음. assert는 std/test.cool에 coollang으로 +쓰인다 (panic 위의 설탕) — std에서 본문이 있는 첫 함수다. 실패 메시지에 +값이 안 나오는 것은 의도다. 표현식 텍스트를 잡으려면 매크로가 필요하다. +※ effect 있는 코드는 테스트할 수 없다. 가짜 capability를 만드는 수단이 + 없기 때문이다. 실제로 불편해진 뒤에 판단한다. + ■ lint (오류다, 경고가 아니다) - 미사용 import: 쓰지 않는 모듈의 시그니처가 바뀌면 이 모듈이 재검사된다. 증분 루프의 비용을 이유 없이 넓히는 선언은 남겨둘 수 없다. diff --git a/lib/ast.ml b/lib/ast.ml index ddd365f..a7b3821 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -74,6 +74,8 @@ type expr = | E_inst of { callee : expr; args : targ list; pos : pos } | E_try of { inner : expr; pos : pos } | E_unary of { op : unop; operand : expr; pos : pos } + (* 복구 불가능한 실패. 타입은 Never — 돌아오지 않으므로 어떤 자리에도 놓인다 *) + | E_panic of { msg : expr; pos : pos } | E_binary of { op : binop; lhs : expr; rhs : expr; pos : pos } and closure = { @@ -148,6 +150,9 @@ type item = pos : pos; } | I_const of { pub : bool; name : string; ty : ty; value : expr; pos : pos } + (* 테스트. 파라미터가 없으므로 capability를 받을 수 없고, 그래서 + effect-free임이 증명된다 — 관례가 아니라 검사다 *) + | I_test of { name : string; body : block; pos : pos } type modul = { items : item list } @@ -244,6 +249,10 @@ let binop_name = function let rec buf_expr b = function | E_lit (l, _) -> buf_lit b l + | E_panic { msg; _ } -> + Buffer.add_string b "(panic "; + buf_expr b msg; + Buffer.add_char b ')' | E_ident (n, _) -> Buffer.add_string b n | E_list (xs, _) -> Buffer.add_string b "(list"; @@ -468,6 +477,10 @@ let buf_item b = function Buffer.add_char b ' '; buf_expr b value; Buffer.add_char b ')' + | I_test { name; body; _ } -> + Buffer.add_string b ("(test \"" ^ name ^ "\" "); + buf_block b body; + Buffer.add_char b ')' let show_item item = let b = Buffer.create 256 in diff --git a/lib/ebnf.ml b/lib/ebnf.ml index 305eb1d..49ac05f 100644 --- a/lib/ebnf.ml +++ b/lib/ebnf.ml @@ -88,7 +88,8 @@ let tokenize (src : string) : (tok * int) array = let start = !i + 1 in incr i; while !i < n && src.[!i] <> quote do - if src.[!i] = '\n' then raise (Error { line = !line; msg = "단말이 닫히지 않았습니다" }); + if src.[!i] = '\n' then + raise (Error { line = !line; msg = "단말이 닫히지 않았습니다" }); incr i done; if !i >= n then raise (Error { line = !line; msg = "단말이 닫히지 않았습니다" }); @@ -115,7 +116,7 @@ let tokenize (src : string) : (tok * int) array = emit t; incr i in - (match c with + match c with | '=' -> single T_eq | ';' -> single T_semi | ',' -> single T_comma @@ -130,9 +131,7 @@ let tokenize (src : string) : (tok * int) array = | '<' -> single T_lt | '>' -> single T_gt | _ -> - raise - (Error - { line = !line; msg = Printf.sprintf "알 수 없는 문자 %c" c })) + raise (Error { line = !line; msg = Printf.sprintf "알 수 없는 문자 %c" c }) end done; emit T_eof; @@ -147,12 +146,10 @@ type state = { toks : (tok * int) array; mutable p : int } let cur st = fst st.toks.(st.p) let line st = snd st.toks.(st.p) let adv st = if st.p < Array.length st.toks - 1 then st.p <- st.p + 1 - let fail st msg = raise (Error { line = line st; msg }) let eat st t what = - if cur st = t then adv st - else fail st (Printf.sprintf "%s이(가) 필요합니다" what) + if cur st = t then adv st else fail st (Printf.sprintf "%s이(가) 필요합니다" what) (* alt := seq { "|" seq } *) let rec parse_alt st = @@ -265,7 +262,8 @@ let parse (src : string) : t = done; List.rev !rules -let parse_result src = match parse src with r -> Ok r | exception Error e -> Error e +let parse_result src = + match parse src with r -> Ok r | exception Error e -> Error e (* ------------------------------------------------------------------ *) (* 조회 *) @@ -280,7 +278,8 @@ let undefined (g : t) : string list = let seen = Hashtbl.create 32 in let rec walk = function | Ref n -> if not (List.mem n defined) then Hashtbl.replace seen n () - | RefArg (n, _) -> if not (List.mem n defined) then Hashtbl.replace seen n () + | RefArg (n, _) -> + if not (List.mem n defined) then Hashtbl.replace seen n () | Term _ -> () | Seq xs | Alt xs -> List.iter walk xs | Opt e | Rep e -> walk e @@ -309,7 +308,8 @@ let unreachable (g : t) ~(start : string) : string list = in List.iter (fun r -> walk r.body) g; List.filter_map - (fun r -> if r.name = start || Hashtbl.mem used r.name then None else Some r.name) + (fun r -> + if r.name = start || Hashtbl.mem used r.name then None else Some r.name) g let rec show_expr = function @@ -326,7 +326,9 @@ and show_paren e = match e with Alt _ | Seq _ -> "( " ^ show_expr e ^ " )" | _ -> show_expr e let show_rule r = - let ps = if r.params = [] then "" else "<" ^ String.concat ", " r.params ^ ">" in + let ps = + if r.params = [] then "" else "<" ^ String.concat ", " r.params ^ ">" + in r.name ^ ps ^ " = " ^ show_expr r.body ^ " ;" (* ------------------------------------------------------------------ *) @@ -356,13 +358,13 @@ let expand (g : t) : t = | Term _ -> e (* 매개변수 이름이 그대로 참조된 자리도 인자로 바꾼다: list의 item *) | Ref n -> ( match List.assoc_opt n env with Some v -> Ref v | None -> e) - | RefArg (n, a) -> + | RefArg (n, a) -> ( let a = match List.assoc_opt a env with Some v -> v | None -> a in - (match by_name_arg n a with + match by_name_arg n a with | Some r when r.params <> [] -> let key = (n, a) in - if not (Hashtbl.mem out (mangle n a)) && not (List.mem key !queue) then - queue := key :: !queue; + if (not (Hashtbl.mem out (mangle n a))) && not (List.mem key !queue) + then queue := key :: !queue; Ref (mangle n a) | _ -> Ref n) | Seq xs -> Seq (List.map (subst env) xs) @@ -398,8 +400,9 @@ let expand (g : t) : t = else Hashtbl.fold (fun k v acc -> - if String.length k > String.length r.name - && String.sub k 0 (String.length r.name + 1) = r.name ^ "<" + if + String.length k > String.length r.name + && String.sub k 0 (String.length r.name + 1) = r.name ^ "<" then v :: acc else acc) out [] @@ -429,7 +432,8 @@ let is_token a n = SS.mem n a.tokens || find a.rules n = None let rec nullable_expr a = function | Term _ -> false - | Ref n -> if is_token a n then false else Hashtbl.find_opt a.nullable n = Some true + | Ref n -> + if is_token a n then false else Hashtbl.find_opt a.nullable n = Some true | RefArg (n, x) -> nullable_expr a (Ref (mangle n x)) | Seq xs -> List.for_all (nullable_expr a) xs | Alt xs -> List.exists (nullable_expr a) xs @@ -438,11 +442,13 @@ let rec nullable_expr a = function let rec first_expr a = function | Term s -> SS.singleton s - | Ref n -> + | Ref n -> ( if is_token a n then SS.singleton n - else ( match Hashtbl.find_opt a.first n with Some s -> s | None -> SS.empty) + else + match Hashtbl.find_opt a.first n with Some s -> s | None -> SS.empty) | RefArg (n, x) -> first_expr a (Ref (mangle n x)) - | Alt xs -> List.fold_left (fun acc x -> SS.union acc (first_expr a x)) SS.empty xs + | Alt xs -> + List.fold_left (fun acc x -> SS.union acc (first_expr a x)) SS.empty xs | Opt x | Rep x -> first_expr a x | Except (x, _) -> first_expr a x | Seq xs -> @@ -476,7 +482,11 @@ let analyze ?(tokens = []) (g : t) : analysis = Hashtbl.replace a.nullable r.name true; changed := true); let f = first_expr a r.body in - let old = match Hashtbl.find_opt a.first r.name with Some s -> s | None -> SS.empty in + let old = + match Hashtbl.find_opt a.first r.name with + | Some s -> s + | None -> SS.empty + in if not (SS.equal f old) then ( Hashtbl.replace a.first r.name (SS.union old f); changed := true)) @@ -498,10 +508,12 @@ let nullable a name = Hashtbl.find_opt a.nullable name = Some true type follow_env = { a : analysis; fol : (string, SS.t) Hashtbl.t; - mutable deps : (string * string) list; (* (n, owner): follow n ⊇ follow owner *) + mutable deps : (string * string) list; + (* (n, owner): follow n ⊇ follow owner *) } -let get_fol e n = match Hashtbl.find_opt e.fol n with Some s -> s | None -> SS.empty +let get_fol e n = + match Hashtbl.find_opt e.fol n with Some s -> s | None -> SS.empty let rec collect e owner expr (cont : SS.t) (cont_end : bool) = match expr with @@ -576,13 +588,18 @@ let conflicts ?(tokens = []) ?(greedy = []) (g : t) : conflict list = c_tokens = toks; c_detail = detail; (* 선택/반복만 greedy로 해소된다. 대안(Alt) 충돌은 못 덮는다 *) - c_greedy = kind <> "선택" && List.for_all (fun t -> List.mem t greedy) toks; + c_greedy = + kind <> "선택" && List.for_all (fun t -> List.mem t greedy) toks; } :: !out in let rec walk r expr (cont : SS.t) (cont_end : bool) = let cont_full = - if cont_end then SS.union cont (match Hashtbl.find_opt fol r.name with Some s -> s | None -> SS.empty) + if cont_end then + SS.union cont + (match Hashtbl.find_opt fol r.name with + | Some s -> s + | None -> SS.empty) else cont in match expr with @@ -592,12 +609,13 @@ let conflicts ?(tokens = []) ?(greedy = []) (g : t) : conflict list = let n = List.length xs in for i = 0 to n - 1 do for j = i + 1 to n - 1 do - let fi = first_expr a (List.nth xs i) and fj = first_expr a (List.nth xs j) in + let fi = first_expr a (List.nth xs i) + and fj = first_expr a (List.nth xs j) in let inter = SS.inter fi fj in if not (SS.is_empty inter) then add r "선택" (SS.elements inter) - (Printf.sprintf "%d번째와 %d번째 대안이 같은 토큰으로 시작합니다: %s / %s" - (i + 1) (j + 1) + (Printf.sprintf "%d번째와 %d번째 대안이 같은 토큰으로 시작합니다: %s / %s" (i + 1) + (j + 1) (show_expr (List.nth xs i)) (show_expr (List.nth xs j))) done diff --git a/lib/ebnf_gen.ml b/lib/ebnf_gen.ml index f344530..f5e2efa 100644 --- a/lib/ebnf_gen.ml +++ b/lib/ebnf_gen.ml @@ -16,7 +16,9 @@ let min_len (g : Ebnf.t) (tokens : string list) : (string, int) Hashtbl.t = 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) + 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 @@ -88,10 +90,12 @@ 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 -> + 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 ( + else match Hashtbl.find_opt g.rules n with | Some r -> Hashtbl.replace g.visited n (); @@ -106,7 +110,9 @@ let rec gen_expr g (e : Ebnf.expr) = 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 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 @@ -144,5 +150,5 @@ let sentence ?(tokens = []) ?(start = "module") ?(max_depth = 14) ?visited 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) + 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/iface.ml b/lib/iface.ml index 4294c8f..cb91197 100644 --- a/lib/iface.ml +++ b/lib/iface.ml @@ -25,6 +25,9 @@ let is_exported = function | I_capability { pub; _ } -> pub | I_const { pub; _ } -> pub | I_reexport _ -> true + (* 테스트는 표면이 아니다. 테스트를 고쳤다고 downstream이 재검사되면 + 안 된다 — 함수 본문과 같은 이유다 *) + | I_test _ -> false | I_import _ -> false let strip = function @@ -38,6 +41,7 @@ let item_name = function | I_capability { name; _ } -> name | I_const { name; _ } -> name | I_reexport { name; _ } -> name + | I_test { name; _ } -> name | I_import { alias; _ } -> alias (* reexport는 이름이 아니라 해소된 정의 본문이 hash에 들어간다. diff --git a/lib/interp.ml b/lib/interp.ml index 860ec68..6e5cc63 100644 --- a/lib/interp.ml +++ b/lib/interp.ml @@ -320,6 +320,8 @@ let rec eval st (env : env) (e : Ir.t) : value = | [ f ] -> apply st pos f [] | _ -> fail pos "spawn은 함수 하나를 받습니다") | other -> fail pos (Printf.sprintf "%s에는 필드가 없습니다" (show other))) + | Ir.I_panic (msg, pos) -> ( + match eval st env msg with VStr s -> fail pos s | v -> fail pos (show v)) | Ir.I_unary (op, e, pos) -> ( match (op, eval st env e) with | Ast.U_not, VBool b -> VBool (not b) @@ -488,8 +490,8 @@ and eval_binary st env op a b pos = print는 실제로 일어난 effect다. 일어난 일을 안 보여주면 "어디까지 갔나"를 알 수 없고, 그게 실패했을 때 가장 먼저 보고 싶은 것이다. *) let run ?(args = []) (prog : Ir.program) (entry : string) - (main_params : (string * string) list) : string * (Token.pos * string) option - = + (main_params : (string * string) list) : + string * (Token.pos * string) option = Buffer.clear out; argv := args; let st = { prog } in @@ -515,3 +517,37 @@ let run ?(args = []) (prog : Ir.program) (entry : string) with | Fail (pos, msg) -> (Buffer.contents out, Some (pos, msg)) | Return_exc _ -> (Buffer.contents out, None))) + +(* ------------------------------------------------------------------ *) +(* 테스트 러너 *) +(* *) +(* 격리는 런타임의 일이지 언어의 일이 아니다. 언어에는 recover가 없고, *) +(* 러너는 죽은 것을 되살리는 것이 아니라 죽었다는 사실을 관찰하고 다음 *) +(* 으로 간다 — 프로세스 경계에 가깝다. *) +(* *) +(* 테스트가 effect-free임은 검사기가 이미 보장한다. 그래서 순서에 *) +(* 의존하지 않고, 어떤 순서로 돌려도 같다. *) +(* ------------------------------------------------------------------ *) + +type test_result = { + t_module : string; + t_name : string; + t_pos : Token.pos; + t_failure : (Token.pos * string) option; +} + +let run_tests ?(filter = "") (prog : Ir.program) : test_result list = + let st = { prog } in + List.rev prog.Ir.tests + |> List.filter (fun (_, name, _, _) -> + filter = "" || find_sub name filter <> None) + |> List.map (fun (m, name, pos, body) -> + let failure = + try + ignore (eval st [ [] ] body); + None + with + | Fail (p, msg) -> Some (p, msg) + | Return_exc _ -> None + in + { t_module = m; t_name = name; t_pos = pos; t_failure = failure }) diff --git a/lib/ir.ml b/lib/ir.ml index 3f7c86f..61b443c 100644 --- a/lib/ir.ml +++ b/lib/ir.ml @@ -45,6 +45,7 @@ type t = | I_seq of stmt list * t (* 블록: 문 나열 + 꼬리 값 *) | I_call of { callee : t; args : t list; pos : pos } | I_field of { obj : t; name : string; pos : pos } + | I_panic of t * pos | I_unary of Ast.unop * t * pos | I_binary of Ast.binop * t * t * pos @@ -60,6 +61,8 @@ type fn = { fn_name : string; fn_params : string list; fn_body : t } type program = { fns : (string, fn) Hashtbl.t; + (* 테스트. (모듈 경로, 이름, 위치, 본문) *) + mutable tests : (string * string * pos * t) list; (* variant 이름 -> (enum 이름, 인자 개수) *) ctors : (string, string * int) Hashtbl.t; caps : (string, string list) Hashtbl.t; (* capability -> 메서드 이름 *) @@ -183,6 +186,7 @@ let rec lower_pat c (p : Ast.pattern) : pat = let rec lower c (e : Ast.expr) : t = match e with + | Ast.E_panic { msg; pos } -> I_panic (lower c msg, pos) | Ast.E_lit (l, _) -> I_lit l | Ast.E_ident (n, pos) -> I_ref (classify c n, pos) | Ast.E_list (xs, _) -> I_list (List.map (lower c) xs) @@ -310,6 +314,7 @@ let of_program (mods : modinfo list) : program = let prog = { fns = Hashtbl.create 64; + tests = []; ctors = Hashtbl.create 64; caps = Hashtbl.create 16; consts = Hashtbl.create 16; @@ -377,6 +382,12 @@ let of_program (mods : modinfo list) : program = | Ast.I_const { name; value; _ } -> c.locals <- []; Hashtbl.replace prog.consts (key name) (lower c value) + | Ast.I_test { name; body; pos } -> + c.locals <- []; + lpush c; + let b = lower_block c body in + lpop c; + prog.tests <- (mi.m_path, name, pos, b) :: prog.tests | _ -> ()) mi.m_ast.items) mods; diff --git a/lib/lexical_doc.ml b/lib/lexical_doc.ml index c38020a..317610c 100644 --- a/lib/lexical_doc.ml +++ b/lib/lexical_doc.ml @@ -19,7 +19,8 @@ let is_keyword (k : Token.kind) = Token.keyword (Token.show_kind k) = Some k let keywords () = List.filter_map - (fun k -> if is_keyword k then Some ("\"" ^ Token.show_kind k ^ "\"") else None) + (fun k -> + if is_keyword k then Some ("\"" ^ Token.show_kind k ^ "\"") else None) Token.all_kinds let statement_enders () = @@ -28,6 +29,7 @@ let statement_enders () = Token.all_kinds let begin_mark = "(* 여기부터 lib/token.ml에서 생성됩니다 — 손으로 고치지 마십시오 *)" + let end_mark = "(* 생성 끝 *)" (* 한 줄이 길어지지 않게 접는다. 구분자는 줄 끝에 남겨 이어짐이 보이게 한다 *) diff --git a/lib/move.ml b/lib/move.ml index e93a8ec..7a89c98 100644 --- a/lib/move.ml +++ b/lib/move.ml @@ -187,6 +187,10 @@ type ctx = Borrow | Move of string (* 어디로 옮겨가는지 — 진단에 let rec walk st (ctx : ctx) (e : expr) : vinfo = match e with | E_lit _ -> v_copy + (* panic은 돌아오지 않지만 메시지 식은 계산된다. 메시지는 빌려 쓴다 *) + | E_panic { msg; _ } -> + ignore (walk st Borrow msg); + v_copy | E_ident (n, pos) -> ( match find st n with | None -> v_copy @@ -463,7 +467,16 @@ let check ?(imports : item list = []) (m : modul) : error list = | _ -> ()) (imports @ m.items); List.iter - (fun it -> match it with I_fn { decl; _ } -> check_fn st decl | _ -> ()) + (fun it -> + match it with + | I_fn { decl; _ } -> check_fn st decl + (* 테스트도 같은 검사를 받는다 *) + | I_test { body; _ } -> + st.scopes <- []; + push st; + ignore (walk_block st (Move "반환할 수") body); + pop st + | _ -> ()) m.items; List.sort (fun a b -> diff --git a/lib/parser.ml b/lib/parser.ml index aee2b2f..e52fcee 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -398,6 +398,12 @@ and parse_primary st = | Token.Kw_fn -> parse_closure st | Token.Kw_if -> parse_if st | Token.Kw_match -> parse_match st + | Token.Kw_panic -> + adv st; + expect st Token.LParen "("; + let msg = with_struct_ok st (fun () -> parse_expr st) in + expect_close st Token.RParen ")"; + E_panic { msg; pos = p } | Token.Kw_scope -> adv st; let name = ident st "새 scope 이름" in @@ -759,6 +765,16 @@ let parse_item st = adv st; let name = ident st "재수출할 이름" in I_reexport { name; pos = p } + | Token.Kw_test -> + adv st; + let name = + match kind st with + | Token.Str s -> + adv st; + s + | _ -> err_expect st "테스트 이름 (문자열)" + in + I_test { name; body = parse_block st; pos = p } | _ -> ( let pub = accept st Token.Kw_pub in match kind st with diff --git a/lib/recognize.ml b/lib/recognize.ml index 7fecd9c..2a4cac4 100644 --- a/lib/recognize.ml +++ b/lib/recognize.ml @@ -48,11 +48,11 @@ let fail st expected = (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 }; + 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) (* 이 식이 지금 토큰으로 시작할 수 있는가 *) @@ -75,8 +75,7 @@ let rec run st (e : Ebnf.expr) = | Some x -> run st x | None -> fail st - (String.concat " 또는 " - (SS.elements (Ebnf.first_expr st.a e))))) + (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 -> @@ -85,8 +84,8 @@ let rec run st (e : Ebnf.expr) = done | Ebnf.Except (x, _) -> run st x -let check ?(tokens = []) ?(start = "module") (g : Ebnf.t) (toks : Token.t list) : - (unit, error) result = +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; @@ -108,6 +107,7 @@ let check ?(tokens = []) ?(start = "module") (g : Ebnf.t) (toks : Token.t list) | Some _ -> () | None -> st.err <- - Some { pos = (cur st).Token.pos; expected = "파일 끝"; got = term st }); + 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/lib/resolve.ml b/lib/resolve.ml index d486875..6d94c7d 100644 --- a/lib/resolve.ml +++ b/lib/resolve.ml @@ -154,6 +154,7 @@ let rec resolve_pattern st seen = function let rec resolve_expr st = function | E_lit _ -> () + | E_panic { msg; _ } -> resolve_expr st msg | E_ident (n, pos) -> if lookup_local st n = None then if Hashtbl.mem st.items n then () @@ -261,8 +262,7 @@ and resolve_stmt st = function | _ -> None in match root place with - | None -> - error st pos "대입 왼쪽에는 변수나 필드만 올 수 있습니다" + | None -> error st pos "대입 왼쪽에는 변수나 필드만 올 수 있습니다" | Some n -> ( match lookup_local st n with | Some true -> () @@ -351,7 +351,7 @@ let resolve (m : modul) : info * error list = variants | I_capability { name; pos; _ } -> declare st pos name K_type | I_const { name; pos; _ } -> declare st pos name K_const - | I_reexport _ -> ()) + | I_test _ | I_reexport _ -> ()) m.items; (* 2차: 본문을 훑는다. *) List.iter @@ -379,6 +379,11 @@ let resolve (m : modul) : info * error list = resolve_ty st ty; push st; resolve_expr st value; + pop st + (* 테스트는 파라미터 없는 본문이다. 나머지는 함수와 같다 *) + | I_test { body; _ } -> + push st; + resolve_block st body; pop st) m.items; (* 미사용 import는 오류다. 취향 문제가 아니라 invalidation 표면 문제다 — diff --git a/lib/session.ml b/lib/session.ml index 4c6910d..bba830c 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -279,3 +279,17 @@ let run ?(args = []) st path : string * error option = match Interp.run ~args prog path (main_params e.ast) with | out, None -> (out, None) | out, Some (pos, msg) -> (out, Some (err_of path pos msg))) + +(* 모듈 그래프를 로드하고 그 안의 테스트를 전부 돌린다 *) +let test ?(filter = "") st path : (Interp.test_result list, error list) result = + load st path; + let errs = errors st in + if errs <> [] then Error errs + else + let mods = + Hashtbl.fold + (fun p (d : entry) acc -> + { Ir.m_path = p; m_ast = d.ast; m_deps = d.imports } :: acc) + st.modules [] + in + Ok (Interp.run_tests ~filter (Ir.of_program mods)) diff --git a/lib/token.ml b/lib/token.ml index 7bd885c..7e1489b 100644 --- a/lib/token.ml +++ b/lib/token.ml @@ -28,6 +28,8 @@ type kind = | Kw_else | Kw_match | Kw_scope + | Kw_panic + | Kw_test | Kw_true | Kw_false (* 구두점 *) @@ -87,6 +89,8 @@ let keyword = function | "else" -> Some Kw_else | "match" -> Some Kw_match | "scope" -> Some Kw_scope + | "panic" -> Some Kw_panic + | "test" -> Some Kw_test | "true" -> Some Kw_true | "false" -> Some Kw_false | _ -> None @@ -115,6 +119,8 @@ let show_kind = function | Kw_else -> "else" | Kw_match -> "match" | Kw_scope -> "scope" + | Kw_panic -> "panic" + | Kw_test -> "test" | Kw_true -> "true" | Kw_false -> "false" | LParen -> "(" @@ -178,7 +184,9 @@ let next_kind = function | Kw_if -> Some Kw_else | Kw_else -> Some Kw_match | Kw_match -> Some Kw_scope - | Kw_scope -> Some Kw_true + | Kw_scope -> Some Kw_panic + | Kw_panic -> Some Kw_test + | Kw_test -> Some Kw_true | Kw_true -> Some Kw_false | Kw_false -> Some LParen | LParen -> Some RParen @@ -215,7 +223,9 @@ let next_kind = function let all_kinds = let rec go k acc = - match next_kind k with None -> List.rev (k :: acc) | Some n -> go n (k :: acc) + match next_kind k with + | None -> List.rev (k :: acc) + | Some n -> go n (k :: acc) in go (Ident "") [] diff --git a/lib/typecheck.ml b/lib/typecheck.ml index 43a22e8..af9d499 100644 --- a/lib/typecheck.ml +++ b/lib/typecheck.ml @@ -164,6 +164,12 @@ let builtin_ctor = function let rec infer env (e : expr) : T.t = match e with + (* panic은 돌아오지 않는다. 타입은 Never이고 어떤 자리에도 놓인다 *) + | E_panic { msg; pos } -> + let t = infer env msg in + if not (T.unify t T.TString) then + mismatch env pos T.TString t "panic의 메시지"; + T.TNever | E_lit (L_int _, _) -> T.TInt | E_lit (L_str _, _) -> T.TString | E_lit (L_bool _, _) -> T.TBool @@ -823,6 +829,27 @@ let check ?(imports : item list = []) (m : modul) : error list = let want = conv env [] ty in let got = infer env value in if not (T.unify want got) then mismatch env pos want got "상수의 값" + (* 테스트는 파라미터 없고 effect 없는 함수와 같다. 검사도 같다 — + 일반 코드와 다른 규칙을 주면 테스트만 통과하는 코드가 생긴다 *) + | I_test { name; body; pos } -> + env.locals <- []; + push env; + env.ret <- T.TUnit; + env.performed <- []; + env.saw_unknown <- false; + let got = infer_block env body in + if not (T.unify T.TUnit got) then + mismatch env pos T.TUnit got (Printf.sprintf "테스트 \"%s\"의 본문" name); + List.iter + (fun (a, apos) -> + err env apos + (Printf.sprintf + "테스트는 effect를 수행할 수 없습니다 (%s) — 테스트는 capability를 받지 않습니다" + (T.atom_show a))) + (List.rev (T.eff_resolve (List.map fst env.performed)) + |> List.map (fun a -> (a, pos))); + env.performed <- []; + pop env | _ -> ()) m.items; List.sort diff --git a/lib/types.ml b/lib/types.ml index ae7f094..b98752b 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -10,6 +10,10 @@ type t = | TUnknown + (* 값을 내지 않는 타입. panic의 타입이고 어떤 자리에도 놓일 수 있다. + TUnknown과 다르다 — TUnknown은 "모른다"이고 TNever는 "돌아오지 + 않는다"이다. 둘 다 무엇과도 맞지만 생기는 이유가 다르다. *) + | TNever | TInt | TBool | TString @@ -97,6 +101,7 @@ let eff_missing ~declared ~performed = let rec show t = match resolve t with | TUnknown -> "?" + | TNever -> "Never" | TInt -> "Int" | TBool -> "Bool" | TString -> "String" @@ -136,6 +141,8 @@ let unify_eff a b = let rec unify a b = match (resolve a, resolve b) with | TUnknown, _ | _, TUnknown -> true + (* Never는 어떤 타입 자리에도 놓인다. panic이 match 팔에 설 수 있는 이유다 *) + | TNever, _ | _, TNever -> true | TMeta r, TMeta r' when r == r' -> true | TMeta r, t | t, TMeta r -> if occurs r t then false diff --git a/samples/app/config.cool b/samples/app/config.cool index 75aa798..ae0bab8 100644 --- a/samples/app/config.cool +++ b/samples/app/config.cool @@ -9,6 +9,7 @@ import "cool.dev/std/string" as String import "cool.dev/std/int" as Int import "cool.dev/std/option" as Option import "cool.dev/std/result" as Result +import "cool.dev/std/test" as Test // 설정 값. 타입이 셋뿐이므로 열거형이 맞다. pub enum Value { @@ -134,3 +135,32 @@ pub fn get_flag(cfg: Config, key: String) -> Result[Bool, String] { Number(_) => Err(String.concat(key, "은(는) 참거짓이 아닙니다")), } } + +// ------------------------------------------------------------------ +// 테스트. 일반 코드와 같은 검사를 받고, capability를 받지 않으므로 +// effect-free임이 증명된다 — 파일도 시계도 못 건드린다. +// ------------------------------------------------------------------ + +test "값의 타입은 모양으로 정한다" { + Test.assert(type_name(parse_value("true")) == "flag") + Test.assert(type_name(parse_value("42")) == "number") + Test.assert(type_name(parse_value("hello")) == "text") +} + +test "빈 줄과 주석은 항목이 아니다" { + let cfg = parse("\n# 주석\n\n") + Test.assert(List.is_empty(cfg.entries)) + Test.assert(List.is_empty(cfg.problems)) +} + +test "= 가 하나가 아니면 문제로 기록한다" { + let cfg = parse("a = 1\nb = c = d\n") + Test.assert(List.len(cfg.entries) == 1) + Test.assert(List.len(cfg.problems) == 1) +} + +test "없는 이름을 찾으면 Err다" { + let cfg = parse("a = 1\n") + Test.assert(!Result.is_ok(get_int(cfg, "없음"))) + Test.assert(Result.is_ok(get_int(cfg, "a"))) +} diff --git a/std/test.cool b/std/test.cool new file mode 100644 index 0000000..e4f1891 --- /dev/null +++ b/std/test.cool @@ -0,0 +1,14 @@ +// 표준 라이브러리: 테스트. +// +// assert는 특별한 것이 아니라 panic 위의 설탕이다. 그래서 본문이 있다 — +// std에서 실제 coollang으로 쓰인 첫 함수다. +// +// 실패 메시지에 값이 안 나오는 것은 의도다. `assert(a == b)`에서 a와 b를 +// 보여주려면 표현식 텍스트를 잡아야 하고 그건 매크로다. 테스트 이름과 +// 위치가 어느 것이 깨졌는지 말해준다. + +pub fn assert(c: Bool) { + if !c { + panic("assert 실패") + } +} diff --git a/test/test_coollang.ml b/test/test_coollang.ml index b92a626..5cf079a 100644 --- a/test/test_coollang.ml +++ b/test/test_coollang.ml @@ -1035,7 +1035,8 @@ let outputs ?(use = []) src expected = | out, None -> out = expected | out, Some e -> Printf.printf " (실행 오류: %s / 그때까지 출력: %S)\n" - (Session.string_of_error e) out; + (Session.string_of_error e) + out; false let () = @@ -1365,8 +1366,7 @@ let () = (Printf.sprintf "grammar.ebnf: %s는 정의되었거나 토큰 부류다" n) (List.mem n allowed)) undef; - check "grammar.ebnf에 죽은 프로덕션이 없다" - (Ebnf.unreachable g ~start:"module" = []); + check "grammar.ebnf에 죽은 프로덕션이 없다" (Ebnf.unreachable g ~start:"module" = []); let g = Ebnf.expand g in let tokens = allowed @ [ "ident"; "int_lit"; "string_lit" ] in let real = @@ -1434,7 +1434,13 @@ let () = |> List.sort compare |> List.map (Filename.concat dir) with Sys_error _ -> []) - [ "../samples"; "../samples/modules"; "../samples/run"; "../samples/app"; "../std" ] + [ + "../samples"; + "../samples/modules"; + "../samples/run"; + "../samples/app"; + "../std"; + ] in check "대조할 파일이 있다" (List.length files > 15); List.iter @@ -1467,7 +1473,9 @@ let () = | Error _ -> () | Ok g -> let tokens = - [ "ident"; "int_lit"; "string_lit"; "NEWLINE"; "char"; "digit"; "letter" ] + [ + "ident"; "int_lit"; "string_lit"; "NEWLINE"; "char"; "digit"; "letter"; + ] in let visited = Hashtbl.create 128 in let bad = ref 0 in @@ -1486,7 +1494,15 @@ let () = done; check "문법이 만든 문장을 파서가 전부 받는다" (!bad = 0); let lexical = - [ "ident"; "int_lit"; "string_lit"; "str_char"; "escape"; "bool_lit"; "literal" ] + [ + "ident"; + "int_lit"; + "string_lit"; + "str_char"; + "escape"; + "bool_lit"; + "literal"; + ] in let all = Ebnf.expand g @@ -1498,3 +1514,110 @@ let () = if unvisited <> [] then Printf.printf " (밟지 않은 프로덕션: %s)\n" (String.concat " " unvisited); check "생성이 모든 프로덕션을 밟는다" (unvisited = []) + +(* ------------------------------------------------------------------ *) +(* panic, Never, test *) +(* ------------------------------------------------------------------ *) + +let () = + let dir = Filename.concat (Filename.get_temp_dir_name ()) "cool_panictest" in + ignore (Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir))); + let f = Filename.concat dir "m.cool" in + let run src = + write f src; + let st = Session.create ~root:dir ~std:"../std" () in + Session.test st f + in + let src = + "import \"cool.dev/std/test\" as Test\n\n\ + pub enum E {\n\ + \ A,\n\ + \ B,\n\ + }\n\n\ + pub fn name(e: E) -> String {\n\ + \ match e {\n\ + \ A => \"a\",\n\ + \ B => panic(\"B는 아직\"),\n\ + \ }\n\ + }\n\n\ + test \"통과\" {\n\ + \ Test.assert(name(A) == \"a\")\n\ + }\n\n\ + test \"assert 실패\" {\n\ + \ Test.assert(1 == 2)\n\ + }\n\n\ + test \"panic 실패\" {\n\ + \ Test.assert(name(B) == \"b\")\n\ + }" + in + match run src with + | Error es -> + List.iter + (fun (e : Session.error) -> Printf.printf " (%s)\n" e.message) + es; + check "panic/test 예제가 검사를 통과한다" false + | Ok rs -> + check "panic/test 예제가 검사를 통과한다" true; + check "테스트 셋이 잡힌다" (List.length rs = 3); + let failed = + List.filter (fun (r : Interp.test_result) -> r.t_failure <> None) rs + in + check "실패는 둘이다" (List.length failed = 2); + (* Never가 match 팔에 서지 못하면 위 예제가 타입 검사를 통과하지 못한다 *) + check "assert 실패가 보고된다" + (List.exists + (fun (r : Interp.test_result) -> + r.t_name = "assert 실패" + && + match r.t_failure with + | Some (_, m) -> has_sub m "assert 실패" + | None -> false) + rs); + check "panic 메시지가 그대로 보고된다" + (List.exists + (fun (r : Interp.test_result) -> + r.t_name = "panic 실패" + && + match r.t_failure with + | Some (_, m) -> has_sub m "B는 아직" + | None -> false) + rs); + (* 하나가 죽어도 나머지는 돈다 — 격리는 런타임의 일이다 *) + check "실패해도 다른 테스트는 돈다" + (List.exists + (fun (r : Interp.test_result) -> + r.t_name = "통과" && r.t_failure = None) + rs) + +(* 테스트는 effect를 수행할 수 없다 — capability를 받지 않으므로 증명된다 *) +let () = + let dir = Filename.concat (Filename.get_temp_dir_name ()) "cool_panictest" in + let f = Filename.concat dir "e.cool" in + write f + "pub capability Db {\n\ + \ fn read() effects {Db.read} -> Int\n\ + }\n\n\ + pub fn sneaky() effects {Db.read} -> Int\n\n\ + test \"금지\" {\n\ + \ let n = sneaky()\n\ + }"; + let st = Session.create ~root:dir ~std:"../std" () in + Session.load st f; + check "테스트는 effect를 수행할 수 없다" + (List.exists + (fun (e : Session.error) -> has_sub e.message "테스트는 effect를 수행할 수 없습니다") + (Session.errors st)) + +(* samples/app의 테스트가 실제로 돈다 *) +let () = + let st = Session.create ~root:"../samples/app" ~std:"../std" () in + match Session.test st "../samples/app/config.cool" with + | Error es -> + List.iter + (fun (e : Session.error) -> Printf.printf " (%s)\n" e.message) + es; + check "samples/app의 테스트가 돈다" false + | Ok rs -> + check "samples/app의 테스트가 돈다" (List.length rs >= 4); + check "samples/app의 테스트가 전부 통과한다" + (List.for_all (fun (r : Interp.test_result) -> r.t_failure = None) rs) diff --git a/tools/ebnf_tool.ml b/tools/ebnf_tool.ml index c2ccac7..ab496e7 100644 --- a/tools/ebnf_tool.ml +++ b/tools/ebnf_tool.ml @@ -20,8 +20,9 @@ let compare_files files = 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 -> + | 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 @@ -33,7 +34,7 @@ let compare_files files = | Error e -> Some (e.pos, Printf.sprintf "%s이(가) 필요한데 %s" e.expected e.got) in - (match (hand, spec) with + match (hand, spec) with | None, None -> () | Some _, Some _ -> () | None, Some (p, m) -> @@ -81,7 +82,17 @@ let fuzz n = done; Printf.printf "\n문장 %d개 중 파서가 거부한 것 %d개\n" n !bad; (* 어휘 층은 파서 문법에서 도달할 수 없다 — 분모에서 뺀다 *) - let lexical = [ "ident"; "int_lit"; "string_lit"; "str_char"; "escape"; "bool_lit"; "literal" ] in + 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) @@ -97,18 +108,25 @@ let fuzz n = 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 + 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; + 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); @@ -116,13 +134,16 @@ let () = 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))); + 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 + 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 -> @@ -140,15 +161,21 @@ let () = | Ref _ | RefArg _ -> () | Seq xs | Alt xs -> List.iter walk xs | Opt e | Rep e -> walk e - | Except (a, b) -> walk a; walk b + | 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 + 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" ] + [ + "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 @@ -166,8 +193,12 @@ let () = (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 + 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