open Coollang

let failures = ref 0

let check name cond =
  if not cond then (
    incr failures;
    Printf.printf "FAIL %s\n" name)

let kinds src =
  match Lexer.lex_result src with
  | Ok ts -> List.map (fun t -> t.Token.kind) ts
  | Error e ->
      failwith
        (Printf.sprintf "예상치 못한 렉서 오류 %d:%d %s" e.pos.line e.pos.col e.msg)

let lex_error src =
  match Lexer.lex_result src with Ok _ -> None | Error e -> Some e.msg

(* --- 키워드와 이름 --- *)

let () =
  check "키워드 인식"
    (kinds "fn own affine"
    = [ Token.Kw_fn; Token.Kw_own; Token.Kw_affine; Token.Eof ]);
  check "이름은 키워드가 아니다"
    (kinds "own_er" = [ Token.Ident "own_er"; Token.Newline; Token.Eof ])

(* --- 두 글자 연산자를 먼저 본다 --- *)

let () =
  check "화살표"
    (kinds "-> => == != <= >= && ||"
    = [
        Token.Arrow;
        Token.FatArrow;
        Token.EqEq;
        Token.BangEq;
        Token.Le;
        Token.Ge;
        Token.AmpAmp;
        Token.PipePipe;
        Token.Eof;
      ]);
  check "한 글자로 갈리는 자리"
    (kinds "- = ! < > |"
    = [
        Token.Minus;
        Token.Eq;
        Token.Bang;
        Token.Lt;
        Token.Gt;
        Token.Pipe;
        Token.Eof;
      ])

(* --- NEWLINE 삽입 (grammar.ebnf 어휘 절) --- *)

let () =
  check "값으로 끝난 줄 뒤에 삽입"
    (kinds "a\nb"
    = [
        Token.Ident "a";
        Token.Newline;
        Token.Ident "b";
        Token.Newline;
        Token.Eof;
      ]);
  check "여는 괄호로 끝난 줄은 이어진다"
    (kinds "f(\na)"
    = [
        Token.Ident "f";
        Token.LParen;
        Token.Ident "a";
        Token.RParen;
        Token.Newline;
        Token.Eof;
      ]);
  check "연산자로 끝난 줄은 이어진다"
    (kinds "a +\nb"
    = [ Token.Ident "a"; Token.Plus; Token.Ident "b"; Token.Newline; Token.Eof ]
    );
  check "빈 줄은 구분자를 만들지 않는다"
    (kinds "a\n\n\nb"
    = [
        Token.Ident "a";
        Token.Newline;
        Token.Ident "b";
        Token.Newline;
        Token.Eof;
      ]);
  check "주석만 있는 줄도 마찬가지"
    (kinds "a\n// 설명\nb"
    = [
        Token.Ident "a";
        Token.Newline;
        Token.Ident "b";
        Token.Newline;
        Token.Eof;
      ]);
  check "닫는 괄호 뒤에는 삽입"
    (kinds "f()\ng()"
    = [
        Token.Ident "f";
        Token.LParen;
        Token.RParen;
        Token.Newline;
        Token.Ident "g";
        Token.LParen;
        Token.RParen;
        Token.Newline;
        Token.Eof;
      ]);
  check "? 뒤에는 삽입"
    (kinds "f()?\ng"
    = [
        Token.Ident "f";
        Token.LParen;
        Token.RParen;
        Token.Question;
        Token.Newline;
        Token.Ident "g";
        Token.Newline;
        Token.Eof;
      ]);
  check "빈 입력" (kinds "" = [ Token.Eof ])

(* --- 리터럴 --- *)

let () =
  check "정수와 밑줄"
    (kinds "1_000" = [ Token.Int "1_000"; Token.Newline; Token.Eof ]);
  check "문자열 이스케이프"
    (kinds "\"a\\nb\"" = [ Token.Str "a\nb"; Token.Newline; Token.Eof ]);
  check "밑줄 단독" (kinds "_" = [ Token.Underscore; Token.Eof ])

(* --- 오류 --- *)

let () =
  check "닫히지 않은 문자열" (lex_error "\"abc" <> None);
  check "줄바꿈 전에 닫지 않은 문자열" (lex_error "\"abc\ndef\"" <> None);
  check "알 수 없는 이스케이프" (lex_error "\"a\\qb\"" <> None);
  check "이름은 문자로 시작" (lex_error "_foo" <> None);
  check "단독 &" (lex_error "a & b" <> None);
  check "정수 뒤 글자" (lex_error "12abc" <> None);
  check "예상치 못한 문자" (lex_error "a @ b" <> None)

(* --- 오류 위치 --- *)

let () =
  match Lexer.lex_result "a\nb @ c" with
  | Ok _ -> check "위치 보고" false
  | Error e -> check "위치 보고" (e.pos.line = 2 && e.pos.col = 3)

(* --- 샘플 전체가 어휘 분석을 통과해야 한다 --- *)

let () =
  let dir = "../samples" in
  let files =
    Sys.readdir dir |> Array.to_list
    |> List.filter (fun f -> Filename.check_suffix f ".cool")
    |> List.sort compare
  in
  check "샘플이 존재한다" (List.length files >= 7);
  List.iter
    (fun f ->
      let path = Filename.concat dir f in
      match Driver.tokens path with
      | Ok ts -> check (f ^ " 어휘 분석") (List.length ts > 10)
      | Error errors ->
          List.iter
            (fun e -> Printf.printf "  %s\n" (Driver.string_of_error e))
            errors;
          check (f ^ " 어휘 분석") false)
    files

(* --- 기존 계약 --- *)

let () =
  check "버전 비어있지 않음" (String.length Version.string > 0);
  match Driver.check [] with Error [ _ ] -> () | _ -> check "빈 입력에는 오류" false

let () =
  if !failures = 0 then print_endline "ok"
  else (
    Printf.printf "%d개 실패\n" !failures;
    exit 1)

(* --- ASI 함정: effects 절이 줄 끝에 오면 } 뒤에 NEWLINE이 삽입된다.
       렉서는 이대로 두고 문법이 { NEWLINE }으로 흡수한다 (grammar.ebnf). --- *)

let () =
  check "닫는 중괄호 뒤 줄바꿈은 삽입된다"
    (kinds "effects {A.b}\n-> Int"
    = [
        Token.Kw_effects;
        Token.LBrace;
        Token.Ident "A";
        Token.Dot;
        Token.Ident "b";
        Token.RBrace;
        Token.Newline;
        Token.Arrow;
        Token.Ident "Int";
        Token.Newline;
        Token.Eof;
      ]);
  check "후행 콤마가 있으면 목록이 이어진다"
    (kinds "f(\na,\nb,\n)"
    = [
        Token.Ident "f";
        Token.LParen;
        Token.Ident "a";
        Token.Comma;
        Token.Ident "b";
        Token.Comma;
        Token.RParen;
        Token.Newline;
        Token.Eof;
      ])

(* ================================================================== *)
(* 파서                                                                *)
(* ================================================================== *)

