typecheck: 타입 검사기와 scope 부모 문법 확정

세 가지를 자율 결정으로 닫고 타입 검사까지 세웠다.

1. scope 부모 문법: scope 자식 = 부모 { ... }로 확정. 부모를 적지 않으면
   자식의 부모가 "가장 가까운 스코프"가 되는데 그것이 정확히 ambient
   authority다. 권한 사슬이 main의 루트 TaskScope부터 끊기지 않으려면 모든
   자식이 부모를 이름으로 지목해야 한다. 이름 해소가 이 구멍을 잡아준 건이라,
   주석 처리했던 중첩 예제를 되살렸다.

2. prelude: 타입 이름은 그 타입에 딸린 함수의 이름공간이다(String.len,
   File.close). 정적 메서드를 위한 별도 문법을 두지 않는다.

3. 타입 검사: 이 모듈 안에서 아는 것만 검사한다. 외부 이름은 TUnknown이
   되어 무엇과도 맞는다 — 모르는 것을 틀렸다고 말하지 않기 위해서다.
   제네릭 해소는 호출 지점의 지역 unification이고 함수 하나를 넘지 않는다.
   클로저 파라미터 타입은 기대 타입에서 읽어온다(양방향 검사, 로컬).

단계 소유권을 하나 정정했다. affinity는 타입 동등성의 일부가 아니다. 값이
affine인지는 무엇을 capture했는지로 정해지는 substructural 성질이고
move/affinity 검사가 소유한다. 타입 검사가 이걸 판정하려다 정당한 코드를
거부하는 것을 06에서 확인하고 unify에서 분리했다.

unify 버그 하나: 같은 미지수끼리 unify할 때 occurs check가 자기 자신을
발견해 실패하고 있었다. 02의 fold 호출에서 잡혔다.

