open Syntax
open Value

(* 実際の計算をする関数 *)
(* Stack-based interpreter : eval4 *)

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

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

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

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