open List
open Minijavaast
open Mp6common

(* MP6 interpreter - no objects, arrays, or floats; just one class;
   limited set of statements.  See MP5 write-up for details. *)
let rec asgn (id:id) (v:stackvalue) (env:environment) : environment = match env with
  (x,y)::t -> if x = id then (x,v)::t else (x,y)::(asgn id v t)
  | [] -> raise (TypeError ("broken"))


let rec binds (id:id) (env:environment) : bool = match env with
  (x,y)::t -> if x = id then true else (binds id t)
  | [] -> false


let rec fetch (id:id) (env:environment) : stackvalue = match env with
  (x,y)::t -> if x = id then y else (fetch id t)
  | [] -> raise(TypeError("Not in state"))


let rec mklist (i:int) (v:stackvalue) : stackvalue list = match i with
  0 -> []
  | _ -> v::(mklist (i - 1) v)

let rec zip (lis1:id list) (lis2:stackvalue list) : environment = match lis1,lis2 with
  [],[] -> []
  | x::xt,y::yt -> if List.length lis1 <> List.length lis2 then raise(TypeError("Suck")) else (x,y)::(zip xt yt)

let rec zipscalar (lis:id list) (v:stackvalue) : environment = match lis with
  [] -> []
  | a::b -> (a,v)::(zipscalar b v)

let rec varnames (varlis:var_decl list) : id list = match varlis with
  [] -> []
  | Var(a,b)::t -> b::(varnames t)

let rec getMethodAux (id:id) methlis : method_decl  = match methlis with
  [] -> raise (TypeError("Dicks"))
  | ((Method(_,x,_,_,_,_)) as meth)::t ->  if x = id then meth else getMethodAux id t

let getMethodInClass (id:id) (Class(_, _, _, methlis)) : method_decl =
  getMethodAux id methlis

let extend (st:store) (hval:heapvalue) : store =
  st @ [hval]

let rec storefetch (st:store) (loc:int) : heapvalue = match st, loc with
  x::y, 0 -> x
  | x::y, l -> storefetch y (l-1)

let asgn_fld (obj:heapvalue) (id:varname) (sv:stackvalue) : heapvalue = match obj with
    Object(a,b) -> Object(a,(asgn id sv b))
    | _ -> raise (TypeError("FEFWEFEW"))


let rec asgn_sto (sto:store) (loc:int) (obj:heapvalue) = match sto, loc with
  x::y, 0 -> [obj]@ y
  | x::y, _ -> [x] @ (asgn_sto y (loc-1) obj)

let rec getClass (c:id) (Program classlis) : class_decl = match classlis with
 [] -> raise (TypeError("Dicksandhalf"))
 | Class(name,f,u,k)::y -> if c = name then Class(name,f,u,k) else getClass c (Program y)

let rec getMethod (id:id) (c:id) (prog:program) : method_decl =
  match (getClass c prog) with
    Class(name, "", f, methlis) -> (
  let rec aux methlis = match methlis with
          [] -> raise (TypeError ("No such method: "^id))
        | (Method(_, m, _, _, _, _) as themethod) :: t ->
        if id=m then themethod else aux t
        in aux methlis
    )
  | Class(name, sup, f, methlis) -> (
    let rec aux methlis = match methlis with
      [] -> getMethod id sup prog
    | (Method(_, m, _, _, _, _) as themethod) :: t ->
        if id=m then themethod else aux t
    in aux methlis
    )


let rec fieldsaux fieldlis:  string list  = match fieldlis with
  [] -> []
  | (_,Var(b,c))::d ->  c::(fieldsaux d )

let rec fields (cls:id) (prog:program) : string list =
  match (getClass cls prog) with
  Class(name,sup,f,m) as x -> fieldsaux f @ (fields sup prog)
  | Class(name, "", f, m) as x -> fieldsaux f
  | _ -> []

let applyOp (bop:binary_operation)
            (v1:stackvalue) (v2:stackvalue) : stackvalue = match bop with
   Multiplication -> (match v1, v2 with
        IntV(v1), IntV(v2) -> IntV(v1*v2)
        |_,_ -> raise (TypeError("LOLUCANTMULTTHAT")))
  | Plus ->  (match v1, v2 with
    IntV(v1), IntV(v2) -> IntV(v1+v2)
    | IntV(v1), StringV(v2) -> StringV( string_of_int(v1)^v2)
    | StringV(v1), IntV(v2) -> StringV( v1^(string_of_int(v2)))
    | StringV(v1), StringV(v2) -> StringV(v1^v2)
    | BoolV(v1), StringV(v2) -> StringV(string_of_bool(v1)^v2)
    | StringV(v1), BoolV(v2) -> StringV  (v1^string_of_bool(v2))
    | _,_ -> raise (TypeError("UCANTADDDAT"))
    | _ -> raise (TypeError("UCENWE"))
    )
  | Division -> (match v1, v2 with
    IntV(v1), IntV(v2) -> if v2 = 0 then raise(RuntimeError("DivisionByZero")) else IntV(v1/v2)
    | _ ,_-> raise (TypeError("UNODIVIDE")))
  | Minus -> (match v1, v2 with
    IntV(v1), IntV(v2) -> IntV(v1-v2)
    |_,_-> raise( TypeError("Minus, THAT?ucwasy")))
  | LessThan ->(match v1, v2 with
    IntV(v1), IntV(v2) -> BoolV(v1<v2)
    |_,_ -> raise (TypeError("UlessthanME")))
  | Equals ->(match v1, v2 with
    IntV(v1), IntV(v2) -> BoolV(v1=v2)
    | StringV(v1), StringV(v2) -> BoolV(v1=v2)
    | BoolV(v1), BoolV(v2) -> BoolV(v1=v2)
    | NullV, NullV -> BoolV(true)
    | NullV, _ -> BoolV(false)
    | _, NullV -> BoolV(false)
    | _,_ -> raise(TypeError("noequal")))
  | _ -> raise (TypeError("NOBOPS"))

