open Syntax
open Value

(* 実際の計算をする関数 *)
(* Defunctionalized interpreter : eval2 *)

(* 初期継続 *)
let idc = C0

(* 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_c2 : c -> v -> t -> v *)
let rec run_c2 c v t = match c with
    C0 ->
    begin match t with
        TNil -> v
      | Trail (c) -> run_c2 c v TNil
    end
  | CApp0 (e1, xs, vs, c) -> f2 e1 xs vs (CApp1 (v, c)) t
  | CApp1 (v0, c) ->
    begin match v0 with
        VFun (e, x, xs, vs) -> f2 e (x :: xs) (v :: vs) c t
      | VCont (c', t') -> run_c2 c' v (apnd t' (cons c t))
      | _ -> failwith "not app"
    end
  | COp0 (e1, xs, vs, op, c) -> f2 e1 xs vs (COp1 (v, op, c)) t
  | COp1 (v0, op, c) ->
    begin match (v0, v) with
        (VNum (n0), VNum (n1)) ->
        begin match op with
            Plus -> run_c2 c (VNum (n0 + n1)) t
          | Minus -> run_c2 c (VNum (n0 - n1)) t
          | Times -> run_c2 c (VNum (n0 * n1)) t
          | Divide ->
            if n1 = 0 then failwith "Division by zero"
            else run_c2 c (VNum (n0 / n1)) t
        end
      | _ -> failwith "op is only VNum"
    end
  | CAppend (c, c') -> run_c2 c v (cons c' t)

(* f2 : e -> string list -> v list -> c -> t -> v *)
and f2 e xs vs c t = match e with
    Num (n) -> run_c2 c (VNum (n)) t
  | Var (x) -> run_c2 c (List.nth vs (Env.offset x xs)) t
  | Op (e0, op, e1) -> f2 e0 xs vs (COp0 (e1, xs, vs, op, c)) t
  | Fun (x, e) -> run_c2 c (VFun (e, x, xs, vs)) t
  | App (e0, e1) -> f2 e0 xs vs (CApp0 (e1, xs, vs, c)) t
  | Control (x, e) -> f2 e (x :: xs) (VCont (c, t) :: vs) idc TNil
  | Prompt (e) -> run_c2 c (f2 e xs vs idc TNil) t

(* f : e -> v *)
let f expr = f2 expr [] [] idc TNil