let parse_ok src =
  match Lexer.lex_result src with
  | Error e ->
      failwith (Printf.sprintf "렉서 오류 %d:%d %s" e.pos.line e.pos.col e.msg)
  | Ok ts -> (
      match Parser.parse_result ts with
      | Ok m -> m
      | Error e ->
          failwith (Printf.sprintf "파서 오류 %d:%d %s" e.pos.line e.pos.col e.msg))

let parse_err src =
  match Lexer.lex_result src with
  | Error e -> Some e.msg
  | Ok ts -> (
      match Parser.parse_result ts with Ok _ -> None | Error e -> Some e.msg)

let one src =
  match (parse_ok src).Ast.items with
  | [ it ] -> Ast.show_item it
  | items -> Printf.sprintf "<항목 %d개>" (List.length items)

(* --- 어순: effects 절은 파라미터 뒤, 화살표 앞 --- *)

let () =
  check "함수 선언 어순"
    (one "pub fn f(a: Int) effects {A.b} -> Int {\n  a\n}"
    = "pub (fn f (a:Int) [eset A.b] -> Int (block a))");
  check "결과 위치의 effect 합집합"
    (one "fn f() effects e1 | e2" = "(fn f () [evar e1 | evar e2] decl)");
  check "함수 타입의 어순과 중첩"
    (one "fn f(g: fn(Int) effects e -> Bool) -> fn(Int) -> Int"
    = "(fn f (g:(fn (Int) [evar e] -> Bool)) -> (fn (Int) -> Int) decl)")

(* --- 대괄호 제네릭: 전위는 리터럴, 후위는 인스턴스화 --- *)

let () =
  check "타입 위치의 대괄호"
    (one "fn f(xs: List[Int]) -> Result[a, Error]"
    = "(fn f (xs:(List Int)) -> (Result a Error) decl)");
  check "식 위치의 후위 대괄호는 인스턴스화"
    (one "fn f() {\n  map[Path, Int, {A.b}](xs, g)\n}"
    = "(fn f () (block (call (inst map Path Int [eset A.b]) xs g)))");
  check "전위 대괄호는 리스트 리터럴"
    (one "fn f() {\n  let xs = [1, 2, 3]\n  xs\n}"
    = "(fn f () (block (let xs (list 1 2 3)) xs))")

(* --- 파라미터 수식어 순서 --- *)

let () =
  check "own은 이름 앞, affine은 타입 안"
    (one "fn f(own a: affine fn() effects {F.c}, mut b: Int)"
    = "(fn f (own a:(affine-fn () [eset F.c]) mut b:Int) decl)")

(* --- 선언 --- *)

let () =
  check "copyable struct"
    (one "pub copyable struct R {\n  id: Id,\n  n: Int,\n}"
    = "pub copyable (struct R (id Id) (n Int))");
  check "enum variant"
    (one "pub enum E {\n  A(Code),\n  B,\n}" = "pub (enum E (A Code) (B))");
  check "capability"
    (one "pub capability C {\n  fn m(id: Id) effects {C.m} -> R\n}"
    = "pub (capability C (fn m (id:Id) [eset C.m] -> R decl))");
  check "import와 reexport"
    (List.length (parse_ok "import \"d/p\" as P\nreexport N\n").Ast.items = 2);
  check "const" (one "pub const N: Int = 3" = "pub (const N:Int 3)")

(* --- 식 --- *)

let () =
  check "우선순위"
    (one "fn f() {\n  a + b * c == d && e\n}"
    = "(fn f () (block (&& (== (+ a (* b c)) d) e)))");
  check "postfix 연쇄"
    (one "fn f() {\n  p.q(r)?.s\n}"
    = "(fn f () (block (. (? (call (. p q) r)) s)))");
  check "if는 식"
    (one "fn f() {\n  let x = if c {\n    a\n  } else {\n    b\n  }\n  x\n}"
    = "(fn f () (block (let x (if c (block a) (block b))) x))");
  check "match"
    (one "fn f() {\n  match e {\n    A(_) => 1,\n    _ => 2,\n  }\n}"
    = "(fn f () (block (match e ((A _) => 1) (_ => 2))))");
  check "scope는 부모를 명시한다"
    (one "fn f(root: TaskScope) {\n  scope sc = root {\n    sc.spawn(g)\n  }\n}"
    = "(fn f (root:TaskScope) (block (scope sc = root (block (call (. sc \
       spawn) g)))))");
  check "struct 리터럴"
    (one "fn f() {\n  H { a: 1 }\n}" = "(fn f () (block (struct H (a 1))))")

(* --- 파서가 거부해야 하는 것 --- *)

let () =
  check "파라미터 위치의 effect 합집합"
    (parse_err "fn f(g: fn(a) effects e | {A.b})"
    = Some "파라미터 위치의 effects 절에는 합집합을 쓸 수 없습니다 (변수 단독 또는 리터럴 집합만 가능)");
  check "match 가드"
    (parse_err
       "fn f() {\n  match e {\n    A(r) if r.x => 1,\n    _ => 2,\n  }\n}"
    = Some "match 가드는 v0에 없습니다 (분기 본문에서 if를 쓰십시오)");
  check "후행 콤마 누락"
    (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 "대입 왼쪽에는 변수나 필드만 올 수 있습니다");
  check "한 줄에 문 두 개" (parse_err "fn f() {\n  a b\n}" = Some "문 끝에 줄바꿈이 필요합니다")

(* --- 괄호 안에서는 struct 리터럴이 다시 허용된다 --- *)

let () =
  check "괄호로 감싸면 if 머리에서도 가능"
    (one "fn f() {\n  if (H { a: 1 }).b {\n    c\n  }\n}"
    = "(fn f () (block (if (. (struct H (a 1)) b) (block c))))")

(* --- 샘플: 01~07은 파싱되고 08은 거부되어야 한다 --- *)

let () =
  let dir = "../samples" in
  let files =
    Sys.readdir dir |> Array.to_list
    |> List.filter (fun f -> Filename.check_suffix f ".cool")
    |> List.sort compare
  in
  List.iter
    (fun f ->
      let path = Filename.concat dir f in
      let is_syntax_error_file = f = "08_syntax_errors.cool" in
      match Driver.ast path with
      | Ok m ->
          if is_syntax_error_file then check (f ^ " 는 파서가 거부해야 한다") false
          else check (f ^ " 구문 분석") (List.length m.Ast.items > 0)
      | Error errors ->
          if is_syntax_error_file then ()
          else (
            List.iter
              (fun e -> Printf.printf "  %s\n" (Driver.string_of_error e))
              errors;
            check (f ^ " 구문 분석") false))
    files

(* ================================================================== *)
(* 이름 해소                                                           *)
(* ================================================================== *)

let resolve_errs src =
  let m = parse_ok src in
  let _, errors = Resolve.resolve m in
  List.map (fun (e : Resolve.error) -> e.msg) errors

let resolve_ext src =
  let m = parse_ok src in
  let info, _ = Resolve.resolve m in
  List.map fst info.Resolve.externals

