open Ast
open Errors
open Llvm_def
open Utils
open Extern_funcs
open Debug_print

let rec eval_lval env = function
          Lval_id(str) ->
              let result = try
                  find_variable env str
                  with Not_found -> raise (Error("undeclared identifier " ^ str))
              in let (_, typ, _) = result in (typ, env)
        | Lval_arr(lval, expr) -> 
              let typ = fst (eval_lval env lval) in
                  begin match typ with
                        List( list_typ ) -> (list_typ, env)
                      | _ -> raise (Error("referenced variable " ^ (get_lval_id lval) ^" is not a list"))
                  end
        | Lval_struct(lval, str) ->
              let typ = fst (eval_lval env lval) in try
                  let ( struct_name , struct_decl_list) = find_struct_by_type env typ in try
                      let ( _ , member_typ) = find_struct_member struct_decl_list str in (member_typ, env)  
                      with Not_found -> raise (Error( str ^ " is not a member of struct " ^ struct_name))          
                  with Not_found -> 
                      raise (Error("referenced variable " ^ (get_lval_id lval) ^ " is not a struct "))


and eval_expr env = function
          Expr_func(str, expr_list_opt) ->
              let typ_list = fst (eval_expr_list_opt env expr_list_opt) in
                  let result = try
                      find_function env str typ_list
                      with Not_found -> raise (Error("undefined function: " ^ str ^ "(" ^ 
                          (func_args_to_string typ_list) ^ ")"))
                  in (snd (fst result), env)
        | Expr_const(constant) -> (check_const_type constant, env)
        | Expr_op(str, expr) -> 
              let expr_type = fst (eval_expr env expr) in
                  if (Pervasives.compare expr_type Int = 0 || Pervasives.compare expr_type Double = 0)
                      then (expr_type, env)
                  else raise(Error("operator " ^ str ^ " not supported for " ^ (type_to_string expr_type)))
        | Expr_lval(lvalue) -> eval_lval env lvalue
        | Expr_lval_op(lvalue, str) -> 
              let lval_type = fst (eval_lval env lvalue) in
                  if (Pervasives.compare lval_type Int = 0) then (lval_type, env)
                  else raise(Error("operator " ^ str ^ " not supported for " ^ (type_to_string lval_type)))
        | Expr_binop(expr1, str, expr2) -> 
              let expr1_type = fst (eval_expr env expr1) in
                  let expr2_type = fst (eval_expr env expr2) in
                      if (str = "*" || str = "/" || str = "%" || str = "+" || str = "-") then
                          if ((Pervasives.compare expr1_type Int = 0 || Pervasives.compare expr1_type Double = 0) &&
                              (Pervasives.compare expr2_type Int = 0 || Pervasives.compare expr2_type Double = 0)) then
                              if(Pervasives.compare expr1_type Double = 0 || Pervasives.compare expr2_type Double = 0) then
                                  (Double, env)
                              else (Int, env)
                          else raise(Error("binary operator " ^ str ^ " not supported for " ^ (type_to_string expr1_type)
                              ^ " and " ^ (type_to_string expr2_type)))
                      else if (str = "&&" || str = "||") then
                          if (Pervasives.compare expr1_type expr2_type = 0) then
                              if (Pervasives.compare expr1_type Int = 0) then (Int, env)
                              else raise(Error("binary operator " ^ str ^ " not supported for " ^ (type_to_string expr1_type)))
                          else raise(Error("types of operands does not match: " ^ (type_to_string expr1_type)
                              ^ " " ^ str ^ " " ^ (type_to_string expr2_type)))
                      else 
                          if ((Pervasives.compare expr1_type Int = 0 || Pervasives.compare expr1_type Double = 0) &&
                              (Pervasives.compare expr2_type Int = 0 || Pervasives.compare expr2_type Double = 0)) then
                              (Int, env)
                          else raise(Error("binary operator " ^ str ^ " not supported for " ^ (type_to_string expr1_type)
                              ^ " and " ^ (type_to_string expr2_type)))
        | Expr_asgop(lvalue, str, expr) -> 
              let lval_type = fst (eval_lval env lvalue) in
                  let expr_type = fst (eval_expr env expr) in
                      if (Pervasives.compare expr_type lval_type = 0) then
                          if (str = "=") then (lval_type, env)
                          else if (Pervasives.compare lval_type Int = 0 || Pervasives.compare lval_type Double = 0)
                              then (lval_type, env)
                              else if (str = "+=" && Pervasives.compare lval_type String = 0) then
                                  (lval_type, env)
                                  else raise(Error("operator " ^ str ^ " not supported for " ^ (type_to_string lval_type)))
                      else if ((Pervasives.compare lval_type Int = 0 || Pervasives.compare lval_type Double = 0) &&
                              (Pervasives.compare expr_type Int = 0 || Pervasives.compare expr_type Double = 0)) then
                          (lval_type, env)
                      else raise(Error("types of operands does not match: " ^
                          (type_to_string lval_type) ^ " " ^ str ^ " " ^ (type_to_string expr_type)))
        | Expr_paren(expr) ->  eval_expr env expr

