open Syntax
open Value

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

(* cons : c -> s -> 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_c11 : c -> s -> t -> m -> v *)
let rec run_c11 c s t m = match (c, s) with
    (CNil, SCons (v, SNil)) ->
    begin match t with
        TNil ->
        begin match m with
            [] -> v
          | (c, s, t) :: m -> run_c11 c (SCons (v, s)) t m
        end
      | Trail (c, s) -> run_c11 c (SCons (v, s)) TNil m
    end
  | (CCons (INum (v), c), SCons (VEnv (vs), s)) -> run_c11 c (SCons (v, s)) t m
  | (CCons (IAccess (n), c), SCons (VEnv (vs), s)) ->
    run_c11 c (SCons (List.nth vs n, s)) t m
  | (CCons (IPush_closure (c'), c), SCons (VEnv (vs), s)) ->
    run_c11 c (SCons (VFun (c', vs), s)) t m
  | (CCons (IReturn, _), SCons (v, SCons (VK (c), s))) ->
    run_c11 c (SCons (v, s)) t m
  | (CCons (IPush_env, c), SCons (VEnv (vs), s)) ->
    run_c11 c (SCons (VEnv (vs), SCons (VEnv (vs), s))) t m
  | (CCons (IPop_env, c), SCons (v, SCons (VEnv (vs), s))) ->
    run_c11 c (SCons (VEnv (vs), SCons (v, s))) t m
  | (CCons (IOperations (op), c), SCons (v1, SCons (v0, s))) ->
    begin match (v0, v1) with
        (VNum (n0), VNum (n1)) ->
        begin match op with
            Plus -> run_c11 c (SCons (VNum (n0 + n1), s)) t m
          | Minus -> run_c11 c (SCons (VNum (n0 - n1), s)) t m
          | Times -> run_c11 c (SCons (VNum (n0 * n1), s)) t m
          | Divide ->
            if n1 = 0 then failwith "Division by zero"
            else run_c11 c (SCons (VNum (n0 / n1), s)) t m
        end
      | _ -> failwith "op is number only"
    end
  | (CCons (ICall, c), SCons (v1, SCons (v0, s))) ->
    begin match v0 with
        VFun (c', vs) ->
        run_c11 c' (SCons (VEnv (v1 :: vs), SCons (VK (c), s))) t m
      | VCont (c', s', t') ->
        run_c11 c' (SCons (v1, s')) (apnd t' (cons c s t)) m
      | _ -> failwith ("not app " ^ to_string v0)
    end
  | (CCons (IControl (c'), c), SCons (VEnv (vs), s)) ->
    run_c11 c' (SCons (VEnv (VCont (c, s, t) :: vs), SNil)) TNil m
  | (CCons (IPrompt (c'), c), SCons (VEnv (vs), s)) ->
    run_c11 c' (SCons (VEnv (vs), SNil)) TNil ((c, s, t) :: m)
  | (CAppend (c, c'), SCons (v, SAppend (s, s'))) ->
    run_c11 c (SCons (v, s)) (cons c' s' t) m
  | _ -> failwith "cont or stack error"

(* at : c -> c -> c *)
let rec at c0 c1 = match c0 with
    CNil -> c1
  | CCons (i, c) -> CCons (i, at c c1)
  | _ -> failwith "cons list error"


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

(* f : e -> v *)
let f expr = run_c11 (f11 expr []) (SCons (VEnv ([]), SNil)) TNil []