let has_err src frag =
  List.exists
    (fun m ->
      let n = String.length frag in
      let rec go i =
        i + n <= String.length m && (String.sub m i n = frag || go (i + 1))
      in
      go 0)
    (resolve_errs src)

(* --- 모듈 하나로 결정할 수 있는 것 = 오류 --- *)

let () =
  check "중복 정의" (has_err "fn f()\nfn f()" "두 번 정의");
  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");
  check "선언된 effect 변수는 통과" (resolve_errs "fn f[e: effects]() effects e" = []);
  check "파라미터 타입 안의 effect 변수도 본다"
    (has_err "fn f(g: fn() effects e)" "선언되지 않은 effect 변수 e");
  check "같은 블록의 재바인딩"
    (has_err "fn f() {\n  let a = 1\n  let a = 2\n  a\n}" "다시 묶을 수 없습니다");
  check "중첩 블록의 가림은 허용"
    (resolve_errs
       "fn f() {\n  let a = 1\n  if a {\n    let a = 2\n    a\n  }\n}"
    = []);
  check "불변 바인딩에 대입" (has_err "fn f() {\n  let a = 1\n  a = 2\n}" "불변 바인딩");
  check "mut이면 통과" (resolve_errs "fn f() {\n  let mut a = 1\n  a = 2\n}" = []);
  check "모듈에 없는 reexport" (has_err "reexport N" "이 모듈에 없습니다");
  check "모듈에 있는 reexport는 통과" (resolve_errs "enum N {\n  A,\n}\nreexport N" = [])

(* --- scope 머리는 지역 바인딩이어야 한다 --- *)

let () =
  check "부모 scope가 지역 바인딩이 아니면 오류"
    (has_err "fn f() {\n  scope s = root {\n    s\n  }\n}" "지역 바인딩이 아닙니다");
  check "파라미터로 온 부모는 통과"
    (resolve_errs "fn f(root: TaskScope) {\n  scope s = root {\n    s\n  }\n}"
    = []);
  check "자식 scope 이름은 블록 안에서만 산다"
    (resolve_ext
       "fn f(root: TaskScope) {\n  scope s = root {\n    s\n  }\n  s\n}"
    = [ "TaskScope"; "s" ])

(* --- variant는 구문이 아니라 이름 해소가 판정한다 --- *)

let () =
  let enum = "enum E {\n  A(Code),\n  B,\n}\n" in
  check "인자 없는 variant는 바인딩이 아니라 생성자"
    (resolve_errs
       (enum ^ "fn f(e: E) {\n  match e {\n    B => 1,\n    _ => 2,\n  }\n}")
    = []);
  check "variant 인자 개수"
    (has_err
       (enum ^ "fn f(e: E) {\n  match e {\n    A => 1,\n    _ => 2,\n  }\n}")
       "인자 1개가 필요합니다");
  check "패턴의 중복 바인딩"
    (has_err
       (enum ^ "fn f(e: E) {\n  match e {\n    A(x) => x,\n    _ => 0,\n  }\n}"
      ^ "\nfn g(e: E) {\n  match e {\n    A(x) => x,\n    _ => 0,\n  }\n}")
       "두 번 나옵니다"
    = false)

(* --- 결정할 수 없는 것 = 외부 참조 --- *)

let () =
  check "모르는 타입은 외부 참조" (resolve_ext "fn f(a: Widget)" = [ "Widget" ]);
  check "import한 이름은 외부 참조가 아니다"
    (resolve_ext "import \"d/p\" as P\nfn f() {\n  P.go()\n}" = []);
  check "지역 이름은 외부 참조가 아니다" (resolve_ext "fn f(a: Int) {\n  a\n}" = []);
  check "builtin은 외부 참조가 아니다"
    (resolve_ext "fn f(a: Int) -> Result[Int, Int] {\n  Ok(a)\n}" = []);
  check "effect 집합의 capability도 표면에 든다"
    (resolve_ext "fn f() effects {Gw.pay}" = [ "Gw" ])

(* --- 샘플: 오류 샘플을 뺀 나머지는 이름 해소를 통과해야 한다 --- *)

(* 일부러 틀린 파일들. 무엇이 틀렸는지는 각 파일의 주석에 있다. *)
let error_samples = [ "08_syntax_errors.cool"; "13_lints.cool" ]

let () =
  let dir = "../samples" in
  let files =
    Sys.readdir dir |> Array.to_list
    |> List.filter (fun f -> Filename.check_suffix f ".cool")
    |> List.filter (fun f -> not (List.mem f error_samples))
    |> List.sort compare
  in
  List.iter
    (fun f ->
      let path = Filename.concat dir f in
      match Driver.resolve path with
      | Ok _ -> ()
      | Error errors ->
          List.iter
            (fun e -> Printf.printf "  %s\n" (Driver.string_of_error e))
            errors;
          check (f ^ " 이름 해소") false)
    files

(* ================================================================== *)
(* 타입 검사                                                           *)
(* ================================================================== *)

let type_errs src =
  List.map (fun (e : Typecheck.error) -> e.msg) (Typecheck.check (parse_ok src))

let type_ok src = type_errs src = []

let type_has src frag =
  List.exists
    (fun m ->
      let n = String.length frag in
      let rec go i =
        i + n <= String.length m && (String.sub m i n = frag || go (i + 1))
      in
      go 0)
    (type_errs src)

(* --- 제네릭은 호출 지점에서 지역 unification으로 풀린다 --- *)

let () =
  check "제네릭 인스턴스화" (type_ok "fn id[a](x: a) -> a\nfn f() -> Int {\n  id(1)\n}");
  check "제네릭 결과가 반환 타입과 안 맞으면 오류"
    (type_has "fn id[a](x: a) -> a\nfn f() -> String {\n  id(1)\n}" "String");
  check "명시적 인스턴스화의 인자 개수"
    (type_has "fn id[a](x: a) -> a\nfn f() -> Int {\n  id[Int, Int](1)\n}"
       "타입 인자 1개가 필요한데 2개");
  check "고차 함수의 클로저 파라미터 타입은 기대 타입에서 온다"
    (type_ok
       "fn map[a, b](xs: List[a], f: fn(a) -> b) -> List[b]\n\
        fn g(xs: List[Int]) -> List[Int] {\n\
       \  map(xs, fn(x) { x + 1 })\n\
        }");
  check "클로저 본문의 타입 오류는 잡힌다"
    (type_has
       "fn map[a, b](xs: List[a], f: fn(a) -> b) -> List[b]\n\
        fn g(xs: List[Int]) -> List[Int] {\n\
       \  map(xs, fn(x) { x + \"1\" })\n\
        }"
       "산술 연산자")

(* --- Result와 ? --- *)

let () =
  check "?는 Result를 벗긴다"
    (type_ok
       "fn f(x: Result[Int, String]) -> Result[Int, String] {\n\
       \  let a = x?\n\
       \  Ok(a)\n\
        }");
  check "?는 Result 반환 함수 안에서만"
    (type_has "fn f(x: Result[Int, String]) -> Int {\n  x?\n}"
       "Result를 반환하는 함수 안에서만")

(* --- enum과 struct --- *)