and eval_expr_opt env = function
          Expr_opt(None) -> (Int, env)
        | Expr_opt(Some(expr)) -> 
              let result = eval_expr env expr in result

and eval_expr_list_opt env  = function expr_list_opt ->
    let (type_list, env) =
        List.fold_left (fun (typ_list, env) expr -> 
            let (typ, env1) = eval_expr env expr in ((typ :: typ_list), env1)) ([], env) expr_list_opt
    in (List.rev type_list, env)

and eval_stmt (has_return, env) = function
          Stmt(expr) -> (has_return, (snd (eval_expr env expr)))
        | Stmt_block(stmt_list) -> List.fold_left eval_stmt (has_return, env) stmt_list
        | Stmt_if(expr, stmt) -> 
              let typ = (fst (eval_expr env expr)) in
                  if (Pervasives.compare typ Int = 0) then eval_stmt (has_return, env) stmt
                  else raise(Error("type of if statement's predicate is " ^ (type_to_string typ)
                      ^ ", but must be evaluated to int"))
	| Stmt_ifelse(expr, stmt1, stmt2) -> 
              let typ = (fst (eval_expr env expr)) in
                  if (Pervasives.compare typ Int = 0) then
                      let (has_return1, env1) = eval_stmt (has_return, env) stmt1 in
                          eval_stmt (has_return1, env1) stmt2
                  else raise(Error("type of if statement's predicate is " ^ (type_to_string typ)
                      ^ ", but must be evaluated to int"))
        | Stmt_for(expr_opt1, expr_opt2, expr_opt3, stmt) ->
              let env1 = snd (eval_expr_opt env expr_opt1) in 
                  let (typ, env2) = eval_expr_opt env1 expr_opt2 in
                      if (Pervasives.compare Int typ = 0) then
                          let env3 = snd (eval_expr_opt env2 expr_opt3) in
                              eval_stmt (has_return, env3) stmt
                      else raise(Error("type of for statement's condition is " ^ (type_to_string typ)
                      ^ ", but must be evaluated to int"))
        | Stmt_break -> has_return, env
        | Stmt_ret(expr) -> 
              let result = eval_expr env expr in
                  if (Pervasives.compare (fst result) env.ret_type = 0) then 
                      true, snd result
                  else raise(Error("function returns type " ^ (type_to_string (fst result)) ^ 
                      ", but should return type " ^ (type_to_string env.ret_type)))
        | Stmt_noop -> has_return, env

and eval_stmt_list (has_return, env) = function stmt_list -> List.fold_left eval_stmt (has_return, env) stmt_list

and eval_const type_spec = function
          Const_int(int) -> if (Pervasives.compare type_spec Int = 0) then (string_of_int(int), Int) 
                                 else raise(Error("type mismatch: " ^ (type_to_string type_spec) ^ " -> int"))
	| Const_dbl(dbl) -> if (Pervasives.compare type_spec Double = 0) then (string_of_float(dbl), Double)
                                 else raise(Error("type mismatch: " ^ (type_to_string type_spec) ^ " -> double"))
        | Const_str(str) -> if (Pervasives.compare type_spec String = 0) then (str, String)
                                 else raise(Error("type mismatch: " ^ (type_to_string type_spec) ^ " -> string"))

and eval_const_expr type_spec = function
	  Const_expr(const) -> eval_const type_spec const
	| Const_expr_neg(const) -> 
            let (value, typ) = eval_const type_spec const in 
                if(Pervasives.compare typ Int = 0 || Pervasives.compare typ Double = 0) then
                    ("-" ^ value, typ)
                else raise(Error("- operator not supported for type string"))

and eval_const_expr_list env type_spec extra_stmts str = function const_expr_list ->
    match type_spec with
      List(typ) ->
          ((List.fold_left (fun list const_expr -> 
              List.rev ((fst (eval_const_expr typ const_expr)) :: List.rev list)) [] const_expr_list), type_spec, extra_stmts)
    | Struct(struct_name) -> 
        (try let ( _ , member_list ) = find_struct_by_type env (Struct(struct_name)) in
            let typ_list = List.fold_left (fun typ_list const_expr -> 
                List.rev ((check_const_expr_type const_expr) :: List.rev typ_list)) [] const_expr_list in
                let result = (match_struct_members member_list typ_list 0) in
                    if (result) then 
		    let new_stmts = struct_decl_to_stmts str member_list const_expr_list in
                        ([""], type_spec, (merge_list extra_stmts new_stmts))
                    else raise(Error("types of the list elements do not match the member types of struct " ^ struct_name))
        with Not_found -> raise(Error("cannot initialize an undefined struct " ^ struct_name)))
    | _ -> raise(Error("cannot assign a list of values to a non-list/non-struct variable"))

