open Syntax
open Value

(* 実際の計算をする関数 *)
(* Refunctionalized interpreter : eval6 *)

(* 初期継続 *)
let idc v s t = match s with
    SNil -> 
    begin match t with
        TNil -> v
      | Trail (c, s) -> c v s TNil
    end
  | _ -> failwith "stack error"

(* cons : c -> s -> t -> t *)
let rec cons c s t = match t with
    TNil -> Trail (c, s)
  | Trail (c', s') ->
    Trail (
      (fun v s t ->
        begin match s with
            SAppend (s, s') -> c v s (cons c' s' t)
          | _ -> failwith "stack error"
        end), 
      SAppend (s, s'))

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

(* f6 : e -> string list -> v list -> s -> c -> t -> v *)
let rec f6 e xs vs s c t = match e with
    Num (n) -> c (VNum (n)) s t
  | Var (x) -> c (List.nth vs (Env.offset x xs)) s t
  | Op (e0, op, e1) ->
    f6 e0 xs vs (SCons (VEnv (vs), s)) (fun v0 s0 t0 ->
        begin match s0 with
            SCons (VEnv (vs), s) ->
            f6 e1 xs vs (SCons (v0, s)) (fun v1 s1 t1 ->
                begin match s1 with
                    SCons (v0, s) ->
                    begin match (v0, v1) with
                        (VNum (n0), VNum (n1)) ->
                        begin match op with
                            Plus -> c (VNum (n0 + n1)) s t1
                          | Minus -> c (VNum (n0 - n1)) s t1
                          | Times -> c (VNum (n0 * n1)) s t1
                          | Divide ->
                            if n1 = 0 then failwith "Division by zero"
                            else c (VNum (n0 / n1)) s t1
                        end
                      | _ -> failwith "op is only Num"
                    end
                  | _ -> failwith "stack error"
                end) t0
          | _ -> failwith "stack error"
        end) t
  | Fun (x, e) ->
    c (VFun (fun v s' c' t' -> f6 e (x :: xs) (v :: vs) s' c' t')) s t
  | App (e0, e1) ->
    f6 e0 xs vs (SCons (VEnv (vs), s)) (fun v0 s0 t0 ->
        begin match s0 with
            SCons (VEnv (vs), s) ->
            f6 e1 xs vs (SCons (v0, s)) (fun v1 s1 t1 ->
                begin match s1 with
                    SCons (v0, s) ->
                    begin match v0 with
                        VFun (f) -> f v1 s c t1
                      | VCont (c', s', t') -> c' v1 s' (apnd t' (cons c s t1))
                      | _ -> failwith "not app"
                    end
                  | _ -> failwith "stack error"
                end) t0
          | _ -> failwith "stack error"
        end) t
  | Control (x, e) -> f6 e (x :: xs) (VCont (c, s, t) :: vs) SNil idc TNil
  | Prompt (e) -> c (f6 e xs vs SNil idc TNil) s t

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