let () =
  let e = "enum E {\n  A(Int),\n  B,\n}\n" in
  check "생성자 호출" (type_ok (e ^ "fn f() -> E {\n  A(1)\n}"));
  check "생성자 인자 타입" (type_has (e ^ "fn f() -> E {\n  A(\"x\")\n}") "인자");
  check "인자 없는 생성자" (type_ok (e ^ "fn f() -> E {\n  B\n}"));
  check "match는 값을 낸다"
    (type_ok
       (e
      ^ "fn f(x: E) -> Int {\n  match x {\n    A(n) => n,\n    B => 0,\n  }\n}"
       ));
  check "제네릭 struct 필드"
    (type_ok "struct P[a] {\n  v: a,\n}\nfn f(p: P[Int]) -> Int {\n  p.v\n}");
  check "제네릭 struct 필드 타입 오류"
    (type_has "struct P[a] {\n  v: a,\n}\nfn f(p: P[Int]) -> String {\n  p.v\n}"
       "String")

(* --- capability 메서드 --- *)

let () =
  let c = "capability G {\n  fn pay(n: Int) -> Bool\n}\n" in
  check "capability 메서드 타입"
    (type_ok (c ^ "fn f(g: G) -> Bool {\n  g.pay(1)\n}"));
  check "없는 메서드"
    (type_has (c ^ "fn f(g: G) -> Bool {\n  g.nope(1)\n}") "메서드가 없습니다");
  check "메서드 인자 타입"
    (type_has (c ^ "fn f(g: G) -> Bool {\n  g.pay(\"x\")\n}") "인자")

(* --- 외부 이름은 검사를 막지 않는다 --- *)

let () =
  check "모르는 타입은 무엇과도 맞는다"
    (type_ok "fn f(w: Widget) -> Int {\n  w.anything(1, 2)\n}");
  check "모르는 것을 틀렸다고 말하지 않는다" (type_ok "fn f(w: Widget) -> Widget {\n  w\n}")

(* --- affinity는 타입 검사가 소유하지 않는다 --- *)

let () =
  check "affine fn과 fn은 타입 동등성에서 구분되지 않는다"
    (type_ok "fn f() -> affine fn() {\n  fn() {\n    unit\n  }\n}")

(* --- 샘플 --- *)

let () =
  let dir = "../samples" in
  let ok_files =
    Sys.readdir dir |> Array.to_list
    |> List.filter (fun f -> Filename.check_suffix f ".cool")
    |> List.filter (fun f ->
        not
          (List.mem f
             [
               "05_move_errors.cool";
               "08_syntax_errors.cool";
               "09_type_errors.cool";
               "10_effect_errors.cool";
               "11_exhaustiveness.cool";
               "12_stdlib_effects.cool";
               "13_lints.cool";
             ]))
    |> List.sort compare
  in
  List.iter
    (fun f ->
      match Driver.typecheck (Filename.concat dir f) with
      | Ok () -> ()
      | Error errors ->
          List.iter
            (fun e -> Printf.printf "  %s\n" (Driver.string_of_error e))
            errors;
          check (f ^ " 타입 검사") false)
    ok_files;
  (match Driver.typecheck (Filename.concat dir "09_type_errors.cool") with
  | Ok () -> check "09는 타입 오류를 내야 한다" false
  | Error errors ->
      check "09의 오류를 전부 모은다 (첫 오류에서 멈추지 않는다)" (List.length errors >= 18));
  (match Driver.typecheck (Filename.concat dir "10_effect_errors.cool") with
  | Ok () -> check "10은 effect 오류를 내야 한다" false
  | Error errors -> check "10의 effect 오류" (List.length errors >= 6));
  (match Driver.typecheck (Filename.concat dir "05_move_errors.cool") with
  | Ok () -> check "05는 move 오류를 내야 한다" false
  | Error errors -> check "05의 move 오류" (List.length errors >= 9));
  match Driver.typecheck (Filename.concat dir "11_exhaustiveness.cool") with
  | Ok () -> check "11은 exhaustiveness 오류를 내야 한다" false
  | Error errors -> check "11의 exhaustiveness 오류" (List.length errors >= 7)

(* ================================================================== *)
(* effect / capability 검사                                            *)
(* ================================================================== *)

let cap =
  "capability Db {\n\
  \  fn read(id: Int) effects {Db.read} -> Int\n\
  \  fn touch(id: Int) effects {Db.read}\n\
   }\n"

(* --- 미선언 effect = compile error (철학 1) --- *)

let () =
  check "선언하면 통과"
    (type_ok (cap ^ "fn f(db: Db) effects {Db.read} -> Int {\n  db.read(1)\n}"));
  check "선언 없이 capability 메서드를 부르면 오류"
    (type_has
       (cap ^ "fn f(db: Db) -> Int {\n  db.read(1)\n}")
       "선언되지 않은 effect Db.read");
  check "헬퍼의 effect도 물려받는다"
    (type_has
       (cap
      ^ "fn g(db: Db) effects {Db.read} -> Int {\n\
        \  db.read(1)\n\
         }\n\
         fn f(db: Db) -> Int {\n\
        \  g(db)\n\
         }")
       "선언되지 않은 effect Db.read");
  check "effect 없는 함수는 절이 없어도 된다"
    (type_ok "fn add(a: Int, b: Int) -> Int {\n  a + b\n}")

(* --- 클로저의 effect는 정의한 자리가 아니라 부르는 자리에서 일어난다 --- *)

let () =
  check "클로저를 만들기만 하면 effect가 새지 않는다"
    (type_ok
       (cap
      ^ "fn f(db: Db) -> fn() effects {Db.read} -> Int {\n\
        \  fn() { db.read(1) }\n\
         }"));
  check "클로저가 선언한 것보다 많이 수행하면 오류"
    (type_has
       (cap
      ^ "fn run(f: fn() effects {}) \n\
         fn f(db: Db) {\n\
        \  run(fn() effects {} { db.touch(1) })\n\
         }")
       "클로저가 선언하지 않은 effect Db.read");
  check "파라미터가 허용한 범위를 넘는 함수를 넘기면 오류"
    (type_has
       (cap
      ^ "fn run(f: fn() effects {})\n\
         fn f(db: Db) {\n\
        \  run(fn() { db.touch(1) })\n\
         }")
       "파라미터가 허용한 effect는 {}")

(* --- effect 변수: 결정 위치에서 인자의 effect로 묶인다 --- *)

let () =
  let twice = "fn twice[e: effects](f: fn() effects e) effects e\n" in
  check "effect 변수는 인자의 effect로 해소된다"
    (type_ok
       (cap ^ twice
      ^ "fn f(db: Db) effects {Db.read} {\n  twice(fn() { db.touch(1) })\n}"));
  check "해소된 effect가 선언에 없으면 오류"
    (type_has
       (cap ^ twice ^ "fn f(db: Db) {\n  twice(fn() { db.touch(1) })\n}")
       "선언되지 않은 effect Db.read");
  check "effect 변수를 그대로 물려주는 것은 통과"
    (type_ok
       (twice ^ "fn g[e: effects](f: fn() effects e) effects e {\n  twice(f)\n}"));
  check "effect 변수를 선언하지 않고 물려주면 오류"
    (type_has
       (twice ^ "fn g[e: effects](f: fn() effects e) {\n  twice(f)\n}")
       "선언되지 않은 effect e")

