interp: 얇은 typed IR과 트리 워킹 인터프리터 — coolc run
문서에만 있던 실행 의미가 코드가 된다. - ir.ml: AST를 얇은 IR로 낮춘다. `?`는 Result에 대한 match로 펼쳐지고, 타입 인자는 사라지며(단형화 없음), 한정 이름은 하나의 이름으로 접힌다. 이름은 낮추기 시점에 분류된다 — 실행 중에 "지역인가 전역인가"를 다시 묻지 않는다. - interp.ml: 검사하지 않는 인터프리터. 여기 도달한 프로그램은 이미 타입, effect, capability, ownership 검사를 통과했고, 같은 질문을 두 번 묻는 것은 두 번째 진실을 만드는 일이다. 권한의 유일한 출처는 런타임이다. 소스에는 capability를 만드는 문법이 없고, main은 자기가 선언한 것만 받는다. 파라미터에서 Console을 지우면 출력할 방법이 프로그램 안에 없다 — 보안 정리 (i)의 실행 시점 대응물. TaskScope의 뿌리도 같은 이유로 런타임이 준다. scope의 v0 실행 의미는 순차다. 구조가 먼저고 병렬성은 그 위의 최적화다. samples/run/은 이제 "검사를 통과한다"가 아니라 "이 값을 낸다"까지 말하고, test/가 같은 것을 검사한다. Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_019ZVDeU6KLuUVL3gs18Hm3E
This commit is contained in:
+3
-4
@@ -2,7 +2,9 @@
|
||||
parse -> name resolution -> type check -> effect/capability check
|
||||
-> interface artifact + hash -> (coolc run 시) 얇은 typed IR -> interpreter
|
||||
|
||||
현재 구현된 단계: 어휘 분석, 구문 분석. *)
|
||||
이 파일은 단일 파일 도구(tokens/ast/deps)만 남았다. 모듈 그래프를 다루는
|
||||
check와 run은 Session이 소유한다 — import를 따라가야 하는 순간부터
|
||||
"파일 하나"는 더 이상 단위가 아니다. *)
|
||||
|
||||
type error = { file : string; line : int; col : int; message : string }
|
||||
|
||||
@@ -103,6 +105,3 @@ let check (files : string list) : (unit, error list) result =
|
||||
|> List.concat
|
||||
in
|
||||
if errors <> [] then Error errors else Ok ()
|
||||
|
||||
let run (file : string) : (unit, error list) result =
|
||||
Error [ { file; line = 0; col = 0; message = "interpreter가 아직 구현되지 않았습니다" } ]
|
||||
|
||||
+340
@@ -0,0 +1,340 @@
|
||||
(* 트리 워킹 인터프리터.
|
||||
|
||||
여기 도달한 프로그램은 이미 타입, effect, capability, ownership 검사를
|
||||
통과했다. 그러므로 이 파일은 검사하지 않는다 — 검사기가 이미 답한 질문을
|
||||
실행 시점에 다시 묻는 것은 두 번째 진실을 만드는 일이다.
|
||||
|
||||
실행 시점 오류로 남는 것은 검사기가 원리적으로 못 잡는 것뿐이다:
|
||||
0으로 나누기, 리스트 범위, 그리고 아직 없는 표준 라이브러리 이름.
|
||||
|
||||
권한의 유일한 출처는 런타임이다. 소스에는 capability를 만드는 문법이 없고,
|
||||
main은 자기가 선언한 capability만 받는다. 선언하지 않은 권한은 프로그램
|
||||
어디에도 존재하지 않는다 — 보안 정리 (i)의 실행 시점 대응물이다. *)
|
||||
|
||||
type value =
|
||||
| VUnit
|
||||
| VInt of int
|
||||
| VBool of bool
|
||||
| VStr of string
|
||||
| VList of value list
|
||||
| VStruct of string * (string * value ref) list
|
||||
| VEnum of string * string * value list (* enum, variant, 인자 *)
|
||||
| VClosure of { params : string list; body : Ir.t; env : env }
|
||||
| VFn of Ir.fn
|
||||
| VCtor of string * string * int (* 아직 인자를 안 받은 생성자 *)
|
||||
| VBuiltin of string
|
||||
| VNative of (value list -> value)
|
||||
| VCap of string * (string * (value list -> value)) list
|
||||
| VScope of string
|
||||
|
||||
and env = (string * value ref) list list
|
||||
|
||||
exception Return_exc of value
|
||||
exception Fail of Token.pos * string
|
||||
|
||||
let fail pos msg = raise (Fail (pos, msg))
|
||||
|
||||
let rec show = function
|
||||
| VUnit -> "unit"
|
||||
| VInt n -> string_of_int n
|
||||
| VBool b -> if b then "true" else "false"
|
||||
| VStr s -> s
|
||||
| VList xs -> "[" ^ String.concat ", " (List.map show xs) ^ "]"
|
||||
| VStruct (n, fs) ->
|
||||
n ^ "{"
|
||||
^ String.concat ", " (List.map (fun (k, v) -> k ^ ": " ^ show !v) fs)
|
||||
^ "}"
|
||||
| VEnum (_, v, []) -> v
|
||||
| VEnum (_, v, args) ->
|
||||
v ^ "(" ^ String.concat ", " (List.map show args) ^ ")"
|
||||
| VClosure _ | VFn _ | VBuiltin _ | VCtor _ | VNative _ -> "<fn>"
|
||||
| VCap (n, _) -> "<capability " ^ n ^ ">"
|
||||
| VScope n -> "<scope " ^ n ^ ">"
|
||||
|
||||
let rec eq a b =
|
||||
match (a, b) with
|
||||
| VInt x, VInt y -> x = y
|
||||
| VBool x, VBool y -> x = y
|
||||
| VStr x, VStr y -> x = y
|
||||
| VUnit, VUnit -> true
|
||||
| VList x, VList y -> List.length x = List.length y && List.for_all2 eq x y
|
||||
| VEnum (_, v1, a1), VEnum (_, v2, a2) ->
|
||||
v1 = v2 && List.length a1 = List.length a2 && List.for_all2 eq a1 a2
|
||||
| _ -> false
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* 환경 *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
let lookup (env : env) n =
|
||||
let rec go = function
|
||||
| [] -> None
|
||||
| s :: r -> (
|
||||
match List.assoc_opt n s with Some v -> Some v | None -> go r)
|
||||
in
|
||||
go env
|
||||
|
||||
let bind (env : env) n v : env =
|
||||
match env with s :: r -> ((n, ref v) :: s) :: r | [] -> [ [ (n, ref v) ] ]
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* 런타임이 제공하는 것 *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
let out = Buffer.create 1024
|
||||
|
||||
let root_capability name : value option =
|
||||
match name with
|
||||
| "Console" ->
|
||||
Some
|
||||
(VCap
|
||||
( "Console",
|
||||
[
|
||||
( "print",
|
||||
fun args ->
|
||||
List.iter (fun v -> Buffer.add_string out (show v)) args;
|
||||
Buffer.add_char out '\n';
|
||||
VUnit );
|
||||
] ))
|
||||
| "TaskScope" ->
|
||||
(* 루트 스코프. 구조적 동시성의 뿌리도 런타임이 준다 — 프로그램이
|
||||
스스로 만들 수 있으면 부모 없는 작업이 생긴다. *)
|
||||
Some (VScope "root")
|
||||
| _ -> None
|
||||
|
||||
let builtin pos name (args : value list) : value =
|
||||
match (name, args) with
|
||||
| "String.concat", [ VStr a; VStr b ] -> VStr (a ^ b)
|
||||
| "String.len", [ VStr a ] -> VInt (String.length a)
|
||||
| "Int.show", [ VInt n ] -> VStr (string_of_int n)
|
||||
| "Bool.show", [ VBool b ] -> VStr (if b then "true" else "false")
|
||||
| "List.len", [ VList xs ] -> VInt (List.length xs)
|
||||
| _ ->
|
||||
fail pos (Printf.sprintf "%s은(는) 런타임이 제공하지 않습니다 (표준 라이브러리가 아직 없습니다)" name)
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* 실행 *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
type st = { prog : Ir.program }
|
||||
|
||||
let rec eval st (env : env) (e : Ir.t) : value =
|
||||
match e with
|
||||
| Ir.I_unit -> VUnit
|
||||
| Ir.I_lit (Ast.L_int n) -> VInt (int_of_string n)
|
||||
| Ir.I_lit (Ast.L_str s) -> VStr s
|
||||
| Ir.I_lit (Ast.L_bool b) -> VBool b
|
||||
| Ir.I_ref (k, pos) -> eval_ref st env k pos
|
||||
| Ir.I_list xs -> VList (List.map (eval st env) xs)
|
||||
| Ir.I_make (n, fields) ->
|
||||
VStruct (n, List.map (fun (k, e) -> (k, ref (eval st env e))) fields)
|
||||
| Ir.I_closure c -> VClosure { params = c.c_params; body = c.c_body; env }
|
||||
| Ir.I_if { cond; then_; else_ } -> (
|
||||
match eval st env cond with
|
||||
| VBool true -> eval st ([] :: env) then_
|
||||
| _ -> eval st ([] :: env) else_)
|
||||
| Ir.I_match { scrutinee; arms; pos } ->
|
||||
let v = eval st env scrutinee in
|
||||
let rec go = function
|
||||
| [] -> fail pos "match에서 어떤 팔도 맞지 않았습니다"
|
||||
| (p, body) :: rest -> (
|
||||
match match_pat v p with
|
||||
| None -> go rest
|
||||
| Some binds ->
|
||||
let env =
|
||||
List.fold_left (fun e (n, v) -> bind e n v) ([] :: env) binds
|
||||
in
|
||||
eval st env body)
|
||||
in
|
||||
go arms
|
||||
| Ir.I_scope { name; body; _ } ->
|
||||
(* v0의 실행 의미: 자식 작업은 순차로 돈다. 블록을 나가는 것이 join이다.
|
||||
구조가 먼저고 병렬성은 그 위의 최적화다 — 순서가 반대면 취소와
|
||||
전파를 나중에 끼워 넣게 된다. *)
|
||||
let env = bind ([] :: env) name (VScope name) in
|
||||
eval st env body
|
||||
| Ir.I_seq (stmts, tail) ->
|
||||
let env = List.fold_left (fun env s -> exec st env s) ([] :: env) stmts in
|
||||
eval st env tail
|
||||
| Ir.I_call { callee; args; pos } ->
|
||||
let f = eval st env callee in
|
||||
let args = List.map (eval st env) args in
|
||||
apply st pos f args
|
||||
| Ir.I_field { obj; name; pos } -> (
|
||||
match eval st env obj with
|
||||
| VStruct (sn, fields) -> (
|
||||
match List.assoc_opt name fields with
|
||||
| Some r -> !r
|
||||
| None -> fail pos (Printf.sprintf "%s에 %s 필드가 없습니다" sn name))
|
||||
| VCap (cn, meths) -> (
|
||||
(* capability 메서드는 값을 통해서만 나온다. 여기가 권한이 코드로
|
||||
흐르는 유일한 통로다. *)
|
||||
match List.assoc_opt name meths with
|
||||
| Some f -> VNative f
|
||||
| None ->
|
||||
fail pos (Printf.sprintf "capability %s에 %s이(가) 없습니다" cn name))
|
||||
| VScope _ when name = "spawn" ->
|
||||
VNative
|
||||
(fun args ->
|
||||
match args with
|
||||
| [ f ] -> apply st pos f []
|
||||
| _ -> fail pos "spawn은 함수 하나를 받습니다")
|
||||
| other -> fail pos (Printf.sprintf "%s에는 필드가 없습니다" (show other)))
|
||||
| Ir.I_unary (op, e, pos) -> (
|
||||
match (op, eval st env e) with
|
||||
| Ast.U_not, VBool b -> VBool (not b)
|
||||
| Ast.U_neg, VInt n -> VInt (-n)
|
||||
| _ -> fail pos "단항 연산자의 피연산자가 맞지 않습니다")
|
||||
| Ir.I_binary (op, a, b, pos) -> eval_binary st env op a b pos
|
||||
|
||||
and eval_ref st env k pos =
|
||||
match k with
|
||||
| Ir.R_local n -> (
|
||||
match lookup env n with
|
||||
| Some r -> !r
|
||||
| None -> fail pos (Printf.sprintf "%s이(가) 묶여 있지 않습니다" n))
|
||||
| Ir.R_ctor (enum, name) -> (
|
||||
match Hashtbl.find_opt st.prog.Ir.ctors name with
|
||||
| Some (_, 0) -> VEnum (enum, name, [])
|
||||
| Some (_, n) -> VCtor (enum, name, n)
|
||||
| None -> VEnum (enum, name, []))
|
||||
| Ir.R_global n -> (
|
||||
match Hashtbl.find_opt st.prog.Ir.fns n with
|
||||
| Some f -> VFn f
|
||||
| None -> (
|
||||
match Hashtbl.find_opt st.prog.Ir.consts n with
|
||||
| Some e -> eval st [ [] ] e
|
||||
| None -> fail pos (Printf.sprintf "%s을(를) 찾을 수 없습니다" n)))
|
||||
| Ir.R_builtin n -> VBuiltin n
|
||||
|
||||
and apply st pos f args =
|
||||
match f with
|
||||
| VFn fn -> (
|
||||
let env = [ List.map2 (fun p a -> (p, ref a)) fn.Ir.fn_params args ] in
|
||||
try eval st env fn.Ir.fn_body with Return_exc v -> v)
|
||||
| VClosure { params; body; env } -> (
|
||||
let env = List.map2 (fun p a -> (p, ref a)) params args :: env in
|
||||
try eval st env body with Return_exc v -> v)
|
||||
| VCtor (enum, name, _) -> VEnum (enum, name, args)
|
||||
(* 고차 builtin은 여기서 처리한다 — apply를 다시 부를 수 있어야 하므로 *)
|
||||
| VBuiltin "List.each" -> (
|
||||
match args with
|
||||
| [ VList xs; f ] ->
|
||||
List.iter (fun x -> ignore (apply st pos f [ x ])) xs;
|
||||
VUnit
|
||||
| _ -> fail pos "List.each는 리스트와 함수를 받습니다")
|
||||
| VBuiltin "List.map" -> (
|
||||
match args with
|
||||
| [ VList xs; f ] -> VList (List.map (fun x -> apply st pos f [ x ]) xs)
|
||||
| _ -> fail pos "List.map은 리스트와 함수를 받습니다")
|
||||
| VBuiltin n -> builtin pos n args
|
||||
| VNative f -> f args
|
||||
| other -> fail pos (Printf.sprintf "%s은(는) 부를 수 없습니다" (show other))
|
||||
|
||||
and exec st env (s : Ir.stmt) : env =
|
||||
match s with
|
||||
| Ir.S_do e ->
|
||||
ignore (eval st env e);
|
||||
env
|
||||
| Ir.S_return (e, _) -> raise (Return_exc (eval st env e))
|
||||
| Ir.S_let (p, e, pos) -> (
|
||||
let v = eval st env e in
|
||||
match match_pat v p with
|
||||
| None -> fail pos "let 패턴이 값과 맞지 않습니다"
|
||||
| Some binds -> List.fold_left (fun e (n, v) -> bind e n v) env binds)
|
||||
| Ir.S_assign { place; value; pos } -> (
|
||||
let v = eval st env value in
|
||||
match place with
|
||||
| Ir.I_ref (Ir.R_local n, _) -> (
|
||||
match lookup env n with
|
||||
| Some r ->
|
||||
r := v;
|
||||
env
|
||||
| None -> fail pos (Printf.sprintf "%s이(가) 묶여 있지 않습니다" n))
|
||||
| Ir.I_field { obj; name; _ } -> (
|
||||
match eval st env obj with
|
||||
| VStruct (_, fields) -> (
|
||||
match List.assoc_opt name fields with
|
||||
| Some r ->
|
||||
r := v;
|
||||
env
|
||||
| None -> fail pos (Printf.sprintf "%s 필드가 없습니다" name))
|
||||
| _ -> fail pos "필드에 대입할 수 없습니다")
|
||||
| _ -> fail pos "대입할 수 없는 자리입니다")
|
||||
|
||||
and match_pat v (p : Ir.pat) : (string * value) list option =
|
||||
match (p, v) with
|
||||
| Ir.IP_wild, _ -> Some []
|
||||
| Ir.IP_bind n, _ -> Some [ (n, v) ]
|
||||
| Ir.IP_lit (Ast.L_int n), VInt m ->
|
||||
if int_of_string n = m then Some [] else None
|
||||
| Ir.IP_lit (Ast.L_str s), VStr t -> if s = t then Some [] else None
|
||||
| Ir.IP_lit (Ast.L_bool b), VBool c -> if b = c then Some [] else None
|
||||
| Ir.IP_ctor (name, ps), VEnum (_, vn, args) ->
|
||||
if name <> vn || List.length ps <> List.length args then None
|
||||
else
|
||||
List.fold_left2
|
||||
(fun acc p a ->
|
||||
match (acc, match_pat a p) with
|
||||
| Some xs, Some ys -> Some (xs @ ys)
|
||||
| _ -> None)
|
||||
(Some []) ps args
|
||||
| _ -> None
|
||||
|
||||
and eval_binary st env op a b pos =
|
||||
match op with
|
||||
(* 단축 평가. 오른쪽을 먼저 계산하면 && 의 의미가 달라진다 *)
|
||||
| Ast.B_and -> (
|
||||
match eval st env a with VBool false -> VBool false | _ -> eval st env b)
|
||||
| Ast.B_or -> (
|
||||
match eval st env a with VBool true -> VBool true | _ -> eval st env b)
|
||||
| _ -> (
|
||||
let x = eval st env a and y = eval st env b in
|
||||
match (op, x, y) with
|
||||
| Ast.B_eq, _, _ -> VBool (eq x y)
|
||||
| Ast.B_ne, _, _ -> VBool (not (eq x y))
|
||||
| Ast.B_lt, VInt m, VInt n -> VBool (m < n)
|
||||
| Ast.B_le, VInt m, VInt n -> VBool (m <= n)
|
||||
| Ast.B_gt, VInt m, VInt n -> VBool (m > n)
|
||||
| Ast.B_ge, VInt m, VInt n -> VBool (m >= n)
|
||||
| Ast.B_add, VInt m, VInt n -> VInt (m + n)
|
||||
| Ast.B_sub, VInt m, VInt n -> VInt (m - n)
|
||||
| Ast.B_mul, VInt m, VInt n -> VInt (m * n)
|
||||
| Ast.B_div, VInt _, VInt 0 -> fail pos "0으로 나눌 수 없습니다"
|
||||
| Ast.B_div, VInt m, VInt n -> VInt (m / n)
|
||||
| Ast.B_rem, VInt _, VInt 0 -> fail pos "0으로 나눌 수 없습니다"
|
||||
| Ast.B_rem, VInt m, VInt n -> VInt (m mod n)
|
||||
| _ -> fail pos "연산자의 피연산자 타입이 맞지 않습니다")
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* 진입 *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
(* main이 선언한 capability만 런타임이 넘긴다. 선언하지 않은 권한은
|
||||
프로그램 안에 존재하지 않는다. *)
|
||||
let run (prog : Ir.program) (main_params : (string * string) list) :
|
||||
(string, Token.pos * string) result =
|
||||
Buffer.clear out;
|
||||
let st = { prog } in
|
||||
match Hashtbl.find_opt prog.Ir.fns "main" with
|
||||
| None -> Error (Token.{ line = 0; col = 0 }, "main 함수가 없습니다")
|
||||
| Some fn -> (
|
||||
let args =
|
||||
List.map
|
||||
(fun (_, tyname) ->
|
||||
match root_capability tyname with
|
||||
| Some v -> Ok v
|
||||
| None ->
|
||||
Error (Printf.sprintf "런타임이 %s capability를 제공하지 않습니다" tyname))
|
||||
main_params
|
||||
in
|
||||
match List.find_opt Result.is_error args with
|
||||
| Some (Error m) -> Error (Token.{ line = 0; col = 0 }, m)
|
||||
| _ -> (
|
||||
let args = List.map Result.get_ok args in
|
||||
try
|
||||
ignore (apply st Token.{ line = 0; col = 0 } (VFn fn) args);
|
||||
Ok (Buffer.contents out)
|
||||
with
|
||||
| Fail (pos, msg) -> Error (pos, msg)
|
||||
| Return_exc _ -> Ok (Buffer.contents out)))
|
||||
@@ -0,0 +1,304 @@
|
||||
(* 얇은 typed IR.
|
||||
|
||||
왜 AST를 직접 해석하지 않는가 — 표면 문법이 실행 의미에 닿지 않는다는 것을
|
||||
구조로 강제하기 위해서다. v1이 백엔드를 무엇으로 바꾸든 소비하는 것은 이
|
||||
IR이고, 문법을 고쳐도 여기가 그대로면 실행 의미는 그대로다.
|
||||
|
||||
얇다는 것의 뜻: 새 개념을 만들지 않는다. 검사 단계가 이미 답한 질문을
|
||||
다시 묻지 않는다 — 여기 도달한 프로그램은 타입, effect, capability,
|
||||
ownership 검사를 모두 통과했다. 그래서 IR에는 타입 검사가 없다.
|
||||
|
||||
낮추기에서 사라지는 것:
|
||||
- E_try: Result에 대한 match로 펼친다. `?`는 설탕이다
|
||||
- E_inst: 타입 인자는 실행에 영향이 없다 (단형화 없음, 값 표현이 같다)
|
||||
- 한정 이름: "Alias.f" 하나의 이름으로 평탄화된다 (검사 단계와 같은 규칙) *)
|
||||
|
||||
type pos = Token.pos
|
||||
|
||||
(* 이름은 낮추기 시점에 분류된다. 실행 중에 "이게 지역인가 전역인가"를
|
||||
다시 묻지 않는다. *)
|
||||
type ref_kind =
|
||||
| R_local of string
|
||||
| R_global of string (* 이 프로그램의 함수 *)
|
||||
| R_ctor of string * string (* enum 이름, variant 이름 *)
|
||||
| R_builtin of string (* String.concat 등 런타임 제공 *)
|
||||
|
||||
type pat =
|
||||
| IP_wild
|
||||
| IP_lit of Ast.lit
|
||||
| IP_bind of string
|
||||
| IP_ctor of string * pat list (* variant 이름 *)
|
||||
|
||||
type t =
|
||||
| I_unit
|
||||
| I_lit of Ast.lit
|
||||
| I_ref of ref_kind * pos
|
||||
| I_list of t list
|
||||
| I_make of string * (string * t) list (* struct 생성 *)
|
||||
| I_closure of closure
|
||||
| I_if of { cond : t; then_ : t; else_ : t }
|
||||
| I_match of { scrutinee : t; arms : (pat * t) list; pos : pos }
|
||||
| I_scope of { name : string; body : t; pos : pos }
|
||||
| I_seq of stmt list * t (* 블록: 문 나열 + 꼬리 값 *)
|
||||
| I_call of { callee : t; args : t list; pos : pos }
|
||||
| I_field of { obj : t; name : string; pos : pos }
|
||||
| I_unary of Ast.unop * t * pos
|
||||
| I_binary of Ast.binop * t * t * pos
|
||||
|
||||
and stmt =
|
||||
| S_let of pat * t * pos
|
||||
| S_assign of { place : t; value : t; pos : pos }
|
||||
| S_return of t * pos
|
||||
| S_do of t
|
||||
|
||||
and closure = { c_params : string list; c_body : t; c_pos : pos }
|
||||
|
||||
type fn = { fn_name : string; fn_params : string list; fn_body : t }
|
||||
|
||||
type program = {
|
||||
fns : (string, fn) Hashtbl.t;
|
||||
(* variant 이름 -> (enum 이름, 인자 개수) *)
|
||||
ctors : (string, string * int) Hashtbl.t;
|
||||
caps : (string, string list) Hashtbl.t; (* capability -> 메서드 이름 *)
|
||||
consts : (string, t) Hashtbl.t;
|
||||
}
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* 낮추기 *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
let qual modl name = match modl with Some a -> a ^ "." ^ name | None -> name
|
||||
|
||||
(* 지역 이름 스택. 검사 단계가 아니라 분류만 한다 — 여기서 못 찾은 이름은
|
||||
전역이거나 생성자이거나 런타임 제공이다. *)
|
||||
type lctx = { prog : program; mutable locals : string list list }
|
||||
|
||||
let lpush c = c.locals <- [] :: c.locals
|
||||
let lpop c = match c.locals with _ :: r -> c.locals <- r | [] -> ()
|
||||
|
||||
let lbind c n =
|
||||
match c.locals with
|
||||
| s :: r -> c.locals <- (n :: s) :: r
|
||||
| [] -> c.locals <- [ [ n ] ]
|
||||
|
||||
let is_local c n = List.exists (fun s -> List.mem n s) c.locals
|
||||
|
||||
let builtins =
|
||||
[
|
||||
"String.concat";
|
||||
"String.len";
|
||||
"Int.show";
|
||||
"Bool.show";
|
||||
"List.len";
|
||||
"List.each";
|
||||
"List.map";
|
||||
"print";
|
||||
]
|
||||
|
||||
let classify c name =
|
||||
if is_local c name then R_local name
|
||||
else
|
||||
match Hashtbl.find_opt c.prog.ctors name with
|
||||
| Some (enum, _) -> R_ctor (enum, name)
|
||||
| None ->
|
||||
if Hashtbl.mem c.prog.fns name || Hashtbl.mem c.prog.consts name then
|
||||
R_global name
|
||||
else R_builtin name
|
||||
|
||||
let rec lower_pat c (p : Ast.pattern) : pat =
|
||||
match p with
|
||||
| Ast.P_wild _ -> IP_wild
|
||||
| Ast.P_lit (l, _) -> IP_lit l
|
||||
| Ast.P_bind (n, _) ->
|
||||
(* 인자 없는 생성자는 이름만 쓴다. 바인딩과 구별은 여기서 끝난다. *)
|
||||
if Hashtbl.mem c.prog.ctors n then IP_ctor (n, [])
|
||||
else (
|
||||
lbind c n;
|
||||
IP_bind n)
|
||||
| Ast.P_ctor { modl; name; args; _ } ->
|
||||
IP_ctor (qual modl name, List.map (lower_pat c) args)
|
||||
|
||||
let rec lower c (e : Ast.expr) : t =
|
||||
match e with
|
||||
| Ast.E_lit (l, _) -> I_lit l
|
||||
| Ast.E_ident (n, pos) -> I_ref (classify c n, pos)
|
||||
| Ast.E_list (xs, _) -> I_list (List.map (lower c) xs)
|
||||
| Ast.E_struct { name; fields; _ } ->
|
||||
I_make (name, List.map (fun (n, e) -> (n, lower c e)) fields)
|
||||
| Ast.E_closure cl ->
|
||||
lpush c;
|
||||
List.iter (fun (n, _) -> lbind c n) cl.cl_params;
|
||||
let body = lower_block c cl.cl_body in
|
||||
lpop c;
|
||||
I_closure
|
||||
{
|
||||
c_params = List.map fst cl.cl_params;
|
||||
c_body = body;
|
||||
c_pos = cl.cl_pos;
|
||||
}
|
||||
| Ast.E_if { cond; then_; else_; _ } ->
|
||||
let cond = lower c cond in
|
||||
lpush c;
|
||||
let t = lower_block c then_ in
|
||||
lpop c;
|
||||
let e =
|
||||
match else_ with
|
||||
| None -> I_unit
|
||||
| Some e ->
|
||||
lpush c;
|
||||
let v = lower c e in
|
||||
lpop c;
|
||||
v
|
||||
in
|
||||
I_if { cond; then_ = t; else_ = e }
|
||||
| Ast.E_match { scrutinee; arms; pos } ->
|
||||
let s = lower c scrutinee in
|
||||
let arms =
|
||||
List.map
|
||||
(fun (a : Ast.arm) ->
|
||||
lpush c;
|
||||
let p = lower_pat c a.arm_pat in
|
||||
let b = lower c a.arm_body in
|
||||
lpop c;
|
||||
(p, b))
|
||||
arms
|
||||
in
|
||||
I_match { scrutinee = s; arms; pos }
|
||||
| Ast.E_scope { name; body; pos; _ } ->
|
||||
lpush c;
|
||||
lbind c name;
|
||||
let b = lower_block c body in
|
||||
lpop c;
|
||||
I_scope { name; body = b; pos }
|
||||
| Ast.E_block b ->
|
||||
lpush c;
|
||||
let v = lower_block c b in
|
||||
lpop c;
|
||||
v
|
||||
| Ast.E_call { callee; args; pos } ->
|
||||
I_call { callee = lower c callee; args = List.map (lower c) args; pos }
|
||||
| Ast.E_field { obj; name; pos } -> (
|
||||
(* Alias.f / String.concat 처럼 이름공간 접근은 하나의 이름으로 접는다.
|
||||
값의 필드 접근과 구별되는 지점은 obj가 지역 이름이 아닌 것뿐이다. *)
|
||||
match obj with
|
||||
| Ast.E_ident (o, _) when not (is_local c o) ->
|
||||
I_ref (classify c (o ^ "." ^ name), pos)
|
||||
| _ -> I_field { obj = lower c obj; name; pos })
|
||||
| Ast.E_inst { callee; _ } -> lower c callee
|
||||
| Ast.E_try { inner; pos } ->
|
||||
(* `?`는 설탕이다: Ok(v) => v, Err(e) => return Err(e) *)
|
||||
I_match
|
||||
{
|
||||
scrutinee = lower c inner;
|
||||
arms =
|
||||
[
|
||||
(IP_ctor ("Ok", [ IP_bind "?v" ]), I_ref (R_local "?v", pos));
|
||||
( IP_ctor ("Err", [ IP_bind "?e" ]),
|
||||
I_seq
|
||||
( [
|
||||
S_return
|
||||
( I_call
|
||||
{
|
||||
callee = I_ref (R_ctor ("Result", "Err"), pos);
|
||||
args = [ I_ref (R_local "?e", pos) ];
|
||||
pos;
|
||||
},
|
||||
pos );
|
||||
],
|
||||
I_unit ) );
|
||||
];
|
||||
pos;
|
||||
}
|
||||
| Ast.E_unary { op; operand; pos } -> I_unary (op, lower c operand, pos)
|
||||
| Ast.E_binary { op; lhs; rhs; pos } ->
|
||||
I_binary (op, lower c lhs, lower c rhs, pos)
|
||||
|
||||
and lower_block c (b : Ast.block) : t =
|
||||
let rec go = function
|
||||
| [] -> I_unit
|
||||
| [ Ast.S_expr e ] -> lower c e
|
||||
| s :: rest -> (
|
||||
let s = lower_stmt c s in
|
||||
let tail = go rest in
|
||||
match tail with
|
||||
| I_seq (ss, t) -> I_seq (s :: ss, t)
|
||||
| t -> I_seq ([ s ], t))
|
||||
in
|
||||
go b.stmts
|
||||
|
||||
and lower_stmt c (s : Ast.stmt) : stmt =
|
||||
match s with
|
||||
| Ast.S_let { pat; value; pos; _ } ->
|
||||
let v = lower c value in
|
||||
(* 값을 먼저 낮춘다 — 바인딩은 그 뒤에야 보인다 *)
|
||||
S_let (lower_pat c pat, v, pos)
|
||||
| Ast.S_return { value; pos } ->
|
||||
S_return ((match value with Some e -> lower c e | None -> I_unit), pos)
|
||||
| Ast.S_assign { place; value; pos } ->
|
||||
S_assign { place = lower c place; value = lower c value; pos }
|
||||
| Ast.S_expr e -> S_do (lower c e)
|
||||
|
||||
let of_module ?(imports : Ast.item list = []) (m : Ast.modul) : program =
|
||||
let prog =
|
||||
{
|
||||
fns = Hashtbl.create 32;
|
||||
ctors = Hashtbl.create 32;
|
||||
caps = Hashtbl.create 8;
|
||||
consts = Hashtbl.create 8;
|
||||
}
|
||||
in
|
||||
let items = imports @ m.items in
|
||||
(* 1차: 이름부터. 낮추기가 이름을 분류하려면 전체가 먼저 보여야 한다. *)
|
||||
List.iter
|
||||
(fun (it : Ast.item) ->
|
||||
match it with
|
||||
| Ast.I_enum { name; variants; _ } ->
|
||||
List.iter
|
||||
(fun (v : Ast.variant) ->
|
||||
Hashtbl.replace prog.ctors v.v_name (name, List.length v.v_args))
|
||||
variants
|
||||
| Ast.I_capability { name; methods; _ } ->
|
||||
Hashtbl.replace prog.caps name
|
||||
(List.map (fun (d : Ast.fn_decl) -> d.fn_name) methods)
|
||||
| Ast.I_fn { decl; _ } when decl.fn_body <> None ->
|
||||
Hashtbl.replace prog.fns decl.fn_name
|
||||
{ fn_name = decl.fn_name; fn_params = []; fn_body = I_unit }
|
||||
| Ast.I_const { name; _ } -> Hashtbl.replace prog.consts name I_unit
|
||||
| _ -> ())
|
||||
items;
|
||||
(* builtin 생성자도 IR이 알아야 한다 *)
|
||||
List.iter
|
||||
(fun (v, e, n) -> Hashtbl.replace prog.ctors v (e, n))
|
||||
[
|
||||
("Ok", "Result", 1);
|
||||
("Err", "Result", 1);
|
||||
("Some", "Option", 1);
|
||||
("None", "Option", 0);
|
||||
];
|
||||
(* 2차: 본문 *)
|
||||
let c = { prog; locals = [] } in
|
||||
List.iter
|
||||
(fun (it : Ast.item) ->
|
||||
match it with
|
||||
| Ast.I_fn { decl; _ } -> (
|
||||
match decl.fn_body with
|
||||
| None -> ()
|
||||
| Some body ->
|
||||
c.locals <- [];
|
||||
lpush c;
|
||||
List.iter (fun (p : Ast.param) -> lbind c p.p_name) decl.fn_params;
|
||||
let b = lower_block c body in
|
||||
lpop c;
|
||||
Hashtbl.replace prog.fns decl.fn_name
|
||||
{
|
||||
fn_name = decl.fn_name;
|
||||
fn_params =
|
||||
List.map (fun (p : Ast.param) -> p.p_name) decl.fn_params;
|
||||
fn_body = b;
|
||||
})
|
||||
| Ast.I_const { name; value; _ } ->
|
||||
c.locals <- [];
|
||||
Hashtbl.replace prog.consts name (lower c value)
|
||||
| _ -> ())
|
||||
items;
|
||||
prog
|
||||
@@ -179,3 +179,47 @@ let errors st =
|
||||
compare (a.file, a.line, a.col) (b.file, b.line, b.col))
|
||||
|
||||
let find st path = Hashtbl.find_opt st.modules path
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* 실행 *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
(* main이 선언한 파라미터의 타입 이름을 뽑는다. 런타임은 이 목록만 보고
|
||||
권한을 만든다 — 선언하지 않은 capability는 프로그램에 존재하지 않는다. *)
|
||||
let main_params (m : Ast.modul) =
|
||||
let rec ty_name (t : Ast.ty) =
|
||||
match t with
|
||||
| Ast.T_named { modl; name; _ } -> (
|
||||
match modl with Some a -> a ^ "." ^ name | None -> name)
|
||||
| Ast.T_fn _ -> "<fn>"
|
||||
in
|
||||
List.concat_map
|
||||
(function
|
||||
| Ast.I_fn { decl; _ } when decl.fn_name = "main" ->
|
||||
List.map
|
||||
(fun (p : Ast.param) -> (p.p_name, ty_name p.p_ty))
|
||||
decl.fn_params
|
||||
| _ -> [])
|
||||
m.items
|
||||
|
||||
let run st path : (string, error) result =
|
||||
load st path;
|
||||
let errs = errors st in
|
||||
if errs <> [] then Error (List.hd errs)
|
||||
else
|
||||
match find st path with
|
||||
| None ->
|
||||
Error { file = path; line = 0; col = 0; message = "모듈을 찾을 수 없습니다" }
|
||||
| Some e -> (
|
||||
let dep_surface =
|
||||
List.concat_map
|
||||
(fun (alias, p) ->
|
||||
match Hashtbl.find_opt st.modules p with
|
||||
| Some d -> Iface.qualify alias d.iface.Iface.items
|
||||
| None -> [])
|
||||
e.imports
|
||||
in
|
||||
let prog = Ir.of_module ~imports:dep_surface e.ast in
|
||||
match Interp.run prog (main_params e.ast) with
|
||||
| Ok out -> Ok out
|
||||
| Error (pos, msg) -> Error (err_of path pos msg))
|
||||
|
||||
Reference in New Issue
Block a user