09_type_errors.cool 추가 — 외부 타입이 하나도 없어 검사기가 TUnknown으로
빠져나갈 구석이 없는 파일이다. 18개 진단이 전부 잡히고, 첫 오류에서 멈추지
않고 모두 보고한다.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_019ZVDeU6KLuUVL3gs18Hm3E
This commit is contained in:
2026-08-30 02:42:35 +09:00
co-authored by Claude Opus 5
parent 94e28d427b
commit 5e034c0891
13 changed files with 1072 additions and 70 deletions
+3 -3
View File
@@ -55,7 +55,7 @@ type expr =
| E_closure of closure
| E_if of { cond : expr; then_ : block; else_ : expr option; pos : pos }
| E_match of { scrutinee : expr; arms : arm list; pos : pos }
| E_scope of { name : string; body : block; pos : pos }
| E_scope of { name : string; parent : string; body : block; pos : pos }
| E_block of block
| E_call of { callee : expr; args : expr list; pos : pos }
| E_field of { obj : expr; name : string; pos : pos }
@@ -285,8 +285,8 @@ let rec buf_expr b = function
Buffer.add_char b ')')
arms;
Buffer.add_char b ')'
| E_scope { name; body; _ } ->
Buffer.add_string b ("(scope " ^ name ^ " ");
| E_scope { name; parent; body; _ } ->
Buffer.add_string b ("(scope " ^ name ^ " = " ^ parent ^ " ");
buf_block b body;
Buffer.add_char b ')'
| E_block bl -> buf_block b bl
+32 -7
View File
@@ -56,6 +56,33 @@ let resolve (file : string) : (Resolve.info, error list) result =
{ file; line = e.pos.line; col = e.pos.col; message = e.msg })
errors))
let typecheck (file : string) : (unit, error list) result =
match parse_file file with
| Error e -> Error [ e ]
| Ok m -> (
let _, rerrors = Resolve.resolve m in
match rerrors with
| _ :: _ ->
Error
(List.map
(fun (e : Resolve.error) ->
{ file; line = e.pos.line; col = e.pos.col; message = e.msg })
rerrors)
| [] -> (
match Typecheck.check m with
| [] -> Ok ()
| terrors ->
Error
(List.map
(fun (e : Typecheck.error) ->
{
file;
line = e.pos.line;
col = e.pos.col;
message = e.msg;
})
terrors)))
let check (files : string list) : (unit, error list) result =
match files with
| [] ->
@@ -63,16 +90,13 @@ let check (files : string list) : (unit, error list) result =
| _ ->
let errors =
List.filter_map
(fun f ->
match resolve f with
| Ok _ -> None
| Error (e :: _) -> Some e
| Error [] -> None)
(fun f -> match typecheck f with Ok _ -> None | Error es -> Some es)
files
|> List.concat
in
if errors <> [] then Error errors
else
(* 이름 해소는 통과했다. 통과했다고 말하지 않는다 — 파이프라인의
(* 타입 검사는 통과했다. 통과했다고 말하지 않는다 — 파이프라인의
나머지가 아직 없으므로 검사되지 않은 것이다. *)
Error
(List.map
@@ -81,7 +105,8 @@ let check (files : string list) : (unit, error list) result =
file = f;
line = 0;
col = 0;
message = "구문 분석까지 통과. 이름 해소가 아직 구현되지 않았습니다";
message =
"타입 검사까지 통과. effect/capability 검사와 move 검사가 아직 구현되지 않았습니다";
})
files)
+4 -2
View File
@@ -385,9 +385,11 @@ and parse_primary st =
| Token.Kw_match -> parse_match st
| Token.Kw_scope ->
adv st;
let name = ident st "scope 이름" in
let name = ident st "scope 이름" in
expect st Token.Eq "= (자식 scope의 부모를 명시해야 합니다)";
let parent = ident st "부모 scope 이름" in
let body = parse_block st in
E_scope { name; body; pos = p }
E_scope { name; parent; body; pos = p }
| Token.Ident n ->
adv st;
if (not st.no_struct) && kind st = Token.LBrace then
+13 -7
View File
@@ -139,6 +139,8 @@ let rec resolve_expr st = function
if Hashtbl.mem st.items n then ()
else if List.mem n builtin_values then ()
else if Hashtbl.mem st.ctors n then ()
else if List.mem n builtin_types then ()
(* 타입 이름은 그 타입에 딸린 함수의 이름공간이다: String.len *)
else external_ref st n pos
| E_list (xs, _) -> List.iter (resolve_expr st) xs
| E_struct { name; fields; pos } ->
@@ -171,16 +173,20 @@ let rec resolve_expr st = function
resolve_expr st a.arm_body;
pop st)
arms
| E_scope { name; body; pos } ->
(* TaskScope는 use 값이라 모듈 수준에 있을 수 없다. scope의 머리는
반드시 지역 바인딩(파라미터 포함)어야 한다. *)
if lookup_local st name = None then
| E_scope { name; parent; body; pos } ->
(* 부모는 이미 가진 TaskScope여야 한다. TaskScope는 use 값이라 모듈
수준에 있을 수 없으므로 반드시 지역 바인딩(파라미터 포함)다.
자식 scope 이름은 블록 안에서만 산다. *)
if lookup_local st parent = None then
error st pos
(Printf.sprintf
"scope 이름 %s이(가) 지역 바인딩이 아닙니다 (TaskScope는 use 값이라 파라미터나 상위 블록에서 \
"부모 scope %s이(가) 지역 바인딩이 아닙니다 (TaskScope는 use 값이라 파라미터나 상위 블록에서 \
와야 합니다)"
name);
resolve_block_scoped st body
parent);
push st;
bind st pos name false;
resolve_block st body;
pop st
| E_block b -> resolve_block_scoped st b
| E_call { callee; args; _ } ->
resolve_expr st callee;
+604
View File
@@ -0,0 +1,604 @@
(* 타입 검사.
범위: 이 모듈 안에서 아는 것만 검사한다. 외부 이름은 TUnknown이 되어
무엇과도 맞는다 — 모르는 것을 틀렸다고 말하지 않는다.
제네릭 해소는 호출 지점의 지역 unification이다. 함수 하나를 넘어가지
않으므로 전역 추론이 아니다. *)
open Ast
module T = Types
type error = { pos : Token.pos; msg : string }
type scheme = {
s_gen : string list; (* 타입 파라미터 이름 (effect 파라미터는 제외) *)
s_params : T.t list;
s_ret : T.t;
}
type env = {
structs : (string, string list * (string * T.t) list) Hashtbl.t;
enums : (string, string list * (string * T.t list) list) Hashtbl.t;
caps : (string, (string * scheme) list) Hashtbl.t;
fns : (string, scheme) Hashtbl.t;
consts : (string, T.t) Hashtbl.t;
ctors : (string, string) Hashtbl.t; (* variant -> enum *)
mutable locals : (string * T.t) list list;
mutable ret : T.t; (* 현재 함수의 선언된 반환 타입 *)
mutable errors : error list;
}
let err env pos msg = env.errors <- { pos; msg } :: env.errors
let mismatch env pos expected got what =
err env pos
(Printf.sprintf "%s: %s이(가) 필요한데 %s입니다" what (T.show expected) (T.show got))
let push env = env.locals <- [] :: env.locals
let pop env = match env.locals with _ :: r -> env.locals <- r | [] -> ()
let bind env n t =
match env.locals with
| s :: r -> env.locals <- ((n, t) :: s) :: r
| [] -> env.locals <- [ [ (n, t) ] ]
let lookup env n =
let rec go = function
| [] -> None
| s :: r -> (
match List.assoc_opt n s with Some t -> Some t | None -> go r)
in
go env.locals
(* ------------------------------------------------------------------ *)
(* Ast.ty -> Types.t *)
(* ------------------------------------------------------------------ *)
let rec conv env (gen : string list) (t : Ast.ty) : T.t =
match t with
| T_named { name; args; _ } -> (
let args =
List.filter_map
(function TA_ty t -> Some (conv env gen t) | TA_eff _ -> None)
args
in
if List.mem name gen then T.TVar name
else
match name with
| "Int" -> T.TInt
| "Bool" -> T.TBool
| "String" -> T.TString
| "Unit" -> T.TUnit
| "List" | "Option" | "Result" -> T.TCon (name, args)
| _ ->
if
Hashtbl.mem env.structs name
|| Hashtbl.mem env.enums name || Hashtbl.mem env.caps name
then T.TCon (name, args)
else T.TUnknown)
| T_fn { affine; params; ret; _ } ->
T.TFn
{
affine;
params = List.map (conv env gen) params;
ret = (match ret with None -> T.TUnit | Some r -> conv env gen r);
}
let scheme_of env (d : fn_decl) : scheme =
let gen =
List.filter_map
(fun g -> if g.gp_effect then None else Some g.gp_name)
d.fn_gen
in
{
s_gen = gen;
s_params = List.map (fun p -> conv env gen p.p_ty) d.fn_params;
s_ret = (match d.fn_ret with None -> T.TUnit | Some r -> conv env gen r);
}
(* 호출 지점 인스턴스화: 타입 파라미터마다 새 미지수 *)
let instantiate (s : scheme) =
let sub = List.map (fun v -> (v, T.fresh ())) s.s_gen in
(List.map (T.subst sub) s.s_params, T.subst sub s.s_ret)
let instantiate_with (s : scheme) (args : T.t list) =
let sub = List.map2 (fun v a -> (v, a)) s.s_gen args in
(List.map (T.subst sub) s.s_params, T.subst sub s.s_ret)
(* ------------------------------------------------------------------ *)
(* 내장 생성자 *)
(* ------------------------------------------------------------------ *)
let builtin_ctor = function
| "Ok" ->
let a = T.fresh () and b = T.fresh () in
Some ([ a ], T.TCon ("Result", [ a; b ]))
| "Err" ->
let a = T.fresh () and b = T.fresh () in
Some ([ b ], T.TCon ("Result", [ a; b ]))
| "Some" ->
let a = T.fresh () in
Some ([ a ], T.TCon ("Option", [ a ]))
| _ -> None
(* ------------------------------------------------------------------ *)
(**)
(* ------------------------------------------------------------------ *)
let rec infer env (e : expr) : T.t =
match e with
| E_lit (L_int _, _) -> T.TInt
| E_lit (L_str _, _) -> T.TString
| E_lit (L_bool _, _) -> T.TBool
| E_ident (n, _) -> (
match lookup env n with
| Some t -> t
| None -> (
match Hashtbl.find_opt env.consts n with
| Some t -> t
| None -> (
match n with
| "unit" -> T.TUnit
| "None" -> T.TCon ("Option", [ T.fresh () ])
| _ -> (
match Hashtbl.find_opt env.fns n with
| Some s ->
let params, ret = instantiate s in
T.TFn { affine = false; params; ret }
| None -> (
match Hashtbl.find_opt env.ctors n with
| Some enum -> nullary_ctor env enum n
| None -> T.TUnknown)))))
| E_list (xs, pos) ->
let elem = T.fresh () in
List.iter
(fun x ->
let t = infer env x in
if not (T.unify elem t) then
mismatch env pos elem t "리스트 원소의 타입이 서로 다릅니다")
xs;
T.TCon ("List", [ elem ])
| E_struct { name; fields; pos } -> infer_struct env name fields pos
| E_closure c -> infer_closure env c None
| E_if { cond; then_; else_; pos } -> (
let c = infer env cond in
if not (T.unify c T.TBool) then mismatch env pos T.TBool c "if의 조건";
let t1 = infer_block env then_ in
match else_ with
| None ->
if not (T.unify t1 T.TUnit) then
err env pos "else가 없는 if의 본문은 값을 남길 수 없습니다";
T.TUnit
| Some e2 ->
let t2 = infer env e2 in
if not (T.unify t1 t2) then mismatch env pos t1 t2 "if의 두 분기 타입이 다릅니다";
t1)
| E_match { scrutinee; arms; pos } ->
let s = infer env scrutinee in
let result = T.fresh () in
List.iter
(fun a ->
push env;
check_pattern env s a.arm_pat;
let t = infer env a.arm_body in
if not (T.unify result t) then
mismatch env a.arm_pos result t "match 팔의 타입이 서로 다릅니다";
pop env)
arms;
if arms = [] then err env pos "match에 팔이 없습니다";
result
| E_scope { name; parent; body; pos } ->
(match lookup env parent with
| Some t when not (T.unify t (T.TCon ("TaskScope", []))) ->
if T.resolve t <> T.TUnknown then
mismatch env pos (T.TCon ("TaskScope", [])) t "scope의 부모"
| _ -> ());
push env;
bind env name (T.TCon ("TaskScope", []));
let t = infer_block env body in
pop env;
t
| E_block b ->
push env;
let t = infer_block env b in
pop env;
t
| E_call { callee; args; pos } -> infer_call env callee args pos
| E_field { obj; name; pos } -> infer_field env obj name pos
| E_inst { callee; args; pos } -> infer_inst env callee args pos
| E_try { inner; pos } -> (
let t = infer env inner in
match T.resolve t with
| T.TUnknown -> T.TUnknown
| T.TCon ("Result", [ ok; _ ]) ->
(match T.resolve env.ret with
| T.TCon ("Result", _) | T.TUnknown -> ()
| r ->
err env pos
(Printf.sprintf "?는 Result를 반환하는 함수 안에서만 쓸 수 있습니다 (현재 반환 타입 %s)"
(T.show r)));
ok
| other ->
err env pos
(Printf.sprintf "?는 Result에만 쓸 수 있습니다 (%s에 쓰였습니다)" (T.show other));
T.TUnknown)
| E_unary { op; operand; pos } ->
let t = infer env operand in
let want = match op with U_not -> T.TBool | U_neg -> T.TInt in
if not (T.unify t want) then mismatch env pos want t "단항 연산자의 피연산자";
want
| E_binary { op; lhs; rhs; pos } -> (
let a = infer env lhs and b = infer env rhs in
match op with
| B_or | B_and ->
if not (T.unify a T.TBool) then mismatch env pos T.TBool a "논리 연산자";
if not (T.unify b T.TBool) then mismatch env pos T.TBool b "논리 연산자";
T.TBool
| B_add | B_sub | B_mul | B_div | B_rem ->
if not (T.unify a T.TInt) then mismatch env pos T.TInt a "산술 연산자";
if not (T.unify b T.TInt) then mismatch env pos T.TInt b "산술 연산자";
T.TInt
| B_lt | B_le | B_gt | B_ge ->
if not (T.unify a T.TInt) then mismatch env pos T.TInt a "비교 연산자";
if not (T.unify b T.TInt) then mismatch env pos T.TInt b "비교 연산자";
T.TBool
| B_eq | B_ne ->
if not (T.unify a b) then mismatch env pos a b "같은 타입끼리만 비교할 수 있습니다";
T.TBool)
and nullary_ctor env enum name =
match Hashtbl.find_opt env.enums enum with
| None -> T.TUnknown
| Some (gen, variants) -> (
let sub = List.map (fun v -> (v, T.fresh ())) gen in
match List.assoc_opt name variants with
| Some [] -> T.TCon (enum, List.map snd sub)
| _ -> T.TCon (enum, List.map snd sub))
and infer_struct env name fields pos =
match Hashtbl.find_opt env.structs name with
| None ->
List.iter (fun (_, e) -> ignore (infer env e)) fields;
T.TUnknown
| Some (gen, decl_fields) ->
let sub = List.map (fun v -> (v, T.fresh ())) gen in
List.iter
(fun (fname, fe) ->
match List.assoc_opt fname decl_fields with
| None -> err env pos (Printf.sprintf "%s에 %s 필드가 없습니다" name fname)
| Some ft ->
let want = T.subst sub ft in
let got = infer env fe in
if not (T.unify want got) then
mismatch env pos want got (Printf.sprintf "%s.%s 필드" name fname))
fields;
List.iter
(fun (fname, _) ->
if not (List.mem_assoc fname fields) then
err env pos (Printf.sprintf "%s의 %s 필드가 빠졌습니다" name fname))
decl_fields;
T.TCon (name, List.map snd sub)
and infer_closure env (c : closure) (expected : T.t option) =
let expected_params, expected_ret =
match Option.map T.resolve expected with
| Some (T.TFn { params; ret; _ })
when List.length params = List.length c.cl_params ->
(List.map Option.some params, Some ret)
| _ -> (List.map (fun _ -> None) c.cl_params, None)
in
push env;
let param_tys =
List.map2
(fun (n, ann) exp ->
let t =
match ann with
| Some a -> conv env [] a
| None -> ( match exp with Some t -> t | None -> T.TUnknown)
in
bind env n t;
t)
c.cl_params expected_params
in
let declared_ret = Option.map (conv env []) c.cl_ret in
let saved = env.ret in
env.ret <-
(match declared_ret with
| Some t -> t
| None -> ( match expected_ret with Some t -> t | None -> T.TUnknown));
let body = infer_block env c.cl_body in
(match declared_ret with
| Some t when not (T.unify t body) -> mismatch env c.cl_pos t body "클로저의 반환"
| _ -> ());
let ret = match declared_ret with Some t -> t | None -> body in
env.ret <- saved;
pop env;
T.TFn { affine = false; params = param_tys; ret }
and infer_call env callee args pos =
let fn_ty =
match callee with
| E_ident (n, _) when lookup env n = None -> (
match Hashtbl.find_opt env.ctors n with
| Some enum -> Some (ctor_fn env enum n)
| None -> (
match builtin_ctor n with
| Some (params, ret) -> Some (T.TFn { affine = false; params; ret })
| None -> (
match Hashtbl.find_opt env.fns n with
| Some s ->
let params, ret = instantiate s in
Some (T.TFn { affine = false; params; ret })
| None -> None)))
| _ -> (
match T.resolve (infer env callee) with
| T.TFn _ as t -> Some t
| _ -> None)
in
match fn_ty with
| None ->
List.iter (fun a -> ignore (infer env a)) args;
T.TUnknown
| Some (T.TFn { params; ret; _ }) ->
if List.length params <> List.length args then (
err env pos
(Printf.sprintf "인자 %d개가 필요한데 %d개가 주어졌습니다" (List.length params)
(List.length args));
List.iter (fun a -> ignore (infer env a)) args)
else
List.iter2
(fun p a ->
let got =
match a with
| E_closure c -> infer_closure env c (Some p)
| _ -> infer env a
in
if not (T.unify p got) then mismatch env pos p got "인자")
params args;
ret
| Some _ -> T.TUnknown
and ctor_fn env enum name =
match Hashtbl.find_opt env.enums enum with
| None -> T.TUnknown
| Some (gen, variants) ->
let sub = List.map (fun v -> (v, T.fresh ())) gen in
let params =
match List.assoc_opt name variants with
| Some ts -> List.map (T.subst sub) ts
| None -> []
in
T.TFn { affine = false; params; ret = T.TCon (enum, List.map snd sub) }
and infer_field env obj name pos =
let t = infer env obj in
match T.resolve t with
| T.TUnknown -> T.TUnknown
| T.TCon (cname, args) -> (
match Hashtbl.find_opt env.structs cname with
| Some (gen, fields) -> (
let sub = List.map2 (fun v a -> (v, a)) gen (adjust gen args) in
match List.assoc_opt name fields with
| Some ft -> T.subst sub ft
| None ->
err env pos (Printf.sprintf "%s에 %s 필드가 없습니다" cname name);
T.TUnknown)
| None -> (
match Hashtbl.find_opt env.caps cname with
| Some methods -> (
match List.assoc_opt name methods with
| Some s ->
let params, ret = instantiate s in
T.TFn { affine = false; params; ret }
| None ->
err env pos
(Printf.sprintf "capability %s에 %s 메서드가 없습니다" cname name);
T.TUnknown)
| None -> T.TUnknown))
| other ->
err env pos (Printf.sprintf "%s에는 필드가 없습니다" (T.show other));
T.TUnknown
and adjust gen args =
let n = List.length gen in
let rec take k xs =
if k = 0 then []
else
match xs with
| [] -> T.fresh () :: take (k - 1) []
| x :: r -> x :: take (k - 1) r
in
take n args
and infer_inst env callee args pos =
let tys =
List.filter_map
(function TA_ty t -> Some (conv env [] t) | TA_eff _ -> None)
args
in
match callee with
| E_ident (n, _) when lookup env n = None -> (
match Hashtbl.find_opt env.fns n with
| None -> T.TUnknown
| Some s ->
if List.length tys <> List.length s.s_gen then (
err env pos
(Printf.sprintf "타입 인자 %d개가 필요한데 %d개가 주어졌습니다"
(List.length s.s_gen) (List.length tys));
T.TUnknown)
else
let params, ret = instantiate_with s tys in
T.TFn { affine = false; params; ret })
| _ -> T.TUnknown
and check_pattern env (scrutinee : T.t) (p : pattern) =
match p with
| P_wild _ -> ()
| P_lit (l, pos) ->
let t =
match l with
| L_int _ -> T.TInt
| L_str _ -> T.TString
| L_bool _ -> T.TBool
in
if not (T.unify scrutinee t) then mismatch env pos scrutinee t "패턴의 리터럴"
| P_bind (n, _) -> (
match Hashtbl.find_opt env.ctors n with
| Some enum ->
check_ctor env scrutinee enum n [] Token.{ line = 0; col = 0 }
| None -> bind env n scrutinee)
| P_ctor { name; args; pos } -> (
match Hashtbl.find_opt env.ctors name with
| Some enum -> check_ctor env scrutinee enum name args pos
| None -> List.iter (check_pattern env T.TUnknown) args)
and check_ctor env scrutinee enum name args pos =
match Hashtbl.find_opt env.enums enum with
| None -> ()
| Some (gen, variants) ->
let sub = List.map (fun v -> (v, T.fresh ())) gen in
let ety = T.TCon (enum, List.map snd sub) in
if not (T.unify scrutinee ety) then
mismatch env pos scrutinee ety "패턴이 match 대상과 다른 타입입니다";
let fields =
match List.assoc_opt name variants with Some ts -> ts | None -> []
in
if List.length fields = List.length args then
List.iter2
(fun ft ap -> check_pattern env (T.subst sub ft) ap)
fields args
(* ------------------------------------------------------------------ *)
(* 문과 블록 *)
(* ------------------------------------------------------------------ *)
and infer_block env (b : block) : T.t =
let rec go = function
| [] -> T.TUnit
| [ S_expr e ] -> infer env e
| s :: rest ->
check_stmt env s;
go rest
in
go b.stmts
and check_stmt env = function
| S_let { pat; ty; value; pos; _ } ->
let declared = Option.map (conv env []) ty in
let got =
match (value, declared) with
| E_closure c, Some t -> infer_closure env c (Some t)
| _ -> infer env value
in
let t =
match declared with
| None -> got
| Some d ->
if not (T.unify d got) then mismatch env pos d got "let의 타입 주석";
d
in
check_pattern env t pat
| S_return { value; pos } ->
let got = match value with None -> T.TUnit | Some e -> infer env e in
if not (T.unify env.ret got) then mismatch env pos env.ret got "return의 값"
| S_assign { place; value; pos } ->
let p = infer env place in
let v = infer env value in
if not (T.unify p v) then mismatch env pos p v "대입"
| S_expr e -> ignore (infer env e)
(* ------------------------------------------------------------------ *)
(* 모듈 *)
(* ------------------------------------------------------------------ *)
let check_fn env (d : fn_decl) =
match d.fn_body with
| None -> ()
| Some body ->
let gen =
List.filter_map
(fun g -> if g.gp_effect then None else Some g.gp_name)
d.fn_gen
in
push env;
List.iter (fun p -> bind env p.p_name (conv env gen p.p_ty)) d.fn_params;
let declared =
match d.fn_ret with None -> T.TUnit | Some r -> conv env gen r
in
env.ret <- declared;
let got = infer_block env body in
if not (T.unify declared got) then
mismatch env d.fn_pos declared got
(Printf.sprintf "%s의 본문이 남기는 값" d.fn_name);
pop env
let check (m : modul) : error list =
let env =
{
structs = Hashtbl.create 16;
enums = Hashtbl.create 16;
caps = Hashtbl.create 16;
fns = Hashtbl.create 16;
consts = Hashtbl.create 16;
ctors = Hashtbl.create 16;
locals = [];
ret = T.TUnit;
errors = [];
}
in
(* 1차: 타입과 생성자 이름부터 (선언 순서에 의존하지 않는다) *)
List.iter
(fun it ->
match it with
| I_struct { name; gen; _ } ->
Hashtbl.replace env.structs name
(List.map (fun g -> g.gp_name) gen, [])
| I_enum { name; gen; variants; _ } ->
Hashtbl.replace env.enums name (List.map (fun g -> g.gp_name) gen, []);
List.iter (fun v -> Hashtbl.replace env.ctors v.v_name name) variants
| I_capability { name; _ } -> Hashtbl.replace env.caps name []
| _ -> ())
m.items;
(* 2차: 본문을 채운다 *)
List.iter
(fun it ->
match it with
| I_struct { name; gen; fields; _ } ->
let g = List.map (fun x -> x.gp_name) gen in
Hashtbl.replace env.structs name
(g, List.map (fun f -> (f.f_name, conv env g f.f_ty)) fields)
| I_enum { name; gen; variants; _ } ->
let g = List.map (fun x -> x.gp_name) gen in
Hashtbl.replace env.enums name
( g,
List.map
(fun v -> (v.v_name, List.map (conv env g) v.v_args))
variants )
| I_capability { name; methods; _ } ->
Hashtbl.replace env.caps name
(List.map (fun d -> (d.fn_name, scheme_of env d)) methods)
| I_fn { decl; _ } ->
Hashtbl.replace env.fns decl.fn_name (scheme_of env decl)
| I_const { name; ty; _ } ->
Hashtbl.replace env.consts name (conv env [] ty)
| _ -> ())
m.items;
(* 3차: 본문 검사 *)
List.iter
(fun it ->
env.locals <- [];
match it with
| I_fn { decl; _ } -> check_fn env decl
| I_const { ty; value; pos; _ } ->
let want = conv env [] ty in
let got = infer env value in
if not (T.unify want got) then mismatch env pos want got "상수의 값"
| _ -> ())
m.items;
List.sort
(fun a b ->
compare
(a.pos.Token.line, a.pos.Token.col)
(b.pos.Token.line, b.pos.Token.col))
(List.rev env.errors)
+93
View File
@@ -0,0 +1,93 @@
(* 타입 표현과 지역 unification.
TUnknown이 핵심이다. 외부 모듈에서 오는 이름은 모듈 로딩이 없는 v0에서
해소할 수 없다. 그런 타입은 TUnknown이 되고 무엇과도 맞는다 — 모르는 것을
틀렸다고 말하지 않기 위해서다. 아는 범위에서만 검사한다.
TMeta는 호출 지점에서 제네릭을 인스턴스화할 때 생기는 미지수다. 함수 하나
범위에서만 살고 전역으로 흐르지 않는다 (철학 2: 전역 추론 없음). *)
type t =
| TUnknown
| TInt
| TBool
| TString
| TUnit
| TVar of string
| TCon of string * t list
| TFn of { affine : bool; params : t list; ret : t }
| TMeta of meta ref
and meta = Unbound of int | Bound of t
let counter = ref 0
let fresh () =
incr counter;
TMeta (ref (Unbound !counter))
let rec resolve t =
match t with TMeta { contents = Bound u } -> resolve u | _ -> t
let rec show t =
match resolve t with
| TUnknown -> "?"
| TInt -> "Int"
| TBool -> "Bool"
| TString -> "String"
| TUnit -> "Unit"
| TVar v -> v
| TCon (n, []) -> n
| TCon (n, args) -> n ^ "[" ^ String.concat ", " (List.map show args) ^ "]"
| TFn { affine; params; ret } -> (
(if affine then "affine fn(" else "fn(")
^ String.concat ", " (List.map show params)
^ ")"
^ match resolve ret with TUnit -> "" | r -> " -> " ^ show r)
| TMeta { contents = Unbound n } -> Printf.sprintf "_%d" n
| TMeta { contents = Bound _ } -> "?"
let rec occurs r t =
match resolve t with
| TMeta r' -> r == r'
| TCon (_, args) -> List.exists (occurs r) args
| TFn { params; ret; _ } -> List.exists (occurs r) params || occurs r ret
| _ -> false
(* 성공하면 true. 실패해도 예외를 던지지 않는다 — 호출자가 위치를 알고
진단을 만든다. *)
let rec unify a b =
match (resolve a, resolve b) with
| TUnknown, _ | _, TUnknown -> true
| TMeta r, TMeta r' when r == r' -> true
| TMeta r, t | t, TMeta r ->
if occurs r t then false
else (
r := Bound t;
true)
| TInt, TInt | TBool, TBool | TString, TString | TUnit, TUnit -> true
| TVar x, TVar y -> x = y
| TCon (n, xs), TCon (m, ys) ->
n = m && List.length xs = List.length ys && List.for_all2 unify xs ys
| TFn f, TFn g ->
(* affinity는 타입 동등성의 일부가 아니다. 값이 affine인지는 무엇을
capture했는지로 정해지는 substructural 성질이고, move/affinity 검사가
소유한다. 여기서 섞으면 두 검사가 서로의 결론을 앞질러 버린다. *)
List.length f.params = List.length g.params
&& List.for_all2 unify f.params g.params
&& unify f.ret g.ret
| _ -> false
(* 제네릭 인스턴스화: TVar를 주어진 대입으로 바꾼다 *)
let rec subst env t =
match resolve t with
| TVar v -> ( match List.assoc_opt v env with Some u -> u | None -> TVar v)
| TCon (n, args) -> TCon (n, List.map (subst env) args)
| TFn f ->
TFn
{
affine = f.affine;
params = List.map (subst env) f.params;
ret = subst env f.ret;
}
| u -> u