(* --- capability 없이는 effect를 수행할 수 없다 --- *)

let () =
  check "capability 값이 없으면 메서드를 부를 수 없다"
    (type_has
       (cap ^ "fn f() effects {Db.read} -> Int {\n  Db.read(1)\n}")
       "값을 통해서만")

(* ================================================================== *)
(* move / affinity 검사                                                *)
(* ================================================================== *)

let move_errs src =
  List.map (fun (e : Move.error) -> e.msg) (Move.check (parse_ok src))

let move_ok src = move_errs src = []

let move_has src frag =
  List.exists
    (fun m ->
      let n = String.length frag in
      let rec go i =
        i + n <= String.length m && (String.sub m i n = frag || go (i + 1))
      in
      go 0)
    (move_errs src)

let res =
  "capability F {\n\
  \  fn size() -> Int\n\
   }\n\
   fn drop(own f: F)\n\
   fn peek(f: F) -> Int\n"

(* --- 이중 소비와 분기 병합 --- *)

let () =
  check "빌리기만 하면 여러 번 써도 된다"
    (move_ok (res ^ "fn f(x: F) -> Int {\n  peek(x) + peek(x)\n}"));
  check "이중 소비는 오류"
    (move_has (res ^ "fn f(own x: F) {\n  drop(x)\n  drop(x)\n}") "이미 move");
  check "양쪽 분기에서 소비하면 통과"
    (move_ok
       (res
      ^ "fn f(own x: F, c: Bool) {\n\
        \  if c {\n\
        \    drop(x)\n\
        \  } else {\n\
        \    drop(x)\n\
        \  }\n\
         }"));
  check "한 분기에서만 소비해도 병합 이후는 moved (보수적 합집합)"
    (move_has
       (res
      ^ "fn f(own x: F, c: Bool) {\n  if c {\n    drop(x)\n  }\n  drop(x)\n}")
       "이미 move");
  check "소비한 자리를 진단에 담는다"
    (move_has (res ^ "fn f(own x: F) {\n  drop(x)\n  drop(x)\n}") "에서 소비")

(* --- 빌린 값은 탈출하지 못한다 --- *)

let () =
  check "빌린 값의 반환" (move_has (res ^ "fn f(x: F) -> F {\n  x\n}") "반환할 수 없습니다");
  check "빌린 값을 소유 자리로" (move_has (res ^ "fn f(x: F) {\n  drop(x)\n}") "빌린 값이라");
  check "own으로 받으면 넘길 수 있다" (move_ok (res ^ "fn f(own x: F) {\n  drop(x)\n}"));
  check "빌린 값의 struct 저장"
    (move_has
       (res ^ "struct H {\n  f: F,\n}\nfn g(x: F) -> H {\n  H { f: x }\n}")
       "struct에 저장할 수 없습니다")

(* --- use의 전염 --- *)

let () =
  check "빌린 값을 capture한 클로저는 빌린 값이다"
    (move_has
       (res ^ "fn sink(own h: fn())\nfn f(x: F) {\n  sink(fn() { peek(x) })\n}")
       "use 값은 탈출하지 못합니다");
  check "빌려 쓰는 자리로는 넘길 수 있다"
    (move_ok
       (res ^ "fn borrow(h: fn())\nfn f(x: F) {\n  borrow(fn() { peek(x) })\n}"))

(* --- callable affinity --- *)

let () =
  check "affine 값을 capture하면 affine fn"
    (move_ok (res ^ "fn f(own x: F) -> affine fn() {\n  fn() { drop(x) }\n}"));
  check "affine 클로저를 fn 자리에 반환하면 오류"
    (move_has
       (res ^ "fn f(own x: F) -> fn() {\n  fn() { drop(x) }\n}")
       "affine fn이어야 합니다");
  check "by-move capture는 바깥에서 소비다"
    (move_has
       (res
      ^ "fn f(own x: F) -> affine fn() {\n\
        \  let g = fn() { drop(x) }\n\
        \  drop(x)\n\
        \  g\n\
         }")
       "이미 move")

(* --- affinity 전이 --- *)

let () =
  check "capability를 필드로 가지면 전이적으로 affine"
    (move_has
       (res ^ "struct B {\n  f: F,\n}\nfn g(b: B) -> B {\n  b\n}")
       "반환할 수 없습니다");
  check "copyable 선언과 affine 필드는 공존할 수 없다"
    (move_has (res ^ "copyable struct B {\n  f: F,\n}") "copyable로 선언되었지만");
  check "affine이 없으면 copyable"
    (move_ok "copyable struct B {\n  n: Int,\n}\nfn g(b: B) -> B {\n  b\n}");
  check "컨테이너를 통해서도 전이된다"
    (move_has (res ^ "fn g(x: List[F]) -> List[F] {\n  x\n}") "반환할 수 없습니다")

(* --- 클로저의 mut capture 금지 --- *)

let () =
  check "클로저는 mut 바인딩을 capture할 수 없다"
    (move_has
       "fn sink(h: fn())\n\
        fn f() {\n\
       \  let mut n = 0\n\
       \  sink(fn() { n = n + 1 })\n\
        }"
       "mut 바인딩");
  check "불변 바인딩은 capture해도 된다"
    (move_ok "fn sink(h: fn())\nfn f() {\n  let n = 0\n  sink(fn() { n })\n}")

(* --- 외부 타입은 affine임을 증명할 수 없다 --- *)

let () =
  check "모르는 타입은 copyable로 본다" (move_ok "fn f(x: Widget) -> Widget {\n  x\n}")

(* ================================================================== *)
(* exhaustiveness                                                      *)
(* ================================================================== *)

let e3 = "enum E {\n  A(Int),\n  B,\n  C,\n}\n"