and eval_init env type_spec extra_stmts str = function
          Init_const_expr(const_expr) -> 
              let (value, typ) = eval_const_expr type_spec const_expr in ([value], typ, extra_stmts)
        | Init_const_expr_list(const_expr_list) ->  eval_const_expr_list env type_spec extra_stmts str const_expr_list

and eval_declarator (type_spec, env, extra_stmts) = function
          Declarator(str, None) -> 
              let result = check_variable env str in
                  if (not result) then (env.variables <- List.rev ((str, type_spec, []) :: List.rev env.variables);
                      (type_spec, env, extra_stmts))
                  else raise (Error("variable " ^ str ^ " has already been defined"))
        | Declarator(str, Some(init)) -> 
            let (value, typ, stmts) = eval_init env type_spec extra_stmts str init in
                env.variables <- List.rev ((str, type_spec, value) :: List.rev env.variables);
                (type_spec, env, stmts)

and eval_decl (env, extra_stmts) = function
          Decl(typ, declarator_list) -> 
              let ( _, new_env, stmts) = List.fold_left eval_declarator (typ, env, extra_stmts) declarator_list in 
                  (new_env, stmts)
        | Decl_struct(str, struct_decl_list) -> 
            let result = check_struct env str in
                if(not result) then 
                    (env.structs <- List.rev ((str, struct_decl_list) :: List.rev env.structs);
                    (env, []))
                else raise (Error("struct " ^ str ^ " has already been defined"))

and eval_decl_list env = function decl_list -> List.fold_left eval_decl (env, []) decl_list

and eval_decl_list_opt env = function decl_list -> eval_decl_list env decl_list

and eval_func_body typ env = function func_body -> 
    let (env1, extra_stmts) = eval_decl_list_opt env func_body.func_decl_list in
       func_body.stmt_list <- (merge_list extra_stmts func_body.stmt_list);
       let (has_return, env2) = eval_stmt_list (false, env1) func_body.stmt_list in
           if(has_return) then env2
           else raise(Error("function must return a type of " ^ (type_to_string typ)))

and eval_func_def env = function func_def ->
    let new_env = 
    { parent = Some(env);
      variables = [];
      functions = [];
      structs = [];
      ret_type = func_def.type_spec;
    } in
        let (name, param_list) = func_def.func_decl in
            let typ_list = get_func_arg_typs param_list in
                let result = check_function env name typ_list in
                    if(not result) then (
                        env.functions <- List.rev (((name, func_def.type_spec), param_list) :: List.rev env.functions);
                        let new_env1 = eval_function_params new_env (snd func_def.func_decl) in 
                        let new_env2 = eval_func_body func_def.type_spec new_env1 func_def.func_body in
                        let (func_name, _ ) = func_def.func_decl in
                            if(func_name = "main") then (func_def.func_body.stmt_list <- add_gl_calls func_def.func_body.stmt_list);
                        ({ func_env = new_env2; func_definition = func_def }, env))  
                    else raise (Error("function " ^ name ^ "(" ^ (func_args_to_string typ_list) ^ ") has already been defined"))     

and eval_function_params env param_list =
    List.fold_left (fun env param -> 
        (env.variables <- List.rev ((fst param, snd param, []) :: List.rev env.variables)); env) env param_list
	
and eval_func_def_list env = function func_def_list -> List.fold_left add_func_data ([], env) func_def_list

and add_func_data (func_data_list, env) = function func_def ->
    let (func_data, new_env) = eval_func_def env func_def in
        (List.rev (func_data :: List.rev func_data_list), new_env)

and eval_prog env = function prog -> 
    let env1 = fst (eval_decl_list env prog.decl_list) in
        let env2 = load_extern_funcs env1 in
           let (func_data_list, env3) =  eval_func_def_list env2 prog.func_def_list in
               check_main env.functions;
               { prog_env = env3;
               prog_functions = func_data_list; }

and check_main func_list = 
    try List.find (fun ((s, _ ), _ ) -> s = "main") func_list; ()
    with Not_found -> raise (Error("function main is not defined"))

let _ =
    let env = 
    { parent = None;
      variables = [];
      functions = [];
      structs = [];
      ret_type = Int;            
    } in
        let lexbuf = Lexing.from_channel stdin in
            let prog = Parser.program Scanner.token lexbuf in
                let prog_data = eval_prog env prog in llvm_prog prog_data
