open Syntax
open Value

(* 実際の計算をする関数 *)
(* Delinearized interpreter : eval5 *)

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

(* cons : c -> t -> t *)
let rec cons c s t = match t with
    TNil -> Trail (c, s)
  | Trail (c', s') -> Trail (CAppend (c, c'), SAppend (s, s'))

(* apnd : t -> t -> t *)
let apnd t0 t1 = match t0 with
    TNil -> t1
  | Trail (c, s) -> cons c s t1

(* run_c5 : c -> v -> s -> t -> v *)
let rec run_c5 c v s t = match (c, s) with
    (C0, SNil) ->
    begin match t with
        TNil -> v
      | Trail (c, s) -> run_c5 c v s TNil
    end
  | (CApp0 (e1, xs, c), SCons (VEnv (vs), s)) ->
    f5 e1 xs vs (SCons (v, s)) (CApp1 (c)) t
  | (CApp1 (c), SCons (v0, s)) ->
    begin match v0 with
        VFun (e, x, xs, vs) -> f5 e (x :: xs) (v :: vs) s c t
      | VCont (c', s', t') -> run_c5 c' v s' (apnd t' (cons c s t))
      | _ -> failwith "not app"
    end
  | (COp0 (e1, xs, op, c), SCons (VEnv (vs), s)) ->
    f5 e1 xs vs (SCons (v, s)) (COp1 (op, c)) t
  | (COp1 (op, c), SCons (v0, s)) ->
    begin match (v0, v) with
        (VNum (n0), VNum (n1)) ->
        begin match op with
            Plus -> run_c5 c (VNum (n0 + n1)) s t
          | Minus -> run_c5 c (VNum (n0 - n1)) s t
          | Times -> run_c5 c (VNum (n0 * n1)) s t
          | Divide ->
            if n1 = 0 then failwith "Division by zero"
            else run_c5 c (VNum (n0 / n1)) s t
        end
      | _ -> failwith "op is only Num"
    end
  | (CAppend (c, c'), SAppend (s, s')) -> run_c5 c v s (cons c' s' t)
  | _ -> failwith "cont and stack error"

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

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