let () =
  check "모든 variant를 덮으면 통과"
    (type_ok
       (e3
      ^ "fn f(x: E) -> Int {\n\
        \  match x {\n\
        \    A(n) => n,\n\
        \    B => 1,\n\
        \    C => 2,\n\
        \  }\n\
         }"));
  check "빠진 variant를 이름으로 말한다"
    (type_has
       (e3
      ^ "fn f(x: E) -> Int {\n  match x {\n    A(n) => n,\n    B => 1,\n  }\n}"
       )
       "빠진 경우: C");
  check "와일드카드가 나머지를 덮는다"
    (type_ok
       (e3
      ^ "fn f(x: E) -> Int {\n  match x {\n    A(n) => n,\n    _ => 0,\n  }\n}"
       ));
  check "Bool의 생성자 집합도 유한하다"
    (type_has "fn f(b: Bool) -> Int {\n  match b {\n    true => 1,\n  }\n}"
       "빠진 경우: false");
  check "Option"
    (type_has
       "fn f(o: Option[Int]) -> Int {\n  match o {\n    Some(n) => n,\n  }\n}"
       "빠진 경우: None");
  check "Result"
    (type_ok
       "fn f(r: Result[Int, Int]) -> Int {\n\
       \  match r {\n\
       \    Ok(n) => n,\n\
       \    Err(e) => e,\n\
       \  }\n\
        }");
  check "중첩된 자리의 반례도 찾는다"
    (type_has
       (e3
      ^ "fn f(o: Option[E]) -> Int {\n\
        \  match o {\n\
        \    Some(A(n)) => n,\n\
        \    None => 0,\n\
        \  }\n\
         }")
       "Some(B)");
  check "Int 리터럴만으로는 완전해지지 않는다"
    (type_has
       "fn f(n: Int) -> Int {\n  match n {\n    0 => 1,\n    1 => 2,\n  }\n}"
       "모든 경우를 덮지 않습니다");
  check "와일드카드가 있으면 리터럴 match도 통과"
    (type_ok
       "fn f(n: Int) -> Int {\n  match n {\n    0 => 1,\n    _ => 2,\n  }\n}")

let () =
  check "와일드카드 뒤의 팔은 도달할 수 없다"
    (type_has
       (e3
      ^ "fn f(x: E) -> Int {\n  match x {\n    _ => 0,\n    B => 1,\n  }\n}")
       "도달할 수 없습니다");
  check "같은 생성자를 두 번 쓰면 뒤가 죽는다"
    (type_has
       (e3
      ^ "fn f(x: E) -> Int {\n\
        \  match x {\n\
        \    A(n) => n,\n\
        \    A(m) => m,\n\
        \    _ => 0,\n\
        \  }\n\
         }")
       "도달할 수 없습니다");
  check "생성자 집합을 모르면 검사하지 않는다"
    (type_ok "fn f(w: Widget) -> Int {\n  match w {\n    _ => 0,\n  }\n}")

(* upstream의 variant 추가가 downstream match를 깨뜨린다 —
   interface hash가 enum 본문을 입력으로 삼는 이유 *)
let () =
  let two = "enum E {\n  A,\n  B,\n}\n" in
  let three = "enum E {\n  A,\n  B,\n  C,\n}\n" in
  let user =
    "fn f(x: E) -> Int {\n  match x {\n    A => 0,\n    B => 1,\n  }\n}"
  in
  check "variant 둘일 때는 통과" (type_ok (two ^ user));
  check "variant가 늘면 같은 코드가 깨진다" (type_has (three ^ user) "빠진 경우: C")

(* ------------------------------------------------------------------ *)
(* 모듈 경계와 incremental 전파                                        *)
(*                                                                     *)
(* 이 세 검사가 아키텍처 주장 전체다:                                  *)
(*   1. 다른 모듈의 타입과 생성자가 별칭으로 보인다                    *)
(*   2. 본문만 고치면 downstream은 재검사되지 않는다                   *)
(*   3. 시그니처를 고치면 downstream까지 전파되고, 실제로 깨진다       *)
(* ------------------------------------------------------------------ *)

let has_sub hay needle =
  let n = String.length needle and h = String.length hay in
  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
  n = 0 || go 0

let write file s =
  let oc = open_out_bin file in
  output_string oc s;
  close_out oc

let () =
  let dir = Filename.concat (Filename.get_temp_dir_name ()) "cool_modtest" in
  ignore (Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir)));
  let a = Filename.concat dir "shapes.cool" in
  let b = Filename.concat dir "area.cool" in
  let shapes_body body =
    "pub enum Shape {\n\
    \  Circle(Int),\n\
    \  Square(Int),\n\
     }\n\n\
     pub fn double(n: Int) -> Int {\n\
    \  " ^ body ^ "\n}\n"
  in
  let shapes_three =
    "pub enum Shape {\n\
    \  Circle(Int),\n\
    \  Square(Int),\n\
    \  Tri(Int),\n\
     }\n\n\
     pub fn double(n: Int) -> Int {\n\
    \  n + n\n\
     }\n"
  in
  let area =
    "import \"shapes\" as Shapes\n\n\
     pub fn area(s: Shapes.Shape) -> Int {\n\
    \  match s {\n\
    \    Shapes.Circle(r) => Shapes.double(r),\n\
    \    Shapes.Square(w) => w * w,\n\
    \  }\n\
     }\n"
  in
  write a (shapes_body "n + n");
  write b area;
  let st = Session.create ~root:dir () in
  Session.load st b;
  check "모듈 경계를 넘는 타입과 생성자가 보인다" (Session.errors st = []);

  (* 본문만 수정 — hash가 그대로이므로 downstream은 손대지 않는다 *)
  write a (shapes_body "n * 2");
  let touched = Session.recheck st [ a ] in
  check "본문만 고치면 자기 자신만 재검사된다" (touched = [ a ]);
  check "본문 수정 후에도 오류 없음" (Session.errors st = []);

  (* 시그니처 수정 — hash가 변하므로 dependents까지 전파된다 *)
  write a shapes_three;
  let touched = Session.recheck st [ a ] in
  check "variant를 추가하면 downstream까지 전파된다" (List.mem b touched);
  check "전파된 downstream이 실제로 깨진다"
    (List.exists
       (fun (e : Session.error) ->
         e.file = b && String.length e.message > 0 && has_sub e.message "빠진 경우")
       (Session.errors st))

(* ------------------------------------------------------------------ *)
(* 인터프리터                                                          *)
(*                                                                     *)
(* 샘플은 이제 "검사를 통과한다"가 아니라 "이 값을 낸다"까지 말한다.   *)
(* 실행 가능한 명세가 되는 지점이고, v1이 백엔드를 바꿔도 남는다.      *)
(* ------------------------------------------------------------------ *)

let run_src src =
  let dir = Filename.concat (Filename.get_temp_dir_name ()) "cool_runtest" in
  ignore (Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir)));
  let f = Filename.concat dir "m.cool" in
  write f src;
  (* 표준 라이브러리는 저장소의 std/. 테스트는 /tmp에서 도니 명시한다. *)
  let st = Session.create ~root:dir ~std:"../std" () in
  Session.run st f

(* prelude가 없다. 표준 라이브러리도 명시적으로 가져온다.
   미사용 import는 오류이므로 테스트마다 쓰는 것만 가져온다. *)
let imports names =
  String.concat ""
    (List.map
       (fun n ->
         Printf.sprintf "import \"cool.dev/std/%s\" as %s\n"
           (String.lowercase_ascii n) n)
       names)

let console =
  "pub capability Console {\n\
  \  fn print(s: String) effects {Console.print}\n\
   }\n\n"

let outputs ?(use = []) src expected =
  match run_src (imports use ^ console ^ src) with
  | Ok out -> out = expected
  | Error e ->
      Printf.printf "  (실행 오류: %s)\n" (Session.string_of_error e);
      false

