(*open Ast
open Sast*)


module StringMap = Map.Make(String)


(**** ENVIRONMENTS  ****)
(* One environment is made for every scope. Environments link back to their parents so that
   the chain of environments can be traversed to look for variables. Each environment
   contains a scope-specific symbol table and the return type of the current function.  *)
type env_func = {
	func_type	: Sast.t;
	func_args	: (string * Sast.t) list;
}

type env_var = {
	var_type	: Sast.t;
	var_expr	: Sast.sexpr;
}

type global_env = {
	global_sym_table	: env_var StringMap.t; (* for storing global variables *)
	global_func_table	: env_func StringMap.t (* stores functions: maps name -> type, list of function's formals types in order *)
}

type env = {
	env_name	 : string;
	env_sym_table	 : env_var StringMap.t; (* map string -> Sast.t *)
	env_parent	 : env option; (* the global environment can have no parent *)
  env_ret_typ : Sast.t;
  func_block : bool
}

(**** HELPER FUNCTIONS ****)
(* Extract the type of a sexpr from the SAST *)
let extract_type sexpr_node = match sexpr_node with
	  Sast.Id(_, t, _) 			             -> t
	| Sast.Noexpr(t) 			               -> t
	| Sast.Binop(_, t, _, _, _)          -> t
  | Sast.Unop(_, t, _, _)              -> t
	| Sast.Assign(_, t, _, _)	           -> t
	| Sast.Call(_, t, _, _)			         -> t
  | Sast.Fliteral(_, t, _)	           -> t
	| Sast.Iliteral(_, t, _)	           -> t
	| Sast.Sliteral(_, t, _)	           -> t
	| Sast.TensorId(_, t, _, _)		       -> t
	| Sast.TensorAssign(_, t, _, _, _)   -> t
	| Sast.Itensor(_, t, _)			         -> t
	| Sast.BindExpr(_, t, _)	           -> t

(* Convert an AST type into a SAST type *)
let convert_type = function
	  Ast.Void 		        -> Sast.Void
	| Ast.Float 		      -> Sast.Float
	| Ast.Int 		        -> Sast.Int
	| Ast.String 		      -> Sast.String
	| Ast.TensorType(q) 	-> Sast.Tensor(List.length q)

(* Check that two given types are the same (or one is an int that can be promoted to float)  *)
let check_matching line t1 t2 op = match t1, t2 with 
     x, y when x = y                        -> x
   | Sast.Int, Sast.Float                   -> Sast.Float
   | Sast.Float, Sast.Int                   -> Sast.Float
   | Sast.Tensor(0), Sast.Tensor(0) | Sast.Tensor(0), Sast.Float | Sast.Float, Sast.Tensor(0) -> Sast.Float
   | a, b                                   -> raise (Exceptions.BinaryTypeMismatchException(line, (Sast.string_of_styp a), (Sast.string_of_styp b), op))

(*DEPRECATED Get the type of a given binary operator with the two given types *)
(*let get_btype t1 op t2 = match op with
    Ast.Concat -> (match t1, t2 with
        x, y when x != Sast.String || y != Sast.String -> 
           raise (Exceptions.BadConcatException(" TODO: linenum "))
        |_                                   -> Sast.String)
   | Ast.Equal | Ast.Neq | Ast.Less | Ast.Leq | Ast.Greater | Ast.Geq | Ast.And | Ast.Or -> Sast.Int 
   |_ -> check_matching t1 t2 (Ast.string_of_op op)
*)
 
(* Attempt to find a given variable in the local symbol table(s), and then the global one  *)
let rec try_find v local_env env = 
   try Some(StringMap.find v local_env.env_sym_table)
        with Not_found -> (match local_env.env_parent with 
           None -> (try Some(StringMap.find v env.global_sym_table)
              with Not_found -> None)
	 | Some x -> try_find v x env)



(**** CHECK EXPRESSIONS ****)
(* fold_left function to check the types of all expressions in one tensor dimension  *)
let rec check_ten_expr_list a t = match a with
	Sast.Tensor(r) -> if ((extract_type t) = a) then Sast.Tensor(r) else raise(Exceptions.InvalidTensorImmedException(Sast.get_line_sexpr t))
	| Sast.Int | Sast.Float -> if ((extract_type t) == Sast.Float || (extract_type t) == Sast.Int) then Sast.Float else raise(Exceptions.InvalidTensorImmedException(Sast.get_line_sexpr t))
	| _ -> raise(Exceptions.InvalidTensorImmedException(Sast.get_line_sexpr t))

(* extract the stimmediate from an expression we know is a tensor immediate *)
and convert_ten_to_stim t = match t with
	Sast.Itensor(_,_, s) -> s
	| x -> raise(Exceptions.InvalidTensorImmedException(Sast.get_line_sexpr x))

(* recursively check one tensor immediate *)
and check_ti line ti local_env global_env =
	(* ti is a list of exprs. convert them to sexprs so we can decide if they are tensors or not *)
	let tchecked = List.map (fun n -> check_expr n local_env global_env) ti in
	(* check that everything in the same level of recursion is the same type. decide that this dimension is a dimension of floats or of tensors. *)
	let tentype = List.fold_left check_ten_expr_list (extract_type (List.hd tchecked)) tchecked in match tentype with
		(* if this dimension is made of tensors, extract the stimmediates *)
		Sast.Tensor(_) -> let tstims = List.map convert_ten_to_stim tchecked in
			(* take the first stimmediate and extract its list of dimensions *)
			(let dim = extract_dim (List.hd tstims) in
				(* make sure that all stimmediates in the list are of the same dimensions *)
				List.iter (fun n -> let d = extract_dim n in
				List.iter2 (fun a b -> if (a == b) then () else (raise(Exceptions.InvalidTensorImmedException(line)))) d dim) tstims;
				(* return (1) the new list of dimensions and (2) the list of tensorimmediates from this level *)
				Sast.STenDim((List.length tstims)::dim, tstims))
		(* if this dimension is made of ints/floats, return a simple ExprDim *)
		| Sast.Int | Sast.Float -> Sast.SExprDim(List.length tchecked, tchecked)
		| _ -> raise(Exceptions.InvalidTensorImmedException(line))

and extract_dim t = match t with
     Sast.SExprDim(i, _)  -> [i]
   | Sast.STenDim(il, _)  -> il

and check_ten_expr expr local_env global_env = 
     let sexpr = check_expr expr local_env global_env in 
         (match extract_type sexpr with 
              Sast.Int | Sast.Float -> sexpr
            | x -> raise( Exceptions.InvalidTensorElementException(Sast.get_line_sexpr sexpr, Sast.string_of_styp x)))


(* Check one single index expression's type *)
and check_ind q local_env global_env =
	let sq = check_ind_expr q local_env global_env in
	match extract_type sq with
		  Sast.Void -> 1
	  | Sast.Int -> 0
	  | x -> raise(Exceptions.InvalidIndexException(Sast.get_line_sexpr sq, Sast.string_of_styp x))

(* Check the type of one index expression in a tensor *)
and check_ind_expr expr local_env global_env = match expr with
  Ast.Id(line, vd) ->
	   (let vt = try_find vd local_env global_env in match vt with
	        None -> Sast.Id(line, Sast.Void, vd)
        | Some x -> Sast.Id(line, x.var_type, vd))
  | _ -> check_expr expr local_env global_env

(* Check a single expression. Check that types are proper, any identifiers can be found in the
    symbol tables, and put any new declarations into them. Return a SAST.sexpr node. *)
and check_expr expr local_env global_env = match expr with 
    Ast.Id(line, vd) -> 
        (let vt = try_find vd local_env global_env in match vt with
          None -> raise (Exceptions.NotDeclaredInScopeException(line, vd))
        | Some x -> Sast.Id(line, x.var_type, vd))

   |Ast.Noexpr -> Sast.Noexpr(Sast.Void)

   |Ast.Binop(line, e1, op, e2)  -> 
        let e1 = check_expr e1 local_env global_env
        and e2 = check_expr e2 local_env global_env in
	    get_btype line e1 op e2

   |Ast.Unop(line, op, e) ->
        let e = check_expr e local_env global_env in
	let t = extract_type e in
	if (match op with 
	        Ast.Neg -> t != Sast.Int && t != Sast.Float && t != Sast.Tensor(0) 
	       |Ast.Not -> t != Sast.Int)            
        then raise (Exceptions.UnaryTypeMismatchException(line, (Sast.string_of_styp t), (Ast.string_of_uop op)))
            else if t = Sast.Tensor(0) then Sast.Unop(line, Sast.Float, op, e) 
            else  Sast.Unop(line, t, op, e)

   |Ast.Assign(line, s, e) -> 
   		(let ts = try_find s local_env global_env in match ts with
			      None -> raise (Exceptions.NotDeclaredInScopeException(line, s))
		      | Some x -> let e = check_expr e local_env global_env in 
	    Sast.Assign(line, check_matching line x.var_type (extract_type e) "assignment", s, e))

   |Ast.Call(line, s, el) -> 
       let build_fname_from_call name elist local_env global_env = match name with
          | _ -> name ^ "_" ^ (String.concat "_" (List.map (fun n -> Sast.string_of_styp(let t = extract_type(check_expr n local_env global_env) in (match t with Sast.Tensor(0) -> Sast.Float | x -> x))) elist))
                 in
        let build_fnames name func = match name with
            | _ -> List.map fst func.func_args
            in 
        let fname = build_fname_from_call s el local_env global_env in 
        let func = (if ((String.length fname >= 11) && (String.compare (String.sub fname 0 4) "dim_") == 0 && (String.compare (String.sub fname ((String.length fname) - 11)  11) "-tensor_int") == 0) then StringMap.find "dim_0-tensor_int" global_env.global_func_table
		else if ((String.length fname >= 7) && ((String.compare (String.sub fname 0 6) "print_") == 0) && ((String.compare (String.sub fname ((String.length fname) - 7) 7) "-tensor") == 0)) then StringMap.find "print_0-tensor" global_env.global_func_table
		else (try StringMap.find fname global_env.global_func_table
            	with Not_found -> raise(Exceptions.NotDeclaredInScopeException(line, fname))))
            in
	let sformal_builder = List.map (fun n -> (match extract_type (check_expr n local_env global_env) with Sast.Tensor(0) -> Sast.Float | x -> x)) el in
        let sformal_names = build_fnames s func in 
        Sast.Call(line, func.func_type, {Sast.ftyp = func.func_type; sfname = s; sformals =List.combine sformal_builder sformal_names; sbody = Sast.SBlock([])}, (List.map (fun n -> check_expr n local_env global_env) el))

   |Ast.Fliteral(l,f) -> Sast.Fliteral(l, Sast.Float, f)

   |Ast.Iliteral(l,i) -> Sast.Iliteral(l, Sast.Int, i)

   |Ast.Sliteral(l,s) -> Sast.Sliteral(l, Sast.String, s)             

   |Ast.TensorId(line, s, q) ->
        (let vt = try_find s local_env global_env in match vt with
		            None -> raise (Exceptions.NotDeclaredInScopeException(line, s));
              | Some x -> let rank = (List.fold_left (fun a n -> a + (check_ind n local_env global_env)) 0 q) in
		if (String.compare ((string_of_int (List.length q)) ^ "-tensor") (Sast.string_of_styp x.var_type)) != 0
		then raise( Exceptions.TensorTypeException(line, s, Sast.string_of_styp x.var_type, string_of_int (List.length q)))
		else Sast.TensorId(line, (if rank == 0 then Sast.Float else (Sast.Tensor(rank))), s, List.map (fun n -> check_ind_expr n local_env global_env) q))

   |Ast.TensorAssign(line, s, sl, e) -> let e = check_expr e local_env global_env in
        let id = check_expr (Ast.TensorId(line, s, sl)) local_env global_env in
	let typ = (check_matching line (extract_type id) (extract_type e) "assignment") in 
	      Sast.TensorAssign(line, typ, s, List.map (fun n -> check_ind_expr n local_env global_env) sl, e) 
	      
   |Ast.Tensor(line, t) -> let stim = check_ti line t local_env global_env in
                         let dim = extract_dim stim in
                 Sast.Itensor(line, Sast.Tensor(List.length dim), stim) 


   |Ast.BindExpr(line, b) -> check_bind line b local_env global_env

and check_bind line bind local_env env = match bind with
    Ast.InferredBind(l, s, e) -> check_new_id s l local_env;
        let se = check_expr e local_env env in
	let t1 = extract_type se in
	let t = (match t1 with Sast.Tensor(0) ->  Sast.Float
		       | x -> x) in 
            ignore(StringMap.add s {var_type=t; var_expr=se} local_env.env_sym_table);
            Sast.BindExpr(line, t, Sast.InferredBind(line, s, se))
   |Ast.TensorBind(line, s, q) -> let qsize = check_new_tensor s line q local_env in
        ignore( List.map (fun n -> if (check_ind n local_env env) == 1 then raise(Exceptions.VoidTensorIndexException(line, Ast.string_of_expr n)) else ()) q );
	if qsize == 0 then raise(Exceptions.EmptyTensorException(line)) 
	else Sast.BindExpr(line, Sast.Tensor(qsize), Sast.TensorBind(line, s, List.map (fun n -> check_expr n local_env env) q))
   |Ast.TensorBindAndAssign(line, s, q, e) -> let qsize = check_new_tensor s line q local_env in
       let se = check_expr e local_env env in
       ignore(check_matching line (extract_type se) (Sast.Tensor(qsize)) "assignment");
       Sast.BindExpr(line, extract_type se, Sast.TensorBindAndAssign(line, s, List.map (fun n -> check_expr n local_env env) q, se))

and check_new_id id line local_env = 
   let x = StringMap.mem id local_env.env_sym_table in 
      match x with
        true -> raise(Exceptions.DoubleDeclareException(line, id))
      | false -> ()

and check_new_tensor s l q local_env = 
        check_new_id s l local_env;
        let qsize = List.length q in
	ignore(StringMap.add s {var_type=Sast.Tensor(qsize); var_expr=Sast.Noexpr(Sast.Void)} local_env.env_sym_table);
	qsize


and extract_free_bound (f, b) q q2 =
  if (extract_type q == Sast.Void) then (
  if List.mem q q2 then (f, if not (List.mem q b) then List.append b [q] else b)
     else (List.append f [q], b))
  else (f, b)

and check_free_bound e1 e2 = (match e1 with 
  Sast.TensorId(_, _, _, q1) | Sast.TensorAssign(_, _, _, q1, _) -> 
    (match e2 with   Sast.TensorId(_, _, _, q2) | Sast.TensorAssign(_, _, _, q2, _) -> 
      (let (free, bound) = List.fold_left (fun a n -> extract_free_bound a n q2) ([], []) q1 in
      List.fold_left (fun a n -> extract_free_bound a n q1) (free, bound) q2) 
    | x -> raise (Exceptions.UnspecifiedTensorMultiplicationException(Sast.get_line_sexpr x)) )
  | x -> raise (Exceptions.UnspecifiedTensorMultiplicationException(Sast.get_line_sexpr x)) )
   
(* Get the type of a given binary operator with the two given types *)
and get_btype line e1 op e2 = 
   let t1 = extract_type e1 in
   let t2 = extract_type e2 in
   match op with
    Ast.Concat -> (match t1, t2 with
        x, y when x != Sast.String || y != Sast.String -> 
           raise (Exceptions.BadConcatException(line))
        |_                                   -> Sast.Binop(line, Sast.String, e1, Ast.Concat, e2))
   |Ast.Mult -> (match t1, t2 with
	Sast.Tensor(_), Sast.Tensor(_) -> let (free, _) = check_free_bound e1 e2 in
	   Sast.Binop(line, Sast.Tensor(List.length free), e1, Ast.Mult, e2)
       |Sast.Tensor(r), Sast.Float | Sast.Float, Sast.Tensor(r) -> Sast.Binop(line, Sast.Tensor(r) , e1, Ast.Mult, e2)
       |Sast.Tensor(r), Sast.Int | Sast.Int, Sast.Tensor(r) -> Sast.Binop(line, Sast.Tensor(r) , e1, Ast.Mult, e2)
       |_, _ -> Sast.Binop(line, check_matching line t1 t2 (Ast.string_of_op op), e1, Ast.Mult, e2)
)
   | Ast.And | Ast.Or | Ast.Less | Ast.Leq | Ast.Greater | Ast.Geq | Ast.Equal | Ast.Neq -> (match t1, t2 with
          x, y when x == Sast.String || y == Sast.String -> raise(Exceptions.BinaryTypeMismatchException(line, (Sast.string_of_styp t1), (Sast.string_of_styp t2), (Ast.string_of_op op)))
        | Sast.Tensor(_), _ -> raise(Exceptions.BinaryTypeMismatchException(line, (Sast.string_of_styp t1), (Sast.string_of_styp t2), (Ast.string_of_op op)))
        | _, Sast.Tensor(_) -> raise(Exceptions.BinaryTypeMismatchException(line, (Sast.string_of_styp t1), (Sast.string_of_styp t2), (Ast.string_of_op op)))
        | _, _ -> ignore(check_matching line t1 t2 (Ast.string_of_op op)); Sast.Binop(line, Sast.Int, e1, op, e2))
   | x -> Sast.Binop(line, check_matching line t1 t2 (Ast.string_of_op op), e1, x, e2)

let extract_name_from_bind = function
    Ast.InferredBind(_, s, _) -> s
  | Ast.TensorBind(_, s, _) -> s
  | Ast. TensorBindAndAssign(_, s, _, _) -> s

let extract_name_from_sbind = function
    Sast.InferredBind(_, s, _) -> s
  | Sast.TensorBind(_, s, _) -> s
  | Sast.TensorBindAndAssign(_, s, _, _) -> s


(**** CHECK STATEMENT ****)
(* Check a single statement, Make a new environment if a new scope is started. Check all
    expressions involved for correct types and semantic correctness. Return a SAST.sstmt
    node. *)
let rec check_stmt local_env global_env stmt = match stmt with
     Ast.Block(_,sl)            -> let new_env = if local_env.func_block == true then {local_env with func_block=false}
                                                else {env_name="sblock"; env_sym_table=StringMap.empty; env_parent=Some local_env; env_ret_typ=local_env.env_ret_typ; func_block=false} 
                                  in check_sblock sl new_env global_env []
   | Ast.Expr(_, e)          -> check_expr_stmt e local_env global_env
   | Ast.If(_, e, s1, s2)       -> check_if e s1 s2 local_env global_env
   | Ast.For(_, e1, e2, e3, s)  -> check_for e1 e2 e3 s local_env global_env
   | Ast.While(_, e, s)         -> check_while e s local_env global_env
   | Ast.Return(_, e)            -> check_return e local_env global_env

(* check an expression statement *)
and check_expr_stmt e local_env global_env =
   Sast.Expr(check_expr e local_env global_env)

and check_sexp_env e local_env global_env = 
  let checked_e = check_expr e local_env global_env in
     match checked_e with
        Sast.BindExpr(_, t, b) -> {local_env with env_sym_table=(StringMap.add (extract_name_from_sbind b) {var_type=t; var_expr=checked_e} local_env.env_sym_table)}
      | _ -> local_env

and check_sblock sl local_env global_env outputlist =  match sl with
   [] -> if List.length outputlist > 0  && (String.compare local_env.env_name "function" == 0) then (let hd = List.hd outputlist in
          (match hd with
            Sast.Return(_) -> ()
          | _ when local_env.env_ret_typ == Sast.Void-> ()
          | _ -> raise(Exceptions.NoReturnException(Sast.string_of_styp local_env.env_ret_typ)));
          Sast.SBlock(List.rev outputlist))
          else Sast.SBlock(List.rev outputlist)
  | Ast.Expr(_, e) :: tl  -> (let new_env = check_sexp_env e local_env global_env in 
                            let sast_e = check_expr_stmt e local_env global_env in 
                              let updated_output_list = sast_e :: outputlist in
                                check_sblock tl new_env global_env updated_output_list)
  | Ast.Return(_, _) :: tl when tl != [] -> raise (Exceptions.StatementAfterReturnException(Ast.string_of_stmt (List.hd tl)))
  | x :: tl -> let updated_output_list = check_stmt local_env global_env x :: outputlist in
                check_sblock tl local_env global_env updated_output_list


(* check an if statement *)
and check_if e s1 s2 local_env global_env =
   let exp = check_expr e local_env global_env in
   let t = extract_type exp in
   if t != Sast.Int then raise (Exceptions.ExpectedConditionException(Sast.get_line_sexpr exp, Ast.string_of_expr e));
   let new_env_if = { env_name="if"; env_sym_table=StringMap.empty; env_parent=(Some local_env); env_ret_typ=local_env.env_ret_typ; func_block=false }
   in let new_env_else = { new_env_if with env_name="else" }  in
   Sast.If(exp, check_stmt new_env_if global_env s1, check_stmt new_env_else global_env s2)

(* check a for statement *)
and check_for e1 e2 e3 s local_env global_env = 
    check_stmt local_env global_env (Ast.Block([], [Ast.Expr([],e1); Ast.While([],e2, Ast.Block([],[s; Ast.Expr([],e3)]))]))

(* check a while statement *)
and check_while e s local_env global_env = 
   let exp = check_expr e local_env global_env in
   let t = extract_type exp in
   if t != Sast.Int then raise (Exceptions.ExpectedConditionException(Sast.get_line_sexpr exp, Ast.string_of_expr e));
   let new_env = { env_name="while"; env_sym_table=StringMap.empty; env_parent=(Some local_env); env_ret_typ=local_env.env_ret_typ; func_block=false  } in
   Sast.While(exp, check_stmt new_env global_env s)

(* check a return statement *)
and check_return e local_env global_env =
    let exp = check_expr e local_env global_env in 
    if (String.compare (Sast.string_of_styp (extract_type exp)) (Sast.string_of_styp local_env.env_ret_typ)) != 0 then 
        raise (Exceptions.FuncReturnTypeException(Sast.get_line_sexpr exp, Sast.string_of_styp local_env.env_ret_typ, Sast.string_of_styp (extract_type exp)))
    else Sast.Return(exp)


(**** GLOBALS ****)
(* check all global variables. put them into the global symbol table. *)
let check_globals globals global_env = 
    let fake_local_env = {env_name="foo"; env_sym_table=StringMap.empty; env_parent=None; env_ret_typ=Sast.Void; func_block=false } in
    let check_gbind global_env bind = {global_env with global_sym_table = (
        match bind with 
	   Ast.InferredBind(line, s,e) -> 	       
	      (let se = check_expr e fake_local_env global_env in 
	       let t = extract_type se in
	             if StringMap.mem s global_env.global_sym_table
                  then raise(Exceptions.DoubleDeclareException(line,s))
          		    else StringMap.add s {var_type=t;var_expr=se} global_env.global_sym_table)
   | Ast.TensorBind(line, s, q) -> 
		ignore(check_new_id s line fake_local_env); (* check for redefinition *)
		ignore(List.map (fun n -> if (check_ind n fake_local_env global_env) == 1 then raise(Exceptions.VoidTensorIndexException(line, Ast.string_of_expr n)) else ()) q);
		let qsize = List.length q in
		StringMap.add s {var_type=Sast.Tensor(qsize); var_expr=Sast.Noexpr(Sast.Void)} global_env.global_sym_table
           |Ast.TensorBindAndAssign(line, s, q, e) -> 
		(ignore(check_new_id s line fake_local_env);
		 let se = check_expr e fake_local_env global_env in
		 let qsize = List.length q in
		 ignore(check_matching line (extract_type se) (Sast.Tensor(qsize)) "assignment");
		 StringMap.add s {var_type=Sast.Tensor(qsize); var_expr=se} global_env.global_sym_table)
    )}
    in List.fold_left check_gbind global_env globals


(**** FUNCTIONS ****)
(* Check one function. Make it its own local environment, check all its formals, check its body.  *)
let check_function global_env dummy_env func = 
	let local_env = {env_name="function"; env_sym_table=StringMap.empty; env_parent=dummy_env; env_ret_typ=(convert_type func.Ast.typ); func_block=true }
	in let add_formal local_env formal = { local_env with env_sym_table=
		if StringMap.mem (snd formal) local_env.env_sym_table
    then raise (Exceptions.DoubleDeclareException(" TODO: linenum", snd formal))
		else StringMap.add (snd formal) ({var_type= (convert_type (fst formal)); var_expr=Sast.Noexpr(Sast.Void)}) local_env.env_sym_table }
	in let local_env_with_formals = List.fold_left add_formal local_env func.Ast.formals
	in let fsbody = check_stmt local_env_with_formals global_env func.Ast.body 
	in let convert_formal formal = ((convert_type (fst formal)), (snd formal))
	in {Sast.ftyp=(convert_type func.Ast.typ); sfname=func.Ast.fname; sformals=List.map convert_formal func.Ast.formals; sbody=fsbody;}
	
(* Check all functions. For each function, add it to the global function table. 
   Make sure some main() function is defined. *)
let rec add_to_globals global_env func = { global_env with global_func_table=(
  if StringMap.mem (build_fname_from_fdecl func.Ast.fname func.Ast.formals) global_env.global_func_table 
        then raise (Exceptions.DoubleDeclareException(" TODO: linenum", func.Ast.fname))
  else StringMap.add (build_fname_from_fdecl func.Ast.fname func.Ast.formals) {func_type=convert_type func.Ast.typ; func_args=List.map (fun n -> ((snd n),(convert_type (fst n)))) func.Ast.formals } global_env.global_func_table )}
and build_fname_from_fdecl fn formals = 
    fn ^ "_" ^ String.concat "_" (List.map (fun n-> Sast.string_of_styp (convert_type (fst n))) formals)

(* Check all functions, but also return the final global environment. *)
let check_functions functions dummy_env global_env =
	let new_global_env = List.fold_left add_to_globals global_env functions
	in let global_env_with_main = match StringMap.mem "main_" new_global_env.global_func_table with
		false -> raise (Exceptions.NoMainException)
	      | true -> new_global_env
	in ((List.map (check_function global_env_with_main dummy_env) functions), global_env_with_main)


let built_in = [
(*file operations: fopen, fclose, fread, fwrite *)
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="fopen"; Ast.formals=[(Ast.String, "f"); (Ast.String, "m")]; Ast.body=Ast.Block([],[])};
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="fclose"; Ast.formals=[(Ast.Int, "f")]; Ast.body=Ast.Block([],[])};
                {Ast.comm=[]; Ast.typ=Ast.String; Ast.fname="fread"; Ast.formals=[(Ast.Int, "n"); (Ast.Int, "f")]; Ast.body=Ast.Block([],[])};
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="fwrite"; Ast.formals=[(Ast.String, "s"); (Ast.Int, "f")]; Ast.body=Ast.Block([],[])};
                
