open Ast

module NameMap = Map.Make(struct
  type t = string
  let compare x y = Pervasives.compare x y
end)

exception ReturnException of string * string NameMap.t

(* Main entry point: run a program *)

let run (vars, funcs) =
  (* Put function declarations in a symbol table *)
  let func_decls = List.fold_left
      (fun funcs fdecl -> NameMap.add fdecl.fname fdecl funcs)
      NameMap.empty funcs
  in
  
	(* Function to trim quotes from strings *)
	let rec trimQuote string =
	let l = String.length string in
	if string.[0]='"' then
	trimQuote (String.sub string 1 (l-1))
	else if string.[l-1]='"' then
	trimQuote (String.sub string 0 (l-1))
	else string
	
	in
	 
  (* Invoke a function and return an updated global symbol table *)
  let rec call fdecl actuals globals =
    (* Evaluate an expression and return (value, updated environment) *)
    let rec eval env = function
				Int_Literal(i) -> i, env
			| String_Literal(i) -> i, env
      | Noexpr -> "1", env (* must be non-zero for the for loop predicate *)
      | Id(var) ->
	  		let locals, globals = env in
	  		if NameMap.mem var locals then
	    	(NameMap.find var locals), env
	  		else if NameMap.mem var globals then
	    	(NameMap.find var globals), env
	  		else raise (Failure ("undeclared identifier in Id " ^ var))
      | Binop(e1, op, e2) ->
	  		let v1, env = eval env e1 in
          let v2, env = eval env e2 in
					 let v1int = int_of_string(v1) in
					   let v2int = int_of_string(v2) in
	  				  let boolean i = if i then 1 else 0 in
	  				  (match op with	    			
						  Add -> string_of_int(v1int + v2int)
	  				| Sub -> string_of_int(v1int - v2int)
	  				| Mult -> string_of_int(v1int * v2int)
	  				| Div -> string_of_int(v1int / v2int)
	  				| Equal -> string_of_int(boolean (v1int = v2int))
	  				| Neq -> string_of_int(boolean (v1int != v2int))
	  				| Less -> string_of_int(boolean (v1int < v2int))
	  				| Leq -> string_of_int(boolean (v1int <= v2int))
	  				| Greater -> string_of_int(boolean (v1int > v2int))
	  				| Geq -> string_of_int(boolean (v1int >= v2int))), env
      | Assign(var, e) ->
	  			let v, (locals, globals) = eval env e in
	  			if NameMap.mem var locals then
	    		v, (NameMap.add var v locals, globals)
	  			else if NameMap.mem var globals then
	    		v, (locals, NameMap.add var v globals)
	  			else raise (Failure ("undeclared identifier in Assign " ^ var))
			| LinkAssign(var, e, e2) ->
	  			let v, (locals, globals) = eval env e in
					let v2, (locals, globals) = eval env e2 in
					let trimV2 = trimQuote v2 in
	  			if NameMap.mem var locals then
	    		v, (NameMap.add var ("<a href=" ^ v ^ ">" ^ trimV2 ^ "</a>") locals, globals)
	  			else if NameMap.mem var globals then
	    		v, (locals, NameMap.add var ("<a href=" ^ v ^ "dotcom") globals)
	  			else raise (Failure ("undeclared identifier in LinkAssign " ^ var))	
			| TitleAssign(var, title) -> 
				 	let titleStr, (locals, globals) = eval env title in
					let titleStrUnqt = trimQuote titleStr in					
	  			if NameMap.mem var locals then
	    		titleStrUnqt, (NameMap.add var ("<html>\n<head></head>\n<body>\n<title>" ^ titleStrUnqt ^ "</title>") locals, globals)
	  			else if NameMap.mem var globals then
	    		titleStrUnqt, (locals, NameMap.add var ("<html>\n<head></head>\n<body>\n<title>" ^ titleStrUnqt ^ "</title>") globals)
	  			else raise (Failure ("undeclared identifier in TitleAssign " ^ var))	
			| FormAssign(var, methodName, action) -> 
				  let v, (locals, globals) = eval env methodName in	
					let v2,(locals, globals) = eval env action in				
	  			if NameMap.mem var locals then
	    		v, (NameMap.add var ("<form onsubmit=\"return true\" method=" ^ v
					 ^ " action=" ^ v2 ^ ">") locals, globals)
	  			else if NameMap.mem var globals then
	    		v, (locals, NameMap.add var ("<a href=" ^ v ^ "dotcom") globals)
	  			else raise (Failure ("undeclared identifier in LinkAssign " ^ var))
			| InputAssign(var, label, size, name) -> 
				  let labelStr, (locals, globals) = eval env label in
						let trimmedLabelStr = trimQuote labelStr in	
					let sizeStr,(locals, globals) = eval env size in				
					let nameStr,(locals, globals) = eval env name in
	  			if NameMap.mem var locals then
	    		trimmedLabelStr, (NameMap.add var ("<p>" ^ trimmedLabelStr
					 ^ " <input type=\"text\" maxlength=" ^ sizeStr ^ " name=" 
					 ^ nameStr ^ " size=" ^ sizeStr ^ ">") locals, globals)
	  			else if NameMap.mem var globals then
	    		trimmedLabelStr, (locals, NameMap.add var ("<a href=" ^ trimmedLabelStr ^ "dotcom") globals)
	  			else raise (Failure ("undeclared identifier in LinkAssign " ^ var))
			| Bold (text) ->
				 let textStr, (locals, globals) = eval env text in 				
				 let textStrTrim = trimQuote textStr in				 
				 "<b>" ^ textStrTrim ^ "</b>", (NameMap.add "dummyKey" ("") locals, globals)
			| Break ->
				let text = Ast.expr in
				let (locals, globals) = eval env text in
				 "<br>", (NameMap.add "dummyKey" ("") locals, globals)
      | Call("insert", [e]) ->
	  		let v, env = eval env e in
	  		print_endline (v);
	  		"0", env
      | Call(f, actuals) ->
	  		let fdecl =
	    	try NameMap.find f func_decls
	    	with Not_found -> raise (Failure ("undefined function " ^ f))
	  		in
	  		let actuals, env = List.fold_left
	      (fun (actuals, env) actual ->
				let v, env = eval env actual in v :: actuals, env)
   	      ([], env) actuals
	  			in
	  			let (locals, globals) = env in
	  			try
	    			let globals = call fdecl actuals globals in "0", (locals, globals)
	  				with ReturnException(v, globals) -> v, (locals, globals)
    			in

    (* Execute a statement and return an updated environment *)
    let rec exec env = function
				Block(stmts) -> List.fold_left exec env stmts
      | Expr(e) -> let _, env = eval env e in env
      | For(e1, e2, e3, s) ->
	  		let _, env = eval env e1 in
	  		let rec loop env =
	    	let v, env = eval env e2 in
	    	if v != "0" then
		      let _, env = eval (exec env s) e3 in
	      	loop env
	    	else
		      env
			  in loop env
      | Return(e) ->
			  let v, (locals, globals) = eval env e in
			  raise (ReturnException(v, globals))
		    in
		    (* Enter the function: bind actual values to formal arguments *)
		    let locals =
      	try List.fold_left2
	  		(fun locals formal actual -> NameMap.add formal actual locals)
	  		NameMap.empty fdecl.formals actuals
      	with Invalid_argument(_) ->
				raise (Failure ("wrong number of arguments passed to " ^ fdecl.fname))
    		in
    		(* Initialize local variables to 0 *)
  		  let locals = List.fold_left
				(fun locals local -> NameMap.add local "0" locals) locals fdecl.locals
    		in
    		(* Execute each statement in sequence, return updated global symbol table *)
    		snd (List.fold_left exec (locals, globals) fdecl.body)

  			(* Run a program: initialize global variables to 0, find and run "page" *)
  			in let globals = List.fold_left
      	(fun globals vdecl1 -> NameMap.add vdecl1 "0" globals) NameMap.empty vars
  			in try
    		call (NameMap.find "page" func_decls) [] globals
  			with Not_found -> raise (Failure ("did not find the page() function"))
