open Ast

let rec llvm_prog prog =
	llvm_global_variables prog.prog_env.variables;
	llvm_struct_def prog.prog_env.structs prog.prog_env;
	llvm_functions prog.prog_functions;
	print_endline("\ndeclare void @llvm.memcpy.i64(i8* nocapture, i8* nocapture, i64, i32) nounwind");
	print_endline("declare i8* @strcpy(i8* noalias, i8* noalias) nounwind");
	print_endline("declare i8* @strcat(i8* noalias, i8* noalias) nounwind");
	print_endline("declare i32 @add_shape(%struct.shape* byval)");
	print_endline("declare i32 @add_point(%struct.point* byval)");
	print_endline("declare i32 @setup()");
	print_endline("declare i32 @run()");
	print_endline("declare i32 @pop_point()");
	print_endline("declare i32 @pop_shape()");
	print_endline("declare i32 @wait(double)");
	print_endline("declare i32 @byebye()");

and llvm_functions prog_functions = List.iter llvm_func prog_functions

and llvm_struct_def structs env = 
	match structs with
		 [] -> print_endline("");
		|head::tail -> llvm_struct_def_single head env;
						llvm_struct_def tail env;
and llvm_struct_def_single (name, type_list) env =
	print_string("%struct." ^ name ^ " = type {  ");
	llvm_print_types type_list env;
	print_endline("}");
and llvm_print_types type_list env =
	match type_list with
	 []-> print_string("")
	|[(str, typ)] -> print_string(llvm_print_type typ);
	|(str, typ)::tail -> print_string((llvm_print_type typ)^", ");
		llvm_print_types tail env;
and llvm_print_type typ=
	match typ with
			 Int -> "i32"
			|Double -> "double"
			|String -> "[100 x i8]"
			|Struct(s) -> "%struct." ^ s
			|List(t)->"[100 x "^llvm_print_type t^"]"


and llvm_func func = 
	llvm_func_def func.func_definition;
	let (func_decls, statements, env, (func_name,_)) = (func.func_definition.func_body.func_decl_list, func.func_definition.func_body.stmt_list, func.func_env,func.func_definition.func_decl) in
		llvm_func_stack_decls func_decls func_name;
		let str_index_typ = ("%reg0", 0, Int) in 
			llvm_stmts str_index_typ statements (func.func_definition, env, "", 0);
			print_endline("");
			print_endline("return:");
			(
			match func.func_definition.type_spec with
			Struct(s)-> print_endline("\tret void");
			|_->
			print_endline("\t%retval4 = load " ^ type2string func.func_definition.type_spec ^ "* %retval");
			print_endline("\tret " ^ type2string func.func_definition.type_spec ^" %retval4");
			);
			print_endline("}\n");


and llvm_stmts str_index_typ statements env= 
	match statements with
	 [] -> str_index_typ
	|head :: tail -> llvm_stmts (llvm_stmt str_index_typ head env) tail env

and llvm_stmt str_index_typ statement env=
	match statement with
	 Stmt(expr) -> llvm_expr str_index_typ expr env
	|Stmt_block(stmts) -> llvm_stmts str_index_typ stmts env
	|Stmt_ret(expr) ->
		let (s1,i1,t1) = llvm_expr str_index_typ expr env
		and (def, e,_,_) = env in
			( match t1 with
			|Struct(st) -> print_endline("\t call  void @llvm.memcpy.i64(i8* %agg.result1, i8* " ^ s1 ^ ", i64 " ^ string_of_int(Utils.sizeof e t1) ^", i32 8)");
			|_->llvm_store def.type_spec s1 "%retval";
			);
			llvm_br "return"; (s1,i1,t1)
	|Stmt_if(expr, stmt1) ->
		let (s0,i0,t0) = llvm_expr str_index_typ expr env in
		let (s1,i1,t1) = llvm_trunc (s0,i0,t0) in
			llvm_bri1 s1 (label i1 0) (label i1 1);
			print_endline("");
			print_endline((label i1 0) ^ ":");
			let (s2,i2,t2) = llvm_stmt (s1,i1,t1) stmt1 env in
				print_endline("");
				print_endline((label i1 1) ^ ":");
				(s2,i2,t2)
	|Stmt_ifelse(expr, stmt1,stmt2) ->
		let (s0,i0,t0) = llvm_expr str_index_typ expr env in
		let (s1,i1,t1) = llvm_trunc (s0,i0,t0) in
			llvm_bri1 s1 (label i1 0) (label i1 1);
			print_endline("");
			print_endline((label i1 0) ^ ":");
			let (s2,i2,t2) = llvm_stmt (s1,i1,t1) stmt1 env in
				llvm_br (label i1 2);
				print_endline("");
				print_endline((label i1 1) ^ ":");
				let (s3,i3,t3) = llvm_stmt (s2,i2,t2) stmt2 env in
					llvm_br (label i1 2);
					print_endline("");
					print_endline((label i1 2) ^ ":");
					(s3,i3,t3)
	|Stmt_for(expr1_opt, expr2_opt, expr3_opt, stmt) ->
		let (s1,i1,t1) = llvm_expr_opt str_index_typ expr1_opt env in
			print_endline("");
			llvm_br((label (i1+1) 0) ^ "forentry");
			print_endline((label (i1+1) 0) ^ "forentry:");
			let (s15,i15,t15) = llvm_expr_opt (s1,i1,t1) expr2_opt env in
			let (s2,i2,t2) = llvm_trunc (s15,i15,t15) in
				llvm_bri1 s2 (label i2 0) (label i2 1);
				print_endline("");
				print_endline((label i2 0) ^ ":");
				let (def,env0,for_stack,n) = env in
				let (s3,i3,t3) = llvm_stmt (s2,i2,t2) stmt (def,env0,(label i2 1),n) in
					let (s4,i4,t4) = llvm_expr_opt (s3,i3,t3) expr3_opt env in
						llvm_br((label (i1+1) 0) ^ "forentry");
						print_endline("");
						print_endline((label i2 1)^":");
						(s4,i4,t4)
	|Stmt_break ->
		let (def,env0,for_stack,_) = env in
			llvm_br(for_stack); str_index_typ
	| _ -> str_index_typ