(*print, toString, string length*)
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="print"; Ast.formals=[(Ast.String, "s")]; Ast.body=Ast.Block([],[])};
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="print"; Ast.formals=[(Ast.Int, "i")]; Ast.body=Ast.Block([],[])};
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="print"; Ast.formals=[(Ast.Float, "f")]; Ast.body=Ast.Block([],[])};
                {Ast.comm=[]; Ast.typ=Ast.String; Ast.fname="toString"; Ast.formals=[(Ast.Int, "i")]; Ast.body=Ast.Block([],[])};
                {Ast.comm=[]; Ast.typ=Ast.String; Ast.fname="toString"; Ast.formals=[(Ast.Float, "f")]; Ast.body=Ast.Block([],[])}; 
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="strlen"; Ast.formals=[(Ast.String, "s")]; Ast.body=Ast.Block([],[])}; 

(*tensor operations: dim, ... *)
		            {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="dim"; Ast.formals=[(Ast.TensorType([]), "t"); (Ast.Int, "i")]; Ast.body=Ast.Block([], [])};
		            {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="print"; Ast.formals=[(Ast.TensorType([]), "t")]; Ast.body=Ast.Block([], [])};

(*casting*)
                {Ast.comm=[]; Ast.typ=Ast.Float; Ast.fname="itof"; Ast.formals=[(Ast.Int, "i")]; Ast.body=Ast.Block([],[])};
		            {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="ftoi"; Ast.formals=[(Ast.Float, "f")]; Ast.body=Ast.Block([], [])};
                {Ast.comm=[]; Ast.typ=Ast.String; Ast.fname="itos"; Ast.formals=[(Ast.Int, "i")]; Ast.body=Ast.Block([],[])};
		            {Ast.comm=[]; Ast.typ=Ast.String; Ast.fname="ftos"; Ast.formals=[(Ast.Float, "f")]; Ast.body=Ast.Block([], [])};
                {Ast.comm=[]; Ast.typ=Ast.Int; Ast.fname="stoi"; Ast.formals=[(Ast.String, "s")]; Ast.body=Ast.Block([],[])};
		            {Ast.comm=[]; Ast.typ=Ast.Float; Ast.fname="stof"; Ast.formals=[(Ast.String, "s")]; Ast.body=Ast.Block([], [])};