let rec eval (e:exp) ((env,sto) as sigma:state) (prog:program)
       : stackvalue * store = match e with
    Null -> ((NullV),sto)
  | True -> BoolV(true),sto
  | False -> BoolV(false),sto
  | Integer i -> IntV(i),sto
  | String i -> StringV(i),sto
  | This -> (fetch "this" env), sto
  | Not b -> (match (eval b sigma prog) with
    BoolV f, sto2 -> (BoolV(not f), sto2)
    | _ -> raise (TypeError("ffff")))
  | Operation(v1,And,v2) -> (match (eval v1 sigma prog) with
    BoolV b, sto2 -> if b = true then (eval v2 sigma prog)
    else BoolV(false),sto2
    |_ -> raise(TypeError("AND")))

  | Operation(v1,Or, v2) -> (match (eval v1 sigma prog) with
    BoolV b, sto2 -> if b = true then BoolV(true),sto2 else (eval v2 sigma prog)
    |_-> raise(TypeError("OR")))
  | Operation(v1, bop, v2) -> (match (eval v1 sigma prog), (eval v2 sigma prog) with
            (x,y),(a,b) -> (applyOp bop x a),sto)
  | Id i -> if binds i env then (fetch i env),sto
            else if (match (evalobject env sto)
                with Object(x,y)->(binds i y)) then (match (evalobject env sto)
                            with Object(x,y) -> (fetch i y),sto) (*double check for errors*)
            else raise (TypeError("FKR"))
  | NewId (c) -> Location(List.length(sto)),extend sto (Object(c,(zipscalar (fields c prog) NullV)))
  | MethodCall(e1, x, el) -> (match (eval e1 sigma prog) with
    (Location l1,l2) -> ( match (storefetch l2 l1) with
            Object(cname, env1) ->(match (getMethod x cname prog), (evallist el sigma prog) with
                Method(a,b,c,d,e,f), (poo,pee) -> evalMethodCall e f (([("this",Location l1)]@(zip (varnames c) poo) @ (zipscalar (varnames d) (Location l1))),l2) prog
                | _ -> raise (TypeError("ERE"))

                          )
            | _ -> raise (TypeError("rere"))
                )
            |_ -> raise (TypeError("REEEREE")))

  | _ -> raise(TypeError("derere"))

and evallist (el:exp list) ((env,sto) as sigma:state) (prog:program)
          : stackvalue list * store = match el with


    a::b -> ( match(evallist b sigma prog) with
            ([],_) -> (match (eval a sigma prog) with
                    (x,y) -> ([x],sto) )
            | (x::y,_) -> (match (eval a sigma prog) with
                    (f,g)-> ((f::(x::y)),g)))
    | []  -> [], sto
    (*a::b -> let (x,y) = (eval a sigma prog) in ([x]@(evallist b sigma prog))

    | [] -> ([], sto)*)

and evalMethodCall (stms:statement list) (retval:exp) (sigma:state) (prog:program) : stackvalue * store =  match (execstmtlis stms sigma prog) with
    a -> eval retval a prog
    | _ -> raise(TypeError("ERERERE"))

and execstmt (s:statement) ((env,sto) as sigma:state) (prog:program) : state =
    match s with
    Assignment(id, e) ->
             if (binds id env) then (match (eval e sigma prog) with
                            (x,y) -> (asgn id x env),y)
             else if (match (evalobject env sto) with
                Object(x,y)-> (binds id y))
                        then (match (eval e sigma prog), (fetch "this" env) with
                         (x,y), Location(h) ->  env,(asgn_sto y h (asgn_fld (storefetch y h) id x))
                            )
             else raise (TypeError("why"))
  | Block s1 -> execstmtlis s1 sigma prog
  | If(e, s1, s2) -> (match (eval e sigma prog) with
        BoolV b,sto -> if b = true then execstmt s1 sigma prog
                else execstmt s2 sigma prog
        |_ -> raise (TypeError("Invalid if")))
  | _ -> raise (TypeError("Invalid if"))

and evalobject env sto = match (fetch "this" env) with
Location(h) -> storefetch sto h

and execstmtlis (sl:statement list) (sigma:state) (prog:program) : state = match sl with
  [] -> sigma
  | a::b -> execstmtlis b (execstmt a sigma prog) prog


let run_with_args (Program(Class(cname,_,_,_) :: _) as prog)
                  (args:exp list) : string =
   let env = [("this", Location 0)]
   and sto = [Object(cname, [])]
   in let (v,_) = eval (MethodCall(Id "this", "main", args))
                       (env,sto) prog
      in string_of_stackval v

let run (prog:program) : string = run_with_args prog []