and llvm_expr_opt (s,i,t) expr_opt env =
	match expr_opt with
	 Expr_opt(Some(expr)) -> llvm_expr (s,i,t) expr env
	|Expr_opt(None) -> (s,i,t)
and llvm_args (s,i,t,arglist) exprs env =
	match exprs with
	 [] -> (s,i,t,arglist)
	|[head] -> llvm_arg_nc (s,i,t,arglist) head env
	|head::tail -> llvm_args (llvm_arg (s,i,t,arglist) head env) tail env
and llvm_arg (s,i,t,arglist) expr env =
	let (str,index,typ) = llvm_expr (s,i,t) expr env
		in 
		match typ with
			|Struct(s)->
				let (s2,i2,t2) = llvm_bitcast_i8 (str,index,typ) (index2str (index)) typ env
					in (s2,i2,t2,arglist^(type2string3 typ) ^" "^ s2^", ")
			|_->(str,index,typ,arglist ^ (type2string3 typ) ^ " " ^ str^", ")
and llvm_arg_nc (s,i,t,arglist) expr env =
	let (str,index,typ) = llvm_expr (s,i,t) expr env
		in 
		match typ with
			|Struct(s)->
				let (s2,i2,t2) = llvm_bitcast_i8 (str,index,typ) (index2str (index)) typ env
					in (s2,i2,t2,arglist^(type2string3 typ) ^" "^ s2)
			|_->(str,index,typ,arglist ^ (type2string3 typ) ^ " " ^ str)