(*math*)        {Ast.comm=[]; Ast.typ=Ast.Float; Ast.fname="sqrt"; Ast.formals=[(Ast.Float, "f")]; Ast.body=Ast.Block([], [])};
                
                ]

(* Add built-in functions to the global environment *)
let populate_library_functions global_env = 
    List.fold_left (fun g n -> add_to_globals g n) global_env built_in


(**** TYPIFY  ****)
(* Take in a list of globals and a list of formals as defined in the AST. Semantically check all
   of these, and if all goes well, return equivalent structures from the SAST. *)
let typify (globals, functions) =
	(* use a dummy empty environment as the root to connect all other environments. the real global
	   vars/func decls will be stored in the global_env. *)
	let env_root = { env_name = "root"; env_sym_table = StringMap.empty; env_parent = None; env_ret_typ=Sast.Void; func_block=false } in
	let global_env = { global_sym_table=StringMap.empty; global_func_table=StringMap.empty  }  in
	let global_env_with_globals = check_globals globals global_env in
	let global_env_with_built_ins = populate_library_functions global_env_with_globals in 
 	let (funcs, global_env_with_funcs) = check_functions functions (Some env_root) global_env_with_built_ins in
	let convert_binding = function
		| n, t -> { Sast.vtyp=t.var_type; vexpr=t.var_expr; sname=n }
	in (global_env_with_funcs, {Sast.functions=funcs; Sast.globals=(List.map convert_binding (StringMap.bindings global_env_with_built_ins.global_sym_table)) })

let string_of_func func = (Sast.string_of_styp ((snd func).func_type)) ^ " " ^ (fst func) ^ " ("
	^ String.concat ", " (List.map (fun arg -> (Sast.string_of_styp (snd arg)) ^ " " ^ (fst arg)) ((snd func).func_args)) ^ ");"

(* Pretty-print the program and also its global environment *)
let string_of_prog_and_env (global_env, sprogram) = Sast.string_of_program sprogram ^ "\n\n\nFINAL GLOBAL ENVIRONMENT:\n" ^
	String.concat "" (List.map Sast.string_of_sglobal sprogram.Sast.globals)  ^ "\n\n" ^
	String.concat "\n" (List.map string_of_func (StringMap.bindings global_env.global_func_table))