let () =
  check "산술과 출력"
    (outputs ~use:[ "Int" ]
       "pub fn main(c: Console) effects {Console.print} {\n\
       \  c.print(Int.show(2 + 3 * 4))\n\
        }"
       "14\n");
  check "match와 생성자"
    (outputs ~use:[ "Int" ]
       "pub enum S {\n\
       \  A(Int),\n\
       \  B,\n\
        }\n\n\
        pub fn f(s: S) -> Int {\n\
       \  match s {\n\
       \    A(n) => n + 1,\n\
       \    B => 0,\n\
       \  }\n\
        }\n\n\
        pub fn main(c: Console) effects {Console.print} {\n\
       \  c.print(Int.show(f(A(41))))\n\
       \  c.print(Int.show(f(B)))\n\
        }"
       "42\n0\n");
  check "mut 바인딩과 대입"
    (outputs ~use:[ "Int" ]
       "pub fn main(c: Console) effects {Console.print} {\n\
       \  let mut n = 1\n\
       \  n = n + 10\n\
       \  c.print(Int.show(n))\n\
        }"
       "11\n");
  check "?는 Err에서 즉시 반환한다"
    (outputs ~use:[ "Int" ]
       "pub enum E {\n\
       \  Bad,\n\
        }\n\n\
        pub fn half(n: Int) -> Result[Int, E] {\n\
       \  if n % 2 == 0 { Ok(n / 2) } else { Err(Bad) }\n\
        }\n\n\
        pub fn twice(n: Int) -> Result[Int, E] {\n\
       \  let a = half(n)?\n\
       \  let b = half(a)?\n\
       \  Ok(a + b)\n\
        }\n\n\
        pub fn show_res(r: Result[Int, E]) -> String {\n\
       \  match r {\n\
       \    Ok(v) => Int.show(v),\n\
       \    Err(_) => \"err\",\n\
       \  }\n\
        }\n\n\
        pub fn main(c: Console) effects {Console.print} {\n\
       \  c.print(show_res(twice(8)))\n\
       \  c.print(show_res(twice(7)))\n\
        }"
       "6\nerr\n");
  check "클로저가 바깥 capability를 잡는다"
    (outputs ~use:[ "List"; "Int" ]
       "pub fn main(c: Console) effects {Console.print} {\n\
       \  List.each([1, 2], fn(n) {\n\
       \    c.print(Int.show(n))\n\
       \  })\n\
        }"
       "1\n2\n");
  check "scope 블록은 순차로 돌고 나갈 때 join한다"
    (outputs
       "pub fn main(c: Console, root: TaskScope) effects {Console.print} {\n\
       \  scope sc = root {\n\
       \    sc.spawn(fn() { c.print(\"a\") })\n\
       \    sc.spawn(fn() { c.print(\"b\") })\n\
       \  }\n\
       \  c.print(\"after\")\n\
        }"
       "a\nb\nafter\n");
  (* 권한은 런타임에서만 온다. main이 선언하지 않으면 존재하지 않는다. *)
  check "선언하지 않은 capability는 실행 시점에도 없다"
    (match run_src "pub fn main() { }" with Ok "" -> true | _ -> false);
  check "런타임이 모르는 capability는 거절한다"
    (match
       run_src
         "pub capability Db {\n\
         \  fn read() effects {Db.read} -> Int\n\
          }\n\n\
          pub fn main(d: Db) effects {Db.read} -> Int { d.read() }"
     with
    | Error e -> has_sub e.message "제공하지 않습니다"
    | Ok _ -> false)

(* 표준 라이브러리 시그니처가 실제 검사에 쓰이는지.

   std가 생기기 전에는 List.each가 모르는 이름이라 조용히 통과했다.
   effect 다형성이 장식이 아니라는 것을 여기서 고정한다. *)
let () =
  let std_check src =
    let dir = Filename.concat (Filename.get_temp_dir_name ()) "cool_stdtest" in
    ignore (Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir)));
    let f = Filename.concat dir "m.cool" in
    write f src;
    let st = Session.create ~root:dir ~std:"../std" () in
    Session.load st f;
    List.map (fun (e : Session.error) -> e.message) (Session.errors st)
  in
  let hdr use = imports use ^ "\n" ^ console in
  let list_only = hdr [ "List" ] in
  let hdr = hdr [ "List"; "Int" ] in
  check "std 시그니처로 인자 개수를 잡는다"
    (List.exists
       (fun m -> has_sub m "인자 1개가 필요한데")
       (std_check
          (list_only ^ "pub fn f(xs: List[Int]) -> Int {\n  List.len(xs, 1)\n}")));
  check "std 시그니처로 반환 타입을 잡는다"
    (List.exists
       (fun m -> has_sub m "String이(가) 필요한데 Int")
       (std_check
          (list_only ^ "pub fn f(xs: List[Int]) -> String {\n  List.len(xs)\n}")));
  (* effect 변수가 호출 지점에서 실제로 해소된다 *)
  check "List.each의 effect 변수가 클로저의 effect로 묶인다"
    (List.exists
       (fun m -> has_sub m "선언되지 않은 effect Console.print")
       (std_check
          (hdr
         ^ "pub fn f(c: Console, xs: List[Int]) {\n\
           \  List.each(xs, fn(n) { c.print(Int.show(n)) })\n\
            }")));
  check "effect를 선언하면 같은 코드가 통과한다"
    (std_check
       (hdr
      ^ "pub fn f(c: Console, xs: List[Int]) effects {Console.print} {\n\
        \  List.each(xs, fn(n) { c.print(Int.show(n)) })\n\
         }")
    = [])

(* ------------------------------------------------------------------ *)
(* lint 둘                                                             *)
(*                                                                     *)
(* 취향이 아니라 비용이다. 미사용 import는 재검사 범위를 넓히고,        *)
(* effect 과잉 선언은 호출자에게 없는 의무를 지운다.                    *)
(* ------------------------------------------------------------------ *)

let () =
  let msgs src =
    let dir = Filename.concat (Filename.get_temp_dir_name ()) "cool_linttest" in
    ignore (Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir)));
    let f = Filename.concat dir "m.cool" in
    write f src;
    let st = Session.create ~root:dir ~std:"../std" () in
    Session.load st f;
    List.map (fun (e : Session.error) -> e.message) (Session.errors st)
  in
  let db =
    "pub capability Db {\n\
    \  fn read(id: Int) effects {Db.read} -> Int\n\
    \  fn write(id: Int) effects {Db.write}\n\
     }\n\n"
  in
  check "미사용 import를 잡는다"
    (List.exists
       (fun m -> has_sub m "가져왔지만 쓰지 않습니다")
       (msgs
          "import \"cool.dev/std/list\" as List\n\npub fn f() -> Int {\n  1\n}"));
  check "쓰면 잡지 않는다"
    (msgs
       "import \"cool.dev/std/list\" as List\n\n\
        pub fn f(xs: List[Int]) -> Int {\n\
       \  List.len(xs)\n\
        }"
    = []);
  check "effect 과잉 선언을 잡는다"
    (List.exists
       (fun m -> has_sub m "선언했지만 수행하지 않습니다")
       (msgs
          (db
         ^ "pub fn f(db: Db, id: Int) effects {Db.read, Db.write} -> Int {\n\
           \  db.read(id)\n\
            }")));
  check "정확히 선언하면 통과한다"
    (msgs
       (db
      ^ "pub fn f(db: Db, id: Int) effects {Db.read} -> Int {\n  db.read(id)\n}"
       )
    = []);
  (* 모르는 것을 틀렸다고 말하지 않는다 *)
  check "effect 변수가 있으면 과잉 선언을 판정하지 않는다"
    (msgs "pub fn f[e: effects](g: fn() effects e) effects e {\n  g()\n}" = []);
  check "외부 타입이 섞이면 과잉 선언을 판정하지 않는다"
    (msgs "pub fn f(fs: FileSystem) effects {FileSystem.read} {\n  fs.read()\n}"
    = []);
  (* lint는 뒤 단계를 막지 않는다 — lint 하나가 진짜 타입 오류를 가리면 안 된다 *)
  check "미사용 import가 타입 오류를 가리지 않는다"
    (let ms =
       msgs
         "import \"cool.dev/std/list\" as List\n\n\
          pub fn f() -> String {\n\
         \  1\n\
          }"
     in
     List.exists (fun m -> has_sub m "가져왔지만 쓰지 않습니다") ms
     && List.exists (fun m -> has_sub m "String이(가) 필요한데 Int") ms)