and llvm_expr (str, index, typ) expression env =
	match expression with
	 Expr_const(konstant) -> 
		begin match konstant with
			Const_str(s)->
				let (def,_,_,_) = env in
				let (func_name,_) = def.func_decl in
					print_endline("@.str." ^ func_name ^ "." ^ string_of_int(index) ^ " = private constant [100 x i8] c" ^ (str2str s) ^ ", align 1");
					("getelementptr inbounds ([100 x i8]* @.str." ^ func_name ^ "." ^string_of_int(index), index, String)
			|_->(konstant2string_helper konstant, index, konstant2type konstant)
		end
	|Expr_func(identifier, exprs) ->
		let (s,i,t,arglist) = llvm_args (str,index,typ,
				(
				 match exprs with
				 [] -> "  "
				|_ -> ""
				)
			) exprs env in
				llvm_call (s,i,t) (function2type identifier env) identifier arglist
	|Expr_op(unary_op, expr) -> 
		let new_sit = llvm_expr (str,index,typ) expr env in
		let (new_s, new_i, new_t) = new_sit in
			begin
				match unary_op with
				 "-" ->
				 	begin
						match new_t with
						 Int -> llvm_sub new_sit "0" new_s
						|Double -> llvm_fsub new_sit "0.0" new_s
						|_ -> undef "Unary operator - only support Int and Double"; new_sit
					end
				|"!" ->
					begin
						match typ with
						 Int ->	llvm_zext (llvm_icmp new_sit "eq" new_s "0")
						|_ -> undef "Unary operator - only support Int"; new_sit
					end
			end
	|Expr_binop(expr1, binop, expr2) ->
		let (s1,i1,t1) = llvm_expr (str,index,typ) expr1 env in
			begin
				match binop with
				 "*" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
				 	begin
						match (t1,t2) with
						 (Int, Int)-> llvm_mul (s2,i2,t2) s1 s2
						|(Int, Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fmul (s3,i3,t3) s2 s3
						|(Double, Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fmul (s3,i3,t3) s1 s3
						|(Double,Double) -> llvm_fmul (s2,i2,t2) s1 s2
					end
				|"/" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int, Int)-> llvm_sdiv (s2,i2,t2) s1 s2
						|(Int, Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fdiv (s3,i3,t3) s2 s3
						|(Double, Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fdiv (s3,i3,t3) s1 s3
						|(Double,Double) -> llvm_fdiv (s2,i2,t2) s1 s2
					end
				|"%" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int, Int)-> llvm_srem (s2,i2,t2) s1 s2
						|(Int, Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_frem (s3,i3,t3) s2 s3
						|(Double, Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_frem (s3,i3,t3) s1 s3
						|(Double,Double) -> llvm_frem (s2,i2,t2) s1 s2
					end
				|"+" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int, Int)-> llvm_add (s2,i2,t2) s1 s2
						|(Int, Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fadd (s3,i3,t3) s2 s3
						|(Double, Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fadd (s3,i3,t3) s1 s3
						|(Double,Double) -> llvm_fadd (s2,i2,t2) s1 s2
					end
				|"-" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int, Int)-> llvm_sub (s2,i2,t2) s1 s2
						|(Int, Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fsub (s3,i3,t3) s2 s3
						|(Double, Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fsub (s3,i3,t3) s1 s3
						|(Double,Double) -> llvm_fsub (s2,i2,t2) s1 s2
					end
				|"<" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int,Int) -> (llvm_icmp (s2,i2,t2) "slt" s1 s2)
						|(Int,Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fcmp (s3,i3,t3) "olt" s2 s3
						|(Double,Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fcmp (s3,i3,t3) "olt" s1 s3
						|(Double,Double) -> llvm_fcmp (s2,i2,t2) "olt" s1 s2
					end
					;llvm_zext (index2str (i2+1),i2+1,Int)
				|">" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int,Int) -> (llvm_icmp (s2,i2,t2) "sgt" s1 s2)
						|(Int,Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fcmp (s3,i3,t3) "ogt" s2 s3
						|(Double,Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fcmp (s3,i3,t3) "ogt" s1 s3
						|(Double,Double) -> llvm_fcmp (s2,i2,t2) "ogt" s1 s2
					end
					;llvm_zext (index2str (i2+1),i2+1,Int)
				|"<=" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int,Int) -> (llvm_icmp (s2,i2,t2) "sle" s1 s2)
						|(Int,Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fcmp (s3,i3,t3) "ole" s2 s3
						|(Double,Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fcmp (s3,i3,t3) "ole" s1 s3
						|(Double,Double) -> llvm_fcmp (s2,i2,t2) "ole" s1 s2
					end
					;llvm_zext (index2str (i2+1),i2+1,Int)
				|">=" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int,Int) -> (llvm_icmp (s2,i2,t2) "sge" s1 s2)
						|(Int,Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fcmp (s3,i3,t3) "oge" s2 s3
						|(Double,Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fcmp (s3,i3,t3) "oge" s1 s3
						|(Double,Double) -> llvm_fcmp (s2,i2,t2) "oge" s1 s2
					end
					;llvm_zext (index2str (i2+1),i2+1,Int)
				|"==" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int,Int) -> (llvm_icmp (s2,i2,t2) "eq" s1 s2)
						|(Int,Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fcmp (s3,i3,t3) "oeq" s2 s3
						|(Double,Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fcmp (s3,i3,t3) "oeq" s1 s3
						|(Double,Double) -> llvm_fcmp (s2,i2,t2) "oeq" s1 s2
					end
					;llvm_zext (index2str (i2+1),i2+1,Int)
				|"!=" ->
					let (s2,i2,t2) = llvm_expr (s1,i1,t1) expr2 env in
					begin
						match (t1,t2) with
						 (Int,Int) -> (llvm_icmp (s2,i2,t2) "nq" s1 s2)
						|(Int,Double) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s1 in llvm_fcmp (s3,i3,t3) "onq" s2 s3
						|(Double,Int) -> 
							let (s3,i3,t3) = llvm_sitofp (s2,i2,t2) s2 in llvm_fcmp (s3,i3,t3) "onq" s1 s3
						|(Double,Double) -> llvm_fcmp (s2,i2,t2) "onq" s1 s2
					end
					;llvm_zext (index2str (i2+1),i2+1,Int)
				|"&&" ->
					begin
						match t1 with
						 Int -> let (s2,i2,t2) = llvm_alloca (s1,i1,t1) Int in
						 		let (s3,i3,t3) = llvm_icmp (s2,i2,t1) "eq" s1 "0" in
								llvm_bri1 s3 (label i3 2) (label i3 0);
								print_endline("");
								print_endline((label i3 0) ^ ":");
								let (s4,i4,t4) = llvm_expr (s3,i3,t3) expr2 env in
						 		let (s5,i5,t5) = llvm_icmp (s4,i4,t4) "eq" s4 "0" in
								llvm_bri1 s5 (label i3 2) (label i3 1);
								print_endline("");
								print_endline((label i3 1) ^ ":");
								llvm_store Int "1" (index2str i2);
								llvm_br (label i3 3);
								print_endline("");
								print_endline((label i3 2) ^ ":");
								llvm_store Int "0" (index2str i2);
								llvm_br (label i3 3);
								print_endline("");
								print_endline((label i3 3) ^ ":");
								llvm_load (s5,i5,t5) Int s2
					end
				|"||" ->
					begin
						match t1 with
						 Int -> let (s2,i2,t2) = llvm_alloca (s1,i1,t1) Int in
						 		let (s3,i3,t3) = llvm_icmp (s2,i2,t1) "eq" s1 "1" in
								llvm_bri1 s3 (label i3 2) (label i3 0);
								print_endline("");
								print_endline((label i3 0) ^ ":");
								let (s4,i4,t4) = llvm_expr (s3,i3,t3) expr2 env in
						 		let (s5,i5,t5) = llvm_icmp (s4,i4,t4) "eq" s4 "1" in
								llvm_bri1 s5 (label i3 2) (label i3 1);
								print_endline("");
								print_endline((label i3 1) ^ ":");
								llvm_store Int "0" (index2str i2);
								llvm_br (label i3 3);
								print_endline("");
								print_endline((label i3 2) ^ ":");
								llvm_store Int "1" (index2str i2);
								llvm_br (label i3 3);
								print_endline("");
								print_endline((label i3 3) ^ ":");
								llvm_load (s5,i5,t5) Int s2
				end
			end
		|Expr_lval(lval) ->
			begin
				match lval with
				 Lval_id(identifier) -> 
					begin match (identifier2type identifier env) with
						|Struct(s)-> llvm_bitcast_struct (str,index,typ) ("%"^identifier) (identifier2type identifier env) env
						|_->llvm_load (str,index,typ) (identifier2type identifier env) (identifier2addr identifier env)
					end
				|Lval_struct(identifier, member) -> 
					let (s1,i1,final_typ) = llvm_getelementptr lval index env in
						print_endline("");
						begin match final_typ with
						Struct(s)-> llvm_bitcast_struct (s1,i1,final_typ) s1 final_typ env
						|_->llvm_load (s1, i1,final_typ) final_typ s1
						end
				|Lval_arr(identifier, expr) ->
						let (s1,i1,t1) = llvm_getelementptr lval index env in
						print_endline("");
						llvm_load (s1, i1,t1) t1 s1
						
			end
		|Expr_lval_op(lval,op) ->
			begin
				match lval with
				 Lval_id(identifier) -> 
					let (s1,i1,t1) = llvm_load (str,index,typ) (identifier2type identifier env) (identifier2addr identifier env) in
						begin match op with
						 "++" -> let (s2,i2,t2)= llvm_add (s1,i1,t1) s1 "1" in
							llvm_store t2 s2 (identifier2addr identifier env);
							(s2,i2,t2)
						|"--" -> let (s2,i2,t2)= llvm_sub (s1,i1,t1) s1 "1" in
							llvm_store t2 s2 (identifier2addr identifier env);
							(s2,i2,t2)
						end
			end
		|Expr_paren(expr) -> llvm_expr (str,index,typ) expr env
		|Expr_asgop(lval, op, expr) ->
			begin match op with
				"=" ->
					begin
						match lval with
						 Lval_id(identifier) -> 
						 	begin match (identifier2type identifier env) with
								String -> 
									let (s2,i2,t2) = llvm_expr (str,index,typ) expr env in
									let (s3,i3,t3) = llvm_bitcast_str (s2,i2,t2) identifier in
									print_endline("\t"^(index2str (i3+1))^" = call i8* @strcpy(i8* noalias " ^ s3 ^", i8* noalias " ^ s2^", i64 0, i64 0)) nounwind");
									((index2str (i3+1)),(i3+1),String)
								|_->
									let (s2,i2,t2) = llvm_expr (str,index,typ) expr env in
									begin match ((identifier2type identifier env),t2) with
									 (Int, Double) -> let (s3,i3,t3)=llvm_fptosi (s2,i2,t2) s2 in
								 		llvm_store (identifier2type identifier env) s3 (identifier2addr identifier env); (s3,i3,t3)
									 |(Double, Int) -> let (s3,i3,t3)=llvm_sitofp (s2,i2,t2) s2 in
								 		llvm_store (identifier2type identifier env) s3 (identifier2addr identifier env); (s3,i3,t3)
									|_ -> 
								 		llvm_store (identifier2type identifier env) s2 (identifier2addr identifier env); (s2,i2,t2)
									end
							end
						|Lval_struct(identifier, member) -> 
							let (s2,i2,t2) = llvm_expr (str,index,typ) expr env in
							let (s3,i3,final_type) = llvm_getelementptr lval i2 env in
								print_endline("");
								begin
									match final_type with
									Struct(s)-> let (_,e,_,_) =env in
									let (s4,i4,t4) = llvm_bitcast_struct (s3,i3,final_type) s3 final_type env in
									print_endline("\t call  void @llvm.memcpy.i64(i8* "^s4^", i8* "^s2^", i64 " ^ string_of_int(Utils.sizeof e final_type) ^", i32 1)");(s4,i4,t4)
									|_-> 
										begin match (final_type,t2) with
											(Int, Double)-> let (s4,i4,t4) = llvm_fptosi (s3,i3,final_type) s2 in
												llvm_store final_type s4 s3;  (s4, i4, t4)
											|(Double, Int)-> let (s4,i4,t4) = llvm_sitofp (s3,i3,final_type) s2 in
												llvm_store final_type s4 s3;  (s4, i4, t4)
											|_-> llvm_store final_type s2 s3;  (s3, i3, final_type)
										end
											
								end
						|Lval_arr(identifier, expr2) ->
							let (s2,i2,t2) = llvm_expr (str,index,typ) expr env in
							let (s3,i3,final_type) = llvm_getelementptr lval i2 env in
								print_endline("");
								llvm_store final_type s2 s3; 
								(s3, i3, final_type)
					end
				|"+=" ->
					begin
						match lval with
						 Lval_id(identifier) ->
						 	begin match (identifier2type identifier env) with
								String->
									let (s2,i2,t2) = llvm_expr (str,index,typ) expr env in
									let (s3,i3,t3) = llvm_bitcast_str (s2,i2,t2) identifier in
									print_endline("\t"^(index2str (i3+1))^" = call i8* @strcat(i8* noalias " ^ s3 ^", i8* noalias " ^ s2^", i64 0, i64 0)) nounwind");
									((index2str (i3+1)),(i3+1),String)
								|_->
									let (s2,i2,t2) = llvm_load (str,index,typ) (identifier2type identifier env) (identifier2addr identifier env) in
									let (s3,i3,t3) = llvm_expr (s2,i2,t2) expr env in
									let (s4,i4,t4) = 
									begin
										match (identifier2type identifier env) with
										 Int -> llvm_add (s3,i3,t3) s2 s3
										|Double -> llvm_fadd (s3,i3,t3) s2 s3
									end
									in llvm_store (identifier2type identifier env) s4 (identifier2addr identifier env); (s4,i4,t4)
							end
						|Lval_struct(identifier,member)->
							let (s2,i2,t2) = llvm_expr (str,index,typ) expr env in
							let (s3,i3,t3) = llvm_getelementptr lval i2 env in
								let (s4,i4,t4) = 
								begin
									match t3 with
									 Int -> llvm_add (s2,i2,t2) s2 s3
									|Double -> llvm_fadd (s2,i2,t2) s2 s3
								end
								in
								print_endline("");
								llvm_store t4 s4 s3;
								(s4,i4,t4)
					end
				|"-=" ->
					begin
						match lval with
						 Lval_id(identifier) ->
							let (s2,i2,t2) = llvm_load (str,index,typ) (identifier2type identifier env) (identifier2addr identifier env) in
							let (s3,i3,t3) = llvm_expr (s2,i2,t2) expr env in
							let (s4,i4,t4) = 
							begin
								match (identifier2type identifier env) with
								 Int -> llvm_sub (s3,i3,t3) s2 s3
								|Double -> llvm_fsub (s3,i3,t3) s2 s3
							end
							in llvm_store (identifier2type identifier env) s4 (identifier2addr identifier env); (s4,i4,t4)
					end
				|"*=" ->
					begin
						match lval with
						 Lval_id(identifier) ->
							let (s2,i2,t2) = llvm_load (str,index,typ) (identifier2type identifier env) (identifier2addr identifier env) in
							let (s3,i3,t3) = llvm_expr (s2,i2,t2) expr env in
							let (s4,i4,t4) = 
							begin
								match (identifier2type identifier env) with
								 Int -> llvm_mul (s3,i3,t3) s2 s3
								|Double -> llvm_fmul (s3,i3,t3) s2 s3
							end
							in llvm_store (identifier2type identifier env) s4 (identifier2addr identifier env); (s4,i4,t4)
					end
				|"/=" ->
					begin
						match lval with
						 Lval_id(identifier) ->
							let (s2,i2,t2) = llvm_load (str,index,typ) (identifier2type identifier env) (identifier2addr identifier env) in
							let (s3,i3,t3) = llvm_expr (s2,i2,t2) expr env in
							let (s4,i4,t4) = 
							begin
								match (identifier2type identifier env) with
								 Int -> llvm_sdiv (s3,i3,t3) s2 s3
								|Double -> llvm_fdiv (s3,i3,t3) s2 s3
							end
							in llvm_store (identifier2type identifier env) s4 (identifier2addr identifier env); (s4,i4,t4)
					end
				|"%=" ->
					begin
						match lval with
						 Lval_id(identifier) ->
							let (s2,i2,t2) = llvm_load (str,index,typ) (identifier2type identifier env) (identifier2addr identifier env) in
							let (s3,i3,t3) = llvm_expr (s2,i2,t2) expr env in
							let (s4,i4,t4) = 
							begin
								match (identifier2type identifier env) with
								 Int -> llvm_srem (s3,i3,t3) s2 s3
								|Double -> llvm_frem (s3,i3,t3) s2 s3
							end
							in llvm_store (identifier2type identifier env) s4 (identifier2addr identifier env); (s4,i4,t4)
					end
			end


and llvm_func_stack_decls func_decls func_name=
	match func_decls with
	 []->()
	|head::tail -> llvm_alloc_func_decl head func_name;
					llvm_func_stack_decls tail func_name;

and llvm_alloc_func_decl func_decl func_name=
	match func_decl with
	 Decl(typ, decls) ->
			let llvm_alloc_func_decl_one declarator =
				begin match declarator with
					Declarator(identifier, None) ->
					begin match typ with
						String -> print_endline("\t%" ^ identifier ^ " = alloca [100 x i8]")
						|Struct(s) -> print_endline("\t%" ^ identifier ^ " = alloca %struct."^s)
						|_ -> print_endline("\t%" ^ identifier ^ " = alloca " ^ type2string typ)
					end
					| Declarator(identifier, Some(init_val)) ->
					begin match typ with
						String -> 
							print_endline("@.str." ^ func_name ^ "." ^ identifier ^ " = private constant [100 x i8] c" ^ (match init_val with Init_const_expr(kStrExp) -> konstant2string kStrExp) ^ ", align 1");
							print_endline("\t%" ^ identifier ^ "0 = alloca [100 x i8]");
							print_endline("\t%" ^ identifier ^ " = bitcast [100 x i8]* %" ^ identifier ^ "0 to i8*");
							print_endline("\tcall void @llvm.memcpy.i64(i8* %" ^ identifier ^ ", i8* getelementptr inbounds ([100 x i8]* @.str." ^ func_name ^"."^ identifier ^ ", i64 0, i64 0), i64 100, i32 1)");
						|Struct(s) ->
							print_endline("\t%" ^ identifier ^ " = alloca %struct." ^ s);
						|_ ->
							print_endline("\t%" ^ identifier ^ " = alloca " ^ type2string typ);
							begin match init_val with
								 Init_const_expr(konstant_expr) ->
								 	llvm_store typ (konstant2string konstant_expr) ("%"^ identifier);
								|Init_const_expr_list(_) -> print_string("")
							end
						end
					end
			in List.iter llvm_alloc_func_decl_one decls
	|Decl_struct(_,_) -> print_string("")
			
			
and konstant2string konstant_expr =
	match konstant_expr with
		 Const_expr(konstant) -> konstant2string_helper konstant
		|Const_expr_neg(konstant) -> "-" ^ (konstant2string_helper konstant)
and konstant2string_helper konstant =
	match konstant with
	 Const_int(i) -> string_of_int(i)
	|Const_dbl(d) -> string_of_float(d)
	|Const_str(s) -> str2str(s)
and konstant2type konstant =
	match konstant with
	 Const_int(i) -> Int
	|Const_dbl(d) -> Double
	|Const_str(s) -> String
(* store type value, type* addr, align alignment*)
and llvm_store typ value addr =
	print_endline("\tstore " ^ type2string typ ^ " " ^ value ^ ", " ^ type2string typ ^ "* " ^ addr ^ ", align " ^ type2align typ);
and llvm_bitcast_str (str, index, typ) identifier =
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = bitcast [100 x i8]* %" ^ identifier ^ "0 to i8*"); (index2str (index+1), index+1, String)
and llvm_bitcast_struct (str, index, typ) identifier str_type env=
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = bitcast "^(type2string str_type) ^" "^ identifier ^ " to i8*"); (index2str (index+1), index+1, str_type)
and llvm_bitcast_i8 (str, index, typ) identifier str_type env=
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = bitcast i8* "^ identifier ^ " to "^(type2string str_type)); (index2str (index+1), index+1, str_type)
and llvm_load (str, index, typ) load_typ addr=
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = load " ^ type2string load_typ ^ "* " ^ addr ^ ", align " ^ type2align load_typ);(index2str (index+1), index+1, load_typ)
and llvm_add (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = add nsw " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Int)
and llvm_fadd (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = fadd " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Double)
and llvm_sub (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = sub nsw " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Int)
and llvm_fsub (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = fsub " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Double)
and llvm_icmp (str, index, typ) cond op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = icmp " ^ cond ^ " "^type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Int)
and llvm_fcmp (str, index, typ) cond op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = fcmp " ^ cond ^ " "^type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Int)
and llvm_mul (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = mul nsw " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Int)
and llvm_fmul (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = fmul " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Double)
and llvm_sdiv (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = sdiv " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Int)
and llvm_fdiv (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = fdiv " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Double)
and llvm_srem (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = srem " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Int)
and llvm_frem (str, index, typ) op1 op2 = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = frem " ^ type2string typ ^ " " ^ op1 ^ ", " ^ op2); (index2str (index+1), index+1, Double)
and llvm_zext (str, index, typ) = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = zext i1 " ^ str ^ " to i32"); (index2str (index+1), index+1, Int)
and llvm_trunc (str, index, typ) = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = trunc i32 " ^ str ^ " to i1"); (index2str (index+1), index+1, Int)
and llvm_fptosi (str, index, typ) op = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = fptosi double " ^ op ^ " to i32" ); (index2str (index+1), index+1, Int)
and llvm_sitofp (str, index, typ) op = 
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = sitofp i32 " ^ op ^ " to double" ); (index2str (index+1), index+1, Double)
and llvm_alloca (str, index, typ) alloca_typ =
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = alloca " ^ type2string alloca_typ); (index2str (index+1), index+1, alloca_typ)
and llvm_call (str, index, typ) call_typ identifier arglist =
	print_endline("\t%reg" ^ string_of_int(index+1) ^ " = call " ^ (type2string call_typ) ^ " @" ^ identifier ^"(" ^ arglist ^ ") nounwind"); (index2str (index+1), index+1, call_typ)
and llvm_bri1 str label1 label0 =
	print_endline("\tbr i1 " ^ str ^ ", label %" ^ label1 ^ ", label %" ^ label0);
and llvm_br label =
	print_endline("\tbr label %" ^ label);
and type2align typ =
	match typ with
	 Int -> "1"
	|Double -> "1"
	|String -> "1"
	|_ ->"1"
(*
 define type @identifier(type %identifier, type %identifier) nounwind {
 *)
and llvm_func_def func_def =
	let (typ, func_decl) = (func_def.type_spec, func_def.func_decl) in
		print_string("define ");
		(match typ with
		Struct(_) -> print_string("void");
		|_ -> print_string(type2string typ););
		print_string(" @");
		let (func_name, parameters) = func_decl in
			print_string(func_name);
			llvm_func_parameters parameters typ;
			print_endline(" nounwind {");
			llvm_func_parameters_stack parameters typ;
			begin match typ with
				Struct(s) -> print_endline("\t %agg.result1 = bitcast %struct."^s^"* %agg.result to i8*");
				|_-> print_endline("\t%retval = alloca " ^ type2string typ);
			end

and llvm_func_parameters_stack parameters typ= print_endline("entry:");
	match parameters with
		 [] -> print_string("")
		| _ -> List.iter llvm_func_parameter_stack parameters

and type2string typ =
	match typ with
		 Int -> "i32"
		|Double -> "double"
		|String -> "i8*"
		|Struct(name) -> "%struct." ^ name ^ "*"
		|List(t) -> "[100 x " ^ type2string t ^ "]"
and type2string3 typ =
	match typ with
		 Int -> "i32"
		|Double -> "double"
		|String -> "i8*"
		|Struct(name) -> "%struct." ^ name ^ "* byval"
and type2string2 typ =
	match typ with
		 Int -> "i32"
		|Double -> "double"
		|String -> "i8*"
		|Struct(name) -> "%struct." ^ name ^ "*"
		|List(t) -> "[100 x " ^ type2string t ^ "]*"

and llvm_func_parameter_stack parameter =
	let (identifier, typ) = parameter in
		match typ with
		Struct(_) -> ();
		|_->print_endline("\t%" ^ identifier ^ " = alloca " ^ type2string typ);
		llvm_store typ ("%" ^ identifier^"_val") ("%" ^ identifier);

and llvm_func_parameters parameters typ= print_string("(");
	(match typ with
		Struct(_) -> print_string((type2string typ)^" noalias sret %agg.result, ")
		|_ -> ()
	);
	llvm_func_paras parameters;
	print_string(")");
and llvm_func_paras parameters = 
	match parameters with
		[] -> ();
		|[head]->llvm_func_para_nc head;
		|head::tail -> llvm_func_para head; llvm_func_paras tail;

and llvm_func_para para =
	let (identifier, typ) = para in
		(match typ with
		Struct(s) -> print_string("%struct."^s^"* byval %"^identifier^", ");
		|_->print_string(type2string typ);
		print_string(" %" ^ identifier^"_val, "););
and llvm_func_para_nc para =
	let (identifier, typ) = para in
		(match typ with
		Struct(s) -> print_string("%struct."^s^"* byval %"^identifier);
		|_->print_string(type2string typ);
		print_string(" %" ^ identifier^"_val"););

	

(*
 @(identifier) = (init_or_not) (type_str_pre)init_val(type_str_post)
 *)
and llvm_global_variables variables =
	List.iter llvm_variable_decl variables;
	
and llvm_variable_decl variable =
	let (name, typ, value) = variable in
	let (identifier, init_or_not, type_str_pre, type_str_post, init_val) = 
		(
		 	name,
		 	(match value with
		 		 [] -> "common global"
				| _ -> "global"
			),
			(match typ with
			 	 Int -> "i32 "
				|Double -> "double "
				|String -> "[100 x i8] c"
				| _ -> ""
			),
			(match typ with
			 	 String -> ", align 1"
				| _ -> ""
			),
			(match value with
			 (* Default value *)
			 	 [] -> (match typ with
					 	 Int -> "0"
						|Double -> "0.0e+00"
						|String -> "\"" ^ (char_00 100) ^ "\""
						|_ -> ""
					 )
				| _ -> (match typ with
						 String -> str2str (List.hd value)
						|_ -> (List.hd value)
					)
			)
		) in print_endline("@" ^ identifier ^ " = " ^ init_or_not ^ " " ^ type_str_pre ^ init_val ^ type_str_post)
	
(* "\00"*n *)
and char_00 n = match n with
	  0 -> ""
	| _ -> "\\00" ^ char_00 (n-1)
and index2str index = "%reg" ^ string_of_int(index)
and str2str str =
	let (final_str, length) =
	let lexbuf = Lexing.from_string str in
		String2string.string2string "" 0 lexbuf
		in
	"\"" ^ final_str
	^ (char_00 (100 - length)) ^ "\""
and undef str=
	print_endline("undef: "^str);
and label vindex bindex = "v" ^ string_of_int(vindex) ^ "bb" ^ string_of_int(bindex)
and function2type identifier (def,env,stk,n) =
	match env.parent with
	|Some(parent) -> 
		let ((str,typ),_) = List.find (fun ((s,_), args) -> s = identifier) parent.functions in typ
		
and identifier2type identifier (def,env,stk,n) =
	try
		let (str,typ,_) =List.find (fun (s,_,_) -> s =identifier) env.variables in
			typ
		with Not_found ->
			match env.parent with
				Some(parent) -> identifier2type identifier (def,parent,stk,n)
and identifier2addr identifier (def,env,stk,n) =
	try
		let (str,typ,_) =List.find (fun (s,_,_) -> s =identifier) env.variables in
			"%" ^ identifier
		with Not_found ->
			match env.parent with
				Some(parent) -> let (str2,typ2,_) = List.find (fun (s,_,_) -> s=identifier) parent.variables in "@" ^ identifier
	
and llvm_getelementptr lv i2 env=
	begin match lv with
	Lval_id(struct_id) ->
		print_string("\t" ^ (index2str (i2+1)) ^ " = getelementptr inbounds " ^ (type2string2 (identifier2type struct_id env)) ^ " %" ^ struct_id ^ ", i32 0"); (index2str (i2+1), i2+1, identifier2type struct_id env)
	|Lval_struct(id,me) ->
		let (ss,ii,tt)=llvm_getelementptr id i2 env in
		let (def,sym,s,i)=env in
			print_string(", i32 "^string_of_int((Utils.sequency sym tt me)-1)); (ss, ii, Utils.member2type tt me sym)
	|Lval_arr(id,expr) ->
		let (s1,i1,t1)=llvm_expr (index2str i2, i2, Int) expr env in
		let (s3,i3,t3)=llvm_getelementptr id i1 env in
			begin
			match t3 with
			List(t4)->
			print_string(", i32 "^s1);(s3,i3,t4)
			end
	end
