open Syntax
open Value

(* 実際の計算をする関数 *)
(* Interpreter with linear trail : eval12 *)

(* run_c12 : c -> s -> t -> m -> v *)
let rec run_c12 c s t m = match (c, s) with
    ([], v :: []) ->
    begin match t with
        [] ->
        begin match m with
            [] -> v
          | ((c, s) :: t) :: m -> run_c12 c (v :: s) t m
          | _ -> failwith "meta error"
        end
      | (c, s) :: t -> run_c12 c (v :: s) t m
    end
  | (INum (v) :: c, VEnv (vs) :: s) -> run_c12 c (v :: s) t m
  | (IAccess (n) :: c, VEnv (vs) :: s) -> run_c12 c ((List.nth vs n) :: s) t m
  | (IPush_closure (c') :: c, VEnv (vs) :: s) ->
    run_c12 c (VFun (c', vs) :: s) t m
  | (IReturn :: _, v :: VK (c) :: s) -> run_c12 c (v :: s) t m
  | (IPush_env :: c, VEnv (vs) :: s) ->
     run_c12 c (VEnv (vs) :: VEnv (vs) :: s) t m
  | (IPop_env :: c, v :: VEnv (vs) :: s) -> run_c12 c (VEnv (vs) :: v :: s) t m
  | (IOperations (op) :: c, v1 :: v0 :: s) ->
    begin match (v0, v1) with
        (VNum (n0), VNum (n1)) ->
        begin match op with
            Plus -> run_c12 c (VNum (n0 + n1) :: s) t m
          | Minus -> run_c12 c (VNum (n0 - n1) :: s) t m
          | Times -> run_c12 c (VNum (n0 * n1) :: s) t m
          | Divide ->
            if n1 = 0 then failwith "Division by zero"
            else run_c12 c (VNum (n0 / n1) :: s) t m
        end
      | _ -> failwith "op is number only"
    end
  | (ICall :: c, v1 :: v0 :: s) ->
    begin match v0 with
        VFun (c', vs) -> run_c12 c' (VEnv (v1 :: vs) :: VK (c) :: s) t m
      | VCont ((c', s') :: t') -> run_c12 c' (v1 :: s') (t' @ ((c, s) :: t)) m
      | _ -> failwith ("not app " ^ to_string v0)
    end
  | (IControl (c') :: c, VEnv (vs) :: s) ->
    run_c12 c' [VEnv (VCont ((c, s) :: t) :: vs)] [] m
  | (IPrompt (c') :: c, VEnv (vs) :: s) ->
    run_c12 c' [VEnv (vs)] [] (((c, s) :: t) :: m)
  | _ -> failwith "cont or stack error"

(* f12 : e -> string list -> c *)
let rec f12 e xs = match e with
    Num (n) -> [INum (VNum (n))]
  | Var (x) -> [IAccess (Env.offset x xs)]
  | Op (e0, op, e1) ->
    [IPush_env] @ (f12 e0 xs) @ [IPop_env] @ (f12 e1 xs) @ [IOperations (op)]
  | Fun (x, e) -> [IPush_closure ((f12 e (x :: xs)) @ [IReturn])]
  | App (e0, e1) ->
    [IPush_env] @ (f12 e0 xs) @ [IPop_env] @ (f12 e1 xs) @ [ICall]
  | Control (x, e) -> [IControl (f12 e (x :: xs))]
  | Prompt (e) -> [IPrompt (f12 e xs)]

(* f : e -> v *)
let f expr = run_c12 (f12 expr []) [VEnv ([])] [] []