coollang/test/test_coollang.ml

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" ])

(* --- 샘플: 01~07은 이름 해소를 통과해야 한다 --- *)

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 -> f <> "08_syntax_errors.cool")
    |> 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 ->
        f <> "05_move_errors.cool"
        && f <> "08_syntax_errors.cool"
        && f <> "09_type_errors.cool"
        && f <> "10_effect_errors.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)

(* ================================================================== *)
(* 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}")