(* ------------------------------------------------------------------ *)
(* 실제 프로그램                                                       *)
(*                                                                     *)
(* samples/app은 검사기를 시험하려고 쓴 것이 아니라 일을 하려고 쓴 것이다. *)
(* 언어가 쓸 만한지는 이런 코드에서만 드러난다.                          *)
(* ------------------------------------------------------------------ *)

let () =
  let st = Session.create ~root:"../samples/app" ~std:"../std" () in
  match
    Session.run
      ~args:[ "../samples/app/example.conf" ]
      st "../samples/app/main.cool"
  with
  | Error e ->
      Printf.printf "  (실행 오류: %s)\n" (Session.string_of_error e);
      check "app: 설정 리포트가 돈다" false
  | Ok out ->
      check "app: 항목과 문제를 센다" (has_sub out "항목 5개, 문제 2개");
      check "app: 값의 타입을 모양으로 정한다"
        (has_sub out "threads = 4   (number)"
        && has_sub out "verbose = true   (flag)"
        && has_sub out "name = \"coollang\"   (text)");
      check "app: 문제에 줄 번호가 붙는다"
        (has_sub out "10행: 이름이 비어 있습니다" && has_sub out "11행: = 가 하나여야 합니다");
      check "app: 타입 있는 조회" (has_sub out "port = 8080")

let () =
  let st = Session.create ~root:"../samples/app" ~std:"../std" () in
  match Session.run st "../samples/app/main.cool" with
  | Ok out -> check "app: 인자가 없으면 말해준다" (has_sub out "경로가 필요합니다")
  | Error _ -> check "app: 인자가 없으면 말해준다" false

let () =
  let st = Session.create ~root:"../samples/app" ~std:"../std" () in
  match Session.run ~args:[ "/없는/파일.conf" ] st "../samples/app/main.cool" with
  | Ok out -> check "app: 없는 파일을 Err로 돌려준다" (has_sub out "오류: ")
  | Error _ -> check "app: 없는 파일을 Err로 돌려준다" false

(* std 선언과 런타임 구현이 어긋나면 검사는 통과하고 실행이 죽는다.
   v0에서 둘은 다른 파일에 있으므로 일치는 테스트가 지킨다 (friction F7). *)
let () =
  let dir = "../std" in
  let declared =
    Sys.readdir dir |> Array.to_list
    |> List.filter (fun f -> Filename.check_suffix f ".cool")
    |> List.concat_map (fun f ->
        let m = ref "" in
        (match Driver.ast (Filename.concat dir f) with
        | Error _ -> ()
        | Ok _ -> m := Filename.remove_extension f);
        match Driver.ast (Filename.concat dir f) with
        | Error _ -> []
        | Ok ast ->
            List.filter_map
              (function
                | Ast.I_fn { decl; _ } -> Some (!m ^ "." ^ decl.fn_name)
                | _ -> None)
              ast.Ast.items)
  in
  check "std에 선언이 있다" (List.length declared > 20);
  List.iter
    (fun name ->
      check
        (Printf.sprintf "std 선언 %s에 런타임 구현이 있다" name)
        (List.mem name Interp.implemented))
    declared;
  List.iter
    (fun name ->
      check
        (Printf.sprintf "런타임 구현 %s에 std 선언이 있다" name)
        (List.mem name declared))
    Interp.implemented

(* ------------------------------------------------------------------ *)
(* 문법 파일                                                           *)
(*                                                                     *)
(* docs/grammar.ebnf는 이제 문서가 아니라 기계가 읽는 소스다. 여기서      *)
(* 검사하는 것 셋:                                                      *)
(*   1. 기계가 읽을 수 있는가                                           *)
(*   2. 정의되지 않은 이름이 토큰 부류뿐인가                             *)
(*   3. LL(1)인가 — 문법 첫머리의 주장이 여기서 검증된다                 *)
(* ------------------------------------------------------------------ *)

let () =
  let src =
    let ic = open_in_bin "../docs/grammar.ebnf" 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 src with
  | Error e ->
      Printf.printf "  (문법 파일 %d행: %s)\n" e.line e.msg;
      check "grammar.ebnf를 읽을 수 있다" false
  | Ok g ->
      check "grammar.ebnf를 읽을 수 있다" true;
      check "프로덕션이 충분히 있다" (List.length g > 50);
      (* 어휘 층의 이름만 정의 없이 참조될 수 있다 *)
      let allowed = [ "NEWLINE"; "char"; "digit"; "letter" ] in
      let undef = Ebnf.undefined g in
      List.iter
        (fun n ->
          check
            (Printf.sprintf "grammar.ebnf: %s는 정의되었거나 토큰 부류다" n)
            (List.mem n allowed))
        undef;
      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 =
        List.filter
          (fun (c : Ebnf.conflict) -> not c.c_greedy)
          (Ebnf.conflicts ~tokens ~greedy:[ "NEWLINE" ] g)
      in
      List.iter
        (fun (c : Ebnf.conflict) ->
          Printf.printf "  (LL(1) 충돌 %s:%d [%s] %s — %s)\n" c.c_rule c.c_line
            c.c_kind
            (String.concat " " c.c_tokens)
            c.c_detail)
        real;
      check "grammar.ebnf는 LL(1)이다" (real = [])

(* 문법 문서의 어휘 절은 코드에서 생성된다. 두 곳에 손으로 적힌 목록은
   어긋난다 — 이 프로젝트가 그것으로 한 번 데었다. *)
let () =
  let src =
    let ic = open_in_bin "../docs/grammar.ebnf" in
    let n = in_channel_length ic in
    let s = really_input_string ic n in
    close_in ic;
    s
  in
  let block = Lexical_doc.render () in
  check "문법 문서의 어휘 절이 token.ml과 일치한다" (has_sub src block);
  if not (has_sub src block) then begin
    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