open Syntax open Value (* 実際の計算をする関数 *) (* Linearized interpreter : eval3 *) (* 初期継続 *) let idc = CNil (* cons : c -> t -> t *) let rec cons c t = match t with TNil -> Trail (c) | Trail (c') -> Trail (CAppend (c, c')) (* apnd : t -> t -> t *) let apnd t0 t1 = match t0 with TNil -> t1 | Trail (c) -> cons c t1 (* run_c3 : c -> v -> t -> v *) let rec run_c3 c v t = match c with CNil -> begin match t with TNil -> v | Trail (c) -> run_c3 c v TNil end | CCons (CApp0 (e1, xs, vs), c) -> f3 e1 xs vs (CCons (CApp1 (v), c)) t | CCons (CApp1 (v0), c) -> begin match v0 with VFun (e, x, xs, vs) -> f3 e (x :: xs) (v :: vs) c t | VCont (c', t') -> run_c3 c' v (apnd t' (cons c t)) | _ -> failwith "not app" end | CCons (COp0 (e1, xs, vs, op), c) -> f3 e1 xs vs (CCons (COp1 (v, op),c)) t | CCons (COp1 (v0, op), c) -> begin match (v0, v) with (VNum (n0), VNum (n1)) -> begin match op with Plus -> run_c3 c (VNum (n0 + n1)) t | Minus -> run_c3 c (VNum (n0 - n1)) t | Times -> run_c3 c (VNum (n0 * n1)) t | Divide -> if n1 = 0 then failwith "Division by zero" else run_c3 c (VNum (n0 / n1)) t end | _ -> failwith "op is only Num" end | CAppend (c, c') -> run_c3 c v (cons c' t) (* f3 : e -> string list -> v list -> c -> t -> v *) and f3 e xs vs c t = match e with Num (n) -> run_c3 c (VNum (n)) t | Var (x) -> run_c3 c (List.nth vs (Env.offset x xs)) t | Op (e0, op, e1) -> f3 e0 xs vs (CCons (COp0 (e1, xs, vs, op), c)) t | Fun (x, e) -> run_c3 c (VFun (e, x, xs, vs)) t | App (e0, e1) -> f3 e0 xs vs (CCons (CApp0 (e1, xs, vs), c)) t | Control (x, e) -> f3 e (x :: xs) (VCont (c, t) :: vs) idc TNil | Prompt (e) -> run_c3 c (f3 e xs vs idc TNil) t (* Eval.f : t -> v *) let f expr = f3 expr [] [] idc TNil